6 Commits

Author SHA1 Message Date
Patrick Stevens
08a4497ebf Recognise more exceptions (#129) 2025-09-06 16:32:26 +01:00
Patrick Stevens
fc62651d55 Add some more tests (#128) 2025-08-31 07:32:47 +00:00
Patrick Stevens
2e9fdbed48 Make it much harder to omit tests (#127) 2025-08-30 22:25:41 +00:00
Patrick Stevens
fb5c4a6313 Progress towards advanced struct layout (#126) 2025-08-30 19:07:05 +00:00
Patrick Stevens
95987e592c Upgrade flake (#125) 2025-08-30 17:05:57 +01:00
Patrick Stevens
0e31d74586 Implement Ldobj and Box for reference types (#124) 2025-08-30 15:36:26 +00:00
17 changed files with 1197 additions and 281 deletions

View File

@@ -67,13 +67,12 @@ dotnet run --project WoofWare.PawPrint.App/WoofWare.PawPrint.App.fsproj -- CShar
- `Corelib.fs`: Core library type definitions (String, Array, etc.)
**WoofWare.PawPrint.Test**
- Uses Expecto as the test framework
- Uses NUnit as the test framework
- 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
- C# source files in `sources{Pure,Impure}/` are compiled and executed by the runtime as test cases; files in `sourcesPure` are automatically turned into test cases with no further action (see TestPureCases.fs for the mechanism)
- `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` (note the additional `--`)
- Run a specific test with `dotnet run --project WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj -- --filter-test-case StringWithinTestName --no-spinner`
- Pending test definitions must be moved into the non-pending test case list before they can be run.
**WoofWare.PawPrint.App**
- Entry point application for running the interpreter

View File

@@ -337,6 +337,23 @@ module ConcreteActivePatterns =
| None -> None
| _ -> None
let (|ConcreteUInt64|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) : unit option =
match handle with
| ConcreteTypeHandle.Concrete id ->
match concreteTypes.Mapping |> Map.tryFind id with
| Some ct ->
if
ct.Assembly.Name = "System.Private.CoreLib"
&& ct.Namespace = "System"
&& ct.Name = "UInt64"
&& ct.Generics.IsEmpty
then
Some ()
else
None
| None -> None
| _ -> None
let (|ConcreteSingle|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) : unit option =
match handle with
| ConcreteTypeHandle.Concrete id ->

View File

@@ -6,6 +6,8 @@ open System.Reflection.Metadata
open System.Reflection.Metadata.Ecma335
open Microsoft.FSharp.Core
[<RequireQualifiedAccess>]
[<NoComparison>]
type ResolvedBaseType =
| Enum
| ValueType

View File

@@ -190,6 +190,18 @@ type BaseClassTypes<'corelib> =
TypedReference : TypeInfo<GenericParamFromMetadata, TypeDefn>
IntPtr : TypeInfo<GenericParamFromMetadata, TypeDefn>
UIntPtr : TypeInfo<GenericParamFromMetadata, TypeDefn>
Exception : TypeInfo<GenericParamFromMetadata, TypeDefn>
ArithmeticException : TypeInfo<GenericParamFromMetadata, TypeDefn>
DivideByZeroException : TypeInfo<GenericParamFromMetadata, TypeDefn>
OverflowException : TypeInfo<GenericParamFromMetadata, TypeDefn>
StackOverflowException : TypeInfo<GenericParamFromMetadata, TypeDefn>
TypeLoadException : TypeInfo<GenericParamFromMetadata, TypeDefn>
IndexOutOfRangeException : TypeInfo<GenericParamFromMetadata, TypeDefn>
InvalidCastException : TypeInfo<GenericParamFromMetadata, TypeDefn>
MissingFieldException : TypeInfo<GenericParamFromMetadata, TypeDefn>
MissingMethodException : TypeInfo<GenericParamFromMetadata, TypeDefn>
NullReferenceException : TypeInfo<GenericParamFromMetadata, TypeDefn>
OutOfMemoryException : TypeInfo<GenericParamFromMetadata, TypeDefn>
}
[<RequireQualifiedAccess>]

View File

@@ -23,7 +23,7 @@ module LoggerFactory =
let makeTest () : (unit -> LogLine list) * ILoggerFactory =
// Shared sink for all loggers created by the factory.
let sink = ResizeArray ()
let isEnabled (logLevel : LogLevel) : bool = logLevel >= LogLevel.Debug
let isEnabled (logLevel : LogLevel) : bool = logLevel >= LogLevel.Information
let createLogger (category : string) : ILogger =
{ new ILogger with

View File

@@ -1,5 +1,6 @@
namespace WoofWare.Pawprint.Test
open System
open System.Collections.Immutable
open System.IO
open FsUnitTyped

View File

@@ -1,5 +1,6 @@
namespace WoofWare.Pawprint.Test
open System
open System.Collections.Immutable
open System.IO
open FsUnitTyped
@@ -16,166 +17,65 @@ module TestPureCases =
let unimplemented =
[
{
FileName = "CrossAssemblyTypes.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "OverlappingStructs.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "AdvancedStructLayout.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "InitializeArray.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "Threads.cs"
ExpectedReturnCode = 3
NativeImpls = MockEnv.make ()
}
{
FileName = "ComplexTryCatch.cs"
ExpectedReturnCode = 14
NativeImpls = NativeImpls.PassThru ()
}
{
FileName = "ResizeArray.cs"
ExpectedReturnCode = 114
NativeImpls = MockEnv.make ()
}
{
FileName = "LdtokenField.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "GenericEdgeCases.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "UnsafeAs.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
"CrossAssemblyTypes.cs"
"OverlappingStructs.cs"
"AdvancedStructLayout.cs"
"InitializeArray.cs"
"Threads.cs"
"ComplexTryCatch.cs"
"ResizeArray.cs"
"LdtokenField.cs"
"GenericEdgeCases.cs"
"UnsafeAs.cs"
]
|> Set.ofList
let requiresMocks =
let empty = MockEnv.make ()
let cases : EndToEndTestCase list =
[
{
FileName = "NoOp.cs"
ExpectedReturnCode = 1
NativeImpls = MockEnv.make ()
}
{
FileName = "Sizeof.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "Sizeof2.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "Initobj.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "TestShl.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "TestShr.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "StaticVariables.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "Ldind.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "CustomDelegate.cs"
ExpectedReturnCode = 8
NativeImpls = MockEnv.make ()
}
{
FileName = "ArgumentOrdering.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "BasicLock.cs"
ExpectedReturnCode = 1
NativeImpls =
let mock = MockEnv.make ()
{ mock with
System_Threading_Monitor = System_Threading_Monitor.passThru
}
}
{
FileName = "TriangleNumber.cs"
ExpectedReturnCode = 10
NativeImpls = MockEnv.make ()
}
{
FileName = "ExceptionWithNoOpFinally.cs"
ExpectedReturnCode = 3
NativeImpls = MockEnv.make ()
}
{
FileName = "ExceptionWithNoOpCatch.cs"
ExpectedReturnCode = 10
NativeImpls = MockEnv.make ()
}
{
FileName = "Floats.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "TryCatchWithThrowInBody.cs"
ExpectedReturnCode = 4
NativeImpls = MockEnv.make ()
}
{
FileName = "Ldelema.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "TypeConcretization.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "TestOr.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "InterfaceDispatch.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
"BasicLock.cs",
(1,
{ empty with
System_Threading_Monitor = System_Threading_Monitor.passThru
})
]
|> Map.ofList
let customExitCodes =
[
"NoOp.cs", 1
"CustomDelegate.cs", 8
"ExceptionWithNoOpFinally.cs", 3
"ExceptionWithNoOpCatch.cs", 10
"TryCatchWithThrowInBody.cs", 4
"ResizeArray.cs", 114
"Threads.cs", 3
"TriangleNumber.cs", 10
]
|> Map.ofList
let allPure =
assy.GetManifestResourceNames ()
|> Seq.choose (fun res ->
let s = "WoofWare.PawPrint.Test.sourcesPure."
if res.StartsWith (s, StringComparison.OrdinalIgnoreCase) then
res.Substring s.Length |> Some
else
None
)
|> Set.ofSeq
let simpleCases : string list =
allPure
|> Seq.filter (fun s ->
(customExitCodes.ContainsKey s
|| requiresMocks.ContainsKey s
|| unimplemented.Contains s)
|> not
)
|> Seq.toList
let runTest (case : EndToEndTestCase) : unit =
let source = Assembly.getEmbeddedResourceAsString case.FileName assy
@@ -210,9 +110,43 @@ module TestPureCases =
reraise ()
[<TestCaseSource(nameof simpleCases)>]
let ``Standard tests`` (fileName : string) =
{
FileName = fileName
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
|> runTest
[<TestCaseSource(nameof customExitCodes)>]
let ``Custom exit code tests`` (KeyValue (fileName : string, exitCode : int)) =
if unimplemented.Contains fileName then
Assert.Inconclusive ()
{
FileName = fileName
ExpectedReturnCode = exitCode
NativeImpls = MockEnv.make ()
}
|> runTest
[<TestCaseSource(nameof requiresMocks)>]
let ``Tests which require mocks`` (KeyValue (fileName : string, (exitCode : int, mock : NativeImpls))) =
{
FileName = fileName
ExpectedReturnCode = exitCode
NativeImpls = mock
}
|> runTest
[<TestCaseSource(nameof unimplemented)>]
[<Explicit>]
let ``Can evaluate C# files, unimplemented`` (case : EndToEndTestCase) = runTest case
[<TestCaseSource(nameof cases)>]
let ``Can evaluate C# files`` (case : EndToEndTestCase) = runTest case
let ``Can evaluate C# files, unimplemented`` (fileName : string) =
{
FileName = fileName
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
|> runTest

View File

@@ -0,0 +1,255 @@
public class TestComparisonOperations
{
// Test Ceq: Compare equal
public static int TestCompareEqual()
{
// Integer equality
if ((5 == 5) != true) return 1;
if ((5 == 6) != false) return 2;
if ((int.MaxValue == int.MaxValue) != true) return 3;
if ((int.MinValue == int.MaxValue) != false) return 4;
// Negative numbers
if ((-1 == -1) != true) return 5;
if ((-5 == 5) != false) return 6;
// Long equality
if ((100L == 100L) != true) return 7;
if ((100L == 101L) != false) return 8;
// Mixed sizes (after promotion)
int i = 42;
long l = 42L;
if ((l == (long)i) != true) return 9;
// Zero comparisons
if ((0 == 0) != true) return 10;
if ((0 == 1) != false) return 11;
return 0;
}
// Test Cgt: Compare greater than (signed)
public static int TestCompareGreaterThan()
{
// Positive integers
if ((10 > 5) != true) return 20;
if ((5 > 10) != false) return 21;
if ((5 > 5) != false) return 22;
// Negative integers
if ((-5 > -10) != true) return 23;
if ((-10 > -5) != false) return 24;
if ((5 > -5) != true) return 25;
if ((-5 > 5) != false) return 26;
// Boundary values
if ((int.MaxValue > int.MinValue) != true) return 27;
if ((int.MinValue > int.MaxValue) != false) return 28;
if ((int.MaxValue > (int.MaxValue - 1)) != true) return 29;
// Zero comparisons
if ((1 > 0) != true) return 30;
if ((0 > 1) != false) return 31;
if ((-1 > 0) != false) return 32;
if ((0 > -1) != true) return 33;
return 0;
}
// Test Cgt_un: Compare greater than (unsigned)
public static int TestCompareGreaterThanUnsigned()
{
uint a = 10;
uint b = 5;
// Basic unsigned comparison
if ((a > b) != true) return 40;
if ((b > a) != false) return 41;
if ((a > a) != false) return 42;
// High bit set (would be negative if signed)
uint high = 0x80000000;
uint low = 0x7FFFFFFF;
if ((high > low) != true) return 43; // Unsigned: high > low
// Maximum values
uint max = uint.MaxValue;
uint min = uint.MinValue;
if ((max > min) != true) return 44;
if ((min > max) != false) return 45;
// Interpret negative as unsigned
uint negAsUint = unchecked((uint)-1);
uint one = 1;
if ((negAsUint > one) != true) return 46; // 0xFFFFFFFF > 1
return 0;
}
// Test Clt: Compare less than (signed)
public static int TestCompareLessThan()
{
// Positive integers
if ((5 < 10) != true) return 50;
if ((10 < 5) != false) return 51;
if ((5 < 5) != false) return 52;
// Negative integers
if ((-10 < -5) != true) return 53;
if ((-5 < -10) != false) return 54;
if ((-5 < 5) != true) return 55;
if ((5 < -5) != false) return 56;
// Boundary values
if ((int.MinValue < int.MaxValue) != true) return 57;
if ((int.MaxValue < int.MinValue) != false) return 58;
// Zero comparisons
if ((0 < 1) != true) return 59;
if ((1 < 0) != false) return 60;
if ((0 < -1) != false) return 61;
if ((-1 < 0) != true) return 62;
return 0;
}
// Test Clt_un: Compare less than (unsigned)
public static int TestCompareLessThanUnsigned()
{
uint a = 5;
uint b = 10;
// Basic unsigned comparison
if ((a < b) != true) return 70;
if ((b < a) != false) return 71;
if ((a < a) != false) return 72;
// High bit set
uint high = 0x80000000;
uint low = 0x7FFFFFFF;
if ((low < high) != true) return 73; // Unsigned: low < high
// Boundary values
uint max = uint.MaxValue;
uint min = uint.MinValue;
if ((min < max) != true) return 74;
if ((max < min) != false) return 75;
// Negative as unsigned
uint one = 1;
uint negAsUint = unchecked((uint)-1);
if ((one < negAsUint) != true) return 76; // 1 < 0xFFFFFFFF
return 0;
}
// Test comparison combinations
public static int TestComparisonCombinations()
{
int x = 10;
int y = 20;
int z = 10;
// Equality chains
if ((x == z) != true) return 80;
if ((x == y) != false) return 81;
// Inequality combinations
if ((x < y && y > x) != true) return 82;
if ((x < y && x == y) != false) return 83;
// Transitive comparisons
if (x < y && y < 30)
{
if ((x < 30) != true) return 84;
}
else
{
return 85;
}
return 0;
}
// Test comparisons with different types
public static int TestMixedTypeComparisons()
{
// byte comparisons (unsigned by default)
byte b1 = 200;
byte b2 = 100;
if ((b1 > b2) != true) return 90;
// sbyte comparisons (signed)
sbyte sb1 = -50;
sbyte sb2 = 50;
if ((sb1 < sb2) != true) return 91;
// short comparisons
short s1 = -1000;
short s2 = 1000;
if ((s1 < s2) != true) return 92;
if ((s1 == s2) != false) return 93;
// long comparisons
long l1 = long.MaxValue;
long l2 = long.MinValue;
if ((l1 > l2) != true) return 94;
return 0;
}
// Test null comparisons
public static int TestNullComparisons()
{
object obj1 = null;
object obj2 = null;
object obj3 = new object();
// Null equality
if ((obj1 == obj2) != true) return 100;
if ((obj1 == obj3) != false) return 101;
if ((obj3 == obj1) != false) return 102;
// String null comparisons
string s1 = null;
string s2 = null;
string s3 = "";
if ((s1 == s2) != true) return 103;
if ((s1 == s3) != false) return 104;
return 0;
}
public static int Main(string[] argv)
{
int result;
result = TestCompareEqual();
if (result != 0) return 100 + result;
result = TestCompareGreaterThan();
if (result != 0) return 200 + result;
result = TestCompareGreaterThanUnsigned();
if (result != 0) return 300 + result;
result = TestCompareLessThan();
if (result != 0) return 400 + result;
result = TestCompareLessThanUnsigned();
if (result != 0) return 500 + result;
result = TestComparisonCombinations();
if (result != 0) return 600 + result;
result = TestMixedTypeComparisons();
if (result != 0) return 700 + result;
result = TestNullComparisons();
if (result != 0) return 800 + result;
return 0;
}
}

View File

@@ -0,0 +1,184 @@
public class TestStackOperations
{
// Test LdArg0-3: Load method arguments
public static int TestLoadArguments(int arg0, int arg1, int arg2, int arg3)
{
// LdArg0 loads 'this' for instance methods or first arg for static
if (arg0 != 10) return 1;
// LdArg1 loads second argument
if (arg1 != 20) return 2;
// LdArg2 loads third argument
if (arg2 != 30) return 3;
// LdArg3 loads fourth argument
if (arg3 != 40) return 4;
return 0;
}
// Test Ldloc_0-3 and Stloc_0-3: Load/store local variables
public static int TestLocalVariables()
{
int local0 = 100;
int local1 = 200;
int local2 = 300;
int local3 = 400;
// Test loading locals
if (local0 != 100) return 10;
if (local1 != 200) return 11;
if (local2 != 300) return 12;
if (local3 != 400) return 13;
// Test storing to locals
local0 = local1 + local2; // Stloc_0
if (local0 != 500) return 14;
local1 = local2 * 2; // Stloc_1
if (local1 != 600) return 15;
local2 = local3 - 100; // Stloc_2
if (local2 != 300) return 16;
local3 = local0 / 5; // Stloc_3
if (local3 != 100) return 17;
return 0;
}
// Test Pop: Remove top stack value
public static int TestPop()
{
int value = 42;
// Push value on stack then pop it
PushAndPop(value);
// If we get here, pop worked
return 0;
}
private static void PushAndPop(int value)
{
// The compiler will generate pop instructions
// for unused return values
GetValue();
GetValue();
}
private static int GetValue()
{
return 123;
}
// Test Dup: Duplicate top stack value
public static int TestDup()
{
int value = 50;
// Dup is used when same value is needed twice
int result1 = value * value; // Compiler may use dup here
if (result1 != 2500) return 20;
// More complex dup scenario
int x = 10;
int result2 = AddTwice(x);
if (result2 != 20) return 21;
return 0;
}
private static int AddTwice(int val)
{
// Compiler may generate dup to use val twice
return val + val;
}
// Test Ret: Return from method
public static int TestReturn()
{
// Test void return
VoidReturn();
// Test value return
int result = ValueReturn(5);
if (result != 5) return 30;
// Test early return
result = EarlyReturn(true);
if (result != 1) return 31;
result = EarlyReturn(false);
if (result != 2) return 32;
return 0;
}
private static void VoidReturn()
{
// Ret with no value
return;
}
private static int ValueReturn(int x)
{
// Ret with value
return x;
}
private static int EarlyReturn(bool condition)
{
if (condition)
return 1; // Early ret
return 2; // Normal ret
}
// Test combinations of stack operations
public static int TestStackCombinations()
{
int a = 10, b = 20, c = 30;
// Complex expression using multiple locals
int result = (a + b) * c - (b - a);
if (result != 890) return 40;
// Nested method calls
result = Compute(a, Compute(b, c));
if (result != 60) return 41;
return 0;
}
private static int Compute(int x, int y)
{
return x + y;
}
public static int Main(string[] argv)
{
int result;
result = TestLoadArguments(10, 20, 30, 40);
if (result != 0) return 100 + result;
result = TestLocalVariables();
if (result != 0) return 200 + result;
result = TestPop();
if (result != 0) return 300 + result;
result = TestDup();
if (result != 0) return 400 + result;
result = TestReturn();
if (result != 0) return 500 + result;
result = TestStackCombinations();
if (result != 0) return 600 + result;
return 0;
}
}

View File

@@ -10,6 +10,7 @@ type IArithmeticOperation =
abstract FloatFloat : float -> float -> float
abstract NativeIntNativeInt : nativeint -> nativeint -> nativeint
abstract Int32ManagedPtr : IlMachineState -> int32 -> ManagedPointerSource -> Choice<ManagedPointerSource, int>
abstract ManagedPtrInt32 : IlMachineState -> ManagedPointerSource -> int32 -> Choice<ManagedPointerSource, int>
abstract ManagedPtrManagedPtr :
IlMachineState -> ManagedPointerSource -> ManagedPointerSource -> Choice<ManagedPointerSource, nativeint>
@@ -18,6 +19,35 @@ type IArithmeticOperation =
[<RequireQualifiedAccess>]
module ArithmeticOperation =
let private addInt32ManagedPtr state v ptr =
match ptr with
| LocalVariable (sourceThread, methodFrame, whichVar) -> failwith "refusing to add to a local variable address"
| Argument (sourceThread, methodFrame, whichVar) -> failwith "refusing to add to an argument address"
| Heap managedHeapAddress -> failwith "refusing to add to a heap address"
| ArrayIndex (arr, index) -> failwith "TODO: arrays"
| Field (src, fieldName) ->
let obj = IlMachineState.dereferencePointer state src
let offset, _ = CliType.getFieldLayout fieldName obj
match CliType.getFieldAt (offset + v) obj with
| None -> failwith "TODO: couldn't identify field at offset"
| Some field ->
ManagedPointerSource.Field (src, CliConcreteField.ToCliField(field).Name)
|> Choice1Of2
| Null -> Choice2Of2 v
| InterpretedAsType (managedPointerSource, concreteType) -> failwith "todo"
let private mulInt32ManagedPtr (state : IlMachineState) v ptr =
if v = 0 then
Choice2Of2 0
elif v = 1 then
Choice1Of2 ptr
else
match ptr with
| ManagedPointerSource.Null -> Choice2Of2 0
| _ -> failwith "refusing to multiply pointers"
let add =
{ new IArithmeticOperation with
member _.Int32Int32 a b = (# "add" a b : int32 #)
@@ -33,28 +63,33 @@ module ArithmeticOperation =
| _, ManagedPointerSource.Null -> Choice1Of2 ptr1
| _, _ -> failwith "refusing to add two managed pointers"
member _.Int32ManagedPtr state val1 ptr2 =
match ptr2 with
| LocalVariable (sourceThread, methodFrame, whichVar) ->
failwith "refusing to add to a local variable address"
| Argument (sourceThread, methodFrame, whichVar) -> failwith "refusing to add to an argument address"
| Heap managedHeapAddress -> failwith "refusing to add to a heap address"
| ArrayIndex (arr, index) -> failwith "TODO: arrays"
| Field (src, fieldName) ->
let obj = IlMachineState.dereferencePointer state src
let offset, _ = CliType.getFieldLayout fieldName obj
match CliType.getFieldAt (offset + val1) obj with
| None -> failwith "TODO: couldn't identify field at offset"
| Some field ->
ManagedPointerSource.Field (src, CliConcreteField.ToCliField(field).Name)
|> Choice1Of2
| Null -> Choice2Of2 val1
| InterpretedAsType (managedPointerSource, concreteType) -> failwith "todo"
member _.Int32ManagedPtr state val1 ptr2 = addInt32ManagedPtr state val1 ptr2
member _.ManagedPtrInt32 state ptr1 val2 = addInt32ManagedPtr state val2 ptr1
member _.Name = "add"
}
let addOvf =
{ new IArithmeticOperation with
member _.Int32Int32 a b = (# "add.ovf" a b : int32 #)
member _.Int64Int64 a b = (# "add.ovf" a b : int64 #)
member _.FloatFloat a b = (# "add.ovf" a b : float #)
member _.NativeIntNativeInt a b = (# "add.ovf" a b : nativeint #)
member _.Int32NativeInt a b = (# "add.ovf" a b : nativeint #)
member _.NativeIntInt32 a b = (# "add.ovf" a b : nativeint #)
member _.ManagedPtrManagedPtr _ ptr1 ptr2 =
match ptr1, ptr2 with
| ManagedPointerSource.Null, _ -> Choice1Of2 ptr2
| _, ManagedPointerSource.Null -> Choice1Of2 ptr1
| _, _ -> failwith "refusing to add two managed pointers"
member _.Int32ManagedPtr state val1 ptr2 = addInt32ManagedPtr state val1 ptr2
member _.ManagedPtrInt32 state ptr1 val2 = addInt32ManagedPtr state val2 ptr1
member _.Name = "add.ovf"
}
let sub =
{ new IArithmeticOperation with
member _.Int32Int32 a b = (# "sub" a b : int32 #)
@@ -94,6 +129,8 @@ module ArithmeticOperation =
| ManagedPointerSource.Null -> Choice2Of2 val1
| _ -> failwith "refusing to subtract a pointer"
member _.ManagedPtrInt32 state ptr1 val2 = failwith "TODO: subtract from pointer"
member _.Name = "sub"
}
@@ -112,16 +149,26 @@ module ArithmeticOperation =
| _, ManagedPointerSource.Null -> Choice2Of2 (nativeint 0)
| _, _ -> failwith "refusing to multiply two managed pointers"
member _.Int32ManagedPtr _ a ptr =
if a = 0 then
Choice2Of2 0
elif a = 1 then
Choice1Of2 ptr
else
member _.Int32ManagedPtr state a ptr = mulInt32ManagedPtr state a ptr
member _.ManagedPtrInt32 state ptr a = mulInt32ManagedPtr state a ptr
match ptr with
| ManagedPointerSource.Null -> Choice2Of2 0
| _ -> failwith "refusing to multiply pointers"
member _.Name = "mul"
}
let rem =
{ new IArithmeticOperation with
member _.Int32Int32 a b = (# "rem" a b : int32 #)
member _.Int64Int64 a b = (# "rem" a b : int64 #)
member _.FloatFloat a b = (# "rem" a b : float #)
member _.NativeIntNativeInt a b = (# "rem" a b : nativeint #)
member _.Int32NativeInt a b = (# "rem" a b : nativeint #)
member _.NativeIntInt32 a b = (# "rem" a b : nativeint #)
member _.ManagedPtrManagedPtr _ ptr1 ptr2 = failwith "refusing to rem pointers"
member _.Int32ManagedPtr _ a ptr = failwith "refusing to rem pointer"
member _.ManagedPtrInt32 _ ptr a = failwith "refusing to rem pointer"
member _.Name = "mul"
}
@@ -141,16 +188,8 @@ module ArithmeticOperation =
| _, ManagedPointerSource.Null -> Choice2Of2 (nativeint 0)
| _, _ -> failwith "refusing to multiply two managed pointers"
member _.Int32ManagedPtr _ a ptr =
if a = 0 then
Choice2Of2 0
elif a = 1 then
Choice1Of2 ptr
else
match ptr with
| ManagedPointerSource.Null -> Choice2Of2 0
| _ -> failwith "refusing to multiply pointers"
member _.Int32ManagedPtr state a ptr = mulInt32ManagedPtr state a ptr
member _.ManagedPtrInt32 state a ptr = mulInt32ManagedPtr state ptr a
member _.Name = "mul_ovf"
}
@@ -175,6 +214,12 @@ module ArithmeticOperation =
else
failwith "refusing to divide pointers"
member _.ManagedPtrInt32 _ ptr a =
if a = 1 then
Choice1Of2 ptr
else
failwith "refusing to divide a pointer"
member _.Name = "div"
}
@@ -238,7 +283,10 @@ module BinaryArithmetic =
| EvalStackValue.ManagedPointer val1, EvalStackValue.NativeInt val2 ->
failwith "" |> EvalStackValue.ManagedPointer
| EvalStackValue.ObjectRef val1, EvalStackValue.NativeInt val2 -> failwith "" |> EvalStackValue.ObjectRef
| EvalStackValue.ManagedPointer val1, EvalStackValue.Int32 val2 -> failwith "" |> EvalStackValue.ManagedPointer
| EvalStackValue.ManagedPointer val1, EvalStackValue.Int32 val2 ->
match op.ManagedPtrInt32 state val1 val2 with
| Choice1Of2 result -> EvalStackValue.ManagedPointer result
| Choice2Of2 result -> EvalStackValue.NativeInt (NativeIntSource.Verbatim (int64<int32> result))
| EvalStackValue.ObjectRef val1, EvalStackValue.Int32 val2 -> failwith "" |> EvalStackValue.ObjectRef
| EvalStackValue.ManagedPointer val1, EvalStackValue.ManagedPointer val2 ->
match op.ManagedPtrManagedPtr state val1 val2 with

View File

@@ -152,6 +152,66 @@ module Corelib =
)
|> Seq.exactlyOne
let exceptionType =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "Exception" then Some v else None)
|> Seq.exactlyOne
let arithmeticException =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "ArithmeticException" then Some v else None)
|> Seq.exactlyOne
let divideByZeroException =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "DivideByZeroException" then Some v else None)
|> Seq.exactlyOne
let overflowException =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "OverflowException" then Some v else None)
|> Seq.exactlyOne
let stackOverflowException =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "StackOverflowException" then Some v else None)
|> Seq.exactlyOne
let typeLoadException =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "TypeLoadException" then Some v else None)
|> Seq.exactlyOne
let indexOutOfRangeException =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "IndexOutOfRangeException" then Some v else None)
|> Seq.exactlyOne
let invalidCastException =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "InvalidCastException" then Some v else None)
|> Seq.exactlyOne
let missingFieldException =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "MissingFieldException" then Some v else None)
|> Seq.exactlyOne
let missingMethodException =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "MissingMethodException" then Some v else None)
|> Seq.exactlyOne
let nullReferenceException =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "NullReferenceException" then Some v else None)
|> Seq.exactlyOne
let outOfMemoryException =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "OutOfMemoryException" then Some v else None)
|> Seq.exactlyOne
{
Corelib = corelib
String = stringType
@@ -182,6 +242,18 @@ module Corelib =
TypedReference = typedReferenceType
IntPtr = intPtrType
UIntPtr = uintPtrType
Exception = exceptionType
ArithmeticException = arithmeticException
DivideByZeroException = divideByZeroException
OverflowException = overflowException
StackOverflowException = stackOverflowException
TypeLoadException = typeLoadException
IndexOutOfRangeException = indexOutOfRangeException
InvalidCastException = invalidCastException
MissingFieldException = missingFieldException
MissingMethodException = missingMethodException
NullReferenceException = nullReferenceException
OutOfMemoryException = outOfMemoryException
}
let concretizeAll

View File

@@ -1,5 +1,7 @@
namespace WoofWare.PawPrint
#nowarn "42"
/// See I.12.3.2.1 for definition
type EvalStackValue =
| Int32 of int32
@@ -100,6 +102,21 @@ module EvalStackValue =
| EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo"
| EvalStackValue.UserDefinedValueType evalStackValues -> failwith "todo"
/// Then truncates to int32.
let convToUInt8 (value : EvalStackValue) : int32 option =
match value with
| EvalStackValue.Int32 (i : int32) ->
let v = (# "conv.u1" i : uint8 #)
Some (int32<uint8> v)
| EvalStackValue.Int64 int64 ->
let v = (# "conv.u1" int64 : uint8 #)
Some (int32<uint8> v)
| EvalStackValue.NativeInt nativeIntSource -> failwith "todo"
| EvalStackValue.Float f -> failwith "todo"
| EvalStackValue.ManagedPointer managedPointerSource -> failwith "todo"
| EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo"
| EvalStackValue.UserDefinedValueType evalStackValues -> failwith "todo"
let rec ofCliType (v : CliType) : EvalStackValue =
match v with
| CliType.Numeric numeric ->

View File

@@ -1670,7 +1670,10 @@ module IlMachineState =
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.Heap addr ->
let result = ManagedHeap.get addr state.ManagedHeap
// TODO: this is awfully dubious, this ain't no value type
CliType.ValueType result.Contents
| ManagedPointerSource.ArrayIndex (arr, index) -> getArrayValue arr index state
| ManagedPointerSource.Field (addr, name) ->
let obj = dereferencePointer state addr
@@ -1690,7 +1693,7 @@ module IlMachineState =
| Some ty -> ty
| None -> failwith "not concretised type"
failwith "TODO"
failwith $"TODO: interpret as type %s{ty.Assembly.Name}.%s{ty.Namespace}.%s{ty.Name}, object %O{src}"
let lookupTypeDefn
(baseClassTypes : BaseClassTypes<DumpedAssembly>)

View File

@@ -27,6 +27,8 @@ module Intrinsics =
"System.Private.CoreLib", "Math", "Max"
// https://github.com/dotnet/runtime/blob/d258af50034c192bf7f0a18856bf83d2903d98ae/src/libraries/System.Private.CoreLib/src/System/Buffer.cs#L150
"System.Private.CoreLib", "Buffer", "Memmove"
// https://github.com/dotnet/runtime/blob/1c3221b63340d7f81dfd829f3bcd822e582324f6/src/libraries/System.Private.CoreLib/src/System/Threading/Thread.cs#L799
"System.Private.CoreLib", "Thread", "get_CurrentThread"
]
|> Set.ofList
@@ -190,6 +192,44 @@ module Intrinsics =
|> IlMachineState.advanceProgramCounter currentThread
Some state
| "System.Private.CoreLib", "Type", "get_IsValueType" ->
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
| [], ConcreteBool state.ConcreteTypes -> ()
| _ -> failwith "bad signature Type.get_IsValueType"
let this, state = IlMachineState.popEvalStack currentThread state
let this =
match this with
| EvalStackValue.ObjectRef ptr ->
IlMachineState.dereferencePointer state (ManagedPointerSource.Heap ptr)
| EvalStackValue.ManagedPointer ptr -> IlMachineState.dereferencePointer state ptr
| EvalStackValue.Float _
| EvalStackValue.Int32 _
| EvalStackValue.Int64 _ -> failwith "refusing to dereference literal"
| _ -> failwith "TODO"
// `this` should be of type Type
let ty =
match this with
| CliType.ValueType cvt ->
match CliValueType.DereferenceField "m_handle" cvt with
| CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.TypeHandlePtr cth)) -> cth
| _ -> failwith ""
| _ -> failwith "expected a Type"
let ty = AllConcreteTypes.lookup ty state.ConcreteTypes |> Option.get
let ty = state.LoadedAssembly(ty.Assembly).Value.TypeDefs.[ty.Definition.Get]
let isValueType =
match DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies ty.Assembly ty.BaseType with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> true
| ResolvedBaseType.Object
| ResolvedBaseType.Delegate -> false
IlMachineState.pushToEvalStack (CliType.ofBool isValueType) currentThread state
|> IlMachineState.advanceProgramCounter currentThread
|> Some
| "System.Private.CoreLib", "Unsafe", "AsPointer" ->
// Method signature: 1 generic parameter, we take a Byref of that parameter, and return a TypeDefn.Pointer(Void)
let arg, state = IlMachineState.popEvalStack currentThread state
@@ -233,6 +273,47 @@ module Intrinsics =
let result =
BitConverter.Int32BitsToSingle arg |> CliNumericType.Float32 |> CliType.Numeric
state
|> IlMachineState.pushToEvalStack result currentThread
|> IlMachineState.advanceProgramCounter currentThread
|> Some
| "System.Private.CoreLib", "BitConverter", "DoubleToUInt64Bits" ->
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
| [ ConcreteDouble state.ConcreteTypes ], ConcreteUInt64 state.ConcreteTypes -> ()
| _ -> failwith "bad signature BitConverter.DoubleToUInt64Bits"
let arg, state = IlMachineState.popEvalStack currentThread state
let arg =
match arg with
| EvalStackValue.Float i -> i
| _ -> failwith "$TODO: {arr}"
let result =
BitConverter.DoubleToUInt64Bits arg
|> int64<uint64>
|> CliNumericType.Int64
|> CliType.Numeric
state
|> IlMachineState.pushToEvalStack result currentThread
|> IlMachineState.advanceProgramCounter currentThread
|> Some
| "System.Private.CoreLib", "BitConverter", "UInt64BitsToDouble" ->
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
| [ ConcreteUInt64 state.ConcreteTypes ], ConcreteDouble state.ConcreteTypes -> ()
| _ -> failwith "bad signature BitConverter.DoubleToUInt64Bits"
let arg, state = IlMachineState.popEvalStack currentThread state
let arg =
match arg with
| EvalStackValue.Int64 i -> uint64 i
| _ -> failwith "$TODO: {arr}"
let result =
BitConverter.UInt64BitsToDouble arg |> CliNumericType.Float64 |> CliType.Numeric
state
|> IlMachineState.pushToEvalStack result currentThread
|> IlMachineState.advanceProgramCounter currentThread
@@ -319,7 +400,8 @@ module Intrinsics =
let arg1 =
match arg1 with
| EvalStackValue.ObjectRef h
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> h
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> Some h
| EvalStackValue.ManagedPointer ManagedPointerSource.Null -> None
| EvalStackValue.Int32 _
| EvalStackValue.Int64 _
| EvalStackValue.Float _ -> failwith $"this isn't a string! {arg1}"
@@ -330,32 +412,38 @@ module Intrinsics =
let arg2 =
match arg2 with
| EvalStackValue.ObjectRef h
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> h
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> Some h
| EvalStackValue.ManagedPointer ManagedPointerSource.Null -> None
| EvalStackValue.Int32 _
| EvalStackValue.Int64 _
| EvalStackValue.Float _ -> failwith $"this isn't a string! {arg2}"
| _ -> failwith $"TODO: %O{arg2}"
if arg1 = arg2 then
state
|> IlMachineState.pushToEvalStack (CliType.ofBool true) currentThread
|> IlMachineState.advanceProgramCounter currentThread
|> Some
else
let areEqual =
match arg1, arg2 with
| None, None -> true
| Some _, None
| None, Some _ -> false
| Some arg1, Some arg2 ->
if arg1 = arg2 then
true
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
AllocatedNonArrayObject.DereferenceField "_firstChar" arg1
<> AllocatedNonArrayObject.DereferenceField "_firstChar" arg2
then
state
|> IlMachineState.pushToEvalStack (CliType.ofBool false) currentThread
|> IlMachineState.advanceProgramCounter currentThread
|> Some
else
failwith "TODO"
if
AllocatedNonArrayObject.DereferenceField "_firstChar" arg1
<> AllocatedNonArrayObject.DereferenceField "_firstChar" arg2
then
false
else
failwith "TODO"
state
|> IlMachineState.pushToEvalStack (CliType.ofBool areEqual) currentThread
|> IlMachineState.advanceProgramCounter currentThread
|> Some
| _ -> None
| "System.Private.CoreLib", "Unsafe", "ReadUnaligned" ->
let ptr, state = IlMachineState.popEvalStack currentThread state

View File

@@ -86,43 +86,28 @@ module NullaryIlOp =
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
failwith "unexpected - can we really write to an argument?"
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
{ state with
ThreadState =
state.ThreadState
|> Map.change
sourceThread
(fun state ->
match state with
| None -> failwith "tried to store in local variables of nonexistent stack frame"
| Some state ->
let frame = state.MethodStates.[methodFrame]
let frame =
{ frame with
LocalVariables =
frame.LocalVariables.SetItem (
int<uint16> whichVar,
EvalStackValue.toCliTypeCoerced varType valueToStore
)
}
{ state with
MethodStates = state.MethodStates.SetItem (methodFrame, frame)
}
|> Some
)
}
state
|> IlMachineState.setLocalVariable
sourceThread
methodFrame
whichVar
(EvalStackValue.toCliTypeCoerced varType valueToStore)
| ManagedPointerSource.Heap managedHeapAddress -> failwith "todo"
| ManagedPointerSource.ArrayIndex _ -> failwith "todo"
| ManagedPointerSource.Field (managedPointerSource, fieldName) -> failwith "todo"
| ManagedPointerSource.Field (managedPointerSource, fieldName) ->
state
|> IlMachineState.setFieldValue
managedPointerSource
(EvalStackValue.toCliTypeCoerced varType valueToStore)
fieldName
| EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo"
let internal ldElem
let internal getArrayElt
(index : EvalStackValue)
(arr : EvalStackValue)
(currentThread : ThreadId)
(state : IlMachineState)
: ExecutionResult
: CliType
=
let index =
match index with
@@ -143,14 +128,7 @@ module NullaryIlOp =
| EvalStackValue.ManagedPointer ManagedPointerSource.Null -> failwith "TODO: throw NRE"
| _ -> failwith $"Invalid array: %O{arr}"
let value = IlMachineState.getArrayValue arrAddr index state
let state =
state
|> IlMachineState.pushToEvalStack value currentThread
|> IlMachineState.advanceProgramCounter currentThread
ExecutionResult.Stepped (state, WhatWeDid.Executed)
IlMachineState.getArrayValue arrAddr index state
let internal stElem
(targetCliTypeZero : CliType)
@@ -443,8 +421,8 @@ module NullaryIlOp =
| Sub_ovf -> failwith "TODO: Sub_ovf unimplemented"
| Sub_ovf_un -> failwith "TODO: Sub_ovf_un unimplemented"
| Add ->
let val1, state = IlMachineState.popEvalStack currentThread state
let val2, state = IlMachineState.popEvalStack currentThread state
let val1, state = IlMachineState.popEvalStack currentThread state
let result = BinaryArithmetic.execute ArithmeticOperation.add state val1 val2
state
@@ -452,11 +430,29 @@ module NullaryIlOp =
|> IlMachineState.advanceProgramCounter currentThread
|> Tuple.withRight WhatWeDid.Executed
|> ExecutionResult.Stepped
| Add_ovf -> failwith "TODO: Add_ovf unimplemented"
| Add_ovf ->
let val2, state = IlMachineState.popEvalStack currentThread state
let val1, state = IlMachineState.popEvalStack currentThread state
let result =
try
BinaryArithmetic.execute ArithmeticOperation.addOvf state val1 val2 |> Ok
with :? OverflowException as e ->
Error e
let state =
match result with
| Ok result -> state |> IlMachineState.pushToEvalStack' result currentThread
| Error excToThrow -> failwith "TODO: throw OverflowException"
state
|> IlMachineState.advanceProgramCounter currentThread
|> Tuple.withRight WhatWeDid.Executed
|> ExecutionResult.Stepped
| Add_ovf_un -> failwith "TODO: Add_ovf_un unimplemented"
| Mul ->
let val1, state = IlMachineState.popEvalStack currentThread state
let val2, state = IlMachineState.popEvalStack currentThread state
let val1, state = IlMachineState.popEvalStack currentThread state
let result = BinaryArithmetic.execute ArithmeticOperation.mul state val1 val2
state
@@ -465,8 +461,8 @@ module NullaryIlOp =
|> Tuple.withRight WhatWeDid.Executed
|> ExecutionResult.Stepped
| Mul_ovf ->
let val1, state = IlMachineState.popEvalStack currentThread state
let val2, state = IlMachineState.popEvalStack currentThread state
let val1, state = IlMachineState.popEvalStack currentThread state
let result =
try
@@ -529,7 +525,33 @@ module NullaryIlOp =
|> IlMachineState.advanceProgramCounter currentThread
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped
| Shr_un -> failwith "TODO: Shr_un unimplemented"
| Shr_un ->
let shift, state = IlMachineState.popEvalStack currentThread state
let number, state = IlMachineState.popEvalStack currentThread state
let shift =
match shift with
| EvalStackValue.Int32 i -> i
| EvalStackValue.NativeInt (NativeIntSource.Verbatim i) -> int<int64> i
| _ -> failwith $"Not allowed shift of {shift}"
let result =
// See table III.6
match number with
| EvalStackValue.Int32 i -> uint32<int> i >>> shift |> int32<uint32> |> EvalStackValue.Int32
| EvalStackValue.Int64 i -> uint64<int64> i >>> shift |> int64<uint64> |> EvalStackValue.Int64
| EvalStackValue.NativeInt (NativeIntSource.Verbatim i) ->
(uint64<int64> i >>> shift |> int64<uint64>)
|> NativeIntSource.Verbatim
|> EvalStackValue.NativeInt
| _ -> failwith $"Not allowed to shift {number}"
let state =
state
|> IlMachineState.pushToEvalStack' result currentThread
|> IlMachineState.advanceProgramCounter currentThread
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped
| Shl ->
let shift, state = IlMachineState.popEvalStack currentThread state
let number, state = IlMachineState.popEvalStack currentThread state
@@ -617,7 +639,37 @@ module NullaryIlOp =
|> IlMachineState.advanceProgramCounter currentThread
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped
| Xor -> failwith "TODO: Xor unimplemented"
| Xor ->
let v2, state = IlMachineState.popEvalStack currentThread state
let v1, state = IlMachineState.popEvalStack currentThread state
let result =
match v1, v2 with
| EvalStackValue.Int32 v1, EvalStackValue.Int32 v2 -> v1 ^^^ v2 |> EvalStackValue.Int32
| EvalStackValue.Int32 v1, EvalStackValue.NativeInt (NativeIntSource.Verbatim v2) ->
int64<int32> v1 ^^^ v2 |> NativeIntSource.Verbatim |> EvalStackValue.NativeInt
| EvalStackValue.Int32 _, EvalStackValue.NativeInt _ ->
failwith $"can't do binary operation on non-verbatim native int {v2}"
| EvalStackValue.Int64 v1, EvalStackValue.Int64 v2 -> v1 ^^^ v2 |> EvalStackValue.Int64
| EvalStackValue.NativeInt (NativeIntSource.Verbatim v1), EvalStackValue.Int32 v2 ->
v1 ^^^ int64<int32> v2 |> NativeIntSource.Verbatim |> EvalStackValue.NativeInt
| EvalStackValue.NativeInt _, EvalStackValue.Int32 _ ->
failwith $"can't do binary operation on non-verbatim native int {v1}"
| EvalStackValue.NativeInt (NativeIntSource.Verbatim v1),
EvalStackValue.NativeInt (NativeIntSource.Verbatim v2) ->
v1 ^^^ v2 |> NativeIntSource.Verbatim |> EvalStackValue.NativeInt
| EvalStackValue.NativeInt (NativeIntSource.Verbatim _), EvalStackValue.NativeInt _ ->
failwith $"can't do binary operation on non-verbatim native int {v2}"
| EvalStackValue.NativeInt _, EvalStackValue.NativeInt (NativeIntSource.Verbatim _) ->
failwith $"can't do binary operation on non-verbatim native int {v1}"
| _, _ -> failwith $"refusing to do binary operation on {v1} and {v2}"
let state =
state
|> IlMachineState.pushToEvalStack' result currentThread
|> IlMachineState.advanceProgramCounter currentThread
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped
| Conv_I ->
let popped, state = IlMachineState.popEvalStack currentThread state
let converted = EvalStackValue.toNativeInt popped
@@ -688,7 +740,20 @@ module NullaryIlOp =
let state = state |> IlMachineState.advanceProgramCounter currentThread
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped
| Conv_U1 -> failwith "TODO: Conv_U1 unimplemented"
| Conv_U1 ->
let popped, state = IlMachineState.popEvalStack currentThread state
let converted = EvalStackValue.convToUInt8 popped
let state =
match converted with
| None -> failwith "TODO: Conv_U8 conversion failure unimplemented"
| Some conv ->
state
|> IlMachineState.pushToEvalStack' (EvalStackValue.Int32 conv) currentThread
let state = state |> IlMachineState.advanceProgramCounter currentThread
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped
| Conv_U2 -> failwith "TODO: Conv_U2 unimplemented"
| Conv_U4 -> failwith "TODO: Conv_U4 unimplemented"
| Conv_U8 ->
@@ -896,7 +961,16 @@ module NullaryIlOp =
| Ldind_u8 -> failwith "TODO: Ldind_u8 unimplemented"
| Ldind_r4 -> executeLdind LdindTargetType.LdindR4 currentThread state
| Ldind_r8 -> executeLdind LdindTargetType.LdindR8 currentThread state
| Rem -> failwith "TODO: Rem unimplemented"
| Rem ->
let val2, state = IlMachineState.popEvalStack currentThread state
let val1, state = IlMachineState.popEvalStack currentThread state
let result = BinaryArithmetic.execute ArithmeticOperation.rem state val1 val2
state
|> IlMachineState.pushToEvalStack' result currentThread
|> IlMachineState.advanceProgramCounter currentThread
|> Tuple.withRight WhatWeDid.Executed
|> ExecutionResult.Stepped
| Rem_un -> failwith "TODO: Rem_un unimplemented"
| Volatile -> failwith "TODO: Volatile unimplemented"
| Tail -> failwith "TODO: Tail unimplemented"
@@ -913,7 +987,22 @@ module NullaryIlOp =
| Conv_ovf_i -> failwith "TODO: Conv_ovf_i unimplemented"
| Conv_ovf_u -> failwith "TODO: Conv_ovf_u unimplemented"
| Neg -> failwith "TODO: Neg unimplemented"
| Not -> failwith "TODO: Not unimplemented"
| Not ->
let val1, state = IlMachineState.popEvalStack currentThread state
let result =
match val1 with
| EvalStackValue.Int32 i -> ~~~i |> EvalStackValue.Int32
| EvalStackValue.Int64 i -> ~~~i |> EvalStackValue.Int64
| EvalStackValue.ManagedPointer _
| EvalStackValue.ObjectRef _ -> failwith "refusing to negate a pointer"
| _ -> failwith "TODO"
state
|> IlMachineState.pushToEvalStack' result currentThread
|> IlMachineState.advanceProgramCounter currentThread
|> Tuple.withRight WhatWeDid.Executed
|> ExecutionResult.Stepped
| Ldind_ref ->
let addr, state = IlMachineState.popEvalStack currentThread state
@@ -924,6 +1013,7 @@ module NullaryIlOp =
let state =
match referenced with
| CliType.RuntimePointer (CliRuntimePointer.Managed _)
| CliType.ObjectRef _ -> IlMachineState.pushToEvalStack referenced currentThread state
| _ -> failwith $"Unexpected non-reference {referenced}"
|> IlMachineState.advanceProgramCounter currentThread
@@ -954,14 +1044,85 @@ module NullaryIlOp =
let state = state |> IlMachineState.advanceProgramCounter currentThread
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped
| Ldelem_i -> failwith "TODO: Ldelem_i unimplemented"
| Ldelem_i1 -> failwith "TODO: Ldelem_i1 unimplemented"
| Ldelem_i ->
let index, state = IlMachineState.popEvalStack currentThread state
let arr, state = IlMachineState.popEvalStack currentThread state
let value = getArrayElt index arr currentThread state
match value with
| CliType.Numeric (CliNumericType.NativeInt _) -> ()
| _ -> failwith "expected native int in Ldelem.i"
let state =
state
|> IlMachineState.pushToEvalStack value currentThread
|> IlMachineState.advanceProgramCounter currentThread
ExecutionResult.Stepped (state, WhatWeDid.Executed)
| Ldelem_i1 ->
let index, state = IlMachineState.popEvalStack currentThread state
let arr, state = IlMachineState.popEvalStack currentThread state
let value = getArrayElt index arr currentThread state
failwith "TODO: we got back an int8; turn it into int32"
let state =
state
|> IlMachineState.pushToEvalStack value currentThread
|> IlMachineState.advanceProgramCounter currentThread
ExecutionResult.Stepped (state, WhatWeDid.Executed)
| Ldelem_u1 -> failwith "TODO: Ldelem_u1 unimplemented"
| Ldelem_i2 -> failwith "TODO: Ldelem_i2 unimplemented"
| Ldelem_i2 ->
let index, state = IlMachineState.popEvalStack currentThread state
let arr, state = IlMachineState.popEvalStack currentThread state
let value = getArrayElt index arr currentThread state
failwith "TODO: we got back an int16; turn it into int32"
let state =
state
|> IlMachineState.pushToEvalStack value currentThread
|> IlMachineState.advanceProgramCounter currentThread
ExecutionResult.Stepped (state, WhatWeDid.Executed)
| Ldelem_u2 -> failwith "TODO: Ldelem_u2 unimplemented"
| Ldelem_i4 -> failwith "TODO: Ldelem_i4 unimplemented"
| Ldelem_i4 ->
let index, state = IlMachineState.popEvalStack currentThread state
let arr, state = IlMachineState.popEvalStack currentThread state
let value = getArrayElt index arr currentThread state
match value with
| CliType.Numeric (CliNumericType.Int32 _) -> ()
| _ -> failwith "expected int32 in Ldelem.i4"
let state =
state
|> IlMachineState.pushToEvalStack value currentThread
|> IlMachineState.advanceProgramCounter currentThread
ExecutionResult.Stepped (state, WhatWeDid.Executed)
| Ldelem_u4 -> failwith "TODO: Ldelem_u4 unimplemented"
| Ldelem_i8 -> failwith "TODO: Ldelem_i8 unimplemented"
| Ldelem_i8 ->
let index, state = IlMachineState.popEvalStack currentThread state
let arr, state = IlMachineState.popEvalStack currentThread state
let value = getArrayElt index arr currentThread state
match value with
| CliType.Numeric (CliNumericType.Int64 _) -> ()
| _ -> failwith "expected int64 in Ldelem.i8"
let state =
state
|> IlMachineState.pushToEvalStack value currentThread
|> IlMachineState.advanceProgramCounter currentThread
ExecutionResult.Stepped (state, WhatWeDid.Executed)
| Ldelem_u8 -> failwith "TODO: Ldelem_u8 unimplemented"
| Ldelem_r4 -> failwith "TODO: Ldelem_r4 unimplemented"
| Ldelem_r8 -> failwith "TODO: Ldelem_r8 unimplemented"
@@ -969,7 +1130,19 @@ module NullaryIlOp =
let index, state = IlMachineState.popEvalStack currentThread state
let arr, state = IlMachineState.popEvalStack currentThread state
ldElem index arr currentThread state
let value = getArrayElt index arr currentThread state
match value with
| CliType.ObjectRef _
| CliType.RuntimePointer _ -> ()
| _ -> failwith "expected object reference in Ldelem.ref"
let state =
state
|> IlMachineState.pushToEvalStack value currentThread
|> IlMachineState.advanceProgramCounter currentThread
ExecutionResult.Stepped (state, WhatWeDid.Executed)
| Stelem_i ->
let value, state = IlMachineState.popEvalStack currentThread state
let index, state = IlMachineState.popEvalStack currentThread state

View File

@@ -416,7 +416,55 @@ module internal UnaryMetadataIlOp =
|> IlMachineState.advanceProgramCounter thread
state, WhatWeDid.Executed
| Box -> failwith "TODO: Box unimplemented"
| Box ->
let state, ty, assy =
match metadataToken with
| MetadataToken.TypeDefinition h ->
let state, ty = IlMachineState.lookupTypeDefn baseClassTypes state activeAssy h
state, ty, activeAssy
| MetadataToken.TypeReference ref ->
IlMachineState.lookupTypeRef
loggerFactory
baseClassTypes
state
activeAssy
currentMethod.DeclaringType.Generics
ref
| MetadataToken.TypeSpecification spec -> state, activeAssy.TypeSpecs.[spec].Signature, activeAssy
| _ -> failwith $"unexpected token {metadataToken} in Box"
let state, typeHandle =
IlMachineState.concretizeType
loggerFactory
baseClassTypes
state
assy.Name
currentMethod.DeclaringType.Generics
currentMethod.Generics
ty
let toBox, state = state |> IlMachineState.popEvalStack thread
let targetType =
AllConcreteTypes.lookup typeHandle state.ConcreteTypes |> Option.get
let defn =
state._LoadedAssemblies.[targetType.Assembly.FullName].TypeDefs.[targetType.Definition.Get]
let baseType =
DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies targetType.Assembly defn.BaseType
let toPush =
match baseType with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> failwith "TODO: implement Box"
| ResolvedBaseType.Object
| ResolvedBaseType.Delegate -> toBox
state
|> IlMachineState.pushToEvalStack' toPush thread
|> IlMachineState.advanceProgramCounter thread
|> Tuple.withRight WhatWeDid.Executed
| Ldelema ->
let index, state = IlMachineState.popEvalStack thread state
let arr, state = IlMachineState.popEvalStack thread state
@@ -1376,7 +1424,70 @@ module internal UnaryMetadataIlOp =
|> IlMachineState.advanceProgramCounter thread
|> Tuple.withRight WhatWeDid.Executed
| Cpobj -> failwith "TODO: Cpobj unimplemented"
| Ldobj -> failwith "TODO: Ldobj unimplemented"
| Ldobj ->
let state, ty, assy =
match metadataToken with
| MetadataToken.TypeDefinition h ->
let state, ty = IlMachineState.lookupTypeDefn baseClassTypes state activeAssy h
state, ty, activeAssy
| MetadataToken.TypeReference ref ->
IlMachineState.lookupTypeRef
loggerFactory
baseClassTypes
state
activeAssy
currentMethod.DeclaringType.Generics
ref
| MetadataToken.TypeSpecification spec -> state, activeAssy.TypeSpecs.[spec].Signature, activeAssy
| _ -> failwith $"unexpected token {metadataToken} in Ldobj"
let state, typeHandle =
IlMachineState.concretizeType
loggerFactory
baseClassTypes
state
assy.Name
currentMethod.DeclaringType.Generics
currentMethod.Generics
ty
let addr, state = state |> IlMachineState.popEvalStack thread
let obj =
match addr with
| EvalStackValue.ObjectRef addr ->
IlMachineState.dereferencePointer state (ManagedPointerSource.Heap addr)
| EvalStackValue.ManagedPointer ptr -> IlMachineState.dereferencePointer state ptr
| EvalStackValue.Float _
| EvalStackValue.Int64 _
| EvalStackValue.Int32 _ -> failwith "refusing to interpret constant as address"
| _ -> failwith "TODO"
let targetType =
AllConcreteTypes.lookup typeHandle state.ConcreteTypes |> Option.get
let defn =
state._LoadedAssemblies.[targetType.Assembly.FullName].TypeDefs.[targetType.Definition.Get]
let baseType =
DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies targetType.Assembly defn.BaseType
let toPush =
match baseType with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType ->
failwith
$"TODO: push %O{obj} as type %s{targetType.Assembly.Name}.%s{targetType.Namespace}.%s{targetType.Name}"
| ResolvedBaseType.Object
| ResolvedBaseType.Delegate ->
// III.4.13: reference types are just copied as pointers.
// We should have received a pointer, so let's just pass it back.
obj
state
|> IlMachineState.pushToEvalStack toPush thread
|> IlMachineState.advanceProgramCounter thread
|> Tuple.withRight WhatWeDid.Executed
| Sizeof ->
let state, ty, assy =
match metadataToken with

6
flake.lock generated
View File

@@ -20,11 +20,11 @@
},
"nixpkgs": {
"locked": {
"lastModified": 1755736253,
"narHash": "sha256-jlIQRypNhB1PcB1BE+expE4xZeJxzoAGr1iUbHQta8s=",
"lastModified": 1756381814,
"narHash": "sha256-tzo7YvAsGlzo4WiIHT0ooR59VHu+aKRQdHk7sIyoia4=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "596312aae91421d6923f18cecce934a7d3bfd6b8",
"rev": "aca2499b79170038df0dbaec8bf2f689b506ad32",
"type": "github"
},
"original": {