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

Interface dispatch (#100)

Browse Source
This commit is contained in:
Patrick Stevens
2025-08-23 22:43:57 +01:00
committed by GitHub
parent 2190f148e1
commit 9afc7efea1
15 changed files with 849 additions and 198 deletions
Download Patch File Download Diff File Expand all files Collapse all files

71
WoofWare.PawPrint.Domain/TypeConcretisation.fs
View File

@@ -53,7 +53,7 @@ module AllConcreteTypes =
let findExistingConcreteType
(concreteTypes : AllConcreteTypes)
(asm : AssemblyName, ns : string, name : string, generics : ConcreteTypeHandle ImmutableArray as key)
(asm : AssemblyName, ns : string, name : string, generics : ConcreteTypeHandle ImmutableArray)
: ConcreteTypeHandle option
=
concreteTypes.Mapping
@@ -166,6 +166,40 @@ module ConcreteActivePatterns =
| _ -> None
| _ -> None
let (|ConcreteObj|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) : unit option =
match handle with
| ConcreteTypeHandle.Concrete id ->
match concreteTypes.Mapping |> Map.tryFind id with
| Some ct ->
if
ct.Assembly.Name = "System.Private.CoreLib"
&& ct.Namespace = "System"
&& ct.Name = "Object"
&& ct.Generics.IsEmpty
then
Some ()
else
None
| None -> None
| _ -> None
let (|ConcreteValueType|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) : unit option =
match handle with
| ConcreteTypeHandle.Concrete id ->
match concreteTypes.Mapping |> Map.tryFind id with
| Some ct ->
if
ct.Assembly.Name = "System.Private.CoreLib"
&& ct.Namespace = "System"
&& ct.Name = "ValueType"
&& ct.Generics.IsEmpty
then
Some ()
else
None
| None -> None
| _ -> None
let (|ConcreteBool|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) : unit option =
match handle with
| ConcreteTypeHandle.Concrete id ->
@@ -322,7 +356,7 @@ module TypeConcretization =
(key : AssemblyName * string * string)
: ConcreteTypeHandle option
=
let (asm, ns, name) = key
let asm, ns, name = key
findExistingType concreteTypes asm ns name ImmutableArray.Empty
// Helper function to create and add a ConcreteType to the context
@@ -377,7 +411,7 @@ module TypeConcretization =
// Need to load the assembly
match typeRef.ResolutionScope with
| TypeRefResolutionScope.Assembly assyRef ->
let newAssemblies, loadedAssy = loadAssembly currentAssembly assyRef
let newAssemblies, _ = loadAssembly currentAssembly assyRef
let newCtx =
{ ctx with
@@ -561,8 +595,8 @@ module TypeConcretization =
(loadAssembly :
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
(assembly : AssemblyName)
(typeGenerics : ConcreteTypeHandle ImmutableArray)
(methodGenerics : ConcreteTypeHandle ImmutableArray)
(typeGenerics : ImmutableArray<ConcreteTypeHandle>)
(methodGenerics : ImmutableArray<ConcreteTypeHandle>)
(typeDefn : TypeDefn)
: ConcreteTypeHandle * ConcretizationContext<'corelib>
=
@@ -658,8 +692,8 @@ module TypeConcretization =
(loadAssembly :
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
(assembly : AssemblyName)
(typeGenerics : ConcreteTypeHandle ImmutableArray)
(methodGenerics : ConcreteTypeHandle ImmutableArray)
(typeGenerics : ImmutableArray<ConcreteTypeHandle>)
(methodGenerics : ImmutableArray<ConcreteTypeHandle>)
(genericDef : TypeDefn)
(args : ImmutableArray<TypeDefn>)
: ConcreteTypeHandle * ConcretizationContext<'corelib>
@@ -817,8 +851,8 @@ module Concretization =
(loadAssembly :
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
(assembly : AssemblyName)
(typeArgs : ConcreteTypeHandle ImmutableArray)
(methodArgs : ConcreteTypeHandle ImmutableArray)
(typeArgs : ImmutableArray<ConcreteTypeHandle>)
(methodArgs : ImmutableArray<ConcreteTypeHandle>)
(types : ImmutableArray<TypeDefn>)
: ImmutableArray<ConcreteTypeHandle> * TypeConcretization.ConcretizationContext<'corelib>
=
@@ -841,8 +875,8 @@ module Concretization =
(loadAssembly :
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
(assembly : AssemblyName)
(typeArgs : ConcreteTypeHandle ImmutableArray)
(methodArgs : ConcreteTypeHandle ImmutableArray)
(typeArgs : ImmutableArray<ConcreteTypeHandle>)
(methodArgs : ImmutableArray<ConcreteTypeHandle>)
(signature : TypeMethodSignature<TypeDefn>)
: TypeMethodSignature<ConcreteTypeHandle> * TypeConcretization.ConcretizationContext<'corelib>
=
@@ -859,7 +893,7 @@ module Concretization =
let handle, newCtx =
TypeConcretization.concretizeType ctx loadAssembly assembly typeArgs methodArgs paramType
paramHandles.Add (handle)
paramHandles.Add handle
ctx <- newCtx
let newSignature =
@@ -876,7 +910,7 @@ module Concretization =
/// Helper to ensure base type assembly is loaded
let rec private ensureBaseTypeAssembliesLoaded
(loadAssembly :
AssemblyName -> AssemblyReferenceHandle -> (ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly))
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
(assyName : AssemblyName)
(baseTypeInfo : BaseTypeInfo option)
@@ -910,9 +944,9 @@ module Concretization =
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
(baseTypes : BaseClassTypes<DumpedAssembly>)
(method : WoofWare.PawPrint.MethodInfo<TypeDefn, GenericParamFromMetadata, TypeDefn>)
(typeArgs : ConcreteTypeHandle ImmutableArray)
(methodArgs : ConcreteTypeHandle ImmutableArray)
(method : WoofWare.PawPrint.MethodInfo<'ty, GenericParamFromMetadata, TypeDefn>)
(typeArgs : ImmutableArray<ConcreteTypeHandle>)
(methodArgs : ImmutableArray<ConcreteTypeHandle>)
: WoofWare.PawPrint.MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle> *
AllConcreteTypes *
ImmutableDictionary<string, DumpedAssembly>
@@ -1042,10 +1076,9 @@ module Concretization =
// Map generics to handles
let genericHandles =
method.Generics
|> Seq.mapi (fun i _ -> methodArgs.[i])
|> ImmutableArray.CreateRange
|> ImmutableArray.map (fun (gp, md) -> methodArgs.[gp.SequenceNumber])
let concretizedMethod : MethodInfo<_, _, ConcreteTypeHandle> =
let concretizedMethod : MethodInfo<_, _, _> =
{
DeclaringType = concretizedDeclaringType
Handle = method.Handle

28
WoofWare.PawPrint.Domain/TypeInfo.fs
View File

@@ -1,5 +1,6 @@
namespace WoofWare.PawPrint
open System
open System.Collections.Generic
open System.Collections.Immutable
open System.Reflection
@@ -80,6 +81,8 @@ type TypeInfo<'generic, 'fieldGeneric> =
/// </summary>
TypeDefHandle : TypeDefinitionHandle
DeclaringType : TypeDefinitionHandle
/// <summary>
/// The assembly in which this type is defined.
/// </summary>
@@ -92,6 +95,19 @@ type TypeInfo<'generic, 'fieldGeneric> =
ImplementedInterfaces : InterfaceImplementation ImmutableArray
}
member this.IsInterface = this.TypeAttributes.HasFlag TypeAttributes.Interface
member this.IsNested =
[
TypeAttributes.NestedPublic
TypeAttributes.NestedPrivate
TypeAttributes.NestedFamily
TypeAttributes.NestedAssembly
TypeAttributes.NestedFamANDAssem
TypeAttributes.NestedFamORAssem
]
|> List.exists this.TypeAttributes.HasFlag
override this.ToString () =
$"%s{this.Assembly.Name}.%s{this.Namespace}.%s{this.Name}"
@@ -172,6 +188,15 @@ type BaseClassTypes<'corelib> =
[<RequireQualifiedAccess>]
module TypeInfo =
let rec fullName (get : TypeDefinitionHandle -> TypeInfo<_, _>) (ty : TypeInfo<'a, 'b>) =
if ty.IsNested then
let parent = get ty.DeclaringType |> fullName get
$"%s{parent}.{ty.Name}"
else if not (String.IsNullOrEmpty ty.Namespace) then
$"{ty.Namespace}.{ty.Name}"
else
ty.Name
let withGenerics<'a, 'b, 'field> (gen : 'b ImmutableArray) (t : TypeInfo<'a, 'field>) : TypeInfo<'b, 'field> =
{
Namespace = t.Namespace
@@ -183,6 +208,7 @@ module TypeInfo =
TypeAttributes = t.TypeAttributes
Attributes = t.Attributes
TypeDefHandle = t.TypeDefHandle
DeclaringType = t.DeclaringType
Assembly = t.Assembly
Generics = gen
Events = t.Events
@@ -201,6 +227,7 @@ module TypeInfo =
: TypeInfo<GenericParamFromMetadata, TypeDefn>
=
let typeDef = metadataReader.GetTypeDefinition typeHandle
let declaringType = typeDef.GetDeclaringType ()
let methods = typeDef.GetMethods ()
let methodImpls =
@@ -295,6 +322,7 @@ module TypeInfo =
Generics = genericParams
Events = events
ImplementedInterfaces = interfaces
DeclaringType = declaringType
}
let isBaseType<'corelib>

10
WoofWare.PawPrint.Test/TestPureCases.fs
View File

@@ -56,11 +56,6 @@ module TestPureCases =
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "InterfaceDispatch.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
]
let cases : EndToEndTestCase list =
@@ -150,6 +145,11 @@ module TestPureCases =
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "InterfaceDispatch.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
]
let runTest (case : EndToEndTestCase) : unit =

3
WoofWare.PawPrint.Test/sourcesPure/InterfaceDispatch.cs
View File

@@ -14,8 +14,11 @@ public class InterfaceDispatchTests
result |= TestGenericInterface() << 5;
result |= TestCovariantInterface() << 6;
result |= TestReimplementation() << 7;
// TODO
/*
result |= TestStructInterface() << 8;
result |= TestNullDispatch() << 9;
*/
result |= TestSharedMethodSignature() << 10;
return result;

1
WoofWare.PawPrint/AbstractMachine.fs
View File

@@ -110,6 +110,7 @@ module AbstractMachine =
constructing
false
false
false
methodGenerics
methodPtr
thread

2
WoofWare.PawPrint/EvalStack.fs
View File

@@ -340,3 +340,5 @@ type EvalStack =
let v = EvalStackValue.ofCliType v
EvalStack.Push' v stack
static member PeekNthFromTop (n : int) (stack : EvalStack) : EvalStackValue option = stack.Values |> List.tryItem n

6
WoofWare.PawPrint/Exceptions.fs
View File

@@ -34,7 +34,7 @@ module ExceptionHandling =
/// Check if an exception type matches a catch handler type
let private isExceptionAssignableTo
(exceptionTypeCrate : TypeInfoCrate)
(exceptionType : ConcreteTypeHandle)
(catchTypeToken : MetadataToken)
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
: bool
@@ -46,7 +46,7 @@ module ExceptionHandling =
/// Also returns `isFinally : bool`: whether this is a `finally` block (as opposed to e.g. a `catch`).
let findExceptionHandler
(currentPC : int)
(exceptionTypeCrate : TypeInfoCrate)
(exceptionType : ConcreteTypeHandle)
(method : WoofWare.PawPrint.MethodInfo<'typeGen, 'methodGeneric, 'methodVar>)
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
: (WoofWare.PawPrint.ExceptionRegion * bool) option // handler, isFinally
@@ -62,7 +62,7 @@ module ExceptionHandling =
| ExceptionRegion.Catch (typeToken, offset) ->
if currentPC >= offset.TryOffset && currentPC < offset.TryOffset + offset.TryLength then
// Check if exception type matches
if isExceptionAssignableTo exceptionTypeCrate typeToken assemblies then
if isExceptionAssignableTo exceptionType typeToken assemblies then
Some (region, false)
else
None

248
WoofWare.PawPrint/IlMachineState.fs
View File

@@ -724,12 +724,17 @@ module IlMachineState =
// Otherwise, extract the now-complete object from the heap and push it to the stack directly.
let constructed = state.ManagedHeap.NonArrayObjects.[constructing]
let ty =
AllConcreteTypes.lookup constructed.ConcreteType state.ConcreteTypes
|> Option.get
let ty' =
state.LoadedAssembly (ty.Assembly)
|> Option.get
|> fun a -> a.TypeDefs.[ty.Definition.Get]
let resolvedBaseType =
DumpedAssembly.resolveBaseType
baseClassTypes
state._LoadedAssemblies
constructed.Type.Assembly
constructed.Type.BaseType
DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies ty.Assembly ty'.BaseType
match resolvedBaseType with
| ResolvedBaseType.Delegate
@@ -769,11 +774,62 @@ module IlMachineState =
|> Some
let concretizeMethodWithAllGenerics
(loggerFactory : ILoggerFactory)
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(typeGenerics : ImmutableArray<ConcreteTypeHandle>)
(methodToCall : WoofWare.PawPrint.MethodInfo<'ty, GenericParamFromMetadata, TypeDefn>)
(methodGenerics : ImmutableArray<ConcreteTypeHandle>)
(state : IlMachineState)
: IlMachineState *
WoofWare.PawPrint.MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle> *
ConcreteTypeHandle
=
// Now concretize the entire method
let concretizedMethod, newConcreteTypes, newAssemblies =
Concretization.concretizeMethod
state.ConcreteTypes
(fun assyName ref ->
match state.LoadedAssembly assyName with
| Some currentAssy ->
let targetAssyRef = currentAssy.AssemblyReferences.[ref]
match state.LoadedAssembly targetAssyRef.Name with
| Some _ ->
// Assembly already loaded, return existing state
state._LoadedAssemblies, state._LoadedAssemblies.[targetAssyRef.Name.FullName]
| None ->
// Need to load the assembly
let newState, loadedAssy, _ = loadAssembly loggerFactory currentAssy ref state
newState._LoadedAssemblies, loadedAssy
| None ->
failwithf "Current assembly %s not loaded when trying to resolve reference" assyName.FullName
)
state._LoadedAssemblies
baseClassTypes
methodToCall
typeGenerics
methodGenerics
let state =
{ state with
ConcreteTypes = newConcreteTypes
_LoadedAssemblies = newAssemblies
}
// Get the handle for the declaring type
let declaringTypeHandle =
match AllConcreteTypes.lookup' concretizedMethod.DeclaringType state.ConcreteTypes with
| Some handle -> handle
| None -> failwith "Concretized method's declaring type not found in ConcreteTypes"
state, concretizedMethod, declaringTypeHandle
let concretizeMethodWithTypeGenerics
(loggerFactory : ILoggerFactory)
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(typeGenerics : ImmutableArray<ConcreteTypeHandle>)
(methodToCall : WoofWare.PawPrint.MethodInfo<TypeDefn, GenericParamFromMetadata, TypeDefn>)
(methodToCall : WoofWare.PawPrint.MethodInfo<'ty, GenericParamFromMetadata, TypeDefn>)
(methodGenerics : TypeDefn ImmutableArray option)
(callingAssembly : AssemblyName)
(currentExecutingMethodGenerics : ImmutableArray<ConcreteTypeHandle>)
@@ -807,50 +863,20 @@ module IlMachineState =
state, handles.ToImmutable ()
// Now concretize the entire method
let concretizedMethod, newConcreteTypes, newAssemblies =
Concretization.concretizeMethod
state.ConcreteTypes
(fun assyName ref ->
match state.LoadedAssembly assyName with
| Some currentAssy ->
let targetAssyRef = currentAssy.AssemblyReferences.[ref]
match state.LoadedAssembly targetAssyRef.Name with
| Some _ ->
// Assembly already loaded, return existing state
state._LoadedAssemblies, state._LoadedAssemblies.[targetAssyRef.Name.FullName]
| None ->
// Need to load the assembly
let newState, loadedAssy, _ = loadAssembly loggerFactory currentAssy ref state
newState._LoadedAssemblies, loadedAssy
| None ->
failwithf "Current assembly %s not loaded when trying to resolve reference" assyName.FullName
)
state._LoadedAssemblies
baseClassTypes
methodToCall
typeGenerics
concretizedMethodGenerics
let state =
{ state with
ConcreteTypes = newConcreteTypes
_LoadedAssemblies = newAssemblies
}
// Get the handle for the declaring type
let declaringTypeHandle =
match AllConcreteTypes.lookup' concretizedMethod.DeclaringType state.ConcreteTypes with
| Some handle -> handle
| None -> failwith "Concretized method's declaring type not found in ConcreteTypes"
state, concretizedMethod, declaringTypeHandle
concretizeMethodWithAllGenerics
loggerFactory
baseClassTypes
typeGenerics
methodToCall
concretizedMethodGenerics
state
/// Returns also the declaring type.
let concretizeMethodForExecution
(loggerFactory : ILoggerFactory)
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(thread : ThreadId)
(methodToCall : WoofWare.PawPrint.MethodInfo<TypeDefn, GenericParamFromMetadata, TypeDefn>)
(methodToCall : WoofWare.PawPrint.MethodInfo<'ty, GenericParamFromMetadata, TypeDefn>)
(methodGenerics : TypeDefn ImmutableArray option)
(typeArgsFromMetadata : TypeDefn ImmutableArray option)
(state : IlMachineState)
@@ -1115,8 +1141,8 @@ module IlMachineState =
ManagedHeap = heap
}
let allocateManagedObject<'generic, 'field>
(typeInfo : WoofWare.PawPrint.TypeInfo<'generic, 'field>)
let allocateManagedObject
(ty : ConcreteTypeHandle)
(fields : (string * CliType) list)
(state : IlMachineState)
: ManagedHeapAddress * IlMachineState
@@ -1124,7 +1150,7 @@ module IlMachineState =
let o =
{
Fields = Map.ofList fields
Type = TypeInfoCrate.make typeInfo
ConcreteType = ty
SyncBlock = SyncBlock.Free
}
@@ -1309,7 +1335,9 @@ module IlMachineState =
| [] ->
failwith
$"Could not find field member {memberName} with the right signature on {targetType.Namespace}.{targetType.Name}"
| [ x ] -> x |> FieldInfo.mapTypeGenerics (fun index _ -> targetType.Generics.[index])
| [ x ] ->
x
|> FieldInfo.mapTypeGenerics (fun _ (par, md) -> targetType.Generics.[par.SequenceNumber])
| _ ->
failwith
$"Multiple overloads matching signature for {targetType.Namespace}.{targetType.Name}'s field {memberName}!"
@@ -1451,16 +1479,24 @@ module IlMachineState =
}
/// Returns the type handle and an allocated System.RuntimeType.
let getOrAllocateType<'corelib>
(baseClassTypes : BaseClassTypes<'corelib>)
let getOrAllocateType
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(defn : ConcreteTypeHandle)
(state : IlMachineState)
: ManagedHeapAddress * IlMachineState
=
let state, runtimeType =
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make baseClassTypes.RuntimeType.TypeDefHandle,
baseClassTypes.Corelib.Name.FullName,
SignatureTypeKind.Class
)
|> concretizeType baseClassTypes state baseClassTypes.Corelib.Name ImmutableArray.Empty ImmutableArray.Empty
let result, reg, state =
TypeHandleRegistry.getOrAllocate
state
(fun fields state -> allocateManagedObject baseClassTypes.RuntimeType fields state)
(fun fields state -> allocateManagedObject runtimeType fields state)
defn
state.TypeHandles
@@ -1472,9 +1508,9 @@ module IlMachineState =
result, state
/// Returns a System.RuntimeFieldHandle.
let getOrAllocateField<'corelib>
let getOrAllocateField
(loggerFactory : ILoggerFactory)
(baseClassTypes : BaseClassTypes<'corelib>)
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(declaringAssy : AssemblyName)
(fieldHandle : FieldDefinitionHandle)
(state : IlMachineState)
@@ -1493,11 +1529,19 @@ module IlMachineState =
let declaringType, state =
concretizeFieldDeclaringType loggerFactory baseClassTypes declaringTypeWithGenerics state
let state, runtimeType =
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make baseClassTypes.RuntimeType.TypeDefHandle,
baseClassTypes.Corelib.Name.FullName,
SignatureTypeKind.Class
)
|> concretizeType baseClassTypes state baseClassTypes.Corelib.Name ImmutableArray.Empty ImmutableArray.Empty
let result, reg, state =
FieldHandleRegistry.getOrAllocate
baseClassTypes
state
(fun fields state -> allocateManagedObject baseClassTypes.RuntimeType fields state)
(fun fields state -> allocateManagedObject runtimeType fields state)
declaringAssy
declaringType
fieldHandle
@@ -1533,3 +1577,97 @@ module IlMachineState =
match v.TryGetValue field with
| false, _ -> None
| true, v -> Some v
let lookupTypeDefn
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(state : IlMachineState)
(activeAssy : DumpedAssembly)
(typeDef : TypeDefinitionHandle)
: IlMachineState * TypeDefn
=
let defn = activeAssy.TypeDefs.[typeDef]
let baseType =
defn.BaseType
|> DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies defn.Assembly
let signatureTypeKind =
match baseType with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object -> SignatureTypeKind.Class
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
let result =
if defn.Generics.IsEmpty then
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make defn.TypeDefHandle,
defn.Assembly.FullName,
signatureTypeKind
)
else
// Preserve the generic instantiation by converting GenericParameters to TypeDefn.GenericTypeParameter
let genericDef =
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make defn.TypeDefHandle,
defn.Assembly.FullName,
signatureTypeKind
)
let genericArgs =
defn.Generics
|> Seq.mapi (fun i _ -> TypeDefn.GenericTypeParameter i)
|> ImmutableArray.CreateRange
TypeDefn.GenericInstantiation (genericDef, genericArgs)
state, result
let lookupTypeRef
(loggerFactory : ILoggerFactory)
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(state : IlMachineState)
(activeAssy : DumpedAssembly)
typeGenerics
(ref : TypeReferenceHandle)
: IlMachineState * TypeDefn * DumpedAssembly
=
let ref = activeAssy.TypeRefs.[ref]
// Convert ConcreteTypeHandles back to TypeDefn for metadata operations
let typeGenerics =
typeGenerics
|> Seq.map (fun handle ->
Concretization.concreteHandleToTypeDefn
baseClassTypes
handle
state.ConcreteTypes
state._LoadedAssemblies
)
|> ImmutableArray.CreateRange
let state, assy, resolved =
resolveTypeFromRef loggerFactory activeAssy ref typeGenerics state
let baseType =
resolved.BaseType
|> DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies assy.Name
let signatureTypeKind =
match baseType with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object -> SignatureTypeKind.Class
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
let result =
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make resolved.TypeDefHandle,
assy.Name.FullName,
signatureTypeKind
)
if resolved.Generics.IsEmpty then
state, result, assy
else
failwith "TODO: add generics"

337
WoofWare.PawPrint/IlMachineStateExecution.fs
View File

@@ -1,15 +1,104 @@
namespace WoofWare.PawPrint
open System
open System.Collections.Immutable
open System.Reflection
open System.Reflection.Metadata
open System.Runtime.CompilerServices
open Microsoft.Extensions.Logging
[<RequireQualifiedAccess>]
module IlMachineStateExecution =
let getTypeOfObj
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(state : IlMachineState)
(esv : EvalStackValue)
: IlMachineState * ConcreteTypeHandle
=
match esv with
| EvalStackValue.Int32 _ ->
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make baseClassTypes.Int32.TypeDefHandle,
baseClassTypes.Corelib.Name.FullName,
SignatureTypeKind.ValueType
)
|> IlMachineState.concretizeType
baseClassTypes
state
baseClassTypes.Corelib.Name
ImmutableArray.Empty
ImmutableArray.Empty
| EvalStackValue.Int64 _ ->
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make baseClassTypes.Int64.TypeDefHandle,
baseClassTypes.Corelib.Name.FullName,
SignatureTypeKind.ValueType
)
|> IlMachineState.concretizeType
baseClassTypes
state
baseClassTypes.Corelib.Name
ImmutableArray.Empty
ImmutableArray.Empty
| EvalStackValue.NativeInt nativeIntSource -> failwith "todo"
| EvalStackValue.Float _ ->
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make baseClassTypes.Double.TypeDefHandle,
baseClassTypes.Corelib.Name.FullName,
SignatureTypeKind.ValueType
)
|> IlMachineState.concretizeType
baseClassTypes
state
baseClassTypes.Corelib.Name
ImmutableArray.Empty
ImmutableArray.Empty
| EvalStackValue.ManagedPointer src ->
match src with
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.Heap addr ->
let o = ManagedHeap.Get addr state.ManagedHeap
state, o.ConcreteType
| ManagedPointerSource.ArrayIndex (arr, index) -> failwith "todo"
| ManagedPointerSource.Null -> failwith "todo"
| EvalStackValue.ObjectRef addr ->
let o = ManagedHeap.Get addr state.ManagedHeap
state, o.ConcreteType
| EvalStackValue.UserDefinedValueType tuples -> failwith "todo"
let isAssignableFrom
(objToCast : ConcreteTypeHandle)
(possibleTargetType : ConcreteTypeHandle)
(state : IlMachineState)
: bool
=
if objToCast = possibleTargetType then
true
else
let objToCast' = AllConcreteTypes.lookup objToCast state.ConcreteTypes |> Option.get
let possibleTargetType' =
AllConcreteTypes.lookup possibleTargetType state.ConcreteTypes |> Option.get
// TODO: null can be assigned to any reference type; might not be relevant here?
match possibleTargetType with
| ConcreteObj state.ConcreteTypes -> true
| ConcreteValueType state.ConcreteTypes when failwith "check if objToCast inherits ValueType" -> true
| _ ->
// Claude describes the algorithm here:
// https://claude.ai/chat/f15e23f6-a27b-4655-9e69-e4d445dd1249
failwith
$"TODO: check inheritance chain and interfaces: is {objToCast'} assignable from {possibleTargetType'}?"
let callMethod
(loggerFactory : ILoggerFactory)
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(wasInitialising : ConcreteTypeHandle option)
(wasConstructing : ManagedHeapAddress option)
(performInterfaceResolution : bool)
(wasClassConstructor : bool)
(advanceProgramCounterOfCaller : bool)
(methodGenerics : ImmutableArray<ConcreteTypeHandle>)
@@ -19,6 +108,7 @@ module IlMachineStateExecution =
(state : IlMachineState)
: IlMachineState
=
let logger = loggerFactory.CreateLogger "CallMethod"
let activeAssy = state.ActiveAssembly thread
// Check for intrinsics first
@@ -41,6 +131,9 @@ module IlMachineStateExecution =
| Some result -> result
| None ->
if methodToCall.Name = "GetValue" then
printfn ""
// Get zero values for all parameters
let state, argZeroObjects =
((state, []), methodToCall.Signature.ParameterTypes)
@@ -53,6 +146,247 @@ module IlMachineStateExecution =
let activeMethodState = threadState.MethodStates.[threadState.ActiveMethodState]
let state, methodToCall =
match methodToCall.Instructions, performInterfaceResolution, methodToCall.IsStatic with
| None, true, false ->
logger.LogDebug (
"Identifying target of virtual call for {TypeName}.{MethodName}",
methodToCall.DeclaringType.Name,
methodToCall.Name
)
// This might be an interface implementation, or implemented by native code.
// If native code, we'll deal with that when we actually start implementing.
// Since we're not static, there's a `this` on the eval stack.
// It comes *below* all the arguments.
let callingObj =
match
activeMethodState.EvaluationStack
|> EvalStack.PeekNthFromTop methodToCall.Parameters.Length
with
| None -> failwith "unexpectedly no `this` on the eval stack of instance method"
| Some this -> this
let state, callingObjTyHandle = getTypeOfObj baseClassTypes state callingObj
let callingObjTy =
let ty =
AllConcreteTypes.lookup callingObjTyHandle state.ConcreteTypes |> Option.get
state.LoadedAssembly(ty.Assembly).Value.TypeDefs.[ty.Definition.Get]
let declaringAssy = state.LoadedAssembly(methodToCall.DeclaringType.Assembly).Value
let methodDeclaringType =
declaringAssy.TypeDefs.[methodToCall.DeclaringType.Definition.Get]
let interfaceExplicitNamedMethod =
if methodDeclaringType.IsInterface then
Some
$"{TypeInfo.fullName (fun h -> declaringAssy.TypeDefs.[h]) methodDeclaringType}.{methodToCall.Name}"
else
None
// Does type `callingObjTy` implement this method? If so, this is probably a JIT intrinsic or
// is supplied by the runtime.
let selfImplementation, state =
(state, callingObjTy.Methods)
||> List.mapFold (fun state meth ->
if
meth.Signature.GenericParameterCount
<> methodToCall.Signature.GenericParameterCount
|| meth.Signature.RequiredParameterCount
<> methodToCall.Signature.RequiredParameterCount
then
None, state
else if
meth.Name <> methodToCall.Name && Some meth.Name <> interfaceExplicitNamedMethod
then
None, state
else
// TODO: check if methodToCall's declaringtype is an interface; if so, check the possible prefixed name first
let state, retType =
meth.Signature.ReturnType
|> IlMachineState.concretizeType
baseClassTypes
state
meth.DeclaringType.Assembly
methodToCall.DeclaringType.Generics
methodToCall.Generics
let paramTypes, state =
(state, meth.Signature.ParameterTypes)
||> Seq.mapFold (fun state ty ->
ty
|> IlMachineState.concretizeType
baseClassTypes
state
meth.DeclaringType.Assembly
methodToCall.DeclaringType.Generics
methodToCall.Generics
|> fun (a, b) -> b, a
)
let paramTypes = List.ofSeq paramTypes
if
isAssignableFrom retType methodToCall.Signature.ReturnType state
&& paramTypes = methodToCall.Signature.ParameterTypes
then
Some (meth, Some meth.Name = interfaceExplicitNamedMethod), state
else
None, state
)
let selfImplementation =
selfImplementation
|> List.choose id
|> List.sortBy (fun (_, isInterface) -> if isInterface then -1 else 0)
match selfImplementation with
| (impl, true) :: l when (l |> List.forall (fun (_, b) -> not b)) ->
logger.LogDebug "Found concrete implementation from an interface"
let typeGenerics =
AllConcreteTypes.lookup callingObjTyHandle state.ConcreteTypes
|> Option.get
|> _.Generics
let state, meth, _ =
IlMachineState.concretizeMethodWithAllGenerics
loggerFactory
baseClassTypes
typeGenerics
impl
methodGenerics
state
state, meth
| [ impl, false ] ->
logger.LogDebug "Found concrete implementation"
// Yes, callingObjTy implements the method directly. No need to look up interfaces.
let typeGenerics =
AllConcreteTypes.lookup callingObjTyHandle state.ConcreteTypes
|> Option.get
|> _.Generics
let state, meth, _ =
IlMachineState.concretizeMethodWithAllGenerics
loggerFactory
baseClassTypes
typeGenerics
impl
methodGenerics
state
state, meth
| _ :: _ ->
selfImplementation
|> List.map (fun (m, _) -> m.Name)
|> String.concat ", "
|> failwithf "multiple options: %s"
| [] ->
logger.LogDebug "No concrete implementation found; scanning interfaces"
// If not, what interfaces does it implement, and do any of those implement the method?
let possibleInterfaceMethods, state =
(state, callingObjTy.ImplementedInterfaces)
||> Seq.mapFold (fun state impl ->
let assy = state.LoadedAssembly impl.RelativeToAssembly |> Option.get
let state, defn =
match impl.InterfaceHandle with
| MetadataToken.TypeDefinition defn ->
let state, defn = IlMachineState.lookupTypeDefn baseClassTypes state assy defn
let state, _, defn =
// TODO: generics
IlMachineState.resolveTypeFromDefn
loggerFactory
baseClassTypes
defn
ImmutableArray.Empty
ImmutableArray.Empty
assy
state
state, defn
| MetadataToken.TypeReference ty ->
let state, defn, assy =
IlMachineState.lookupTypeRef loggerFactory baseClassTypes state assy Seq.empty ty
state, failwith "TODO"
| MetadataToken.TypeSpecification spec ->
// TODO: generics
let state, assy, defn =
IlMachineState.resolveTypeFromSpec
loggerFactory
baseClassTypes
spec
assy
ImmutableArray.Empty
ImmutableArray.Empty
state
state, defn
| handle -> failwith $"unexpected: {handle}"
logger.LogDebug (
"Interface {InterfaceName} (generics: {InterfaceGenerics})",
defn.Name,
defn.Generics
)
let s, state =
defn.Methods
|> Seq.filter (fun mi -> mi.Name = methodToCall.Name
// TODO: also the rest of the signature
)
|> Seq.mapFold
(fun state meth ->
// TODO: generics
let state, mi, _ =
IlMachineState.concretizeMethodForExecution
loggerFactory
baseClassTypes
thread
meth
None
(if defn.Generics.IsEmpty then None else Some defn.Generics)
state
mi, state
)
state
s, state
)
let possibleInterfaceMethods = possibleInterfaceMethods |> Seq.concat |> Seq.toList
match possibleInterfaceMethods with
| [] ->
logger.LogDebug "No interface implementation found either"
state, methodToCall
| [ meth ] ->
logger.LogDebug (
"Exactly one interface implementation found {DeclaringTypeNamespace}.{DeclaringTypeName}.{MethodName} ({MethodGenerics})",
meth.DeclaringType.Namespace,
meth.DeclaringType.Name,
meth.Name,
meth.Generics
)
state, meth
| _ -> failwith "TODO: handle overloads"
| _, _, true
| _, false, _
| Some _, _, _ -> state, methodToCall
// Helper to pop and coerce a single argument
let popAndCoerceArg zeroType methodState =
let value, newState = MethodState.popFromStack methodState
@@ -425,6 +759,7 @@ module IlMachineStateExecution =
None
true
true
false
// constructor is surely not generic
ImmutableArray.Empty
fullyConvertedMethod
@@ -471,6 +806,7 @@ module IlMachineStateExecution =
(loggerFactory : ILoggerFactory)
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(thread : ThreadId)
(performInterfaceResolution : bool)
(advanceProgramCounterOfCaller : bool)
(methodGenerics : TypeDefn ImmutableArray option)
(methodToCall : WoofWare.PawPrint.MethodInfo<TypeDefn, GenericParamFromMetadata, TypeDefn>)
@@ -501,6 +837,7 @@ module IlMachineStateExecution =
baseClassTypes
None
weAreConstructingObj
performInterfaceResolution
false
advanceProgramCounterOfCaller
concretizedMethod.Generics

21
WoofWare.PawPrint/Intrinsics.fs
View File

@@ -202,6 +202,16 @@ module Intrinsics =
|> IlMachineState.advanceProgramCounter currentThread
|> Some
else
let arg1 = ManagedHeap.Get arg1 state.ManagedHeap
let arg2 = ManagedHeap.Get arg2 state.ManagedHeap
if arg1.Fields.["_firstChar"] <> arg2.Fields.["_firstChar"] then
state
|> IlMachineState.pushToEvalStack (CliType.ofBool false) currentThread
|> IlMachineState.advanceProgramCounter currentThread
|> Some
else
failwith "TODO"
| _ -> None
| "System.Private.CoreLib", "Unsafe", "ReadUnaligned" ->
@@ -278,9 +288,20 @@ module Intrinsics =
failwith $"TODO: do the thing on %O{generic}"
| "System.Private.CoreLib", "RuntimeHelpers", "InitializeArray" ->
// https://github.com/dotnet/runtime/blob/9e5e6aa7bc36aeb2a154709a9d1192030c30a2ef/src/coreclr/System.Private.CoreLib/src/System/Runtime/CompilerServices/RuntimeHelpers.CoreCLR.cs#L18
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
| [ ConcreteNonGenericArray state.ConcreteTypes ; ConcreteRuntimeFieldHandle state.ConcreteTypes ],
ConcreteVoid state.ConcreteTypes -> ()
| _ -> failwith "bad signature for System.Private.CoreLib.RuntimeHelpers.InitializeArray"
failwith "TODO: if arg0 is null, throw NRE"
failwith "TODO: if arg1 contains null handle, throw ArgumentException"
failwith "TODO: array initialization"
| "System.Private.CoreLib", "RuntimeHelpers", "CreateSpan" ->
// https://github.com/dotnet/runtime/blob/9e5e6aa7bc36aeb2a154709a9d1192030c30a2ef/src/libraries/System.Private.CoreLib/src/System/Runtime/CompilerServices/RuntimeHelpers.cs#L153
None
| "System.Private.CoreLib", "Type", "op_Equality" ->
// https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/Type.cs#L703
None
| a, b, c -> failwith $"TODO: implement JIT intrinsic {a}.{b}.{c}"
|> Option.map (fun s -> s.WithThreadSwitchedToAssembly callerAssy currentThread |> fst)

6
WoofWare.PawPrint/ManagedHeap.fs
View File

@@ -9,7 +9,7 @@ type SyncBlock =
type AllocatedNonArrayObject =
{
Fields : Map<string, CliType>
Type : WoofWare.PawPrint.TypeInfoCrate
ConcreteType : ConcreteTypeHandle
SyncBlock : SyncBlock
}
@@ -119,6 +119,10 @@ type ManagedHeap =
arr.Elements.[offset]
static member Get (alloc : ManagedHeapAddress) (heap : ManagedHeap) : AllocatedNonArrayObject =
// TODO: arrays too
heap.NonArrayObjects.[alloc]
static member SetArrayValue
(alloc : ManagedHeapAddress)
(offset : int)

2
WoofWare.PawPrint/NullaryIlOp.fs
View File

@@ -777,7 +777,7 @@ module NullaryIlOp =
match
ExceptionHandling.findExceptionHandler
currentMethodState.IlOpIndex
heapObject.Type
heapObject.ConcreteType
currentMethodState.ExecutingMethod
state._LoadedAssemblies
with

16
WoofWare.PawPrint/Program.fs
View File

@@ -3,6 +3,7 @@ namespace WoofWare.PawPrint
open System
open System.Collections.Immutable
open System.IO
open System.Reflection.Metadata
open Microsoft.Extensions.Logging
[<RequireQualifiedAccess>]
@@ -14,10 +15,23 @@ module Program =
(state : IlMachineState)
: ManagedHeapAddress * IlMachineState
=
let state, stringType =
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make corelib.String.TypeDefHandle,
corelib.Corelib.Name.FullName,
SignatureTypeKind.Class
)
|> IlMachineState.concretizeType
corelib
state
corelib.Corelib.Name
ImmutableArray.Empty
ImmutableArray.Empty
let argsAllocations, state =
(state, args)
||> Seq.mapFold (fun state arg ->
IlMachineState.allocateManagedObject corelib.String (failwith "TODO: assert fields and populate") state
IlMachineState.allocateManagedObject stringType (failwith "TODO: assert fields and populate") state
// TODO: set the char values in memory
)

278
WoofWare.PawPrint/UnaryMetadataIlOp.fs
View File

@@ -7,100 +7,6 @@ open Microsoft.Extensions.Logging
[<RequireQualifiedAccess>]
module internal UnaryMetadataIlOp =
let lookupTypeDefn
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(state : IlMachineState)
(activeAssy : DumpedAssembly)
(typeDef : TypeDefinitionHandle)
: IlMachineState * TypeDefn
=
let defn = activeAssy.TypeDefs.[typeDef]
let baseType =
defn.BaseType
|> DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies defn.Assembly
let signatureTypeKind =
match baseType with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object -> SignatureTypeKind.Class
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
let result =
if defn.Generics.IsEmpty then
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make defn.TypeDefHandle,
defn.Assembly.FullName,
signatureTypeKind
)
else
// Preserve the generic instantiation by converting GenericParameters to TypeDefn.GenericTypeParameter
let genericDef =
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make defn.TypeDefHandle,
defn.Assembly.FullName,
signatureTypeKind
)
let genericArgs =
defn.Generics
|> Seq.mapi (fun i _ -> TypeDefn.GenericTypeParameter i)
|> ImmutableArray.CreateRange
TypeDefn.GenericInstantiation (genericDef, genericArgs)
state, result
let lookupTypeRef
(loggerFactory : ILoggerFactory)
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(state : IlMachineState)
(activeAssy : DumpedAssembly)
typeGenerics
(ref : TypeReferenceHandle)
: IlMachineState * TypeDefn * DumpedAssembly
=
let ref = activeAssy.TypeRefs.[ref]
// Convert ConcreteTypeHandles back to TypeDefn for metadata operations
let typeGenerics =
typeGenerics
|> Seq.map (fun handle ->
Concretization.concreteHandleToTypeDefn
baseClassTypes
handle
state.ConcreteTypes
state._LoadedAssemblies
)
|> ImmutableArray.CreateRange
let state, assy, resolved =
IlMachineState.resolveTypeFromRef loggerFactory activeAssy ref typeGenerics state
let baseType =
resolved.BaseType
|> DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies assy.Name
let signatureTypeKind =
match baseType with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object -> SignatureTypeKind.Class
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
let result =
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make resolved.TypeDefHandle,
assy.Name.FullName,
signatureTypeKind
)
if resolved.Generics.IsEmpty then
state, result, assy
else
failwith "TODO: add generics"
let execute
(loggerFactory : ILoggerFactory)
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
@@ -190,6 +96,7 @@ module internal UnaryMetadataIlOp =
None
None
false
false
true
concretizedMethod.Generics
concretizedMethod
@@ -272,6 +179,7 @@ module internal UnaryMetadataIlOp =
baseClassTypes
thread
true
true
methodGenerics
methodToCall
None
@@ -368,7 +276,15 @@ module internal UnaryMetadataIlOp =
// On completion of the constructor, we'll copy the value back off the heap,
// and put it on the eval stack directly.
let allocatedAddr, state =
IlMachineState.allocateManagedObject ctorType fields state
let ty =
(concretizedCtor.DeclaringType.Assembly,
concretizedCtor.DeclaringType.Namespace,
concretizedCtor.DeclaringType.Name,
concretizedCtor.DeclaringType.Generics)
|> AllConcreteTypes.findExistingConcreteType state.ConcreteTypes
|> Option.get
IlMachineState.allocateManagedObject ty fields state
let state =
state
@@ -383,6 +299,7 @@ module internal UnaryMetadataIlOp =
loggerFactory
baseClassTypes
thread
false
true
None
ctor
@@ -415,11 +332,19 @@ module internal UnaryMetadataIlOp =
let state, elementType, assy =
match metadataToken with
| MetadataToken.TypeDefinition defn ->
let state, resolved = lookupTypeDefn baseClassTypes state activeAssy defn
let state, resolved =
IlMachineState.lookupTypeDefn baseClassTypes state activeAssy defn
state, resolved, activeAssy
| MetadataToken.TypeSpecification spec -> state, activeAssy.TypeSpecs.[spec].Signature, activeAssy
| MetadataToken.TypeReference ref ->
lookupTypeRef loggerFactory baseClassTypes state activeAssy currentMethod.DeclaringType.Generics ref
IlMachineState.lookupTypeRef
loggerFactory
baseClassTypes
state
activeAssy
currentMethod.DeclaringType.Generics
ref
| x -> failwith $"TODO: Newarr element type resolution unimplemented for {x}"
let state, zeroOfType =
@@ -478,7 +403,7 @@ module internal UnaryMetadataIlOp =
| Isinst ->
let actualObj, state = IlMachineState.popEvalStack thread state
let targetType : TypeDefn =
let state, targetType =
match metadataToken with
| MetadataToken.TypeDefinition td ->
let activeAssy = state.ActiveAssembly thread
@@ -498,10 +423,46 @@ module internal UnaryMetadataIlOp =
| ResolvedBaseType.Object -> SignatureTypeKind.Class
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
state,
TypeDefn.FromDefinition (ComparableTypeDefinitionHandle.Make td, activeAssy.Name.FullName, sigType)
| MetadataToken.TypeSpecification handle -> state.ActiveAssembly(thread).TypeSpecs.[handle].Signature
| MetadataToken.TypeSpecification handle ->
state, state.ActiveAssembly(thread).TypeSpecs.[handle].Signature
| MetadataToken.TypeReference handle ->
let state, assy, resol =
IlMachineState.resolveTypeFromRef
loggerFactory
activeAssy
(state.ActiveAssembly(thread).TypeRefs.[handle])
ImmutableArray.Empty
state
let baseTy =
DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies assy.Name resol.BaseType
let sigType =
match baseTy with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object -> SignatureTypeKind.Class
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
state,
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make resol.TypeDefHandle,
assy.Name.FullName,
sigType
)
| m -> failwith $"unexpected metadata token {m} in IsInst"
let state, targetConcreteType =
IlMachineState.concretizeType
baseClassTypes
state
activeAssy.Name
currentMethod.DeclaringType.Generics
currentMethod.Generics
targetType
let returnObj =
match actualObj with
| EvalStackValue.ManagedPointer ManagedPointerSource.Null ->
@@ -511,10 +472,10 @@ module internal UnaryMetadataIlOp =
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) ->
match state.ManagedHeap.NonArrayObjects.TryGetValue addr with
| true, v ->
{ new TypeInfoEval<_> with
member _.Eval typeInfo = failwith "TODO"
}
|> v.Type.Apply
if v.ConcreteType = targetConcreteType then
actualObj
else
failwith $"TODO: is {v.ConcreteType} an instance of {targetType} ({targetConcreteType})"
| false, _ ->
match state.ManagedHeap.Arrays.TryGetValue addr with
@@ -534,7 +495,7 @@ module internal UnaryMetadataIlOp =
| MetadataToken.FieldDefinition f ->
let field =
activeAssy.Fields.[f]
|> FieldInfo.mapTypeGenerics (fun _ _ -> failwith "no generics allowed in FieldDefinition")
|> FieldInfo.mapTypeGenerics (fun _ -> failwith "no generics allowed in FieldDefinition")
state, field
| MetadataToken.MemberReference mr ->
@@ -629,7 +590,7 @@ module internal UnaryMetadataIlOp =
| true, field ->
let field =
field
|> FieldInfo.mapTypeGenerics (fun _ _ -> failwith "no generics allowed in FieldDefinition")
|> FieldInfo.mapTypeGenerics (fun _ -> failwith "no generics allowed in FieldDefinition")
state, field
| MetadataToken.MemberReference mr ->
@@ -693,7 +654,7 @@ module internal UnaryMetadataIlOp =
| MetadataToken.FieldDefinition f ->
let field =
activeAssy.Fields.[f]
|> FieldInfo.mapTypeGenerics (fun _ _ -> failwith "no generics allowed on FieldDefinition")
|> FieldInfo.mapTypeGenerics (fun _ -> failwith "no generics allowed on FieldDefinition")
state, field
| MetadataToken.MemberReference mr ->
@@ -794,7 +755,7 @@ module internal UnaryMetadataIlOp =
| true, field ->
let field =
field
|> FieldInfo.mapTypeGenerics (fun _ _ -> failwith "generics not allowed in FieldDefinition")
|> FieldInfo.mapTypeGenerics (fun _ -> failwith "generics not allowed in FieldDefinition")
state, field
| MetadataToken.MemberReference mr ->
@@ -992,7 +953,7 @@ module internal UnaryMetadataIlOp =
| false, _ -> failwith "TODO: Ldsflda - throw MissingFieldException"
| true, field ->
field
|> FieldInfo.mapTypeGenerics (fun _ _ -> failwith "generics not allowed on FieldDefinition")
|> FieldInfo.mapTypeGenerics (fun _ -> failwith "generics not allowed on FieldDefinition")
| t -> failwith $"Unexpectedly asked to load a non-field: {t}"
let state, declaringTypeHandle, typeGenerics =
@@ -1089,6 +1050,94 @@ module internal UnaryMetadataIlOp =
let ty = baseClassTypes.RuntimeMethodHandle
let field = ty.Fields |> List.exactlyOne
failwith ""
| MetadataToken.TypeSpecification h ->
let ty = baseClassTypes.RuntimeTypeHandle
let field = ty.Fields |> List.exactlyOne
if field.Name <> "m_type" then
failwith $"unexpected field name ${field.Name} for BCL type RuntimeTypeHandle"
let typeGenerics = currentMethod.DeclaringType.Generics
let methodGenerics = currentMethod.Generics
let state, assy, typeDefn =
IlMachineState.resolveTypeFromSpecConcrete
loggerFactory
baseClassTypes
h
activeAssy
typeGenerics
methodGenerics
state
let stk =
match
DumpedAssembly.resolveBaseType
baseClassTypes
state._LoadedAssemblies
assy.Name
typeDefn.BaseType
with
| ResolvedBaseType.ValueType
| ResolvedBaseType.Enum -> SignatureTypeKind.ValueType
| ResolvedBaseType.Delegate
| ResolvedBaseType.Object -> SignatureTypeKind.Class
let typeDefn =
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make typeDefn.TypeDefHandle,
assy.Name.FullName,
stk
)
let state, handle =
IlMachineState.concretizeType
baseClassTypes
state
assy.Name
typeGenerics
methodGenerics
typeDefn
let alloc, state = IlMachineState.getOrAllocateType baseClassTypes handle state
let vt =
{
Fields = [ "m_type", CliType.ObjectRef (Some alloc) ]
}
IlMachineState.pushToEvalStack (CliType.ValueType vt) thread state
| MetadataToken.TypeReference h ->
let ty = baseClassTypes.RuntimeTypeHandle
let field = ty.Fields |> List.exactlyOne
if field.Name <> "m_type" then
failwith $"unexpected field name ${field.Name} for BCL type RuntimeTypeHandle"
let methodGenerics = currentMethod.Generics
let typeGenerics = currentMethod.DeclaringType.Generics
let state, typeDefn, assy =
IlMachineState.lookupTypeRef loggerFactory baseClassTypes state activeAssy typeGenerics h
let state, handle =
IlMachineState.concretizeType
baseClassTypes
state
assy.Name
typeGenerics
methodGenerics
typeDefn
let alloc, state = IlMachineState.getOrAllocateType baseClassTypes handle state
let vt =
{
Fields = [ "m_type", CliType.ObjectRef (Some alloc) ]
}
IlMachineState.pushToEvalStack (CliType.ValueType vt) thread state
| MetadataToken.TypeDefinition h ->
let ty = baseClassTypes.RuntimeTypeHandle
let field = ty.Fields |> List.exactlyOne
@@ -1100,7 +1149,8 @@ module internal UnaryMetadataIlOp =
let typeGenerics = currentMethod.DeclaringType.Generics
let state, typeDefn = lookupTypeDefn baseClassTypes state activeAssy h
let state, typeDefn =
IlMachineState.lookupTypeDefn baseClassTypes state activeAssy h
let state, handle =
IlMachineState.concretizeType
@@ -1130,10 +1180,16 @@ module internal UnaryMetadataIlOp =
let state, ty, assy =
match metadataToken with
| MetadataToken.TypeDefinition h ->
let state, ty = lookupTypeDefn baseClassTypes state activeAssy h
let state, ty = IlMachineState.lookupTypeDefn baseClassTypes state activeAssy h
state, ty, activeAssy
| MetadataToken.TypeReference ref ->
lookupTypeRef loggerFactory baseClassTypes state activeAssy currentMethod.DeclaringType.Generics ref
IlMachineState.lookupTypeRef
loggerFactory
baseClassTypes
state
activeAssy
currentMethod.DeclaringType.Generics
ref
| _ -> failwith $"unexpected token {metadataToken} in Sizeof"
let state, typeHandle =

18
WoofWare.PawPrint/UnaryStringTokenIlOp.fs
View File

@@ -1,6 +1,8 @@
namespace WoofWare.PawPrint
open System.Collections.Immutable
open System.Reflection
open System.Reflection.Metadata
[<RequireQualifiedAccess>]
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
@@ -51,8 +53,20 @@ module internal UnaryStringTokenIlOp =
"_stringLength", CliType.Numeric (CliNumericType.Int32 stringToAllocate.Length)
]
let addr, state =
IlMachineState.allocateManagedObject baseClassTypes.String fields state
let state, stringType =
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make baseClassTypes.String.TypeDefHandle,
baseClassTypes.Corelib.Name.FullName,
SignatureTypeKind.Class
)
|> IlMachineState.concretizeType
baseClassTypes
state
baseClassTypes.Corelib.Name
ImmutableArray.Empty
ImmutableArray.Empty
let addr, state = IlMachineState.allocateManagedObject stringType fields state
addr,
{ state with