From 4c55bbe5e7aaeec1e0c8be4b1c86f1efa7ef5089 Mon Sep 17 00:00:00 2001 From: Patrick Stevens <3138005+Smaug123@users.noreply.github.com> Date: Sun, 1 Jun 2025 15:31:59 +0100 Subject: [PATCH] Allow CliType.zeroOf to load other assemblies (#30) --- WoofWare.PawPrint/AbstractMachine.fs | 7 +- WoofWare.PawPrint/Assembly.fs | 95 ++++++++- WoofWare.PawPrint/AssemblyReference.fs | 9 +- WoofWare.PawPrint/BasicCliType.fs | 49 +++-- WoofWare.PawPrint/IlMachineState.fs | 268 +++++++++++++++---------- WoofWare.PawPrint/MethodState.fs | 24 ++- WoofWare.PawPrint/NullaryIlOp.fs | 12 +- WoofWare.PawPrint/Program.fs | 25 ++- WoofWare.PawPrint/TypeInfo.fs | 2 + WoofWare.PawPrint/UnaryMetadataIlOp.fs | 112 ++++++++--- 10 files changed, 438 insertions(+), 165 deletions(-) diff --git a/WoofWare.PawPrint/AbstractMachine.fs b/WoofWare.PawPrint/AbstractMachine.fs index 3bcb7de..342802e 100644 --- a/WoofWare.PawPrint/AbstractMachine.fs +++ b/WoofWare.PawPrint/AbstractMachine.fs @@ -68,7 +68,10 @@ module AbstractMachine = match outcome with | ExecutionResult.Terminated (state, terminating) -> ExecutionResult.Terminated (state, terminating) | ExecutionResult.Stepped (state, whatWeDid) -> - ExecutionResult.Stepped (IlMachineState.returnStackFrame thread state |> Option.get, whatWeDid) + ExecutionResult.Stepped ( + IlMachineState.returnStackFrame loggerFactory thread state |> Option.get, + whatWeDid + ) | Some instructions -> @@ -93,7 +96,7 @@ module AbstractMachine = ) match instruction.ExecutingMethod.Instructions.Value.Locations.[instruction.IlOpIndex] with - | IlOp.Nullary op -> NullaryIlOp.execute state thread op + | IlOp.Nullary op -> NullaryIlOp.execute loggerFactory state thread op | IlOp.UnaryConst unaryConstIlOp -> UnaryConstIlOp.execute state thread unaryConstIlOp |> ExecutionResult.Stepped | IlOp.UnaryMetadataToken (unaryMetadataTokenIlOp, bytes) -> diff --git a/WoofWare.PawPrint/Assembly.fs b/WoofWare.PawPrint/Assembly.fs index 3b11457..839127a 100644 --- a/WoofWare.PawPrint/Assembly.fs +++ b/WoofWare.PawPrint/Assembly.fs @@ -245,6 +245,10 @@ type DumpedAssembly = interface IDisposable with member this.Dispose () = this.PeReader.Dispose () +type TypeResolutionResult = + | FirstLoadAssy of WoofWare.PawPrint.AssemblyReference + | Resolved of DumpedAssembly * TypeInfo + [] module Assembly = let read (loggerFactory : ILoggerFactory) (originalPath : string option) (dllBytes : Stream) : DumpedAssembly = @@ -264,7 +268,7 @@ module Assembly = let builder = ImmutableDictionary.CreateBuilder () for ref in metadataReader.AssemblyReferences do - builder.Add (ref, AssemblyReference.make (metadataReader.GetAssemblyReference ref)) + builder.Add (ref, AssemblyReference.make ref (metadataReader.GetAssemblyReference ref)) builder.ToImmutable () @@ -419,3 +423,92 @@ module Assembly = instructions.Instructions |> List.map (fun (op, index) -> IlOp.Format op index) |> List.iter Console.WriteLine + + let rec resolveTypeRef + (assemblies : ImmutableDictionary) + (referencedInAssembly : DumpedAssembly) + (target : TypeRef) + : TypeResolutionResult + = + match target.ResolutionScope with + | TypeRefResolutionScope.Assembly r -> + let assemblyRef = referencedInAssembly.AssemblyReferences.[r] + let assemblyName = assemblyRef.Name + + match assemblies.TryGetValue assemblyName.FullName with + | false, _ -> TypeResolutionResult.FirstLoadAssy assemblyRef + | true, assy -> + + let nsPath = target.Namespace.Split '.' |> Array.toList + + let targetNs = assy.NonRootNamespaces.[nsPath] + + let targetType = + targetNs.TypeDefinitions + |> Seq.choose (fun td -> + let ty = assy.TypeDefs.[td] + + if ty.Name = target.Name && ty.Namespace = target.Namespace then + Some ty + else + None + ) + |> Seq.toList + + match targetType with + | [ t ] -> + // If resolved from TypeDef (above), it won't have generic parameters, I hope? + let t = + t |> TypeInfo.mapGeneric (fun _ -> failwith "no generic parameters") + + TypeResolutionResult.Resolved (assy, t) + | _ :: _ :: _ -> failwith $"Multiple matching type definitions! {nsPath} {target.Name}" + | [] -> + match assy.ExportedType (Some target.Namespace) target.Name with + | None -> failwith $"Failed to find type {nsPath} {target.Name} in {assy.Name.FullName}!" + | Some ty -> resolveTypeFromExport assy assemblies ty + | k -> failwith $"Unexpected: {k}" + + and internal resolveTypeFromName + (assy : DumpedAssembly) + (assemblies : ImmutableDictionary) + (ns : string option) + (name : string) + : TypeResolutionResult + = + match ns with + | None -> failwith "what are the semantics here" + | Some ns -> + + match assy.TypeDef ns name with + | Some typeDef -> + // If resolved from TypeDef, it won't have generic parameters, I hope? + let typeDef = + typeDef + |> TypeInfo.mapGeneric (fun _ -> failwith "no generic parameters") + + TypeResolutionResult.Resolved (assy, typeDef) + | None -> + + match assy.TypeRef ns name with + | Some typeRef -> resolveTypeRef assemblies assy typeRef + | None -> + + match assy.ExportedType (Some ns) name with + | Some export -> resolveTypeFromExport assy assemblies export + | None -> failwith $"TODO: type resolution unimplemented for {ns} {name}" + + and resolveTypeFromExport + (fromAssembly : DumpedAssembly) + (assemblies : ImmutableDictionary) + (ty : WoofWare.PawPrint.ExportedType) + : TypeResolutionResult + = + match ty.Data with + | NonForwarded _ -> failwith "Somehow didn't find type definition but it is exported" + | ForwardsTo assy -> + let assy = fromAssembly.AssemblyReferences.[assy] + + match assemblies.TryGetValue assy.Name.FullName with + | false, _ -> TypeResolutionResult.FirstLoadAssy assy + | true, toAssy -> resolveTypeFromName toAssy assemblies ty.Namespace ty.Name diff --git a/WoofWare.PawPrint/AssemblyReference.fs b/WoofWare.PawPrint/AssemblyReference.fs index 0be8a15..ca71779 100644 --- a/WoofWare.PawPrint/AssemblyReference.fs +++ b/WoofWare.PawPrint/AssemblyReference.fs @@ -2,9 +2,11 @@ namespace WoofWare.PawPrint open System open System.Reflection +open System.Reflection.Metadata type AssemblyReference = { + Handle : AssemblyReferenceHandle Culture : StringToken Flags : AssemblyFlags Name : AssemblyName @@ -13,8 +15,13 @@ type AssemblyReference = [] module AssemblyReference = - let make (ref : System.Reflection.Metadata.AssemblyReference) : AssemblyReference = + let make + (handle : AssemblyReferenceHandle) + (ref : System.Reflection.Metadata.AssemblyReference) + : AssemblyReference + = { + Handle = handle Culture = StringToken.String ref.Culture Flags = ref.Flags Name = ref.GetAssemblyName () diff --git a/WoofWare.PawPrint/BasicCliType.fs b/WoofWare.PawPrint/BasicCliType.fs index 09b4945..a6cce9c 100644 --- a/WoofWare.PawPrint/BasicCliType.fs +++ b/WoofWare.PawPrint/BasicCliType.fs @@ -91,9 +91,19 @@ type CliType = static member OfManagedObject (ptr : ManagedHeapAddress) = CliType.ObjectRef (Some ptr) +type CliTypeResolutionResult = + | Resolved of CliType + | FirstLoad of WoofWare.PawPrint.AssemblyReference + [] module CliType = - let rec zeroOf (generics : TypeDefn ImmutableArray) (ty : TypeDefn) : CliType = + let rec zeroOf + (assemblies : ImmutableDictionary) + (assy : DumpedAssembly) + (generics : TypeDefn ImmutableArray) + (ty : TypeDefn) + : CliTypeResolutionResult + = match ty with | TypeDefn.PrimitiveType primitiveType -> match primitiveType with @@ -111,33 +121,44 @@ module CliType = | PrimitiveType.Double -> CliType.Numeric (CliNumericType.Float64 0.0) | PrimitiveType.String -> CliType.ObjectRef None | PrimitiveType.TypedReference -> failwith "todo" - | PrimitiveType.IntPtr -> failwith "todo" - | PrimitiveType.UIntPtr -> failwith "todo" + | PrimitiveType.IntPtr -> CliType.Numeric (CliNumericType.Int64 0L) + | PrimitiveType.UIntPtr -> CliType.Numeric (CliNumericType.Int64 0L) | PrimitiveType.Object -> CliType.ObjectRef None - | TypeDefn.Array _ -> CliType.ObjectRef None + |> CliTypeResolutionResult.Resolved + | TypeDefn.Array _ -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved | TypeDefn.Pinned typeDefn -> failwith "todo" - | TypeDefn.Pointer _ -> CliType.ObjectRef None - | TypeDefn.Byref _ -> CliType.ObjectRef None - | TypeDefn.OneDimensionalArrayLowerBoundZero _ -> CliType.ObjectRef None + | TypeDefn.Pointer _ -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved + | TypeDefn.Byref _ -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved + | TypeDefn.OneDimensionalArrayLowerBoundZero _ -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved | TypeDefn.Modified (original, afterMod, modificationRequired) -> failwith "todo" | TypeDefn.FromReference (typeRef, signatureTypeKind) -> match signatureTypeKind with | SignatureTypeKind.Unknown -> failwith "todo" - | SignatureTypeKind.ValueType -> failwith "todo" - | SignatureTypeKind.Class -> CliType.ObjectRef None + | SignatureTypeKind.ValueType -> + match Assembly.resolveTypeRef assemblies assy typeRef with + | TypeResolutionResult.Resolved (_, ty) -> failwith $"TODO: {ty}" + | TypeResolutionResult.FirstLoadAssy assy -> CliTypeResolutionResult.FirstLoad assy + | SignatureTypeKind.Class -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved | _ -> raise (ArgumentOutOfRangeException ()) | TypeDefn.FromDefinition (typeDefinitionHandle, signatureTypeKind) -> match signatureTypeKind with | SignatureTypeKind.Unknown -> failwith "todo" - | SignatureTypeKind.ValueType -> failwith "todo" - | SignatureTypeKind.Class -> CliType.ObjectRef None + | SignatureTypeKind.ValueType -> + let typeDef = assy.TypeDefs.[typeDefinitionHandle] + + let fields = + typeDef.Fields + |> List.map (fun fi -> zeroOf assemblies assy generics fi.Signature) + + CliType.ObjectRef None |> CliTypeResolutionResult.Resolved + | SignatureTypeKind.Class -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved | _ -> raise (ArgumentOutOfRangeException ()) | TypeDefn.GenericInstantiation (generic, args) -> // TODO: this is rather concerning and probably incorrect - zeroOf args generic + zeroOf assemblies assy args generic | TypeDefn.FunctionPointer typeMethodSignature -> 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 -> zeroOf generics generics.[index] + zeroOf assemblies assy generics generics.[index] + | TypeDefn.GenericMethodParameter index -> zeroOf assemblies assy generics generics.[index] | TypeDefn.Void -> failwith "should never construct an element of type Void" diff --git a/WoofWare.PawPrint/IlMachineState.fs b/WoofWare.PawPrint/IlMachineState.fs index bdaf8c3..6a39ef7 100644 --- a/WoofWare.PawPrint/IlMachineState.fs +++ b/WoofWare.PawPrint/IlMachineState.fs @@ -198,27 +198,11 @@ module IlMachineState = (state : IlMachineState) : IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo = - match ns with - | None -> failwith "what are the semantics here" - | Some ns -> - - match assy.TypeDef ns name with - | Some typeDef -> - // If resolved from TypeDef, it won't have generic parameters, I hope? - let typeDef = - typeDef - |> TypeInfo.mapGeneric (fun _ -> failwith "no generic parameters") - - state, assy, typeDef - | None -> - - match assy.TypeRef ns name with - | Some typeRef -> resolveTypeFromRef loggerFactory assy typeRef state - | None -> - - match assy.ExportedType (Some ns) name with - | Some export -> resolveTypeFromExport loggerFactory assy export state - | None -> failwith $"TODO: type resolution unimplemented for {ns} {name}" + match Assembly.resolveTypeFromName assy state._LoadedAssemblies ns name with + | TypeResolutionResult.Resolved (assy, typeDef) -> state, assy, typeDef + | TypeResolutionResult.FirstLoadAssy loadFirst -> + let state, _, _ = loadAssembly loggerFactory assy loadFirst.Handle state + resolveTypeFromName loggerFactory ns name assy state and resolveTypeFromExport (loggerFactory : ILoggerFactory) @@ -227,11 +211,11 @@ module IlMachineState = (state : IlMachineState) : IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo = - match ty.Data with - | NonForwarded _ -> failwith "Somehow didn't find type definition but it is exported" - | ForwardsTo assy -> - let state, targetAssy, _ = loadAssembly loggerFactory fromAssembly assy state - resolveTypeFromName loggerFactory ty.Namespace ty.Name targetAssy state + match Assembly.resolveTypeFromExport fromAssembly state._LoadedAssemblies ty with + | TypeResolutionResult.Resolved (assy, typeDef) -> state, assy, typeDef + | TypeResolutionResult.FirstLoadAssy loadFirst -> + let state, _, _ = loadAssembly loggerFactory fromAssembly loadFirst.Handle state + resolveTypeFromExport loggerFactory fromAssembly ty state and resolveTypeFromRef (loggerFactory : ILoggerFactory) @@ -240,40 +224,13 @@ module IlMachineState = (state : IlMachineState) : IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo = - match target.ResolutionScope with - | TypeRefResolutionScope.Assembly r -> - let state, assy, newAssyName = - loadAssembly loggerFactory referencedInAssembly r state + match Assembly.resolveTypeRef state._LoadedAssemblies referencedInAssembly target with + | TypeResolutionResult.Resolved (assy, typeDef) -> state, assy, typeDef + | TypeResolutionResult.FirstLoadAssy loadFirst -> + let state, _, _ = + loadAssembly loggerFactory referencedInAssembly loadFirst.Handle state - let nsPath = target.Namespace.Split '.' |> Array.toList - - let targetNs = assy.NonRootNamespaces.[nsPath] - - let targetType = - targetNs.TypeDefinitions - |> Seq.choose (fun td -> - let ty = assy.TypeDefs.[td] - - if ty.Name = target.Name && ty.Namespace = target.Namespace then - Some ty - else - None - ) - |> Seq.toList - - match targetType with - | [ t ] -> - // If resolved from TypeDef (above), it won't have generic parameters, I hope? - let t = - t |> TypeInfo.mapGeneric (fun _ -> failwith "no generic parameters") - - state, assy, t - | _ :: _ :: _ -> failwith $"Multiple matching type definitions! {nsPath} {target.Name}" - | [] -> - match assy.ExportedType (Some target.Namespace) target.Name with - | None -> failwith $"Failed to find type {nsPath} {target.Name} in {assy.Name.FullName}!" - | Some ty -> resolveTypeFromExport loggerFactory assy ty state - | k -> failwith $"Unexpected: {k}" + resolveTypeFromRef loggerFactory referencedInAssembly target state and resolveType (loggerFactory : ILoggerFactory) @@ -309,7 +266,7 @@ module IlMachineState = | TypeDefn.FromDefinition (defn, _typeKind) -> state, assy, assy.TypeDefs.[defn], None | s -> failwith $"TODO: resolveTypeFromDefn unimplemented for {s}" - let rec resolveTypeFromSpec + let resolveTypeFromSpec (loggerFactory : ILoggerFactory) (ty : TypeSpecificationHandle) (assy : DumpedAssembly) @@ -330,7 +287,22 @@ module IlMachineState = let generic = TypeInfo.withGenerics args generic state, assy, generic + let rec cliTypeZeroOf + (loggerFactory : ILoggerFactory) + (assy : DumpedAssembly) + (ty : TypeDefn) + (generics : TypeDefn ImmutableArray) + (state : IlMachineState) + : IlMachineState * CliType + = + match CliType.zeroOf state._LoadedAssemblies assy generics ty with + | CliTypeResolutionResult.Resolved result -> state, result + | CliTypeResolutionResult.FirstLoad ref -> + let state, _, _ = loadAssembly loggerFactory assy ref.Handle state + cliTypeZeroOf loggerFactory assy ty generics state + let callMethod + (loggerFactory : ILoggerFactory) (wasInitialising : (TypeDefinitionHandle * AssemblyName) option) (wasConstructing : ManagedHeapAddress option) (wasClassConstructor : bool) @@ -341,9 +313,25 @@ module IlMachineState = (state : IlMachineState) : IlMachineState = + let state, argZeroObjects = + ((state, []), methodToCall.Signature.ParameterTypes) + ||> List.fold (fun (state, zeros) ty -> + let state, zero = + cliTypeZeroOf + loggerFactory + (state.ActiveAssembly thread) + ty + (generics |> Option.defaultValue ImmutableArray.Empty) + state + + state, zero :: zeros + ) + + let argZeroObjects = List.rev argZeroObjects + let activeMethodState = threadState.MethodStates.[threadState.ActiveMethodState] - let newFrame, oldFrame = + let state, newFrame, oldFrame = if methodToCall.IsStatic then let args = ImmutableArray.CreateBuilder methodToCall.Parameters.Length let mutable afterPop = activeMethodState @@ -351,10 +339,7 @@ module IlMachineState = for i = 0 to methodToCall.Parameters.Length - 1 do let poppedArg, afterPop' = afterPop |> MethodState.popFromStack - let zeroArg = - CliType.zeroOf - (generics |> Option.defaultValue ImmutableArray.Empty) - methodToCall.Signature.ParameterTypes.[i] + let zeroArg = argZeroObjects.[i] let poppedArg = EvalStackValue.toCliTypeCoerced zeroArg poppedArg afterPop <- afterPop' @@ -362,16 +347,37 @@ module IlMachineState = args.Reverse () - let newFrame = - MethodState.Empty - methodToCall - (args.ToImmutable ()) - (Some - { - JumpTo = threadState.ActiveMethodState - WasInitialisingType = wasInitialising - WasConstructingObj = wasConstructing - }) + let rec newFrame (state : IlMachineState) = + let meth = + MethodState.Empty + state._LoadedAssemblies + (state.ActiveAssembly thread) + methodToCall + (args.ToImmutable ()) + (Some + { + JumpTo = threadState.ActiveMethodState + WasInitialisingType = wasInitialising + WasConstructingObj = wasConstructing + }) + + match meth with + | Ok r -> state, r + | Error toLoad -> + (state, toLoad) + ||> List.fold (fun state (toLoad : WoofWare.PawPrint.AssemblyReference) -> + let state, _, _ = + loadAssembly + loggerFactory + (state.LoadedAssembly (snd methodToCall.DeclaringType) |> Option.get) + toLoad.Handle + state + + state + ) + |> newFrame + + let state, newFrame = newFrame state let oldFrame = if wasClassConstructor then @@ -379,7 +385,7 @@ module IlMachineState = else afterPop |> MethodState.advanceProgramCounter - newFrame, oldFrame + state, newFrame, oldFrame else let args = ImmutableArray.CreateBuilder (methodToCall.Parameters.Length + 1) let poppedArg, afterPop = activeMethodState |> MethodState.popFromStack @@ -387,9 +393,7 @@ module IlMachineState = for i = 1 to methodToCall.Parameters.Length do let poppedArg, afterPop' = afterPop |> MethodState.popFromStack - // TODO: generics - let zeroArg = - CliType.zeroOf ImmutableArray.Empty methodToCall.Signature.ParameterTypes.[i - 1] + let zeroArg = argZeroObjects.[i - 1] let poppedArg = EvalStackValue.toCliTypeCoerced zeroArg poppedArg afterPop <- afterPop' @@ -403,19 +407,39 @@ module IlMachineState = args.Reverse () - let newFrame = - MethodState.Empty - methodToCall - (args.ToImmutable ()) - (Some - { - JumpTo = threadState.ActiveMethodState - WasInitialisingType = wasInitialising - WasConstructingObj = wasConstructing - }) + let rec newFrame (state : IlMachineState) = + let meth = + MethodState.Empty + state._LoadedAssemblies + (state.ActiveAssembly thread) + methodToCall + (args.ToImmutable ()) + (Some + { + JumpTo = threadState.ActiveMethodState + WasInitialisingType = wasInitialising + WasConstructingObj = wasConstructing + }) + match meth with + | Ok r -> state, r + | Error toLoad -> + (state, toLoad) + ||> List.fold (fun state (toLoad : WoofWare.PawPrint.AssemblyReference) -> + let state, _, _ = + loadAssembly + loggerFactory + (state.LoadedAssembly (snd methodToCall.DeclaringType) |> Option.get) + toLoad.Handle + state + + state + ) + |> newFrame + + let state, newFrame = newFrame state let oldFrame = afterPop |> MethodState.advanceProgramCounter - newFrame, oldFrame + state, newFrame, oldFrame let newThreadState = { threadState with @@ -535,6 +559,7 @@ module IlMachineState = let currentThreadState = state.ThreadState.[currentThread] callMethod + loggerFactory (Some (typeDefHandle, assemblyName)) None true @@ -555,6 +580,26 @@ module IlMachineState = |> fst |> NothingToDo + let ensureTypeInitialised + (loggerFactory : ILoggerFactory) + (thread : ThreadId) + (ty : TypeDefinitionHandle * AssemblyName) + (state : IlMachineState) + : IlMachineState * WhatWeDid + = + match TypeInitTable.tryGet ty state.TypeInitTable with + | None -> + match loadClass loggerFactory (fst ty) (snd 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 callMethodInActiveAssembly (loggerFactory : ILoggerFactory) (thread : ThreadId) @@ -566,25 +611,14 @@ module IlMachineState = = let threadState = state.ThreadState.[thread] - 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 false generics methodToCall thread threadState state, - WhatWeDid.Executed - | FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit - | Some TypeInitState.Initialized -> - callMethod None weAreConstructingObj false generics methodToCall thread threadState state, + let state, typeInit = + ensureTypeInitialised loggerFactory thread methodToCall.DeclaringType state + + match typeInit with + | WhatWeDid.Executed -> + callMethod loggerFactory None weAreConstructingObj false generics 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 generics methodToCall thread threadState state, - WhatWeDid.Executed - else - state, WhatWeDid.BlockedOnClassInit threadId + | _ -> state, typeInit let initial (lf : ILoggerFactory) @@ -861,7 +895,12 @@ module IlMachineState = state, assy.Name, Choice1Of2 method /// There might be no stack frame to return to, so you might get None. - let returnStackFrame (currentThread : ThreadId) (state : IlMachineState) : IlMachineState option = + let returnStackFrame + (loggerFactory : ILoggerFactory) + (currentThread : ThreadId) + (state : IlMachineState) + : IlMachineState option + = let threadStateAtEndOfMethod = state.ThreadState.[currentThread] match threadStateAtEndOfMethod.MethodState.ReturnState with @@ -906,8 +945,15 @@ module IlMachineState = | TypeDefn.Void -> state | retType -> // TODO: generics - let toPush = - EvalStackValue.toCliTypeCoerced (CliType.zeroOf ImmutableArray.Empty retType) retVal + let state, zero = + cliTypeZeroOf + loggerFactory + (state.ActiveAssembly currentThread) + retType + ImmutableArray.Empty + state + + let toPush = EvalStackValue.toCliTypeCoerced zero retVal state |> pushToEvalStack toPush currentThread | _ -> diff --git a/WoofWare.PawPrint/MethodState.fs b/WoofWare.PawPrint/MethodState.fs index 19c13d3..2889463 100644 --- a/WoofWare.PawPrint/MethodState.fs +++ b/WoofWare.PawPrint/MethodState.fs @@ -102,10 +102,12 @@ and MethodState = /// If `method` is an instance method, `args` must be of length 1+numParams. /// If `method` is static, `args` must be of length numParams. static member Empty + (loadedAssemblies : ImmutableDictionary) + (containingAssembly : DumpedAssembly) (method : WoofWare.PawPrint.MethodInfo) (args : ImmutableArray) (returnState : MethodReturnState option) - : MethodState + : Result = do if method.IsStatic then @@ -125,11 +127,24 @@ and MethodState = | Some vars -> vars // 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 requiredAssemblies = ResizeArray () + let localVars = // TODO: generics? - localVariableSig - |> Seq.map (CliType.zeroOf ImmutableArray.Empty) - |> ImmutableArray.CreateRange + let result = ImmutableArray.CreateBuilder () + + for var in localVariableSig do + match CliType.zeroOf loadedAssemblies containingAssembly ImmutableArray.Empty var with + | CliTypeResolutionResult.Resolved t -> result.Add t + | CliTypeResolutionResult.FirstLoad (assy : WoofWare.PawPrint.AssemblyReference) -> + requiredAssemblies.Add assy + + result.ToImmutable () + + if requiredAssemblies.Count > 0 then + Error (requiredAssemblies |> Seq.toList) + else { EvaluationStack = EvalStack.Empty @@ -140,3 +155,4 @@ and MethodState = LocalMemoryPool = () ReturnState = returnState } + |> Ok diff --git a/WoofWare.PawPrint/NullaryIlOp.fs b/WoofWare.PawPrint/NullaryIlOp.fs index b0877cd..dfdea0d 100644 --- a/WoofWare.PawPrint/NullaryIlOp.fs +++ b/WoofWare.PawPrint/NullaryIlOp.fs @@ -2,6 +2,8 @@ namespace WoofWare.PawPrint #nowarn "42" +open Microsoft.Extensions.Logging + type private IArithmeticOperation = abstract Int32Int32 : int32 -> int32 -> int32 abstract Int64Int64 : int64 -> int64 -> int64 @@ -108,7 +110,13 @@ module NullaryIlOp = | ManagedPointerSource.Heap managedHeapAddress -> failwith "todo" | EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo" - let internal execute (state : IlMachineState) (currentThread : ThreadId) (op : NullaryIlOp) : ExecutionResult = + let internal execute + (loggerFactory : ILoggerFactory) + (state : IlMachineState) + (currentThread : ThreadId) + (op : NullaryIlOp) + : ExecutionResult + = match op with | Nop -> (IlMachineState.advanceProgramCounter currentThread state, WhatWeDid.Executed) @@ -187,7 +195,7 @@ module NullaryIlOp = |> Tuple.withRight WhatWeDid.Executed |> ExecutionResult.Stepped | Ret -> - match IlMachineState.returnStackFrame currentThread state with + match IlMachineState.returnStackFrame loggerFactory currentThread state with | None -> ExecutionResult.Terminated (state, currentThread) | Some state -> (state, WhatWeDid.Executed) |> ExecutionResult.Stepped | LdcI4_0 -> diff --git a/WoofWare.PawPrint/Program.fs b/WoofWare.PawPrint/Program.fs index fcd767e..a415ce1 100644 --- a/WoofWare.PawPrint/Program.fs +++ b/WoofWare.PawPrint/Program.fs @@ -72,9 +72,17 @@ module Program = // We construct the thread here before we are entirely ready, because we need a thread from which to // initialise the class containing the main method. // Once we've obtained e.g. the String and Array classes, we can populate the args array. - |> IlMachineState.addThread - (MethodState.Empty mainMethod (ImmutableArray.CreateRange [ CliType.ObjectRef None ]) None) - dumped.Name + |> fun s -> + match + MethodState.Empty + s._LoadedAssemblies + dumped + mainMethod + (ImmutableArray.CreateRange [ CliType.ObjectRef None ]) + None + with + | Ok meth -> IlMachineState.addThread meth dumped.Name s + | Error requiresRefs -> failwith "TODO: I'd be surprised if this could ever happen in a valid program" let rec loadInitialState (state : IlMachineState) = match @@ -113,7 +121,16 @@ module Program = // Now that BCL initialisation has taken place, overwrite the main thread completely. let methodState = - MethodState.Empty mainMethod (ImmutableArray.Create (CliType.OfManagedObject arrayAllocation)) None + match + MethodState.Empty + state._LoadedAssemblies + dumped + mainMethod + (ImmutableArray.Create (CliType.OfManagedObject arrayAllocation)) + None + with + | Ok s -> s + | Error _ -> failwith "TODO: I'd be surprised if this could ever happen in a valid program" let threadState = { state.ThreadState.[mainThread] with diff --git a/WoofWare.PawPrint/TypeInfo.fs b/WoofWare.PawPrint/TypeInfo.fs index 6518331..cf0be63 100644 --- a/WoofWare.PawPrint/TypeInfo.fs +++ b/WoofWare.PawPrint/TypeInfo.fs @@ -55,6 +55,8 @@ type TypeInfo<'generic> = /// /// The base type that this type inherits from, or None for types that don't have a base type /// (like System.Object). + /// + /// Value types inherit *directly* from System.ValueType; enums directly from System.Enum. /// BaseType : BaseTypeInfo option diff --git a/WoofWare.PawPrint/UnaryMetadataIlOp.fs b/WoofWare.PawPrint/UnaryMetadataIlOp.fs index 0a55ffa..8737b11 100644 --- a/WoofWare.PawPrint/UnaryMetadataIlOp.fs +++ b/WoofWare.PawPrint/UnaryMetadataIlOp.fs @@ -64,6 +64,8 @@ module internal UnaryMetadataIlOp = | FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit | Callvirt -> + let logger = loggerFactory.CreateLogger "Callvirt" + let method, generics = match metadataToken with | MetadataToken.MethodDef defn -> @@ -79,6 +81,18 @@ module internal UnaryMetadataIlOp = | None -> failwith "nothing on stack when Callvirt called" | Some obj -> obj + do + let assy = state.LoadedAssembly (snd method.DeclaringType) |> Option.get + let ty = assy.TypeDefs.[fst method.DeclaringType] + + logger.LogTrace ( + "Calling method {Assembly}.{Type}.{CallvirtMethod} on object {CallvirtObject}", + assy.Name.Name, + ty.Name, + method.Name, + currentObj + ) + let methodToCall = match currentObj with | EvalStackValue.ManagedPointer src -> @@ -113,6 +127,8 @@ module internal UnaryMetadataIlOp = |> IlMachineState.callMethodInActiveAssembly loggerFactory thread generics methodToCall None | Castclass -> failwith "TODO: Castclass unimplemented" | Newobj -> + let logger = loggerFactory.CreateLogger "Newobj" + let state, assy, ctor = match metadataToken with | MethodDef md -> @@ -128,18 +144,42 @@ module internal UnaryMetadataIlOp = | Choice2Of2 _field -> failwith "unexpectedly NewObj found a constructor which is a field" | x -> failwith $"Unexpected metadata token for constructor: %O{x}" + let state, init = + IlMachineState.ensureTypeInitialised loggerFactory thread ctor.DeclaringType state + + match init with + | WhatWeDid.BlockedOnClassInit state -> failwith "TODO: another thread is running the initialiser" + | WhatWeDid.SuspendedForClassInit -> state, SuspendedForClassInit + | WhatWeDid.Executed -> + let ctorType, ctorAssembly = ctor.DeclaringType let ctorAssembly = state.LoadedAssembly ctorAssembly |> Option.get let ctorType = ctorAssembly.TypeDefs.[ctorType] - let fields = - ctorType.Fields - |> List.map (fun field -> - // 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 + do + logger.LogDebug ( + "Creating object of type {ConstructorAssembly}.{ConstructorType}", + ctorAssembly.Name.Name, + ctorType.Name ) + let state, fieldZeros = + ((state, []), ctorType.Fields) + ||> List.fold (fun (state, zeros) field -> + // TODO: generics + let state, zero = + IlMachineState.cliTypeZeroOf + loggerFactory + ctorAssembly + field.Signature + ImmutableArray.Empty + state + + state, (field.Name, zero) :: zeros + ) + + let fields = List.rev fieldZeros + let allocatedAddr, state = IlMachineState.allocateManagedObject ctorType fields state @@ -175,21 +215,26 @@ module internal UnaryMetadataIlOp = | EvalStackValue.Int32 v -> v | popped -> failwith $"unexpectedly popped value %O{popped} to serve as array len" - let elementType = + let elementType, baseType = match metadataToken with | MetadataToken.TypeDefinition defn -> - state.LoadedAssembly currentState.ActiveAssembly - |> Option.get - |> fun assy -> assy.TypeDefs.[defn] - | x -> failwith $"TODO: Newarr element type resolution unimplemented for {x}" + let assy = state.LoadedAssembly currentState.ActiveAssembly |> Option.get + let elementType = assy.TypeDefs.[defn] - let baseType = - elementType.BaseType - |> TypeInfo.resolveBaseType - (fun (x : DumpedAssembly) -> x.Name) - (fun x y -> x.TypeDefs.[y]) - baseClassTypes - elementType.Assembly + let baseType = + elementType.BaseType + |> TypeInfo.resolveBaseType + (fun (x : DumpedAssembly) -> x.Name) + (fun x y -> x.TypeDefs.[y]) + baseClassTypes + elementType.Assembly + + elementType, baseType + | MetadataToken.TypeSpecification spec -> + let assy = state.LoadedAssembly currentState.ActiveAssembly |> Option.get + let elementType = assy.TypeSpecs.[spec] + failwith "" + | x -> failwith $"TODO: Newarr element type resolution unimplemented for {x}" let zeroOfType = match baseType with @@ -254,8 +299,16 @@ module internal UnaryMetadataIlOp = let valueToStore, state = IlMachineState.popEvalStack thread state - let valueToStore = - EvalStackValue.toCliTypeCoerced (CliType.zeroOf ImmutableArray.Empty field.Signature) valueToStore + let state, zero = + // TODO: generics + IlMachineState.cliTypeZeroOf + loggerFactory + (state.ActiveAssembly thread) + field.Signature + ImmutableArray.Empty + state + + let valueToStore = EvalStackValue.toCliTypeCoerced zero valueToStore let currentObj, state = IlMachineState.popEvalStack thread state @@ -328,8 +381,11 @@ module internal UnaryMetadataIlOp = let popped, state = IlMachineState.popEvalStack thread state - let toStore = - EvalStackValue.toCliTypeCoerced (CliType.zeroOf ImmutableArray.Empty field.Signature) popped + let state, zero = + // TODO: generics + IlMachineState.cliTypeZeroOf loggerFactory activeAssy field.Signature ImmutableArray.Empty state + + let toStore = EvalStackValue.toCliTypeCoerced zero popped let state = state.SetStatic (field.DeclaringType, activeAssy.Name) field.Name toStore @@ -427,19 +483,23 @@ module internal UnaryMetadataIlOp = | FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit | NothingToDo state -> + // TODO: generics + let generics = ImmutableArray.Empty + let fieldValue, state = match state.Statics.TryGetValue ((field.DeclaringType, activeAssy.Name)) with | false, _ -> - // TODO: generics - let newVal = CliType.zeroOf ImmutableArray.Empty field.Signature + let state, newVal = + IlMachineState.cliTypeZeroOf loggerFactory activeAssy field.Signature generics state newVal, state.SetStatic (field.DeclaringType, activeAssy.Name) field.Name newVal | true, v -> match v.TryGetValue field.Name with | true, v -> v, state | false, _ -> - // TODO: generics - let newVal = CliType.zeroOf ImmutableArray.Empty field.Signature + let state, newVal = + IlMachineState.cliTypeZeroOf loggerFactory activeAssy field.Signature generics state + newVal, state.SetStatic (field.DeclaringType, activeAssy.Name) field.Name newVal do