diff --git a/CSharpExample/CSharpExample.csproj b/CSharpExample/CSharpExample.csproj new file mode 100644 index 0000000..d2a210c --- /dev/null +++ b/CSharpExample/CSharpExample.csproj @@ -0,0 +1,7 @@ + + + + netstandard2.0 + + + diff --git a/CSharpExample/Class1.cs b/CSharpExample/Class1.cs new file mode 100644 index 0000000..bc2bfb3 --- /dev/null +++ b/CSharpExample/Class1.cs @@ -0,0 +1,17 @@ +using System; +using System.IO; + +namespace HelloWorldApp +{ + class Program + { + static int Main(string[] args) + { + object locker = new FileInfo("hi"); + lock (locker) + { + return 1; + } + } + } +} diff --git a/WoofWare.PawPrint.Test/LoggerFactory.fs b/WoofWare.PawPrint.Test/LoggerFactory.fs index a557b43..cdaab81 100644 --- a/WoofWare.PawPrint.Test/LoggerFactory.fs +++ b/WoofWare.PawPrint.Test/LoggerFactory.fs @@ -10,6 +10,10 @@ type LogLine = Message : string } + /// Human-readable representation of this log line. + override this.ToString () = + $"%s{this.LoggerName} [%O{this.Level}]: %s{this.Message}" + /// Very small, in-memory implementation of `ILoggerFactory` for unit tests. [] module LoggerFactory = diff --git a/WoofWare.PawPrint.Test/TestBasicLock.fs b/WoofWare.PawPrint.Test/TestBasicLock.fs new file mode 100644 index 0000000..e09033f --- /dev/null +++ b/WoofWare.PawPrint.Test/TestBasicLock.fs @@ -0,0 +1,43 @@ +namespace WoofWare.Pawprint.Test + +open System.Collections.Immutable +open System.IO +open FsUnitTyped +open NUnit.Framework +open WoofWare.PawPrint +open WoofWare.PawPrint.Test +open WoofWare.DotnetRuntimeLocator + +[] +module TestBasicLick = + let assy = typeof.Assembly + + [] + let ``Can run BasicLock`` () : unit = + let source = Assembly.getEmbeddedResourceAsString "BasicLock.cs" assy + let image = Roslyn.compile [ source ] + let messages, loggerFactory = LoggerFactory.makeTest () + + let dotnetRuntimes = + DotnetRuntime.SelectForDll assy.Location |> ImmutableArray.CreateRange + + use peImage = new MemoryStream (image) + + try + let terminalState, terminatingThread = + Program.run loggerFactory peImage dotnetRuntimes [] + + let exitCode = + match terminalState.ThreadState.[terminatingThread].MethodState.EvaluationStack.Values with + | [] -> failwith "expected program to return 1, but it returned void" + | head :: _ -> + match head with + | EvalStackValue.Int32 i -> i + | _ -> failwith "TODO" + + exitCode |> shouldEqual 0 + finally + let messages = messages () + + for message in messages do + System.Console.WriteLine $"%O{message}" diff --git a/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj b/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj index 31b1cec..571f23a 100644 --- a/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj +++ b/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj @@ -16,6 +16,8 @@ + + diff --git a/WoofWare.PawPrint.Test/sources/BasicLock.cs b/WoofWare.PawPrint.Test/sources/BasicLock.cs new file mode 100644 index 0000000..bec43ea --- /dev/null +++ b/WoofWare.PawPrint.Test/sources/BasicLock.cs @@ -0,0 +1,16 @@ +using System; + +namespace HelloWorldApp +{ + class Program + { + static int Main(string[] args) + { + object locker = new object(); + lock (locker) + { + return 1; + } + } + } +} diff --git a/WoofWare.PawPrint.sln b/WoofWare.PawPrint.sln index 43c4df4..04b887e 100644 --- a/WoofWare.PawPrint.sln +++ b/WoofWare.PawPrint.sln @@ -9,6 +9,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.PawPrint.Test", "W EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "HelloWorld", "HelloWorld\HelloWorld.fsproj", "{E74D79B2-1C4D-4B21-BECB-83D361D54C02}" EndProject +Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "CSharpExample", "CSharpExample\CSharpExample.csproj", "{250EF9D0-7C29-4AFF-844B-13CC68962B21}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -31,5 +33,9 @@ Global {E74D79B2-1C4D-4B21-BECB-83D361D54C02}.Debug|Any CPU.Build.0 = Debug|Any CPU {E74D79B2-1C4D-4B21-BECB-83D361D54C02}.Release|Any CPU.ActiveCfg = Release|Any CPU {E74D79B2-1C4D-4B21-BECB-83D361D54C02}.Release|Any CPU.Build.0 = Release|Any CPU + {250EF9D0-7C29-4AFF-844B-13CC68962B21}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {250EF9D0-7C29-4AFF-844B-13CC68962B21}.Debug|Any CPU.Build.0 = Debug|Any CPU + {250EF9D0-7C29-4AFF-844B-13CC68962B21}.Release|Any CPU.ActiveCfg = Release|Any CPU + {250EF9D0-7C29-4AFF-844B-13CC68962B21}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection EndGlobal diff --git a/WoofWare.PawPrint/AbstractMachine.fs b/WoofWare.PawPrint/AbstractMachine.fs index 8a87533..4a3fd90 100644 --- a/WoofWare.PawPrint/AbstractMachine.fs +++ b/WoofWare.PawPrint/AbstractMachine.fs @@ -1,7 +1,5 @@ namespace WoofWare.PawPrint -open System -open System.Collections.Generic open System.Collections.Immutable open System.IO open System.Reflection @@ -9,135 +7,100 @@ open System.Reflection.Metadata open Microsoft.Extensions.Logging open Microsoft.FSharp.Core -type ThreadId = | ThreadId of int +type FieldSlot = + { + FieldName : string + FieldSize : int + } -type ManagedHeapAddress = | ManagedHeapAddress of int - -type EvalStackValue = - | Int32 of int32 - | Int64 of int64 - | NativeInt of int64 - | Float of float - /// allowed to be null - | ManagedPointer of ManagedHeapAddress option - | ObjectRef of ManagedHeapAddress - | TransientPointer of int - | UserDefinedValueType - -type BasicCliObject = - /// Can be assigned the null value 0 - /// This is the 'O' type. - | ObjectReference of ManagedHeapAddress option - /// This is the '&' type. - | PointerType of ManagedHeapAddress option - | Int32 of int32 - | Int64 of int64 - | NativeInt of int64 - | NativeFloat of float - -type CliObject = - private - | Basic of BasicCliObject - | Bool of byte - /// A UTF-16 code unit, i.e. two bytes. We store the most significant one first. - | Char of byte * byte - | UInt8 of uint8 - | UInt16 of uint16 - | Int8 of int8 - | Int16 of int16 - | Float32 of float32 - | Float64 of float32 - - /// In fact any non-zero value will do for True, but we'll use 1 - static member OfBool (b : bool) = CliObject.Bool (if b then 1uy else 0uy) - - static member OfChar (c : char) = - CliObject.Char (byte (int c / 256), byte (int c % 256)) - - static member OfManagedObject (ptr : ManagedHeapAddress) = - CliObject.Basic (BasicCliObject.ObjectReference (Some ptr)) +type ManagedObject = + { + Fields : (string * CliType) list + SyncBlock : unit + } type ReferenceType = | String of string - | ManagedObject + | ManagedObject of fields : FieldSlot list | Array of len : int * containedType : Type - static member SizeOnHeap (r : ReferenceType) = - match r with - | ReferenceType.String s -> 2 * s.Length - | ReferenceType.ManagedObject -> 8 - | ReferenceType.Array (len, ty) -> Type.SizeOf ty * len + 4 // for the len - and Type = | ReferenceType of ReferenceType | ValueType - static member SizeOf (t : Type) : int = +[] +module Type = + let rec sizeOnHeapRef (r : ReferenceType) : int = + match r with + | ReferenceType.String s -> + // UTF-16, so two bytes per char + 2 * s.Length + | ReferenceType.ManagedObject fields -> fields |> Seq.sumBy (fun slot -> slot.FieldSize) + | ReferenceType.Array (len, ty) -> sizeOf ty * len + 4 // for the len + + and sizeOf (t : Type) : int = match t with - | ReferenceType t -> ReferenceType.SizeOnHeap t + | ReferenceType t -> sizeOnHeapRef t | ValueType -> failwith "todo" + let sizeOfTypeDefn (assy : DumpedAssembly) (t : WoofWare.PawPrint.TypeDefn) : int = + match t with + | TypeDefn.PrimitiveType prim -> + match prim with + | PrimitiveType.Void -> failwith "todo" + | PrimitiveType.Boolean -> failwith "todo" + | PrimitiveType.Char -> failwith "todo" + | PrimitiveType.SByte -> failwith "todo" + | PrimitiveType.Byte -> failwith "todo" + | PrimitiveType.Int16 -> failwith "todo" + | PrimitiveType.UInt16 -> failwith "todo" + | PrimitiveType.Int32 -> 4 + | PrimitiveType.UInt32 -> failwith "todo" + | PrimitiveType.Int64 -> failwith "todo" + | PrimitiveType.UInt64 -> failwith "todo" + | PrimitiveType.Single -> failwith "todo" + | PrimitiveType.Double -> failwith "todo" + | PrimitiveType.String -> failwith "todo" + | PrimitiveType.TypedReference -> failwith "todo" + | PrimitiveType.IntPtr -> failwith "todo" + | PrimitiveType.UIntPtr -> failwith "todo" + | PrimitiveType.Object -> failwith "todo" + | TypeDefn.FromDefinition (handle, kind) -> + match kind with + | SignatureTypeKind.Unknown -> failwith "todo" + | SignatureTypeKind.Class -> 8 + | SignatureTypeKind.ValueType -> + let ty = assy.TypeDefs.[handle] + failwith $"TODO: %O{ty}" + | s -> raise (System.ArgumentOutOfRangeException ()) + | _ -> failwith $"oh no: %O{t}" -type EvalStack = - { - Values : EvalStackValue list - } - - static member Empty : EvalStack = - { - Values = [] - } - - static member Pop (stack : EvalStack) : EvalStackValue * EvalStack = - match stack.Values with - | [] -> failwith "eval stack was empty on pop instruction" - | v :: rest -> - let stack = - { - Values = rest - } - - v, stack - - static member Push (v : CliObject) (stack : EvalStack) = - let v = - match v with - | CliObject.Basic (BasicCliObject.Int32 i) -> EvalStackValue.Int32 i - | CliObject.Basic (BasicCliObject.Int64 i) -> EvalStackValue.Int64 i - | CliObject.Basic (BasicCliObject.NativeInt i) -> failwith "TODO" - | CliObject.Basic (BasicCliObject.NativeFloat i) -> failwith "TODO" - | CliObject.Basic (BasicCliObject.ObjectReference i) -> EvalStackValue.ManagedPointer i - | CliObject.Basic (BasicCliObject.PointerType i) -> failwith "TODO" - // Zero-extend unsigned int8/unsigned int16/bool/char - | CliObject.Bool b -> int32 b |> EvalStackValue.Int32 - | CliObject.Char (high, low) -> int32 high * 256 + int32 low |> EvalStackValue.Int32 - | CliObject.UInt8 b -> int32 b |> EvalStackValue.Int32 - | CliObject.UInt16 b -> int32 b |> EvalStackValue.Int32 - // Sign-extend types int8 and int16 - | CliObject.Int8 b -> int32 b |> EvalStackValue.Int32 - | CliObject.Int16 b -> int32 b |> EvalStackValue.Int32 - | Float32 f -> failwith "todo" - | Float64 f -> failwith "todo" - - { - Values = v :: stack.Values - } - + let ofTypeInfo (assy : DumpedAssembly) (t : WoofWare.PawPrint.TypeInfo) : Type = + // TODO: is value type? + t.Fields + |> List.map (fun field -> + { + FieldName = field.Name + FieldSize = sizeOfTypeDefn assy field.Signature + } + ) + |> ReferenceType.ManagedObject + |> Type.ReferenceType type MethodReturnState = { JumpTo : MethodState - WasInitialising : (TypeDefinitionHandle * AssemblyName) option + WasInitialisingType : (TypeDefinitionHandle * AssemblyName) option } and MethodState = { // TODO: local variables are initialised to 0 if the localsinit flag is set for the method - LocalVariables : CliObject ImmutableArray + LocalVariables : CliType ImmutableArray /// Index into the stream of IL bytes. IlOpIndex : int EvaluationStack : EvalStack - Arguments : CliObject ImmutableArray + Arguments : CliType ImmutableArray ExecutingMethod : WoofWare.PawPrint.MethodInfo /// We don't implement the local memory pool right now LocalMemoryPool : unit @@ -159,7 +122,7 @@ and MethodState = EvaluationStack = state.EvaluationStack |> EvalStack.Push state.Arguments.[index] } - static member popFromStack (localVariableIndex : int) (state : MethodState) : MethodState = + static member popFromStackToVariable (localVariableIndex : int) (state : MethodState) : MethodState = if localVariableIndex >= state.LocalVariables.Length then failwith $"Tried to access zero-indexed local variable %i{localVariableIndex} but only %i{state.LocalVariables.Length} exist" @@ -171,29 +134,32 @@ and MethodState = let desiredValue = match state.LocalVariables.[localVariableIndex] with - | Basic (BasicCliObject.Int32 _) -> + | CliType.Numeric numeric -> + match numeric with + | CliNumericType.Int32 _ -> + match popped with + | EvalStackValue.Int32 i -> CliType.Numeric (CliNumericType.Int32 i) + | i -> failwith $"TODO: %O{i}" + | CliNumericType.Int64 int64 -> failwith "todo" + | CliNumericType.NativeInt int64 -> failwith "todo" + | CliNumericType.NativeFloat f -> failwith "todo" + | CliNumericType.Int8 b -> failwith "todo" + | CliNumericType.Int16 s -> failwith "todo" + | CliNumericType.UInt8 b -> failwith "todo" + | CliNumericType.UInt16 s -> failwith "todo" + | CliNumericType.Float32 f -> failwith "todo" + | CliNumericType.Float64 f -> failwith "todo" + | CliType.ObjectRef _ -> match popped with - | EvalStackValue.Int32 i -> CliObject.Basic (BasicCliObject.Int32 i) - | EvalStackValue.Int64 int64 -> failwith "todo" - | EvalStackValue.NativeInt int64 -> failwith "todo" - | EvalStackValue.Float f -> failwith "todo" - | EvalStackValue.ManagedPointer managedHeapAddressOption -> failwith "todo" - | EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo" - | EvalStackValue.TransientPointer i -> failwith "todo" - | EvalStackValue.UserDefinedValueType -> failwith "todo" - | Basic (BasicCliObject.Int64 _) -> failwith "todo" - | Basic (BasicCliObject.NativeFloat _) -> failwith "todo" - | Basic (BasicCliObject.NativeInt _) -> failwith "todo" - | Basic (BasicCliObject.ObjectReference _) -> failwith "todo" - | Basic (BasicCliObject.PointerType _) -> failwith "todo" - | Bool b -> failwith "todo" - | Char (b, b1) -> failwith "todo" - | UInt8 b -> failwith "todo" - | UInt16 s -> failwith "todo" - | Int8 b -> failwith "todo" - | Int16 s -> failwith "todo" - | Float32 f -> failwith "todo" - | Float64 f -> failwith "todo" + | EvalStackValue.ManagedPointer addr -> CliType.ObjectRef addr + | i -> failwith $"TODO: %O{i}" + | CliType.Bool _ -> + match popped with + | EvalStackValue.Int32 i -> + // Bools are zero-extended + CliType.Bool (i % 256 |> byte) + | i -> failwith $"TODO: %O{i}" + | i -> failwith $"TODO: %O{i}" { state with EvaluationStack = newStack @@ -214,15 +180,15 @@ and MethodState = | TypeDefn.PrimitiveType primitiveType -> match primitiveType with | PrimitiveType.Void -> failwith "todo" - | PrimitiveType.Boolean -> CliObject.Bool 0uy + | PrimitiveType.Boolean -> CliType.Bool 0uy | PrimitiveType.Char -> failwith "todo" | PrimitiveType.SByte -> failwith "todo" | PrimitiveType.Byte -> failwith "todo" | PrimitiveType.Int16 -> failwith "todo" | PrimitiveType.UInt16 -> failwith "todo" - | PrimitiveType.Int32 -> CliObject.Basic (BasicCliObject.Int32 0) + | PrimitiveType.Int32 -> CliType.Numeric (CliNumericType.Int32 0) | PrimitiveType.UInt32 -> failwith "todo" - | PrimitiveType.Int64 -> CliObject.Basic (BasicCliObject.Int64 0L) + | PrimitiveType.Int64 -> CliType.Numeric (CliNumericType.Int64 0L) | PrimitiveType.UInt64 -> failwith "todo" | PrimitiveType.Single -> failwith "todo" | PrimitiveType.Double -> failwith "todo" @@ -230,15 +196,15 @@ and MethodState = | PrimitiveType.TypedReference -> failwith "todo" | PrimitiveType.IntPtr -> failwith "todo" | PrimitiveType.UIntPtr -> failwith "todo" - | PrimitiveType.Object -> failwith "todo" + | PrimitiveType.Object -> CliType.ObjectRef None | 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 signatureTypeKind -> CliObject.Basic (BasicCliObject.ObjectReference None) - | TypeDefn.FromDefinition signatureTypeKind -> failwith "todo" + | TypeDefn.FromReference _ -> CliType.ObjectRef None + | TypeDefn.FromDefinition (_, signatureTypeKind) -> failwith "todo" | TypeDefn.GenericInstantiation (generic, args) -> failwith "todo" | TypeDefn.FunctionPointer typeMethodSignature -> failwith "todo" | TypeDefn.GenericTypeParameter index -> failwith "todo" @@ -269,109 +235,13 @@ type ThreadState = ActiveAssembly = activeAssy } -type ManagedHeap = - { - /// We store the size of the allocation too. - Types : Map - Contents : ImmutableArray - FirstAvailableAddress : int - } - - static member Empty : ManagedHeap = - { - Types = Map.empty - // We'll leave the null reference empty. - Contents = ImmutableArray.Create None - FirstAvailableAddress = 1 - } - - static member Allocate (ty : ReferenceType) (heap : ManagedHeap) : ManagedHeapAddress * ManagedHeap = - let size = ReferenceType.SizeOnHeap ty - - assert (heap.Contents.Length = heap.FirstAvailableAddress) - let contents = heap.Contents.AddRange (Seq.replicate size None) - - let heap = - { - FirstAvailableAddress = heap.FirstAvailableAddress + size - Types = heap.Types |> Map.add (ManagedHeapAddress heap.FirstAvailableAddress) (ty, size) - Contents = contents - } - - ManagedHeapAddress heap.FirstAvailableAddress, heap - - static member SetValue - (alloc : ManagedHeapAddress) - (offset : int) - (v : CliObject) - (heap : ManagedHeap) - : ManagedHeap - = - let ty, _ = heap.Types.[alloc] - let size = ReferenceType.SizeOnHeap ty - let (ManagedHeapAddress a) = alloc - - let v = - match v with - | CliObject.Basic (BasicCliObject.ObjectReference o) -> - if size <> 8 then - failwith - $"precondition failed! trying to write mismatched size 8 to array whose elements are size %i{size}" - - match o with - | None -> Array.replicate 8 (Some 0uy) - | Some (ManagedHeapAddress ptr) -> System.BitConverter.GetBytes (uint64 ptr) |> Array.map Some - | _ -> failwith $"TODO: %O{v}" - - { heap with - Contents = heap.Contents.RemoveRange(a + offset, size).InsertRange (a + offset, v) - } - type WhatWeDid = | Executed /// We didn't run what you wanted, because we have to do class initialisation first. | SuspendedForClassInit - | NotTellingYou /// We can't proceed until this thread has finished the class initialisation work it's doing. | BlockedOnClassInit of threadBlockingUs : ThreadId -/// Represents the state of a type's initialization in the CLI -type TypeInitState = - | InProgress of ThreadId // Being initialized by this thread - | Initialized - -/// Tracks the initialization state of types across assemblies -type TypeInitTable = ImmutableDictionary - -[] -module TypeInitTable = - let beginInitialising - (thread : ThreadId) - (typeDef : TypeDefinitionHandle * AssemblyName) - (t : TypeInitTable) - : TypeInitTable - = - match t.TryGetValue typeDef with - | false, _ -> t.Add (typeDef, TypeInitState.InProgress thread) - | true, v -> failwith "Logic error: tried initialising a type which has already started initialising" - - let markInitialised - (thread : ThreadId) - (typeDef : TypeDefinitionHandle * AssemblyName) - (t : TypeInitTable) - : TypeInitTable - = - match t.TryGetValue typeDef 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" - | true, TypeInitState.InProgress thread2 -> - if thread <> thread2 then - failwith - "Logic error: completed initialisation of a type on a different thread to the one which started it!" - else - t.SetItem (typeDef, TypeInitState.Initialized) - type IlMachineState = { NextThreadId : int @@ -385,7 +255,7 @@ type IlMachineState = _LoadedAssemblies : ImmutableDictionary /// Tracks initialization state of types across assemblies TypeInitTable : TypeInitTable - Statics : ImmutableDictionary + Statics : ImmutableDictionary DotnetRuntimeDirs : string ImmutableArray } @@ -436,7 +306,10 @@ type IlMachineState = $"Somehow we believe the active assembly is {active}, but only had the following available: {available}" type StateLoadResult = + /// The type is loaded; you can proceed. | NothingToDo of IlMachineState + /// We didn't manage to load the requested type, because that type itself requires first loading something. + /// The state we give you is ready to load that something. | FirstLoadThis of IlMachineState [] @@ -688,7 +561,7 @@ module IlMachineState = (Some { JumpTo = currentThreadState.MethodState |> MethodState.advanceProgramCounter - WasInitialising = Some (typeDefHandle, assemblyName) + WasInitialisingType = Some (typeDefHandle, assemblyName) }) { state with @@ -740,7 +613,7 @@ module IlMachineState = (Some { JumpTo = threadState.MethodState |> MethodState.advanceProgramCounter - WasInitialising = None + WasInitialisingType = None }) } @@ -758,7 +631,7 @@ module IlMachineState = (Some { JumpTo = threadState.MethodState |> MethodState.advanceProgramCounter - WasInitialising = None + WasInitialisingType = None }) } @@ -768,7 +641,6 @@ module IlMachineState = WhatWeDid.Executed | true, InProgress threadId -> state, WhatWeDid.BlockedOnClassInit threadId - let initial (dotnetRuntimeDirs : ImmutableArray) (entryAssembly : DumpedAssembly) : IlMachineState = let assyName = entryAssembly.ThisAssemblyDefinition.Name @@ -805,15 +677,79 @@ module IlMachineState = newState, thread - let allocate (o : ReferenceType) (state : IlMachineState) : ManagedHeapAddress * IlMachineState = - let alloc, heap = ManagedHeap.Allocate o state.ManagedHeap + // let allocate (o : CliObject) (state : IlMachineState) : ManagedHeapAddress * IlMachineState = + // let alloc, heap = ManagedHeap.Allocate o state.ManagedHeap + + // let state = + // { state with + // ManagedHeap = heap + // } + + // alloc, state + + let allocateArray + (elementType : WoofWare.PawPrint.TypeInfo) + (len : int) + (state : IlMachineState) + : ManagedHeapAddress * IlMachineState + = + let zeroElement (_ : int) : CliType = failwith "TODO" + let initialisation = zeroElement |> Seq.init len |> ImmutableArray.CreateRange + + let o : AllocatedArray = + { + Length = len + Elements = initialisation + } + + let alloc, heap = state.ManagedHeap |> ManagedHeap.AllocateArray o + + let state = + { state with + ManagedHeap = heap + } + + alloc, state + + let allocateStringData (len : int) (state : IlMachineState) : int * IlMachineState = + let addr, heap = state.ManagedHeap |> ManagedHeap.AllocateString len + + let state = + { state with + ManagedHeap = heap + } + + addr, state + + let setStringData (addr : int) (contents : string) (state : IlMachineState) : IlMachineState = + let heap = ManagedHeap.SetStringData addr contents state.ManagedHeap - alloc, { state with ManagedHeap = heap } - let pushToEvalStack (o : CliObject) (thread : ThreadId) (state : IlMachineState) = + let allocateManagedObject + (typeInfo : WoofWare.PawPrint.TypeInfo) + (fields : (string * CliType) list) + (state : IlMachineState) + : ManagedHeapAddress * IlMachineState + = + let o = + { + Fields = Map.ofList fields + Type = typeInfo + } + + let alloc, heap = state.ManagedHeap |> ManagedHeap.AllocateNonArray o + + let state = + { state with + ManagedHeap = heap + } + + alloc, state + + let pushToEvalStack (o : CliType) (thread : ThreadId) (state : IlMachineState) = { state with ThreadState = state.ThreadState @@ -862,7 +798,7 @@ module IlMachineState = | Some threadState -> threadState let methodState = - MethodState.popFromStack localVariableIndex threadState.MethodState + MethodState.popFromStackToVariable localVariableIndex threadState.MethodState { state with ThreadState = @@ -876,13 +812,12 @@ module IlMachineState = let setArrayValue (arrayAllocation : ManagedHeapAddress) - (v : CliObject) + (v : CliType) (index : int) (state : IlMachineState) : IlMachineState = - // TODO: actually we need to skip the first four bytes because they hold the length - let heap = ManagedHeap.SetValue arrayAllocation index v state.ManagedHeap + let heap = ManagedHeap.SetArrayValue arrayAllocation index v state.ManagedHeap { state with ManagedHeap = heap @@ -1023,7 +958,7 @@ module AbstractMachine = | Some returnState -> let state = - match returnState.WasInitialising with + match returnState.WasInitialisingType with | None -> state | Some finishedInitialising -> { state with @@ -1062,55 +997,55 @@ module AbstractMachine = | LdcI4_0 -> state - |> IlMachineState.pushToEvalStack (CliObject.Basic (BasicCliObject.Int32 0)) currentThread + |> IlMachineState.pushToEvalStack (CliType.Numeric (CliNumericType.Int32 0)) currentThread |> IlMachineState.advanceProgramCounter currentThread |> Tuple.withRight WhatWeDid.Executed |> ExecutionResult.Stepped | LdcI4_1 -> state - |> IlMachineState.pushToEvalStack (CliObject.Basic (BasicCliObject.Int32 1)) currentThread + |> IlMachineState.pushToEvalStack (CliType.Numeric (CliNumericType.Int32 1)) currentThread |> IlMachineState.advanceProgramCounter currentThread |> Tuple.withRight WhatWeDid.Executed |> ExecutionResult.Stepped | LdcI4_2 -> state - |> IlMachineState.pushToEvalStack (CliObject.Basic (BasicCliObject.Int32 2)) currentThread + |> IlMachineState.pushToEvalStack (CliType.Numeric (CliNumericType.Int32 2)) currentThread |> IlMachineState.advanceProgramCounter currentThread |> Tuple.withRight WhatWeDid.Executed |> ExecutionResult.Stepped | LdcI4_3 -> state - |> IlMachineState.pushToEvalStack (CliObject.Basic (BasicCliObject.Int32 3)) currentThread + |> IlMachineState.pushToEvalStack (CliType.Numeric (CliNumericType.Int32 3)) currentThread |> IlMachineState.advanceProgramCounter currentThread |> Tuple.withRight WhatWeDid.Executed |> ExecutionResult.Stepped | LdcI4_4 -> state - |> IlMachineState.pushToEvalStack (CliObject.Basic (BasicCliObject.Int32 4)) currentThread + |> IlMachineState.pushToEvalStack (CliType.Numeric (CliNumericType.Int32 4)) currentThread |> IlMachineState.advanceProgramCounter currentThread |> Tuple.withRight WhatWeDid.Executed |> ExecutionResult.Stepped | LdcI4_5 -> state - |> IlMachineState.pushToEvalStack (CliObject.Basic (BasicCliObject.Int32 5)) currentThread + |> IlMachineState.pushToEvalStack (CliType.Numeric (CliNumericType.Int32 5)) currentThread |> IlMachineState.advanceProgramCounter currentThread |> Tuple.withRight WhatWeDid.Executed |> ExecutionResult.Stepped | LdcI4_6 -> state - |> IlMachineState.pushToEvalStack (CliObject.Basic (BasicCliObject.Int32 6)) currentThread + |> IlMachineState.pushToEvalStack (CliType.Numeric (CliNumericType.Int32 6)) currentThread |> IlMachineState.advanceProgramCounter currentThread |> Tuple.withRight WhatWeDid.Executed |> ExecutionResult.Stepped | LdcI4_7 -> state - |> IlMachineState.pushToEvalStack (CliObject.Basic (BasicCliObject.Int32 7)) currentThread + |> IlMachineState.pushToEvalStack (CliType.Numeric (CliNumericType.Int32 7)) currentThread |> IlMachineState.advanceProgramCounter currentThread |> Tuple.withRight WhatWeDid.Executed |> ExecutionResult.Stepped | LdcI4_8 -> state - |> IlMachineState.pushToEvalStack (CliObject.Basic (BasicCliObject.Int32 8)) currentThread + |> IlMachineState.pushToEvalStack (CliType.Numeric (CliNumericType.Int32 8)) currentThread |> IlMachineState.advanceProgramCounter currentThread |> Tuple.withRight WhatWeDid.Executed |> ExecutionResult.Stepped @@ -1335,7 +1270,7 @@ module AbstractMachine = | Callvirt -> failwith "todo" | Castclass -> failwith "todo" | Newobj -> - // TODO: allocate the object, and pass it as the first argument to the constructor. Check the rest of what + // TODO: Pass the allocation as the first argument to the constructor. Check the rest of what // newobj is supposed to do, and do it. let state, assy, ctor = match metadataToken with @@ -1346,15 +1281,109 @@ module AbstractMachine = | MemberReference mr -> resolveMember loggerFactory (state.ActiveAssembly thread) mr state | x -> failwith $"Unexpected metadata token for constructor: %O{x}" - state.WithThreadSwitchedToAssembly assy thread - |> fst - |> IlMachineState.callMethodInActiveAssembly loggerFactory thread ctor - | Newarr -> failwith "todo" + 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 -> + let zeroedAllocation = + match field.Signature with + | TypeDefn.PrimitiveType ty -> failwith "todo" + | TypeDefn.Array _ -> failwith "todo" + | TypeDefn.Pinned _ -> failwith "todo" + | TypeDefn.Pointer _ -> failwith "todo" + | TypeDefn.Byref _ -> failwith "todo" + | TypeDefn.OneDimensionalArrayLowerBoundZero _ -> failwith "todo" + | TypeDefn.Modified _ -> failwith "todo" + | TypeDefn.FromReference _ -> failwith "todo" + | TypeDefn.FromDefinition _ -> failwith "todo" + | TypeDefn.GenericInstantiation _ -> failwith "todo" + | TypeDefn.FunctionPointer _ -> failwith "todo" + | TypeDefn.GenericTypeParameter _ -> failwith "todo" + | TypeDefn.GenericMethodParameter _ -> failwith "todo" + + field.Name, zeroedAllocation + ) + + let allocatedAddr, state = + IlMachineState.allocateManagedObject ctorType fields state + + let state = + state + |> IlMachineState.pushToEvalStack (CliType.OfManagedObject allocatedAddr) thread + + let state, whatWeDid = + state.WithThreadSwitchedToAssembly assy thread + |> fst + |> IlMachineState.callMethodInActiveAssembly loggerFactory thread ctor + + state, whatWeDid + | Newarr -> + let currentState = state.ThreadState.[thread] + let popped, newStack = EvalStack.Pop currentState.MethodState.EvaluationStack + + let currentState = + { currentState with + ThreadState.MethodState.EvaluationStack = newStack + } + + let len = + match popped with + | EvalStackValue.Int32 v -> v + | popped -> failwith $"unexpectedly popped value %O{popped} to serve as array len" + + let elementType = + match metadataToken with + | MetadataToken.TypeDefinition defn -> + state.LoadedAssembly currentState.ActiveAssembly + |> Option.get + |> fun assy -> assy.TypeDefs.[defn] + | x -> failwith $"TODO: {x}" + + failwith $"TODO: {elementType.Name}" | Box -> failwith "todo" | Ldelema -> failwith "todo" | Isinst -> failwith "todo" | Stfld -> failwith "todo" - | Stsfld -> failwith "todo" + | Stsfld -> + let fieldHandle = + match metadataToken with + | MetadataToken.FieldDefinition f -> f + | t -> failwith $"Unexpectedly asked to store to a non-field: {t}" + + let activeAssy = state.ActiveAssembly thread + + match activeAssy.Fields.TryGetValue fieldHandle with + | false, _ -> failwith "TODO: throw MissingFieldException" + | true, field -> + + match IlMachineState.loadClass loggerFactory field.DeclaringType activeAssy.Name thread state with + | FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit + | NothingToDo state -> + + let popped, evalStack = + EvalStack.Pop state.ThreadState.[thread].MethodState.EvaluationStack + + let toStore = + match popped with + | EvalStackValue.ManagedPointer addr -> CliType.ObjectRef addr + | _ -> failwith "TODO" + + let newThreadState = + { state.ThreadState.[thread] with + ThreadState.MethodState.EvaluationStack = evalStack + } + + let state = + { state with + Statics = state.Statics.SetItem ((field.DeclaringType, activeAssy.Name), toStore) + ThreadState = state.ThreadState |> Map.add thread newThreadState + } + + state, WhatWeDid.Executed + | Ldfld -> failwith "todo" | Ldflda -> failwith "todo" | Ldsfld -> failwith "todo" @@ -1381,19 +1410,14 @@ module AbstractMachine = if TypeDefn.isManaged field.Signature then match state.Statics.TryGetValue ((field.DeclaringType, activeAssy.Name)) with | true, v -> - IlMachineState.pushToEvalStack - (CliObject.Basic (BasicCliObject.PointerType (Some v))) - thread - state + IlMachineState.pushToEvalStack v thread state |> IlMachineState.advanceProgramCounter thread |> Tuple.withRight WhatWeDid.Executed | false, _ -> - let allocation, state = state |> IlMachineState.allocate (failwith "") + let allocation, state = state |> (failwith "") state - |> IlMachineState.pushToEvalStack - (CliObject.Basic (BasicCliObject.PointerType (Some allocation))) - thread + |> IlMachineState.pushToEvalStack (CliType.ObjectRef (Some allocation)) thread |> Tuple.withRight WhatWeDid.Executed else failwith "TODO: push unmanaged pointer" @@ -1412,6 +1436,7 @@ module AbstractMachine = | Jmp -> failwith "todo" let private executeUnaryStringToken + (stringType : WoofWare.PawPrint.TypeInfo) (op : UnaryStringTokenIlOp) (sh : StringToken) (state : IlMachineState) @@ -1423,8 +1448,40 @@ module AbstractMachine = let addressToLoad, state = match state.InternedStrings.TryGetValue sh with | false, _ -> - let toAllocate = state.ActiveAssembly(thread).Strings sh - let addr, state = IlMachineState.allocate (ReferenceType.String toAllocate) state + let stringToAllocate = state.ActiveAssembly(thread).Strings sh + + let dataAddr, state = + IlMachineState.allocateStringData stringToAllocate.Length state + + let state = state |> IlMachineState.setStringData dataAddr stringToAllocate + + let stringInstanceFields = + stringType.Fields + |> List.choose (fun field -> + if int (field.Attributes &&& FieldAttributes.Static) = 0 then + Some (field.Name, field.Signature) + else + None + ) + |> List.sortBy fst + // Assert that the string type has the fields we expect + if + stringInstanceFields + <> [ + ("_firstChar", TypeDefn.PrimitiveType PrimitiveType.Char) + ("_stringLength", TypeDefn.PrimitiveType PrimitiveType.Int32) + ] + then + failwith + $"unexpectedly don't know how to initialise a string: got fields %O{stringInstanceFields}" + + let fields = + [ + "_firstChar", CliType.OfChar state.ManagedHeap.StringArrayData.[dataAddr] + "_stringLength", CliType.Numeric (CliNumericType.Int32 stringToAllocate.Length) + ] + + let addr, state = IlMachineState.allocateManagedObject stringType fields state addr, { state with @@ -1433,10 +1490,7 @@ module AbstractMachine = | true, v -> v, state let state = - IlMachineState.pushToEvalStack - (CliObject.Basic (BasicCliObject.ObjectReference (Some addressToLoad))) - thread - state + IlMachineState.pushToEvalStack (CliType.ObjectRef (Some addressToLoad)) thread state state |> IlMachineState.advanceProgramCounter thread @@ -1460,10 +1514,18 @@ module AbstractMachine = |> IlMachineState.advanceProgramCounter currentThread |> Tuple.withRight WhatWeDid.Executed | Ldc_I8 int64 -> failwith "todo" - | Ldc_I4 i -> failwith "todo" + | Ldc_I4 i -> + state + |> IlMachineState.pushToEvalStack (CliType.Numeric (CliNumericType.Int32 i)) currentThread + |> IlMachineState.advanceProgramCounter currentThread + |> Tuple.withRight WhatWeDid.Executed | Ldc_R4 f -> failwith "todo" | Ldc_R8 f -> failwith "todo" - | Ldc_I4_s b -> failwith "todo" + | Ldc_I4_s b -> + state + |> IlMachineState.pushToEvalStack (CliType.Numeric (CliNumericType.Int8 b)) currentThread + |> IlMachineState.advanceProgramCounter currentThread + |> Tuple.withRight WhatWeDid.Executed | Br i -> failwith "todo" | Br_s b -> state @@ -1508,7 +1570,13 @@ module AbstractMachine = | Ldloca s -> failwith "todo" | Ldarg s -> failwith "todo" - let executeOneStep (loggerFactory : ILoggerFactory) (state : IlMachineState) (thread : ThreadId) : ExecutionResult = + let executeOneStep + (loggerFactory : ILoggerFactory) + (stringType : WoofWare.PawPrint.TypeInfo) + (state : IlMachineState) + (thread : ThreadId) + : ExecutionResult + = let logger = loggerFactory.CreateLogger typeof.DeclaringType let instruction = state.ThreadState.[thread].MethodState @@ -1516,9 +1584,18 @@ module AbstractMachine = | false, _ -> failwith "Wanted to execute a nonexistent instruction" | true, executingInstruction -> + let executingInType = + match state.LoadedAssembly (snd instruction.ExecutingMethod.DeclaringType) with + | None -> "" + | Some assy -> + match assy.TypeDefs.TryGetValue (fst instruction.ExecutingMethod.DeclaringType) with + | true, v -> v.Name + | false, _ -> "" + logger.LogInformation ( - "Executing one step (index {ExecutingIlOpIndex} in method {ExecutingMethodName}): {ExecutingIlOp}", + "Executing one step (index {ExecutingIlOpIndex} in method {ExecutingMethodType}.{ExecutingMethodName}): {ExecutingIlOp}", instruction.IlOpIndex, + executingInType, instruction.ExecutingMethod.Name, executingInstruction ) @@ -1531,5 +1608,5 @@ module AbstractMachine = |> ExecutionResult.Stepped | IlOp.Switch immutableArray -> failwith "todo" | IlOp.UnaryStringToken (unaryStringTokenIlOp, stringHandle) -> - executeUnaryStringToken unaryStringTokenIlOp stringHandle state thread + executeUnaryStringToken stringType unaryStringTokenIlOp stringHandle state thread |> ExecutionResult.Stepped diff --git a/WoofWare.PawPrint/AbstractMachineDomain.fs b/WoofWare.PawPrint/AbstractMachineDomain.fs new file mode 100644 index 0000000..5ec015a --- /dev/null +++ b/WoofWare.PawPrint/AbstractMachineDomain.fs @@ -0,0 +1,3 @@ +namespace WoofWare.PawPrint + +type ThreadId = | ThreadId of int diff --git a/WoofWare.PawPrint/BasicCliType.fs b/WoofWare.PawPrint/BasicCliType.fs new file mode 100644 index 0000000..6d9de73 --- /dev/null +++ b/WoofWare.PawPrint/BasicCliType.fs @@ -0,0 +1,85 @@ +namespace WoofWare.PawPrint + +/// Currently this is just an opaque handle; it can't be treated as a pointer. +type ManagedHeapAddress = | ManagedHeapAddress of int + +/// Source: +/// Table I.6: Data Types Directly Supported by the CLI +type CliSupportedObject = + /// Can be assigned the null value 0 + /// This is the 'O' type. + | ObjectReference of ManagedHeapAddress option + /// This is the '&' type. It can point to managed or unmanaged memory. + /// TODO: the contents of this are therefore wrong + | PointerType of ManagedHeapAddress option + | Int8 of int8 + | UInt8 of uint8 + | Int16 of int16 + | UInt16 of uint16 + | Int32 of int32 + | UInt32 of uint32 + | Int64 of int64 + | UInt64 of uint64 + | Float32 of float32 + | Float64 of float + | NativeInt of int64 + | NativeUint of uint64 + +/// Defined in III.1.1 +type BasicCliType = + | ObjectReference of ManagedHeapAddress option + | PointerType of ManagedHeapAddress option + | Int32 of int32 + | Int64 of int64 + | NativeInt of int64 + | NativeFloat of float + +/// Defined in III.1.1.1 +type CliNumericType = + | Int32 of int32 + | Int64 of int64 + | NativeInt of int64 + | NativeFloat of float + | Int8 of int8 + | Int16 of int16 + | UInt8 of uint8 + | UInt16 of uint16 + | Float32 of float32 + | Float64 of float + +type CliValueType = + private + | Bool of byte + /// A UTF-16 code unit, i.e. two bytes. We store the most significant one first. + | Char of byte * byte + | UInt8 of uint8 + | UInt16 of uint16 + | Int8 of int8 + | Int16 of int16 + | Float32 of float32 + | Float64 of float + +type CliRuntimePointer = + | Unmanaged of unit + | Managed of unit + +/// This is the kind of type that can be stored in arguments, local variables, statics, array elements, fields. +type CliType = + /// III.1.1.1 + | Numeric of CliNumericType + /// III.1.1.2 + | Bool of byte + /// III.1.1.3 + | Char of high : byte * low : byte + /// III.1.1.4 - this is a completely opaque handle to a managed object; arithmetic is forbidden + | ObjectRef of ManagedHeapAddress option + /// III.1.1.5 + | RuntimePointer of CliRuntimePointer + + /// In fact any non-zero value will do for True, but we'll use 1 + static member OfBool (b : bool) = CliType.Bool (if b then 1uy else 0uy) + + static member OfChar (c : char) = + CliType.Char (byte (int c / 256), byte (int c % 256)) + + static member OfManagedObject (ptr : ManagedHeapAddress) = CliType.ObjectRef (Some ptr) diff --git a/WoofWare.PawPrint/EvalStack.fs b/WoofWare.PawPrint/EvalStack.fs new file mode 100644 index 0000000..bc45750 --- /dev/null +++ b/WoofWare.PawPrint/EvalStack.fs @@ -0,0 +1,61 @@ +namespace WoofWare.PawPrint + +/// See I.12.3.2.1 for definition +type EvalStackValue = + | Int32 of int32 + | Int64 of int64 + | NativeInt of int64 + | Float of float + /// allowed to be null + | ManagedPointer of ManagedHeapAddress option + | ObjectRef of ManagedHeapAddress + | TransientPointer of int + | UserDefinedValueType + +type EvalStack = + { + Values : EvalStackValue list + } + + static member Empty : EvalStack = + { + Values = [] + } + + static member Pop (stack : EvalStack) : EvalStackValue * EvalStack = + match stack.Values with + | [] -> failwith "eval stack was empty on pop instruction" + | v :: rest -> + let stack = + { + Values = rest + } + + v, stack + + static member Push (v : CliType) (stack : EvalStack) : EvalStack = + let v = + match v with + | CliType.Numeric numeric -> + match numeric with + | CliNumericType.Int32 i -> EvalStackValue.Int32 i + | CliNumericType.Int64 i -> EvalStackValue.Int64 i + | CliNumericType.NativeInt i -> failwith "TODO" + // Sign-extend types int8 and int16 + // Zero-extend unsigned int8/unsigned int16 + | CliNumericType.Int8 b -> int32 b |> EvalStackValue.Int32 + | CliNumericType.UInt8 b -> int32 b |> EvalStackValue.Int32 + | CliNumericType.Int16 s -> int32 s |> EvalStackValue.Int32 + | CliNumericType.UInt16 s -> int32 s |> EvalStackValue.Int32 + | CliNumericType.Float32 f -> failwith "todo" + | CliNumericType.Float64 f -> failwith "todo" + | CliNumericType.NativeFloat f -> failwith "todo" + | CliType.ObjectRef i -> EvalStackValue.ManagedPointer i + // Zero-extend bool/char + | CliType.Bool b -> int32 b |> EvalStackValue.Int32 + | CliType.Char (high, low) -> int32 high * 256 + int32 low |> EvalStackValue.Int32 + | CliType.RuntimePointer cliRuntimePointer -> failwith "todo" + + { + Values = v :: stack.Values + } diff --git a/WoofWare.PawPrint/ManagedHeap.fs b/WoofWare.PawPrint/ManagedHeap.fs new file mode 100644 index 0000000..15d4c2c --- /dev/null +++ b/WoofWare.PawPrint/ManagedHeap.fs @@ -0,0 +1,112 @@ +namespace WoofWare.PawPrint + +open System.Collections.Immutable + +type AllocatedNonArrayObject = + { + Fields : Map + Type : WoofWare.PawPrint.TypeInfo + } + +type AllocatedArray = + { + Length : int + Elements : ImmutableArray + } + +type ManagedHeap = + { + NonArrayObjects : Map + Arrays : Map + FirstAvailableAddress : int + /// Strings are special-cased in the runtime anyway and have a whole lot of unsafe code in them, + /// so we'll have a special pool for their bytes. + StringArrayData : ImmutableArray + } + + static member Empty : ManagedHeap = + { + NonArrayObjects = Map.empty + FirstAvailableAddress = 1 + Arrays = Map.empty + StringArrayData = ImmutableArray.Empty + } + + static member AllocateArray (ty : AllocatedArray) (heap : ManagedHeap) : ManagedHeapAddress * ManagedHeap = + let addr = heap.FirstAvailableAddress + + let heap = + { + FirstAvailableAddress = heap.FirstAvailableAddress + 1 + NonArrayObjects = heap.NonArrayObjects + Arrays = heap.Arrays |> Map.add (ManagedHeapAddress addr) ty + StringArrayData = heap.StringArrayData + } + + ManagedHeapAddress addr, heap + + static member AllocateString (len : int) (heap : ManagedHeap) : int * ManagedHeap = + let addr = heap.StringArrayData.Length + + let heap = + { heap with + // strings are also null-terminated + // https://github.com/dotnet/runtime/blob/ab105b51f8b50ec5567d7cfe9001ca54dd6f64c3/src/libraries/System.Private.CoreLib/src/System/String.cs#L56 + StringArrayData = heap.StringArrayData.AddRange (Seq.replicate (len + 1) (char 0)) + } + + addr, heap + + static member SetStringData (addr : int) (contents : string) (heap : ManagedHeap) : ManagedHeap = + let newArr = + (heap.StringArrayData, seq { 0 .. contents.Length - 1 }) + ||> Seq.fold (fun data count -> data.SetItem (addr + count, contents.[count])) + + let heap = + { heap with + StringArrayData = newArr + } + + heap + + static member AllocateNonArray + (ty : AllocatedNonArrayObject) + (heap : ManagedHeap) + : ManagedHeapAddress * ManagedHeap + = + let addr = heap.FirstAvailableAddress + + let heap = + { + FirstAvailableAddress = addr + 1 + NonArrayObjects = heap.NonArrayObjects |> Map.add (ManagedHeapAddress addr) ty + Arrays = heap.Arrays + StringArrayData = heap.StringArrayData + } + + ManagedHeapAddress addr, heap + + static member SetArrayValue + (alloc : ManagedHeapAddress) + (offset : int) + (v : CliType) + (heap : ManagedHeap) + : ManagedHeap + = + let newArrs = + heap.Arrays + |> Map.change + alloc + (fun arr -> + match arr with + | None -> failwith "tried to change element of nonexistent array" + | Some arr -> + { arr with + Elements = arr.Elements.SetItem (offset, v) + } + |> Some + ) + + { heap with + Arrays = newArrs + } diff --git a/WoofWare.PawPrint/Program.fs b/WoofWare.PawPrint/Program.fs index 7d63798..974dda9 100644 --- a/WoofWare.PawPrint/Program.fs +++ b/WoofWare.PawPrint/Program.fs @@ -1,5 +1,6 @@ namespace WoofWare.PawPrint +open System open System.Collections.Immutable open System.IO open Microsoft.Extensions.Logging @@ -7,24 +8,27 @@ open Microsoft.Extensions.Logging [] module Program = /// Returns the pointer to the resulting array on the heap. - let allocateArgs (args : string list) (state : IlMachineState) : ManagedHeapAddress * IlMachineState = + let allocateArgs + (args : string list) + (stringAssy : DumpedAssembly, stringType : TypeInfo, arrayType : TypeInfo) + (state : IlMachineState) + : ManagedHeapAddress * IlMachineState + = let argsAllocations, state = (state, args) - ||> Seq.mapFold (fun state arg -> IlMachineState.allocate (ReferenceType.String arg) state + ||> Seq.mapFold (fun state arg -> + IlMachineState.allocateManagedObject stringType (failwith "TODO: assert fields and populate") state // TODO: set the char values in memory ) let arrayAllocation, state = - IlMachineState.allocate - (ReferenceType.Array (args.Length, Type.ReferenceType ReferenceType.ManagedObject)) - state - // TODO: set the length of the array + IlMachineState.allocateArray stringType args.Length state let state = ((state, 0), argsAllocations) ||> Seq.fold (fun (state, i) arg -> let state = - IlMachineState.setArrayValue arrayAllocation (CliObject.OfManagedObject arg) i state + IlMachineState.setArrayValue arrayAllocation (CliType.OfManagedObject arg) i state state, i + 1 ) @@ -55,29 +59,66 @@ module Program = if mainMethod.Signature.GenericParameterCount > 0 then failwith "Refusing to execute generic main method" - let state = IlMachineState.initial dotnetRuntimeDirs dumped + let state, mainThread = + IlMachineState.initial 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 + // initialise the class containing the main method. + |> IlMachineState.addThread (MethodState.Empty mainMethod None) dumped.Name + + let rec loadInitialState (state : IlMachineState) = + match + state + |> IlMachineState.loadClass + loggerFactory + (fst mainMethod.DeclaringType) + (snd mainMethod.DeclaringType) + mainThread + with + | StateLoadResult.NothingToDo ilMachineState -> ilMachineState + | StateLoadResult.FirstLoadThis ilMachineState -> loadInitialState ilMachineState + + let state = loadInitialState state + + // Now that the object has been loaded, we can identify the String type from System.Private.CoreLib. + + let corelib = + let coreLib = + state._LoadedAssemblies.Keys + |> Seq.find (fun x -> x.StartsWith ("System.Private.CoreLib, ", StringComparison.Ordinal)) + + state._LoadedAssemblies.[coreLib] + + let stringType = + corelib.TypeDefs + |> Seq.pick (fun (KeyValue (_, v)) -> if v.Name = "String" then Some v else None) + + let arrayType = + corelib.TypeDefs + |> Seq.pick (fun (KeyValue (_, v)) -> if v.Name = "Array" then Some v else None) let arrayAllocation, state = match mainMethod.Signature.ParameterTypes |> Seq.toList with | [ TypeDefn.OneDimensionalArrayLowerBoundZero (TypeDefn.PrimitiveType PrimitiveType.String) ] -> - allocateArgs argv state + allocateArgs argv (corelib, stringType, arrayType) state | _ -> failwith "Main method must take an array of strings; other signatures not yet implemented" match mainMethod.Signature.ReturnType with | TypeDefn.PrimitiveType PrimitiveType.Int32 -> () | _ -> failwith "Main method must return int32; other types not currently supported" + // TODO: now overwrite the main thread which we used for object initialisation. The below is not right. let state, mainThread = state |> IlMachineState.addThread - // TODO: we need to load the main method's class first, and that's a faff with the current layout { MethodState.Empty mainMethod None with - Arguments = ImmutableArray.Create (CliObject.OfManagedObject arrayAllocation) + Arguments = ImmutableArray.Create (CliType.OfManagedObject arrayAllocation) } dumped.Name let rec go (state : IlMachineState) = - match AbstractMachine.executeOneStep loggerFactory state mainThread with + match AbstractMachine.executeOneStep loggerFactory stringType state mainThread with | ExecutionResult.Terminated (state, terminatingThread) -> state, terminatingThread | ExecutionResult.Stepped (state', whatWeDid) -> @@ -85,7 +126,6 @@ module Program = | WhatWeDid.Executed -> logger.LogInformation "Executed one step." | WhatWeDid.SuspendedForClassInit -> logger.LogInformation "Suspended execution of current method for class initialisation." - | WhatWeDid.NotTellingYou -> logger.LogInformation "(Execution outcome missing.)" | WhatWeDid.BlockedOnClassInit threadBlockingUs -> logger.LogInformation "Unable to execute because class has not yet initialised." diff --git a/WoofWare.PawPrint/TypeDefn.fs b/WoofWare.PawPrint/TypeDefn.fs index 51cb2a3..f5cc97d 100644 --- a/WoofWare.PawPrint/TypeDefn.fs +++ b/WoofWare.PawPrint/TypeDefn.fs @@ -47,6 +47,7 @@ module TypeMethodSignature = RequiredParameterCount = p.RequiredParameterCount } +/// See I.8.2.2 type PrimitiveType = | Void | Boolean @@ -97,8 +98,8 @@ type TypeDefn = | Byref of TypeDefn | OneDimensionalArrayLowerBoundZero of elements : TypeDefn | Modified of original : TypeDefn * afterMod : TypeDefn * modificationRequired : bool - | FromReference of SignatureTypeKind - | FromDefinition of SignatureTypeKind + | FromReference of TypeReferenceHandle * SignatureTypeKind + | FromDefinition of TypeDefinitionHandle * SignatureTypeKind | GenericInstantiation of generic : TypeDefn * args : ImmutableArray | FunctionPointer of TypeMethodSignature | GenericTypeParameter of index : int @@ -115,8 +116,13 @@ module TypeDefn = | Byref typeDefn -> failwith "todo" | OneDimensionalArrayLowerBoundZero elements -> failwith "todo" | Modified (original, afterMod, modificationRequired) -> failwith "todo" - | FromReference signatureTypeKind -> true - | FromDefinition signatureTypeKind -> failwith "todo" + | FromReference _ -> true + | 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" @@ -181,18 +187,18 @@ module TypeDefn = (reader : MetadataReader, handle : TypeDefinitionHandle, rawTypeKind : byte) : TypeDefn = - let handle : EntityHandle = TypeDefinitionHandle.op_Implicit handle - let typeKind = reader.ResolveSignatureTypeKind (handle, rawTypeKind) + let handle' : EntityHandle = TypeDefinitionHandle.op_Implicit handle + let typeKind = reader.ResolveSignatureTypeKind (handle', rawTypeKind) - TypeDefn.FromDefinition typeKind + TypeDefn.FromDefinition (handle, typeKind) member this.GetTypeFromReference (reader : MetadataReader, handle : TypeReferenceHandle, rawTypeKind : byte) : TypeDefn = - let handle : EntityHandle = TypeReferenceHandle.op_Implicit handle - let typeKind = reader.ResolveSignatureTypeKind (handle, rawTypeKind) - TypeDefn.FromReference typeKind + let handle' : EntityHandle = TypeReferenceHandle.op_Implicit handle + let typeKind = reader.ResolveSignatureTypeKind (handle', rawTypeKind) + TypeDefn.FromReference (handle, typeKind) member this.GetPointerType (typeCode : TypeDefn) : TypeDefn = TypeDefn.Pointer typeCode diff --git a/WoofWare.PawPrint/TypeInfo.fs b/WoofWare.PawPrint/TypeInfo.fs index 4520035..6bff168 100644 --- a/WoofWare.PawPrint/TypeInfo.fs +++ b/WoofWare.PawPrint/TypeInfo.fs @@ -117,7 +117,7 @@ module TypeInfo = |> ImmutableDictionary.CreateRange let fields = - metadataReader.FieldDefinitions + typeDef.GetFields () |> Seq.map (fun h -> FieldInfo.make metadataReader.GetString h (metadataReader.GetFieldDefinition h)) |> Seq.toList @@ -141,19 +141,21 @@ module TypeInfo = |> Seq.map (fun h -> CustomAttribute.make h (metadataReader.GetCustomAttribute h)) |> Seq.toList + let methods = + methods + |> Seq.choose (fun m -> + let result = MethodInfo.read loggerFactory peReader metadataReader m + + match result with + | None -> None + | Some x -> Some x + ) + |> Seq.toList + { Namespace = ns Name = name - Methods = - methods - |> Seq.choose (fun m -> - let result = MethodInfo.read loggerFactory peReader metadataReader m - - match result with - | None -> None - | Some x -> Some x - ) - |> Seq.toList + Methods = methods MethodImpls = methodImpls Fields = fields BaseType = baseType diff --git a/WoofWare.PawPrint/TypeInitialisation.fs b/WoofWare.PawPrint/TypeInitialisation.fs new file mode 100644 index 0000000..29d3edf --- /dev/null +++ b/WoofWare.PawPrint/TypeInitialisation.fs @@ -0,0 +1,42 @@ +namespace WoofWare.PawPrint + +open System.Collections.Immutable +open System.Reflection +open System.Reflection.Metadata + +/// Represents the state of a type's initialization in the CLI +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 + +[] +module TypeInitTable = + let beginInitialising + (thread : ThreadId) + (typeDef : TypeDefinitionHandle * AssemblyName) + (t : TypeInitTable) + : TypeInitTable + = + match t.TryGetValue typeDef with + | false, _ -> t.Add (typeDef, TypeInitState.InProgress thread) + | true, v -> failwith "Logic error: tried initialising a type which has already started initialising" + + let markInitialised + (thread : ThreadId) + (typeDef : TypeDefinitionHandle * AssemblyName) + (t : TypeInitTable) + : TypeInitTable + = + match t.TryGetValue typeDef 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" + | true, TypeInitState.InProgress thread2 -> + if thread <> thread2 then + failwith + "Logic error: completed initialisation of a type on a different thread to the one which started it!" + else + t.SetItem (typeDef, TypeInitState.Initialized) diff --git a/WoofWare.PawPrint/WoofWare.PawPrint.fsproj b/WoofWare.PawPrint/WoofWare.PawPrint.fsproj index 4b6ca7f..cef003a 100644 --- a/WoofWare.PawPrint/WoofWare.PawPrint.fsproj +++ b/WoofWare.PawPrint/WoofWare.PawPrint.fsproj @@ -20,6 +20,11 @@ + + + + +