patrick/WoofWare.PawPrint
1
0
Fork 0
mirror of https://github.com/Smaug123/WoofWare.PawPrint synced 2025-10-10 08:18:39 +00:00
Code Issues Packages Projects Releases Wiki Activity

Store ConcreteType in FieldInfo (#36)

Browse Source
This commit is contained in:
Patrick Stevens
2025-06-02 09:12:18 +01:00
committed by GitHub
parent efd94e5cea
commit 2b350986d3
7 changed files with 166 additions and 111 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
WoofWare.PawPrint/Assembly.fs
View File

@@ -71,7 +71,7 @@ type DumpedAssembly =
/// <summary>
/// Dictionary of all field definitions in this assembly, keyed by their handle.
/// </summary>
Fields : IReadOnlyDictionary<FieldDefinitionHandle, WoofWare.PawPrint.FieldInfo>
Fields : IReadOnlyDictionary<FieldDefinitionHandle, WoofWare.PawPrint.FieldInfo<FakeUnit>>
/// <summary>
/// The entry point method of the assembly, if one exists.
@@ -268,7 +268,7 @@ module Assembly =
let builder = ImmutableDictionary.CreateBuilder ()
for ref in metadataReader.AssemblyReferences do
builder.Add (ref, AssemblyReference.make ref (metadataReader.GetAssemblyReference ref))
builder.Add (ref, AssemblyReference.make (ref, assy.Name) (metadataReader.GetAssemblyReference ref))
builder.ToImmutable ()
@@ -355,7 +355,7 @@ module Assembly =
for field in metadataReader.FieldDefinitions do
let fieldDefn =
metadataReader.GetFieldDefinition field
|> FieldInfo.make metadataReader.GetString field
|> FieldInfo.make metadataReader assy.Name field
result.Add (field, fieldDefn)

5
WoofWare.PawPrint/AssemblyReference.fs
View File

@@ -6,7 +6,8 @@ open System.Reflection.Metadata
type AssemblyReference =
{
Handle : AssemblyReferenceHandle
/// A handle relative to the specified assembly.
Handle : AssemblyReferenceHandle * AssemblyName
Culture : StringToken
Flags : AssemblyFlags
Name : AssemblyName
@@ -16,7 +17,7 @@ type AssemblyReference =
[<RequireQualifiedAccess>]
module AssemblyReference =
let make
(handle : AssemblyReferenceHandle)
(handle : AssemblyReferenceHandle * AssemblyName)
(ref : System.Reflection.Metadata.AssemblyReference)
: AssemblyReference
=

36
WoofWare.PawPrint/FieldInfo.fs
View File

@@ -1,12 +1,14 @@
namespace WoofWare.PawPrint
open System
open System.Reflection
open System.Reflection.Metadata
/// <summary>
/// Represents detailed information about a field in a .NET assembly.
/// This is a strongly-typed representation of FieldDefinition from System.Reflection.Metadata.
/// </summary>
type FieldInfo =
type FieldInfo<'typeGeneric when 'typeGeneric : comparison and 'typeGeneric :> IComparable<'typeGeneric>> =
{
/// <summary>
/// The metadata token handle that uniquely identifies this field in the assembly.
@@ -19,7 +21,7 @@ type FieldInfo =
/// <summary>
/// The type that declares this field.
/// </summary>
DeclaringType : TypeDefinitionHandle
DeclaringType : ConcreteType<'typeGeneric>
/// <summary>
/// The type of the field.
@@ -30,20 +32,42 @@ type FieldInfo =
/// The attributes applied to this field, including visibility, static/instance,
/// literal, and other characteristics.
/// </summary>
Attributes : System.Reflection.FieldAttributes
Attributes : FieldAttributes
}
[<RequireQualifiedAccess>]
module FieldInfo =
let make (getString : StringHandle -> string) (handle : FieldDefinitionHandle) (def : FieldDefinition) : FieldInfo =
let name = getString def.Name
let make
(mr : MetadataReader)
(assembly : AssemblyName)
(handle : FieldDefinitionHandle)
(def : FieldDefinition)
: FieldInfo<FakeUnit>
=
let name = mr.GetString def.Name
let fieldSig = def.DecodeSignature (TypeDefn.typeProvider, ())
let declaringType = def.GetDeclaringType ()
let typeGenerics = mr.GetTypeDefinition(declaringType).GetGenericParameters().Count
{
Name = name
Signature = fieldSig
DeclaringType = declaringType
DeclaringType = ConcreteType.make' assembly declaringType typeGenerics
Handle = handle
Attributes = def.Attributes
}
let mapTypeGenerics<'a, 'b
when 'a :> IComparable<'a> and 'a : comparison and 'b :> IComparable<'b> and 'b : comparison>
(f : int -> 'a -> 'b)
(input : FieldInfo<'a>)
: FieldInfo<'b>
=
{
Handle = input.Handle
Name = input.Name
DeclaringType = input.DeclaringType |> ConcreteType.mapGeneric f
Signature = input.Signature
Attributes = input.Attributes
}

64
WoofWare.PawPrint/IlMachineState.fs
View File

@@ -23,20 +23,34 @@ type IlMachineState =
/// Tracks initialization state of types across assemblies
TypeInitTable : TypeInitTable
/// For each type, specialised to each set of generic args, a map of string field name to static value contained therein.
Statics : ImmutableDictionary<RuntimeConcreteType, ImmutableDictionary<string, CliType>>
_Statics : ImmutableDictionary<ConcreteType<FakeUnit>, ImmutableDictionary<string, CliType>>
DotnetRuntimeDirs : string ImmutableArray
}
member this.SetStatic (ty : RuntimeConcreteType) (field : string) (value : CliType) : IlMachineState =
// Static variables are shared among all instantiations of a generic type.
let ty = ty |> ConcreteType.mapGeneric (fun _ _ -> FakeUnit.FakeUnit)
let statics =
match this.Statics.TryGetValue ty with
| false, _ -> this.Statics.Add (ty, ImmutableDictionary.Create().Add (field, value))
| true, v -> this.Statics.SetItem (ty, v.SetItem (field, value))
match this._Statics.TryGetValue ty with
| false, _ -> this._Statics.Add (ty, ImmutableDictionary.Create().Add (field, value))
| true, v -> this._Statics.SetItem (ty, v.SetItem (field, value))
{ this with
Statics = statics
_Statics = statics
}
member this.GetStatic (ty : RuntimeConcreteType) (field : string) : CliType option =
// Static variables are shared among all instantiations of a generic type.
let ty = ty |> ConcreteType.mapGeneric (fun _ _ -> FakeUnit.FakeUnit)
match this._Statics.TryGetValue ty with
| false, _ -> None
| true, v ->
match v.TryGetValue field with
| false, _ -> None
| true, v -> Some v
member this.WithTypeBeginInit (thread : ThreadId) (ty : RuntimeConcreteType) =
this.Logger.LogDebug (
"Beginning initialisation of type {s_Assembly}.{TypeName}, handle {TypeDefinitionHandle}",
@@ -198,7 +212,13 @@ module IlMachineState =
match Assembly.resolveTypeFromName assy state._LoadedAssemblies ns name with
| TypeResolutionResult.Resolved (assy, typeDef) -> state, assy, typeDef
| TypeResolutionResult.FirstLoadAssy loadFirst ->
let state, _, _ = loadAssembly loggerFactory assy loadFirst.Handle state
let state, _, _ =
loadAssembly
loggerFactory
state._LoadedAssemblies.[snd(loadFirst.Handle).FullName]
(fst loadFirst.Handle)
state
resolveTypeFromName loggerFactory ns name assy state
and resolveTypeFromExport
@@ -211,8 +231,14 @@ module IlMachineState =
match Assembly.resolveTypeFromExport fromAssembly state._LoadedAssemblies ty with
| TypeResolutionResult.Resolved (assy, typeDef) -> state, assy, typeDef
| TypeResolutionResult.FirstLoadAssy loadFirst ->
let state, _, _ = loadAssembly loggerFactory fromAssembly loadFirst.Handle state
resolveTypeFromExport loggerFactory fromAssembly ty state
let state, targetAssy, _ =
loadAssembly
loggerFactory
state._LoadedAssemblies.[snd(loadFirst.Handle).FullName]
(fst loadFirst.Handle)
state
resolveTypeFromName loggerFactory ty.Namespace ty.Name targetAssy state
and resolveTypeFromRef
(loggerFactory : ILoggerFactory)
@@ -225,7 +251,11 @@ module IlMachineState =
| TypeResolutionResult.Resolved (assy, typeDef) -> state, assy, typeDef
| TypeResolutionResult.FirstLoadAssy loadFirst ->
let state, _, _ =
loadAssembly loggerFactory referencedInAssembly loadFirst.Handle state
loadAssembly
loggerFactory
(state._LoadedAssemblies.[snd(loadFirst.Handle).FullName])
(fst loadFirst.Handle)
state
resolveTypeFromRef loggerFactory referencedInAssembly target state
@@ -295,7 +325,9 @@ module IlMachineState =
match CliType.zeroOf state._LoadedAssemblies assy generics ty with
| CliTypeResolutionResult.Resolved result -> state, result
| CliTypeResolutionResult.FirstLoad ref ->
let state, _, _ = loadAssembly loggerFactory assy ref.Handle state
let state, _, _ =
loadAssembly loggerFactory state._LoadedAssemblies.[snd(ref.Handle).FullName] (fst ref.Handle) state
cliTypeZeroOf loggerFactory assy ty generics state
let callMethod
@@ -368,7 +400,7 @@ module IlMachineState =
loadAssembly
loggerFactory
(state.LoadedAssembly methodToCall.DeclaringType.Assembly |> Option.get)
toLoad.Handle
(fst toLoad.Handle)
state
state
@@ -429,7 +461,7 @@ module IlMachineState =
loadAssembly
loggerFactory
(state.LoadedAssembly methodToCall.DeclaringType.Assembly |> Option.get)
toLoad.Handle
(fst toLoad.Handle)
state
state
@@ -651,7 +683,7 @@ module IlMachineState =
ThreadState = Map.empty
InternedStrings = ImmutableDictionary.Empty
_LoadedAssemblies = ImmutableDictionary.Empty
Statics = ImmutableDictionary.Empty
_Statics = ImmutableDictionary.Empty
TypeInitTable = ImmutableDictionary.Empty
DotnetRuntimeDirs = dotnetRuntimeDirs
}
@@ -857,7 +889,9 @@ module IlMachineState =
(assy : DumpedAssembly)
(m : MemberReferenceHandle)
(state : IlMachineState)
: IlMachineState * AssemblyName * Choice<WoofWare.PawPrint.MethodInfo<TypeDefn>, WoofWare.PawPrint.FieldInfo>
: IlMachineState *
AssemblyName *
Choice<WoofWare.PawPrint.MethodInfo<TypeDefn>, WoofWare.PawPrint.FieldInfo<TypeDefn>>
=
// TODO: do we need to initialise the parent class here?
let mem = assy.Members.[m]
@@ -882,7 +916,7 @@ module IlMachineState =
| [] ->
failwith
$"Could not find field member {memberName} with the right signature on {targetType.Namespace}.{targetType.Name}"
| [ x ] -> x
| [ x ] -> x |> FieldInfo.mapTypeGenerics (fun index _ -> targetType.Generics.[index])
| _ ->
failwith
$"Multiple overloads matching signature for {targetType.Namespace}.{targetType.Name}'s field {memberName}!"

4
WoofWare.PawPrint/TypeInfo.fs
View File

@@ -44,7 +44,7 @@ type TypeInfo<'generic> =
/// <summary>
/// Fields defined in this type.
/// </summary>
Fields : WoofWare.PawPrint.FieldInfo list
Fields : WoofWare.PawPrint.FieldInfo<FakeUnit> list
/// <summary>
/// The base type that this type inherits from, or None for types that don't have a base type
@@ -152,7 +152,7 @@ module TypeInfo =
let fields =
typeDef.GetFields ()
|> Seq.map (fun h -> FieldInfo.make metadataReader.GetString h (metadataReader.GetFieldDefinition h))
|> Seq.map (fun h -> FieldInfo.make metadataReader thisAssembly h (metadataReader.GetFieldDefinition h))
|> Seq.toList
let name = metadataReader.GetString typeDef.Name

160
WoofWare.PawPrint/UnaryMetadataIlOp.fs
View File

@@ -287,20 +287,20 @@ module internal UnaryMetadataIlOp =
let state, declaringType, field =
match metadataToken with
| MetadataToken.FieldDefinition f ->
let field = activeAssy.Fields.[f]
// No generics on a type if we're accessing it by FieldDefinition
let declaringType = ConcreteType.make activeAssy.Name field.DeclaringType []
state, declaringType, field
let field =
activeAssy.Fields.[f]
|> FieldInfo.mapTypeGenerics (fun _ _ -> failwith "no generics allowed in FieldDefinition")
state, field.DeclaringType, field
| t -> failwith $"Unexpectedly asked to store to a non-field: {t}"
do
let logger = loggerFactory.CreateLogger "Stfld"
let declaring = activeAssy.TypeDefs.[field.DeclaringType]
logger.LogInformation (
"Storing in object field {FieldAssembly}.{FieldDeclaringType}.{FieldName} (type {FieldType})",
declaring.Assembly.Name,
declaring.Name,
field.DeclaringType.Assembly.Name,
field.Name,
field.Name,
field.Signature
)
@@ -362,41 +362,42 @@ module internal UnaryMetadataIlOp =
| Stsfld ->
let activeAssy = state.ActiveAssembly thread
let state, field, declaringType =
let state, field =
match metadataToken with
| MetadataToken.FieldDefinition fieldHandle ->
match activeAssy.Fields.TryGetValue fieldHandle with
| false, _ -> failwith "TODO: Stsfld - throw MissingFieldException"
| true, field -> state, field, ConcreteType.make activeAssy.Name field.DeclaringType []
| true, field ->
let field =
field
|> FieldInfo.mapTypeGenerics (fun _ _ -> failwith "no generics allowed in FieldDefinition")
state, field
| MetadataToken.MemberReference mr ->
let state, assy, method =
let state, _, method =
IlMachineState.resolveMember loggerFactory (state.ActiveAssembly thread) mr state
match method with
| Choice1Of2 methodInfo ->
failwith $"unexpectedly asked to store to a non-field method: {methodInfo.Name}"
| Choice2Of2 fieldInfo ->
state,
fieldInfo,
ConcreteType.make
assy
fieldInfo.DeclaringType
(failwith "TODO: refactor FieldInfo to store a Runtime type")
| Choice2Of2 fieldInfo -> state, fieldInfo
| t -> failwith $"Unexpectedly asked to store to a non-field: {t}"
do
let logger = loggerFactory.CreateLogger "Stsfld"
let declaring = state.ActiveAssembly(thread).TypeDefs.[field.DeclaringType]
let declaring =
state.ActiveAssembly(thread).TypeDefs.[field.DeclaringType.Definition.Get]
logger.LogInformation (
"Storing in static field {FieldAssembly}.{FieldDeclaringType}.{FieldName} (type {FieldType})",
declaring.Assembly.Name,
field.DeclaringType.Assembly.Name,
declaring.Name,
field.Name,
field.Signature
)
match IlMachineState.loadClass loggerFactory declaringType thread state with
match IlMachineState.loadClass loggerFactory field.DeclaringType thread state with
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| NothingToDo state ->
@@ -407,13 +408,13 @@ module internal UnaryMetadataIlOp =
loggerFactory
activeAssy
field.Signature
(ImmutableArray.CreateRange declaringType.Generics)
(ImmutableArray.CreateRange field.DeclaringType.Generics)
state
let toStore = EvalStackValue.toCliTypeCoerced zero popped
let state =
state.SetStatic declaringType field.Name toStore
state.SetStatic field.DeclaringType field.Name toStore
|> IlMachineState.advanceProgramCounter thread
state, WhatWeDid.Executed
@@ -421,36 +422,30 @@ module internal UnaryMetadataIlOp =
| Ldfld ->
let activeAssembly = state.ActiveAssembly thread
let state, declaringType, field =
let state, field =
match metadataToken with
| MetadataToken.FieldDefinition f ->
let declaringType =
ConcreteType.make activeAssembly.Name activeAssembly.Fields.[f].DeclaringType []
let field =
activeAssembly.Fields.[f]
|> FieldInfo.mapTypeGenerics (fun _ _ -> failwith "no generics allowed on FieldDefinition")
state, declaringType, activeAssembly.Fields.[f]
state, field
| MetadataToken.MemberReference mr ->
let state, assyName, field =
IlMachineState.resolveMember loggerFactory activeAssembly mr state
match field with
| Choice1Of2 _method -> failwith "member reference was unexpectedly a method"
| Choice2Of2 field ->
let parentTy = state.LoadedAssembly(assyName).Value.TypeDefs.[field.DeclaringType]
if parentTy.Generics.Length > 0 then
failwith "oh no: generics"
let declaringType = ConcreteType.make assyName field.DeclaringType []
state, declaringType, field
| Choice2Of2 field -> state, field
| t -> failwith $"Unexpectedly asked to load from a non-field: {t}"
do
let logger = loggerFactory.CreateLogger "Ldfld"
let declaring = activeAssembly.TypeDefs.[field.DeclaringType]
let declaring = activeAssembly.TypeDefs.[field.DeclaringType.Definition.Get]
logger.LogInformation (
"Loading object field {FieldAssembly}.{FieldDeclaringType}.{FieldName} (type {FieldType})",
declaring.Assembly.Name,
field.DeclaringType.Assembly.Name,
declaring.Name,
field.Name,
field.Signature
@@ -459,7 +454,21 @@ module internal UnaryMetadataIlOp =
let currentObj, state = IlMachineState.popEvalStack thread state
if field.Attributes.HasFlag FieldAttributes.Static then
let staticField = state.Statics.[declaringType].[field.Name]
let state, staticField =
match state.GetStatic field.DeclaringType field.Name with
| Some v -> state, v
| None ->
let state, zero =
IlMachineState.cliTypeZeroOf
loggerFactory
(state.LoadedAssembly(field.DeclaringType.Assembly).Value)
field.Signature
(ImmutableArray.CreateRange field.DeclaringType.Generics)
state
let state = state.SetStatic field.DeclaringType field.Name zero
state, zero
let state = state |> IlMachineState.pushToEvalStack staticField thread
state, WhatWeDid.Executed
else
@@ -496,67 +505,59 @@ module internal UnaryMetadataIlOp =
let activeAssy = state.ActiveAssembly thread
let field, declaringType =
let field =
match metadataToken with
| MetadataToken.FieldDefinition fieldHandle ->
match activeAssy.Fields.TryGetValue fieldHandle with
| false, _ -> failwith "TODO: Ldsfld - throw MissingFieldException"
| true, field ->
// FieldDefinition won't come on a generic type
field, ConcreteType.make activeAssy.Name field.DeclaringType []
field
|> FieldInfo.mapTypeGenerics (fun _ _ -> failwith "generics not allowed in FieldDefinition")
| t -> failwith $"Unexpectedly asked to load from a non-field: {t}"
do
let declaring =
state.LoadedAssembly (declaringType.Assembly)
state.LoadedAssembly field.DeclaringType.Assembly
|> Option.get
|> fun a -> a.TypeDefs.[declaringType.Definition.Get]
|> fun a -> a.TypeDefs.[field.DeclaringType.Definition.Get]
logger.LogInformation (
"Loading from static field {FieldAssembly}.{FieldDeclaringType}.{FieldName} (type {FieldType})",
declaring.Assembly.Name,
field.DeclaringType.Assembly.Name,
declaring.Name,
field.Name,
field.Signature
)
match IlMachineState.loadClass loggerFactory declaringType thread state with
match IlMachineState.loadClass loggerFactory field.DeclaringType thread state with
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| NothingToDo state ->
let fieldValue, state =
match state.Statics.TryGetValue declaringType with
| false, _ ->
match state.GetStatic field.DeclaringType field.Name with
| None ->
let state, newVal =
IlMachineState.cliTypeZeroOf
loggerFactory
activeAssy
field.Signature
(declaringType.Generics |> ImmutableArray.CreateRange)
(field.DeclaringType.Generics |> ImmutableArray.CreateRange)
state
newVal, state.SetStatic declaringType field.Name newVal
| true, v ->
match v.TryGetValue field.Name with
| true, v -> v, state
| false, _ ->
let state, newVal =
IlMachineState.cliTypeZeroOf
loggerFactory
activeAssy
field.Signature
(declaringType.Generics |> ImmutableArray.CreateRange)
state
newVal, state.SetStatic declaringType field.Name newVal
newVal, state.SetStatic field.DeclaringType field.Name newVal
| Some v -> v, state
do
let logger = loggerFactory.CreateLogger "Ldsfld"
let declaring = state.ActiveAssembly(thread).TypeDefs.[field.DeclaringType]
let declaring =
state
.LoadedAssembly(field.DeclaringType.Assembly)
.Value.TypeDefs.[field.DeclaringType.Definition.Get]
logger.LogInformation (
"Loaded from static field {FieldAssembly}.{FieldDeclaringType}.{FieldName} (type {FieldType}), value {LoadedValue}",
declaring.Assembly.Name,
field.DeclaringType.Assembly.Name,
declaring.Name,
field.Name,
field.Signature,
@@ -578,47 +579,42 @@ module internal UnaryMetadataIlOp =
// TODO: check whether we should throw FieldAccessException
let field, declaringType =
let field =
match metadataToken with
| MetadataToken.FieldDefinition fieldHandle ->
match activeAssy.Fields.TryGetValue fieldHandle with
| false, _ -> failwith "TODO: Ldsflda - throw MissingFieldException"
| true, field ->
// FieldDefinition is not found on generic type
field, ConcreteType.make activeAssy.Name field.DeclaringType []
field
|> FieldInfo.mapTypeGenerics (fun _ _ -> failwith "generics not allowed on FieldDefinition")
| t -> failwith $"Unexpectedly asked to load a non-field: {t}"
match IlMachineState.loadClass loggerFactory declaringType thread state with
match IlMachineState.loadClass loggerFactory field.DeclaringType thread state with
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| NothingToDo state ->
if TypeDefn.isManaged field.Signature then
let allocateStatic () =
match state.GetStatic field.DeclaringType field.Name with
| Some v ->
IlMachineState.pushToEvalStack v thread state
|> IlMachineState.advanceProgramCounter thread
|> Tuple.withRight WhatWeDid.Executed
| None ->
// Field is not yet initialised
let state, zero =
IlMachineState.cliTypeZeroOf
loggerFactory
activeAssy
field.Signature
(declaringType.Generics |> ImmutableArray.CreateRange)
(field.DeclaringType.Generics |> ImmutableArray.CreateRange)
state
state.SetStatic declaringType field.Name zero
state.SetStatic field.DeclaringType field.Name zero
|> IlMachineState.pushToEvalStack (CliType.ObjectRef None) thread
|> Tuple.withRight WhatWeDid.Executed
match state.Statics.TryGetValue declaringType with
| true, v ->
match v.TryGetValue field.Name with
| true, v ->
IlMachineState.pushToEvalStack v thread state
|> IlMachineState.advanceProgramCounter thread
|> Tuple.withRight WhatWeDid.Executed
| false, _ ->
// Field has not yet been initialised.
allocateStatic ()
| false, _ -> allocateStatic ()
else
failwith "TODO: Ldsflda - push unmanaged pointer"
| Ldftn -> failwith "TODO: Ldftn unimplemented"
| Stobj -> failwith "TODO: Stobj unimplemented"
| Constrained -> failwith "TODO: Constrained unimplemented"

2
WoofWare.PawPrint/WoofWare.PawPrint.fsproj
View File

@@ -18,8 +18,8 @@
<Compile Include="ComparableTypeDefinitionHandle.fs" />
<Compile Include="ComparableSignatureHeader.fs" />
<Compile Include="TypeDefn.fs" />
<Compile Include="FieldInfo.fs" />
<Compile Include="ConcreteType.fs" />
<Compile Include="FieldInfo.fs" />
<Compile Include="MethodInfo.fs" />
<Compile Include="TypeInfo.fs" />
<Compile Include="MethodSpec.fs" />