From de1eefb436bd5b5e32cd426678922191868c341d Mon Sep 17 00:00:00 2001 From: Patrick Stevens <3138005+Smaug123@users.noreply.github.com> Date: Fri, 4 Jul 2025 19:08:56 +0100 Subject: [PATCH] Implement Sizeof (#92) --- CLAUDE.md | 8 +- WoofWare.PawPrint.Domain/ConcreteType.fs | 15 +- .../TypeConcretisation.fs | 41 ++- WoofWare.PawPrint.Domain/TypeDefn.fs | 22 ++ WoofWare.PawPrint.Test/TestPureCases.fs | 38 ++- .../WoofWare.PawPrint.Test.fsproj | 1 + WoofWare.PawPrint.Test/sourcesPure/Sizeof.cs | 118 +++++++ WoofWare.PawPrint/BasicCliType.fs | 67 ++-- WoofWare.PawPrint/EvalStack.fs | 33 +- .../System.Threading.Monitor.fs | 2 +- WoofWare.PawPrint/IlMachineState.fs | 27 +- WoofWare.PawPrint/IlMachineStateExecution.fs | 8 +- WoofWare.PawPrint/Intrinsics.fs | 14 +- WoofWare.PawPrint/Program.fs | 4 +- WoofWare.PawPrint/UnaryMetadataIlOp.fs | 295 ++++++++++-------- WoofWare.PawPrint/UnaryStringTokenIlOp.fs | 2 +- 16 files changed, 456 insertions(+), 239 deletions(-) create mode 100644 WoofWare.PawPrint.Test/sourcesPure/Sizeof.cs diff --git a/CLAUDE.md b/CLAUDE.md index 8b3e55a..3708265 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -44,7 +44,7 @@ dotnet fantomas . ### Running the Application A playground C# file is in CSharpExample/Class1.cs. This environment is convenient for running WoofWare.PawPrint against a standalone DLL. -Interpolate the approprate strings like `{Platform}` as necessary depending on the current environment and the output of the `dotnet publish`. +Interpolate the appropriate strings like `{Platform}` as necessary depending on the current environment and the output of the `dotnet publish`. ```bash dotnet publish --self-contained --runtime {Platform} CSharpExample/ @@ -68,7 +68,7 @@ dotnet run --project WoofWare.PawPrint.App/WoofWare.PawPrint.App.fsproj -- CShar **WoofWare.PawPrint.Test** - Uses Expecto as the test framework -- Test cases are defined in `TestCases.fs` +- Test cases are defined in `TestPureCases.fs` and `TestImpureCases.fs` - C# source files in `sources{Pure,Impure}/` are compiled and executed by the runtime as test cases - `TestHarness.fs` provides infrastructure for running test assemblies through the interpreter - Run all tests with `dotnet run --project WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj -- --no-spinner` @@ -98,8 +98,8 @@ dotnet run --project WoofWare.PawPrint.App/WoofWare.PawPrint.App.fsproj -- CShar When adding new IL instruction support: 1. Add the instruction to `IlOp.fs` 2. Implement execution logic in `AbstractMachine.fs` -3. Add a test case in `sources/` (C# file) that exercises the instruction -4. Add the test case to `TestCases.fs` +3. Add a test case in `sourcesPure/` or `sourcesImpure/` (C# file) that exercises the instruction, remembering also to add the file as an EmbeddedResource in WoofWare.PawPrint.Test.fsproj +4. Add the test case to `TestPureCases.fs` or `TestImpureCases.fs` 5. Run tests to verify implementation The project uses deterministic builds and treats warnings as errors to maintain code quality. diff --git a/WoofWare.PawPrint.Domain/ConcreteType.fs b/WoofWare.PawPrint.Domain/ConcreteType.fs index f85f467..87601e7 100644 --- a/WoofWare.PawPrint.Domain/ConcreteType.fs +++ b/WoofWare.PawPrint.Domain/ConcreteType.fs @@ -1,6 +1,7 @@ namespace WoofWare.PawPrint open System +open System.Collections.Immutable open System.Reflection open System.Reflection.Metadata @@ -30,12 +31,12 @@ type ConcreteType<'typeGeneric when 'typeGeneric : comparison and 'typeGeneric : /// Do not use this, because it's intended to be private; use the accessor `.Namespace` instead. _Namespace : string /// Do not use this, because it's intended to be private; use the accessor `.Generics` instead. - _Generics : 'typeGeneric list + _Generics : 'typeGeneric ImmutableArray } member this.Assembly : AssemblyName = this._AssemblyName member this.Definition : ComparableTypeDefinitionHandle = this._Definition - member this.Generics : 'typeGeneric list = this._Generics + member this.Generics : 'typeGeneric ImmutableArray = this._Generics member this.Name = this._Name member this.Namespace = this._Namespace @@ -65,8 +66,8 @@ type ConcreteType<'typeGeneric when 'typeGeneric : comparison and 'typeGeneric : comp else - let thisGen = (this._Generics : 'typeGeneric list) :> IComparable<'typeGeneric list> - thisGen.CompareTo other._Generics + let thisGen = this._Generics |> Seq.toList :> IComparable<'typeGeneric list> + thisGen.CompareTo (other._Generics |> Seq.toList) interface IComparable with member this.CompareTo other = @@ -82,7 +83,7 @@ module ConcreteType = (ns : string) (name : string) (defn : TypeDefinitionHandle) - (generics : TypeDefn list) + (generics : TypeDefn ImmutableArray) : ConcreteType = { @@ -106,7 +107,7 @@ module ConcreteType = _Definition = ComparableTypeDefinitionHandle.Make defn _Name = name _Namespace = ns - _Generics = List.replicate genericParamCount FakeUnit.FakeUnit + _Generics = Seq.replicate genericParamCount FakeUnit.FakeUnit |> ImmutableArray.CreateRange } let mapGeneric<'a, 'b @@ -115,7 +116,7 @@ module ConcreteType = (x : ConcreteType<'a>) : ConcreteType<'b> = - let generics = x._Generics |> List.mapi f + let generics = x._Generics |> Seq.mapi f |> ImmutableArray.CreateRange { _AssemblyName = x._AssemblyName diff --git a/WoofWare.PawPrint.Domain/TypeConcretisation.fs b/WoofWare.PawPrint.Domain/TypeConcretisation.fs index d99b53c..2e49155 100644 --- a/WoofWare.PawPrint.Domain/TypeConcretisation.fs +++ b/WoofWare.PawPrint.Domain/TypeConcretisation.fs @@ -46,7 +46,7 @@ module AllConcreteTypes = let findExistingConcreteType (concreteTypes : AllConcreteTypes) - (asm : AssemblyName, ns : string, name : string, generics : ConcreteTypeHandle list as key) + (asm : AssemblyName, ns : string, name : string, generics : ConcreteTypeHandle ImmutableArray as key) : ConcreteTypeHandle option = concreteTypes.Mapping @@ -95,7 +95,7 @@ module TypeConcretization = (assembly : AssemblyName) (ns : string) (name : string) - (generics : ConcreteTypeHandle list) + (generics : ConcreteTypeHandle ImmutableArray) : ConcreteTypeHandle option = concreteTypes.Mapping @@ -118,7 +118,7 @@ module TypeConcretization = : ConcreteTypeHandle option = let (asm, ns, name) = key - findExistingType concreteTypes asm ns name [] + findExistingType concreteTypes asm ns name ImmutableArray.Empty // Helper function to create and add a ConcreteType to the context let private createAndAddConcreteType @@ -127,7 +127,7 @@ module TypeConcretization = (definition : ComparableTypeDefinitionHandle) (ns : string) (name : string) - (generics : ConcreteTypeHandle list) + (generics : ConcreteTypeHandle ImmutableArray) : ConcreteTypeHandle * ConcretizationContext = let concreteType = @@ -229,7 +229,7 @@ module TypeConcretization = (ComparableTypeDefinitionHandle.Make typeInfo.TypeDefHandle) typeInfo.Namespace typeInfo.Name - [] // Primitives have no generic parameters + ImmutableArray.Empty // Primitives have no generic parameters let private concretizeArray (ctx : ConcretizationContext) @@ -248,7 +248,7 @@ module TypeConcretization = arrayTypeInfo.Assembly arrayTypeInfo.Namespace arrayTypeInfo.Name - [ elementHandle ] + (ImmutableArray.Create elementHandle) with | Some handle -> handle, ctx | None -> @@ -259,7 +259,7 @@ module TypeConcretization = (ComparableTypeDefinitionHandle.Make arrayTypeInfo.TypeDefHandle) arrayTypeInfo.Namespace arrayTypeInfo.Name - [ elementHandle ] // Array has one generic parameter + (ImmutableArray.Create elementHandle) // Array has one generic parameter let private concretizeOneDimArray (ctx : ConcretizationContext) @@ -278,7 +278,7 @@ module TypeConcretization = arrayTypeInfo.Assembly arrayTypeInfo.Namespace arrayTypeInfo.Name - [ elementHandle ] + (ImmutableArray.Create elementHandle) with | Some handle -> handle, ctx | None -> @@ -289,7 +289,7 @@ module TypeConcretization = (ComparableTypeDefinitionHandle.Make arrayTypeInfo.TypeDefHandle) arrayTypeInfo.Namespace arrayTypeInfo.Name - [ elementHandle ] // Array has one generic parameter + (ImmutableArray.Create elementHandle) // Array has one generic parameter let concretizeTypeDefinition (ctx : ConcretizationContext) @@ -315,11 +315,17 @@ module TypeConcretization = typeInfo.Generics.Length // Check if we've already concretized this type - match findExistingType ctx.ConcreteTypes assemblyName typeInfo.Namespace typeInfo.Name [] with + match findExistingType ctx.ConcreteTypes assemblyName typeInfo.Namespace typeInfo.Name ImmutableArray.Empty with | Some handle -> handle, ctx | None -> // Create and add the concrete type (no generic arguments since it's not generic) - createAndAddConcreteType ctx assemblyName typeDefHandle typeInfo.Namespace typeInfo.Name [] // No generic parameters + createAndAddConcreteType + ctx + assemblyName + typeDefHandle + typeInfo.Namespace + typeInfo.Name + ImmutableArray.Empty // No generic parameters let private concretizeTypeReference (loadAssembly : @@ -422,7 +428,12 @@ module TypeConcretization = let voidTypeInfo = ctx.BaseTypes.Void match - findExistingType ctx.ConcreteTypes voidTypeInfo.Assembly voidTypeInfo.Namespace voidTypeInfo.Name [] + findExistingType + ctx.ConcreteTypes + voidTypeInfo.Assembly + voidTypeInfo.Namespace + voidTypeInfo.Name + ImmutableArray.Empty with | Some handle -> handle, ctx | None -> @@ -433,7 +444,7 @@ module TypeConcretization = (ComparableTypeDefinitionHandle.Make voidTypeInfo.TypeDefHandle) voidTypeInfo.Namespace voidTypeInfo.Name - [] // Void has no generic parameters + ImmutableArray.Empty // Void has no generic parameters | _ -> failwithf "TODO: Concretization of %A not implemented" typeDefn @@ -460,7 +471,7 @@ module TypeConcretization = ) ([], ctx) - let argHandles = argHandles |> List.rev + let argHandles = argHandles |> Seq.rev |> ImmutableArray.CreateRange // Get the base type definition let baseAssembly, baseTypeDefHandle, baseNamespace, baseName, ctxAfterArgs = @@ -891,7 +902,7 @@ module Concretization = // Recursively convert generic arguments let genericArgs = concreteType.Generics - |> List.map (fun h -> concreteHandleToTypeDefn baseClassTypes h concreteTypes assemblies) + |> Seq.map (fun h -> concreteHandleToTypeDefn baseClassTypes h concreteTypes assemblies) |> ImmutableArray.CreateRange let baseDef = diff --git a/WoofWare.PawPrint.Domain/TypeDefn.fs b/WoofWare.PawPrint.Domain/TypeDefn.fs index 2d7e76b..c7d7459 100644 --- a/WoofWare.PawPrint.Domain/TypeDefn.fs +++ b/WoofWare.PawPrint.Domain/TypeDefn.fs @@ -149,6 +149,28 @@ type PrimitiveType = | PrimitiveType.UIntPtr -> "uintptr" | PrimitiveType.Object -> "obj" +[] +module PrimitiveType = + let sizeOf (pt : PrimitiveType) : int = + match pt with + | PrimitiveType.Boolean -> 1 + | PrimitiveType.Char -> 2 + | PrimitiveType.SByte -> 1 + | PrimitiveType.Byte -> 1 + | PrimitiveType.Int16 -> 2 + | PrimitiveType.UInt16 -> 2 + | PrimitiveType.Int32 -> 4 + | PrimitiveType.UInt32 -> 4 + | PrimitiveType.Int64 -> 8 + | PrimitiveType.UInt64 -> 8 + | PrimitiveType.Single -> 4 + | PrimitiveType.Double -> 8 + | PrimitiveType.String -> 8 + | PrimitiveType.TypedReference -> failwith "todo" + | PrimitiveType.IntPtr -> 8 + | PrimitiveType.UIntPtr -> 8 + | PrimitiveType.Object -> 8 + type TypeDefn = | PrimitiveType of PrimitiveType // TODO: array shapes diff --git a/WoofWare.PawPrint.Test/TestPureCases.fs b/WoofWare.PawPrint.Test/TestPureCases.fs index 485e01c..9ab141d 100644 --- a/WoofWare.PawPrint.Test/TestPureCases.fs +++ b/WoofWare.PawPrint.Test/TestPureCases.fs @@ -25,18 +25,6 @@ module TestPureCases = NativeImpls = MockEnv.make () LocalVariablesOfMain = None } - { - FileName = "TestShl.cs" - ExpectedReturnCode = 0 - NativeImpls = MockEnv.make () - LocalVariablesOfMain = None - } - { - FileName = "TestShr.cs" - ExpectedReturnCode = 0 - NativeImpls = MockEnv.make () - LocalVariablesOfMain = None - } { FileName = "Threads.cs" ExpectedReturnCode = 3 @@ -79,6 +67,12 @@ module TestPureCases = NativeImpls = MockEnv.make () LocalVariablesOfMain = [ CliType.Numeric (CliNumericType.Int32 10) ] |> Some } + { + FileName = "Sizeof.cs" + ExpectedReturnCode = 0 + NativeImpls = MockEnv.make () + LocalVariablesOfMain = None + } ] let cases : TestCase list = @@ -89,6 +83,18 @@ module TestPureCases = NativeImpls = MockEnv.make () LocalVariablesOfMain = [ CliType.Numeric (CliNumericType.Int32 1) ] |> Some } + { + FileName = "TestShl.cs" + ExpectedReturnCode = 0 + NativeImpls = MockEnv.make () + LocalVariablesOfMain = None + } + { + FileName = "TestShr.cs" + ExpectedReturnCode = 0 + NativeImpls = MockEnv.make () + LocalVariablesOfMain = None + } { FileName = "StaticVariables.cs" ExpectedReturnCode = 0 @@ -117,9 +123,9 @@ module TestPureCases = // filter CliType.ObjectRef (Some (ManagedHeapAddress 2)) // result - CliType.OfBool true + CliType.ofBool true // result, cloned for "if(result)" check - CliType.OfBool true + CliType.ofBool true // ret CliType.Numeric (CliNumericType.Int32 8) ] @@ -148,7 +154,7 @@ module TestPureCases = // a copy of locker, taken so that the contents of the implicit `finally` have a stable copy CliType.ObjectRef (Some (ManagedHeapAddress 2)) // out param of `ReliableEnter` - CliType.OfBool true + CliType.ofBool true // return value CliType.Numeric (CliNumericType.Int32 1) ] @@ -165,7 +171,7 @@ module TestPureCases = // i CliType.Numeric (CliNumericType.Int32 5) // End-loop condition - CliType.OfBool false + CliType.ofBool false // Ret CliType.Numeric (CliNumericType.Int32 10) ] diff --git a/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj b/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj index aba25ba..cfa8eeb 100644 --- a/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj +++ b/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj @@ -39,6 +39,7 @@ + diff --git a/WoofWare.PawPrint.Test/sourcesPure/Sizeof.cs b/WoofWare.PawPrint.Test/sourcesPure/Sizeof.cs new file mode 100644 index 0000000..2c92c57 --- /dev/null +++ b/WoofWare.PawPrint.Test/sourcesPure/Sizeof.cs @@ -0,0 +1,118 @@ +using System; +using System.Runtime.InteropServices; + +unsafe public class Program +{ + public struct SmallStruct + { + public byte Value; + } + + public struct MediumStruct + { + public int Value1; + public int Value2; + } + + public struct LargeStruct + { + public long Value1; + public long Value2; + public long Value3; + public long Value4; + } + + public struct NestedStruct + { + public SmallStruct Small; + public MediumStruct Medium; + public int Extra; + } + + [StructLayout(LayoutKind.Explicit)] + public struct UnionStruct + { + [FieldOffset(0)] + public int AsInt; + [FieldOffset(0)] + public float AsFloat; + } + + public static int Main(string[] args) + { + // Test 1: Basic primitive types + if (sizeof(byte) != 1) return 1; + if (sizeof(sbyte) != 1) return 2; + if (sizeof(short) != 2) return 3; + if (sizeof(ushort) != 2) return 4; + if (sizeof(int) != 4) return 5; + if (sizeof(uint) != 4) return 6; + if (sizeof(long) != 8) return 7; + if (sizeof(ulong) != 8) return 8; + if (sizeof(float) != 4) return 9; + if (sizeof(double) != 8) return 10; + if (sizeof(char) != 2) return 11; + if (sizeof(bool) != 1) return 12; + + // Test 2: Struct sizes + if (sizeof(SmallStruct) != 1) return 13; + if (sizeof(MediumStruct) != 8) return 14; + if (sizeof(LargeStruct) != 32) return 15; + + // Test 3: Nested struct size + // SmallStruct (1) + padding (3) + MediumStruct (8) + int (4) = 16 + if (sizeof(NestedStruct) != 16) return 16; + + // Test 4: Union struct size + if (sizeof(UnionStruct) != 4) return 17; + + // Test 5: Enum size (underlying type is int) + if (sizeof(DayOfWeek) != 4) return 18; + + // Test 6: Pointer types + unsafe + { + if (sizeof(IntPtr) != sizeof(void*)) return 19; + if (sizeof(UIntPtr) != sizeof(void*)) return 20; + } + + // Test 7: Using sizeof in expressions + int totalSize = sizeof(int) + sizeof(long) + sizeof(byte); + if (totalSize != 13) return 21; + + // Test 8: Array element size calculation + int arrayElementSize = sizeof(MediumStruct); + int arraySize = arrayElementSize * 3; + if (arraySize != 24) return 22; + + // Test 9: Conditional using sizeof + bool is32Bit = sizeof(IntPtr) == 4; + bool is64Bit = sizeof(IntPtr) == 8; + if (!is32Bit && !is64Bit) return 23; + if (is32Bit && is64Bit) return 24; + + // Test 10: Sizeof in switch statement + int result = 0; + switch (sizeof(int)) + { + case 1: + result = 1; + break; + case 2: + result = 2; + break; + case 4: + result = 4; + break; + case 8: + result = 8; + break; + default: + result = -1; + break; + } + if (result != 4) return 25; + + return 0; + } +} diff --git a/WoofWare.PawPrint/BasicCliType.fs b/WoofWare.PawPrint/BasicCliType.fs index b560913..815875e 100644 --- a/WoofWare.PawPrint/BasicCliType.fs +++ b/WoofWare.PawPrint/BasicCliType.fs @@ -113,18 +113,6 @@ type CliNumericType = | 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 CliRuntimePointerSource = | LocalVariable of sourceThread : ThreadId * methodFrame : int * whichVar : uint16 @@ -151,15 +139,12 @@ type CliType = | RuntimePointer of CliRuntimePointer /// This is *not* a CLI type as such. I don't actually know its status. A value type is represented simply /// as a concatenated list of its fields. - | ValueType of (string * CliType) list + | ValueType of CliValueType - /// 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) +and CliValueType = + { + Fields : (string * CliType) list + } type CliTypeResolutionResult = | Resolved of CliType @@ -167,6 +152,38 @@ type CliTypeResolutionResult = [] module CliType = + /// In fact any non-zero value will do for True, but we'll use 1 + let ofBool (b : bool) : CliType = CliType.Bool (if b then 1uy else 0uy) + + let ofChar (c : char) : CliType = + CliType.Char (byte (int c / 256), byte (int c % 256)) + + let ofManagedObject (ptr : ManagedHeapAddress) : CliType = CliType.ObjectRef (Some ptr) + + let rec sizeOf (ty : CliType) : int = + match ty with + | CliType.Numeric ty -> + match ty with + | CliNumericType.Int32 _ -> 4 + | CliNumericType.Int64 _ -> 8 + | CliNumericType.NativeInt _ -> 8 + | CliNumericType.NativeFloat _ -> 8 + | CliNumericType.Int8 _ -> 1 + | CliNumericType.Int16 _ -> 2 + | CliNumericType.UInt8 _ -> 1 + | CliNumericType.UInt16 _ -> 2 + | CliNumericType.Float32 _ -> 4 + | CliNumericType.Float64 _ -> 8 + | CliType.Bool _ -> 1 + | CliType.Char _ -> 2 + | CliType.ObjectRef _ -> 8 + | CliType.RuntimePointer _ -> 8 + | CliType.ValueType vt -> + match vt.Fields with + | [] -> failwith "is it even possible to instantiate a value type with no fields" + | [ _, f ] -> sizeOf f + | _ -> failwith $"TODO: %O{vt.Fields} (need to consider struct layout)" + let zeroOfPrimitive (primitiveType : PrimitiveType) : CliType = match primitiveType with | PrimitiveType.Boolean -> CliType.Bool 0uy @@ -345,7 +362,12 @@ module CliType = (field.Name, fieldZero) ) - CliType.ValueType fieldZeros, currentConcreteTypes + let vt = + { + Fields = fieldZeros + } + + CliType.ValueType vt, currentConcreteTypes else // It's a reference type CliType.ObjectRef None, concreteTypes @@ -369,7 +391,6 @@ module CliType = } // The field type might reference generic parameters of the declaring type - let typeGenerics = declaringType.Generics |> ImmutableArray.CreateRange let methodGenerics = ImmutableArray.Empty // Fields don't have method generics let loadAssembly @@ -392,7 +413,7 @@ module CliType = ctx loadAssembly declaringType.Assembly - typeGenerics + declaringType.Generics methodGenerics fieldType diff --git a/WoofWare.PawPrint/EvalStack.fs b/WoofWare.PawPrint/EvalStack.fs index d4c14d8..8366dfb 100644 --- a/WoofWare.PawPrint/EvalStack.fs +++ b/WoofWare.PawPrint/EvalStack.fs @@ -197,7 +197,7 @@ module EvalStackValue = match popped with | EvalStackValue.ManagedPointer src -> match src with - | ManagedPointerSource.Heap addr -> CliType.OfManagedObject addr + | ManagedPointerSource.Heap addr -> CliType.ofManagedObject addr | ManagedPointerSource.Null -> CliType.ObjectRef None | ManagedPointerSource.LocalVariable (sourceThread, methodFrame, var) -> CliRuntimePointerSource.LocalVariable (sourceThread, methodFrame, var) @@ -238,25 +238,30 @@ module EvalStackValue = let low = i % 256 CliType.Char (byte high, byte low) | popped -> failwith $"Unexpectedly wanted a char from {popped}" - | CliType.ValueType fields -> + | CliType.ValueType vt -> match popped with | EvalStackValue.UserDefinedValueType popped -> - if fields.Length <> popped.Length then + if vt.Fields.Length <> popped.Length then failwith - $"mismatch: popped value type {popped} (length %i{popped.Length}) into {fields} (length %i{fields.Length})" + $"mismatch: popped value type {popped} (length %i{popped.Length}) into {vt} (length %i{vt.Fields.Length})" - List.map2 - (fun (name1, v1) (name2, v2) -> - if name1 <> name2 then - failwith $"TODO: name mismatch, {name1} vs {name2}" + let fields = + List.map2 + (fun (name1, v1) (name2, v2) -> + if name1 <> name2 then + failwith $"TODO: name mismatch, {name1} vs {name2}" - name1, toCliTypeCoerced v1 v2 - ) - fields - popped + name1, toCliTypeCoerced v1 v2 + ) + vt.Fields + popped + + { + Fields = fields + } |> CliType.ValueType | popped -> - match fields with + match vt.Fields with | [ _, target ] -> toCliTypeCoerced target popped | _ -> failwith $"TODO: {popped} into value type {target}" @@ -299,7 +304,7 @@ module EvalStackValue = | CliRuntimePointerSource.Heap addr -> EvalStackValue.ObjectRef addr | CliRuntimePointerSource.Null -> EvalStackValue.ManagedPointer ManagedPointerSource.Null | CliType.ValueType fields -> - fields + fields.Fields |> List.map (fun (name, f) -> name, ofCliType f) |> EvalStackValue.UserDefinedValueType diff --git a/WoofWare.PawPrint/ExternImplementations/System.Threading.Monitor.fs b/WoofWare.PawPrint/ExternImplementations/System.Threading.Monitor.fs index de2acd2..f765601 100644 --- a/WoofWare.PawPrint/ExternImplementations/System.Threading.Monitor.fs +++ b/WoofWare.PawPrint/ExternImplementations/System.Threading.Monitor.fs @@ -82,7 +82,7 @@ module System_Threading_Monitor = | ManagedPointerSource.Null -> failwith "logic error" | ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) -> state - |> IlMachineState.setLocalVariable sourceThread methodFrame whichVar (CliType.OfBool true) + |> IlMachineState.setLocalVariable sourceThread methodFrame whichVar (CliType.ofBool true) | ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) -> failwith "not really expecting to *edit* an argument..." | ManagedPointerSource.Heap addr -> failwith "todo: managed heap" diff --git a/WoofWare.PawPrint/IlMachineState.fs b/WoofWare.PawPrint/IlMachineState.fs index 039f917..8fc378a 100644 --- a/WoofWare.PawPrint/IlMachineState.fs +++ b/WoofWare.PawPrint/IlMachineState.fs @@ -477,7 +477,7 @@ module IlMachineState = // Concretize each generic argument first let mutable currentCtx = ctx - let genericHandles = ImmutableArray.CreateBuilder (declaringType.Generics.Length) + let genericHandles = ImmutableArray.CreateBuilder declaringType.Generics.Length for genericArg in declaringType.Generics do let handle, newCtx = @@ -490,7 +490,7 @@ module IlMachineState = genericArg currentCtx <- newCtx - genericHandles.Add (handle) + genericHandles.Add handle // Now we need to concretize the type definition itself // If it's a non-generic type, we can use concretizeTypeDefinition directly @@ -507,10 +507,7 @@ module IlMachineState = else // For generic types, we need to check if this concrete instantiation already exists let key = - (declaringType.Assembly, - declaringType.Namespace, - declaringType.Name, - genericHandles.ToImmutable () |> Seq.toList) + (declaringType.Assembly, declaringType.Namespace, declaringType.Name, genericHandles.ToImmutable ()) match AllConcreteTypes.findExistingConcreteType currentCtx.ConcreteTypes key with | Some handle -> @@ -707,11 +704,16 @@ module IlMachineState = match resolvedBaseType with | ResolvedBaseType.Delegate - | ResolvedBaseType.Object -> state |> pushToEvalStack (CliType.OfManagedObject constructing) currentThread + | ResolvedBaseType.Object -> state |> pushToEvalStack (CliType.ofManagedObject constructing) currentThread | ResolvedBaseType.ValueType -> + let vt = + { + Fields = Map.toList constructed.Fields + } + state // TODO: ordering of fields probably important - |> pushToEvalStack (CliType.ValueType (Map.toList constructed.Fields)) currentThread + |> pushToEvalStack (CliType.ValueType vt) currentThread | ResolvedBaseType.Enum -> failwith "TODO" | None -> match threadStateAtEndOfMethod.MethodState.EvaluationStack.Values with @@ -900,7 +902,7 @@ module IlMachineState = | _ -> // Fall back to current execution context let currentMethod = state.ThreadState.[thread].MethodState.ExecutingMethod - currentMethod.DeclaringType.Generics |> ImmutableArray.CreateRange, state + currentMethod.DeclaringType.Generics, state let typeGenerics, state = typeGenerics @@ -929,8 +931,7 @@ module IlMachineState = // Get type and method generics from current execution context let currentMethod = state.ThreadState.[thread].MethodState.ExecutingMethod - let contextTypeGenerics = - currentMethod.DeclaringType.Generics |> ImmutableArray.CreateRange + let contextTypeGenerics = currentMethod.DeclaringType.Generics let contextMethodGenerics = currentMethod.Generics |> ImmutableArray.CreateRange @@ -991,7 +992,7 @@ module IlMachineState = // Use the actual type arguments from the field's declaring type // These should already be correctly instantiated (e.g., GenericMethodParameter 0 for Array.Empty) - let genericArgs = field.DeclaringType.Generics |> ImmutableArray.CreateRange + let genericArgs = field.DeclaringType.Generics TypeDefn.GenericInstantiation (baseType, genericArgs) @@ -1022,7 +1023,7 @@ module IlMachineState = let concretizedType = AllConcreteTypes.lookup declaringHandle state.ConcreteTypes |> Option.get - let typeGenerics = concretizedType.Generics |> ImmutableArray.CreateRange + let typeGenerics = concretizedType.Generics state, declaringHandle, typeGenerics diff --git a/WoofWare.PawPrint/IlMachineStateExecution.fs b/WoofWare.PawPrint/IlMachineStateExecution.fs index 3250316..8d64a19 100644 --- a/WoofWare.PawPrint/IlMachineStateExecution.fs +++ b/WoofWare.PawPrint/IlMachineStateExecution.fs @@ -280,7 +280,7 @@ module IlMachineStateExecution = ctx (fun _ _ -> failwith "getAssembly not needed for base type concretization") sourceAssembly.Name - (concreteType.Generics |> ImmutableArray.CreateRange) // Use the current type's generics + concreteType.Generics // Use the current type's generics ImmutableArray.Empty // No method generics baseTypeDefn @@ -345,7 +345,7 @@ module IlMachineStateExecution = ctx (fun _ _ -> failwith "getAssembly not needed for base type concretization") assy.Name - (concreteType.Generics |> ImmutableArray.CreateRange) // Use the current type's generics + concreteType.Generics // Use the current type's generics ImmutableArray.Empty // No method generics baseTypeDefn @@ -418,7 +418,7 @@ module IlMachineStateExecution = state._LoadedAssemblies, targetAssy ) concreteType.Assembly - (concreteType.Generics |> ImmutableArray.CreateRange) + concreteType.Generics ImmutableArray.Empty // no method generics for cctor typeDefn @@ -469,7 +469,7 @@ module IlMachineStateExecution = state._LoadedAssemblies, targetAssy ) concreteType.Assembly - (concreteType.Generics |> ImmutableArray.CreateRange) + concreteType.Generics ImmutableArray.Empty // no method generics for cctor typeDefn diff --git a/WoofWare.PawPrint/Intrinsics.fs b/WoofWare.PawPrint/Intrinsics.fs index 22e04c3..51c0be9 100644 --- a/WoofWare.PawPrint/Intrinsics.fs +++ b/WoofWare.PawPrint/Intrinsics.fs @@ -61,10 +61,12 @@ module Intrinsics = go arg let state = - IlMachineState.pushToEvalStack - (CliType.ValueType [ "m_type", CliType.ObjectRef arg ]) - currentThread - state + let vt = + { + Fields = [ "m_type", CliType.ObjectRef arg ] + } + + IlMachineState.pushToEvalStack (CliType.ValueType vt) currentThread state |> IlMachineState.advanceProgramCounter currentThread Some state @@ -170,7 +172,7 @@ module Intrinsics = if arg1 = arg2 then state - |> IlMachineState.pushToEvalStack (CliType.OfBool true) currentThread + |> IlMachineState.pushToEvalStack (CliType.ofBool true) currentThread |> IlMachineState.advanceProgramCounter currentThread |> Some else @@ -218,7 +220,7 @@ module Intrinsics = && ret.Namespace = "System" && ret.Name = "ReadOnlySpan`1" then - match ret.Generics with + match ret.Generics |> Seq.toList with | [ gen ] -> let gen = state.ConcreteTypes |> AllConcreteTypes.lookup gen |> Option.get diff --git a/WoofWare.PawPrint/Program.fs b/WoofWare.PawPrint/Program.fs index 53e2f42..eee741b 100644 --- a/WoofWare.PawPrint/Program.fs +++ b/WoofWare.PawPrint/Program.fs @@ -28,7 +28,7 @@ module Program = ((state, 0), argsAllocations) ||> Seq.fold (fun (state, i) arg -> let state = - IlMachineState.setArrayValue arrayAllocation (CliType.OfManagedObject arg) i state + IlMachineState.setArrayValue arrayAllocation (CliType.ofManagedObject arg) i state state, i + 1 ) @@ -301,7 +301,7 @@ module Program = dumped concretizedMainMethod ImmutableArray.Empty - (ImmutableArray.Create (CliType.OfManagedObject arrayAllocation)) + (ImmutableArray.Create (CliType.ofManagedObject arrayAllocation)) None with | Ok s -> s diff --git a/WoofWare.PawPrint/UnaryMetadataIlOp.fs b/WoofWare.PawPrint/UnaryMetadataIlOp.fs index 4bd4e8c..69c9b18 100644 --- a/WoofWare.PawPrint/UnaryMetadataIlOp.fs +++ b/WoofWare.PawPrint/UnaryMetadataIlOp.fs @@ -7,6 +7,100 @@ open Microsoft.Extensions.Logging [] module internal UnaryMetadataIlOp = + let lookupTypeDefn + (baseClassTypes : BaseClassTypes) + (state : IlMachineState) + (activeAssy : DumpedAssembly) + (typeDef : TypeDefinitionHandle) + : IlMachineState * TypeDefn + = + let defn = activeAssy.TypeDefs.[typeDef] + + let baseType = + defn.BaseType + |> DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies defn.Assembly + + let signatureTypeKind = + match baseType with + | ResolvedBaseType.Enum + | ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType + | ResolvedBaseType.Object -> SignatureTypeKind.Class + | ResolvedBaseType.Delegate -> SignatureTypeKind.Class + + let result = + if defn.Generics.IsEmpty then + TypeDefn.FromDefinition ( + ComparableTypeDefinitionHandle.Make defn.TypeDefHandle, + defn.Assembly.FullName, + signatureTypeKind + ) + else + // Preserve the generic instantiation by converting GenericParameters to TypeDefn.GenericTypeParameter + let genericDef = + TypeDefn.FromDefinition ( + ComparableTypeDefinitionHandle.Make defn.TypeDefHandle, + defn.Assembly.FullName, + signatureTypeKind + ) + + let genericArgs = + defn.Generics + |> Seq.mapi (fun i _ -> TypeDefn.GenericTypeParameter i) + |> ImmutableArray.CreateRange + + TypeDefn.GenericInstantiation (genericDef, genericArgs) + + state, result + + let lookupTypeRef + (loggerFactory : ILoggerFactory) + (baseClassTypes : BaseClassTypes) + (state : IlMachineState) + (activeAssy : DumpedAssembly) + typeGenerics + (ref : TypeReferenceHandle) + : IlMachineState * TypeDefn * DumpedAssembly + = + let ref = activeAssy.TypeRefs.[ref] + + // Convert ConcreteTypeHandles back to TypeDefn for metadata operations + let typeGenerics = + typeGenerics + |> Seq.map (fun handle -> + Concretization.concreteHandleToTypeDefn + baseClassTypes + handle + state.ConcreteTypes + state._LoadedAssemblies + ) + |> ImmutableArray.CreateRange + + let state, assy, resolved = + IlMachineState.resolveTypeFromRef loggerFactory activeAssy ref typeGenerics state + + let baseType = + resolved.BaseType + |> DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies assy.Name + + let signatureTypeKind = + match baseType with + | ResolvedBaseType.Enum + | ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType + | ResolvedBaseType.Object -> SignatureTypeKind.Class + | ResolvedBaseType.Delegate -> SignatureTypeKind.Class + + let result = + TypeDefn.FromDefinition ( + ComparableTypeDefinitionHandle.Make resolved.TypeDefHandle, + assy.Name.FullName, + signatureTypeKind + ) + + if resolved.Generics.IsEmpty then + state, result, assy + else + failwith "TODO: add generics" + let execute (loggerFactory : ILoggerFactory) (baseClassTypes : BaseClassTypes) @@ -16,7 +110,10 @@ module internal UnaryMetadataIlOp = (thread : ThreadId) : IlMachineState * WhatWeDid = + let logger = loggerFactory.CreateLogger (op.ToString ()) + let activeAssy = state.ActiveAssembly thread + let currentMethod = state.ThreadState.[thread].MethodState.ExecutingMethod match op with | Call -> @@ -180,8 +277,6 @@ module internal UnaryMetadataIlOp = | Castclass -> failwith "TODO: Castclass unimplemented" | Newobj -> - let logger = loggerFactory.CreateLogger "Newobj" - let state, assy, ctor, typeArgsFromMetadata = match metadataToken with | MethodDef md -> @@ -206,8 +301,6 @@ 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 currentMethod = state.ThreadState.[thread].MethodState.ExecutingMethod - let state, concretizedCtor, declaringTypeHandle = IlMachineState.concretizeMethodForExecution loggerFactory @@ -241,8 +334,7 @@ module internal UnaryMetadataIlOp = ctorType.Name ) - let typeGenerics = - concretizedCtor.DeclaringType.Generics |> ImmutableArray.CreateRange + let typeGenerics = concretizedCtor.DeclaringType.Generics let state, fieldZeros = ((state, []), ctorType.Fields) @@ -299,11 +391,11 @@ module internal UnaryMetadataIlOp = state, WhatWeDid.Executed | Newarr -> let currentState = state.ThreadState.[thread] - let popped, newMethodState = MethodState.popFromStack currentState.MethodState + let popped, methodState = MethodState.popFromStack currentState.MethodState let currentState = { currentState with - MethodStates = currentState.MethodStates.SetItem (currentState.ActiveMethodState, newMethodState) + MethodStates = currentState.MethodStates.SetItem (currentState.ActiveMethodState, methodState) } let len = @@ -311,96 +403,16 @@ module internal UnaryMetadataIlOp = | EvalStackValue.Int32 v -> v | popped -> failwith $"unexpectedly popped value %O{popped} to serve as array len" - let typeGenerics = - newMethodState.ExecutingMethod.DeclaringType.Generics - |> ImmutableArray.CreateRange + let typeGenerics = currentMethod.DeclaringType.Generics let state, elementType, assy = match metadataToken with | MetadataToken.TypeDefinition defn -> - let assy = state.LoadedAssembly currentState.ActiveAssembly |> Option.get - let defn = assy.TypeDefs.[defn] - - let baseType = - defn.BaseType - |> DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies defn.Assembly - - let signatureTypeKind = - match baseType with - | ResolvedBaseType.Enum - | ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType - | ResolvedBaseType.Object -> SignatureTypeKind.Class - | ResolvedBaseType.Delegate -> SignatureTypeKind.Class - - let result = - if defn.Generics.IsEmpty then - TypeDefn.FromDefinition ( - ComparableTypeDefinitionHandle.Make defn.TypeDefHandle, - defn.Assembly.FullName, - signatureTypeKind - ) - else - // Preserve the generic instantiation by converting GenericParameters to TypeDefn.GenericTypeParameter - let genericDef = - TypeDefn.FromDefinition ( - ComparableTypeDefinitionHandle.Make defn.TypeDefHandle, - defn.Assembly.FullName, - signatureTypeKind - ) - - let genericArgs = - defn.Generics - |> Seq.mapi (fun i _ -> TypeDefn.GenericTypeParameter i) - |> ImmutableArray.CreateRange - - TypeDefn.GenericInstantiation (genericDef, genericArgs) - - state, result, assy - | MetadataToken.TypeSpecification spec -> - let assy = state.LoadedAssembly currentState.ActiveAssembly |> Option.get - state, assy.TypeSpecs.[spec].Signature, assy + let state, resolved = lookupTypeDefn baseClassTypes state activeAssy defn + state, resolved, activeAssy + | MetadataToken.TypeSpecification spec -> state, activeAssy.TypeSpecs.[spec].Signature, activeAssy | MetadataToken.TypeReference ref -> - let ref = state.ActiveAssembly(thread).TypeRefs.[ref] - - // Convert ConcreteTypeHandles back to TypeDefn for metadata operations - let typeGenerics = - newMethodState.ExecutingMethod.DeclaringType.Generics - |> Seq.map (fun handle -> - Concretization.concreteHandleToTypeDefn - baseClassTypes - handle - state.ConcreteTypes - state._LoadedAssemblies - ) - |> ImmutableArray.CreateRange - - let state, assy, resolved = - IlMachineState.resolveTypeFromRef - loggerFactory - (state.ActiveAssembly thread) - ref - typeGenerics - state - - let baseType = - resolved.BaseType - |> DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies assy.Name - - let signatureTypeKind = - match baseType with - | ResolvedBaseType.Enum - | ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType - | ResolvedBaseType.Object -> SignatureTypeKind.Class - | ResolvedBaseType.Delegate -> SignatureTypeKind.Class - - let result = - TypeDefn.FromDefinition ( - ComparableTypeDefinitionHandle.Make resolved.TypeDefHandle, - assy.Name.FullName, - signatureTypeKind - ) - - state, result, assy + lookupTypeRef loggerFactory baseClassTypes state activeAssy currentMethod.DeclaringType.Generics ref | x -> failwith $"TODO: Newarr element type resolution unimplemented for {x}" let state, zeroOfType = @@ -410,7 +422,7 @@ module internal UnaryMetadataIlOp = assy elementType typeGenerics - newMethodState.Generics + methodState.Generics state let alloc, state = IlMachineState.allocateArray (fun () -> zeroOfType) len state @@ -528,8 +540,6 @@ module internal UnaryMetadataIlOp = | t -> failwith $"Unexpectedly asked to store to a non-field: {t}" do - let logger = loggerFactory.CreateLogger "Stfld" - logger.LogInformation ( "Storing in object field {FieldAssembly}.{FieldDeclaringType}.{FieldName} (type {FieldType})", field.DeclaringType.Assembly.Name, @@ -632,8 +642,6 @@ module internal UnaryMetadataIlOp = | t -> failwith $"Unexpectedly asked to store to a non-field: {t}" do - let logger = loggerFactory.CreateLogger "Stsfld" - let declaring = state.ActiveAssembly(thread).TypeDefs.[field.DeclaringType.Definition.Get] @@ -691,7 +699,6 @@ module internal UnaryMetadataIlOp = | t -> failwith $"Unexpectedly asked to load from a non-field: {t}" do - let logger = loggerFactory.CreateLogger "Ldfld" let declaring = activeAssy.TypeDefs.[field.DeclaringType.Definition.Get] logger.LogInformation ( @@ -772,8 +779,6 @@ module internal UnaryMetadataIlOp = | Ldflda -> failwith "TODO: Ldflda unimplemented" | Ldsfld -> - let logger = loggerFactory.CreateLogger "Ldsfld" - let state, field = match metadataToken with | MetadataToken.FieldDefinition fieldHandle -> @@ -832,8 +837,6 @@ module internal UnaryMetadataIlOp = | Some v -> v, state do - let logger = loggerFactory.CreateLogger "Ldsfld" - let declaring = state .LoadedAssembly(field.DeclaringType.Assembly) @@ -856,20 +859,14 @@ module internal UnaryMetadataIlOp = | Unbox_Any -> failwith "TODO: Unbox_Any unimplemented" | Stelem -> - let assy = - state.LoadedAssembly state.ThreadState.[thread].ActiveAssembly |> Option.get - - let currentMethod = state.ThreadState.[thread].MethodState.ExecutingMethod - - let declaringTypeGenerics = - currentMethod.DeclaringType.Generics |> ImmutableArray.CreateRange + let declaringTypeGenerics = currentMethod.DeclaringType.Generics let state, assy, elementType = match metadataToken with | MetadataToken.TypeDefinition defn -> state, - assy, - assy.TypeDefs.[defn] + activeAssy, + activeAssy.TypeDefs.[defn] |> TypeInfo.mapGeneric (fun _ p -> TypeDefn.GenericTypeParameter p.SequenceNumber) | MetadataToken.TypeSpecification spec -> let state, assy, ty = @@ -877,7 +874,7 @@ module internal UnaryMetadataIlOp = loggerFactory baseClassTypes spec - assy + activeAssy declaringTypeGenerics currentMethod.Generics state @@ -926,20 +923,14 @@ module internal UnaryMetadataIlOp = |> Tuple.withRight WhatWeDid.Executed | Ldelem -> - let assy = - state.LoadedAssembly state.ThreadState.[thread].ActiveAssembly |> Option.get - - let currentMethod = state.ThreadState.[thread].MethodState.ExecutingMethod - - let declaringTypeGenerics = - currentMethod.DeclaringType.Generics |> ImmutableArray.CreateRange + let declaringTypeGenerics = currentMethod.DeclaringType.Generics let state, assy, elementType = match metadataToken with | MetadataToken.TypeDefinition defn -> state, - assy, - assy.TypeDefs.[defn] + activeAssy, + activeAssy.TypeDefs.[defn] |> TypeInfo.mapGeneric (fun _ p -> TypeDefn.GenericTypeParameter p.SequenceNumber) | MetadataToken.TypeSpecification spec -> let state, assy, ty = @@ -947,7 +938,7 @@ module internal UnaryMetadataIlOp = loggerFactory baseClassTypes spec - assy + activeAssy declaringTypeGenerics currentMethod.Generics state @@ -1030,8 +1021,6 @@ module internal UnaryMetadataIlOp = failwith "TODO: Ldsflda - push unmanaged pointer" | Ldftn -> - let logger = loggerFactory.CreateLogger "Ldftn" - let (method : MethodInfo), methodGenerics = match metadataToken with | MetadataToken.MethodDef handle -> @@ -1102,11 +1091,9 @@ module internal UnaryMetadataIlOp = if field.Name <> "m_type" then failwith $"unexpected field name ${field.Name} for BCL type RuntimeTypeHandle" - let currentMethod = state.ThreadState.[thread].MethodState - let methodGenerics = currentMethod.Generics - let typeGenerics = currentMethod.ExecutingMethod.DeclaringType.Generics + let typeGenerics = currentMethod.DeclaringType.Generics if not (methodGenerics.IsEmpty && typeGenerics.IsEmpty) then failwith "TODO: generics" @@ -1118,10 +1105,12 @@ module internal UnaryMetadataIlOp = let (_, alloc), state = IlMachineState.getOrAllocateType baseClassTypes handle state - IlMachineState.pushToEvalStack - (CliType.ValueType [ "m_type", CliType.ObjectRef (Some alloc) ]) - thread - state + let vt = + { + Fields = [ "m_type", CliType.ObjectRef (Some alloc) ] + } + + IlMachineState.pushToEvalStack (CliType.ValueType vt) thread state | _ -> failwith $"Unexpected metadata token %O{metadataToken} in LdToken" state @@ -1129,7 +1118,47 @@ module internal UnaryMetadataIlOp = |> Tuple.withRight WhatWeDid.Executed | Cpobj -> failwith "TODO: Cpobj unimplemented" | Ldobj -> failwith "TODO: Ldobj unimplemented" - | Sizeof -> failwith "TODO: Sizeof unimplemented" + | Sizeof -> + let state, ty, assy = + match metadataToken with + | MetadataToken.TypeDefinition h -> + let state, ty = lookupTypeDefn baseClassTypes state activeAssy h + state, ty, activeAssy + | MetadataToken.TypeReference ref -> + lookupTypeRef loggerFactory baseClassTypes state activeAssy currentMethod.DeclaringType.Generics ref + | _ -> failwith $"unexpected token {metadataToken} in Sizeof" + + let ctx = + { + TypeConcretization.ConcretizationContext.InProgress = ImmutableDictionary.Empty + TypeConcretization.ConcretizationContext.ConcreteTypes = state.ConcreteTypes + TypeConcretization.ConcretizationContext.LoadedAssemblies = state._LoadedAssemblies + TypeConcretization.ConcretizationContext.BaseTypes = baseClassTypes + } + + let typeHandle, newCtx = + TypeConcretization.concretizeType + ctx + (fun _ _ -> failwith "getAssembly not needed for base type concretization") + assy.Name + currentMethod.DeclaringType.Generics + currentMethod.Generics + ty + + let state = + { state with + _LoadedAssemblies = newCtx.LoadedAssemblies + ConcreteTypes = newCtx.ConcreteTypes + } + + let zero, state = IlMachineState.cliTypeZeroOfHandle state baseClassTypes typeHandle + + let size = CliType.sizeOf zero + + state + |> IlMachineState.pushToEvalStack (CliType.Numeric (CliNumericType.Int32 size)) thread + |> IlMachineState.advanceProgramCounter thread + |> Tuple.withRight WhatWeDid.Executed | Calli -> failwith "TODO: Calli unimplemented" | Unbox -> failwith "TODO: Unbox unimplemented" | Ldvirtftn -> failwith "TODO: Ldvirtftn unimplemented" diff --git a/WoofWare.PawPrint/UnaryStringTokenIlOp.fs b/WoofWare.PawPrint/UnaryStringTokenIlOp.fs index 0d0a97b..1b164e0 100644 --- a/WoofWare.PawPrint/UnaryStringTokenIlOp.fs +++ b/WoofWare.PawPrint/UnaryStringTokenIlOp.fs @@ -47,7 +47,7 @@ module internal UnaryStringTokenIlOp = let fields = [ - "_firstChar", CliType.OfChar state.ManagedHeap.StringArrayData.[dataAddr] + "_firstChar", CliType.ofChar state.ManagedHeap.StringArrayData.[dataAddr] "_stringLength", CliType.Numeric (CliNumericType.Int32 stringToAllocate.Length) ]