mirror of
https://github.com/Smaug123/WoofWare.PawPrint
synced 2025-10-06 06:28:39 +00:00
Compare commits
8 Commits
5173805562
...
net10
Author | SHA1 | Date | |
---|---|---|---|
|
81abd6dca2 | ||
|
08a4497ebf | ||
|
fc62651d55 | ||
|
2e9fdbed48 | ||
|
fb5c4a6313 | ||
|
95987e592c | ||
|
0e31d74586 | ||
|
8112b122fb |
@@ -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
|
||||||
|
@@ -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>
|
||||||
|
@@ -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>
|
||||||
|
|
||||||
|
@@ -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>
|
||||||
|
|
||||||
|
@@ -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 ->
|
||||||
|
@@ -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
|
||||||
|
@@ -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>]
|
||||||
|
@@ -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
|
||||||
|
@@ -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
|
||||||
|
@@ -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
|
||||||
|
@@ -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>
|
||||||
|
255
WoofWare.PawPrint.Test/sourcesPure/ComparisonOperations.cs
Normal file
255
WoofWare.PawPrint.Test/sourcesPure/ComparisonOperations.cs
Normal 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;
|
||||||
|
}
|
||||||
|
}
|
184
WoofWare.PawPrint.Test/sourcesPure/StackOperations.cs
Normal file
184
WoofWare.PawPrint.Test/sourcesPure/StackOperations.cs
Normal 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;
|
||||||
|
}
|
||||||
|
}
|
@@ -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
|
||||||
|
@@ -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
|
||||||
|
@@ -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}"
|
||||||
|
@@ -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
|
||||||
|
@@ -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
|
||||||
|
@@ -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
|
||||||
|
@@ -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>)
|
||||||
|
@@ -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
|
||||||
|
@@ -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
|
||||||
|
@@ -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
|
||||||
|
@@ -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
|
||||||
|
@@ -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
|
||||||
|
@@ -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
6
flake.lock
generated
@@ -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": {
|
||||||
|
@@ -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 {
|
||||||
|
Reference in New Issue
Block a user