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

Plumb through field offset info (#112)

Browse Source
This commit is contained in:
Patrick Stevens
2025-08-24 10:05:31 +01:00
committed by GitHub
parent 5f35c7a7cd
commit 3e4b0a7b7e
22 changed files with 1381 additions and 212 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
WoofWare.PawPrint.Domain/FieldInfo.fs
View File

@@ -32,9 +32,14 @@ type FieldInfo<'typeGeneric, 'fieldGeneric> =
/// literal, and other characteristics.
/// </summary>
Attributes : FieldAttributes
/// Static fields don't have an offset at all; also, instance fields which don't have an explicit offset (but
/// which of course do have one implicitly, which is most fields) are None here.
Offset : int option
}
member this.HasFieldRVA = this.Attributes.HasFlag FieldAttributes.HasFieldRVA
member this.IsStatic = this.Attributes.HasFlag FieldAttributes.Static
override this.ToString () : string =
$"%s{this.DeclaringType.Assembly.Name}.{this.DeclaringType.Name}.%s{this.Name}"
@@ -63,12 +68,18 @@ module FieldInfo =
let declaringType =
ConcreteType.make assembly declaringType declaringTypeNamespace declaringTypeName typeGenerics
let offset =
match def.GetOffset () with
| -1 -> None
| s -> Some s
{
Name = name
Signature = fieldSig
DeclaringType = declaringType
Handle = handle
Attributes = def.Attributes
Offset = offset
}
let mapTypeGenerics<'a, 'b, 'field> (f : int -> 'a -> 'b) (input : FieldInfo<'a, 'field>) : FieldInfo<'b, 'field> =
@@ -80,5 +91,5 @@ module FieldInfo =
DeclaringType = declaringType
Signature = input.Signature
Attributes = input.Attributes
Offset = input.Offset
}

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

@@ -56,6 +56,16 @@ module TestPureCases =
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "AdvancedStructLayout.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "OverlappingStructs.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
]
let cases : EndToEndTestCase list =

480
WoofWare.PawPrint.Test/sourcesPure/AdvancedStructLayout.cs Normal file
View File

@@ -0,0 +1,480 @@
using System;
using System.Runtime.InteropServices;
using System.Runtime.CompilerServices;
public class StructLayoutTestsAdvanced
{
// Test structs
[StructLayout(LayoutKind.Sequential)]
struct PointerTestStruct
{
public int A;
public byte B;
public short C;
public int D;
}
[StructLayout(LayoutKind.Sequential)]
unsafe struct FixedBufferStruct
{
public int Header;
public fixed byte Buffer[64];
public int Footer;
}
[StructLayout(LayoutKind.Sequential)]
unsafe struct NestedFixedStruct
{
public fixed int IntArray[4];
public fixed double DoubleArray[2];
}
[StructLayout(LayoutKind.Sequential, CharSet = CharSet.Ansi)]
struct MarshalStringStruct
{
public int Id;
[MarshalAs(UnmanagedType.ByValTStr, SizeConst = 32)]
public string Name;
public double Value;
}
[StructLayout(LayoutKind.Sequential)]
struct MarshalArrayStruct
{
public int Count;
[MarshalAs(UnmanagedType.ByValArray, SizeConst = 8)]
public int[] Values;
}
[StructLayout(LayoutKind.Sequential)]
struct BlittableStruct
{
public int X;
public double Y;
public long Z;
}
ref struct RefStruct
{
public int Value;
public Span<int> Span;
public RefStruct(int value)
{
Value = value;
Span = new Span<int>(new int[] { value, value * 2, value * 3 });
}
}
readonly struct ReadOnlyStruct
{
public readonly int X;
public readonly int Y;
public ReadOnlyStruct(int x, int y)
{
X = x;
Y = y;
}
public int Sum => X + Y;
}
readonly ref struct ReadOnlyRefStruct
{
public readonly int Value;
public readonly ReadOnlySpan<byte> Data;
public ReadOnlyRefStruct(int value, ReadOnlySpan<byte> data)
{
Value = value;
Data = data;
}
}
struct Generic<T> where T : struct
{
public T Value;
public int Index;
public Generic(T value, int index)
{
Value = value;
Index = index;
}
}
struct DoubleGeneric<T, U>
{
public T First;
public U Second;
}
interface IIndexable
{
int GetIndex();
void SetIndex(int value);
}
struct StructWithInterface : IIndexable
{
public int Index;
public string Data;
public int GetIndex() => Index;
public void SetIndex(int value) => Index = value;
}
interface IMutable
{
void Mutate();
}
struct MutableStruct : IMutable
{
public int Counter;
public void Mutate()
{
Counter++;
}
}
struct RefReturnStruct
{
public int A;
public int B;
public int C;
public static ref int GetRef(ref RefReturnStruct s, int index)
{
if (index == 0) return ref s.A;
if (index == 1) return ref s.B;
return ref s.C;
}
}
static unsafe int TestUnsafePointers()
{
var s = new PointerTestStruct { A = 0x12345678, B = 0xAB, C = 0x1234, D = unchecked((int)0xDEADBEEF) };
// Test sizeof
int size = sizeof(PointerTestStruct);
if (size == 0) return 1;
// Test pointer access
PointerTestStruct* ptr = &s;
if (ptr->A != 0x12345678) return 2;
if (ptr->B != 0xAB) return 3;
if (ptr->C != 0x1234) return 4;
if (ptr->D != unchecked((int)0xDEADBEEF)) return 5;
// Test pointer arithmetic and casting
byte* bytePtr = (byte*)ptr;
int* intPtr = (int*)bytePtr;
if (*intPtr != 0x12345678) return 6; // First int field
// Verify field offsets
int* dPtr = &(ptr->D);
int* aPtr = &(ptr->A);
long ptrDiff = (byte*)dPtr - (byte*)aPtr;
if (ptrDiff < 8) return 7; // D should be at least 8 bytes from A
// Test modification through pointer
ptr->A = 999;
if (s.A != 999) return 8;
return 0;
}
static unsafe int TestFixedBuffers()
{
var f = new FixedBufferStruct();
f.Header = 0xFEED;
f.Footer = 0xBEEF;
// Test fixed buffer access
for (int i = 0; i < 64; i++)
{
f.Buffer[i] = (byte)(i % 256);
}
if (f.Header != 0xFEED) return 10;
if (f.Footer != 0xBEEF) return 11;
// Verify buffer contents
for (int i = 0; i < 64; i++)
{
if (f.Buffer[i] != (byte)(i % 256)) return 12;
}
// Test pointer to fixed buffer
byte* bufPtr = f.Buffer;
bufPtr[0] = 255;
if (f.Buffer[0] != 255) return 13;
// Test nested fixed arrays
var n = new NestedFixedStruct();
n.IntArray[0] = 100;
n.IntArray[3] = 400;
n.DoubleArray[0] = 1.5;
n.DoubleArray[1] = 2.5;
if (n.IntArray[0] != 100) return 14;
if (n.IntArray[3] != 400) return 15;
if (Math.Abs(n.DoubleArray[0] - 1.5) > 0.0001) return 16;
if (Math.Abs(n.DoubleArray[1] - 2.5) > 0.0001) return 17;
return 0;
}
static unsafe int TestMarshaling()
{
// Test string marshaling
var ms = new MarshalStringStruct
{
Id = 42,
Name = "TestString",
Value = 3.14159
};
if (ms.Id != 42) return 20;
if (ms.Name != "TestString") return 21;
if (Math.Abs(ms.Value - 3.14159) > 0.00001) return 22;
// Test Marshal.SizeOf
int marshalSize = Marshal.SizeOf(typeof(MarshalStringStruct));
if (marshalSize == 0) return 23;
// Test array marshaling
var ma = new MarshalArrayStruct
{
Count = 5,
Values = new int[] { 1, 2, 3, 4, 5, 6, 7, 8 }
};
if (ma.Count != 5) return 24;
if (ma.Values.Length != 8) return 25;
if (ma.Values[7] != 8) return 26;
// Test StructureToPtr and PtrToStructure
var blittable = new BlittableStruct { X = 100, Y = 200.5, Z = 300 };
IntPtr ptr = Marshal.AllocHGlobal(Marshal.SizeOf(typeof(BlittableStruct)));
try
{
Marshal.StructureToPtr(blittable, ptr, false);
var recovered = (BlittableStruct)Marshal.PtrToStructure(ptr, typeof(BlittableStruct));
if (recovered.X != 100) return 27;
if (Math.Abs(recovered.Y - 200.5) > 0.00001) return 28;
if (recovered.Z != 300) return 29;
}
finally
{
Marshal.FreeHGlobal(ptr);
}
return 0;
}
static int TestRefStructs()
{
// Test ref struct
var rs = new RefStruct(10);
if (rs.Value != 10) return 30;
if (rs.Span.Length != 3) return 31;
if (rs.Span[0] != 10) return 32;
if (rs.Span[1] != 20) return 33;
if (rs.Span[2] != 30) return 34;
// Modify through span
rs.Span[0] = 100;
if (rs.Span[0] != 100) return 35;
// Test readonly struct
var ros = new ReadOnlyStruct(5, 7);
if (ros.X != 5) return 36;
if (ros.Y != 7) return 37;
if (ros.Sum != 12) return 38;
// Verify immutability - create new instance
var ros2 = new ReadOnlyStruct(10, 20);
if (ros.X != 5) return 39; // Original should be unchanged
// Test readonly ref struct
byte[] data = { 1, 2, 3, 4 };
var rors = new ReadOnlyRefStruct(42, new ReadOnlySpan<byte>(data));
if (rors.Value != 42) return 40;
if (rors.Data.Length != 4) return 41;
if (rors.Data[3] != 4) return 42;
return 0;
}
static int TestGenerics()
{
// Test single generic parameter
var g1 = new Generic<int>(42, 1);
if (g1.Value != 42) return 50;
if (g1.Index != 1) return 51;
var g2 = new Generic<double>(3.14, 2);
if (Math.Abs(g2.Value - 3.14) > 0.00001) return 52;
if (g2.Index != 2) return 53;
// Test with custom struct
var inner = new ReadOnlyStruct(10, 20);
var g3 = new Generic<ReadOnlyStruct>(inner, 3);
if (g3.Value.X != 10) return 54;
if (g3.Value.Y != 20) return 55;
if (g3.Index != 3) return 56;
// Test double generic
var dg = new DoubleGeneric<int, string> { First = 100, Second = "test" };
if (dg.First != 100) return 57;
if (dg.Second != "test") return 58;
// Test with different type combinations
var dg2 = new DoubleGeneric<double, long> { First = 2.718, Second = long.MaxValue };
if (Math.Abs(dg2.First - 2.718) > 0.00001) return 59;
if (dg2.Second != long.MaxValue) return 60;
return 0;
}
static int TestByRefReturns()
{
var r = new RefReturnStruct { A = 10, B = 20, C = 30 };
// Test ref return
ref int refA = ref RefReturnStruct.GetRef(ref r, 0);
if (refA != 10) return 70;
// Modify through ref
refA = 100;
if (r.A != 100) return 71;
ref int refB = ref RefReturnStruct.GetRef(ref r, 1);
refB = 200;
if (r.B != 200) return 72;
ref int refC = ref RefReturnStruct.GetRef(ref r, 2);
refC = 300;
if (r.C != 300) return 73;
// Test ref local
ref int localRef = ref r.A;
localRef = 1000;
if (r.A != 1000) return 74;
// Test that ref points to actual field
localRef = 2000;
if (refA != 2000) return 75; // Both should see the change
return 0;
}
static int TestStructInterfaces()
{
// Test struct implementing interface
var s = new StructWithInterface { Index = 42, Data = "test" };
if (s.GetIndex() != 42) return 80;
s.SetIndex(100);
if (s.Index != 100) return 81;
// Test boxing to interface
IIndexable boxed = s; // Boxing occurs here
if (boxed.GetIndex() != 100) return 82;
// Modify through interface (modifies boxed copy)
boxed.SetIndex(200);
if (boxed.GetIndex() != 200) return 83;
if (s.Index != 100) return 84; // Original should be unchanged
// Test mutable interface
var m = new MutableStruct { Counter = 0 };
m.Mutate();
if (m.Counter != 1) return 85;
// Box to interface and mutate
IMutable boxedMutable = m; // Boxing
boxedMutable.Mutate();
if (m.Counter != 1) return 86; // Original unchanged
// Cast back to see boxed mutation
var unboxed = (MutableStruct)boxedMutable;
if (unboxed.Counter != 2) return 87;
// Direct interface call on boxed struct maintains state
boxedMutable.Mutate();
boxedMutable.Mutate();
var unboxed2 = (MutableStruct)boxedMutable;
if (unboxed2.Counter != 4) return 88;
return 0;
}
static unsafe int TestCombinedScenarios()
{
// Test generic with fixed buffer struct
var f = new FixedBufferStruct();
f.Header = 999;
f.Buffer[0] = 123;
f.Footer = 111;
var generic = new Generic<FixedBufferStruct>(f, 42);
if (generic.Value.Header != 999) return 90;
if (generic.Value.Buffer[0] != 123) return 91;
if (generic.Value.Footer != 111) return 92;
if (generic.Index != 42) return 93;
// Test marshaling with generic
var marshalable = new BlittableStruct { X = 10, Y = 20.0, Z = 30 };
var genericMarshal = new Generic<BlittableStruct>(marshalable, 5);
if (genericMarshal.Value.X != 10) return 94;
if (Math.Abs(genericMarshal.Value.Y - 20.0) > 0.00001) return 95;
if (genericMarshal.Value.Z != 30) return 96;
return 0;
}
public static int Main(string[] argv)
{
int result = 0;
unsafe
{
result = TestUnsafePointers();
if (result != 0) return result;
result = TestFixedBuffers();
if (result != 0) return result;
}
result = TestMarshaling();
if (result != 0) return result;
result = TestRefStructs();
if (result != 0) return result;
result = TestGenerics();
if (result != 0) return result;
result = TestByRefReturns();
if (result != 0) return result;
result = TestStructInterfaces();
if (result != 0) return result;
unsafe
{
result = TestCombinedScenarios();
if (result != 0) return result;
}
return 0; // All tests passed
}
}

364
WoofWare.PawPrint.Test/sourcesPure/OverlappingStructs.cs Normal file
View File

@@ -0,0 +1,364 @@
using System;
using System.Runtime.InteropServices;
public class StructLayoutTests
{
// Test structs with various layouts
[StructLayout(LayoutKind.Sequential)]
struct SequentialStruct
{
public int A;
public byte B;
public long C;
}
[StructLayout(LayoutKind.Explicit)]
struct ExplicitUnion
{
[FieldOffset(0)] public int AsInt;
[FieldOffset(0)] public float AsFloat;
[FieldOffset(0)] public byte Byte0;
[FieldOffset(1)] public byte Byte1;
[FieldOffset(2)] public byte Byte2;
[FieldOffset(3)] public byte Byte3;
}
[StructLayout(LayoutKind.Explicit, Size = 16)]
struct FixedSizeStruct
{
[FieldOffset(0)] public long First;
[FieldOffset(8)] public int Second;
[FieldOffset(12)] public short Third;
}
[StructLayout(LayoutKind.Sequential, Pack = 1)]
struct PackedStruct
{
public byte A;
public int B;
public byte C;
}
[StructLayout(LayoutKind.Auto)]
struct AutoLayoutStruct
{
public int X;
public string Y;
public double Z;
}
[StructLayout(LayoutKind.Explicit)]
struct NestedUnion
{
[FieldOffset(0)] public ExplicitUnion Inner;
[FieldOffset(0)] public long AsLong;
[FieldOffset(4)] public int UpperInt;
}
[StructLayout(LayoutKind.Explicit)]
struct LargeUnion
{
[FieldOffset(0)] public long Long1;
[FieldOffset(8)] public long Long2;
[FieldOffset(0)] public double Double1;
[FieldOffset(8)] public double Double2;
[FieldOffset(0)] public decimal AsDecimal;
}
// Static fields for testing
static SequentialStruct staticSequential;
static ExplicitUnion staticUnion;
static FixedSizeStruct staticFixed;
// Instance fields for testing
class FieldContainer
{
public SequentialStruct instanceSequential;
public ExplicitUnion instanceUnion;
public PackedStruct instancePacked;
public NestedUnion instanceNested;
}
static int TestSequentialLayout()
{
var s = new SequentialStruct { A = 42, B = 255, C = long.MaxValue };
// Test field access
if (s.A != 42) return 1;
if (s.B != 255) return 2;
if (s.C != long.MaxValue) return 3;
// Test copy semantics
var s2 = s;
s2.A = 100;
if (s.A != 42) return 4; // Should be unchanged (value type)
if (s2.A != 100) return 5;
// Test static field storage
staticSequential = s;
if (staticSequential.A != 42) return 6;
if (staticSequential.C != long.MaxValue) return 7;
return 0;
}
static int TestExplicitUnion()
{
var u = new ExplicitUnion();
// Test overlapping int/float
u.AsInt = 0x3F800000; // IEEE 754 representation of 1.0f
if (Math.Abs(u.AsFloat - 1.0f) > 0.0001f) return 10;
// Test byte-level access
u.AsInt = 0x12345678;
bool isLittleEndian = BitConverter.IsLittleEndian;
if (isLittleEndian)
{
if (u.Byte0 != 0x78) return 11;
if (u.Byte1 != 0x56) return 12;
if (u.Byte2 != 0x34) return 13;
if (u.Byte3 != 0x12) return 14;
}
else
{
if (u.Byte0 != 0x12) return 11;
if (u.Byte1 != 0x34) return 12;
if (u.Byte2 != 0x56) return 13;
if (u.Byte3 != 0x78) return 14;
}
// Test static field
staticUnion = u;
if (staticUnion.AsInt != 0x12345678) return 15;
return 0;
}
static int TestFixedSizeStruct()
{
var f = new FixedSizeStruct { First = -1, Second = 42, Third = 1000 };
if (f.First != -1) return 20;
if (f.Second != 42) return 21;
if (f.Third != 1000) return 22;
// Test size is respected
int size = Marshal.SizeOf(typeof(FixedSizeStruct));
if (size != 16) return 23;
staticFixed = f;
if (staticFixed.Second != 42) return 24;
return 0;
}
static int TestPackedStruct()
{
var p = new PackedStruct { A = 1, B = 0x12345678, C = 2 };
if (p.A != 1) return 30;
if (p.B != 0x12345678) return 31;
if (p.C != 2) return 32;
// Packed struct should be 6 bytes (1 + 4 + 1)
int size = Marshal.SizeOf(typeof(PackedStruct));
if (size != 6) return 33;
return 0;
}
static int TestInstanceFields()
{
var container = new FieldContainer();
container.instanceSequential = new SequentialStruct { A = 111, B = 222, C = 333 };
if (container.instanceSequential.A != 111) return 40;
container.instanceUnion = new ExplicitUnion { AsInt = unchecked((int)0xDEADBEEF) };
if (container.instanceUnion.AsInt != unchecked((int)0xDEADBEEF)) return 41;
container.instancePacked = new PackedStruct { A = 10, B = 20, C = 30 };
if (container.instancePacked.B != 20) return 42;
container.instanceNested = new NestedUnion();
container.instanceNested.Inner.AsInt = 100;
if (container.instanceNested.Inner.AsInt != 100) return 43;
return 0;
}
static int TestStructPassing()
{
var s = new SequentialStruct { A = 500, B = 50, C = 5000 };
int result = ProcessSequential(s);
if (result != 555) return 50; // 500 + 50 + 5 (C % 1000)
var u = new ExplicitUnion { AsInt = 1000 };
u = TransformUnion(u);
if (u.AsInt != 2000) return 51;
return 0;
}
static int ProcessSequential(SequentialStruct s)
{
return s.A + s.B + (int)(s.C % 1000);
}
static ExplicitUnion TransformUnion(ExplicitUnion u)
{
u.AsInt *= 2;
return u;
}
static int TestNestedUnion()
{
var n = new NestedUnion();
n.Inner.AsInt = 0x12345678;
// Lower 32 bits should match Inner.AsInt
if ((n.AsLong & 0xFFFFFFFF) != 0x12345678) return 60;
// Modify upper int
n.UpperInt = unchecked((int)0xABCDEF00);
// Check both parts
if (n.Inner.AsInt != 0x12345678) return 61;
if (n.UpperInt != unchecked((int)0xABCDEF00)) return 62;
return 0;
}
static int TestLargeUnion()
{
var l = new LargeUnion();
// Test double/long overlap
l.Double1 = 1.0;
l.Double2 = 2.0;
// IEEE 754: 1.0 = 0x3FF0000000000000
if (l.Long1 != 0x3FF0000000000000) return 70;
// IEEE 754: 2.0 = 0x4000000000000000
if (l.Long2 != 0x4000000000000000) return 71;
// Test decimal overlap (decimal is 128 bits)
l.AsDecimal = 42m;
// Just verify it doesn't crash and maintains some structure
if (l.AsDecimal != 42m) return 72;
return 0;
}
static int TestAutoLayout()
{
// Auto layout structs can't use FieldOffset, but we can still test basic functionality
var a = new AutoLayoutStruct { X = 100, Y = "test", Z = 3.14159 };
if (a.X != 100) return 80;
if (a.Y != "test") return 81;
if (Math.Abs(a.Z - 3.14159) > 0.00001) return 82;
// Test copy
var a2 = a;
a2.X = 200;
if (a.X != 100) return 83; // Original should be unchanged
if (a2.X != 200) return 84;
return 0;
}
static int TestStructArray()
{
var arr = new ExplicitUnion[3];
arr[0].AsInt = 10;
arr[1].AsInt = 20;
arr[2].AsInt = 30;
if (arr[0].AsInt != 10) return 90;
if (arr[1].AsInt != 20) return 91;
if (arr[2].AsInt != 30) return 92;
// Modify through float view
arr[1].AsFloat = 2.5f;
if (Math.Abs(arr[1].AsFloat - 2.5f) > 0.0001f) return 93;
return 0;
}
static int TestBoxingUnboxing()
{
ExplicitUnion u = new ExplicitUnion { AsInt = 999 };
object boxed = u; // Box
ExplicitUnion unboxed = (ExplicitUnion)boxed; // Unbox
if (unboxed.AsInt != 999) return 100;
// Modify original, boxed should remain unchanged
u.AsInt = 111;
ExplicitUnion fromBoxed = (ExplicitUnion)boxed;
if (fromBoxed.AsInt != 999) return 101; // Should still be 999
return 0;
}
static int TestDefaultValues()
{
// Test that default struct initialization zeroes memory
var s = new SequentialStruct();
if (s.A != 0) return 110;
if (s.B != 0) return 111;
if (s.C != 0) return 112;
var u = new ExplicitUnion();
if (u.AsInt != 0) return 113;
if (u.AsFloat != 0.0f) return 114;
return 0;
}
public static int Main(string[] argv)
{
int result = 0;
result = TestSequentialLayout();
if (result != 0) return result;
result = TestExplicitUnion();
if (result != 0) return result;
result = TestFixedSizeStruct();
if (result != 0) return result;
result = TestPackedStruct();
if (result != 0) return result;
result = TestInstanceFields();
if (result != 0) return result;
result = TestStructPassing();
if (result != 0) return result;
result = TestNestedUnion();
if (result != 0) return result;
result = TestLargeUnion();
if (result != 0) return result;
result = TestAutoLayout();
if (result != 0) return result;
result = TestStructArray();
if (result != 0) return result;
result = TestBoxingUnboxing();
if (result != 0) return result;
result = TestDefaultValues();
if (result != 0) return result;
return 0; // All tests passed
}
}

6
WoofWare.PawPrint/AbstractMachine.fs
View File

@@ -1,6 +1,5 @@
namespace WoofWare.PawPrint
open System.Collections.Immutable
open Microsoft.Extensions.Logging
open Microsoft.FSharp.Core
open WoofWare.PawPrint.ExternImplementations
@@ -55,18 +54,19 @@ module AbstractMachine =
// We've been instructed to run a delegate.
let delegateToRunAddr =
match instruction.Arguments.[0] with
| CliType.RuntimePointer (CliRuntimePointer.Managed (CliRuntimePointerSource.Heap addr))
| CliType.ObjectRef (Some addr) -> addr
| _ -> failwith "expected a managed object ref to delegate"
let delegateToRun = state.ManagedHeap.NonArrayObjects.[delegateToRunAddr]
let target =
match delegateToRun.Fields.["_target"] with
match delegateToRun |> AllocatedNonArrayObject.DereferenceField "_target" with
| CliType.ObjectRef addr -> addr
| x -> failwith $"TODO: delegate target wasn't an object ref: %O{x}"
let methodPtr =
match delegateToRun.Fields.["_methodPtr"] with
match delegateToRun |> AllocatedNonArrayObject.DereferenceField "_methodPtr" with
| CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.FunctionPointer mi)) -> mi
| d -> failwith $"unexpectedly not a method pointer in delegate invocation: {d}"

106
WoofWare.PawPrint/BasicCliType.fs
View File

@@ -121,6 +121,18 @@ type CliRuntimePointerSource =
| ArrayIndex of arr : ManagedHeapAddress * index : int
| Null
[<RequireQualifiedAccess>]
module CliRuntimePointerSource =
let rec ofManagedPointerSource (ptrSource : ManagedPointerSource) : CliRuntimePointerSource =
match ptrSource with
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
CliRuntimePointerSource.LocalVariable (sourceThread, methodFrame, whichVar)
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
CliRuntimePointerSource.Argument (sourceThread, methodFrame, whichVar)
| ManagedPointerSource.Heap managedHeapAddress -> CliRuntimePointerSource.Heap managedHeapAddress
| ManagedPointerSource.Null -> CliRuntimePointerSource.Null
| ManagedPointerSource.ArrayIndex (arr, ind) -> CliRuntimePointerSource.ArrayIndex (arr, ind)
type CliRuntimePointer =
| Unmanaged of int64
| Managed of CliRuntimePointerSource
@@ -141,11 +153,28 @@ type CliType =
/// as a concatenated list of its fields.
| ValueType of CliValueType
and CliField =
{
Name : string
Contents : CliType
/// "None" for "no explicit offset specified"; we expect most offsets to be None.
Offset : int option
}
and CliValueType =
{
Fields : (string * CliType) list
Fields : CliField list
}
static member OfFields (f : CliField list) =
{
Fields = f
}
static member DereferenceField (name : string) (f : CliValueType) : CliType =
// TODO: this is wrong, it doesn't account for overlapping fields
f.Fields |> List.find (fun f -> f.Name = name) |> _.Contents
type CliTypeResolutionResult =
| Resolved of CliType
| FirstLoad of WoofWare.PawPrint.AssemblyReference
@@ -181,8 +210,10 @@ module CliType =
| 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)"
| [ field ] -> sizeOf field.Contents
| fields ->
// TODO: consider struct layout (there's an `Explicit` test that will exercise that)
fields |> List.map (_.Contents >> sizeOf) |> List.sum
let zeroOfPrimitive (primitiveType : PrimitiveType) : CliType =
match primitiveType with
@@ -204,8 +235,24 @@ module CliType =
| PrimitiveType.Double -> CliType.Numeric (CliNumericType.Float64 0.0)
| PrimitiveType.String -> CliType.ObjectRef None
| PrimitiveType.TypedReference -> failwith "todo"
| PrimitiveType.IntPtr -> CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null)
| PrimitiveType.UIntPtr -> CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null)
| PrimitiveType.IntPtr ->
{
Name = "_value"
Contents = CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null)
Offset = Some 0
}
|> List.singleton
|> CliValueType.OfFields
|> CliType.ValueType
| PrimitiveType.UIntPtr ->
{
Name = "_value"
Contents = CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null)
Offset = Some 0
}
|> List.singleton
|> CliValueType.OfFields
|> CliType.ValueType
| PrimitiveType.Object -> CliType.ObjectRef None
let rec zeroOf
@@ -343,7 +390,7 @@ module CliType =
// It's a value type - need to create zero values for all non-static fields
let mutable currentConcreteTypes = concreteTypes
let fieldZeros =
let vt =
typeDef.Fields
|> List.filter (fun field -> not (field.Attributes.HasFlag FieldAttributes.Static))
|> List.map (fun field ->
@@ -359,13 +406,14 @@ module CliType =
zeroOfWithVisited currentConcreteTypes assemblies corelib fieldHandle visited
currentConcreteTypes <- updatedConcreteTypes2
(field.Name, fieldZero)
)
let vt =
{
Fields = fieldZeros
}
{
Name = field.Name
Contents = fieldZero
Offset = field.Offset
}
)
|> CliValueType.OfFields
CliType.ValueType vt, currentConcreteTypes
else
@@ -418,3 +466,37 @@ module CliType =
fieldType
handle, newCtx.ConcreteTypes
let withFieldSet (field : string) (value : CliType) (c : CliType) : CliType =
match c with
| CliType.Numeric cliNumericType -> failwith "todo"
| CliType.Bool b -> failwith "todo"
| CliType.Char (high, low) -> failwith "todo"
| CliType.ObjectRef managedHeapAddressOption -> failwith "todo"
| CliType.RuntimePointer cliRuntimePointer -> failwith "todo"
| CliType.ValueType cvt ->
{
Fields =
cvt.Fields
|> List.replaceWhere (fun f ->
if f.Name = field then
{ f with
Contents = value
}
|> Some
else
None
)
}
|> CliType.ValueType
let getField (field : string) (value : CliType) : CliType =
match value with
| CliType.Numeric cliNumericType -> failwith "todo"
| CliType.Bool b -> failwith "todo"
| CliType.Char (high, low) -> failwith "todo"
| CliType.ObjectRef managedHeapAddressOption -> failwith "todo"
| CliType.RuntimePointer cliRuntimePointer -> failwith "todo"
| CliType.ValueType cvt ->
cvt.Fields
|> List.pick (fun f -> if f.Name = field then Some f.Contents else None)

10
WoofWare.PawPrint/Constants.fs Normal file
View File

@@ -0,0 +1,10 @@
namespace WoofWare.PawPrint
[<AutoOpen>]
module Constants =
[<Literal>]
let SIZEOF_INT = 4
[<Literal>]
let SIZEOF_OBJ = 8

158
WoofWare.PawPrint/EvalStack.fs
View File

@@ -10,8 +10,7 @@ type EvalStackValue =
| ObjectRef of ManagedHeapAddress
// Fraser thinks this isn't really a thing in CoreCLR
// | TransientPointer of TransientPointerSource
/// Mapping of field name to value
| UserDefinedValueType of (string * EvalStackValue) list
| UserDefinedValueType of EvalStackValueUserType
override this.ToString () =
match this with
@@ -23,12 +22,39 @@ type EvalStackValue =
| EvalStackValue.ObjectRef managedHeapAddress -> $"ObjectRef(%O{managedHeapAddress})"
| EvalStackValue.UserDefinedValueType evalStackValues ->
let desc =
evalStackValues
|> List.map (snd >> string<EvalStackValue>)
evalStackValues.Fields
|> List.map (_.ContentsEval >> string<EvalStackValue>)
|> String.concat " | "
$"Struct(%s{desc})"
and EvalStackValueField =
{
Name : string
ContentsEval : EvalStackValue
Offset : int option
}
and EvalStackValueUserType =
{
Fields : EvalStackValueField list
}
static member DereferenceField (name : string) (this : EvalStackValueUserType) =
// TODO: this doesn't account for overlapping fields
this.Fields
|> List.pick (fun stackField ->
if stackField.Name = name then
Some stackField.ContentsEval
else
None
)
static member OfFields (fields : EvalStackValueField list) =
{
Fields = fields
}
[<RequireQualifiedAccess>]
module EvalStackValue =
/// The conversion performed by Conv_u.
@@ -107,7 +133,11 @@ module EvalStackValue =
| CliNumericType.Int32 _ ->
match popped with
| EvalStackValue.Int32 i -> CliType.Numeric (CliNumericType.Int32 i)
| EvalStackValue.UserDefinedValueType [ popped ] -> toCliTypeCoerced target (snd popped)
| EvalStackValue.UserDefinedValueType popped ->
match popped.Fields with
| [] -> failwith "unexpectedly empty"
| [ popped ] -> toCliTypeCoerced target popped.ContentsEval
| _ -> failwith $"TODO: %O{target}"
| i -> failwith $"TODO: %O{i}"
| CliNumericType.Int64 _ ->
match popped with
@@ -123,11 +153,16 @@ module EvalStackValue =
| i -> failwith $"TODO: %O{i}"
| CliNumericType.NativeInt _ ->
match popped with
| EvalStackValue.NativeInt s -> CliNumericType.NativeInt s
| EvalStackValue.NativeInt s -> CliNumericType.NativeInt s |> CliType.Numeric
| EvalStackValue.ManagedPointer ptrSrc ->
CliNumericType.NativeInt (NativeIntSource.ManagedPointer ptrSrc)
|> CliType.Numeric
| EvalStackValue.UserDefinedValueType vt ->
match vt.Fields with
| [] -> failwith "unexpected"
| [ vt ] -> toCliTypeCoerced target vt.ContentsEval
| _ -> failwith $"TODO: {popped}"
| _ -> failwith $"TODO: {popped}"
|> CliType.Numeric
| CliNumericType.NativeFloat f -> failwith "todo"
| CliNumericType.Int8 _ ->
match popped with
@@ -156,19 +191,13 @@ module EvalStackValue =
| CliType.ObjectRef _ ->
match popped with
| EvalStackValue.ManagedPointer ptrSource ->
match ptrSource with
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
CliRuntimePointerSource.LocalVariable (sourceThread, methodFrame, whichVar)
|> CliRuntimePointer.Managed
|> CliType.RuntimePointer
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
CliRuntimePointerSource.Argument (sourceThread, methodFrame, whichVar)
|> CliRuntimePointer.Managed
|> CliType.RuntimePointer
| ManagedPointerSource.Heap managedHeapAddress -> CliType.ObjectRef (Some managedHeapAddress)
| ManagedPointerSource.Null -> CliType.ObjectRef None
| ManagedPointerSource.ArrayIndex (arr, ind) ->
CliType.RuntimePointer (CliRuntimePointer.Managed (CliRuntimePointerSource.ArrayIndex (arr, ind)))
CliRuntimePointerSource.ofManagedPointerSource ptrSource
|> CliRuntimePointer.Managed
|> CliType.RuntimePointer
| EvalStackValue.ObjectRef ptr ->
CliRuntimePointerSource.Heap ptr
|> CliRuntimePointer.Managed
|> CliType.RuntimePointer
| EvalStackValue.NativeInt nativeIntSource ->
match nativeIntSource with
| NativeIntSource.Verbatim 0L -> CliType.ObjectRef None
@@ -180,9 +209,9 @@ module EvalStackValue =
| ManagedPointerSource.Null -> CliType.ObjectRef None
| ManagedPointerSource.Heap s -> CliType.ObjectRef (Some s)
| _ -> failwith "TODO"
| EvalStackValue.UserDefinedValueType fields ->
match fields with
| [ esv ] -> toCliTypeCoerced target (snd esv)
| EvalStackValue.UserDefinedValueType obj ->
match obj.Fields with
| [ esv ] -> toCliTypeCoerced target esv.ContentsEval
| fields -> failwith $"TODO: don't know how to coerce struct of {fields} to a pointer"
| _ -> failwith $"TODO: {popped}"
| CliType.Bool _ ->
@@ -196,40 +225,23 @@ module EvalStackValue =
| CliType.RuntimePointer _ ->
match popped with
| EvalStackValue.ManagedPointer src ->
match src with
| ManagedPointerSource.Heap addr -> CliType.ofManagedObject addr
| ManagedPointerSource.Null -> CliType.ObjectRef None
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, var) ->
CliRuntimePointerSource.LocalVariable (sourceThread, methodFrame, var)
|> CliRuntimePointer.Managed
|> CliType.RuntimePointer
| ManagedPointerSource.Argument (sourceThread, methodFrame, var) ->
CliRuntimePointerSource.Argument (sourceThread, methodFrame, var)
|> CliRuntimePointer.Managed
|> CliType.RuntimePointer
| ManagedPointerSource.ArrayIndex (arr, index) ->
CliRuntimePointerSource.ArrayIndex (arr, index)
|> CliRuntimePointer.Managed
|> CliType.RuntimePointer
CliRuntimePointerSource.ofManagedPointerSource src
|> CliRuntimePointer.Managed
|> CliType.RuntimePointer
| EvalStackValue.NativeInt intSrc ->
match intSrc with
| NativeIntSource.Verbatim i -> CliType.RuntimePointer (CliRuntimePointer.Unmanaged i)
| NativeIntSource.ManagedPointer src ->
match src with
| ManagedPointerSource.Heap src ->
CliType.RuntimePointer (CliRuntimePointer.Managed (CliRuntimePointerSource.Heap src))
| ManagedPointerSource.Null ->
CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null)
| ManagedPointerSource.LocalVariable (a, b, c) ->
CliType.RuntimePointer (
CliRuntimePointer.Managed (CliRuntimePointerSource.LocalVariable (a, b, c))
)
| ManagedPointerSource.Argument (a, b, c) ->
CliType.RuntimePointer (CliRuntimePointer.Managed (CliRuntimePointerSource.Argument (a, b, c)))
| ManagedPointerSource.ArrayIndex _ -> failwith "TODO"
CliRuntimePointerSource.ofManagedPointerSource src
|> CliRuntimePointer.Managed
|> CliType.RuntimePointer
| NativeIntSource.FunctionPointer methodInfo ->
CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.FunctionPointer methodInfo))
| NativeIntSource.TypeHandlePtr int64 -> failwith "todo"
| EvalStackValue.ObjectRef addr ->
CliRuntimePointerSource.Heap addr
|> CliRuntimePointer.Managed
|> CliType.RuntimePointer
| _ -> failwith $"TODO: %O{popped}"
| CliType.Char _ ->
match popped with
@@ -241,28 +253,32 @@ module EvalStackValue =
| CliType.ValueType vt ->
match popped with
| EvalStackValue.UserDefinedValueType popped ->
if vt.Fields.Length <> popped.Length then
if vt.Fields.Length <> popped.Fields.Length then
// TODO: overlapping fields
failwith
$"mismatch: popped value type {popped} (length %i{popped.Length}) into {vt} (length %i{vt.Fields.Length})"
$"mismatch: popped value type {popped} (length %i{popped.Fields.Length}) into {vt} (length %i{vt.Fields.Length})"
let fields =
List.map2
(fun (name1, v1) (name2, v2) ->
if name1 <> name2 then
failwith $"TODO: name mismatch, {name1} vs {name2}"
(vt.Fields, popped.Fields)
||> List.map2 (fun field1 popped ->
if field1.Name <> popped.Name then
failwith $"TODO: name mismatch, {field1.Name} vs {popped.Name}"
name1, toCliTypeCoerced v1 v2
)
vt.Fields
popped
if field1.Offset <> popped.Offset then
failwith $"TODO: offset mismatch for {field1.Name}, {field1.Offset} vs {popped.Offset}"
{
Fields = fields
}
let contents = toCliTypeCoerced field1.Contents popped.ContentsEval
{
CliField.Name = field1.Name
Contents = contents
Offset = field1.Offset
}
)
|> CliValueType.OfFields
|> CliType.ValueType
| popped ->
match vt.Fields with
| [ _, target ] -> toCliTypeCoerced target popped
| [ field ] -> toCliTypeCoerced field.Contents popped
| _ -> failwith $"TODO: {popped} into value type {target}"
let rec ofCliType (v : CliType) : EvalStackValue =
@@ -304,8 +320,18 @@ module EvalStackValue =
| CliRuntimePointerSource.Heap addr -> EvalStackValue.ObjectRef addr
| CliRuntimePointerSource.Null -> EvalStackValue.ManagedPointer ManagedPointerSource.Null
| CliType.ValueType fields ->
// TODO: this is a bit dubious; we're being a bit sloppy with possibly-overlapping fields here
fields.Fields
|> List.map (fun (name, f) -> name, ofCliType f)
|> List.map (fun field ->
let contents = ofCliType field.Contents
{
Name = field.Name
Offset = field.Offset
ContentsEval = contents
}
)
|> EvalStackValueUserType.OfFields
|> EvalStackValue.UserDefinedValueType
type EvalStack =

29
WoofWare.PawPrint/EvalStackValueComparisons.fs
View File

@@ -123,11 +123,24 @@ module EvalStackValueComparisons =
let rec ceq (var1 : EvalStackValue) (var2 : EvalStackValue) : bool =
// Table III.4
match var1, var2 with
| EvalStackValue.UserDefinedValueType [ _, u ], v -> ceq u v
| u, EvalStackValue.UserDefinedValueType [ _, v ] -> ceq u v
| EvalStackValue.UserDefinedValueType [], EvalStackValue.UserDefinedValueType [] -> true
| EvalStackValue.UserDefinedValueType {
Fields = [ f ]
},
v -> ceq f.ContentsEval v
| u,
EvalStackValue.UserDefinedValueType {
Fields = [ f ]
} -> ceq u f.ContentsEval
| EvalStackValue.UserDefinedValueType {
Fields = []
},
EvalStackValue.UserDefinedValueType {
Fields = []
} ->
// hmm, surely this can't happen, but :shrug:
true
| EvalStackValue.UserDefinedValueType _, _
| _, EvalStackValue.UserDefinedValueType _ -> failwith $"bad ceq: {var1} vs {var2}"
| _, EvalStackValue.UserDefinedValueType _ -> failwith $"TODO: ceq {var1} vs {var2}"
| EvalStackValue.Int32 var1, EvalStackValue.Int32 var2 -> var1 = var2
| EvalStackValue.Int32 var1, EvalStackValue.NativeInt var2 -> failwith "TODO: int32 CEQ nativeint"
| EvalStackValue.Int32 _, _ -> failwith $"bad ceq: Int32 vs {var2}"
@@ -151,6 +164,14 @@ module EvalStackValueComparisons =
failwith $"TODO (CEQ): nativeint vs managed pointer"
| EvalStackValue.NativeInt _, _ -> failwith $"bad ceq: NativeInt vs {var2}"
| EvalStackValue.ObjectRef var1, EvalStackValue.ObjectRef var2 -> var1 = var2
| EvalStackValue.ManagedPointer src, EvalStackValue.ObjectRef var1
| EvalStackValue.ObjectRef var1, EvalStackValue.ManagedPointer src ->
match src with
| ManagedPointerSource.Heap src -> src = var1
| ManagedPointerSource.Null -> false
| ManagedPointerSource.LocalVariable _
| ManagedPointerSource.Argument _ -> false
| ManagedPointerSource.ArrayIndex (arr, index) -> failwith "todo"
| EvalStackValue.ObjectRef _, _ -> failwith $"bad ceq: ObjectRef vs {var2}"
| EvalStackValue.ManagedPointer var1, EvalStackValue.ManagedPointer var2 -> var1 = var2
| EvalStackValue.ManagedPointer var1, EvalStackValue.NativeInt var2 ->

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

@@ -62,6 +62,7 @@ module System_Threading_Monitor =
match lockObj with
| EvalStackValue.ManagedPointer ManagedPointerSource.Null ->
failwith "TODO: throw ArgumentNullException"
| EvalStackValue.ObjectRef addr
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) ->
match IlMachineState.getSyncBlock addr state with
| SyncBlock.Free ->
@@ -100,6 +101,7 @@ module System_Threading_Monitor =
match lockObj with
| EvalStackValue.ManagedPointer ManagedPointerSource.Null ->
failwith "TODO: throw ArgumentNullException"
| EvalStackValue.ObjectRef addr
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) ->
match IlMachineState.getSyncBlock addr state with
| SyncBlock.Free -> failwith "TODO: throw SynchronizationLockException"

53
WoofWare.PawPrint/FieldHandleRegistry.fs
View File

@@ -34,7 +34,7 @@ module FieldHandleRegistry =
let getOrAllocate
(baseClassTypes : BaseClassTypes<'corelib>)
(allocState : 'allocState)
(allocate : (string * CliType) list -> 'allocState -> ManagedHeapAddress * 'allocState)
(allocate : CliField list -> 'allocState -> ManagedHeapAddress * 'allocState)
(declaringAssy : AssemblyName)
(declaringType : ConcreteTypeHandle)
(handle : FieldDefinitionHandle)
@@ -54,8 +54,12 @@ module FieldHandleRegistry =
failwith $"unexpected field name %s{field.Name} for BCL type RuntimeFieldHandle"
{
Fields = [ "m_ptr", CliType.ofManagedObject runtimeFieldInfoStub ]
Name = "m_ptr"
Contents = CliType.ofManagedObject runtimeFieldInfoStub
Offset = None
}
|> List.singleton
|> CliValueType.OfFields
|> CliType.ValueType
let handle =
@@ -81,21 +85,52 @@ module FieldHandleRegistry =
| TypeDefn.PrimitiveType PrimitiveType.IntPtr -> ()
| s -> failwith $"bad sig: {s}"
// https://github.com/dotnet/runtime/blob/2b21c73fa2c32fa0195e4a411a435dda185efd08/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L1380
{
Fields = [ "m_handle", CliType.RuntimePointer (CliRuntimePointer.Unmanaged newHandle) ]
Name = "m_handle"
Contents = CliType.RuntimePointer (CliRuntimePointer.Unmanaged newHandle)
Offset = None // no struct layout was specified
}
|> List.singleton
|> CliValueType.OfFields
|> CliType.ValueType
// https://github.com/dotnet/runtime/blob/1d1bf92fcf43aa6981804dc53c5174445069c9e4/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L1074
let runtimeFieldInfoStub =
// LayoutKind.Sequential
[
// If we ever implement a GC, something should change here
"m_keepalive", CliType.ObjectRef None
"m_c", CliType.ObjectRef None
"m_d", CliType.ObjectRef None
"m_b", CliType.Numeric (CliNumericType.Int32 0)
"m_e", CliType.ObjectRef None
{
Name = "m_keepalive"
Contents = CliType.ObjectRef None
Offset = Some 0
}
{
Name = "m_c"
Contents = CliType.ObjectRef None
Offset = Some SIZEOF_OBJ
}
{
Name = "m_d"
Contents = CliType.ObjectRef None
Offset = Some (SIZEOF_OBJ * 2)
}
{
Name = "m_b"
Contents = CliType.Numeric (CliNumericType.Int32 0)
Offset = Some (SIZEOF_OBJ * 3)
}
{
Name = "m_e"
Contents = CliType.ObjectRef None
Offset = Some (SIZEOF_OBJ * 3 + SIZEOF_INT)
}
// RuntimeFieldHandleInternal: https://github.com/dotnet/runtime/blob/1d1bf92fcf43aa6981804dc53c5174445069c9e4/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L1048
"m_fieldHandle", runtimeFieldHandleInternal
{
Name = "m_fieldHandle"
Contents = runtimeFieldHandleInternal
Offset = Some (SIZEOF_OBJ * 4 + SIZEOF_INT)
}
]
let alloc, state = allocate runtimeFieldInfoStub allocState

57
WoofWare.PawPrint/IlMachineState.fs
View File

@@ -674,14 +674,14 @@ module IlMachineState =
(state : IlMachineState)
: IlMachineState
=
let heap = ManagedHeap.SetArrayValue arrayAllocation index v state.ManagedHeap
let heap = ManagedHeap.setArrayValue arrayAllocation index v state.ManagedHeap
{ state with
ManagedHeap = heap
}
let getArrayValue (arrayAllocation : ManagedHeapAddress) (index : int) (state : IlMachineState) : CliType =
ManagedHeap.GetArrayValue arrayAllocation index state.ManagedHeap
ManagedHeap.getArrayValue arrayAllocation index state.ManagedHeap
/// There might be no stack frame to return to, so you might get None.
let returnStackFrame
@@ -742,7 +742,7 @@ module IlMachineState =
| ResolvedBaseType.ValueType ->
let vt =
{
Fields = Map.toList constructed.Fields
CliValueType.Fields = constructed.Fields
}
state
@@ -1069,7 +1069,7 @@ module IlMachineState =
Logger = logger
NextThreadId = 0
// CallStack = []
ManagedHeap = ManagedHeap.Empty
ManagedHeap = ManagedHeap.empty
ThreadState = Map.empty
InternedStrings = ImmutableDictionary.Empty
_LoadedAssemblies = ImmutableDictionary.Empty
@@ -1115,7 +1115,7 @@ module IlMachineState =
Elements = initialisation
}
let alloc, heap = state.ManagedHeap |> ManagedHeap.AllocateArray o
let alloc, heap = state.ManagedHeap |> ManagedHeap.allocateArray o
let state =
{ state with
@@ -1125,7 +1125,7 @@ module IlMachineState =
alloc, state
let allocateStringData (len : int) (state : IlMachineState) : int * IlMachineState =
let addr, heap = state.ManagedHeap |> ManagedHeap.AllocateString len
let addr, heap = state.ManagedHeap |> ManagedHeap.allocateString len
let state =
{ state with
@@ -1135,7 +1135,7 @@ module IlMachineState =
addr, state
let setStringData (addr : int) (contents : string) (state : IlMachineState) : IlMachineState =
let heap = ManagedHeap.SetStringData addr contents state.ManagedHeap
let heap = ManagedHeap.setStringData addr contents state.ManagedHeap
{ state with
ManagedHeap = heap
@@ -1143,18 +1143,18 @@ module IlMachineState =
let allocateManagedObject
(ty : ConcreteTypeHandle)
(fields : (string * CliType) list)
(fields : CliField list)
(state : IlMachineState)
: ManagedHeapAddress * IlMachineState
=
let o =
{
Fields = Map.ofList fields
Fields = fields
ConcreteType = ty
SyncBlock = SyncBlock.Free
}
let alloc, heap = state.ManagedHeap |> ManagedHeap.AllocateNonArray o
let alloc, heap = state.ManagedHeap |> ManagedHeap.allocateNonArray o
let state =
{ state with
@@ -1429,11 +1429,11 @@ module IlMachineState =
: IlMachineState
=
{ state with
ManagedHeap = state.ManagedHeap |> ManagedHeap.SetSyncBlock addr syncBlockValue
ManagedHeap = state.ManagedHeap |> ManagedHeap.setSyncBlock addr syncBlockValue
}
let getSyncBlock (addr : ManagedHeapAddress) (state : IlMachineState) : SyncBlock =
state.ManagedHeap |> ManagedHeap.GetSyncBlock addr
state.ManagedHeap |> ManagedHeap.getSyncBlock addr
let executeDelegateConstructor (instruction : MethodState) (state : IlMachineState) : IlMachineState =
// We've been called with arguments already popped from the stack into local arguments.
@@ -1443,12 +1443,17 @@ module IlMachineState =
let targetObj =
match targetObj with
| CliType.ObjectRef target -> target
| CliType.RuntimePointer (CliRuntimePointer.Managed (CliRuntimePointerSource.Heap target))
| CliType.ObjectRef (Some target) -> Some target
| CliType.ObjectRef None
| CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null) -> None
| _ -> failwith $"Unexpected target type for delegate: {targetObj}"
let constructing =
match constructing with
| CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null)
| CliType.ObjectRef None -> failwith "unexpectedly constructing the null delegate"
| CliType.RuntimePointer (CliRuntimePointer.Managed (CliRuntimePointerSource.Heap target))
| CliType.ObjectRef (Some target) -> target
| _ -> failwith $"Unexpectedly not constructing a managed object: {constructing}"
@@ -1460,9 +1465,19 @@ module IlMachineState =
// Standard delegate fields in .NET are _target and _methodPtr
// Update the fields with the target object and method pointer
let updatedFields =
heapObj.Fields
|> Map.add "_target" (CliType.ObjectRef targetObj)
|> Map.add "_methodPtr" methodPtr
// Let's not consider field ordering for reference types like delegates.
// Nobody's going to be marshalling a reference type anyway, I hope.
{
Name = "_target"
Contents = CliType.ObjectRef targetObj
Offset = None
}
:: {
Name = "_methodPtr"
Contents = methodPtr
Offset = None
}
:: heapObj.Fields
let updatedObj =
{ heapObj with
@@ -1578,6 +1593,16 @@ module IlMachineState =
| false, _ -> None
| true, v -> Some v
let rec dereferencePointer (state : IlMachineState) (src : ManagedPointerSource) : CliType =
match src with
| ManagedPointerSource.Null -> failwith "TODO: throw NRE"
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
state.ThreadState.[sourceThread].MethodStates.[methodFrame].LocalVariables.[int<uint16> whichVar]
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
state.ThreadState.[sourceThread].MethodStates.[methodFrame].Arguments.[int<uint16> whichVar]
| ManagedPointerSource.Heap addr -> failwith "todo"
| ManagedPointerSource.ArrayIndex (arr, index) -> getArrayValue arr index state
let lookupTypeDefn
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(state : IlMachineState)

4
WoofWare.PawPrint/IlMachineStateExecution.fs
View File

@@ -58,12 +58,12 @@ module IlMachineStateExecution =
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.Heap addr ->
let o = ManagedHeap.Get addr state.ManagedHeap
let o = ManagedHeap.get addr state.ManagedHeap
state, o.ConcreteType
| ManagedPointerSource.ArrayIndex (arr, index) -> failwith "todo"
| ManagedPointerSource.Null -> failwith "todo"
| EvalStackValue.ObjectRef addr ->
let o = ManagedHeap.Get addr state.ManagedHeap
let o = ManagedHeap.get addr state.ManagedHeap
state, o.ConcreteType
| EvalStackValue.UserDefinedValueType tuples -> failwith "todo"

52
WoofWare.PawPrint/Intrinsics.fs
View File

@@ -42,6 +42,8 @@ module Intrinsics =
None
else
// In general, some implementations are in:
// https://github.com/dotnet/runtime/blob/108fa7856efcfd39bc991c2d849eabbf7ba5989c/src/coreclr/tools/Common/TypeSystem/IL/Stubs/UnsafeIntrinsics.cs#L192
match methodToCall.DeclaringType.Assembly.Name, methodToCall.DeclaringType.Name, methodToCall.Name with
| "System.Private.CoreLib", "Type", "get_TypeHandle" ->
// TODO: check return type is RuntimeTypeHandle
@@ -50,7 +52,14 @@ module Intrinsics =
| _ -> ()
// https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/Type.cs#L470
// TODO: check return type is RuntimeTypeHandle
match methodToCall.Signature.ParameterTypes with
| _ :: _ -> failwith "bad signature Type.get_TypeHandle"
| _ -> ()
// no args, returns RuntimeTypeHandle, a struct with a single field (a RuntimeType class)
// https://github.com/dotnet/runtime/blob/1d1bf92fcf43aa6981804dc53c5174445069c9e4/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L18
// The thing on top of the stack will be a RuntimeType.
let arg, state = IlMachineState.popEvalStack currentThread state
@@ -58,7 +67,10 @@ module Intrinsics =
let arg =
let rec go (arg : EvalStackValue) =
match arg with
| EvalStackValue.UserDefinedValueType [ _, s ] -> go s
| EvalStackValue.UserDefinedValueType vt ->
match vt.Fields with
| [ field ] -> go field.ContentsEval
| _ -> failwith $"TODO: %O{vt}"
| EvalStackValue.ManagedPointer ManagedPointerSource.Null -> failwith "TODO: throw NRE"
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) -> Some addr
| s -> failwith $"TODO: called with unrecognised arg %O{s}"
@@ -67,9 +79,14 @@ module Intrinsics =
let state =
let vt =
// https://github.com/dotnet/runtime/blob/2b21c73fa2c32fa0195e4a411a435dda185efd08/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L92
{
Fields = [ "m_type", CliType.ObjectRef arg ]
Name = "m_type"
Contents = CliType.ObjectRef arg
Offset = Some 0
}
|> List.singleton
|> CliValueType.OfFields
IlMachineState.pushToEvalStack (CliType.ValueType vt) currentThread state
|> IlMachineState.advanceProgramCounter currentThread
@@ -203,10 +220,13 @@ module Intrinsics =
|> Some
else
let arg1 = ManagedHeap.Get arg1 state.ManagedHeap
let arg2 = ManagedHeap.Get arg2 state.ManagedHeap
let arg1 = ManagedHeap.get arg1 state.ManagedHeap
let arg2 = ManagedHeap.get arg2 state.ManagedHeap
if arg1.Fields.["_firstChar"] <> arg2.Fields.["_firstChar"] then
if
AllocatedNonArrayObject.DereferenceField "_firstChar" arg1
<> AllocatedNonArrayObject.DereferenceField "_firstChar" arg2
then
state
|> IlMachineState.pushToEvalStack (CliType.ofBool false) currentThread
|> IlMachineState.advanceProgramCounter currentThread
@@ -220,19 +240,19 @@ module Intrinsics =
let v : CliType =
let rec go ptr =
match ptr with
| EvalStackValue.ManagedPointer src ->
match src with
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.Heap managedHeapAddress -> failwith "todo"
| ManagedPointerSource.ArrayIndex (arr, index) ->
state |> IlMachineState.getArrayValue arr index
| ManagedPointerSource.Null -> failwith "TODO: throw NRE"
| EvalStackValue.ManagedPointer src -> IlMachineState.dereferencePointer state src
| EvalStackValue.NativeInt src -> failwith "TODO"
| EvalStackValue.ObjectRef ptr -> failwith "TODO"
| EvalStackValue.UserDefinedValueType [ _, field ] -> go field
| EvalStackValue.UserDefinedValueType []
| EvalStackValue.UserDefinedValueType (_ :: _ :: _)
| EvalStackValue.UserDefinedValueType {
Fields = [ f ]
} -> go f.ContentsEval
| EvalStackValue.UserDefinedValueType {
Fields = []
} -> failwith "unexpected no-fields object"
| EvalStackValue.UserDefinedValueType {
Fields = _ :: _ :: _
} ->
failwith "TODO: check overlapping fields to see if this is a pointer"
| EvalStackValue.Int32 _
| EvalStackValue.Int64 _
| EvalStackValue.Float _ -> failwith $"this isn't a pointer! {ptr}"

12
WoofWare.PawPrint/List.fs Normal file
View File

@@ -0,0 +1,12 @@
namespace WoofWare.PawPrint
[<RequireQualifiedAccess>]
module List =
let replaceWhere (f : 'a -> 'a option) (l : 'a list) : 'a list =
([], l)
||> List.fold (fun acc x ->
match f x with
| None -> x :: acc
| Some y -> y :: acc
)
|> List.rev

38
WoofWare.PawPrint/ManagedHeap.fs
View File

@@ -8,11 +8,15 @@ type SyncBlock =
type AllocatedNonArrayObject =
{
Fields : Map<string, CliType>
Fields : CliField list
ConcreteType : ConcreteTypeHandle
SyncBlock : SyncBlock
}
static member DereferenceField (name : string) (f : AllocatedNonArrayObject) : CliType =
// TODO: this is wrong, it doesn't account for overlapping fields
f.Fields |> List.find (fun f -> f.Name = name) |> _.Contents
type AllocatedArray =
{
Length : int
@@ -29,7 +33,9 @@ type ManagedHeap =
StringArrayData : ImmutableArray<char>
}
static member Empty : ManagedHeap =
[<RequireQualifiedAccess>]
module ManagedHeap =
let empty : ManagedHeap =
{
NonArrayObjects = Map.empty
FirstAvailableAddress = 1
@@ -37,12 +43,12 @@ type ManagedHeap =
StringArrayData = ImmutableArray.Empty
}
static member GetSyncBlock (addr : ManagedHeapAddress) (heap : ManagedHeap) : SyncBlock =
let getSyncBlock (addr : ManagedHeapAddress) (heap : ManagedHeap) : SyncBlock =
match heap.NonArrayObjects.TryGetValue addr with
| false, _ -> failwith "TODO: getting sync block of array"
| true, v -> v.SyncBlock
static member SetSyncBlock (addr : ManagedHeapAddress) (syncValue : SyncBlock) (heap : ManagedHeap) : ManagedHeap =
let setSyncBlock (addr : ManagedHeapAddress) (syncValue : SyncBlock) (heap : ManagedHeap) : ManagedHeap =
match heap.NonArrayObjects.TryGetValue addr with
| false, _ -> failwith "TODO: locked on an array object"
| true, v ->
@@ -55,7 +61,7 @@ type ManagedHeap =
NonArrayObjects = heap.NonArrayObjects |> Map.add addr newV
}
static member AllocateArray (ty : AllocatedArray) (heap : ManagedHeap) : ManagedHeapAddress * ManagedHeap =
let allocateArray (ty : AllocatedArray) (heap : ManagedHeap) : ManagedHeapAddress * ManagedHeap =
let addr = heap.FirstAvailableAddress
let heap =
@@ -68,7 +74,7 @@ type ManagedHeap =
ManagedHeapAddress addr, heap
static member AllocateString (len : int) (heap : ManagedHeap) : int * ManagedHeap =
let allocateString (len : int) (heap : ManagedHeap) : int * ManagedHeap =
let addr = heap.StringArrayData.Length
let heap =
@@ -80,7 +86,7 @@ type ManagedHeap =
addr, heap
static member SetStringData (addr : int) (contents : string) (heap : ManagedHeap) : ManagedHeap =
let 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]))
@@ -92,11 +98,7 @@ type ManagedHeap =
heap
static member AllocateNonArray
(ty : AllocatedNonArrayObject)
(heap : ManagedHeap)
: ManagedHeapAddress * ManagedHeap
=
let allocateNonArray (ty : AllocatedNonArrayObject) (heap : ManagedHeap) : ManagedHeapAddress * ManagedHeap =
let addr = heap.FirstAvailableAddress
let heap =
@@ -109,7 +111,7 @@ type ManagedHeap =
ManagedHeapAddress addr, heap
static member GetArrayValue (alloc : ManagedHeapAddress) (offset : int) (heap : ManagedHeap) : CliType =
let getArrayValue (alloc : ManagedHeapAddress) (offset : int) (heap : ManagedHeap) : CliType =
match heap.Arrays.TryGetValue alloc with
| false, _ -> failwith "TODO: array not on heap"
| true, arr ->
@@ -119,17 +121,11 @@ type ManagedHeap =
arr.Elements.[offset]
static member Get (alloc : ManagedHeapAddress) (heap : ManagedHeap) : AllocatedNonArrayObject =
let get (alloc : ManagedHeapAddress) (heap : ManagedHeap) : AllocatedNonArrayObject =
// TODO: arrays too
heap.NonArrayObjects.[alloc]
static member SetArrayValue
(alloc : ManagedHeapAddress)
(offset : int)
(v : CliType)
(heap : ManagedHeap)
: ManagedHeap
=
let setArrayValue (alloc : ManagedHeapAddress) (offset : int) (v : CliType) (heap : ManagedHeap) : ManagedHeap =
let newArrs =
heap.Arrays
|> Map.change

1
WoofWare.PawPrint/NullaryIlOp.fs
View File

@@ -684,6 +684,7 @@ module NullaryIlOp =
let popped =
match popped with
| EvalStackValue.ManagedPointer ManagedPointerSource.Null -> failwith "TODO: throw NRE"
| EvalStackValue.ObjectRef addr
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) -> addr
| _ -> failwith $"can't get len of {popped}"

28
WoofWare.PawPrint/TypeHandleRegistry.fs
View File

@@ -18,7 +18,7 @@ module TypeHandleRegistry =
/// Returns an allocated System.RuntimeType as well.
let getOrAllocate
(allocState : 'allocState)
(allocate : (string * CliType) list -> 'allocState -> ManagedHeapAddress * 'allocState)
(allocate : CliField list -> 'allocState -> ManagedHeapAddress * 'allocState)
(def : ConcreteTypeHandle)
(reg : TypeHandleRegistry)
: ManagedHeapAddress * TypeHandleRegistry * 'allocState
@@ -29,16 +29,34 @@ module TypeHandleRegistry =
// Here follows the class System.RuntimeType, which is an internal class type with a constructor
// whose only purpose is to throw.
// https://github.com/dotnet/runtime/blob/2b21c73fa2c32fa0195e4a411a435dda185efd08/src/libraries/System.Private.CoreLib/src/System/RuntimeType.cs#L14
// and https://github.com/dotnet/runtime/blob/f0168ee80ba9aca18a7e7140b2bb436defda623c/src/coreclr/System.Private.CoreLib/src/System/RuntimeType.CoreCLR.cs#L44
let fields =
[
// for the GC, I think?
"m_keepalive", CliType.ObjectRef None
{
Name = "m_keepalive"
Contents = CliType.ObjectRef None
Offset = None
}
// TODO: this is actually a System.IntPtr https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/coreclr/nativeaot/Runtime.Base/src/System/Primitives.cs#L339
"m_cache", CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.Verbatim 0L))
"m_handle", CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.TypeHandlePtr def))
{
Name = "m_cache"
Contents = CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.Verbatim 0L))
Offset = None
}
{
Name = "m_handle"
Contents = CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.TypeHandlePtr def))
Offset = None
}
// This is the const -1, apparently?!
// https://github.com/dotnet/runtime/blob/f0168ee80ba9aca18a7e7140b2bb436defda623c/src/coreclr/System.Private.CoreLib/src/System/RuntimeType.CoreCLR.cs#L2496
"GenericParameterCountAny", CliType.Numeric (CliNumericType.Int32 -1)
{
Name = "GenericParameterCountAny"
Contents = CliType.Numeric (CliNumericType.Int32 -1)
Offset = None
}
]
let alloc, state = allocate fields allocState

5
WoofWare.PawPrint/UnaryConstIlOp.fs
View File

@@ -107,8 +107,8 @@ module internal UnaryConstIlOp =
| EvalStackValue.NativeInt i -> not (NativeIntSource.isZero i)
| EvalStackValue.Float f -> failwith "TODO: Brfalse_s float semantics undocumented"
| EvalStackValue.ManagedPointer ManagedPointerSource.Null -> false
| EvalStackValue.ObjectRef _
| EvalStackValue.ManagedPointer _ -> true
| EvalStackValue.ObjectRef _ -> failwith "TODO: Brfalse_s ObjectRef comparison unimplemented"
| EvalStackValue.UserDefinedValueType _ ->
failwith "TODO: Brfalse_s UserDefinedValueType comparison unimplemented"
@@ -129,8 +129,8 @@ module internal UnaryConstIlOp =
| EvalStackValue.NativeInt i -> not (NativeIntSource.isZero i)
| EvalStackValue.Float f -> failwith "TODO: Brtrue_s float semantics undocumented"
| EvalStackValue.ManagedPointer ManagedPointerSource.Null -> false
| EvalStackValue.ObjectRef _
| EvalStackValue.ManagedPointer _ -> true
| EvalStackValue.ObjectRef _ -> failwith "TODO: Brtrue_s ObjectRef comparison unimplemented"
| EvalStackValue.UserDefinedValueType _ ->
failwith "TODO: Brtrue_s UserDefinedValueType comparison unimplemented"
@@ -422,6 +422,7 @@ module internal UnaryConstIlOp =
| EvalStackValue.Float v1, _ -> failwith $"invalid comparison, {v1} with {value2}"
| EvalStackValue.NativeInt v1, EvalStackValue.NativeInt v2 -> v1 <> v2
| EvalStackValue.ManagedPointer ptr1, EvalStackValue.ManagedPointer ptr2 -> ptr1 <> ptr2
| EvalStackValue.ObjectRef ptr1, EvalStackValue.ObjectRef ptr2 -> ptr1 <> ptr2
| _, _ -> failwith $"TODO {value1} {value2} (see table III.4)"
state

149
WoofWare.PawPrint/UnaryMetadataIlOp.fs
View File

@@ -265,7 +265,14 @@ module internal UnaryMetadataIlOp =
ImmutableArray.Empty
state
state, (field.Name, zero) :: zeros
let field =
{
Name = field.Name
Contents = zero
Offset = field.Offset
}
state, field :: zeros
)
let fields = List.rev fieldZeros
@@ -469,6 +476,7 @@ module internal UnaryMetadataIlOp =
// null IsInstance check always succeeds and results in a null reference
EvalStackValue.ManagedPointer ManagedPointerSource.Null
| EvalStackValue.ManagedPointer (ManagedPointerSource.LocalVariable _) -> failwith "TODO"
| EvalStackValue.ObjectRef addr
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) ->
match state.ManagedHeap.NonArrayObjects.TryGetValue addr with
| true, v ->
@@ -548,33 +556,51 @@ module internal UnaryMetadataIlOp =
| EvalStackValue.Int64 _ -> failwith "unexpectedly setting field on an int64"
| EvalStackValue.NativeInt _ -> failwith "unexpectedly setting field on a nativeint"
| EvalStackValue.Float _ -> failwith "unexpectedly setting field on a float"
| EvalStackValue.ManagedPointer source ->
match source with
| ManagedPointerSource.Null -> failwith "TODO: raise NullReferenceException"
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
state
|> IlMachineState.setLocalVariable sourceThread methodFrame whichVar valueToStore
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.ArrayIndex (arr, index) ->
state |> IlMachineState.setArrayValue arr valueToStore index
| ManagedPointerSource.Heap addr ->
match state.ManagedHeap.NonArrayObjects.TryGetValue addr with
| false, _ -> failwith $"todo: array {addr}"
| true, v ->
let v =
{ v with
Fields = v.Fields |> Map.add field.Name valueToStore
}
let heap =
{ state.ManagedHeap with
NonArrayObjects = state.ManagedHeap.NonArrayObjects |> Map.add addr v
}
{ state with
ManagedHeap = heap
| EvalStackValue.ObjectRef addr
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) ->
match state.ManagedHeap.NonArrayObjects.TryGetValue addr with
| false, _ -> failwith $"todo: array {addr}"
| true, v ->
let v =
{ v with
Fields =
v.Fields
|> List.replaceWhere (fun f ->
if f.Name = field.Name then
{ f with
Contents = valueToStore
}
|> Some
else
None
)
}
| EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo"
let heap =
{ state.ManagedHeap with
NonArrayObjects = state.ManagedHeap.NonArrayObjects |> Map.add addr v
}
{ state with
ManagedHeap = heap
}
| EvalStackValue.ManagedPointer ManagedPointerSource.Null ->
failwith "TODO: raise NullReferenceException"
| EvalStackValue.ManagedPointer (ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar)) ->
let newValue =
IlMachineState.getLocalVariable sourceThread methodFrame whichVar state
|> CliType.withFieldSet field.Name valueToStore
state
|> IlMachineState.setLocalVariable sourceThread methodFrame whichVar newValue
| EvalStackValue.ManagedPointer (ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar)) ->
failwith "todo"
| EvalStackValue.ManagedPointer (ManagedPointerSource.ArrayIndex (arr, index)) ->
let newValue =
IlMachineState.getArrayValue arr index state
|> CliType.withFieldSet field.Name valueToStore
state |> IlMachineState.setArrayValue arr newValue index
| EvalStackValue.UserDefinedValueType _ -> failwith "todo"
state
@@ -713,32 +739,37 @@ module internal UnaryMetadataIlOp =
| EvalStackValue.Int64 int64 -> failwith "todo: int64"
| EvalStackValue.NativeInt nativeIntSource -> failwith $"todo: nativeint {nativeIntSource}"
| EvalStackValue.Float f -> failwith "todo: float"
| EvalStackValue.ManagedPointer managedPointerSource ->
match managedPointerSource with
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
let currentValue =
state.ThreadState.[sourceThread].MethodStates.[methodFrame].LocalVariables
.[int<uint16> whichVar]
| EvalStackValue.ManagedPointer (ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar)) ->
let currentValue =
state.ThreadState.[sourceThread].MethodStates.[methodFrame].LocalVariables
.[int<uint16> whichVar]
|> CliType.getField field.Name
IlMachineState.pushToEvalStack currentValue thread state
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
let currentValue =
state.ThreadState.[sourceThread].MethodStates.[methodFrame].Arguments.[int<uint16> whichVar]
IlMachineState.pushToEvalStack currentValue thread state
| EvalStackValue.ManagedPointer (ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar)) ->
let currentValue =
state.ThreadState.[sourceThread].MethodStates.[methodFrame].Arguments.[int<uint16> whichVar]
|> CliType.getField field.Name
IlMachineState.pushToEvalStack currentValue thread state
| ManagedPointerSource.Heap managedHeapAddress ->
match state.ManagedHeap.NonArrayObjects.TryGetValue managedHeapAddress with
| false, _ -> failwith $"todo: array {managedHeapAddress}"
| true, v -> IlMachineState.pushToEvalStack v.Fields.[field.Name] thread state
| ManagedPointerSource.ArrayIndex (arr, index) ->
let currentValue = state |> IlMachineState.getArrayValue arr index
IlMachineState.pushToEvalStack currentValue thread state
| ManagedPointerSource.Null -> failwith "TODO: raise NullReferenceException"
| EvalStackValue.ObjectRef managedHeapAddress -> failwith $"todo: {managedHeapAddress}"
| EvalStackValue.UserDefinedValueType fields ->
let result =
fields |> List.pick (fun (k, v) -> if k = field.Name then Some v else None)
IlMachineState.pushToEvalStack currentValue thread state
| EvalStackValue.ObjectRef managedHeapAddress
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap managedHeapAddress) ->
match state.ManagedHeap.NonArrayObjects.TryGetValue managedHeapAddress with
| false, _ -> failwith $"todo: array {managedHeapAddress}"
| true, v ->
IlMachineState.pushToEvalStack
(v.Fields |> List.find (fun f -> field.Name = f.Name) |> _.Contents)
thread
state
| EvalStackValue.ManagedPointer (ManagedPointerSource.ArrayIndex (arr, index)) ->
let currentValue =
state |> IlMachineState.getArrayValue arr index |> CliType.getField field.Name
IlMachineState.pushToEvalStack currentValue thread state
| EvalStackValue.ManagedPointer ManagedPointerSource.Null ->
failwith "TODO: raise NullReferenceException"
| EvalStackValue.UserDefinedValueType vt ->
let result = vt |> EvalStackValueUserType.DereferenceField field.Name
IlMachineState.pushToEvalStack' result thread state
state
@@ -1103,8 +1134,12 @@ module internal UnaryMetadataIlOp =
let vt =
{
Fields = [ "m_type", CliType.ObjectRef (Some alloc) ]
Name = "m_type"
Contents = CliType.ObjectRef (Some alloc)
Offset = None
}
|> List.singleton
|> CliValueType.OfFields
IlMachineState.pushToEvalStack (CliType.ValueType vt) thread state
| MetadataToken.TypeReference h ->
@@ -1134,8 +1169,12 @@ module internal UnaryMetadataIlOp =
let vt =
{
Fields = [ "m_type", CliType.ObjectRef (Some alloc) ]
Name = "m_type"
Contents = CliType.ObjectRef (Some alloc)
Offset = None
}
|> List.singleton
|> CliValueType.OfFields
IlMachineState.pushToEvalStack (CliType.ValueType vt) thread state
| MetadataToken.TypeDefinition h ->
@@ -1165,8 +1204,12 @@ module internal UnaryMetadataIlOp =
let vt =
{
Fields = [ "m_type", CliType.ObjectRef (Some alloc) ]
Name = "m_type"
Contents = CliType.ObjectRef (Some alloc)
Offset = None
}
|> List.singleton
|> CliValueType.OfFields
IlMachineState.pushToEvalStack (CliType.ValueType vt) thread state
| _ -> failwith $"Unexpected metadata token %O{metadataToken} in LdToken"

14
WoofWare.PawPrint/UnaryStringTokenIlOp.fs
View File

@@ -27,6 +27,8 @@ module internal UnaryStringTokenIlOp =
let state = state |> IlMachineState.setStringData dataAddr stringToAllocate
// String type is:
// https://github.com/dotnet/runtime/blob/f0168ee80ba9aca18a7e7140b2bb436defda623c/src/libraries/System.Private.CoreLib/src/System/String.cs#L26
let stringInstanceFields =
baseClassTypes.String.Fields
|> List.choose (fun field ->
@@ -49,8 +51,16 @@ module internal UnaryStringTokenIlOp =
let fields =
[
"_firstChar", CliType.ofChar state.ManagedHeap.StringArrayData.[dataAddr]
"_stringLength", CliType.Numeric (CliNumericType.Int32 stringToAllocate.Length)
{
Name = "_firstChar"
Contents = CliType.ofChar state.ManagedHeap.StringArrayData.[dataAddr]
Offset = None
}
{
Name = "_stringLength"
Contents = CliType.Numeric (CliNumericType.Int32 stringToAllocate.Length)
Offset = None
}
]
let state, stringType =

2
WoofWare.PawPrint/WoofWare.PawPrint.fsproj
View File

@@ -7,8 +7,10 @@
<ItemGroup>
<Compile Include="Tuple.fs" />
<Compile Include="List.fs" />
<Compile Include="ImmutableArray.fs" />
<Compile Include="Result.fs" />
<Compile Include="Constants.fs" />
<Compile Include="Corelib.fs" />
<Compile Include="AbstractMachineDomain.fs" />
<Compile Include="BasicCliType.fs" />