8 Commits

Author SHA1 Message Date
Smaug123
81abd6dca2 Bump to net10 2025-09-28 20:30:25 +01:00
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
Patrick Stevens
8112b122fb Compute byte form for CliType where necessary (#123) 2025-08-29 23:19:29 +00:00
28 changed files with 1687 additions and 313 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.) - `Corelib.fs`: Core library type definitions (String, Array, etc.)
**WoofWare.PawPrint.Test** **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` - 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 - `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 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` - 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** **WoofWare.PawPrint.App**
- Entry point application for running the interpreter - Entry point application for running the interpreter

View File

@@ -1,7 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk"> <Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup> <PropertyGroup>
<TargetFramework>net9.0</TargetFramework> <TargetFramework>net10.0</TargetFramework>
<OutputType>Exe</OutputType> <OutputType>Exe</OutputType>
<AllowUnsafeBlocks>true</AllowUnsafeBlocks> <AllowUnsafeBlocks>true</AllowUnsafeBlocks>
<WarningsAsErrors>false</WarningsAsErrors> <WarningsAsErrors>false</WarningsAsErrors>

View File

@@ -1,8 +1,8 @@
<Project Sdk="Microsoft.NET.Sdk"> <Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup> <PropertyGroup>
<OutputType>Exe</OutputType> <OutputType>Exe</OutputType>
<TargetFramework>net9.0</TargetFramework> <TargetFramework>net10.0</TargetFramework>
<SelfContained>true</SelfContained> <SelfContained>true</SelfContained>
</PropertyGroup> </PropertyGroup>

View File

@@ -1,7 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk"> <Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup> <PropertyGroup>
<TargetFramework>net9.0</TargetFramework> <TargetFramework>net10.0</TargetFramework>
<OutputType>Exe</OutputType> <OutputType>Exe</OutputType>
</PropertyGroup> </PropertyGroup>

View File

@@ -337,6 +337,23 @@ module ConcreteActivePatterns =
| None -> None | None -> 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 = let (|ConcreteSingle|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) : unit option =
match handle with match handle with
| ConcreteTypeHandle.Concrete id -> | ConcreteTypeHandle.Concrete id ->

View File

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

View File

@@ -190,6 +190,18 @@ type BaseClassTypes<'corelib> =
TypedReference : TypeInfo<GenericParamFromMetadata, TypeDefn> TypedReference : TypeInfo<GenericParamFromMetadata, TypeDefn>
IntPtr : TypeInfo<GenericParamFromMetadata, TypeDefn> IntPtr : TypeInfo<GenericParamFromMetadata, TypeDefn>
UIntPtr : 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>] [<RequireQualifiedAccess>]

View File

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

View File

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

View File

@@ -1,5 +1,6 @@
namespace WoofWare.Pawprint.Test namespace WoofWare.Pawprint.Test
open System
open System.Collections.Immutable open System.Collections.Immutable
open System.IO open System.IO
open FsUnitTyped open FsUnitTyped
@@ -16,166 +17,65 @@ module TestPureCases =
let unimplemented = let unimplemented =
[ [
{ "CrossAssemblyTypes.cs"
FileName = "CrossAssemblyTypes.cs" "OverlappingStructs.cs"
ExpectedReturnCode = 0 "AdvancedStructLayout.cs"
NativeImpls = MockEnv.make () "InitializeArray.cs"
} "Threads.cs"
{ "ComplexTryCatch.cs"
FileName = "OverlappingStructs.cs" "ResizeArray.cs"
ExpectedReturnCode = 0 "LdtokenField.cs"
NativeImpls = MockEnv.make () "GenericEdgeCases.cs"
} "UnsafeAs.cs"
{
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 ()
}
] ]
|> Set.ofList
let requiresMocks =
let empty = MockEnv.make ()
let cases : EndToEndTestCase list =
[ [
{ "BasicLock.cs",
FileName = "NoOp.cs" (1,
ExpectedReturnCode = 1 { empty with
NativeImpls = MockEnv.make () System_Threading_Monitor = System_Threading_Monitor.passThru
} })
{
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 ()
}
] ]
|> 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 runTest (case : EndToEndTestCase) : unit =
let source = Assembly.getEmbeddedResourceAsString case.FileName assy let source = Assembly.getEmbeddedResourceAsString case.FileName assy
@@ -210,9 +110,43 @@ module TestPureCases =
reraise () 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)>] [<TestCaseSource(nameof unimplemented)>]
[<Explicit>] [<Explicit>]
let ``Can evaluate C# files, unimplemented`` (case : EndToEndTestCase) = runTest case let ``Can evaluate C# files, unimplemented`` (fileName : string) =
{
[<TestCaseSource(nameof cases)>] FileName = fileName
let ``Can evaluate C# files`` (case : EndToEndTestCase) = runTest case ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
|> runTest

View File

@@ -1,7 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk"> <Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup> <PropertyGroup>
<TargetFramework>net9.0</TargetFramework> <TargetFramework>net10.0</TargetFramework>
<IsPackable>false</IsPackable> <IsPackable>false</IsPackable>
<OutputType>Exe</OutputType> <OutputType>Exe</OutputType>
</PropertyGroup> </PropertyGroup>

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

@@ -42,7 +42,7 @@ module AbstractMachine =
| Some { | Some {
WasConstructingObj = Some _ WasConstructingObj = Some _
} -> } ->
IlMachineState.executeDelegateConstructor instruction state IlMachineState.executeDelegateConstructor baseClassTypes instruction state
// can't advance the program counter here - there's no IL instructions executing! // can't advance the program counter here - there's no IL instructions executing!
|> IlMachineState.returnStackFrame loggerFactory baseClassTypes thread |> IlMachineState.returnStackFrame loggerFactory baseClassTypes thread
|> Option.get |> Option.get

View File

@@ -1,5 +1,6 @@
namespace WoofWare.PawPrint namespace WoofWare.PawPrint
open System
open System.Collections.Immutable open System.Collections.Immutable
open System.Reflection open System.Reflection
open Checked open Checked
@@ -134,6 +135,28 @@ type CliNumericType =
| CliNumericType.Float32 _ -> 4 | CliNumericType.Float32 _ -> 4
| CliNumericType.Float64 _ -> 8 | CliNumericType.Float64 _ -> 8
static member ToBytes (t : CliNumericType) : byte[] =
match t with
| CliNumericType.Int32 i -> BitConverter.GetBytes i
| CliNumericType.Int64 i -> BitConverter.GetBytes i
| CliNumericType.NativeInt src ->
match src with
| NativeIntSource.Verbatim i -> BitConverter.GetBytes i
| NativeIntSource.ManagedPointer src ->
match src with
| ManagedPointerSource.Null -> BitConverter.GetBytes 0L
| _ -> failwith "refusing to express pointer as bytes"
| NativeIntSource.FieldHandlePtr _ -> failwith "refusing to express FieldHandlePtr as bytes"
| NativeIntSource.FunctionPointer _ -> failwith "refusing to express FunctionPointer as bytes"
| NativeIntSource.TypeHandlePtr _ -> failwith "refusing to express TypeHandlePtr as bytes"
| CliNumericType.NativeFloat f -> BitConverter.GetBytes f
| CliNumericType.Int8 i -> BitConverter.GetBytes i
| CliNumericType.Int16 i -> BitConverter.GetBytes i
| CliNumericType.UInt8 i -> BitConverter.GetBytes i
| CliNumericType.UInt16 i -> BitConverter.GetBytes i
| CliNumericType.Float32 i -> BitConverter.GetBytes i
| CliNumericType.Float64 i -> BitConverter.GetBytes i
type CliRuntimePointer = type CliRuntimePointer =
| Verbatim of int64 | Verbatim of int64
| FieldRegistryHandle of int64 | FieldRegistryHandle of int64
@@ -192,30 +215,46 @@ type CliType =
} }
| CliType.ValueType vt -> CliValueType.SizeOf vt | CliType.ValueType vt -> CliValueType.SizeOf vt
static member ToBytes (t : CliType) : byte[] =
match t with
| CliType.Numeric n -> CliNumericType.ToBytes n
| CliType.Bool b -> [| b |]
| CliType.Char (high, low) -> [| low ; high |]
| CliType.ObjectRef None -> Array.zeroCreate NATIVE_INT_SIZE
| CliType.ObjectRef (Some i) -> failwith "todo"
| CliType.RuntimePointer cliRuntimePointer -> failwith "todo"
| CliType.ValueType cvt -> CliValueType.ToBytes cvt
static member OfBytesAsType (targetType : ConcreteTypeHandle) (bytes : byte[]) : CliType = failwith "TODO"
and CliField = and CliField =
{ {
Name : string Name : string
Contents : CliType Contents : CliType
/// "None" for "no explicit offset specified"; we expect most offsets to be None. /// "None" for "no explicit offset specified"; we expect most offsets to be None.
Offset : int option Offset : int option
Type : ConcreteTypeHandle
} }
and private CliConcreteField = and CliConcreteField =
{ private
Name : string {
Contents : CliType Name : string
Offset : int Contents : CliType
Size : int Offset : int
Alignment : int Size : int
ConfiguredOffset : int option Alignment : int
EditedAtTime : uint64 ConfiguredOffset : int option
} EditedAtTime : uint64
Type : ConcreteTypeHandle
}
static member ToCliField (this : CliConcreteField) : CliField = static member ToCliField (this : CliConcreteField) : CliField =
{ {
Offset = this.ConfiguredOffset Offset = this.ConfiguredOffset
Contents = this.Contents Contents = this.Contents
Name = this.Name Name = this.Name
Type = this.Type
} }
and CliValueType = and CliValueType =
@@ -265,6 +304,7 @@ and CliValueType =
Alignment = size.Alignment Alignment = size.Alignment
ConfiguredOffset = field.Offset ConfiguredOffset = field.Offset
EditedAtTime = 0UL EditedAtTime = 0UL
Type = field.Type
} }
alignedOffset + size.Size, concreteField :: acc alignedOffset + size.Size, concreteField :: acc
@@ -286,11 +326,26 @@ and CliValueType =
Alignment = size.Alignment Alignment = size.Alignment
ConfiguredOffset = field.Offset ConfiguredOffset = field.Offset
EditedAtTime = 0UL EditedAtTime = 0UL
Type = field.Type
} }
) )
| _ :: _, _ :: _ -> failwith "unexpectedly mixed explicit and automatic layout of fields" | _ :: _, _ :: _ -> failwith "unexpectedly mixed explicit and automatic layout of fields"
static member ToBytes (cvt : CliValueType) : byte[] =
let bytes = Array.zeroCreate<byte> (CliValueType.SizeOf(cvt).Size)
cvt._Fields
|> List.sortBy _.EditedAtTime
|> List.iter (fun candidateField ->
let fieldBytes : byte[] = CliType.ToBytes candidateField.Contents
for i = 0 to candidateField.Size - 1 do
bytes.[candidateField.Offset + i] <- fieldBytes.[i]
)
bytes
static member OfFields (layout : Layout) (f : CliField list) : CliValueType = static member OfFields (layout : Layout) (f : CliField list) : CliValueType =
let fields = CliValueType.ComputeConcreteFields layout f let fields = CliValueType.ComputeConcreteFields layout f
@@ -318,6 +373,7 @@ and CliValueType =
match vt.Layout with match vt.Layout with
| Layout.Default -> None | Layout.Default -> None
| Layout.Custom _ -> Some cf.Offset | Layout.Custom _ -> Some cf.Offset
Type = cf.Type
} }
)) ))
@@ -341,7 +397,16 @@ and CliValueType =
NextTimestamp = vt.NextTimestamp + 1UL NextTimestamp = vt.NextTimestamp + 1UL
} }
// TODO: rewrite this so that it takes a CliConcreteField. /// Returns the offset and size.
static member GetFieldLayout (field : string) (cvt : CliValueType) : int * int =
let targetField =
cvt._Fields
|> List.tryFind (fun f -> f.Name = field)
|> Option.defaultWith (fun () -> failwithf $"Field '%s{field}' not found")
targetField.Offset, targetField.Size
// TODO: use DereferenceFieldAt for the implementation.
// We should eventually be able to dereference an arbitrary field of a struct // We should eventually be able to dereference an arbitrary field of a struct
// as though it were any other field of any other type, to accommodate Unsafe.As. // as though it were any other field of any other type, to accommodate Unsafe.As.
static member DereferenceField (field : string) (cvt : CliValueType) : CliType = static member DereferenceField (field : string) (cvt : CliValueType) : CliType =
@@ -366,11 +431,20 @@ and CliValueType =
match affectedFields with match affectedFields with
| [] -> failwith "unexpectedly didn't dereference a field" | [] -> failwith "unexpectedly didn't dereference a field"
| [ f ] -> f.Contents | [ f ] -> f.Contents
| _ -> failwith "TODO: dereference overlapping fields" | fields ->
let bytes = CliValueType.ToBytes cvt
let fieldBytes =
bytes.[targetField.Offset .. targetField.Offset + targetField.Size - 1]
CliType.OfBytesAsType targetField.Type fieldBytes
static member FieldsAt (offset : int) (cvt : CliValueType) : CliConcreteField list =
cvt._Fields |> List.filter (fun f -> f.Offset = offset)
static member DereferenceFieldAt (offset : int) (size : int) (cvt : CliValueType) : CliType = static member DereferenceFieldAt (offset : int) (size : int) (cvt : CliValueType) : CliType =
let targetField = let targetField =
cvt._Fields |> List.tryFind (fun f -> f.Offset = offset && f.Size = size) CliValueType.FieldsAt offset cvt |> List.tryFind (fun f -> f.Size = size)
match targetField with match targetField with
| None -> failwith "TODO: couldn't find the field" | None -> failwith "TODO: couldn't find the field"
@@ -470,7 +544,12 @@ module CliType =
let sizeOf (ty : CliType) : int = CliType.SizeOf(ty).Size let sizeOf (ty : CliType) : int = CliType.SizeOf(ty).Size
let zeroOfPrimitive (primitiveType : PrimitiveType) : CliType = let zeroOfPrimitive
(concreteTypes : AllConcreteTypes)
(corelib : BaseClassTypes<DumpedAssembly>)
(primitiveType : PrimitiveType)
: CliType
=
match primitiveType with match primitiveType with
| PrimitiveType.Boolean -> CliType.Bool 0uy | PrimitiveType.Boolean -> CliType.Bool 0uy
| PrimitiveType.Char -> CliType.Char (0uy, 0uy) | PrimitiveType.Char -> CliType.Char (0uy, 0uy)
@@ -493,8 +572,16 @@ module CliType =
| PrimitiveType.IntPtr -> | PrimitiveType.IntPtr ->
{ {
Name = "_value" Name = "_value"
Contents = CliType.RuntimePointer (CliRuntimePointer.Managed ManagedPointerSource.Null) Contents =
CliType.Numeric (
CliNumericType.NativeInt (NativeIntSource.ManagedPointer ManagedPointerSource.Null)
)
Offset = None Offset = None
Type =
AllConcreteTypes.findExistingConcreteType
concreteTypes
(corelib.IntPtr.Assembly, corelib.IntPtr.Namespace, corelib.IntPtr.Name, ImmutableArray.Empty)
|> Option.get
} }
|> List.singleton |> List.singleton
|> CliValueType.OfFields Layout.Default |> CliValueType.OfFields Layout.Default
@@ -502,8 +589,16 @@ module CliType =
| PrimitiveType.UIntPtr -> | PrimitiveType.UIntPtr ->
{ {
Name = "_value" Name = "_value"
Contents = CliType.RuntimePointer (CliRuntimePointer.Managed ManagedPointerSource.Null) Contents =
CliType.Numeric (
CliNumericType.NativeInt (NativeIntSource.ManagedPointer ManagedPointerSource.Null)
)
Offset = None Offset = None
Type =
AllConcreteTypes.findExistingConcreteType
concreteTypes
(corelib.UIntPtr.Assembly, corelib.UIntPtr.Namespace, corelib.UIntPtr.Name, ImmutableArray.Empty)
|> Option.get
} }
|> List.singleton |> List.singleton
|> CliValueType.OfFields Layout.Default |> CliValueType.OfFields Layout.Default
@@ -556,37 +651,37 @@ module CliType =
then then
// Check against known primitive types // Check against known primitive types
if TypeInfo.NominallyEqual typeDef corelib.Boolean then if TypeInfo.NominallyEqual typeDef corelib.Boolean then
zeroOfPrimitive PrimitiveType.Boolean, concreteTypes zeroOfPrimitive concreteTypes corelib PrimitiveType.Boolean, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.Char then elif TypeInfo.NominallyEqual typeDef corelib.Char then
zeroOfPrimitive PrimitiveType.Char, concreteTypes zeroOfPrimitive concreteTypes corelib PrimitiveType.Char, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.SByte then elif TypeInfo.NominallyEqual typeDef corelib.SByte then
zeroOfPrimitive PrimitiveType.SByte, concreteTypes zeroOfPrimitive concreteTypes corelib PrimitiveType.SByte, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.Byte then elif TypeInfo.NominallyEqual typeDef corelib.Byte then
zeroOfPrimitive PrimitiveType.Byte, concreteTypes zeroOfPrimitive concreteTypes corelib PrimitiveType.Byte, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.Int16 then elif TypeInfo.NominallyEqual typeDef corelib.Int16 then
zeroOfPrimitive PrimitiveType.Int16, concreteTypes zeroOfPrimitive concreteTypes corelib PrimitiveType.Int16, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.UInt16 then elif TypeInfo.NominallyEqual typeDef corelib.UInt16 then
zeroOfPrimitive PrimitiveType.UInt16, concreteTypes zeroOfPrimitive concreteTypes corelib PrimitiveType.UInt16, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.Int32 then elif TypeInfo.NominallyEqual typeDef corelib.Int32 then
zeroOfPrimitive PrimitiveType.Int32, concreteTypes zeroOfPrimitive concreteTypes corelib PrimitiveType.Int32, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.UInt32 then elif TypeInfo.NominallyEqual typeDef corelib.UInt32 then
zeroOfPrimitive PrimitiveType.UInt32, concreteTypes zeroOfPrimitive concreteTypes corelib PrimitiveType.UInt32, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.Int64 then elif TypeInfo.NominallyEqual typeDef corelib.Int64 then
zeroOfPrimitive PrimitiveType.Int64, concreteTypes zeroOfPrimitive concreteTypes corelib PrimitiveType.Int64, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.UInt64 then elif TypeInfo.NominallyEqual typeDef corelib.UInt64 then
zeroOfPrimitive PrimitiveType.UInt64, concreteTypes zeroOfPrimitive concreteTypes corelib PrimitiveType.UInt64, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.Single then elif TypeInfo.NominallyEqual typeDef corelib.Single then
zeroOfPrimitive PrimitiveType.Single, concreteTypes zeroOfPrimitive concreteTypes corelib PrimitiveType.Single, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.Double then elif TypeInfo.NominallyEqual typeDef corelib.Double then
zeroOfPrimitive PrimitiveType.Double, concreteTypes zeroOfPrimitive concreteTypes corelib PrimitiveType.Double, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.String then elif TypeInfo.NominallyEqual typeDef corelib.String then
zeroOfPrimitive PrimitiveType.String, concreteTypes zeroOfPrimitive concreteTypes corelib PrimitiveType.String, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.Object then elif TypeInfo.NominallyEqual typeDef corelib.Object then
zeroOfPrimitive PrimitiveType.Object, concreteTypes zeroOfPrimitive concreteTypes corelib PrimitiveType.Object, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.IntPtr then elif TypeInfo.NominallyEqual typeDef corelib.IntPtr then
zeroOfPrimitive PrimitiveType.IntPtr, concreteTypes zeroOfPrimitive concreteTypes corelib PrimitiveType.IntPtr, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.UIntPtr then elif TypeInfo.NominallyEqual typeDef corelib.UIntPtr then
zeroOfPrimitive PrimitiveType.UIntPtr, concreteTypes zeroOfPrimitive concreteTypes corelib PrimitiveType.UIntPtr, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.Array then elif TypeInfo.NominallyEqual typeDef corelib.Array then
// Arrays are reference types // Arrays are reference types
CliType.ObjectRef None, concreteTypes CliType.ObjectRef None, concreteTypes
@@ -676,6 +771,7 @@ module CliType =
Name = field.Name Name = field.Name
Contents = fieldZero Contents = fieldZero
Offset = field.Offset Offset = field.Offset
Type = fieldHandle
} }
) )
|> CliValueType.OfFields typeDef.Layout |> CliValueType.OfFields typeDef.Layout
@@ -751,3 +847,23 @@ module CliType =
| CliType.ObjectRef managedHeapAddressOption -> failwith "todo" | CliType.ObjectRef managedHeapAddressOption -> failwith "todo"
| CliType.RuntimePointer cliRuntimePointer -> failwith "todo" | CliType.RuntimePointer cliRuntimePointer -> failwith "todo"
| CliType.ValueType cvt -> CliValueType.DereferenceField field cvt | CliType.ValueType cvt -> CliValueType.DereferenceField field cvt
/// Returns the offset and size.
let getFieldLayout (field : string) (value : CliType) : int * int =
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 -> CliValueType.GetFieldLayout field cvt
/// Returns None if there isn't *exactly* one field that starts there. This rules out some valid programs.
let getFieldAt (offset : int) (value : CliType) : CliConcreteField option =
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 -> CliValueType.FieldsAt offset cvt |> List.tryExactlyOne

View File

@@ -4,28 +4,133 @@ namespace WoofWare.PawPrint
type IArithmeticOperation = type IArithmeticOperation =
abstract Int32Int32 : int32 -> int32 -> int32 abstract Int32Int32 : int32 -> int32 -> int32
abstract Int32NativeInt : int32 -> nativeint -> nativeint
abstract NativeIntInt32 : nativeint -> int32 -> nativeint
abstract Int64Int64 : int64 -> int64 -> int64 abstract Int64Int64 : int64 -> int64 -> int64
abstract FloatFloat : float -> float -> float abstract FloatFloat : float -> float -> float
abstract NativeIntNativeInt : nativeint -> nativeint -> nativeint 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>
abstract Name : string abstract Name : string
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module ArithmeticOperation = 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 = let add =
{ new IArithmeticOperation with { new IArithmeticOperation with
member _.Int32Int32 a b = (# "add" a b : int32 #) member _.Int32Int32 a b = (# "add" a b : int32 #)
member _.Int64Int64 a b = (# "add" a b : int64 #) member _.Int64Int64 a b = (# "add" a b : int64 #)
member _.FloatFloat a b = (# "add" a b : float #) member _.FloatFloat a b = (# "add" a b : float #)
member _.NativeIntNativeInt a b = (# "add" a b : nativeint #) member _.NativeIntNativeInt a b = (# "add" a b : nativeint #)
member _.Int32NativeInt a b = (# "add" a b : nativeint #)
member _.NativeIntInt32 a b = (# "add" 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" 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 = let sub =
{ new IArithmeticOperation with { new IArithmeticOperation with
member _.Int32Int32 a b = (# "sub" a b : int32 #) member _.Int32Int32 a b = (# "sub" a b : int32 #)
member _.Int64Int64 a b = (# "sub" a b : int64 #) member _.Int64Int64 a b = (# "sub" a b : int64 #)
member _.FloatFloat a b = (# "sub" a b : float #) member _.FloatFloat a b = (# "sub" a b : float #)
member _.NativeIntNativeInt a b = (# "sub" a b : nativeint #) member _.NativeIntNativeInt a b = (# "sub" a b : nativeint #)
member _.Int32NativeInt a b = (# "sub" a b : nativeint #)
member _.NativeIntInt32 a b = (# "sub" a b : nativeint #)
member _.ManagedPtrManagedPtr state ptr1 ptr2 =
match ptr1, ptr2 with
| ptr1, ManagedPointerSource.Null -> Choice1Of2 ptr1
| ManagedPointerSource.Null, _ -> failwith "refusing to create negative pointer"
| ManagedPointerSource.ArrayIndex (arr1, index1), ManagedPointerSource.ArrayIndex (arr2, index2) ->
if arr1 <> arr2 then
failwith "refusing to operate on pointers to different arrays"
(index1 - index2) |> nativeint |> Choice2Of2
| ManagedPointerSource.ArrayIndex _, _ -> failwith $"refusing to operate on array index ptr vs %O{ptr2}"
| ManagedPointerSource.Argument _, _
| _, ManagedPointerSource.Argument _ ->
failwith $"refusing to operate on pointers to arguments: %O{ptr1} and %O{ptr2}"
| ManagedPointerSource.Field (obj1, fieldName1), ManagedPointerSource.Field (obj2, fieldName2) ->
if obj1 <> obj2 then
failwith "refusing to operate on field pointers in different objects"
let obj = IlMachineState.dereferencePointer state obj1
let offset1, _ = CliType.getFieldLayout fieldName1 obj
let offset2, _ = CliType.getFieldLayout fieldName2 obj
(offset1 - offset2) |> nativeint |> Choice2Of2
| _, _ -> failwith "TODO"
member _.Int32ManagedPtr state val1 ptr2 =
match ptr2 with
| ManagedPointerSource.Null -> Choice2Of2 val1
| _ -> failwith "refusing to subtract a pointer"
member _.ManagedPtrInt32 state ptr1 val2 = failwith "TODO: subtract from pointer"
member _.Name = "sub" member _.Name = "sub"
} }
@@ -35,6 +140,36 @@ module ArithmeticOperation =
member _.Int64Int64 a b = (# "mul" a b : int64 #) member _.Int64Int64 a b = (# "mul" a b : int64 #)
member _.FloatFloat a b = (# "mul" a b : float #) member _.FloatFloat a b = (# "mul" a b : float #)
member _.NativeIntNativeInt a b = (# "mul" a b : nativeint #) member _.NativeIntNativeInt a b = (# "mul" a b : nativeint #)
member _.Int32NativeInt a b = (# "mul" a b : nativeint #)
member _.NativeIntInt32 a b = (# "mul" a b : nativeint #)
member _.ManagedPtrManagedPtr _ ptr1 ptr2 =
match ptr1, ptr2 with
| ManagedPointerSource.Null, _ -> Choice2Of2 (nativeint 0)
| _, ManagedPointerSource.Null -> Choice2Of2 (nativeint 0)
| _, _ -> failwith "refusing to multiply two managed pointers"
member _.Int32ManagedPtr state a ptr = mulInt32ManagedPtr state a ptr
member _.ManagedPtrInt32 state ptr a = mulInt32ManagedPtr state a ptr
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" member _.Name = "mul"
} }
@@ -44,30 +179,98 @@ module ArithmeticOperation =
member _.Int64Int64 a b = (# "mul.ovf" a b : int64 #) member _.Int64Int64 a b = (# "mul.ovf" a b : int64 #)
member _.FloatFloat a b = (# "mul.ovf" a b : float #) member _.FloatFloat a b = (# "mul.ovf" a b : float #)
member _.NativeIntNativeInt a b = (# "mul.ovf" a b : nativeint #) member _.NativeIntNativeInt a b = (# "mul.ovf" a b : nativeint #)
member _.Int32NativeInt a b = (# "mul.ovf" a b : nativeint #)
member _.NativeIntInt32 a b = (# "mul.ovf" a b : nativeint #)
member _.ManagedPtrManagedPtr _ ptr1 ptr2 =
match ptr1, ptr2 with
| ManagedPointerSource.Null, _ -> Choice2Of2 (nativeint 0)
| _, ManagedPointerSource.Null -> Choice2Of2 (nativeint 0)
| _, _ -> failwith "refusing to multiply two managed pointers"
member _.Int32ManagedPtr state a ptr = mulInt32ManagedPtr state a ptr
member _.ManagedPtrInt32 state a ptr = mulInt32ManagedPtr state ptr a
member _.Name = "mul_ovf" member _.Name = "mul_ovf"
} }
let div =
{ new IArithmeticOperation with
member _.Int32Int32 a b = (# "div" a b : int32 #)
member _.Int64Int64 a b = (# "div" a b : int64 #)
member _.FloatFloat a b = (# "div" a b : float #)
member _.NativeIntNativeInt a b = (# "div" a b : nativeint #)
member _.Int32NativeInt a b = (# "div" a b : nativeint #)
member _.NativeIntInt32 a b = (# "div" a b : nativeint #)
member _.ManagedPtrManagedPtr _ ptr1 ptr2 =
match ptr1, ptr2 with
| ManagedPointerSource.Null, _ -> Choice2Of2 (nativeint 0)
| _, _ -> failwith "refusing to divide two managed pointers"
member _.Int32ManagedPtr _ a ptr =
if a = 0 then
Choice2Of2 0
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"
}
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module BinaryArithmetic = module BinaryArithmetic =
let execute (op : IArithmeticOperation) (val1 : EvalStackValue) (val2 : EvalStackValue) : EvalStackValue = let execute
(op : IArithmeticOperation)
(state : IlMachineState)
(val1 : EvalStackValue)
(val2 : EvalStackValue)
: EvalStackValue
=
// see table at https://learn.microsoft.com/en-us/dotnet/api/system.reflection.emit.opcodes.add?view=net-9.0 // see table at https://learn.microsoft.com/en-us/dotnet/api/system.reflection.emit.opcodes.add?view=net-9.0
match val1, val2 with match val1, val2 with
| EvalStackValue.Int32 val1, EvalStackValue.Int32 val2 -> op.Int32Int32 val1 val2 |> EvalStackValue.Int32 | EvalStackValue.Int32 val1, EvalStackValue.Int32 val2 -> op.Int32Int32 val1 val2 |> EvalStackValue.Int32
| EvalStackValue.Int32 val1, EvalStackValue.NativeInt val2 -> failwith "" |> EvalStackValue.NativeInt | EvalStackValue.Int32 val1, EvalStackValue.NativeInt val2 ->
| EvalStackValue.Int32 val1, EvalStackValue.ManagedPointer val2 -> failwith "" |> EvalStackValue.ManagedPointer let val2 =
match val2 with
| NativeIntSource.Verbatim n -> nativeint<int64> n
| v -> failwith $"refusing to operate on non-verbatim native int %O{v}"
op.Int32NativeInt val1 val2
|> int64<nativeint>
|> NativeIntSource.Verbatim
|> EvalStackValue.NativeInt
| EvalStackValue.Int32 val1, EvalStackValue.ManagedPointer val2 ->
match op.Int32ManagedPtr state val1 val2 with
| Choice1Of2 v -> EvalStackValue.ManagedPointer v
| Choice2Of2 i -> EvalStackValue.Int32 i
| EvalStackValue.Int32 val1, EvalStackValue.ObjectRef val2 -> failwith "" |> EvalStackValue.ObjectRef | EvalStackValue.Int32 val1, EvalStackValue.ObjectRef val2 -> failwith "" |> EvalStackValue.ObjectRef
| EvalStackValue.Int64 val1, EvalStackValue.Int64 val2 -> op.Int64Int64 val1 val2 |> EvalStackValue.Int64 | EvalStackValue.Int64 val1, EvalStackValue.Int64 val2 -> op.Int64Int64 val1 val2 |> EvalStackValue.Int64
| EvalStackValue.NativeInt val1, EvalStackValue.Int32 val2 -> failwith "" |> EvalStackValue.NativeInt | EvalStackValue.NativeInt val1, EvalStackValue.Int32 val2 ->
let val1 =
match val1 with
| NativeIntSource.Verbatim n -> nativeint<int64> n
| v -> failwith $"refusing to operate on non-verbatim native int %O{v}"
op.NativeIntInt32 val1 val2
|> int64<nativeint>
|> NativeIntSource.Verbatim
|> EvalStackValue.NativeInt
| EvalStackValue.NativeInt val1, EvalStackValue.NativeInt val2 -> | EvalStackValue.NativeInt val1, EvalStackValue.NativeInt val2 ->
let val1 = let val1 =
match val1 with match val1 with
| NativeIntSource.Verbatim n -> nativeint<int64> n | NativeIntSource.Verbatim n -> nativeint<int64> n
| v -> failwith $"refusing to multiply non-verbatim native int %O{v}" | v -> failwith $"refusing to operate on non-verbatim native int %O{v}"
let val2 = let val2 =
match val2 with match val2 with
| NativeIntSource.Verbatim n -> nativeint<int64> n | NativeIntSource.Verbatim n -> nativeint<int64> n
| v -> failwith $"refusing to multiply non-verbatim native int %O{v}" | v -> failwith $"refusing to operate on non-verbatim native int %O{v}"
op.NativeIntNativeInt val1 val2 op.NativeIntNativeInt val1 val2
|> int64<nativeint> |> int64<nativeint>
@@ -80,6 +283,13 @@ module BinaryArithmetic =
| EvalStackValue.ManagedPointer val1, EvalStackValue.NativeInt val2 -> | EvalStackValue.ManagedPointer val1, EvalStackValue.NativeInt val2 ->
failwith "" |> EvalStackValue.ManagedPointer failwith "" |> EvalStackValue.ManagedPointer
| EvalStackValue.ObjectRef val1, EvalStackValue.NativeInt val2 -> failwith "" |> EvalStackValue.ObjectRef | 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.ObjectRef val1, EvalStackValue.Int32 val2 -> failwith "" |> EvalStackValue.ObjectRef
| EvalStackValue.ManagedPointer val1, EvalStackValue.ManagedPointer val2 ->
match op.ManagedPtrManagedPtr state val1 val2 with
| Choice1Of2 result -> EvalStackValue.ManagedPointer result
| Choice2Of2 result -> EvalStackValue.NativeInt (NativeIntSource.Verbatim (int64<nativeint> result))
| val1, val2 -> failwith $"invalid %s{op.Name} operation: {val1} and {val2}" | val1, val2 -> failwith $"invalid %s{op.Name} operation: {val1} and {val2}"

View File

@@ -152,6 +152,66 @@ module Corelib =
) )
|> Seq.exactlyOne |> 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 Corelib = corelib
String = stringType String = stringType
@@ -182,6 +242,18 @@ module Corelib =
TypedReference = typedReferenceType TypedReference = typedReferenceType
IntPtr = intPtrType IntPtr = intPtrType
UIntPtr = uintPtrType 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 let concretizeAll

View File

@@ -1,5 +1,7 @@
namespace WoofWare.PawPrint namespace WoofWare.PawPrint
#nowarn "42"
/// See I.12.3.2.1 for definition /// See I.12.3.2.1 for definition
type EvalStackValue = type EvalStackValue =
| Int32 of int32 | Int32 of int32
@@ -76,7 +78,14 @@ module EvalStackValue =
match value with match value with
| EvalStackValue.Int32 i -> Some (int64<int> i) | EvalStackValue.Int32 i -> Some (int64<int> i)
| EvalStackValue.Int64 i -> Some i | EvalStackValue.Int64 i -> Some i
| EvalStackValue.NativeInt nativeIntSource -> failwith "todo" | EvalStackValue.NativeInt src ->
match src with
| NativeIntSource.Verbatim int64 -> Some int64
| NativeIntSource.ManagedPointer ManagedPointerSource.Null -> Some 0L
| NativeIntSource.ManagedPointer _
| NativeIntSource.FunctionPointer _
| NativeIntSource.TypeHandlePtr _
| NativeIntSource.FieldHandlePtr _ -> failwith "refusing to convert pointer to int64"
| EvalStackValue.Float f -> failwith "todo" | EvalStackValue.Float f -> failwith "todo"
| EvalStackValue.ManagedPointer managedPointerSource -> failwith "todo" | EvalStackValue.ManagedPointer managedPointerSource -> failwith "todo"
| EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo" | EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo"
@@ -93,6 +102,21 @@ module EvalStackValue =
| EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo" | EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo"
| EvalStackValue.UserDefinedValueType evalStackValues -> 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 = let rec ofCliType (v : CliType) : EvalStackValue =
match v with match v with
| CliType.Numeric numeric -> | CliType.Numeric numeric ->
@@ -281,6 +305,7 @@ module EvalStackValue =
CliField.Name = field1.Name CliField.Name = field1.Name
Contents = contents Contents = contents
Offset = field1.Offset Offset = field1.Offset
Type = field1.Type
} }
) )
|> CliValueType.OfFields popped'.Layout |> CliValueType.OfFields popped'.Layout

View File

@@ -1,5 +1,6 @@
namespace WoofWare.PawPrint namespace WoofWare.PawPrint
open System.Collections.Immutable
open System.Reflection open System.Reflection
open System.Reflection.Metadata open System.Reflection.Metadata
@@ -33,6 +34,7 @@ module FieldHandleRegistry =
/// Returns a (struct) System.RuntimeFieldHandle, with its contents (reference type) freshly allocated if necessary. /// Returns a (struct) System.RuntimeFieldHandle, with its contents (reference type) freshly allocated if necessary.
let getOrAllocate let getOrAllocate
(baseClassTypes : BaseClassTypes<'corelib>) (baseClassTypes : BaseClassTypes<'corelib>)
(allConcreteTypes : AllConcreteTypes)
(allocState : 'allocState) (allocState : 'allocState)
(allocate : CliValueType -> 'allocState -> ManagedHeapAddress * 'allocState) (allocate : CliValueType -> 'allocState -> ManagedHeapAddress * 'allocState)
(declaringAssy : AssemblyName) (declaringAssy : AssemblyName)
@@ -57,6 +59,14 @@ module FieldHandleRegistry =
Name = "m_ptr" Name = "m_ptr"
Contents = CliType.ofManagedObject runtimeFieldInfoStub Contents = CliType.ofManagedObject runtimeFieldInfoStub
Offset = None Offset = None
Type =
AllConcreteTypes.findExistingConcreteType
allConcreteTypes
(baseClassTypes.RuntimeFieldInfoStub.Assembly,
baseClassTypes.RuntimeFieldInfoStub.Namespace,
baseClassTypes.RuntimeFieldInfoStub.Name,
ImmutableArray.Empty)
|> Option.get
} }
|> List.singleton |> List.singleton
|> CliValueType.OfFields Layout.Default |> CliValueType.OfFields Layout.Default
@@ -90,6 +100,14 @@ module FieldHandleRegistry =
Name = "m_handle" Name = "m_handle"
Contents = CliType.RuntimePointer (CliRuntimePointer.FieldRegistryHandle newHandle) Contents = CliType.RuntimePointer (CliRuntimePointer.FieldRegistryHandle newHandle)
Offset = None // no struct layout was specified Offset = None // no struct layout was specified
Type =
AllConcreteTypes.findExistingConcreteType
allConcreteTypes
(baseClassTypes.IntPtr.Assembly,
baseClassTypes.IntPtr.Namespace,
baseClassTypes.IntPtr.Name,
ImmutableArray.Empty)
|> Option.get
} }
|> List.singleton |> List.singleton
|> CliValueType.OfFields Layout.Default |> CliValueType.OfFields Layout.Default
@@ -97,6 +115,24 @@ module FieldHandleRegistry =
// https://github.com/dotnet/runtime/blob/1d1bf92fcf43aa6981804dc53c5174445069c9e4/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L1074 // https://github.com/dotnet/runtime/blob/1d1bf92fcf43aa6981804dc53c5174445069c9e4/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L1074
let runtimeFieldInfoStub = let runtimeFieldInfoStub =
let objType =
AllConcreteTypes.findExistingConcreteType
allConcreteTypes
(baseClassTypes.Object.Assembly,
baseClassTypes.Object.Namespace,
baseClassTypes.Object.Name,
ImmutableArray.Empty)
|> Option.get
let intType =
AllConcreteTypes.findExistingConcreteType
allConcreteTypes
(baseClassTypes.Int32.Assembly,
baseClassTypes.Int32.Namespace,
baseClassTypes.Int32.Name,
ImmutableArray.Empty)
|> Option.get
// LayoutKind.Sequential // LayoutKind.Sequential
[ [
// If we ever implement a GC, something should change here // If we ever implement a GC, something should change here
@@ -104,32 +140,45 @@ module FieldHandleRegistry =
Name = "m_keepalive" Name = "m_keepalive"
Contents = CliType.ObjectRef None Contents = CliType.ObjectRef None
Offset = None Offset = None
Type = objType
} }
{ {
Name = "m_c" Name = "m_c"
Contents = CliType.ObjectRef None Contents = CliType.ObjectRef None
Offset = None Offset = None
Type = objType
} }
{ {
Name = "m_d" Name = "m_d"
Contents = CliType.ObjectRef None Contents = CliType.ObjectRef None
Offset = None Offset = None
Type = objType
} }
{ {
Name = "m_b" Name = "m_b"
Contents = CliType.Numeric (CliNumericType.Int32 0) Contents = CliType.Numeric (CliNumericType.Int32 0)
Offset = None Offset = None
Type = intType
} }
{ {
Name = "m_e" Name = "m_e"
Contents = CliType.ObjectRef None Contents = CliType.ObjectRef None
Offset = None Offset = None
Type = objType
} }
// RuntimeFieldHandleInternal: https://github.com/dotnet/runtime/blob/1d1bf92fcf43aa6981804dc53c5174445069c9e4/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L1048 // RuntimeFieldHandleInternal: https://github.com/dotnet/runtime/blob/1d1bf92fcf43aa6981804dc53c5174445069c9e4/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L1048
{ {
Name = "m_fieldHandle" Name = "m_fieldHandle"
Contents = runtimeFieldHandleInternal Contents = runtimeFieldHandleInternal
Offset = None Offset = None
Type =
AllConcreteTypes.findExistingConcreteType
allConcreteTypes
(baseClassTypes.RuntimeFieldHandleInternal.Assembly,
baseClassTypes.RuntimeFieldHandleInternal.Namespace,
baseClassTypes.RuntimeFieldHandleInternal.Name,
ImmutableArray.Empty)
|> Option.get
} }
] ]
|> CliValueType.OfFields Layout.Default // explicitly sequential but no custom packing size |> CliValueType.OfFields Layout.Default // explicitly sequential but no custom packing size

View File

@@ -614,7 +614,7 @@ module IlMachineState =
(typeGenerics : ConcreteTypeHandle ImmutableArray) (typeGenerics : ConcreteTypeHandle ImmutableArray)
(methodGenerics : ConcreteTypeHandle ImmutableArray) (methodGenerics : ConcreteTypeHandle ImmutableArray)
(state : IlMachineState) (state : IlMachineState)
: IlMachineState * CliType : IlMachineState * CliType * ConcreteTypeHandle
= =
// First concretize the type // First concretize the type
@@ -630,7 +630,7 @@ module IlMachineState =
// Now get the zero value // Now get the zero value
let zero, state = cliTypeZeroOfHandle state baseClassTypes handle let zero, state = cliTypeZeroOfHandle state baseClassTypes handle
state, zero state, zero, handle
let pushToEvalStack' (o : EvalStackValue) (thread : ThreadId) (state : IlMachineState) = let pushToEvalStack' (o : EvalStackValue) (thread : ThreadId) (state : IlMachineState) =
let activeThreadState = state.ThreadState.[thread] let activeThreadState = state.ThreadState.[thread]
@@ -1466,7 +1466,12 @@ module IlMachineState =
| ManagedPointerSource.Null -> failwith "TODO: throw NRE" | ManagedPointerSource.Null -> failwith "TODO: throw NRE"
| ManagedPointerSource.InterpretedAsType (src, ty) -> failwith "TODO" | ManagedPointerSource.InterpretedAsType (src, ty) -> failwith "TODO"
let executeDelegateConstructor (instruction : MethodState) (state : IlMachineState) : IlMachineState = let executeDelegateConstructor
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(instruction : MethodState)
(state : IlMachineState)
: IlMachineState
=
// We've been called with arguments already popped from the stack into local arguments. // We've been called with arguments already popped from the stack into local arguments.
let constructing = instruction.Arguments.[0] let constructing = instruction.Arguments.[0]
let targetObj = instruction.Arguments.[1] let targetObj = instruction.Arguments.[1]
@@ -1495,6 +1500,8 @@ module IlMachineState =
// Standard delegate fields in .NET are _target and _methodPtr // Standard delegate fields in .NET are _target and _methodPtr
// Update the fields with the target object and method pointer // Update the fields with the target object and method pointer
let allConcreteTypes = state.ConcreteTypes
let updatedObj = let updatedObj =
let newContents = let newContents =
heapObj.Contents heapObj.Contents
@@ -1503,12 +1510,28 @@ module IlMachineState =
Name = "_target" Name = "_target"
Contents = CliType.ObjectRef targetObj Contents = CliType.ObjectRef targetObj
Offset = None Offset = None
Type =
AllConcreteTypes.findExistingConcreteType
allConcreteTypes
(baseClassTypes.Object.Assembly,
baseClassTypes.Object.Namespace,
baseClassTypes.Object.Name,
ImmutableArray.Empty)
|> Option.get
} }
|> CliValueType.AddField |> CliValueType.AddField
{ {
Name = "_methodPtr" Name = "_methodPtr"
Contents = methodPtr Contents = methodPtr
Offset = None Offset = None
Type =
AllConcreteTypes.findExistingConcreteType
allConcreteTypes
(baseClassTypes.Object.Assembly,
baseClassTypes.Object.Namespace,
baseClassTypes.Object.Name,
ImmutableArray.Empty)
|> Option.get
} }
{ heapObj with { heapObj with
@@ -1548,6 +1571,8 @@ module IlMachineState =
let result, reg, state = let result, reg, state =
TypeHandleRegistry.getOrAllocate TypeHandleRegistry.getOrAllocate
state.ConcreteTypes
baseClassTypes
state state
(fun fields state -> allocateManagedObject runtimeType fields state) (fun fields state -> allocateManagedObject runtimeType fields state)
defn defn
@@ -1599,6 +1624,7 @@ module IlMachineState =
let result, reg, state = let result, reg, state =
FieldHandleRegistry.getOrAllocate FieldHandleRegistry.getOrAllocate
baseClassTypes baseClassTypes
state.ConcreteTypes
state state
(fun fields state -> allocateManagedObject runtimeType fields state) (fun fields state -> allocateManagedObject runtimeType fields state)
declaringAssy declaringAssy
@@ -1644,7 +1670,10 @@ module IlMachineState =
state.ThreadState.[sourceThread].MethodStates.[methodFrame].LocalVariables.[int<uint16> whichVar] state.ThreadState.[sourceThread].MethodStates.[methodFrame].LocalVariables.[int<uint16> whichVar]
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) -> | ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
state.ThreadState.[sourceThread].MethodStates.[methodFrame].Arguments.[int<uint16> 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.ArrayIndex (arr, index) -> getArrayValue arr index state
| ManagedPointerSource.Field (addr, name) -> | ManagedPointerSource.Field (addr, name) ->
let obj = dereferencePointer state addr let obj = dereferencePointer state addr
@@ -1664,9 +1693,7 @@ module IlMachineState =
| Some ty -> ty | Some ty -> ty
| None -> failwith "not concretised type" | None -> failwith "not concretised type"
match concrete with failwith $"TODO: interpret as type %s{ty.Assembly.Name}.%s{ty.Namespace}.%s{ty.Name}, object %O{src}"
| ConcreteUInt32 state.ConcreteTypes -> failwith "TODO: cast"
| _ -> failwith "TODO"
let lookupTypeDefn let lookupTypeDefn
(baseClassTypes : BaseClassTypes<DumpedAssembly>) (baseClassTypes : BaseClassTypes<DumpedAssembly>)

View File

@@ -27,6 +27,8 @@ module Intrinsics =
"System.Private.CoreLib", "Math", "Max" "System.Private.CoreLib", "Math", "Max"
// https://github.com/dotnet/runtime/blob/d258af50034c192bf7f0a18856bf83d2903d98ae/src/libraries/System.Private.CoreLib/src/System/Buffer.cs#L150 // https://github.com/dotnet/runtime/blob/d258af50034c192bf7f0a18856bf83d2903d98ae/src/libraries/System.Private.CoreLib/src/System/Buffer.cs#L150
"System.Private.CoreLib", "Buffer", "Memmove" "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 |> Set.ofList
@@ -174,6 +176,14 @@ module Intrinsics =
Name = "m_type" Name = "m_type"
Contents = CliType.ObjectRef arg Contents = CliType.ObjectRef arg
Offset = None Offset = None
Type =
AllConcreteTypes.findExistingConcreteType
state.ConcreteTypes
(baseClassTypes.RuntimeType.Assembly,
baseClassTypes.RuntimeType.Namespace,
baseClassTypes.RuntimeType.Name,
ImmutableArray.Empty)
|> Option.get
} }
|> List.singleton |> List.singleton
|> CliValueType.OfFields Layout.Default |> CliValueType.OfFields Layout.Default
@@ -182,6 +192,44 @@ module Intrinsics =
|> IlMachineState.advanceProgramCounter currentThread |> IlMachineState.advanceProgramCounter currentThread
Some state 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" -> | "System.Private.CoreLib", "Unsafe", "AsPointer" ->
// Method signature: 1 generic parameter, we take a Byref of that parameter, and return a TypeDefn.Pointer(Void) // 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 let arg, state = IlMachineState.popEvalStack currentThread state
@@ -225,6 +273,47 @@ module Intrinsics =
let result = let result =
BitConverter.Int32BitsToSingle arg |> CliNumericType.Float32 |> CliType.Numeric 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 state
|> IlMachineState.pushToEvalStack result currentThread |> IlMachineState.pushToEvalStack result currentThread
|> IlMachineState.advanceProgramCounter currentThread |> IlMachineState.advanceProgramCounter currentThread
@@ -311,7 +400,8 @@ module Intrinsics =
let arg1 = let arg1 =
match arg1 with match arg1 with
| EvalStackValue.ObjectRef h | EvalStackValue.ObjectRef h
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> h | EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> Some h
| EvalStackValue.ManagedPointer ManagedPointerSource.Null -> None
| EvalStackValue.Int32 _ | EvalStackValue.Int32 _
| EvalStackValue.Int64 _ | EvalStackValue.Int64 _
| EvalStackValue.Float _ -> failwith $"this isn't a string! {arg1}" | EvalStackValue.Float _ -> failwith $"this isn't a string! {arg1}"
@@ -322,32 +412,38 @@ module Intrinsics =
let arg2 = let arg2 =
match arg2 with match arg2 with
| EvalStackValue.ObjectRef h | EvalStackValue.ObjectRef h
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> h | EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> Some h
| EvalStackValue.ManagedPointer ManagedPointerSource.Null -> None
| EvalStackValue.Int32 _ | EvalStackValue.Int32 _
| EvalStackValue.Int64 _ | EvalStackValue.Int64 _
| EvalStackValue.Float _ -> failwith $"this isn't a string! {arg2}" | EvalStackValue.Float _ -> failwith $"this isn't a string! {arg2}"
| _ -> failwith $"TODO: %O{arg2}" | _ -> failwith $"TODO: %O{arg2}"
if arg1 = arg2 then let areEqual =
state match arg1, arg2 with
|> IlMachineState.pushToEvalStack (CliType.ofBool true) currentThread | None, None -> true
|> IlMachineState.advanceProgramCounter currentThread | Some _, None
|> Some | None, Some _ -> false
else | Some arg1, Some arg2 ->
if arg1 = arg2 then
true
else
let arg1 = ManagedHeap.get arg1 state.ManagedHeap let arg1 = ManagedHeap.get arg1 state.ManagedHeap
let arg2 = ManagedHeap.get arg2 state.ManagedHeap let arg2 = ManagedHeap.get arg2 state.ManagedHeap
if if
AllocatedNonArrayObject.DereferenceField "_firstChar" arg1 AllocatedNonArrayObject.DereferenceField "_firstChar" arg1
<> AllocatedNonArrayObject.DereferenceField "_firstChar" arg2 <> AllocatedNonArrayObject.DereferenceField "_firstChar" arg2
then then
state false
|> IlMachineState.pushToEvalStack (CliType.ofBool false) currentThread else
|> IlMachineState.advanceProgramCounter currentThread failwith "TODO"
|> Some
else state
failwith "TODO" |> IlMachineState.pushToEvalStack (CliType.ofBool areEqual) currentThread
|> IlMachineState.advanceProgramCounter currentThread
|> Some
| _ -> None | _ -> None
| "System.Private.CoreLib", "Unsafe", "ReadUnaligned" -> | "System.Private.CoreLib", "Unsafe", "ReadUnaligned" ->
let ptr, state = IlMachineState.popEvalStack currentThread state let ptr, state = IlMachineState.popEvalStack currentThread state

View File

@@ -86,43 +86,28 @@ module NullaryIlOp =
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) -> | ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
failwith "unexpected - can we really write to an argument?" failwith "unexpected - can we really write to an argument?"
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) -> | ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
{ state with state
ThreadState = |> IlMachineState.setLocalVariable
state.ThreadState sourceThread
|> Map.change methodFrame
sourceThread whichVar
(fun state -> (EvalStackValue.toCliTypeCoerced varType valueToStore)
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
)
}
| ManagedPointerSource.Heap managedHeapAddress -> failwith "todo" | ManagedPointerSource.Heap managedHeapAddress -> failwith "todo"
| ManagedPointerSource.ArrayIndex _ -> 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" | EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo"
let internal ldElem let internal getArrayElt
(index : EvalStackValue) (index : EvalStackValue)
(arr : EvalStackValue) (arr : EvalStackValue)
(currentThread : ThreadId) (currentThread : ThreadId)
(state : IlMachineState) (state : IlMachineState)
: ExecutionResult : CliType
= =
let index = let index =
match index with match index with
@@ -143,14 +128,7 @@ module NullaryIlOp =
| EvalStackValue.ManagedPointer ManagedPointerSource.Null -> failwith "TODO: throw NRE" | EvalStackValue.ManagedPointer ManagedPointerSource.Null -> failwith "TODO: throw NRE"
| _ -> failwith $"Invalid array: %O{arr}" | _ -> failwith $"Invalid array: %O{arr}"
let value = IlMachineState.getArrayValue arrAddr index state IlMachineState.getArrayValue arrAddr index state
let state =
state
|> IlMachineState.pushToEvalStack value currentThread
|> IlMachineState.advanceProgramCounter currentThread
ExecutionResult.Stepped (state, WhatWeDid.Executed)
let internal stElem let internal stElem
(targetCliTypeZero : CliType) (targetCliTypeZero : CliType)
@@ -433,7 +411,7 @@ module NullaryIlOp =
| Sub -> | Sub ->
let val2, state = IlMachineState.popEvalStack currentThread state let val2, state = IlMachineState.popEvalStack currentThread state
let val1, state = IlMachineState.popEvalStack currentThread state let val1, state = IlMachineState.popEvalStack currentThread state
let result = BinaryArithmetic.execute ArithmeticOperation.sub val1 val2 let result = BinaryArithmetic.execute ArithmeticOperation.sub state val1 val2
state state
|> IlMachineState.pushToEvalStack' result currentThread |> IlMachineState.pushToEvalStack' result currentThread
@@ -443,21 +421,39 @@ module NullaryIlOp =
| Sub_ovf -> failwith "TODO: Sub_ovf unimplemented" | Sub_ovf -> failwith "TODO: Sub_ovf unimplemented"
| Sub_ovf_un -> failwith "TODO: Sub_ovf_un unimplemented" | Sub_ovf_un -> failwith "TODO: Sub_ovf_un unimplemented"
| Add -> | Add ->
let val1, state = IlMachineState.popEvalStack currentThread state
let val2, state = IlMachineState.popEvalStack currentThread state let val2, state = IlMachineState.popEvalStack currentThread state
let result = BinaryArithmetic.execute ArithmeticOperation.add val1 val2 let val1, state = IlMachineState.popEvalStack currentThread state
let result = BinaryArithmetic.execute ArithmeticOperation.add state val1 val2
state state
|> IlMachineState.pushToEvalStack' result currentThread |> IlMachineState.pushToEvalStack' result currentThread
|> IlMachineState.advanceProgramCounter currentThread |> IlMachineState.advanceProgramCounter currentThread
|> Tuple.withRight WhatWeDid.Executed |> Tuple.withRight WhatWeDid.Executed
|> ExecutionResult.Stepped |> 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" | Add_ovf_un -> failwith "TODO: Add_ovf_un unimplemented"
| Mul -> | Mul ->
let val1, state = IlMachineState.popEvalStack currentThread state
let val2, state = IlMachineState.popEvalStack currentThread state let val2, state = IlMachineState.popEvalStack currentThread state
let result = BinaryArithmetic.execute ArithmeticOperation.mul val1 val2 let val1, state = IlMachineState.popEvalStack currentThread state
let result = BinaryArithmetic.execute ArithmeticOperation.mul state val1 val2
state state
|> IlMachineState.pushToEvalStack' result currentThread |> IlMachineState.pushToEvalStack' result currentThread
@@ -465,12 +461,12 @@ module NullaryIlOp =
|> Tuple.withRight WhatWeDid.Executed |> Tuple.withRight WhatWeDid.Executed
|> ExecutionResult.Stepped |> ExecutionResult.Stepped
| Mul_ovf -> | Mul_ovf ->
let val1, state = IlMachineState.popEvalStack currentThread state
let val2, state = IlMachineState.popEvalStack currentThread state let val2, state = IlMachineState.popEvalStack currentThread state
let val1, state = IlMachineState.popEvalStack currentThread state
let result = let result =
try try
BinaryArithmetic.execute ArithmeticOperation.mulOvf val1 val2 |> Ok BinaryArithmetic.execute ArithmeticOperation.mulOvf state val1 val2 |> Ok
with :? OverflowException as e -> with :? OverflowException as e ->
Error e Error e
@@ -484,7 +480,25 @@ module NullaryIlOp =
|> Tuple.withRight WhatWeDid.Executed |> Tuple.withRight WhatWeDid.Executed
|> ExecutionResult.Stepped |> ExecutionResult.Stepped
| Mul_ovf_un -> failwith "TODO: Mul_ovf_un unimplemented" | Mul_ovf_un -> failwith "TODO: Mul_ovf_un unimplemented"
| Div -> failwith "TODO: Div unimplemented" | Div ->
let val2, state = IlMachineState.popEvalStack currentThread state
let val1, state = IlMachineState.popEvalStack currentThread state
let result =
try
BinaryArithmetic.execute ArithmeticOperation.div 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
| Div_un -> failwith "TODO: Div_un unimplemented" | Div_un -> failwith "TODO: Div_un unimplemented"
| Shr -> | Shr ->
let shift, state = IlMachineState.popEvalStack currentThread state let shift, state = IlMachineState.popEvalStack currentThread state
@@ -511,7 +525,33 @@ module NullaryIlOp =
|> IlMachineState.advanceProgramCounter currentThread |> IlMachineState.advanceProgramCounter currentThread
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped (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 -> | Shl ->
let shift, state = IlMachineState.popEvalStack currentThread state let shift, state = IlMachineState.popEvalStack currentThread state
let number, state = IlMachineState.popEvalStack currentThread state let number, state = IlMachineState.popEvalStack currentThread state
@@ -599,7 +639,37 @@ module NullaryIlOp =
|> IlMachineState.advanceProgramCounter currentThread |> IlMachineState.advanceProgramCounter currentThread
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped (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 -> | Conv_I ->
let popped, state = IlMachineState.popEvalStack currentThread state let popped, state = IlMachineState.popEvalStack currentThread state
let converted = EvalStackValue.toNativeInt popped let converted = EvalStackValue.toNativeInt popped
@@ -670,7 +740,20 @@ module NullaryIlOp =
let state = state |> IlMachineState.advanceProgramCounter currentThread let state = state |> IlMachineState.advanceProgramCounter currentThread
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped (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_U2 -> failwith "TODO: Conv_U2 unimplemented"
| Conv_U4 -> failwith "TODO: Conv_U4 unimplemented" | Conv_U4 -> failwith "TODO: Conv_U4 unimplemented"
| Conv_U8 -> | Conv_U8 ->
@@ -878,7 +961,16 @@ module NullaryIlOp =
| Ldind_u8 -> failwith "TODO: Ldind_u8 unimplemented" | Ldind_u8 -> failwith "TODO: Ldind_u8 unimplemented"
| Ldind_r4 -> executeLdind LdindTargetType.LdindR4 currentThread state | Ldind_r4 -> executeLdind LdindTargetType.LdindR4 currentThread state
| Ldind_r8 -> executeLdind LdindTargetType.LdindR8 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" | Rem_un -> failwith "TODO: Rem_un unimplemented"
| Volatile -> failwith "TODO: Volatile unimplemented" | Volatile -> failwith "TODO: Volatile unimplemented"
| Tail -> failwith "TODO: Tail unimplemented" | Tail -> failwith "TODO: Tail unimplemented"
@@ -895,7 +987,22 @@ module NullaryIlOp =
| Conv_ovf_i -> failwith "TODO: Conv_ovf_i unimplemented" | Conv_ovf_i -> failwith "TODO: Conv_ovf_i unimplemented"
| Conv_ovf_u -> failwith "TODO: Conv_ovf_u unimplemented" | Conv_ovf_u -> failwith "TODO: Conv_ovf_u unimplemented"
| Neg -> failwith "TODO: Neg 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 -> | Ldind_ref ->
let addr, state = IlMachineState.popEvalStack currentThread state let addr, state = IlMachineState.popEvalStack currentThread state
@@ -906,6 +1013,7 @@ module NullaryIlOp =
let state = let state =
match referenced with match referenced with
| CliType.RuntimePointer (CliRuntimePointer.Managed _)
| CliType.ObjectRef _ -> IlMachineState.pushToEvalStack referenced currentThread state | CliType.ObjectRef _ -> IlMachineState.pushToEvalStack referenced currentThread state
| _ -> failwith $"Unexpected non-reference {referenced}" | _ -> failwith $"Unexpected non-reference {referenced}"
|> IlMachineState.advanceProgramCounter currentThread |> IlMachineState.advanceProgramCounter currentThread
@@ -936,14 +1044,85 @@ module NullaryIlOp =
let state = state |> IlMachineState.advanceProgramCounter currentThread let state = state |> IlMachineState.advanceProgramCounter currentThread
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped (state, WhatWeDid.Executed) |> ExecutionResult.Stepped
| Ldelem_i -> failwith "TODO: Ldelem_i unimplemented" | Ldelem_i ->
| Ldelem_i1 -> failwith "TODO: Ldelem_i1 unimplemented" 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_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_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_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_u8 -> failwith "TODO: Ldelem_u8 unimplemented"
| Ldelem_r4 -> failwith "TODO: Ldelem_r4 unimplemented" | Ldelem_r4 -> failwith "TODO: Ldelem_r4 unimplemented"
| Ldelem_r8 -> failwith "TODO: Ldelem_r8 unimplemented" | Ldelem_r8 -> failwith "TODO: Ldelem_r8 unimplemented"
@@ -951,7 +1130,19 @@ module NullaryIlOp =
let index, state = IlMachineState.popEvalStack currentThread state let index, state = IlMachineState.popEvalStack currentThread state
let arr, 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 -> | Stelem_i ->
let value, state = IlMachineState.popEvalStack currentThread state let value, state = IlMachineState.popEvalStack currentThread state
let index, state = IlMachineState.popEvalStack currentThread state let index, state = IlMachineState.popEvalStack currentThread state

View File

@@ -1,5 +1,7 @@
namespace WoofWare.PawPrint namespace WoofWare.PawPrint
open System.Collections.Immutable
type TypeHandleRegistry = type TypeHandleRegistry =
private private
{ {
@@ -17,6 +19,8 @@ module TypeHandleRegistry =
/// Returns an allocated System.RuntimeType as well. /// Returns an allocated System.RuntimeType as well.
let getOrAllocate let getOrAllocate
(allConcreteTypes : AllConcreteTypes)
(corelib : BaseClassTypes<DumpedAssembly>)
(allocState : 'allocState) (allocState : 'allocState)
(allocate : CliValueType -> 'allocState -> ManagedHeapAddress * 'allocState) (allocate : CliValueType -> 'allocState -> ManagedHeapAddress * 'allocState)
(def : ConcreteTypeHandle) (def : ConcreteTypeHandle)
@@ -38,17 +42,40 @@ module TypeHandleRegistry =
Name = "m_keepalive" Name = "m_keepalive"
Contents = CliType.ObjectRef None Contents = CliType.ObjectRef None
Offset = None Offset = None
Type =
AllConcreteTypes.findExistingConcreteType
allConcreteTypes
(corelib.Object.Assembly,
corelib.Object.Namespace,
corelib.Object.Name,
ImmutableArray.Empty)
|> Option.get
} }
// TODO: this is actually a System.IntPtr https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/coreclr/nativeaot/Runtime.Base/src/System/Primitives.cs#L339
{ {
Name = "m_cache" Name = "m_cache"
Contents = CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.Verbatim 0L)) Contents = CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.Verbatim 0L))
Offset = None Offset = None
Type =
AllConcreteTypes.findExistingConcreteType
allConcreteTypes
(corelib.IntPtr.Assembly,
corelib.IntPtr.Namespace,
corelib.IntPtr.Name,
ImmutableArray.Empty)
|> Option.get
} }
{ {
Name = "m_handle" Name = "m_handle"
Contents = CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.TypeHandlePtr def)) Contents = CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.TypeHandlePtr def))
Offset = None Offset = None
Type =
AllConcreteTypes.findExistingConcreteType
allConcreteTypes
(corelib.IntPtr.Assembly,
corelib.IntPtr.Namespace,
corelib.IntPtr.Name,
ImmutableArray.Empty)
|> Option.get
} }
// This is the const -1, apparently?! // This is the const -1, apparently?!
// https://github.com/dotnet/runtime/blob/f0168ee80ba9aca18a7e7140b2bb436defda623c/src/coreclr/System.Private.CoreLib/src/System/RuntimeType.CoreCLR.cs#L2496 // https://github.com/dotnet/runtime/blob/f0168ee80ba9aca18a7e7140b2bb436defda623c/src/coreclr/System.Private.CoreLib/src/System/RuntimeType.CoreCLR.cs#L2496
@@ -56,6 +83,11 @@ module TypeHandleRegistry =
Name = "GenericParameterCountAny" Name = "GenericParameterCountAny"
Contents = CliType.Numeric (CliNumericType.Int32 -1) Contents = CliType.Numeric (CliNumericType.Int32 -1)
Offset = None Offset = None
Type =
AllConcreteTypes.findExistingConcreteType
allConcreteTypes
(corelib.Int32.Assembly, corelib.Int32.Namespace, corelib.Int32.Name, ImmutableArray.Empty)
|> Option.get
} }
] ]
|> CliValueType.OfFields Layout.Default |> CliValueType.OfFields Layout.Default

View File

@@ -296,7 +296,7 @@ module internal UnaryMetadataIlOp =
((state, []), instanceFields) ((state, []), instanceFields)
||> List.fold (fun (state, zeros) field -> ||> List.fold (fun (state, zeros) field ->
// TODO: generics // TODO: generics
let state, zero = let state, zero, concreteType =
IlMachineState.cliTypeZeroOf IlMachineState.cliTypeZeroOf
loggerFactory loggerFactory
baseClassTypes baseClassTypes
@@ -311,6 +311,7 @@ module internal UnaryMetadataIlOp =
Name = field.Name Name = field.Name
Contents = zero Contents = zero
Offset = field.Offset Offset = field.Offset
Type = concreteType
} }
state, field :: zeros state, field :: zeros
@@ -395,7 +396,7 @@ module internal UnaryMetadataIlOp =
ref ref
| x -> failwith $"TODO: Newarr element type resolution unimplemented for {x}" | x -> failwith $"TODO: Newarr element type resolution unimplemented for {x}"
let state, zeroOfType = let state, zeroOfType, concreteTypeHandle =
IlMachineState.cliTypeZeroOf IlMachineState.cliTypeZeroOf
loggerFactory loggerFactory
baseClassTypes baseClassTypes
@@ -415,7 +416,55 @@ module internal UnaryMetadataIlOp =
|> IlMachineState.advanceProgramCounter thread |> IlMachineState.advanceProgramCounter thread
state, WhatWeDid.Executed 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 -> | Ldelema ->
let index, state = IlMachineState.popEvalStack thread state let index, state = IlMachineState.popEvalStack thread state
let arr, state = IlMachineState.popEvalStack thread state let arr, state = IlMachineState.popEvalStack thread state
@@ -553,7 +602,7 @@ module internal UnaryMetadataIlOp =
let state, declaringTypeHandle, typeGenerics = let state, declaringTypeHandle, typeGenerics =
IlMachineState.concretizeFieldForExecution loggerFactory baseClassTypes thread field state IlMachineState.concretizeFieldForExecution loggerFactory baseClassTypes thread field state
let state, zero = let state, zero, concreteTypeHandle =
IlMachineState.cliTypeZeroOf IlMachineState.cliTypeZeroOf
loggerFactory loggerFactory
baseClassTypes baseClassTypes
@@ -669,7 +718,7 @@ module internal UnaryMetadataIlOp =
let popped, state = IlMachineState.popEvalStack thread state let popped, state = IlMachineState.popEvalStack thread state
let state, zero = let state, zero, concreteTypeHandle =
IlMachineState.cliTypeZeroOf IlMachineState.cliTypeZeroOf
loggerFactory loggerFactory
baseClassTypes baseClassTypes
@@ -736,7 +785,7 @@ module internal UnaryMetadataIlOp =
match IlMachineState.getStatic declaringTypeHandle field.Name state with match IlMachineState.getStatic declaringTypeHandle field.Name state with
| Some v -> state, v | Some v -> state, v
| None -> | None ->
let state, zero = let state, zero, concreteTypeHandle =
IlMachineState.cliTypeZeroOf IlMachineState.cliTypeZeroOf
loggerFactory loggerFactory
baseClassTypes baseClassTypes
@@ -901,7 +950,7 @@ module internal UnaryMetadataIlOp =
let fieldValue, state = let fieldValue, state =
match IlMachineState.getStatic declaringTypeHandle field.Name state with match IlMachineState.getStatic declaringTypeHandle field.Name state with
| None -> | None ->
let state, newVal = let state, newVal, concreteTypeHandle =
IlMachineState.cliTypeZeroOf IlMachineState.cliTypeZeroOf
loggerFactory loggerFactory
baseClassTypes baseClassTypes
@@ -979,7 +1028,7 @@ module internal UnaryMetadataIlOp =
let elementType = let elementType =
DumpedAssembly.typeInfoToTypeDefn baseClassTypes state._LoadedAssemblies elementType DumpedAssembly.typeInfoToTypeDefn baseClassTypes state._LoadedAssemblies elementType
let state, zeroOfType = let state, zeroOfType, concreteTypeHandle =
IlMachineState.cliTypeZeroOf IlMachineState.cliTypeZeroOf
loggerFactory loggerFactory
baseClassTypes baseClassTypes
@@ -1076,7 +1125,7 @@ module internal UnaryMetadataIlOp =
targetType targetType
|> DumpedAssembly.typeInfoToTypeDefn baseClassTypes state._LoadedAssemblies |> DumpedAssembly.typeInfoToTypeDefn baseClassTypes state._LoadedAssemblies
let state, zeroOfType = let state, zeroOfType, concreteTypeHandle =
IlMachineState.cliTypeZeroOf IlMachineState.cliTypeZeroOf
loggerFactory loggerFactory
baseClassTypes baseClassTypes
@@ -1144,7 +1193,7 @@ module internal UnaryMetadataIlOp =
|> Tuple.withRight WhatWeDid.Executed |> Tuple.withRight WhatWeDid.Executed
| None -> | None ->
// Field is not yet initialised // Field is not yet initialised
let state, zero = let state, zero, concreteTypeHandle =
IlMachineState.cliTypeZeroOf IlMachineState.cliTypeZeroOf
loggerFactory loggerFactory
baseClassTypes baseClassTypes
@@ -1239,6 +1288,14 @@ module internal UnaryMetadataIlOp =
Name = "m_type" Name = "m_type"
Contents = CliType.ObjectRef (Some alloc) Contents = CliType.ObjectRef (Some alloc)
Offset = None Offset = None
Type =
AllConcreteTypes.findExistingConcreteType
state.ConcreteTypes
(baseClassTypes.Object.Assembly,
baseClassTypes.Object.Namespace,
baseClassTypes.Object.Name,
ImmutableArray.Empty)
|> Option.get
} }
|> List.singleton |> List.singleton
|> CliValueType.OfFields Layout.Default |> CliValueType.OfFields Layout.Default
@@ -1298,6 +1355,14 @@ module internal UnaryMetadataIlOp =
Name = "m_type" Name = "m_type"
Contents = CliType.ObjectRef (Some alloc) Contents = CliType.ObjectRef (Some alloc)
Offset = None Offset = None
Type =
AllConcreteTypes.findExistingConcreteType
state.ConcreteTypes
(baseClassTypes.Object.Assembly,
baseClassTypes.Object.Namespace,
baseClassTypes.Object.Name,
ImmutableArray.Empty)
|> Option.get
} }
|> List.singleton |> List.singleton
|> CliValueType.OfFields Layout.Default |> CliValueType.OfFields Layout.Default
@@ -1335,6 +1400,14 @@ module internal UnaryMetadataIlOp =
Name = "m_type" Name = "m_type"
Contents = CliType.ObjectRef (Some alloc) Contents = CliType.ObjectRef (Some alloc)
Offset = None Offset = None
Type =
AllConcreteTypes.findExistingConcreteType
state.ConcreteTypes
(baseClassTypes.Object.Assembly,
baseClassTypes.Object.Namespace,
baseClassTypes.Object.Name,
ImmutableArray.Empty)
|> Option.get
} }
|> List.singleton |> List.singleton
|> CliValueType.OfFields Layout.Default |> CliValueType.OfFields Layout.Default
@@ -1351,7 +1424,70 @@ module internal UnaryMetadataIlOp =
|> IlMachineState.advanceProgramCounter thread |> IlMachineState.advanceProgramCounter thread
|> Tuple.withRight WhatWeDid.Executed |> Tuple.withRight WhatWeDid.Executed
| Cpobj -> failwith "TODO: Cpobj unimplemented" | 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 -> | Sizeof ->
let state, ty, assy = let state, ty, assy =
match metadataToken with match metadataToken with

View File

@@ -56,11 +56,27 @@ module internal UnaryStringTokenIlOp =
Name = "_firstChar" Name = "_firstChar"
Contents = CliType.ofChar state.ManagedHeap.StringArrayData.[dataAddr] Contents = CliType.ofChar state.ManagedHeap.StringArrayData.[dataAddr]
Offset = None Offset = None
Type =
AllConcreteTypes.findExistingConcreteType
state.ConcreteTypes
(baseClassTypes.Char.Assembly,
baseClassTypes.Char.Namespace,
baseClassTypes.Char.Name,
ImmutableArray.Empty)
|> Option.get
} }
{ {
Name = "_stringLength" Name = "_stringLength"
Contents = CliType.Numeric (CliNumericType.Int32 stringToAllocate.Length) Contents = CliType.Numeric (CliNumericType.Int32 stringToAllocate.Length)
Offset = None Offset = None
Type =
AllConcreteTypes.findExistingConcreteType
state.ConcreteTypes
(baseClassTypes.Int32.Assembly,
baseClassTypes.Int32.Namespace,
baseClassTypes.Int32.Name,
ImmutableArray.Empty)
|> Option.get
} }
] ]
|> CliValueType.OfFields Layout.Default |> CliValueType.OfFields Layout.Default

View File

@@ -20,10 +20,10 @@
<Compile Include="Exceptions.fs" /> <Compile Include="Exceptions.fs" />
<Compile Include="EvalStack.fs" /> <Compile Include="EvalStack.fs" />
<Compile Include="EvalStackValueComparisons.fs" /> <Compile Include="EvalStackValueComparisons.fs" />
<Compile Include="BinaryArithmetic.fs" />
<Compile Include="MethodState.fs" /> <Compile Include="MethodState.fs" />
<Compile Include="ThreadState.fs" /> <Compile Include="ThreadState.fs" />
<Compile Include="IlMachineState.fs" /> <Compile Include="IlMachineState.fs" />
<Compile Include="BinaryArithmetic.fs" />
<Compile Include="Intrinsics.fs" /> <Compile Include="Intrinsics.fs" />
<Compile Include="IlMachineStateExecution.fs" /> <Compile Include="IlMachineStateExecution.fs" />
<Compile Include="NullaryIlOp.fs" /> <Compile Include="NullaryIlOp.fs" />

6
flake.lock generated
View File

@@ -20,11 +20,11 @@
}, },
"nixpkgs": { "nixpkgs": {
"locked": { "locked": {
"lastModified": 1755736253, "lastModified": 1759036355,
"narHash": "sha256-jlIQRypNhB1PcB1BE+expE4xZeJxzoAGr1iUbHQta8s=", "narHash": "sha256-0m27AKv6ka+q270dw48KflE0LwQYrO7Fm4/2//KCVWg=",
"owner": "NixOS", "owner": "NixOS",
"repo": "nixpkgs", "repo": "nixpkgs",
"rev": "596312aae91421d6923f18cecce934a7d3bfd6b8", "rev": "e9f00bd893984bc8ce46c895c3bf7cac95331127",
"type": "github" "type": "github"
}, },
"original": { "original": {

View File

@@ -17,8 +17,8 @@
config.allowUnfree = true; config.allowUnfree = true;
}; };
pname = "WoofWare.PawPrint"; pname = "WoofWare.PawPrint";
dotnet-sdk = pkgs.dotnetCorePackages.sdk_9_0; dotnet-sdk = pkgs.dotnetCorePackages.sdk_10_0;
dotnet-runtime = pkgs.dotnetCorePackages.runtime_9_0; dotnet-runtime = pkgs.dotnetCorePackages.runtime_10_0;
version = "0.1"; version = "0.1";
dotnetTool = dllOverride: toolName: toolVersion: hash: dotnetTool = dllOverride: toolName: toolVersion: hash:
pkgs.stdenvNoCC.mkDerivation rec { pkgs.stdenvNoCC.mkDerivation rec {