diff --git a/WoofWare.PawPrint.App/Program.fs b/WoofWare.PawPrint.App/Program.fs index bb3e9df..70a1e61 100644 --- a/WoofWare.PawPrint.App/Program.fs +++ b/WoofWare.PawPrint.App/Program.fs @@ -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 | _ -> diff --git a/WoofWare.PawPrint.Test/TestBasicLock.fs b/WoofWare.PawPrint.Test/TestBasicLock.fs index 292ab3d..17629ea 100644 --- a/WoofWare.PawPrint.Test/TestBasicLock.fs +++ b/WoofWare.PawPrint.Test/TestBasicLock.fs @@ -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 diff --git a/WoofWare.PawPrint.Test/TestCases.fs b/WoofWare.PawPrint.Test/TestCases.fs index ceef97d..df9f7b2 100644 --- a/WoofWare.PawPrint.Test/TestCases.fs +++ b/WoofWare.PawPrint.Test/TestCases.fs @@ -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 = [] [] - 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 diff --git a/WoofWare.PawPrint.Test/TestHelloWorld.fs b/WoofWare.PawPrint.Test/TestHelloWorld.fs index 5d65976..30eaeca 100644 --- a/WoofWare.PawPrint.Test/TestHelloWorld.fs +++ b/WoofWare.PawPrint.Test/TestHelloWorld.fs @@ -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 diff --git a/WoofWare.PawPrint.Test/sources/WriteLine.cs b/WoofWare.PawPrint.Test/sources/WriteLine.cs index b50979a..c453f95 100644 --- a/WoofWare.PawPrint.Test/sources/WriteLine.cs +++ b/WoofWare.PawPrint.Test/sources/WriteLine.cs @@ -7,7 +7,7 @@ namespace HelloWorldApp static int Main(string[] args) { Console.WriteLine("Hello, world!"); - return 0; + return 1; } } } diff --git a/WoofWare.PawPrint/AbstractMachine.fs b/WoofWare.PawPrint/AbstractMachine.fs index 0b86a6c..a5999c6 100644 --- a/WoofWare.PawPrint/AbstractMachine.fs +++ b/WoofWare.PawPrint/AbstractMachine.fs @@ -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 |> 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.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) (entryAssembly : DumpedAssembly) : IlMachineState = + let initial + (lf : ILoggerFactory) + (dotnetRuntimeDirs : ImmutableArray) + (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,9 +1154,14 @@ 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 + state |> IlMachineState.pushToEvalStack toPush currentThread | _ -> failwith "Unexpected interpretation result has a local evaluation stack with more than one element on RET" @@ -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 + | FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit + + | 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 - // TODO: push the instance pointer if necessary - // TODO: push args? - - | Callvirt -> failwith "TODO: Callvirt unimplemented" | 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 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" diff --git a/WoofWare.PawPrint/Assembly.fs b/WoofWare.PawPrint/Assembly.fs index 952a2d3..3b11457 100644 --- a/WoofWare.PawPrint/Assembly.fs +++ b/WoofWare.PawPrint/Assembly.fs @@ -36,6 +36,8 @@ module AssemblyDefinition = /// type DumpedAssembly = { + OriginalPath : string option + /// Logger for recording information about this assembly. 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 = [] 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 diff --git a/WoofWare.PawPrint/BasicCliType.fs b/WoofWare.PawPrint/BasicCliType.fs index dc1b6d8..b89b134 100644 --- a/WoofWare.PawPrint/BasicCliType.fs +++ b/WoofWare.PawPrint/BasicCliType.fs @@ -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 = [] 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" diff --git a/WoofWare.PawPrint/EvalStack.fs b/WoofWare.PawPrint/EvalStack.fs index a83963f..e4241f2 100644 --- a/WoofWare.PawPrint/EvalStack.fs +++ b/WoofWare.PawPrint/EvalStack.fs @@ -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) - ) - ) + 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 high, byte 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 } diff --git a/WoofWare.PawPrint/IlOp.fs b/WoofWare.PawPrint/IlOp.fs index 2df787e..03a1965 100644 --- a/WoofWare.PawPrint/IlOp.fs +++ b/WoofWare.PawPrint/IlOp.fs @@ -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) = diff --git a/WoofWare.PawPrint/MethodInfo.fs b/WoofWare.PawPrint/MethodInfo.fs index 7c456e9..107431f 100644 --- a/WoofWare.PawPrint/MethodInfo.fs +++ b/WoofWare.PawPrint/MethodInfo.fs @@ -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 -> { diff --git a/WoofWare.PawPrint/Program.fs b/WoofWare.PawPrint/Program.fs index f91fb6c..46bb345 100644 --- a/WoofWare.PawPrint/Program.fs +++ b/WoofWare.PawPrint/Program.fs @@ -44,6 +44,7 @@ module Program = /// caused execution to end. let run (loggerFactory : ILoggerFactory) + (originalPath : string option) (fileStream : Stream) (dotnetRuntimeDirs : ImmutableArray) (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 -> diff --git a/WoofWare.PawPrint/TypeDefn.fs b/WoofWare.PawPrint/TypeDefn.fs index f5cc97d..51628d9 100644 --- a/WoofWare.PawPrint/TypeDefn.fs +++ b/WoofWare.PawPrint/TypeDefn.fs @@ -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 | GenericTypeParameter of index : int | GenericMethodParameter of index : int + /// Not really a type: this indicates the *absence* of a return value. + | Void [] 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) diff --git a/WoofWare.PawPrint/TypeInitialisation.fs b/WoofWare.PawPrint/TypeInitialisation.fs index 29d3edf..8071580 100644 --- a/WoofWare.PawPrint/TypeInitialisation.fs +++ b/WoofWare.PawPrint/TypeInitialisation.fs @@ -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 +/// 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 [] 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)