patrick/WoofWare.PawPrint
1
0
Fork 0
mirror of https://github.com/Smaug123/WoofWare.PawPrint synced 2025-10-05 06:08:39 +00:00
Code Issues Packages Projects Releases Wiki Activity

Implement Sizeof (#92)

Browse Source
This commit is contained in:
Patrick Stevens
2025-07-04 19:08:56 +01:00
committed by GitHub
parent 30b8ec990f
commit de1eefb436
16 changed files with 456 additions and 239 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
CLAUDE.md
View File

@@ -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.

15
WoofWare.PawPrint.Domain/ConcreteType.fs
View File

@@ -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<TypeDefn>
=
{
@@ -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

41
WoofWare.PawPrint.Domain/TypeConcretisation.fs
View File

@@ -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<T> has one generic parameter
(ImmutableArray.Create elementHandle) // Array<T> 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<T> has one generic parameter
(ImmutableArray.Create elementHandle) // Array<T> 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 =

22
WoofWare.PawPrint.Domain/TypeDefn.fs
View File

@@ -149,6 +149,28 @@ type PrimitiveType =
| PrimitiveType.UIntPtr -> "uintptr"
| PrimitiveType.Object -> "obj"
[<RequireQualifiedAccess>]
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

38
WoofWare.PawPrint.Test/TestPureCases.fs
View File

@@ -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)
]

1
WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj
View File

@@ -39,6 +39,7 @@
<EmbeddedResource Include="sourcesPure\TypeConcretization.cs" />
<EmbeddedResource Include="sourcesPure\CrossAssemblyTypes.cs" />
<EmbeddedResource Include="sourcesPure\GenericEdgeCases.cs" />
<EmbeddedResource Include="sourcesPure\Sizeof.cs" />
</ItemGroup>
<ItemGroup>
<EmbeddedResource Include="sourcesImpure\WriteLine.cs" />

118
WoofWare.PawPrint.Test/sourcesPure/Sizeof.cs Normal file
View File

@@ -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;
}
}

67
WoofWare.PawPrint/BasicCliType.fs
View File

@@ -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
[<RequireQualifiedAccess>]
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 =
[<RequireQualifiedAccess>]
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

33
WoofWare.PawPrint/EvalStack.fs
View File

@@ -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<int> high, byte<int> 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

2
WoofWare.PawPrint/ExternImplementations/System.Threading.Monitor.fs
View File

@@ -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"

27
WoofWare.PawPrint/IlMachineState.fs
View File

@@ -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<T>)
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

8
WoofWare.PawPrint/IlMachineStateExecution.fs
View File

@@ -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

14
WoofWare.PawPrint/Intrinsics.fs
View File

@@ -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

4
WoofWare.PawPrint/Program.fs
View File

@@ -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

295
WoofWare.PawPrint/UnaryMetadataIlOp.fs
View File

@@ -7,6 +7,100 @@ open Microsoft.Extensions.Logging
[<RequireQualifiedAccess>]
module internal UnaryMetadataIlOp =
let lookupTypeDefn
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(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<DumpedAssembly>)
(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<DumpedAssembly>)
@@ -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<TypeDefn, WoofWare.PawPrint.GenericParameter, TypeDefn>), 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"

2
WoofWare.PawPrint/UnaryStringTokenIlOp.fs
View File

@@ -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)
]