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

Split up IlMachineState (#91)

Browse Source
This commit is contained in:
Patrick Stevens
2025-07-03 08:51:48 +01:00
committed by GitHub
parent 2efe9803da
commit 30b8ec990f
8 changed files with 846 additions and 818 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
WoofWare.PawPrint/AbstractMachine.fs
View File

@@ -103,7 +103,7 @@ module AbstractMachine =
let currentThreadState = state.ThreadState.[thread] let currentThreadState = state.ThreadState.[thread]
let state = let state =
IlMachineState.callMethod IlMachineStateExecution.callMethod
loggerFactory loggerFactory
baseClassTypes baseClassTypes
None None

803
WoofWare.PawPrint/IlMachineState.fs
View File

@@ -738,761 +738,6 @@ module IlMachineState =
|> Some |> Some
let private safeIntrinsics =
[
// The IL implementation is fine: https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/Runtime/CompilerServices/Unsafe.cs#L677
"System.Private.CoreLib", "Unsafe", "AsRef"
// https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/String.cs#L739-L750
"System.Private.CoreLib", "String", "get_Length"
// https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/ArgumentNullException.cs#L54
"System.Private.CoreLib", "ArgumentNullException", "ThrowIfNull"
// https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/coreclr/System.Private.CoreLib/src/System/Type.CoreCLR.cs#L82
"System.Private.CoreLib", "Type", "GetTypeFromHandle"
]
|> Set.ofList
let callIntrinsic
(baseClassTypes : BaseClassTypes<_>)
(methodToCall : WoofWare.PawPrint.MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle>)
(currentThread : ThreadId)
(state : IlMachineState)
: IlMachineState option
=
let callerAssy =
state.ThreadState.[currentThread].MethodState.ExecutingMethod.DeclaringType.Assembly
if
methodToCall.DeclaringType.Assembly.Name = "System.Private.CoreLib"
&& methodToCall.DeclaringType.Name = "Volatile"
then
// These are all safely implemented in IL, just inefficient.
// https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/Threading/Volatile.cs#L13
None
elif
Set.contains
(methodToCall.DeclaringType.Assembly.Name, methodToCall.DeclaringType.Name, methodToCall.Name)
safeIntrinsics
then
None
else
match methodToCall.DeclaringType.Assembly.Name, methodToCall.DeclaringType.Name, methodToCall.Name with
| "System.Private.CoreLib", "Type", "get_TypeHandle" ->
// https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/Type.cs#L470
// no args, returns RuntimeTypeHandle, a struct with a single field (a RuntimeType class)
// The thing on top of the stack will be a RuntimeType.
let arg, state = popEvalStack currentThread state
let arg =
let rec go (arg : EvalStackValue) =
match arg with
| EvalStackValue.UserDefinedValueType [ _, s ] -> go s
| EvalStackValue.ManagedPointer ManagedPointerSource.Null -> failwith "TODO: throw NRE"
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) -> Some addr
| s -> failwith $"TODO: called with unrecognised arg %O{s}"
go arg
let state =
pushToEvalStack (CliType.ValueType [ "m_type", CliType.ObjectRef arg ]) currentThread state
|> advanceProgramCounter currentThread
Some state
| "System.Private.CoreLib", "Unsafe", "AsPointer" ->
// Method signature: 1 generic parameter, we take a Byref of that parameter, and return a TypeDefn.Pointer(Void)
let arg, state = popEvalStack currentThread state
let toPush =
match arg with
| EvalStackValue.ManagedPointer ptr ->
match ptr with
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
CliRuntimePointer.Managed (
CliRuntimePointerSource.LocalVariable (sourceThread, methodFrame, whichVar)
)
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
CliRuntimePointer.Managed (
CliRuntimePointerSource.Argument (sourceThread, methodFrame, whichVar)
)
| ManagedPointerSource.Heap managedHeapAddress ->
CliRuntimePointer.Managed (CliRuntimePointerSource.Heap managedHeapAddress)
| ManagedPointerSource.Null -> failwith "todo"
| ManagedPointerSource.ArrayIndex _ -> failwith "TODO"
| x -> failwith $"TODO: Unsafe.AsPointer(%O{x})"
pushToEvalStack (CliType.RuntimePointer toPush) currentThread state
|> advanceProgramCounter currentThread
|> Some
| "System.Private.CoreLib", "BitConverter", "SingleToInt32Bits" ->
let arg, state = popEvalStack currentThread state
let result =
match arg with
| EvalStackValue.Float f -> BitConverter.SingleToInt32Bits (float32<float> f) |> EvalStackValue.Int32
| _ -> failwith "TODO"
state
|> pushToEvalStack' result currentThread
|> advanceProgramCounter currentThread
|> Some
| "System.Private.CoreLib", "BitConverter", "Int32BitsToSingle" ->
let arg, state = popEvalStack currentThread state
let arg =
match arg with
| EvalStackValue.Int32 i -> i
| _ -> failwith "$TODO: {arr}"
let result =
BitConverter.Int32BitsToSingle arg |> CliNumericType.Float32 |> CliType.Numeric
state
|> pushToEvalStack result currentThread
|> advanceProgramCounter currentThread
|> Some
| "System.Private.CoreLib", "BitConverter", "Int64BitsToDouble" ->
let arg, state = popEvalStack currentThread state
let arg =
match arg with
| EvalStackValue.Int64 i -> i
| _ -> failwith "$TODO: {arr}"
let result =
BitConverter.Int64BitsToDouble arg |> CliNumericType.Float64 |> CliType.Numeric
state
|> pushToEvalStack result currentThread
|> advanceProgramCounter currentThread
|> Some
| "System.Private.CoreLib", "BitConverter", "DoubleToInt64Bits" ->
let arg, state = popEvalStack currentThread state
let result =
match arg with
| EvalStackValue.Float f -> BitConverter.DoubleToInt64Bits f |> EvalStackValue.Int64
| _ -> failwith "TODO"
state
|> pushToEvalStack' result currentThread
|> advanceProgramCounter currentThread
|> Some
| "System.Private.CoreLib", "String", "Equals" ->
let arg1, state = popEvalStack currentThread state
let arg1 =
match arg1 with
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> h
| EvalStackValue.Int32 _
| EvalStackValue.Int64 _
| EvalStackValue.Float _ -> failwith $"this isn't a string! {arg1}"
| _ -> failwith $"TODO: %O{arg1}"
let arg2, state = popEvalStack currentThread state
let arg2 =
match arg2 with
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> h
| EvalStackValue.Int32 _
| EvalStackValue.Int64 _
| EvalStackValue.Float _ -> failwith $"this isn't a string! {arg2}"
| _ -> failwith $"TODO: %O{arg2}"
if arg1 = arg2 then
state
|> pushToEvalStack (CliType.OfBool true) currentThread
|> advanceProgramCounter currentThread
|> Some
else
failwith "TODO"
| "System.Private.CoreLib", "Unsafe", "ReadUnaligned" ->
let ptr, state = popEvalStack currentThread state
let v : CliType =
let rec go ptr =
match ptr with
| EvalStackValue.ManagedPointer src ->
match src with
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.Heap managedHeapAddress -> failwith "todo"
| ManagedPointerSource.ArrayIndex (arr, index) -> state |> getArrayValue arr index
| ManagedPointerSource.Null -> failwith "TODO: throw NRE"
| EvalStackValue.NativeInt src -> failwith "TODO"
| EvalStackValue.ObjectRef ptr -> failwith "TODO"
| EvalStackValue.UserDefinedValueType [ _, field ] -> go field
| EvalStackValue.UserDefinedValueType []
| EvalStackValue.UserDefinedValueType (_ :: _ :: _)
| EvalStackValue.Int32 _
| EvalStackValue.Int64 _
| EvalStackValue.Float _ -> failwith $"this isn't a pointer! {ptr}"
go ptr
let state =
state |> pushToEvalStack v currentThread |> advanceProgramCounter currentThread
Some state
| "System.Private.CoreLib", "String", "op_Implicit" ->
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
| [ par ], ret ->
let par = state.ConcreteTypes |> AllConcreteTypes.lookup par |> Option.get
let ret = state.ConcreteTypes |> AllConcreteTypes.lookup ret |> Option.get
if
par.Namespace = "System"
&& par.Name = "String"
&& ret.Namespace = "System"
&& ret.Name = "ReadOnlySpan`1"
then
match ret.Generics with
| [ gen ] ->
let gen = state.ConcreteTypes |> AllConcreteTypes.lookup gen |> Option.get
if gen.Namespace = "System" && gen.Name = "Char" then
// This is just an optimisation
// https://github.com/dotnet/runtime/blob/ab105b51f8b50ec5567d7cfe9001ca54dd6f64c3/src/libraries/System.Private.CoreLib/src/System/String.cs#L363-L366
None
else
failwith "TODO: unexpected params to String.op_Implicit"
| _ -> failwith "TODO: unexpected params to String.op_Implicit"
else
failwith "TODO: unexpected params to String.op_Implicit"
| _ -> failwith "TODO: unexpected params to String.op_Implicit"
| a, b, c -> failwith $"TODO: implement JIT intrinsic {a}.{b}.{c}"
|> Option.map (fun s -> s.WithThreadSwitchedToAssembly callerAssy currentThread |> fst)
let callMethod
(loggerFactory : ILoggerFactory)
(corelib : BaseClassTypes<DumpedAssembly>)
(wasInitialising : ConcreteTypeHandle option)
(wasConstructing : ManagedHeapAddress option)
(wasClassConstructor : bool)
(advanceProgramCounterOfCaller : bool)
(methodGenerics : ImmutableArray<ConcreteTypeHandle>)
(methodToCall : WoofWare.PawPrint.MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle>)
(thread : ThreadId)
(threadState : ThreadState)
(state : IlMachineState)
: IlMachineState
=
let activeAssy = state.ActiveAssembly thread
// Check for intrinsics first
let isIntrinsic =
MethodInfo.isJITIntrinsic
(fun handle ->
match activeAssy.Members.[handle].Parent with
| MetadataToken.TypeReference r -> activeAssy.TypeRefs.[r]
| x -> failwith $"{x}"
)
activeAssy.Methods
methodToCall
match
if isIntrinsic then
callIntrinsic corelib methodToCall thread state
else
None
with
| Some result -> result
| None ->
// Get zero values for all parameters
let state, argZeroObjects =
((state, []), methodToCall.Signature.ParameterTypes)
||> List.fold (fun (state, zeros) tyHandle ->
let zero, state = cliTypeZeroOfHandle state corelib tyHandle
state, zero :: zeros
)
let argZeroObjects = List.rev argZeroObjects
let activeMethodState = threadState.MethodStates.[threadState.ActiveMethodState]
// Helper to pop and coerce a single argument
let popAndCoerceArg zeroType methodState =
let value, newState = MethodState.popFromStack methodState
EvalStackValue.toCliTypeCoerced zeroType value, newState
// Collect arguments based on calling convention
let args, afterPop =
if methodToCall.IsStatic then
// Static method: pop args in reverse order
let args = ImmutableArray.CreateBuilder methodToCall.Parameters.Length
let mutable currentState = activeMethodState
for i = methodToCall.Parameters.Length - 1 downto 0 do
let arg, newState = popAndCoerceArg argZeroObjects.[i] currentState
args.Add arg
currentState <- newState
args.Reverse ()
args.ToImmutable (), currentState
else
// Instance method: handle `this` pointer
let argCount = methodToCall.Parameters.Length
let args = ImmutableArray.CreateBuilder (argCount + 1)
let mutable currentState = activeMethodState
match wasConstructing with
| Some _ ->
// Constructor: `this` is on top of stack, by our own odd little calling convention
// where Newobj puts the object pointer on top
let thisArg, newState =
popAndCoerceArg
(CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null))
currentState
currentState <- newState
// Pop remaining args in reverse
for i = argCount - 1 downto 0 do
let arg, newState = popAndCoerceArg argZeroObjects.[i] currentState
args.Add arg
currentState <- newState
args.Add thisArg
args.Reverse ()
args.ToImmutable (), currentState
| None ->
// Regular instance method: args then `this`
for i = argCount - 1 downto 0 do
let arg, newState = popAndCoerceArg argZeroObjects.[i] currentState
args.Add arg
currentState <- newState
let thisArg, newState =
popAndCoerceArg
(CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null))
currentState
args.Add thisArg
currentState <- newState
args.Reverse ()
args.ToImmutable (), currentState
// Helper to create new frame with assembly loading
let rec createNewFrame state =
let returnInfo =
Some
{
JumpTo = threadState.ActiveMethodState
WasInitialisingType = wasInitialising
WasConstructingObj = wasConstructing
}
match
MethodState.Empty
state.ConcreteTypes
corelib
state._LoadedAssemblies
(state.ActiveAssembly thread)
methodToCall
methodGenerics
args
returnInfo
with
| Ok frame -> state, frame
| Error toLoad ->
let state' =
(state, toLoad)
||> List.fold (fun s (asmRef : WoofWare.PawPrint.AssemblyReference) ->
let s, _, _ =
loadAssembly
loggerFactory
(state.LoadedAssembly methodToCall.DeclaringType.Assembly |> Option.get)
(fst asmRef.Handle)
s
s
)
createNewFrame state'
let state, newFrame = createNewFrame state
let oldFrame =
if wasClassConstructor || not advanceProgramCounterOfCaller then
afterPop
else
afterPop |> MethodState.advanceProgramCounter
let newThreadState =
{ threadState with
MethodStates = threadState.MethodStates.Add(newFrame).SetItem (threadState.ActiveMethodState, oldFrame)
ActiveMethodState = threadState.MethodStates.Length
}
{ state with
ThreadState = state.ThreadState |> Map.add thread newThreadState
}
let rec loadClass
(loggerFactory : ILoggerFactory)
(corelib : BaseClassTypes<DumpedAssembly>)
(ty : ConcreteTypeHandle)
(currentThread : ThreadId)
(state : IlMachineState)
: StateLoadResult
=
let logger = loggerFactory.CreateLogger "LoadClass"
match TypeInitTable.tryGet ty state.TypeInitTable with
| Some TypeInitState.Initialized ->
// Type already initialized; nothing to do
StateLoadResult.NothingToDo state
| Some (TypeInitState.InProgress tid) when tid = currentThread ->
// We're already initializing this type on this thread; just proceed with the initialisation, no extra
// class loading required.
StateLoadResult.NothingToDo state
| Some (TypeInitState.InProgress _) ->
// This is usually signalled by WhatWeDid.Blocked
failwith
"TODO: cross-thread class init synchronization unimplemented - this thread has to wait for the other thread to finish initialisation"
| None ->
// We have work to do!
// Look up the concrete type from the handle
let concreteType =
match AllConcreteTypes.lookup ty state.ConcreteTypes with
| Some ct -> ct
| None -> failwith $"ConcreteTypeHandle {ty} not found in ConcreteTypes mapping"
let state, origAssyName =
state.WithThreadSwitchedToAssembly concreteType.Assembly currentThread
let sourceAssembly = state.LoadedAssembly concreteType.Assembly |> Option.get
let typeDef =
match sourceAssembly.TypeDefs.TryGetValue concreteType.Definition.Get with
| false, _ ->
failwith
$"Failed to find type definition {concreteType.Definition.Get} in {concreteType.Assembly.FullName}"
| true, v -> v
logger.LogDebug ("Resolving type {TypeDefNamespace}.{TypeDefName}", typeDef.Namespace, typeDef.Name)
// First mark as in-progress to detect cycles
let state = state.WithTypeBeginInit currentThread ty
// Check if the type has a base type that needs initialization
let firstDoBaseClass =
match typeDef.BaseType with
| Some baseTypeInfo ->
// Determine if base type is in the same or different assembly
match baseTypeInfo with
| BaseTypeInfo.ForeignAssemblyType _ -> failwith "TODO"
//logger.LogDebug (
// "Resolved base type of {TypeDefNamespace}.{TypeDefName} to foreign assembly {ForeignAssemblyName}",
// typeDef.Namespace,
// typeDef.Name,
// baseAssemblyName.Name
//)
//match loadClass loggerFactory baseTypeHandle baseAssemblyName currentThread state with
//| FirstLoadThis state -> Error state
//| NothingToDo state -> Ok state
| BaseTypeInfo.TypeDef typeDefinitionHandle ->
logger.LogDebug (
"Resolved base type of {TypeDefNamespace}.{TypeDefName} to this assembly, typedef",
typeDef.Namespace,
typeDef.Name
)
// TypeDef won't have any generics; it would be a TypeSpec if it did
// Create a TypeDefn from the TypeDef handle
let baseTypeDefn =
let baseTypeDef = sourceAssembly.TypeDefs.[typeDefinitionHandle]
let baseType =
baseTypeDef.BaseType
|> DumpedAssembly.resolveBaseType corelib state._LoadedAssemblies sourceAssembly.Name
let signatureTypeKind =
match baseType with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make typeDefinitionHandle,
sourceAssembly.Name.FullName,
signatureTypeKind
)
// Concretize the base type
let ctx =
{
TypeConcretization.ConcretizationContext.InProgress = ImmutableDictionary.Empty
TypeConcretization.ConcretizationContext.ConcreteTypes = state.ConcreteTypes
TypeConcretization.ConcretizationContext.LoadedAssemblies = state._LoadedAssemblies
TypeConcretization.ConcretizationContext.BaseTypes = corelib
}
let baseTypeHandle, newCtx =
TypeConcretization.concretizeType
ctx
(fun _ _ -> failwith "getAssembly not needed for base type concretization")
sourceAssembly.Name
(concreteType.Generics |> ImmutableArray.CreateRange) // Use the current type's generics
ImmutableArray.Empty // No method generics
baseTypeDefn
let state =
{ state with
ConcreteTypes = newCtx.ConcreteTypes
}
// Recursively load the base class
match loadClass loggerFactory corelib baseTypeHandle currentThread state with
| FirstLoadThis state -> Error state
| NothingToDo state -> Ok state
| BaseTypeInfo.TypeRef typeReferenceHandle ->
let state, assy, targetType =
// TypeRef won't have any generics; it would be a TypeSpec if it did
resolveType
loggerFactory
typeReferenceHandle
ImmutableArray.Empty
(state.ActiveAssembly currentThread)
state
logger.LogDebug (
"Resolved base type of {TypeDefNamespace}.{TypeDefName} to a typeref in assembly {ResolvedAssemblyName}, {BaseTypeNamespace}.{BaseTypeName}",
typeDef.Namespace,
typeDef.Name,
assy.Name.Name,
targetType.Namespace,
targetType.Name
)
// Create a TypeDefn from the resolved TypeRef
let baseTypeDefn =
let baseType =
targetType.BaseType
|> DumpedAssembly.resolveBaseType corelib state._LoadedAssemblies assy.Name
let signatureTypeKind =
match baseType with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make targetType.TypeDefHandle,
assy.Name.FullName,
signatureTypeKind
)
// Concretize the base type
let ctx =
{
TypeConcretization.ConcretizationContext.InProgress = ImmutableDictionary.Empty
TypeConcretization.ConcretizationContext.ConcreteTypes = state.ConcreteTypes
TypeConcretization.ConcretizationContext.LoadedAssemblies = state._LoadedAssemblies
TypeConcretization.ConcretizationContext.BaseTypes = corelib
}
let baseTypeHandle, newCtx =
TypeConcretization.concretizeType
ctx
(fun _ _ -> failwith "getAssembly not needed for base type concretization")
assy.Name
(concreteType.Generics |> ImmutableArray.CreateRange) // Use the current type's generics
ImmutableArray.Empty // No method generics
baseTypeDefn
let state =
{ state with
ConcreteTypes = newCtx.ConcreteTypes
}
// Recursively load the base class
match loadClass loggerFactory corelib baseTypeHandle currentThread state with
| FirstLoadThis state -> Error state
| NothingToDo state -> Ok state
| BaseTypeInfo.TypeSpec typeSpecificationHandle ->
failwith "TODO: TypeSpec base type loading unimplemented"
| None -> Ok state // No base type (or it's System.Object)
match firstDoBaseClass with
| Error state -> FirstLoadThis state
| Ok state ->
// TODO: also need to initialise all interfaces implemented by the type
// Find the class constructor (.cctor) if it exists
let cctor =
typeDef.Methods
|> List.tryFind (fun method -> method.Name = ".cctor" && method.IsStatic && method.Parameters.IsEmpty)
match cctor with
| Some cctorMethod ->
// Call the class constructor! Note that we *don't* use `callMethodInActiveAssembly`, because that
// performs class loading, but we're already in the middle of loading this class.
// TODO: factor out the common bit.
let currentThreadState = state.ThreadState.[currentThread]
// Convert the method's type generics from TypeDefn to ConcreteTypeHandle
let cctorMethodWithTypeGenerics =
cctorMethod |> MethodInfo.mapTypeGenerics (fun i _ -> concreteType.Generics.[i])
// Convert method generics (should be empty for cctor)
let cctorMethodWithMethodGenerics =
cctorMethodWithTypeGenerics
|> MethodInfo.mapMethodGenerics (fun _ -> failwith "cctor cannot be generic")
// Convert method signature from TypeDefn to ConcreteTypeHandle using concretization
let state, convertedSignature =
cctorMethodWithMethodGenerics.Signature
|> TypeMethodSignature.map
state
(fun state typeDefn ->
// Concretize each TypeDefn in the signature
let ctx =
{
TypeConcretization.ConcretizationContext.InProgress = ImmutableDictionary.Empty
TypeConcretization.ConcretizationContext.ConcreteTypes = state.ConcreteTypes
TypeConcretization.ConcretizationContext.LoadedAssemblies = state._LoadedAssemblies
TypeConcretization.ConcretizationContext.BaseTypes = corelib
}
let handle, ctx =
TypeConcretization.concretizeType
ctx
(fun assyName ref ->
let currentAssy = state.LoadedAssembly assyName |> Option.get
let targetAssy =
currentAssy.AssemblyReferences.[ref].Name
|> state.LoadedAssembly
|> Option.get
state._LoadedAssemblies, targetAssy
)
concreteType.Assembly
(concreteType.Generics |> ImmutableArray.CreateRange)
ImmutableArray.Empty // no method generics for cctor
typeDefn
let state =
{ state with
_LoadedAssemblies = ctx.LoadedAssemblies
ConcreteTypes = ctx.ConcreteTypes
}
state, handle
)
// Convert method instructions (local variables)
let state, convertedInstructions =
match cctorMethodWithMethodGenerics.Instructions with
| None -> state, None
| Some methodInstr ->
let state, convertedLocalVars =
match methodInstr.LocalVars with
| None -> state, None
| Some localVars ->
// Concretize each local variable type
let state, convertedVars =
((state, []), localVars)
||> Seq.fold (fun (state, acc) typeDefn ->
let ctx =
{
TypeConcretization.ConcretizationContext.InProgress =
ImmutableDictionary.Empty
TypeConcretization.ConcretizationContext.ConcreteTypes =
state.ConcreteTypes
TypeConcretization.ConcretizationContext.LoadedAssemblies =
state._LoadedAssemblies
TypeConcretization.ConcretizationContext.BaseTypes = corelib
}
let handle, ctx =
TypeConcretization.concretizeType
ctx
(fun assyName ref ->
let currentAssy = state.LoadedAssembly assyName |> Option.get
let targetAssy =
currentAssy.AssemblyReferences.[ref].Name
|> state.LoadedAssembly
|> Option.get
state._LoadedAssemblies, targetAssy
)
concreteType.Assembly
(concreteType.Generics |> ImmutableArray.CreateRange)
ImmutableArray.Empty // no method generics for cctor
typeDefn
let state =
{ state with
_LoadedAssemblies = ctx.LoadedAssemblies
ConcreteTypes = ctx.ConcreteTypes
}
state, handle :: acc
)
|> Tuple.rmap ImmutableArray.CreateRange
state, Some convertedVars
state, Some (MethodInstructions.setLocalVars convertedLocalVars methodInstr)
let fullyConvertedMethod =
MethodInfo.setMethodVars convertedInstructions convertedSignature cctorMethodWithMethodGenerics
callMethod
loggerFactory
corelib
(Some ty)
None
true
true
// constructor is surely not generic
ImmutableArray.Empty
fullyConvertedMethod
currentThread
currentThreadState
state
|> FirstLoadThis
| None ->
// No constructor, just continue.
// Mark the type as initialized.
let state = state.WithTypeEndInit currentThread ty
// Restore original assembly context if needed
state.WithThreadSwitchedToAssembly origAssyName currentThread
|> fst
|> NothingToDo
let ensureTypeInitialised
(loggerFactory : ILoggerFactory)
(corelib : BaseClassTypes<DumpedAssembly>)
(thread : ThreadId)
(ty : ConcreteTypeHandle)
(state : IlMachineState)
: IlMachineState * WhatWeDid
=
match TypeInitTable.tryGet ty state.TypeInitTable with
| None ->
match loadClass loggerFactory corelib ty thread state with
| NothingToDo state -> state, WhatWeDid.Executed
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| Some TypeInitState.Initialized -> state, WhatWeDid.Executed
| Some (InProgress threadId) ->
if threadId = thread then
// II.10.5.3.2: avoid the deadlock by simply proceeding.
state, WhatWeDid.Executed
else
state, WhatWeDid.BlockedOnClassInit threadId
let concretizeMethodWithTypeGenerics let concretizeMethodWithTypeGenerics
(loggerFactory : ILoggerFactory) (loggerFactory : ILoggerFactory)
(corelib : BaseClassTypes<DumpedAssembly>) (corelib : BaseClassTypes<DumpedAssembly>)
@@ -1781,54 +1026,6 @@ module IlMachineState =
state, declaringHandle, typeGenerics state, declaringHandle, typeGenerics
/// It may be useful to *not* advance the program counter of the caller, e.g. if you're using `callMethodInActiveAssembly`
/// as a convenient way to move to a different method body rather than to genuinely perform a call.
/// (Delegates do this, for example: we get a call to invoke the delegate, and then we implement the delegate as
/// another call to its function pointer.)
let callMethodInActiveAssembly
(loggerFactory : ILoggerFactory)
(corelib : BaseClassTypes<DumpedAssembly>)
(thread : ThreadId)
(advanceProgramCounterOfCaller : bool)
(methodGenerics : TypeDefn ImmutableArray option)
(methodToCall : WoofWare.PawPrint.MethodInfo<TypeDefn, WoofWare.PawPrint.GenericParameter, TypeDefn>)
(weAreConstructingObj : ManagedHeapAddress option)
(typeArgsFromMetadata : TypeDefn ImmutableArray option)
(state : IlMachineState)
: IlMachineState * WhatWeDid
=
let threadState = state.ThreadState.[thread]
let state, concretizedMethod, declaringTypeHandle =
concretizeMethodForExecution
loggerFactory
corelib
thread
methodToCall
methodGenerics
typeArgsFromMetadata
state
let state, typeInit =
ensureTypeInitialised loggerFactory corelib thread declaringTypeHandle state
match typeInit with
| WhatWeDid.Executed ->
callMethod
loggerFactory
corelib
None
weAreConstructingObj
false
advanceProgramCounterOfCaller
concretizedMethod.Generics
concretizedMethod
thread
threadState
state,
WhatWeDid.Executed
| _ -> state, typeInit
let initial let initial
(lf : ILoggerFactory) (lf : ILoggerFactory)
(dotnetRuntimeDirs : ImmutableArray<string>) (dotnetRuntimeDirs : ImmutableArray<string>)

584
WoofWare.PawPrint/IlMachineStateExecution.fs Normal file
View File

@@ -0,0 +1,584 @@
namespace WoofWare.PawPrint
open System.Collections.Immutable
open System.Reflection.Metadata
open Microsoft.Extensions.Logging
module IlMachineStateExecution =
let callMethod
(loggerFactory : ILoggerFactory)
(corelib : BaseClassTypes<DumpedAssembly>)
(wasInitialising : ConcreteTypeHandle option)
(wasConstructing : ManagedHeapAddress option)
(wasClassConstructor : bool)
(advanceProgramCounterOfCaller : bool)
(methodGenerics : ImmutableArray<ConcreteTypeHandle>)
(methodToCall : WoofWare.PawPrint.MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle>)
(thread : ThreadId)
(threadState : ThreadState)
(state : IlMachineState)
: IlMachineState
=
let activeAssy = state.ActiveAssembly thread
// Check for intrinsics first
let isIntrinsic =
MethodInfo.isJITIntrinsic
(fun handle ->
match activeAssy.Members.[handle].Parent with
| MetadataToken.TypeReference r -> activeAssy.TypeRefs.[r]
| x -> failwith $"{x}"
)
activeAssy.Methods
methodToCall
match
if isIntrinsic then
Intrinsics.call corelib methodToCall thread state
else
None
with
| Some result -> result
| None ->
// Get zero values for all parameters
let state, argZeroObjects =
((state, []), methodToCall.Signature.ParameterTypes)
||> List.fold (fun (state, zeros) tyHandle ->
let zero, state = IlMachineState.cliTypeZeroOfHandle state corelib tyHandle
state, zero :: zeros
)
let argZeroObjects = List.rev argZeroObjects
let activeMethodState = threadState.MethodStates.[threadState.ActiveMethodState]
// Helper to pop and coerce a single argument
let popAndCoerceArg zeroType methodState =
let value, newState = MethodState.popFromStack methodState
EvalStackValue.toCliTypeCoerced zeroType value, newState
// Collect arguments based on calling convention
let args, afterPop =
if methodToCall.IsStatic then
// Static method: pop args in reverse order
let args = ImmutableArray.CreateBuilder methodToCall.Parameters.Length
let mutable currentState = activeMethodState
for i = methodToCall.Parameters.Length - 1 downto 0 do
let arg, newState = popAndCoerceArg argZeroObjects.[i] currentState
args.Add arg
currentState <- newState
args.Reverse ()
args.ToImmutable (), currentState
else
// Instance method: handle `this` pointer
let argCount = methodToCall.Parameters.Length
let args = ImmutableArray.CreateBuilder (argCount + 1)
let mutable currentState = activeMethodState
match wasConstructing with
| Some _ ->
// Constructor: `this` is on top of stack, by our own odd little calling convention
// where Newobj puts the object pointer on top
let thisArg, newState =
popAndCoerceArg
(CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null))
currentState
currentState <- newState
// Pop remaining args in reverse
for i = argCount - 1 downto 0 do
let arg, newState = popAndCoerceArg argZeroObjects.[i] currentState
args.Add arg
currentState <- newState
args.Add thisArg
args.Reverse ()
args.ToImmutable (), currentState
| None ->
// Regular instance method: args then `this`
for i = argCount - 1 downto 0 do
let arg, newState = popAndCoerceArg argZeroObjects.[i] currentState
args.Add arg
currentState <- newState
let thisArg, newState =
popAndCoerceArg
(CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null))
currentState
args.Add thisArg
currentState <- newState
args.Reverse ()
args.ToImmutable (), currentState
// Helper to create new frame with assembly loading
let rec createNewFrame state =
let returnInfo =
Some
{
JumpTo = threadState.ActiveMethodState
WasInitialisingType = wasInitialising
WasConstructingObj = wasConstructing
}
match
MethodState.Empty
state.ConcreteTypes
corelib
state._LoadedAssemblies
(state.ActiveAssembly thread)
methodToCall
methodGenerics
args
returnInfo
with
| Ok frame -> state, frame
| Error toLoad ->
let state' =
(state, toLoad)
||> List.fold (fun s (asmRef : WoofWare.PawPrint.AssemblyReference) ->
let s, _, _ =
IlMachineState.loadAssembly
loggerFactory
(state.LoadedAssembly methodToCall.DeclaringType.Assembly |> Option.get)
(fst asmRef.Handle)
s
s
)
createNewFrame state'
let state, newFrame = createNewFrame state
let oldFrame =
if wasClassConstructor || not advanceProgramCounterOfCaller then
afterPop
else
afterPop |> MethodState.advanceProgramCounter
let newThreadState =
{ threadState with
MethodStates = threadState.MethodStates.Add(newFrame).SetItem (threadState.ActiveMethodState, oldFrame)
ActiveMethodState = threadState.MethodStates.Length
}
{ state with
ThreadState = state.ThreadState |> Map.add thread newThreadState
}
let rec loadClass
(loggerFactory : ILoggerFactory)
(corelib : BaseClassTypes<DumpedAssembly>)
(ty : ConcreteTypeHandle)
(currentThread : ThreadId)
(state : IlMachineState)
: StateLoadResult
=
let logger = loggerFactory.CreateLogger "LoadClass"
match TypeInitTable.tryGet ty state.TypeInitTable with
| Some TypeInitState.Initialized ->
// Type already initialized; nothing to do
StateLoadResult.NothingToDo state
| Some (TypeInitState.InProgress tid) when tid = currentThread ->
// We're already initializing this type on this thread; just proceed with the initialisation, no extra
// class loading required.
StateLoadResult.NothingToDo state
| Some (TypeInitState.InProgress _) ->
// This is usually signalled by WhatWeDid.Blocked
failwith
"TODO: cross-thread class init synchronization unimplemented - this thread has to wait for the other thread to finish initialisation"
| None ->
// We have work to do!
// Look up the concrete type from the handle
let concreteType =
match AllConcreteTypes.lookup ty state.ConcreteTypes with
| Some ct -> ct
| None -> failwith $"ConcreteTypeHandle {ty} not found in ConcreteTypes mapping"
let state, origAssyName =
state.WithThreadSwitchedToAssembly concreteType.Assembly currentThread
let sourceAssembly = state.LoadedAssembly concreteType.Assembly |> Option.get
let typeDef =
match sourceAssembly.TypeDefs.TryGetValue concreteType.Definition.Get with
| false, _ ->
failwith
$"Failed to find type definition {concreteType.Definition.Get} in {concreteType.Assembly.FullName}"
| true, v -> v
logger.LogDebug ("Resolving type {TypeDefNamespace}.{TypeDefName}", typeDef.Namespace, typeDef.Name)
// First mark as in-progress to detect cycles
let state = state.WithTypeBeginInit currentThread ty
// Check if the type has a base type that needs initialization
let firstDoBaseClass =
match typeDef.BaseType with
| Some baseTypeInfo ->
// Determine if base type is in the same or different assembly
match baseTypeInfo with
| BaseTypeInfo.ForeignAssemblyType _ -> failwith "TODO"
//logger.LogDebug (
// "Resolved base type of {TypeDefNamespace}.{TypeDefName} to foreign assembly {ForeignAssemblyName}",
// typeDef.Namespace,
// typeDef.Name,
// baseAssemblyName.Name
//)
//match loadClass loggerFactory baseTypeHandle baseAssemblyName currentThread state with
//| FirstLoadThis state -> Error state
//| NothingToDo state -> Ok state
| BaseTypeInfo.TypeDef typeDefinitionHandle ->
logger.LogDebug (
"Resolved base type of {TypeDefNamespace}.{TypeDefName} to this assembly, typedef",
typeDef.Namespace,
typeDef.Name
)
// TypeDef won't have any generics; it would be a TypeSpec if it did
// Create a TypeDefn from the TypeDef handle
let baseTypeDefn =
let baseTypeDef = sourceAssembly.TypeDefs.[typeDefinitionHandle]
let baseType =
baseTypeDef.BaseType
|> DumpedAssembly.resolveBaseType corelib state._LoadedAssemblies sourceAssembly.Name
let signatureTypeKind =
match baseType with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make typeDefinitionHandle,
sourceAssembly.Name.FullName,
signatureTypeKind
)
// Concretize the base type
let ctx =
{
TypeConcretization.ConcretizationContext.InProgress = ImmutableDictionary.Empty
TypeConcretization.ConcretizationContext.ConcreteTypes = state.ConcreteTypes
TypeConcretization.ConcretizationContext.LoadedAssemblies = state._LoadedAssemblies
TypeConcretization.ConcretizationContext.BaseTypes = corelib
}
let baseTypeHandle, newCtx =
TypeConcretization.concretizeType
ctx
(fun _ _ -> failwith "getAssembly not needed for base type concretization")
sourceAssembly.Name
(concreteType.Generics |> ImmutableArray.CreateRange) // Use the current type's generics
ImmutableArray.Empty // No method generics
baseTypeDefn
let state =
{ state with
ConcreteTypes = newCtx.ConcreteTypes
}
// Recursively load the base class
match loadClass loggerFactory corelib baseTypeHandle currentThread state with
| FirstLoadThis state -> Error state
| NothingToDo state -> Ok state
| BaseTypeInfo.TypeRef typeReferenceHandle ->
let state, assy, targetType =
// TypeRef won't have any generics; it would be a TypeSpec if it did
IlMachineState.resolveType
loggerFactory
typeReferenceHandle
ImmutableArray.Empty
(state.ActiveAssembly currentThread)
state
logger.LogDebug (
"Resolved base type of {TypeDefNamespace}.{TypeDefName} to a typeref in assembly {ResolvedAssemblyName}, {BaseTypeNamespace}.{BaseTypeName}",
typeDef.Namespace,
typeDef.Name,
assy.Name.Name,
targetType.Namespace,
targetType.Name
)
// Create a TypeDefn from the resolved TypeRef
let baseTypeDefn =
let baseType =
targetType.BaseType
|> DumpedAssembly.resolveBaseType corelib state._LoadedAssemblies assy.Name
let signatureTypeKind =
match baseType with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make targetType.TypeDefHandle,
assy.Name.FullName,
signatureTypeKind
)
// Concretize the base type
let ctx =
{
TypeConcretization.ConcretizationContext.InProgress = ImmutableDictionary.Empty
TypeConcretization.ConcretizationContext.ConcreteTypes = state.ConcreteTypes
TypeConcretization.ConcretizationContext.LoadedAssemblies = state._LoadedAssemblies
TypeConcretization.ConcretizationContext.BaseTypes = corelib
}
let baseTypeHandle, newCtx =
TypeConcretization.concretizeType
ctx
(fun _ _ -> failwith "getAssembly not needed for base type concretization")
assy.Name
(concreteType.Generics |> ImmutableArray.CreateRange) // Use the current type's generics
ImmutableArray.Empty // No method generics
baseTypeDefn
let state =
{ state with
ConcreteTypes = newCtx.ConcreteTypes
}
// Recursively load the base class
match loadClass loggerFactory corelib baseTypeHandle currentThread state with
| FirstLoadThis state -> Error state
| NothingToDo state -> Ok state
| BaseTypeInfo.TypeSpec typeSpecificationHandle ->
failwith "TODO: TypeSpec base type loading unimplemented"
| None -> Ok state // No base type (or it's System.Object)
match firstDoBaseClass with
| Error state -> FirstLoadThis state
| Ok state ->
// TODO: also need to initialise all interfaces implemented by the type
// Find the class constructor (.cctor) if it exists
let cctor =
typeDef.Methods
|> List.tryFind (fun method -> method.Name = ".cctor" && method.IsStatic && method.Parameters.IsEmpty)
match cctor with
| Some cctorMethod ->
// Call the class constructor! Note that we *don't* use `callMethodInActiveAssembly`, because that
// performs class loading, but we're already in the middle of loading this class.
// TODO: factor out the common bit.
let currentThreadState = state.ThreadState.[currentThread]
// Convert the method's type generics from TypeDefn to ConcreteTypeHandle
let cctorMethodWithTypeGenerics =
cctorMethod |> MethodInfo.mapTypeGenerics (fun i _ -> concreteType.Generics.[i])
// Convert method generics (should be empty for cctor)
let cctorMethodWithMethodGenerics =
cctorMethodWithTypeGenerics
|> MethodInfo.mapMethodGenerics (fun _ -> failwith "cctor cannot be generic")
// Convert method signature from TypeDefn to ConcreteTypeHandle using concretization
let state, convertedSignature =
cctorMethodWithMethodGenerics.Signature
|> TypeMethodSignature.map
state
(fun state typeDefn ->
// Concretize each TypeDefn in the signature
let ctx =
{
TypeConcretization.ConcretizationContext.InProgress = ImmutableDictionary.Empty
TypeConcretization.ConcretizationContext.ConcreteTypes = state.ConcreteTypes
TypeConcretization.ConcretizationContext.LoadedAssemblies = state._LoadedAssemblies
TypeConcretization.ConcretizationContext.BaseTypes = corelib
}
let handle, ctx =
TypeConcretization.concretizeType
ctx
(fun assyName ref ->
let currentAssy = state.LoadedAssembly assyName |> Option.get
let targetAssy =
currentAssy.AssemblyReferences.[ref].Name
|> state.LoadedAssembly
|> Option.get
state._LoadedAssemblies, targetAssy
)
concreteType.Assembly
(concreteType.Generics |> ImmutableArray.CreateRange)
ImmutableArray.Empty // no method generics for cctor
typeDefn
let state =
{ state with
_LoadedAssemblies = ctx.LoadedAssemblies
ConcreteTypes = ctx.ConcreteTypes
}
state, handle
)
// Convert method instructions (local variables)
let state, convertedInstructions =
match cctorMethodWithMethodGenerics.Instructions with
| None -> state, None
| Some methodInstr ->
let state, convertedLocalVars =
match methodInstr.LocalVars with
| None -> state, None
| Some localVars ->
// Concretize each local variable type
let state, convertedVars =
((state, []), localVars)
||> Seq.fold (fun (state, acc) typeDefn ->
let ctx =
{
TypeConcretization.ConcretizationContext.InProgress =
ImmutableDictionary.Empty
TypeConcretization.ConcretizationContext.ConcreteTypes =
state.ConcreteTypes
TypeConcretization.ConcretizationContext.LoadedAssemblies =
state._LoadedAssemblies
TypeConcretization.ConcretizationContext.BaseTypes = corelib
}
let handle, ctx =
TypeConcretization.concretizeType
ctx
(fun assyName ref ->
let currentAssy = state.LoadedAssembly assyName |> Option.get
let targetAssy =
currentAssy.AssemblyReferences.[ref].Name
|> state.LoadedAssembly
|> Option.get
state._LoadedAssemblies, targetAssy
)
concreteType.Assembly
(concreteType.Generics |> ImmutableArray.CreateRange)
ImmutableArray.Empty // no method generics for cctor
typeDefn
let state =
{ state with
_LoadedAssemblies = ctx.LoadedAssemblies
ConcreteTypes = ctx.ConcreteTypes
}
state, handle :: acc
)
|> Tuple.rmap ImmutableArray.CreateRange
state, Some convertedVars
state, Some (MethodInstructions.setLocalVars convertedLocalVars methodInstr)
let fullyConvertedMethod =
MethodInfo.setMethodVars convertedInstructions convertedSignature cctorMethodWithMethodGenerics
callMethod
loggerFactory
corelib
(Some ty)
None
true
true
// constructor is surely not generic
ImmutableArray.Empty
fullyConvertedMethod
currentThread
currentThreadState
state
|> FirstLoadThis
| None ->
// No constructor, just continue.
// Mark the type as initialized.
let state = state.WithTypeEndInit currentThread ty
// Restore original assembly context if needed
state.WithThreadSwitchedToAssembly origAssyName currentThread
|> fst
|> NothingToDo
let ensureTypeInitialised
(loggerFactory : ILoggerFactory)
(corelib : BaseClassTypes<DumpedAssembly>)
(thread : ThreadId)
(ty : ConcreteTypeHandle)
(state : IlMachineState)
: IlMachineState * WhatWeDid
=
match TypeInitTable.tryGet ty state.TypeInitTable with
| None ->
match loadClass loggerFactory corelib ty thread state with
| NothingToDo state -> state, WhatWeDid.Executed
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| Some TypeInitState.Initialized -> state, WhatWeDid.Executed
| Some (InProgress threadId) ->
if threadId = thread then
// II.10.5.3.2: avoid the deadlock by simply proceeding.
state, WhatWeDid.Executed
else
state, WhatWeDid.BlockedOnClassInit threadId
/// It may be useful to *not* advance the program counter of the caller, e.g. if you're using `callMethodInActiveAssembly`
/// as a convenient way to move to a different method body rather than to genuinely perform a call.
/// (Delegates do this, for example: we get a call to invoke the delegate, and then we implement the delegate as
/// another call to its function pointer.)
let callMethodInActiveAssembly
(loggerFactory : ILoggerFactory)
(corelib : BaseClassTypes<DumpedAssembly>)
(thread : ThreadId)
(advanceProgramCounterOfCaller : bool)
(methodGenerics : TypeDefn ImmutableArray option)
(methodToCall : WoofWare.PawPrint.MethodInfo<TypeDefn, WoofWare.PawPrint.GenericParameter, TypeDefn>)
(weAreConstructingObj : ManagedHeapAddress option)
(typeArgsFromMetadata : TypeDefn ImmutableArray option)
(state : IlMachineState)
: IlMachineState * WhatWeDid
=
let threadState = state.ThreadState.[thread]
let state, concretizedMethod, declaringTypeHandle =
IlMachineState.concretizeMethodForExecution
loggerFactory
corelib
thread
methodToCall
methodGenerics
typeArgsFromMetadata
state
let state, typeInit =
ensureTypeInitialised loggerFactory corelib thread declaringTypeHandle state
match typeInit with
| WhatWeDid.Executed ->
callMethod
loggerFactory
corelib
None
weAreConstructingObj
false
advanceProgramCounterOfCaller
concretizedMethod.Generics
concretizedMethod
thread
threadState
state,
WhatWeDid.Executed
| _ -> state, typeInit

236
WoofWare.PawPrint/Intrinsics.fs Normal file
View File

@@ -0,0 +1,236 @@
namespace WoofWare.PawPrint
open System
[<RequireQualifiedAccess>]
module Intrinsics =
let private safeIntrinsics =
[
// The IL implementation is fine: https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/Runtime/CompilerServices/Unsafe.cs#L677
"System.Private.CoreLib", "Unsafe", "AsRef"
// https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/String.cs#L739-L750
"System.Private.CoreLib", "String", "get_Length"
// https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/ArgumentNullException.cs#L54
"System.Private.CoreLib", "ArgumentNullException", "ThrowIfNull"
// https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/coreclr/System.Private.CoreLib/src/System/Type.CoreCLR.cs#L82
"System.Private.CoreLib", "Type", "GetTypeFromHandle"
]
|> Set.ofList
let call
(baseClassTypes : BaseClassTypes<_>)
(methodToCall : WoofWare.PawPrint.MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle>)
(currentThread : ThreadId)
(state : IlMachineState)
: IlMachineState option
=
let callerAssy =
state.ThreadState.[currentThread].MethodState.ExecutingMethod.DeclaringType.Assembly
if
methodToCall.DeclaringType.Assembly.Name = "System.Private.CoreLib"
&& methodToCall.DeclaringType.Name = "Volatile"
then
// These are all safely implemented in IL, just inefficient.
// https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/Threading/Volatile.cs#L13
None
elif
Set.contains
(methodToCall.DeclaringType.Assembly.Name, methodToCall.DeclaringType.Name, methodToCall.Name)
safeIntrinsics
then
None
else
match methodToCall.DeclaringType.Assembly.Name, methodToCall.DeclaringType.Name, methodToCall.Name with
| "System.Private.CoreLib", "Type", "get_TypeHandle" ->
// https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/Type.cs#L470
// no args, returns RuntimeTypeHandle, a struct with a single field (a RuntimeType class)
// The thing on top of the stack will be a RuntimeType.
let arg, state = IlMachineState.popEvalStack currentThread state
let arg =
let rec go (arg : EvalStackValue) =
match arg with
| EvalStackValue.UserDefinedValueType [ _, s ] -> go s
| EvalStackValue.ManagedPointer ManagedPointerSource.Null -> failwith "TODO: throw NRE"
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) -> Some addr
| s -> failwith $"TODO: called with unrecognised arg %O{s}"
go arg
let state =
IlMachineState.pushToEvalStack
(CliType.ValueType [ "m_type", CliType.ObjectRef arg ])
currentThread
state
|> IlMachineState.advanceProgramCounter currentThread
Some state
| "System.Private.CoreLib", "Unsafe", "AsPointer" ->
// Method signature: 1 generic parameter, we take a Byref of that parameter, and return a TypeDefn.Pointer(Void)
let arg, state = IlMachineState.popEvalStack currentThread state
let toPush =
match arg with
| EvalStackValue.ManagedPointer ptr ->
match ptr with
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
CliRuntimePointer.Managed (
CliRuntimePointerSource.LocalVariable (sourceThread, methodFrame, whichVar)
)
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
CliRuntimePointer.Managed (
CliRuntimePointerSource.Argument (sourceThread, methodFrame, whichVar)
)
| ManagedPointerSource.Heap managedHeapAddress ->
CliRuntimePointer.Managed (CliRuntimePointerSource.Heap managedHeapAddress)
| ManagedPointerSource.Null -> failwith "todo"
| ManagedPointerSource.ArrayIndex _ -> failwith "TODO"
| x -> failwith $"TODO: Unsafe.AsPointer(%O{x})"
IlMachineState.pushToEvalStack (CliType.RuntimePointer toPush) currentThread state
|> IlMachineState.advanceProgramCounter currentThread
|> Some
| "System.Private.CoreLib", "BitConverter", "SingleToInt32Bits" ->
let arg, state = IlMachineState.popEvalStack currentThread state
let result =
match arg with
| EvalStackValue.Float f -> BitConverter.SingleToInt32Bits (float32<float> f) |> EvalStackValue.Int32
| _ -> failwith "TODO"
state
|> IlMachineState.pushToEvalStack' result currentThread
|> IlMachineState.advanceProgramCounter currentThread
|> Some
| "System.Private.CoreLib", "BitConverter", "Int32BitsToSingle" ->
let arg, state = IlMachineState.popEvalStack currentThread state
let arg =
match arg with
| EvalStackValue.Int32 i -> i
| _ -> failwith "$TODO: {arr}"
let result =
BitConverter.Int32BitsToSingle arg |> CliNumericType.Float32 |> CliType.Numeric
state
|> IlMachineState.pushToEvalStack result currentThread
|> IlMachineState.advanceProgramCounter currentThread
|> Some
| "System.Private.CoreLib", "BitConverter", "Int64BitsToDouble" ->
let arg, state = IlMachineState.popEvalStack currentThread state
let arg =
match arg with
| EvalStackValue.Int64 i -> i
| _ -> failwith "$TODO: {arr}"
let result =
BitConverter.Int64BitsToDouble arg |> CliNumericType.Float64 |> CliType.Numeric
state
|> IlMachineState.pushToEvalStack result currentThread
|> IlMachineState.advanceProgramCounter currentThread
|> Some
| "System.Private.CoreLib", "BitConverter", "DoubleToInt64Bits" ->
let arg, state = IlMachineState.popEvalStack currentThread state
let result =
match arg with
| EvalStackValue.Float f -> BitConverter.DoubleToInt64Bits f |> EvalStackValue.Int64
| _ -> failwith "TODO"
state
|> IlMachineState.pushToEvalStack' result currentThread
|> IlMachineState.advanceProgramCounter currentThread
|> Some
| "System.Private.CoreLib", "String", "Equals" ->
let arg1, state = IlMachineState.popEvalStack currentThread state
let arg1 =
match arg1 with
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> h
| EvalStackValue.Int32 _
| EvalStackValue.Int64 _
| EvalStackValue.Float _ -> failwith $"this isn't a string! {arg1}"
| _ -> failwith $"TODO: %O{arg1}"
let arg2, state = IlMachineState.popEvalStack currentThread state
let arg2 =
match arg2 with
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> h
| EvalStackValue.Int32 _
| EvalStackValue.Int64 _
| EvalStackValue.Float _ -> failwith $"this isn't a string! {arg2}"
| _ -> failwith $"TODO: %O{arg2}"
if arg1 = arg2 then
state
|> IlMachineState.pushToEvalStack (CliType.OfBool true) currentThread
|> IlMachineState.advanceProgramCounter currentThread
|> Some
else
failwith "TODO"
| "System.Private.CoreLib", "Unsafe", "ReadUnaligned" ->
let ptr, state = IlMachineState.popEvalStack currentThread state
let v : CliType =
let rec go ptr =
match ptr with
| EvalStackValue.ManagedPointer src ->
match src with
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.Heap managedHeapAddress -> failwith "todo"
| ManagedPointerSource.ArrayIndex (arr, index) ->
state |> IlMachineState.getArrayValue arr index
| ManagedPointerSource.Null -> failwith "TODO: throw NRE"
| EvalStackValue.NativeInt src -> failwith "TODO"
| EvalStackValue.ObjectRef ptr -> failwith "TODO"
| EvalStackValue.UserDefinedValueType [ _, field ] -> go field
| EvalStackValue.UserDefinedValueType []
| EvalStackValue.UserDefinedValueType (_ :: _ :: _)
| EvalStackValue.Int32 _
| EvalStackValue.Int64 _
| EvalStackValue.Float _ -> failwith $"this isn't a pointer! {ptr}"
go ptr
let state =
state
|> IlMachineState.pushToEvalStack v currentThread
|> IlMachineState.advanceProgramCounter currentThread
Some state
| "System.Private.CoreLib", "String", "op_Implicit" ->
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
| [ par ], ret ->
let par = state.ConcreteTypes |> AllConcreteTypes.lookup par |> Option.get
let ret = state.ConcreteTypes |> AllConcreteTypes.lookup ret |> Option.get
if
par.Namespace = "System"
&& par.Name = "String"
&& ret.Namespace = "System"
&& ret.Name = "ReadOnlySpan`1"
then
match ret.Generics with
| [ gen ] ->
let gen = state.ConcreteTypes |> AllConcreteTypes.lookup gen |> Option.get
if gen.Namespace = "System" && gen.Name = "Char" then
// This is just an optimisation
// https://github.com/dotnet/runtime/blob/ab105b51f8b50ec5567d7cfe9001ca54dd6f64c3/src/libraries/System.Private.CoreLib/src/System/String.cs#L363-L366
None
else
failwith "TODO: unexpected params to String.op_Implicit"
| _ -> failwith "TODO: unexpected params to String.op_Implicit"
else
failwith "TODO: unexpected params to String.op_Implicit"
| _ -> failwith "TODO: unexpected params to String.op_Implicit"
| a, b, c -> failwith $"TODO: implement JIT intrinsic {a}.{b}.{c}"
|> Option.map (fun s -> s.WithThreadSwitchedToAssembly callerAssy currentThread |> fst)

8
WoofWare.PawPrint/Program.fs
View File

@@ -249,7 +249,11 @@ module Program =
let rec loadInitialState (state : IlMachineState) = let rec loadInitialState (state : IlMachineState) =
match match
state state
|> IlMachineState.loadClass loggerFactory (Option.toObj baseClassTypes) mainTypeHandle mainThread |> IlMachineStateExecution.loadClass
loggerFactory
(Option.toObj baseClassTypes)
mainTypeHandle
mainThread
with with
| StateLoadResult.NothingToDo ilMachineState -> ilMachineState | StateLoadResult.NothingToDo ilMachineState -> ilMachineState
| StateLoadResult.FirstLoadThis ilMachineState -> loadInitialState ilMachineState | StateLoadResult.FirstLoadThis ilMachineState -> loadInitialState ilMachineState
@@ -313,7 +317,7 @@ module Program =
{ state with { state with
ThreadState = state.ThreadState |> Map.add mainThread threadState ThreadState = state.ThreadState |> Map.add mainThread threadState
} }
|> IlMachineState.ensureTypeInitialised loggerFactory baseClassTypes mainThread mainTypeHandle |> IlMachineStateExecution.ensureTypeInitialised loggerFactory baseClassTypes mainThread mainTypeHandle
match init with match init with
| WhatWeDid.SuspendedForClassInit -> failwith "TODO: suspended for class init" | WhatWeDid.SuspendedForClassInit -> failwith "TODO: suspended for class init"

23
WoofWare.PawPrint/UnaryMetadataIlOp.fs
View File

@@ -78,14 +78,14 @@ module internal UnaryMetadataIlOp =
typeArgsFromMetadata typeArgsFromMetadata
state state
match IlMachineState.loadClass loggerFactory baseClassTypes declaringTypeHandle thread state with match IlMachineStateExecution.loadClass loggerFactory baseClassTypes declaringTypeHandle thread state with
| NothingToDo state -> | NothingToDo state ->
let state, _ = let state, _ =
state.WithThreadSwitchedToAssembly methodToCall.DeclaringType.Assembly thread state.WithThreadSwitchedToAssembly methodToCall.DeclaringType.Assembly thread
let threadState = state.ThreadState.[thread] let threadState = state.ThreadState.[thread]
IlMachineState.callMethod IlMachineStateExecution.callMethod
loggerFactory loggerFactory
baseClassTypes baseClassTypes
None None
@@ -162,13 +162,13 @@ module internal UnaryMetadataIlOp =
typeArgsFromMetadata typeArgsFromMetadata
state state
match IlMachineState.loadClass loggerFactory baseClassTypes declaringTypeHandle thread state with match IlMachineStateExecution.loadClass loggerFactory baseClassTypes declaringTypeHandle thread state with
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit | FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| NothingToDo state -> | NothingToDo state ->
state.WithThreadSwitchedToAssembly methodToCall.DeclaringType.Assembly thread state.WithThreadSwitchedToAssembly methodToCall.DeclaringType.Assembly thread
|> fst |> fst
|> IlMachineState.callMethodInActiveAssembly |> IlMachineStateExecution.callMethodInActiveAssembly
loggerFactory loggerFactory
baseClassTypes baseClassTypes
thread thread
@@ -219,7 +219,12 @@ module internal UnaryMetadataIlOp =
state state
let state, init = let state, init =
IlMachineState.ensureTypeInitialised loggerFactory baseClassTypes thread declaringTypeHandle state IlMachineStateExecution.ensureTypeInitialised
loggerFactory
baseClassTypes
thread
declaringTypeHandle
state
match init with match init with
| WhatWeDid.BlockedOnClassInit state -> failwith "TODO: another thread is running the initialiser" | WhatWeDid.BlockedOnClassInit state -> failwith "TODO: another thread is running the initialiser"
@@ -275,7 +280,7 @@ module internal UnaryMetadataIlOp =
let state, whatWeDid = let state, whatWeDid =
state.WithThreadSwitchedToAssembly assy thread state.WithThreadSwitchedToAssembly assy thread
|> fst |> fst
|> IlMachineState.callMethodInActiveAssembly |> IlMachineStateExecution.callMethodInActiveAssembly
loggerFactory loggerFactory
baseClassTypes baseClassTypes
thread thread
@@ -643,7 +648,7 @@ module internal UnaryMetadataIlOp =
let state, declaringTypeHandle, typeGenerics = let state, declaringTypeHandle, typeGenerics =
IlMachineState.concretizeFieldForExecution loggerFactory baseClassTypes thread field state IlMachineState.concretizeFieldForExecution loggerFactory baseClassTypes thread field state
match IlMachineState.loadClass loggerFactory baseClassTypes declaringTypeHandle thread state with match IlMachineStateExecution.loadClass loggerFactory baseClassTypes declaringTypeHandle thread state with
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit | FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| NothingToDo state -> | NothingToDo state ->
@@ -806,7 +811,7 @@ module internal UnaryMetadataIlOp =
let state, declaringTypeHandle, typeGenerics = let state, declaringTypeHandle, typeGenerics =
IlMachineState.concretizeFieldForExecution loggerFactory baseClassTypes thread field state IlMachineState.concretizeFieldForExecution loggerFactory baseClassTypes thread field state
match IlMachineState.loadClass loggerFactory baseClassTypes declaringTypeHandle thread state with match IlMachineStateExecution.loadClass loggerFactory baseClassTypes declaringTypeHandle thread state with
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit | FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| NothingToDo state -> | NothingToDo state ->
@@ -995,7 +1000,7 @@ module internal UnaryMetadataIlOp =
let state, declaringTypeHandle, typeGenerics = let state, declaringTypeHandle, typeGenerics =
IlMachineState.concretizeFieldForExecution loggerFactory baseClassTypes thread field state IlMachineState.concretizeFieldForExecution loggerFactory baseClassTypes thread field state
match IlMachineState.loadClass loggerFactory baseClassTypes declaringTypeHandle thread state with match IlMachineStateExecution.loadClass loggerFactory baseClassTypes declaringTypeHandle thread state with
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit | FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| NothingToDo state -> | NothingToDo state ->

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

@@ -21,6 +21,8 @@
<Compile Include="MethodState.fs" /> <Compile Include="MethodState.fs" />
<Compile Include="ThreadState.fs" /> <Compile Include="ThreadState.fs" />
<Compile Include="IlMachineState.fs" /> <Compile Include="IlMachineState.fs" />
<Compile Include="Intrinsics.fs" />
<Compile Include="IlMachineStateExecution.fs" />
<Compile Include="NullaryIlOp.fs" /> <Compile Include="NullaryIlOp.fs" />
<Compile Include="UnaryMetadataIlOp.fs" /> <Compile Include="UnaryMetadataIlOp.fs" />
<Compile Include="UnaryStringTokenIlOp.fs" /> <Compile Include="UnaryStringTokenIlOp.fs" />

6
flake.lock generated
View File

@@ -20,11 +20,11 @@
}, },
"nixpkgs": { "nixpkgs": {
"locked": { "locked": {
"lastModified": 1750836778, "lastModified": 1751498133,
"narHash": "sha256-sRLyRiC7TezRbbjGJwUFOgb2xMbSr3wQ0oJKfYlQ6s0=", "narHash": "sha256-QWJ+NQbMU+NcU2xiyo7SNox1fAuwksGlQhpzBl76g1I=",
"owner": "NixOS", "owner": "NixOS",
"repo": "nixpkgs", "repo": "nixpkgs",
"rev": "d7bb1922f0bb3d0c990f56f9cdb767fdb20a5f22", "rev": "d55716bb59b91ae9d1ced4b1ccdea7a442ecbfdb",
"type": "github" "type": "github"
}, },
"original": { "original": {