Fix circular type init (#16)

This commit is contained in:
Patrick Stevens
2025-05-26 16:18:57 +01:00
committed by GitHub
parent 0b10ccedfd
commit 3ef25c27f3
14 changed files with 459 additions and 145 deletions

View File

@@ -24,7 +24,8 @@ module Program =
use fileStream = new FileStream (dllPath, FileMode.Open, FileAccess.Read)
let terminalState = Program.run loggerFactory fileStream dotnetRuntimes args
let terminalState =
Program.run loggerFactory (Some dllPath) fileStream dotnetRuntimes args
0
| _ ->

View File

@@ -25,7 +25,7 @@ module TestBasicLock =
try
let terminalState, terminatingThread =
Program.run loggerFactory peImage dotnetRuntimes []
Program.run loggerFactory (Some "BasicLock.cs") peImage dotnetRuntimes []
let exitCode =
match terminalState.ThreadState.[terminatingThread].MethodState.EvaluationStack.Values with

View File

@@ -19,12 +19,12 @@ module TestCases =
ExpectedReturnCode = 10
}
{
FileName = "WriteLine.cs"
FileName = "BasicLock.cs"
ExpectedReturnCode = 10
}
{
FileName = "BasicLock.cs"
ExpectedReturnCode = 10
FileName = "WriteLine.cs"
ExpectedReturnCode = 1
}
]
@@ -53,7 +53,7 @@ module TestCases =
try
let terminalState, terminatingThread =
Program.run loggerFactory peImage dotnetRuntimes []
Program.run loggerFactory (Some case.FileName) peImage dotnetRuntimes []
let exitCode =
match terminalState.ThreadState.[terminatingThread].MethodState.EvaluationStack.Values with
@@ -73,7 +73,7 @@ module TestCases =
[<TestCaseSource(nameof unimplemented)>]
[<Explicit "not yet implemented">]
let ``Can evaluate C# files (unimplemented)`` (case : TestCase) : unit =
let ``Can evaluate C# files, unimplemented`` (case : TestCase) : unit =
let source = Assembly.getEmbeddedResourceAsString case.FileName assy
let image = Roslyn.compile [ source ]
let messages, loggerFactory = LoggerFactory.makeTest ()
@@ -85,7 +85,7 @@ module TestCases =
try
let terminalState, terminatingThread =
Program.run loggerFactory peImage dotnetRuntimes []
Program.run loggerFactory (Some case.FileName) peImage dotnetRuntimes []
let exitCode =
match terminalState.ThreadState.[terminatingThread].MethodState.EvaluationStack.Values with

View File

@@ -26,7 +26,7 @@ module TestHelloWorld =
use peImage = new MemoryStream (image)
let terminalState, terminatingThread =
Program.run loggerFactory peImage dotnetRuntimes []
Program.run loggerFactory (Some "HelloWorld.cs") peImage dotnetRuntimes []
let exitCode =
match terminalState.ThreadState.[terminatingThread].MethodState.EvaluationStack.Values with

View File

@@ -7,7 +7,7 @@ namespace HelloWorldApp
static int Main(string[] args)
{
Console.WriteLine("Hello, world!");
return 0;
return 1;
}
}
}

View File

@@ -143,11 +143,10 @@ and MethodState =
// I think valid code should remain valid if we unconditionally localsInit - it should be undefined
// to use an uninitialised value? Not checked this; TODO.
let localVars =
localVariableSig |> Seq.map CliType.zeroOf |> ImmutableArray.CreateRange
do
let args = args |> Seq.map string<CliType> |> String.concat " ; "
System.Console.Error.WriteLine $"Setting args list in {method.Name}: {args}"
// TODO: generics?
localVariableSig
|> Seq.map (CliType.zeroOf ImmutableArray.Empty)
|> ImmutableArray.CreateRange
{
EvaluationStack = EvalStack.Empty
@@ -247,6 +246,23 @@ type ThreadState =
MethodStates = methodState
}
(*
Type load algorithm, from II.10.5.3.3
1. At class load-time (hence prior to initialization time) store zero or null into all static fields of the
type.
2. If the type is initialized, you are done.
2.1. If the type is not yet initialized, try to take an initialization lock.
2.2. If successful, record this thread as responsible for initializing the type and proceed to step 2.3.
2.2.1. If not successful, see whether this thread or any thread waiting for this thread to complete already
holds the lock.
2.2.2. If so, return since blocking would create a deadlock. This thread will now see an incompletely
initialized state for the type, but no deadlock will arise.
2.2.3 If not, block until the type is initialized then return.
2.3 Initialize the base class type and then all interfaces implemented by this type.
2.4 Execute the type initialization code for this type.
2.5 Mark the type as initialized, release the initialization lock, awaken any threads waiting for this type
to be initialized, and return.
*)
type WhatWeDid =
| Executed
/// We didn't run what you wanted, because we have to do class initialisation first.
@@ -256,6 +272,7 @@ type WhatWeDid =
type IlMachineState =
{
Logger : ILogger
NextThreadId : int
// CallStack : StackFrame list
/// Multiple managed heaps are allowed, but we hopefully only need one.
@@ -271,6 +288,36 @@ type IlMachineState =
DotnetRuntimeDirs : string ImmutableArray
}
member this.WithTypeBeginInit (thread : ThreadId) (handle : TypeDefinitionHandle, assy : AssemblyName) =
this.Logger.LogDebug (
"Beginning initialisation of type {TypeName}, handle {TypeDefinitionHandle} from assy {AssemblyHash}",
this.LoadedAssembly(assy).Value.TypeDefs.[handle].Name,
handle.GetHashCode (),
assy.GetHashCode ()
)
let typeInitTable =
this.TypeInitTable |> TypeInitTable.beginInitialising thread (handle, assy)
{ this with
TypeInitTable = typeInitTable
}
member this.WithTypeEndInit (thread : ThreadId) (handle : TypeDefinitionHandle, assy : AssemblyName) =
this.Logger.LogDebug (
"Marking complete initialisation of type {TypeName}, handle {TypeDefinitionHandle} from assy {AssemblyHash}",
this.LoadedAssembly(assy).Value.TypeDefs.[handle].Name,
handle.GetHashCode (),
assy.GetHashCode ()
)
let typeInitTable =
this.TypeInitTable |> TypeInitTable.markInitialised thread (handle, assy)
{ this with
TypeInitTable = typeInitTable
}
member this.WithLoadedAssembly (name : AssemblyName) (value : DumpedAssembly) =
{ this with
_LoadedAssemblies = this._LoadedAssemblies.Add (name.FullName, value)
@@ -351,16 +398,15 @@ module IlMachineState =
try
use f = File.OpenRead file
logger.LogInformation ("Loading assembly from file {AssemblyFileLoadPath}", file)
Assembly.read loggerFactory f |> Some
Assembly.read loggerFactory (Some file) f |> Some
with :? FileNotFoundException ->
None
)
|> Seq.toList
match assy with
| [] -> failwith $"Could not find a readable DLL in any runtime dir with name %s{assemblyName.Name}.dll"
| _ :: _ :: _ -> failwith $"Found multiple DLLs in runtime dirs with name %s{assemblyName.Name}.dll"
| [ assy ] ->
match assy |> List.tryHead with
| None -> failwith $"Could not find a readable DLL in any runtime dir with name %s{assemblyName.Name}.dll"
| Some assy ->
state.WithLoadedAssembly assemblyName assy, assy, assemblyName
@@ -507,6 +553,7 @@ module IlMachineState =
let callMethod
(wasInitialising : (TypeDefinitionHandle * AssemblyName) option)
(wasConstructing : ManagedHeapAddress option)
(wasClassConstructor : bool)
(methodToCall : WoofWare.PawPrint.MethodInfo)
(thread : ThreadId)
(threadState : ThreadState)
@@ -522,7 +569,10 @@ module IlMachineState =
for i = 0 to methodToCall.Parameters.Length - 1 do
let poppedArg, afterPop' = afterPop |> MethodState.popFromStack
let zeroArg = CliType.zeroOf methodToCall.Signature.ParameterTypes.[i]
// TODO: generics
let zeroArg =
CliType.zeroOf ImmutableArray.Empty methodToCall.Signature.ParameterTypes.[i]
let poppedArg = EvalStackValue.toCliTypeCoerced zeroArg poppedArg
afterPop <- afterPop'
args.Add poppedArg
@@ -536,11 +586,16 @@ module IlMachineState =
(Some
{
JumpTo = threadState.ActiveMethodState
WasInitialisingType = None
WasInitialisingType = wasInitialising
WasConstructingObj = wasConstructing
})
let oldFrame = afterPop |> MethodState.advanceProgramCounter
let oldFrame =
if wasClassConstructor then
afterPop
else
afterPop |> MethodState.advanceProgramCounter
newFrame, oldFrame
else
let args = ImmutableArray.CreateBuilder (methodToCall.Parameters.Length + 1)
@@ -549,7 +604,10 @@ module IlMachineState =
for i = 1 to methodToCall.Parameters.Length do
let poppedArg, afterPop' = afterPop |> MethodState.popFromStack
let zeroArg = CliType.zeroOf methodToCall.Signature.ParameterTypes.[i - 1]
// TODO: generics
let zeroArg =
CliType.zeroOf ImmutableArray.Empty methodToCall.Signature.ParameterTypes.[i - 1]
let poppedArg = EvalStackValue.toCliTypeCoerced zeroArg poppedArg
afterPop <- afterPop'
args.Add poppedArg
@@ -599,19 +657,19 @@ module IlMachineState =
let logger = loggerFactory.CreateLogger typeof<Dummy>.DeclaringType
match state.TypeInitTable.TryGetValue ((typeDefHandle, assemblyName)) with
| true, TypeInitState.Initialized ->
match TypeInitTable.tryGet (typeDefHandle, assemblyName) state.TypeInitTable with
| Some TypeInitState.Initialized ->
// Type already initialized; nothing to do
StateLoadResult.NothingToDo state
| true, TypeInitState.InProgress tid when tid = currentThread ->
| 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
| true, TypeInitState.InProgress _ ->
| 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"
| false, _ ->
| None ->
// We have work to do!
let state, origAssyName =
@@ -627,12 +685,7 @@ module IlMachineState =
logger.LogDebug ("Resolving type {TypeDefNamespace}.{TypeDefName}", typeDef.Namespace, typeDef.Name)
// First mark as in-progress to detect cycles
let state =
{ state with
TypeInitTable =
state.TypeInitTable
|> TypeInitTable.beginInitialising currentThread (typeDefHandle, assemblyName)
}
let state = state.WithTypeBeginInit currentThread (typeDefHandle, assemblyName)
// Check if the type has a base type that needs initialization
let firstDoBaseClass =
@@ -684,6 +737,8 @@ module IlMachineState =
| 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
@@ -696,17 +751,19 @@ module IlMachineState =
// TODO: factor out the common bit.
let currentThreadState = state.ThreadState.[currentThread]
callMethod (Some (typeDefHandle, assemblyName)) None ctorMethod currentThread currentThreadState state
callMethod
(Some (typeDefHandle, assemblyName))
None
true
ctorMethod
currentThread
currentThreadState
state
|> FirstLoadThis
| None ->
// No constructor, just continue.
// Mark the type as initialized.
let state =
{ state with
TypeInitTable =
state.TypeInitTable
|> TypeInitTable.markInitialised currentThread (typeDefHandle, assemblyName)
}
let state = state.WithTypeEndInit currentThread (typeDefHandle, assemblyName)
// Restore original assembly context if needed
state.WithThreadSwitchedToAssembly origAssyName currentThread
@@ -723,23 +780,35 @@ module IlMachineState =
=
let threadState = state.ThreadState.[thread]
match state.TypeInitTable.TryGetValue methodToCall.DeclaringType with
| false, _ ->
match TypeInitTable.tryGet methodToCall.DeclaringType state.TypeInitTable with
| None ->
match
loadClass loggerFactory (fst methodToCall.DeclaringType) (snd methodToCall.DeclaringType) thread state
with
| NothingToDo state ->
callMethod None weAreConstructingObj methodToCall thread threadState state, WhatWeDid.Executed
callMethod None weAreConstructingObj false methodToCall thread threadState state, WhatWeDid.Executed
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| true, TypeInitState.Initialized ->
callMethod None weAreConstructingObj methodToCall thread threadState state, WhatWeDid.Executed
| true, InProgress threadId -> state, WhatWeDid.BlockedOnClassInit threadId
| Some TypeInitState.Initialized ->
callMethod None weAreConstructingObj false methodToCall thread threadState state, WhatWeDid.Executed
| Some (InProgress threadId) ->
if threadId = thread then
// II.10.5.3.2: avoid the deadlock by simply proceeding.
callMethod None weAreConstructingObj false methodToCall thread threadState state, WhatWeDid.Executed
else
state, WhatWeDid.BlockedOnClassInit threadId
let initial (dotnetRuntimeDirs : ImmutableArray<string>) (entryAssembly : DumpedAssembly) : IlMachineState =
let initial
(lf : ILoggerFactory)
(dotnetRuntimeDirs : ImmutableArray<string>)
(entryAssembly : DumpedAssembly)
: IlMachineState
=
let assyName = entryAssembly.ThisAssemblyDefinition.Name
let logger = lf.CreateLogger "IlMachineState"
let state =
{
Logger = logger
NextThreadId = 0
// CallStack = []
ManagedHeap = ManagedHeap.Empty
@@ -1052,12 +1121,7 @@ module AbstractMachine =
let state =
match returnState.WasInitialisingType with
| None -> state
| Some finishedInitialising ->
{ state with
TypeInitTable =
state.TypeInitTable
|> TypeInitTable.markInitialised currentThread finishedInitialising
}
| Some finishedInitialising -> state.WithTypeEndInit currentThread finishedInitialising
// Return to previous stack frame
let state =
@@ -1090,7 +1154,12 @@ module AbstractMachine =
let retType =
threadStateAtEndOfMethod.MethodState.ExecutingMethod.Signature.ReturnType
let toPush = EvalStackValue.toCliTypeCoerced (CliType.zeroOf retType) retVal
match retType with
| TypeDefn.Void -> state
| retType ->
// TODO: generics
let toPush =
EvalStackValue.toCliTypeCoerced (CliType.zeroOf ImmutableArray.Empty retType) retVal
state |> IlMachineState.pushToEvalStack toPush currentThread
| _ ->
@@ -1154,8 +1223,49 @@ module AbstractMachine =
|> Tuple.withRight WhatWeDid.Executed
|> ExecutionResult.Stepped
| LdcI4_m1 -> failwith "TODO: LdcI4_m1 unimplemented"
| LdNull -> failwith "TODO: LdNull unimplemented"
| Ceq -> failwith "TODO: Ceq unimplemented"
| LdNull ->
let state =
state
|> IlMachineState.pushToEvalStack'
(EvalStackValue.ManagedPointer ManagedPointerSource.Null)
currentThread
|> IlMachineState.advanceProgramCounter currentThread
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped
| Ceq ->
let var2, state = state |> IlMachineState.popEvalStack currentThread
let var1, state = state |> IlMachineState.popEvalStack currentThread
let comparisonResult =
// Table III.4
match var1, var2 with
| EvalStackValue.Int32 var1, EvalStackValue.Int32 var2 -> if var1 = var2 then 1 else 0
| EvalStackValue.Int32 var1, EvalStackValue.NativeInt var2 -> failwith "TODO: int32 CEQ nativeint"
| EvalStackValue.Int32 _, _ -> failwith $"bad ceq: Int32 vs {var2}"
| EvalStackValue.Int64 var1, EvalStackValue.Int64 var2 -> if var1 = var2 then 1 else 0
| EvalStackValue.Int64 _, _ -> failwith $"bad ceq: Int64 vs {var2}"
| EvalStackValue.Float var1, EvalStackValue.Float var2 -> failwith "TODO: float CEQ float"
| EvalStackValue.Float _, _ -> failwith $"bad ceq: Float vs {var2}"
| EvalStackValue.NativeInt var1, EvalStackValue.NativeInt var2 ->
failwith $"TODO (CEQ): nativeint vs nativeint"
| EvalStackValue.NativeInt var1, EvalStackValue.Int32 var2 -> failwith $"TODO (CEQ): nativeint vs int32"
| EvalStackValue.NativeInt var1, EvalStackValue.ManagedPointer var2 ->
failwith $"TODO (CEQ): nativeint vs managed pointer"
| EvalStackValue.NativeInt _, _ -> failwith $"bad ceq: NativeInt vs {var2}"
| EvalStackValue.ObjectRef var1, EvalStackValue.ObjectRef var2 -> if var1 = var2 then 1 else 0
| EvalStackValue.ObjectRef _, _ -> failwith $"bad ceq: ObjectRef vs {var2}"
| EvalStackValue.ManagedPointer var1, EvalStackValue.ManagedPointer var2 ->
failwith $"TODO (CEQ): managed pointers"
| EvalStackValue.ManagedPointer var1, EvalStackValue.NativeInt var2 ->
failwith $"TODO (CEQ): managed pointer vs nativeint"
| EvalStackValue.ManagedPointer _, _ -> failwith $"bad ceq: ManagedPointer vs {var2}"
| EvalStackValue.UserDefinedValueType, _ -> failwith $"bad ceq: UserDefinedValueType vs {var2}"
state
|> IlMachineState.pushToEvalStack' (EvalStackValue.Int32 comparisonResult) currentThread
|> IlMachineState.advanceProgramCounter currentThread
|> Tuple.withRight WhatWeDid.Executed
|> ExecutionResult.Stepped
| Cgt -> failwith "TODO: Cgt unimplemented"
| Cgt_un -> failwith "TODO: Cgt_un unimplemented"
| Clt ->
@@ -1495,15 +1605,20 @@ module AbstractMachine =
=
match op with
| Call ->
// TODO: make an abstraction for "call this method" that wraps up all the `loadClass` stuff too
let state, methodToCall =
match metadataToken with
| MetadataToken.MethodSpecification h ->
// TODO: do we need to initialise the parent class here?
let spec = (state.ActiveAssembly thread).MethodSpecs.[h]
match spec.Method with
| MetadataToken.MethodDef token -> state, (state.ActiveAssembly thread).Methods.[token]
| MetadataToken.MemberReference ref ->
let state, _, method =
resolveMember loggerFactory (state.ActiveAssembly thread) ref state
match method with
| Choice2Of2 _field -> failwith "tried to Call a field"
| Choice1Of2 method -> state, method
| k -> failwith $"Unrecognised kind: %O{k}"
| MetadataToken.MemberReference h ->
let state, _, method =
@@ -1521,13 +1636,68 @@ module AbstractMachine =
| false, _ -> failwith $"could not find method in {activeAssy.Name}"
| k -> failwith $"Unrecognised kind: %O{k}"
match
IlMachineState.loadClass
loggerFactory
(fst methodToCall.DeclaringType)
(snd methodToCall.DeclaringType)
thread
state
with
| NothingToDo state ->
state.WithThreadSwitchedToAssembly (snd methodToCall.DeclaringType) thread
|> fst
|> IlMachineState.callMethodInActiveAssembly loggerFactory thread methodToCall None
// TODO: push the instance pointer if necessary
// TODO: push args?
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| Callvirt -> failwith "TODO: Callvirt unimplemented"
| Callvirt ->
let method =
match metadataToken with
| MetadataToken.MethodDef defn ->
let activeAssy = state.ActiveAssembly thread
match activeAssy.Methods.TryGetValue defn with
| true, method -> method
| false, _ -> failwith $"could not find method in {activeAssy.Name}"
| _ -> failwith $"TODO (Callvirt): %O{metadataToken}"
let currentObj =
match IlMachineState.peekEvalStack thread state with
| None -> failwith "nothing on stack when Callvirt called"
| Some obj -> obj
let methodToCall =
match currentObj with
| EvalStackValue.ManagedPointer src ->
match src with
| ManagedPointerSource.Null -> failwith "TODO: raise NullReferenceException"
| ManagedPointerSource.LocalVariable _ -> failwith "TODO (Callvirt): LocalVariable"
| ManagedPointerSource.Heap addr ->
match state.ManagedHeap.NonArrayObjects.TryGetValue addr with
| false, _ -> failwith "TODO (Callvirt): address"
| true, v ->
{ new TypeInfoEval<_> with
member _.Eval ty =
let matchingMethods =
ty.Methods
|> List.filter (fun mi ->
mi.Name = method.Name && mi.Signature = method.Signature && not mi.IsStatic
)
match matchingMethods with
| [] ->
failwith
"TODO: walk up the class hierarchy; eventually throw MissingMethodException"
| [ m ] -> m
| _ -> failwith $"multiple matching methods for {method.Name}"
}
|> v.Type.Apply
| EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo"
| _ -> failwith $"TODO (Callvirt): can't identify type of {currentObj}"
state.WithThreadSwitchedToAssembly (snd methodToCall.DeclaringType) thread
|> fst
|> IlMachineState.callMethodInActiveAssembly loggerFactory thread methodToCall None
| Castclass -> failwith "TODO: Castclass unimplemented"
| Newobj ->
let state, assy, ctor =
@@ -1552,7 +1722,8 @@ module AbstractMachine =
let fields =
ctorType.Fields
|> List.map (fun field ->
let zeroedAllocation = CliType.zeroOf field.Signature
// TODO: I guess the type itself can have generics, which should be passed in as this array?
let zeroedAllocation = CliType.zeroOf ImmutableArray.Empty field.Signature
field.Name, zeroedAllocation
)
@@ -1642,6 +1813,18 @@ module AbstractMachine =
| false, _ -> failwith "TODO: Stsfld - throw MissingFieldException"
| true, field ->
do
let logger = loggerFactory.CreateLogger "Stsfld"
let declaring = state.ActiveAssembly(thread).TypeDefs.[field.DeclaringType]
logger.LogInformation (
"Storing in static field {FieldAssembly}.{FieldDeclaringType}.{FieldName} (type {FieldType})",
declaring.Assembly.Name,
declaring.Name,
field.Name,
field.Signature
)
match IlMachineState.loadClass loggerFactory field.DeclaringType activeAssy.Name thread state with
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| NothingToDo state ->
@@ -1649,20 +1832,13 @@ module AbstractMachine =
let popped, state = IlMachineState.popEvalStack thread state
let toStore =
match popped with
| EvalStackValue.ManagedPointer source ->
match source with
| ManagedPointerSource.LocalVariable _ ->
failwith "TODO: Stsfld LocalVariable storage unimplemented"
| ManagedPointerSource.Heap addr -> CliType.ObjectRef (Some addr)
| ManagedPointerSource.Null -> CliType.ObjectRef None
| _ -> failwith "TODO: Stsfld non-managed pointer storage unimplemented"
EvalStackValue.toCliTypeCoerced (CliType.zeroOf ImmutableArray.Empty field.Signature) popped
let state =
{ state with
Statics = state.Statics.SetItem ((field.DeclaringType, activeAssy.Name), toStore)
}
// TODO: do we need to advance the program counter here?
|> IlMachineState.advanceProgramCounter thread
state, WhatWeDid.Executed
@@ -1680,6 +1856,18 @@ module AbstractMachine =
| Choice2Of2 field -> state, assyName, field
| t -> failwith $"Unexpectedly asked to load from a non-field: {t}"
do
let logger = loggerFactory.CreateLogger "Ldfld"
let declaring = state.ActiveAssembly(thread).TypeDefs.[field.DeclaringType]
logger.LogInformation (
"Storing in object field {FieldAssembly}.{FieldDeclaringType}.{FieldName} (type {FieldType})",
declaring.Assembly.Name,
declaring.Name,
field.Name,
field.Signature
)
let currentObj, state = IlMachineState.popEvalStack thread state
if field.Attributes.HasFlag FieldAttributes.Static then
@@ -1688,7 +1876,7 @@ module AbstractMachine =
state, WhatWeDid.Executed
else
let currentObj : unit =
let state =
match currentObj with
| EvalStackValue.Int32 i -> failwith "todo: int32"
| EvalStackValue.Int64 int64 -> failwith "todo: int64"
@@ -1702,14 +1890,65 @@ module AbstractMachine =
.[int<uint16> whichVar]
failwith $"todo: local variable {currentValue} {field}"
| ManagedPointerSource.Heap managedHeapAddress -> failwith $"todo: heap addr {managedHeapAddress}"
| ManagedPointerSource.Heap managedHeapAddress ->
match state.ManagedHeap.NonArrayObjects.TryGetValue managedHeapAddress with
| false, _ -> failwith $"todo: array {managedHeapAddress}"
| true, v -> IlMachineState.pushToEvalStack v.Fields.[field.Name] thread state
| ManagedPointerSource.Null -> failwith "TODO: raise NullReferenceException"
| EvalStackValue.ObjectRef managedHeapAddress -> failwith $"todo: {managedHeapAddress}"
| EvalStackValue.UserDefinedValueType -> failwith "todo"
failwith "TODO: Ldfld unimplemented"
state
|> IlMachineState.advanceProgramCounter thread
|> Tuple.withRight WhatWeDid.Executed
| Ldflda -> failwith "TODO: Ldflda unimplemented"
| Ldsfld -> failwith "TODO: Ldsfld unimplemented"
| Ldsfld ->
let fieldHandle =
match metadataToken with
| MetadataToken.FieldDefinition f -> f
| t -> failwith $"Unexpectedly asked to load from a non-field: {t}"
let activeAssy = state.ActiveAssembly thread
match activeAssy.Fields.TryGetValue fieldHandle with
| false, _ -> failwith "TODO: Ldsfld - throw MissingFieldException"
| true, field ->
do
let logger = loggerFactory.CreateLogger "Ldsfld"
let declaring = state.ActiveAssembly(thread).TypeDefs.[field.DeclaringType]
logger.LogInformation (
"Loading from static field {FieldAssembly}.{FieldDeclaringType}.{FieldName} (type {FieldType})",
declaring.Assembly.Name,
declaring.Name,
field.Name,
field.Signature
)
match IlMachineState.loadClass loggerFactory field.DeclaringType activeAssy.Name thread state with
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| NothingToDo state ->
let fieldValue, state =
match state.Statics.TryGetValue ((field.DeclaringType, activeAssy.Name)) with
| false, _ ->
// TODO: generics
let newVal = CliType.zeroOf ImmutableArray.Empty field.Signature
newVal,
{ state with
Statics = state.Statics.SetItem ((field.DeclaringType, activeAssy.Name), newVal)
}
| true, v -> v, state
let state =
IlMachineState.pushToEvalStack fieldValue thread state
|> IlMachineState.advanceProgramCounter thread
state, WhatWeDid.Executed
| Unbox_Any -> failwith "TODO: Unbox_Any unimplemented"
| Stelem -> failwith "TODO: Stelem unimplemented"
| Ldelem -> failwith "TODO: Ldelem unimplemented"

View File

@@ -36,6 +36,8 @@ module AssemblyDefinition =
/// </summary>
type DumpedAssembly =
{
OriginalPath : string option
/// <summary>Logger for recording information about this assembly.</summary>
Logger : ILogger
@@ -160,7 +162,7 @@ type DumpedAssembly =
if keys.Add key then
result.Add (key, ty)
else
logger.LogWarning (
logger.LogDebug (
"Duplicate types exported from assembly {ThisAssemblyName}: namespace {DuplicatedTypeNamespace}, type {DuplicatedTypeName}. Ignoring the duplicate.",
name,
ty.Namespace,
@@ -186,7 +188,7 @@ type DumpedAssembly =
result.Add (key, ty)
else
// TODO: this is all very dubious, the ResolutionScope is supposed to tell us how to disambiguate these
logger.LogWarning (
logger.LogDebug (
"Duplicate type refs from assembly {ThisAssemblyName}: namespace {DuplicatedTypeNamespace}, type {DuplicatedTypeName}. Ignoring the duplicate.",
name,
ty.Namespace,
@@ -210,7 +212,7 @@ type DumpedAssembly =
result.Add (key, ty)
else
// TODO: this is all very dubious, the ResolutionScope is supposed to tell us how to disambiguate these
logger.LogWarning (
logger.LogDebug (
"Duplicate type defs from assembly {ThisAssemblyName}: namespace {DuplicatedTypeNamespace}, type {DuplicatedTypeName}. Ignoring the duplicate.",
name,
ty.Namespace,
@@ -245,7 +247,7 @@ type DumpedAssembly =
[<RequireQualifiedAccess>]
module Assembly =
let read (loggerFactory : ILoggerFactory) (dllBytes : Stream) : DumpedAssembly =
let read (loggerFactory : ILoggerFactory) (originalPath : string option) (dllBytes : Stream) : DumpedAssembly =
let peReader = new PEReader (dllBytes)
let metadataReader = peReader.GetMetadataReader ()
@@ -378,6 +380,7 @@ module Assembly =
{
Logger = logger
OriginalPath = originalPath
TypeDefs = typeDefs
TypeRefs = typeRefs
TypeSpecs = typeSpecs

View File

@@ -1,5 +1,9 @@
namespace WoofWare.PawPrint
open System
open System.Collections.Immutable
open System.Reflection.Metadata
/// Currently this is just an opaque handle; it can't be treated as a pointer.
type ManagedHeapAddress = | ManagedHeapAddress of int
@@ -89,11 +93,10 @@ type CliType =
[<RequireQualifiedAccess>]
module CliType =
let zeroOf (ty : TypeDefn) : CliType =
let rec zeroOf (generics : TypeDefn ImmutableArray) (ty : TypeDefn) : CliType =
match ty with
| TypeDefn.PrimitiveType primitiveType ->
match primitiveType with
| PrimitiveType.Void -> failwith "todo"
| PrimitiveType.Boolean -> CliType.Bool 0uy
| PrimitiveType.Char -> CliType.Char (0uy, 0uy)
| PrimitiveType.SByte -> CliType.Numeric (CliNumericType.Int8 0y)
@@ -118,8 +121,16 @@ module CliType =
| TypeDefn.OneDimensionalArrayLowerBoundZero _ -> CliType.ObjectRef None
| TypeDefn.Modified (original, afterMod, modificationRequired) -> failwith "todo"
| TypeDefn.FromReference (typeReferenceHandle, signatureTypeKind) -> failwith "todo"
| TypeDefn.FromDefinition (typeDefinitionHandle, signatureTypeKind) -> failwith "todo"
| TypeDefn.GenericInstantiation (generic, args) -> failwith "todo"
| TypeDefn.FromDefinition (typeDefinitionHandle, signatureTypeKind) ->
match signatureTypeKind with
| SignatureTypeKind.Unknown -> failwith "todo"
| SignatureTypeKind.ValueType -> failwith "todo"
| SignatureTypeKind.Class -> CliType.ObjectRef None
| _ -> raise (ArgumentOutOfRangeException ())
| TypeDefn.GenericInstantiation (generic, args) -> zeroOf args generic
| TypeDefn.FunctionPointer typeMethodSignature -> failwith "todo"
| TypeDefn.GenericTypeParameter index -> failwith "todo"
| TypeDefn.GenericTypeParameter index ->
// TODO: can generics depend on other generics? presumably, so we pass the array down again
zeroOf generics generics.[index]
| TypeDefn.GenericMethodParameter index -> failwith "todo"
| TypeDefn.Void -> failwith "should never construct an element of type Void"

View File

@@ -117,13 +117,17 @@ module EvalStackValue =
| ManagedPointerSource.Heap addr -> CliType.OfManagedObject addr
| ManagedPointerSource.Null -> CliType.ObjectRef None
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, var) ->
CliType.RuntimePointer (
CliRuntimePointer.Managed (
CliRuntimePointerSource.LocalVariable (sourceThread, methodFrame, var)
)
)
|> CliRuntimePointer.Managed
|> CliType.RuntimePointer
| _ -> failwith $"TODO: %O{popped}"
| CliType.Char _ -> failwith "TODO: char"
| CliType.Char _ ->
match popped with
| EvalStackValue.Int32 i ->
let high = i / 256
let low = i % 256
CliType.Char (byte<int> high, byte<int> low)
| popped -> failwith $"Unexpectedly wanted a char from {popped}"
type EvalStack =
{
@@ -136,8 +140,6 @@ type EvalStack =
}
static member Pop (stack : EvalStack) : EvalStackValue * EvalStack =
System.Console.Error.WriteLine "Popping value from stack"
match stack.Values with
| [] -> failwith "eval stack was empty on pop instruction"
| v :: rest ->
@@ -151,8 +153,6 @@ type EvalStack =
static member Peek (stack : EvalStack) : EvalStackValue option = stack.Values |> List.tryHead
static member Push' (v : EvalStackValue) (stack : EvalStack) : EvalStack =
System.Console.Error.WriteLine $"Pushing value {v} to stack"
{
Values = v :: stack.Values
}

View File

@@ -122,7 +122,9 @@ type NullaryIlOp =
| LdcI4_7
| LdcI4_8
| LdcI4_m1
/// Push a null object reference onto the stack.
| LdNull
/// Pop two values from the stack; push 1 if they're equal, 0 otherwise
| Ceq
| Cgt
| Cgt_un
@@ -375,10 +377,15 @@ type UnaryMetadataTokenIlOp =
| Box
| Ldelema
| Isinst
/// Pop value from stack; pop object ref from stack; set specified field on that object to that value.
| Stfld
/// Pop value from eval stack; set specified static field to that value.
| Stsfld
/// Pop object ref from eval stack; look up specified field on that object; push field's value to eval stack.
| Ldfld
/// Pop object ref from eval stack; find address of specified field on that object; push address to eval stack.
| Ldflda
/// Push value of specified static field onto eval stack.
| Ldsfld
| Ldsflda
| Unbox_Any
@@ -398,6 +405,40 @@ type UnaryMetadataTokenIlOp =
| Refanyval
| Jmp
override this.ToString () =
match this with
| UnaryMetadataTokenIlOp.Call -> "Call"
| UnaryMetadataTokenIlOp.Calli -> "Calli"
| UnaryMetadataTokenIlOp.Callvirt -> "Callvirt"
| UnaryMetadataTokenIlOp.Castclass -> "Castclass"
| UnaryMetadataTokenIlOp.Newobj -> "Newobj"
| UnaryMetadataTokenIlOp.Newarr -> "Newarr"
| UnaryMetadataTokenIlOp.Box -> "Box"
| UnaryMetadataTokenIlOp.Ldelema -> "Ldelema"
| UnaryMetadataTokenIlOp.Isinst -> "Isinst"
| UnaryMetadataTokenIlOp.Stfld -> "Stfld"
| UnaryMetadataTokenIlOp.Stsfld -> "Stsfld"
| UnaryMetadataTokenIlOp.Ldfld -> "Ldfld"
| UnaryMetadataTokenIlOp.Ldflda -> "Ldflda"
| UnaryMetadataTokenIlOp.Ldsfld -> "Ldsfld"
| UnaryMetadataTokenIlOp.Ldsflda -> "Ldsflda"
| UnaryMetadataTokenIlOp.Unbox_Any -> "Unbox_Any"
| UnaryMetadataTokenIlOp.Stelem -> "Stelem"
| UnaryMetadataTokenIlOp.Ldelem -> "Ldelem"
| UnaryMetadataTokenIlOp.Initobj -> "Initobj"
| UnaryMetadataTokenIlOp.Ldftn -> "Ldftn"
| UnaryMetadataTokenIlOp.Stobj -> "Stobj"
| UnaryMetadataTokenIlOp.Constrained -> "Constrained"
| UnaryMetadataTokenIlOp.Ldtoken -> "Ldtoken"
| UnaryMetadataTokenIlOp.Cpobj -> "Cpobj"
| UnaryMetadataTokenIlOp.Ldobj -> "Ldobj"
| UnaryMetadataTokenIlOp.Sizeof -> "Sizeof"
| UnaryMetadataTokenIlOp.Unbox -> "Unbox"
| UnaryMetadataTokenIlOp.Ldvirtftn -> "Ldvirtftn"
| UnaryMetadataTokenIlOp.Mkrefany -> "Mkrefany"
| UnaryMetadataTokenIlOp.Refanyval -> "Refanyval"
| UnaryMetadataTokenIlOp.Jmp -> "Jmp"
/// The number of bytes this instruction takes in memory, including its metadata token argument.
static member NumberOfBytes (op : UnaryMetadataTokenIlOp) : int =
match op with
@@ -447,6 +488,14 @@ type IlOp =
| UnaryStringToken of UnaryStringTokenIlOp * StringToken
| Switch of int32 ImmutableArray
override this.ToString () =
match this with
| IlOp.Nullary op -> $"Nullary %O{op}"
| IlOp.UnaryConst op -> $"UnaryConst.%O{op}"
| IlOp.UnaryMetadataToken (op, _) -> $"UnaryMetadataToken.%O{op}"
| IlOp.UnaryStringToken (op, _) -> $"UnaryStringToken.%O{op}"
| IlOp.Switch arr -> $"Switch[%i{arr.Length}]"
static member Format (opCode : IlOp) (offset : int) : string = $" IL_%04X{offset}: %-20O{opCode}"
static member NumberOfBytes (op : IlOp) =

View File

@@ -539,7 +539,7 @@ module MethodInfo =
else
match readMethodBody peReader metadataReader methodDef with
| None ->
logger.LogDebug $"no method body in {assemblyName.Name} {methodName}"
logger.LogTrace $"no method body in {assemblyName.Name} {methodName}"
None
| Some body ->
{

View File

@@ -44,6 +44,7 @@ module Program =
/// caused execution to end.
let run
(loggerFactory : ILoggerFactory)
(originalPath : string option)
(fileStream : Stream)
(dotnetRuntimeDirs : ImmutableArray<string>)
(argv : string list)
@@ -51,7 +52,7 @@ module Program =
=
let logger = loggerFactory.CreateLogger "Program"
let dumped = Assembly.read loggerFactory fileStream
let dumped = Assembly.read loggerFactory originalPath fileStream
let entryPoint =
match dumped.MainMethod with
@@ -64,7 +65,7 @@ module Program =
failwith "Refusing to execute generic main method"
let state, mainThread =
IlMachineState.initial dotnetRuntimeDirs dumped
IlMachineState.initial loggerFactory dotnetRuntimeDirs dumped
// The thread's state is slightly fake: we will need to put arguments onto the stack before actually
// executing the main method.
// We construct the thread here before we are entirely ready, because we need a thread from which to
@@ -131,7 +132,7 @@ module Program =
match whatWeDid with
| WhatWeDid.Executed ->
logger.LogInformation
$"Executed one step; active assembly: {state'.ActiveAssembly(mainThread).Name.Name}."
$"Executed one step; active assembly: {state'.ActiveAssembly(mainThread).Name.Name}"
| WhatWeDid.SuspendedForClassInit ->
logger.LogInformation "Suspended execution of current method for class initialisation."
| WhatWeDid.BlockedOnClassInit threadBlockingUs ->

View File

@@ -49,7 +49,6 @@ module TypeMethodSignature =
/// See I.8.2.2
type PrimitiveType =
| Void
| Boolean
| Char
| SByte
@@ -68,26 +67,26 @@ type PrimitiveType =
| UIntPtr
| Object
static member OfEnum (ptc : PrimitiveTypeCode) : PrimitiveType =
static member OfEnum (ptc : PrimitiveTypeCode) : PrimitiveType option =
match ptc with
| PrimitiveTypeCode.Void -> PrimitiveType.Void
| PrimitiveTypeCode.Boolean -> PrimitiveType.Boolean
| PrimitiveTypeCode.Char -> PrimitiveType.Char
| PrimitiveTypeCode.SByte -> PrimitiveType.SByte
| PrimitiveTypeCode.Byte -> PrimitiveType.Byte
| PrimitiveTypeCode.Int16 -> PrimitiveType.Int16
| PrimitiveTypeCode.UInt16 -> PrimitiveType.UInt16
| PrimitiveTypeCode.Int32 -> PrimitiveType.Int32
| PrimitiveTypeCode.UInt32 -> PrimitiveType.UInt32
| PrimitiveTypeCode.Int64 -> PrimitiveType.Int64
| PrimitiveTypeCode.UInt64 -> PrimitiveType.UInt64
| PrimitiveTypeCode.Single -> PrimitiveType.Single
| PrimitiveTypeCode.Double -> PrimitiveType.Double
| PrimitiveTypeCode.String -> PrimitiveType.String
| PrimitiveTypeCode.TypedReference -> PrimitiveType.TypedReference
| PrimitiveTypeCode.IntPtr -> PrimitiveType.IntPtr
| PrimitiveTypeCode.UIntPtr -> PrimitiveType.UIntPtr
| PrimitiveTypeCode.Object -> PrimitiveType.Object
| PrimitiveTypeCode.Void -> None
| PrimitiveTypeCode.Boolean -> PrimitiveType.Boolean |> Some
| PrimitiveTypeCode.Char -> PrimitiveType.Char |> Some
| PrimitiveTypeCode.SByte -> PrimitiveType.SByte |> Some
| PrimitiveTypeCode.Byte -> PrimitiveType.Byte |> Some
| PrimitiveTypeCode.Int16 -> PrimitiveType.Int16 |> Some
| PrimitiveTypeCode.UInt16 -> PrimitiveType.UInt16 |> Some
| PrimitiveTypeCode.Int32 -> PrimitiveType.Int32 |> Some
| PrimitiveTypeCode.UInt32 -> PrimitiveType.UInt32 |> Some
| PrimitiveTypeCode.Int64 -> PrimitiveType.Int64 |> Some
| PrimitiveTypeCode.UInt64 -> PrimitiveType.UInt64 |> Some
| PrimitiveTypeCode.Single -> PrimitiveType.Single |> Some
| PrimitiveTypeCode.Double -> PrimitiveType.Double |> Some
| PrimitiveTypeCode.String -> PrimitiveType.String |> Some
| PrimitiveTypeCode.TypedReference -> PrimitiveType.TypedReference |> Some
| PrimitiveTypeCode.IntPtr -> PrimitiveType.IntPtr |> Some
| PrimitiveTypeCode.UIntPtr -> PrimitiveType.UIntPtr |> Some
| PrimitiveTypeCode.Object -> PrimitiveType.Object |> Some
| x -> failwithf $"Unrecognised primitive type code: %O{x}"
type TypeDefn =
@@ -104,34 +103,37 @@ type TypeDefn =
| FunctionPointer of TypeMethodSignature<TypeDefn>
| GenericTypeParameter of index : int
| GenericMethodParameter of index : int
/// Not really a type: this indicates the *absence* of a return value.
| Void
[<RequireQualifiedAccess>]
module TypeDefn =
let isManaged (typeDefn : TypeDefn) : bool =
match typeDefn with
| PrimitiveType primitiveType -> failwith "todo"
| Array (elt, shape) -> failwith "todo"
| Pinned typeDefn -> failwith "todo"
| Pointer typeDefn -> failwith "todo"
| Byref typeDefn -> failwith "todo"
| OneDimensionalArrayLowerBoundZero elements -> failwith "todo"
| Modified (original, afterMod, modificationRequired) -> failwith "todo"
| FromReference _ -> true
| FromDefinition (_, signatureTypeKind) ->
| TypeDefn.PrimitiveType primitiveType -> failwith "todo"
| TypeDefn.Array (elt, shape) -> failwith "todo"
| TypeDefn.Pinned typeDefn -> failwith "todo"
| TypeDefn.Pointer typeDefn -> failwith "todo"
| TypeDefn.Byref typeDefn -> failwith "todo"
| TypeDefn.OneDimensionalArrayLowerBoundZero elements -> failwith "todo"
| TypeDefn.Modified (original, afterMod, modificationRequired) -> failwith "todo"
| TypeDefn.FromReference _ -> true
| TypeDefn.FromDefinition (_, signatureTypeKind) ->
match signatureTypeKind with
| SignatureTypeKind.Unknown -> failwith "todo"
| SignatureTypeKind.ValueType -> false
| SignatureTypeKind.Class -> true
| s -> raise (System.ArgumentOutOfRangeException ())
| GenericInstantiation (generic, args) -> failwith "todo"
| FunctionPointer typeMethodSignature -> failwith "todo"
| GenericTypeParameter index -> failwith "todo"
| GenericMethodParameter index -> failwith "todo"
| TypeDefn.GenericInstantiation (generic, args) -> failwith "todo"
| TypeDefn.FunctionPointer typeMethodSignature -> failwith "todo"
| TypeDefn.GenericTypeParameter index -> failwith "todo"
| TypeDefn.GenericMethodParameter index -> failwith "todo"
| TypeDefn.Void -> false
let fromTypeCode (s : SignatureTypeCode) : TypeDefn =
match s with
| SignatureTypeCode.Invalid -> failwith "todo"
| SignatureTypeCode.Void -> TypeDefn.PrimitiveType PrimitiveType.Void
| SignatureTypeCode.Void -> TypeDefn.Void
| SignatureTypeCode.Boolean -> TypeDefn.PrimitiveType PrimitiveType.Boolean
| SignatureTypeCode.Char -> TypeDefn.PrimitiveType PrimitiveType.Char
| SignatureTypeCode.SByte -> TypeDefn.PrimitiveType PrimitiveType.SByte
@@ -175,7 +177,9 @@ module TypeDefn =
TypeDefn.OneDimensionalArrayLowerBoundZero elementType
member this.GetPrimitiveType (elementType : PrimitiveTypeCode) : TypeDefn =
PrimitiveType.OfEnum elementType |> TypeDefn.PrimitiveType
match PrimitiveType.OfEnum elementType with
| None -> TypeDefn.Void
| Some v -> TypeDefn.PrimitiveType v
member this.GetGenericInstantiation
(generic : TypeDefn, typeArguments : ImmutableArray<TypeDefn>)

View File

@@ -9,28 +9,34 @@ type TypeInitState =
| InProgress of ThreadId // Being initialized by this thread
| Initialized
/// Tracks the initialization state of types across assemblies. The AssemblyName in the key is where the type comes from.
type TypeInitTable = ImmutableDictionary<TypeDefinitionHandle * AssemblyName, TypeInitState>
/// Tracks the initialization state of types across assemblies. The string in the key is the FullName of the AssemblyName where the type comes from.
// TODO: need a better solution than string here! AssemblyName didn't work, we had nonequal assembly names.
type TypeInitTable = ImmutableDictionary<TypeDefinitionHandle * string, TypeInitState>
[<RequireQualifiedAccess>]
module TypeInitTable =
let tryGet (typeDef : TypeDefinitionHandle, assy : AssemblyName) (t : TypeInitTable) =
match t.TryGetValue ((typeDef, assy.FullName)) with
| true, v -> Some v
| false, _ -> None
let beginInitialising
(thread : ThreadId)
(typeDef : TypeDefinitionHandle * AssemblyName)
(typeDef : TypeDefinitionHandle, assy : AssemblyName)
(t : TypeInitTable)
: TypeInitTable
=
match t.TryGetValue typeDef with
| false, _ -> t.Add (typeDef, TypeInitState.InProgress thread)
match t.TryGetValue ((typeDef, assy.FullName)) with
| false, _ -> t.Add ((typeDef, assy.FullName), TypeInitState.InProgress thread)
| true, v -> failwith "Logic error: tried initialising a type which has already started initialising"
let markInitialised
(thread : ThreadId)
(typeDef : TypeDefinitionHandle * AssemblyName)
(typeDef : TypeDefinitionHandle, assy : AssemblyName)
(t : TypeInitTable)
: TypeInitTable
=
match t.TryGetValue typeDef with
match t.TryGetValue ((typeDef, assy.FullName)) with
| false, _ -> failwith "Logic error: completing initialisation of a type which never started initialising"
| true, TypeInitState.Initialized ->
failwith "Logic error: completing initialisation of a type which has already finished initialising"
@@ -39,4 +45,4 @@ module TypeInitTable =
failwith
"Logic error: completed initialisation of a type on a different thread to the one which started it!"
else
t.SetItem (typeDef, TypeInitState.Initialized)
t.SetItem ((typeDef, assy.FullName), TypeInitState.Initialized)