mirror of
https://github.com/Smaug123/WoofWare.PawPrint
synced 2025-10-06 06:28:39 +00:00
Compare commits
14 Commits
a9b2598525
...
main
Author | SHA1 | Date | |
---|---|---|---|
|
08a4497ebf | ||
|
fc62651d55 | ||
|
2e9fdbed48 | ||
|
fb5c4a6313 | ||
|
95987e592c | ||
|
0e31d74586 | ||
|
8112b122fb | ||
|
5173805562 | ||
|
cb5d76f059 | ||
|
5e7bd969ba | ||
|
07fabfff65 | ||
|
655ba4400a | ||
|
c58c8ce678 | ||
|
239ae0f0cd |
@@ -67,13 +67,12 @@ dotnet run --project WoofWare.PawPrint.App/WoofWare.PawPrint.App.fsproj -- CShar
|
||||
- `Corelib.fs`: Core library type definitions (String, Array, etc.)
|
||||
|
||||
**WoofWare.PawPrint.Test**
|
||||
- Uses Expecto as the test framework
|
||||
- Uses NUnit as the test framework
|
||||
- Test cases are defined in `TestPureCases.fs` and `TestImpureCases.fs`
|
||||
- C# source files in `sources{Pure,Impure}/` are compiled and executed by the runtime as test cases
|
||||
- C# source files in `sources{Pure,Impure}/` are compiled and executed by the runtime as test cases; files in `sourcesPure` are automatically turned into test cases with no further action (see TestPureCases.fs for the mechanism)
|
||||
- `TestHarness.fs` provides infrastructure for running test assemblies through the interpreter
|
||||
- Run all tests with `dotnet run --project WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj -- --no-spinner` (note the additional `--`)
|
||||
- Run a specific test with `dotnet run --project WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj -- --filter-test-case StringWithinTestName --no-spinner`
|
||||
- Pending test definitions must be moved into the non-pending test case list before they can be run.
|
||||
|
||||
**WoofWare.PawPrint.App**
|
||||
- Entry point application for running the interpreter
|
||||
|
@@ -565,6 +565,7 @@ module DumpedAssembly =
|
||||
(bct : BaseClassTypes<DumpedAssembly>)
|
||||
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
|
||||
(ti : TypeInfo<TypeDefn, TypeDefn>)
|
||||
: TypeDefn
|
||||
=
|
||||
ti
|
||||
|> TypeInfo.toTypeDefn
|
||||
|
@@ -33,6 +33,20 @@ type ConcreteType<'typeGeneric> =
|
||||
_Generics : ImmutableArray<'typeGeneric>
|
||||
}
|
||||
|
||||
override this.ToString () : string =
|
||||
let basic = $"%s{this.Assembly.Name}.%s{this.Namespace}.%s{this.Name}"
|
||||
|
||||
let generics =
|
||||
if this.Generics.IsEmpty then
|
||||
""
|
||||
else
|
||||
this.Generics
|
||||
|> Seq.map string
|
||||
|> String.concat ", "
|
||||
|> fun x -> "<" + x + ">"
|
||||
|
||||
basic + generics
|
||||
|
||||
member this.Assembly : AssemblyName = this._AssemblyName
|
||||
member this.Definition : ComparableTypeDefinitionHandle = this._Definition
|
||||
member this.Generics : ImmutableArray<'typeGeneric> = this._Generics
|
||||
|
@@ -8,3 +8,9 @@ module Constants =
|
||||
|
||||
[<Literal>]
|
||||
let SIZEOF_OBJ = 8
|
||||
|
||||
[<Literal>]
|
||||
let DEFAULT_STRUCT_ALIGNMENT = 8
|
||||
|
||||
[<Literal>]
|
||||
let NATIVE_INT_SIZE = 8
|
@@ -57,11 +57,10 @@ module FieldInfo =
|
||||
let fieldSig = def.DecodeSignature (TypeDefn.typeProvider assembly, ())
|
||||
let declaringType = def.GetDeclaringType ()
|
||||
|
||||
let typeGenerics =
|
||||
mr.GetTypeDefinition(declaringType).GetGenericParameters ()
|
||||
|> GenericParameter.readAll mr
|
||||
|
||||
let decType = mr.GetTypeDefinition declaringType
|
||||
|
||||
let typeGenerics = decType.GetGenericParameters () |> GenericParameter.readAll mr
|
||||
|
||||
let declaringTypeNamespace = mr.GetString decType.Namespace
|
||||
let declaringTypeName = mr.GetString decType.Name
|
||||
|
||||
|
@@ -183,6 +183,24 @@ module ConcreteActivePatterns =
|
||||
| _ -> None
|
||||
| _ -> None
|
||||
|
||||
let (|ConcreteGenericArray|_|)
|
||||
(concreteTypes : AllConcreteTypes)
|
||||
(eltType : ConcreteTypeHandle)
|
||||
(handle : ConcreteTypeHandle)
|
||||
=
|
||||
match handle with
|
||||
| ConcreteTypeHandle.Concrete id ->
|
||||
match concreteTypes.Mapping |> Map.tryFind id with
|
||||
| Some ct when
|
||||
ct.Assembly.Name = "System.Private.CoreLib"
|
||||
&& ct.Namespace = "System"
|
||||
&& ct.Name = "Array"
|
||||
&& Seq.tryExactlyOne ct.Generics = Some eltType
|
||||
->
|
||||
Some ()
|
||||
| _ -> None
|
||||
| _ -> None
|
||||
|
||||
let (|ConcreteObj|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) : unit option =
|
||||
match handle with
|
||||
| ConcreteTypeHandle.Concrete id ->
|
||||
@@ -302,6 +320,40 @@ module ConcreteActivePatterns =
|
||||
| None -> None
|
||||
| _ -> None
|
||||
|
||||
let (|ConcreteUInt32|_|) (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 = "UInt32"
|
||||
&& ct.Generics.IsEmpty
|
||||
then
|
||||
Some ()
|
||||
else
|
||||
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 =
|
||||
match handle with
|
||||
| ConcreteTypeHandle.Concrete id ->
|
||||
@@ -331,6 +383,13 @@ module ConcreteActivePatterns =
|
||||
| ConcreteTypeHandle.Pointer inner -> Some inner
|
||||
| _ -> None
|
||||
|
||||
type IAssemblyLoad =
|
||||
abstract LoadAssembly :
|
||||
loadedAssemblies : ImmutableDictionary<string, DumpedAssembly> ->
|
||||
referencedIn : AssemblyName ->
|
||||
handle : AssemblyReferenceHandle ->
|
||||
ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module TypeConcretization =
|
||||
|
||||
@@ -406,8 +465,7 @@ module TypeConcretization =
|
||||
|
||||
// Helper function for assembly loading with retry pattern
|
||||
let private loadAssemblyAndResolveTypeRef
|
||||
(loadAssembly :
|
||||
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
|
||||
(loadAssembly : IAssemblyLoad)
|
||||
(ctx : ConcretizationContext<'corelib>)
|
||||
(currentAssembly : AssemblyName)
|
||||
(typeRef : TypeRef)
|
||||
@@ -428,7 +486,8 @@ module TypeConcretization =
|
||||
// Need to load the assembly
|
||||
match typeRef.ResolutionScope with
|
||||
| TypeRefResolutionScope.Assembly assyRef ->
|
||||
let newAssemblies, _ = loadAssembly currentAssembly assyRef
|
||||
let newAssemblies, _ =
|
||||
loadAssembly.LoadAssembly ctx.LoadedAssemblies currentAssembly assyRef
|
||||
|
||||
let newCtx =
|
||||
{ ctx with
|
||||
@@ -584,8 +643,7 @@ module TypeConcretization =
|
||||
ImmutableArray.Empty // No generic parameters
|
||||
|
||||
let private concretizeTypeReference
|
||||
(loadAssembly :
|
||||
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
|
||||
(loadAssembly : IAssemblyLoad)
|
||||
(ctx : ConcretizationContext<'corelib>)
|
||||
(currentAssembly : AssemblyName)
|
||||
(typeRef : TypeRef)
|
||||
@@ -609,8 +667,7 @@ module TypeConcretization =
|
||||
/// Concretize a type in a specific generic context
|
||||
let rec concretizeType
|
||||
(ctx : ConcretizationContext<DumpedAssembly>)
|
||||
(loadAssembly :
|
||||
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
|
||||
(loadAssembly : IAssemblyLoad)
|
||||
(assembly : AssemblyName)
|
||||
(typeGenerics : ImmutableArray<ConcreteTypeHandle>)
|
||||
(methodGenerics : ImmutableArray<ConcreteTypeHandle>)
|
||||
@@ -706,8 +763,7 @@ module TypeConcretization =
|
||||
|
||||
and private concretizeGenericInstantiation
|
||||
(ctx : ConcretizationContext<DumpedAssembly>)
|
||||
(loadAssembly :
|
||||
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
|
||||
(loadAssembly : IAssemblyLoad)
|
||||
(assembly : AssemblyName)
|
||||
(typeGenerics : ImmutableArray<ConcreteTypeHandle>)
|
||||
(methodGenerics : ImmutableArray<ConcreteTypeHandle>)
|
||||
@@ -786,7 +842,8 @@ module TypeConcretization =
|
||||
|
||||
| false, _ ->
|
||||
// Need to load the assembly
|
||||
let newAssemblies, loadedAssy = loadAssembly assembly assyRef
|
||||
let newAssemblies, loadedAssy =
|
||||
loadAssembly.LoadAssembly ctx.LoadedAssemblies assembly assyRef
|
||||
|
||||
let ctxWithNewAssy =
|
||||
{ ctxAfterArgs with
|
||||
@@ -865,8 +922,7 @@ module Concretization =
|
||||
/// Helper to concretize an array of types
|
||||
let private concretizeTypeArray
|
||||
(ctx : TypeConcretization.ConcretizationContext<DumpedAssembly>)
|
||||
(loadAssembly :
|
||||
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
|
||||
(loadAssembly : IAssemblyLoad)
|
||||
(assembly : AssemblyName)
|
||||
(typeArgs : ImmutableArray<ConcreteTypeHandle>)
|
||||
(methodArgs : ImmutableArray<ConcreteTypeHandle>)
|
||||
@@ -889,8 +945,7 @@ module Concretization =
|
||||
/// Helper to concretize a method signature
|
||||
let private concretizeMethodSignature
|
||||
(ctx : TypeConcretization.ConcretizationContext<DumpedAssembly>)
|
||||
(loadAssembly :
|
||||
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
|
||||
(loadAssembly : IAssemblyLoad)
|
||||
(assembly : AssemblyName)
|
||||
(typeArgs : ImmutableArray<ConcreteTypeHandle>)
|
||||
(methodArgs : ImmutableArray<ConcreteTypeHandle>)
|
||||
@@ -926,8 +981,7 @@ module Concretization =
|
||||
|
||||
/// Helper to ensure base type assembly is loaded
|
||||
let rec private ensureBaseTypeAssembliesLoaded
|
||||
(loadAssembly :
|
||||
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
|
||||
(loadAssembly : IAssemblyLoad)
|
||||
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
|
||||
(assyName : AssemblyName)
|
||||
(baseTypeInfo : BaseTypeInfo option)
|
||||
@@ -947,7 +1001,7 @@ module Concretization =
|
||||
| true, _ -> assemblies
|
||||
| false, _ ->
|
||||
// Need to load the assembly - pass the assembly that contains the reference
|
||||
let newAssemblies, _ = loadAssembly assy.Name assyRef
|
||||
let newAssemblies, _ = loadAssembly.LoadAssembly assemblies assy.Name assyRef
|
||||
newAssemblies
|
||||
| _ -> assemblies
|
||||
| Some (BaseTypeInfo.TypeDef _)
|
||||
@@ -957,8 +1011,7 @@ module Concretization =
|
||||
/// Concretize a method's signature and body
|
||||
let concretizeMethod
|
||||
(ctx : AllConcreteTypes)
|
||||
(loadAssembly :
|
||||
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
|
||||
(loadAssembly : IAssemblyLoad)
|
||||
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
|
||||
(baseTypes : BaseClassTypes<DumpedAssembly>)
|
||||
(method : WoofWare.PawPrint.MethodInfo<'ty, GenericParamFromMetadata, TypeDefn>)
|
||||
|
@@ -6,6 +6,8 @@ open System.Reflection.Metadata
|
||||
open System.Reflection.Metadata.Ecma335
|
||||
open Microsoft.FSharp.Core
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
[<NoComparison>]
|
||||
type ResolvedBaseType =
|
||||
| Enum
|
||||
| ValueType
|
||||
@@ -167,8 +169,8 @@ module PrimitiveType =
|
||||
| PrimitiveType.Double -> 8
|
||||
| PrimitiveType.String -> 8
|
||||
| PrimitiveType.TypedReference -> failwith "todo"
|
||||
| PrimitiveType.IntPtr -> 8
|
||||
| PrimitiveType.UIntPtr -> 8
|
||||
| PrimitiveType.IntPtr -> NATIVE_INT_SIZE
|
||||
| PrimitiveType.UIntPtr -> NATIVE_INT_SIZE
|
||||
| PrimitiveType.Object -> 8
|
||||
|
||||
type TypeDefn =
|
||||
|
@@ -29,6 +29,10 @@ type InterfaceImplementation =
|
||||
RelativeToAssembly : AssemblyName
|
||||
}
|
||||
|
||||
type Layout =
|
||||
| Default
|
||||
| Custom of size : int * packingSize : int
|
||||
|
||||
/// <summary>
|
||||
/// Represents detailed information about a type definition in a .NET assembly.
|
||||
/// This is a strongly-typed representation of TypeDefinition from System.Reflection.Metadata.
|
||||
@@ -93,6 +97,8 @@ type TypeInfo<'generic, 'fieldGeneric> =
|
||||
Events : EventDefn ImmutableArray
|
||||
|
||||
ImplementedInterfaces : InterfaceImplementation ImmutableArray
|
||||
|
||||
Layout : Layout
|
||||
}
|
||||
|
||||
member this.IsInterface = this.TypeAttributes.HasFlag TypeAttributes.Interface
|
||||
@@ -184,6 +190,18 @@ type BaseClassTypes<'corelib> =
|
||||
TypedReference : TypeInfo<GenericParamFromMetadata, TypeDefn>
|
||||
IntPtr : TypeInfo<GenericParamFromMetadata, TypeDefn>
|
||||
UIntPtr : TypeInfo<GenericParamFromMetadata, TypeDefn>
|
||||
Exception : TypeInfo<GenericParamFromMetadata, TypeDefn>
|
||||
ArithmeticException : TypeInfo<GenericParamFromMetadata, TypeDefn>
|
||||
DivideByZeroException : TypeInfo<GenericParamFromMetadata, TypeDefn>
|
||||
OverflowException : TypeInfo<GenericParamFromMetadata, TypeDefn>
|
||||
StackOverflowException : TypeInfo<GenericParamFromMetadata, TypeDefn>
|
||||
TypeLoadException : TypeInfo<GenericParamFromMetadata, TypeDefn>
|
||||
IndexOutOfRangeException : TypeInfo<GenericParamFromMetadata, TypeDefn>
|
||||
InvalidCastException : TypeInfo<GenericParamFromMetadata, TypeDefn>
|
||||
MissingFieldException : TypeInfo<GenericParamFromMetadata, TypeDefn>
|
||||
MissingMethodException : TypeInfo<GenericParamFromMetadata, TypeDefn>
|
||||
NullReferenceException : TypeInfo<GenericParamFromMetadata, TypeDefn>
|
||||
OutOfMemoryException : TypeInfo<GenericParamFromMetadata, TypeDefn>
|
||||
}
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
@@ -213,6 +231,7 @@ module TypeInfo =
|
||||
Generics = gen
|
||||
Events = t.Events
|
||||
ImplementedInterfaces = t.ImplementedInterfaces
|
||||
Layout = t.Layout
|
||||
}
|
||||
|
||||
let mapGeneric<'a, 'b, 'field> (f : 'a -> 'b) (t : TypeInfo<'a, 'field>) : TypeInfo<'b, 'field> =
|
||||
@@ -308,6 +327,14 @@ module TypeInfo =
|
||||
|
||||
result.ToImmutable ()
|
||||
|
||||
let layout =
|
||||
let l = typeDef.GetLayout ()
|
||||
|
||||
if l.IsDefault then
|
||||
Layout.Default
|
||||
else
|
||||
Layout.Custom (size = l.Size, packingSize = l.PackingSize)
|
||||
|
||||
{
|
||||
Namespace = ns
|
||||
Name = name
|
||||
@@ -323,6 +350,7 @@ module TypeInfo =
|
||||
Events = events
|
||||
ImplementedInterfaces = interfaces
|
||||
DeclaringType = declaringType
|
||||
Layout = layout
|
||||
}
|
||||
|
||||
let isBaseType<'corelib>
|
||||
|
@@ -7,6 +7,7 @@
|
||||
|
||||
<ItemGroup>
|
||||
<Compile Include="StringToken.fs" />
|
||||
<Compile Include="Constants.fs" />
|
||||
<Compile Include="ImmutableArray.fs" />
|
||||
<Compile Include="Tokens.fs" />
|
||||
<Compile Include="TypeRef.fs" />
|
||||
|
@@ -23,7 +23,7 @@ module LoggerFactory =
|
||||
let makeTest () : (unit -> LogLine list) * ILoggerFactory =
|
||||
// Shared sink for all loggers created by the factory.
|
||||
let sink = ResizeArray ()
|
||||
let isEnabled (logLevel : LogLevel) : bool = logLevel >= LogLevel.Debug
|
||||
let isEnabled (logLevel : LogLevel) : bool = logLevel >= LogLevel.Information
|
||||
|
||||
let createLogger (category : string) : ILogger =
|
||||
{ new ILogger with
|
||||
|
@@ -1,5 +1,6 @@
|
||||
namespace WoofWare.Pawprint.Test
|
||||
|
||||
open System
|
||||
open System.Collections.Immutable
|
||||
open System.IO
|
||||
open FsUnitTyped
|
||||
|
@@ -1,5 +1,6 @@
|
||||
namespace WoofWare.Pawprint.Test
|
||||
|
||||
open System
|
||||
open System.Collections.Immutable
|
||||
open System.IO
|
||||
open FsUnitTyped
|
||||
@@ -16,161 +17,65 @@ module TestPureCases =
|
||||
|
||||
let unimplemented =
|
||||
[
|
||||
{
|
||||
FileName = "CrossAssemblyTypes.cs"
|
||||
ExpectedReturnCode = 0
|
||||
NativeImpls = MockEnv.make ()
|
||||
}
|
||||
{
|
||||
FileName = "InitializeArray.cs"
|
||||
ExpectedReturnCode = 0
|
||||
NativeImpls = MockEnv.make ()
|
||||
}
|
||||
{
|
||||
FileName = "GenericEdgeCases.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 = "Sizeof.cs"
|
||||
ExpectedReturnCode = 0
|
||||
NativeImpls = MockEnv.make ()
|
||||
}
|
||||
{
|
||||
FileName = "LdtokenField.cs"
|
||||
ExpectedReturnCode = 0
|
||||
NativeImpls = MockEnv.make ()
|
||||
}
|
||||
{
|
||||
FileName = "AdvancedStructLayout.cs"
|
||||
ExpectedReturnCode = 0
|
||||
NativeImpls = MockEnv.make ()
|
||||
}
|
||||
{
|
||||
FileName = "OverlappingStructs.cs"
|
||||
ExpectedReturnCode = 0
|
||||
NativeImpls = MockEnv.make ()
|
||||
}
|
||||
{
|
||||
FileName = "UnsafeAs.cs"
|
||||
ExpectedReturnCode = 0
|
||||
NativeImpls = MockEnv.make ()
|
||||
}
|
||||
"CrossAssemblyTypes.cs"
|
||||
"OverlappingStructs.cs"
|
||||
"AdvancedStructLayout.cs"
|
||||
"InitializeArray.cs"
|
||||
"Threads.cs"
|
||||
"ComplexTryCatch.cs"
|
||||
"ResizeArray.cs"
|
||||
"LdtokenField.cs"
|
||||
"GenericEdgeCases.cs"
|
||||
"UnsafeAs.cs"
|
||||
]
|
||||
|> Set.ofList
|
||||
|
||||
let requiresMocks =
|
||||
let empty = MockEnv.make ()
|
||||
|
||||
let cases : EndToEndTestCase list =
|
||||
[
|
||||
{
|
||||
FileName = "NoOp.cs"
|
||||
ExpectedReturnCode = 1
|
||||
NativeImpls = MockEnv.make ()
|
||||
}
|
||||
{
|
||||
FileName = "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 ()
|
||||
}
|
||||
{
|
||||
FileName = "Initobj.cs"
|
||||
ExpectedReturnCode = 0
|
||||
NativeImpls = MockEnv.make ()
|
||||
}
|
||||
"BasicLock.cs",
|
||||
(1,
|
||||
{ empty with
|
||||
System_Threading_Monitor = System_Threading_Monitor.passThru
|
||||
})
|
||||
]
|
||||
|> Map.ofList
|
||||
|
||||
let customExitCodes =
|
||||
[
|
||||
"NoOp.cs", 1
|
||||
"CustomDelegate.cs", 8
|
||||
"ExceptionWithNoOpFinally.cs", 3
|
||||
"ExceptionWithNoOpCatch.cs", 10
|
||||
"TryCatchWithThrowInBody.cs", 4
|
||||
"ResizeArray.cs", 114
|
||||
"Threads.cs", 3
|
||||
"TriangleNumber.cs", 10
|
||||
]
|
||||
|> Map.ofList
|
||||
|
||||
let allPure =
|
||||
assy.GetManifestResourceNames ()
|
||||
|> Seq.choose (fun res ->
|
||||
let s = "WoofWare.PawPrint.Test.sourcesPure."
|
||||
|
||||
if res.StartsWith (s, StringComparison.OrdinalIgnoreCase) then
|
||||
res.Substring s.Length |> Some
|
||||
else
|
||||
None
|
||||
)
|
||||
|> Set.ofSeq
|
||||
|
||||
let simpleCases : string list =
|
||||
allPure
|
||||
|> Seq.filter (fun s ->
|
||||
(customExitCodes.ContainsKey s
|
||||
|| requiresMocks.ContainsKey s
|
||||
|| unimplemented.Contains s)
|
||||
|> not
|
||||
)
|
||||
|> Seq.toList
|
||||
|
||||
let runTest (case : EndToEndTestCase) : unit =
|
||||
let source = Assembly.getEmbeddedResourceAsString case.FileName assy
|
||||
@@ -205,9 +110,43 @@ module TestPureCases =
|
||||
|
||||
reraise ()
|
||||
|
||||
[<TestCaseSource(nameof simpleCases)>]
|
||||
let ``Standard tests`` (fileName : string) =
|
||||
{
|
||||
FileName = fileName
|
||||
ExpectedReturnCode = 0
|
||||
NativeImpls = MockEnv.make ()
|
||||
}
|
||||
|> runTest
|
||||
|
||||
[<TestCaseSource(nameof customExitCodes)>]
|
||||
let ``Custom exit code tests`` (KeyValue (fileName : string, exitCode : int)) =
|
||||
if unimplemented.Contains fileName then
|
||||
Assert.Inconclusive ()
|
||||
|
||||
{
|
||||
FileName = fileName
|
||||
ExpectedReturnCode = exitCode
|
||||
NativeImpls = MockEnv.make ()
|
||||
}
|
||||
|> runTest
|
||||
|
||||
[<TestCaseSource(nameof requiresMocks)>]
|
||||
let ``Tests which require mocks`` (KeyValue (fileName : string, (exitCode : int, mock : NativeImpls))) =
|
||||
{
|
||||
FileName = fileName
|
||||
ExpectedReturnCode = exitCode
|
||||
NativeImpls = mock
|
||||
}
|
||||
|> runTest
|
||||
|
||||
|
||||
[<TestCaseSource(nameof unimplemented)>]
|
||||
[<Explicit>]
|
||||
let ``Can evaluate C# files, unimplemented`` (case : EndToEndTestCase) = runTest case
|
||||
|
||||
[<TestCaseSource(nameof cases)>]
|
||||
let ``Can evaluate C# files`` (case : EndToEndTestCase) = runTest case
|
||||
let ``Can evaluate C# files, unimplemented`` (fileName : string) =
|
||||
{
|
||||
FileName = fileName
|
||||
ExpectedReturnCode = 0
|
||||
NativeImpls = MockEnv.make ()
|
||||
}
|
||||
|> runTest
|
||||
|
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;
|
||||
}
|
||||
}
|
@@ -323,10 +323,10 @@ public class StructLayoutTests
|
||||
{
|
||||
int result = 0;
|
||||
|
||||
result = TestSequentialLayout();
|
||||
result = TestExplicitUnion();
|
||||
if (result != 0) return result;
|
||||
|
||||
result = TestExplicitUnion();
|
||||
result = TestSequentialLayout();
|
||||
if (result != 0) return result;
|
||||
|
||||
result = TestFixedSizeStruct();
|
||||
|
@@ -10,16 +10,16 @@ unsafe public class Program
|
||||
|
||||
public struct MediumStruct
|
||||
{
|
||||
public int Value1;
|
||||
public int Value2;
|
||||
public int MediumValue1;
|
||||
public int MediumValue2;
|
||||
}
|
||||
|
||||
public struct LargeStruct
|
||||
{
|
||||
public long Value1;
|
||||
public long Value2;
|
||||
public long Value3;
|
||||
public long Value4;
|
||||
public long LongValue1;
|
||||
public long LongValue2;
|
||||
public long LongValue3;
|
||||
public long LongValue4;
|
||||
}
|
||||
|
||||
public struct NestedStruct
|
||||
|
235
WoofWare.PawPrint.Test/sourcesPure/Sizeof2.cs
Normal file
235
WoofWare.PawPrint.Test/sourcesPure/Sizeof2.cs
Normal file
@@ -0,0 +1,235 @@
|
||||
using System;
|
||||
using System.Runtime.InteropServices;
|
||||
|
||||
unsafe public class Program
|
||||
{
|
||||
// Test for empty struct (should be 1 byte, not 0)
|
||||
public struct EmptyStruct
|
||||
{
|
||||
}
|
||||
|
||||
// Test for char alignment (should align to 2, not 1)
|
||||
public struct CharStruct
|
||||
{
|
||||
public byte B;
|
||||
public char C; // Should be at offset 2, not 1
|
||||
}
|
||||
|
||||
// Test for end padding
|
||||
public struct NeedsEndPadding
|
||||
{
|
||||
public int X;
|
||||
public byte Y;
|
||||
// Should pad to 8 bytes total (multiple of 4)
|
||||
}
|
||||
|
||||
// Test Pack=1 (no padding)
|
||||
[StructLayout(LayoutKind.Sequential, Pack = 1)]
|
||||
public struct PackedStruct
|
||||
{
|
||||
public byte B;
|
||||
public int I; // At offset 1, not 4
|
||||
public byte B2;
|
||||
// Total 6 bytes, no padding
|
||||
}
|
||||
|
||||
// Test Pack=2
|
||||
[StructLayout(LayoutKind.Sequential, Pack = 2)]
|
||||
public struct Pack2Struct
|
||||
{
|
||||
public byte B;
|
||||
public int I; // At offset 2 (2-byte aligned, not 4)
|
||||
public byte B2;
|
||||
// Should pad to 8 bytes (multiple of 2)
|
||||
}
|
||||
|
||||
// Test custom size smaller than natural size
|
||||
[StructLayout(LayoutKind.Sequential, Size = 12)]
|
||||
public struct CustomSizeSmaller
|
||||
{
|
||||
public long L1;
|
||||
public long L2;
|
||||
// Natural size is 16, but Size=12 is ignored (12 < 16)
|
||||
}
|
||||
|
||||
// Test custom size larger than natural size
|
||||
[StructLayout(LayoutKind.Sequential, Size = 20)]
|
||||
public struct CustomSizeLarger
|
||||
{
|
||||
public long L;
|
||||
// Natural size is 8, custom size 20 should win
|
||||
}
|
||||
|
||||
// Test custom size not multiple of alignment
|
||||
[StructLayout(LayoutKind.Sequential, Size = 15)]
|
||||
public struct CustomSizeOdd
|
||||
{
|
||||
public long L;
|
||||
// Size=15 should be honored even though not multiple of 8
|
||||
}
|
||||
|
||||
// Test Pack=0 (means default, not 0)
|
||||
[StructLayout(LayoutKind.Sequential, Pack = 0)]
|
||||
public struct Pack0Struct
|
||||
{
|
||||
public byte B;
|
||||
public int I; // Should be at offset 4 (default packing)
|
||||
}
|
||||
|
||||
// Test both Pack and Size
|
||||
[StructLayout(LayoutKind.Sequential, Pack = 1, Size = 10)]
|
||||
public struct PackAndSize
|
||||
{
|
||||
public byte B;
|
||||
public int I;
|
||||
// Natural packed size is 5, custom size 10 should win
|
||||
}
|
||||
|
||||
// Test explicit with custom Size
|
||||
[StructLayout(LayoutKind.Explicit, Size = 10)]
|
||||
public struct ExplicitWithSize
|
||||
{
|
||||
[FieldOffset(0)]
|
||||
public int I;
|
||||
[FieldOffset(2)]
|
||||
public short S;
|
||||
// Max offset+size is 4, but Size=10 should win
|
||||
}
|
||||
|
||||
public struct SmallStruct
|
||||
{
|
||||
public byte Value;
|
||||
}
|
||||
|
||||
public struct MediumStruct
|
||||
{
|
||||
public int MediumValue1;
|
||||
public int MediumValue2;
|
||||
}
|
||||
|
||||
public struct LargeStruct
|
||||
{
|
||||
public long LongValue1;
|
||||
public long LongValue2;
|
||||
public long LongValue3;
|
||||
public long LongValue4;
|
||||
}
|
||||
|
||||
public struct NestedStruct
|
||||
{
|
||||
public SmallStruct Small;
|
||||
public MediumStruct Medium;
|
||||
public int Extra;
|
||||
}
|
||||
|
||||
[StructLayout(LayoutKind.Explicit)]
|
||||
public struct UnionStruct
|
||||
{
|
||||
[FieldOffset(0)]
|
||||
public int AsInt;
|
||||
[FieldOffset(0)]
|
||||
public float AsFloat;
|
||||
}
|
||||
|
||||
public static int Main(string[] args)
|
||||
{
|
||||
// Test 1: Basic primitive types
|
||||
if (sizeof(byte) != 1) return 1;
|
||||
if (sizeof(sbyte) != 1) return 2;
|
||||
if (sizeof(short) != 2) return 3;
|
||||
if (sizeof(ushort) != 2) return 4;
|
||||
if (sizeof(int) != 4) return 5;
|
||||
if (sizeof(uint) != 4) return 6;
|
||||
if (sizeof(long) != 8) return 7;
|
||||
if (sizeof(ulong) != 8) return 8;
|
||||
if (sizeof(float) != 4) return 9;
|
||||
if (sizeof(double) != 8) return 10;
|
||||
if (sizeof(char) != 2) return 11;
|
||||
if (sizeof(bool) != 1) return 12;
|
||||
|
||||
// Test 2: Struct sizes
|
||||
if (sizeof(SmallStruct) != 1) return 13;
|
||||
if (sizeof(MediumStruct) != 8) return 14;
|
||||
if (sizeof(LargeStruct) != 32) return 15;
|
||||
|
||||
// Test 3: Nested struct size
|
||||
// SmallStruct (1) + padding (3) + MediumStruct (8) + int (4) = 16
|
||||
if (sizeof(NestedStruct) != 16) return 16;
|
||||
|
||||
// Test 4: Union struct size
|
||||
if (sizeof(UnionStruct) != 4) return 17;
|
||||
|
||||
// Test 5: Enum size (underlying type is int)
|
||||
if (sizeof(DayOfWeek) != 4) return 18;
|
||||
|
||||
// Test 6: Empty struct (should be 1, not 0)
|
||||
if (sizeof(EmptyStruct) != 1) return 19;
|
||||
|
||||
// Test 7: Char alignment
|
||||
// byte (1) + padding (1) + char (2) = 4
|
||||
if (sizeof(CharStruct) != 4) return 20;
|
||||
|
||||
// Test 8: End padding
|
||||
// int (4) + byte (1) + padding (3) = 8
|
||||
if (sizeof(NeedsEndPadding) != 8) return 21;
|
||||
|
||||
// Test 9: Pack=1 removes all padding
|
||||
// byte (1) + int (4) + byte (1) = 6
|
||||
if (sizeof(PackedStruct) != 6) return 22;
|
||||
|
||||
// Test 10: Pack=2
|
||||
// byte (1) + padding (1) + int (4) + byte (1) + padding (1) = 8
|
||||
if (sizeof(Pack2Struct) != 8) return 23;
|
||||
|
||||
// Test 11: Custom size smaller than natural (ignored)
|
||||
if (sizeof(CustomSizeSmaller) != 16) return 24;
|
||||
|
||||
// Test 12: Custom size larger than natural (honored)
|
||||
if (sizeof(CustomSizeLarger) != 20) return 25;
|
||||
|
||||
// Test 13: Custom size not multiple of alignment (honored)
|
||||
if (sizeof(CustomSizeOdd) != 15) return 26;
|
||||
|
||||
// Test 14: Pack=0 means default packing
|
||||
// byte (1) + padding (3) + int (4) = 8
|
||||
if (sizeof(Pack0Struct) != 8) return 27;
|
||||
|
||||
// Test 15: Pack and Size together
|
||||
// Natural packed: byte (1) + int (4) = 5, but Size=10
|
||||
if (sizeof(PackAndSize) != 10) return 28;
|
||||
|
||||
// Test 16: Explicit with Size
|
||||
// Max used is 4, but Size=10
|
||||
if (sizeof(ExplicitWithSize) != 10) return 29;
|
||||
|
||||
// Test 17: Pointer types
|
||||
unsafe
|
||||
{
|
||||
if (sizeof(IntPtr) != sizeof(void*)) return 30;
|
||||
if (sizeof(UIntPtr) != sizeof(void*)) return 31;
|
||||
}
|
||||
|
||||
// Test 18: Using sizeof in expressions
|
||||
int totalSize = sizeof(int) + sizeof(long) + sizeof(byte);
|
||||
if (totalSize != 13) return 32;
|
||||
|
||||
// Test 19: Array element size calculation
|
||||
int arrayElementSize = sizeof(MediumStruct);
|
||||
int arraySize = arrayElementSize * 3;
|
||||
if (arraySize != 24) return 33;
|
||||
|
||||
// Test 20: Complex nested struct with Pack
|
||||
// byte (1) + CharStruct (4) + byte (1) = 6
|
||||
if (sizeof(PackedNested) != 6) return 34;
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
[StructLayout(LayoutKind.Sequential, Pack = 1)]
|
||||
struct PackedNested
|
||||
{
|
||||
public byte B;
|
||||
public CharStruct C;
|
||||
public byte B2;
|
||||
}
|
||||
}
|
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 {
|
||||
WasConstructingObj = Some _
|
||||
} ->
|
||||
IlMachineState.executeDelegateConstructor instruction state
|
||||
IlMachineState.executeDelegateConstructor baseClassTypes instruction state
|
||||
// can't advance the program counter here - there's no IL instructions executing!
|
||||
|> IlMachineState.returnStackFrame loggerFactory baseClassTypes thread
|
||||
|> Option.get
|
||||
@@ -54,7 +54,7 @@ module AbstractMachine =
|
||||
// We've been instructed to run a delegate.
|
||||
let delegateToRunAddr =
|
||||
match instruction.Arguments.[0] with
|
||||
| CliType.RuntimePointer (CliRuntimePointer.Managed (CliRuntimePointerSource.Heap addr))
|
||||
| CliType.RuntimePointer (CliRuntimePointer.Managed (ManagedPointerSource.Heap addr))
|
||||
| CliType.ObjectRef (Some addr) -> addr
|
||||
| _ -> failwith "expected a managed object ref to delegate"
|
||||
|
||||
@@ -222,5 +222,5 @@ module AbstractMachine =
|
||||
|> ExecutionResult.Stepped
|
||||
| IlOp.Switch immutableArray -> failwith "TODO: Switch unimplemented"
|
||||
| IlOp.UnaryStringToken (unaryStringTokenIlOp, stringHandle) ->
|
||||
UnaryStringTokenIlOp.execute baseClassTypes unaryStringTokenIlOp stringHandle state thread
|
||||
UnaryStringTokenIlOp.execute loggerFactory baseClassTypes unaryStringTokenIlOp stringHandle state thread
|
||||
|> ExecutionResult.Stepped
|
||||
|
@@ -1,8 +1,9 @@
|
||||
namespace WoofWare.PawPrint
|
||||
|
||||
open System
|
||||
open System.Collections.Immutable
|
||||
open System.Reflection
|
||||
open System.Reflection.Metadata
|
||||
open Checked
|
||||
|
||||
/// Source:
|
||||
/// Table I.6: Data Types Directly Supported by the CLI
|
||||
@@ -43,6 +44,7 @@ type ManagedPointerSource =
|
||||
| ArrayIndex of arr : ManagedHeapAddress * index : int
|
||||
| Field of ManagedPointerSource * fieldName : string
|
||||
| Null
|
||||
| InterpretedAsType of ManagedPointerSource * ConcreteType<ConcreteTypeHandle>
|
||||
|
||||
override this.ToString () =
|
||||
match this with
|
||||
@@ -54,6 +56,7 @@ type ManagedPointerSource =
|
||||
$"<argument %i{var} in method frame %i{method} of thread %O{source}>"
|
||||
| ManagedPointerSource.ArrayIndex (arr, index) -> $"<index %i{index} of array %O{arr}>"
|
||||
| ManagedPointerSource.Field (source, name) -> $"<field %s{name} of %O{source}>"
|
||||
| ManagedPointerSource.InterpretedAsType (src, ty) -> $"<%O{src} as %s{ty.Namespace}.%s{ty.Name}>"
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
type UnsignedNativeIntSource =
|
||||
@@ -66,6 +69,7 @@ type NativeIntSource =
|
||||
| ManagedPointer of ManagedPointerSource
|
||||
| FunctionPointer of MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle>
|
||||
| TypeHandlePtr of ConcreteTypeHandle
|
||||
| FieldHandlePtr of int64
|
||||
|
||||
override this.ToString () : string =
|
||||
match this with
|
||||
@@ -74,12 +78,14 @@ type NativeIntSource =
|
||||
| NativeIntSource.FunctionPointer methodDefinition ->
|
||||
$"<pointer to {methodDefinition.Name} in {methodDefinition.DeclaringType.Assembly.Name}>"
|
||||
| NativeIntSource.TypeHandlePtr ptr -> $"<type ID %O{ptr}>"
|
||||
| NativeIntSource.FieldHandlePtr ptr -> $"<field ID %O{ptr}>"
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module NativeIntSource =
|
||||
let isZero (n : NativeIntSource) : bool =
|
||||
match n with
|
||||
| NativeIntSource.Verbatim i -> i = 0L
|
||||
| NativeIntSource.FieldHandlePtr _
|
||||
| NativeIntSource.TypeHandlePtr _ -> false
|
||||
| NativeIntSource.FunctionPointer _ -> failwith "TODO"
|
||||
| NativeIntSource.ManagedPointer src ->
|
||||
@@ -91,6 +97,7 @@ module NativeIntSource =
|
||||
match n with
|
||||
| NativeIntSource.Verbatim i -> i >= 0L
|
||||
| NativeIntSource.FunctionPointer _ -> failwith "TODO"
|
||||
| NativeIntSource.FieldHandlePtr _
|
||||
| NativeIntSource.TypeHandlePtr _ -> true
|
||||
| NativeIntSource.ManagedPointer _ -> true
|
||||
|
||||
@@ -115,46 +122,51 @@ type CliNumericType =
|
||||
| Float32 of float32
|
||||
| Float64 of float
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
type CliRuntimePointerSource =
|
||||
| LocalVariable of sourceThread : ThreadId * methodFrame : int * whichVar : uint16
|
||||
| Argument of sourceThread : ThreadId * methodFrame : int * whichVar : uint16
|
||||
| Field of source : CliRuntimePointerSource * fieldName : string
|
||||
| Heap of ManagedHeapAddress
|
||||
| ArrayIndex of arr : ManagedHeapAddress * index : int
|
||||
| Null
|
||||
static member SizeOf (t : CliNumericType) : int =
|
||||
match t with
|
||||
| CliNumericType.Int32 _ -> 4
|
||||
| CliNumericType.Int64 _ -> 8
|
||||
| CliNumericType.NativeInt _ -> 8
|
||||
| CliNumericType.NativeFloat _ -> 8
|
||||
| CliNumericType.Int8 _ -> 1
|
||||
| CliNumericType.Int16 _ -> 2
|
||||
| CliNumericType.UInt8 _ -> 1
|
||||
| CliNumericType.UInt16 _ -> 2
|
||||
| CliNumericType.Float32 _ -> 4
|
||||
| CliNumericType.Float64 _ -> 8
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module CliRuntimePointerSource =
|
||||
let rec ofManagedPointerSource (ptrSource : ManagedPointerSource) : CliRuntimePointerSource =
|
||||
match ptrSource with
|
||||
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
|
||||
CliRuntimePointerSource.LocalVariable (sourceThread, methodFrame, whichVar)
|
||||
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
|
||||
CliRuntimePointerSource.Argument (sourceThread, methodFrame, whichVar)
|
||||
| ManagedPointerSource.Heap managedHeapAddress -> CliRuntimePointerSource.Heap managedHeapAddress
|
||||
| ManagedPointerSource.Null -> CliRuntimePointerSource.Null
|
||||
| ManagedPointerSource.ArrayIndex (arr, ind) -> CliRuntimePointerSource.ArrayIndex (arr, ind)
|
||||
| ManagedPointerSource.Field (a, ind) ->
|
||||
let a = ofManagedPointerSource a
|
||||
CliRuntimePointerSource.Field (a, ind)
|
||||
|
||||
let rec toManagedPointerSource (ptrSource : CliRuntimePointerSource) : ManagedPointerSource =
|
||||
match ptrSource with
|
||||
| CliRuntimePointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
|
||||
ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar)
|
||||
| CliRuntimePointerSource.Argument (sourceThread, methodFrame, whichVar) ->
|
||||
ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar)
|
||||
| CliRuntimePointerSource.Heap managedHeapAddress -> ManagedPointerSource.Heap managedHeapAddress
|
||||
| CliRuntimePointerSource.Null -> ManagedPointerSource.Null
|
||||
| CliRuntimePointerSource.ArrayIndex (arr, ind) -> ManagedPointerSource.ArrayIndex (arr, ind)
|
||||
| CliRuntimePointerSource.Field (a, ind) ->
|
||||
let a = toManagedPointerSource a
|
||||
ManagedPointerSource.Field (a, ind)
|
||||
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 =
|
||||
| Unmanaged of int64
|
||||
| Managed of CliRuntimePointerSource
|
||||
| Verbatim of int64
|
||||
| FieldRegistryHandle of int64
|
||||
| Managed of ManagedPointerSource
|
||||
|
||||
type SizeofResult =
|
||||
{
|
||||
Alignment : int
|
||||
Size : int
|
||||
}
|
||||
|
||||
/// This is the kind of type that can be stored in arguments, local variables, statics, array elements, fields.
|
||||
type CliType =
|
||||
@@ -172,27 +184,349 @@ type CliType =
|
||||
/// as a concatenated list of its fields.
|
||||
| ValueType of CliValueType
|
||||
|
||||
static member SizeOf (t : CliType) : SizeofResult =
|
||||
match t with
|
||||
| CliType.Numeric ty ->
|
||||
let size = CliNumericType.SizeOf ty
|
||||
|
||||
{
|
||||
Size = size
|
||||
Alignment = size
|
||||
}
|
||||
| CliType.Bool _ ->
|
||||
{
|
||||
Size = 1
|
||||
Alignment = 1
|
||||
}
|
||||
| CliType.Char _ ->
|
||||
{
|
||||
Size = 2
|
||||
Alignment = 2
|
||||
}
|
||||
| CliType.ObjectRef _ ->
|
||||
{
|
||||
Size = 8
|
||||
Alignment = 8
|
||||
}
|
||||
| CliType.RuntimePointer _ ->
|
||||
{
|
||||
Size = 8
|
||||
Alignment = 8
|
||||
}
|
||||
| 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 =
|
||||
{
|
||||
Name : string
|
||||
Contents : CliType
|
||||
/// "None" for "no explicit offset specified"; we expect most offsets to be None.
|
||||
Offset : int option
|
||||
Type : ConcreteTypeHandle
|
||||
}
|
||||
|
||||
and CliValueType =
|
||||
{
|
||||
Fields : CliField list
|
||||
}
|
||||
|
||||
static member OfFields (f : CliField list) =
|
||||
and CliConcreteField =
|
||||
private
|
||||
{
|
||||
Fields = f
|
||||
Name : string
|
||||
Contents : CliType
|
||||
Offset : int
|
||||
Size : int
|
||||
Alignment : int
|
||||
ConfiguredOffset : int option
|
||||
EditedAtTime : uint64
|
||||
Type : ConcreteTypeHandle
|
||||
}
|
||||
|
||||
static member DereferenceField (name : string) (f : CliValueType) : CliType =
|
||||
// TODO: this is wrong, it doesn't account for overlapping fields
|
||||
f.Fields |> List.find (fun f -> f.Name = name) |> _.Contents
|
||||
static member ToCliField (this : CliConcreteField) : CliField =
|
||||
{
|
||||
Offset = this.ConfiguredOffset
|
||||
Contents = this.Contents
|
||||
Name = this.Name
|
||||
Type = this.Type
|
||||
}
|
||||
|
||||
and CliValueType =
|
||||
private
|
||||
{
|
||||
_Fields : CliConcreteField list
|
||||
Layout : Layout
|
||||
/// We track dependency orderings between updates to overlapping fields with a monotonically increasing
|
||||
/// timestamp.
|
||||
NextTimestamp : uint64
|
||||
}
|
||||
|
||||
static member private ComputeConcreteFields (layout : Layout) (fields : CliField list) : CliConcreteField list =
|
||||
// Minimum size only matters for `sizeof` computation
|
||||
let _minimumSize, packingSize =
|
||||
match layout with
|
||||
| Layout.Custom (size = size ; packingSize = packing) ->
|
||||
size, if packing = 0 then DEFAULT_STRUCT_ALIGNMENT else packing
|
||||
| Layout.Default -> 0, DEFAULT_STRUCT_ALIGNMENT
|
||||
|
||||
let seqFields, nonSeqFields =
|
||||
fields |> List.partition (fun field -> field.Offset.IsNone)
|
||||
|
||||
match seqFields, nonSeqFields with
|
||||
| [], [] -> []
|
||||
| _ :: _, [] ->
|
||||
// Sequential layout: compute offsets respecting alignment
|
||||
let _, concreteFields =
|
||||
((0, []), seqFields)
|
||||
||> List.fold (fun (currentOffset, acc) field ->
|
||||
let size = CliType.SizeOf field.Contents
|
||||
let alignmentCap = min size.Alignment packingSize
|
||||
let error = currentOffset % alignmentCap
|
||||
|
||||
let alignedOffset =
|
||||
if error > 0 then
|
||||
currentOffset + (alignmentCap - error)
|
||||
else
|
||||
currentOffset
|
||||
|
||||
let concreteField =
|
||||
{
|
||||
Name = field.Name
|
||||
Contents = field.Contents
|
||||
Offset = alignedOffset
|
||||
Size = size.Size
|
||||
Alignment = size.Alignment
|
||||
ConfiguredOffset = field.Offset
|
||||
EditedAtTime = 0UL
|
||||
Type = field.Type
|
||||
}
|
||||
|
||||
alignedOffset + size.Size, concreteField :: acc
|
||||
)
|
||||
|
||||
List.rev concreteFields
|
||||
|
||||
| [], _ :: _ ->
|
||||
// Explicit layout: use provided offsets
|
||||
nonSeqFields
|
||||
|> List.map (fun field ->
|
||||
let size = CliType.SizeOf field.Contents
|
||||
|
||||
{
|
||||
Name = field.Name
|
||||
Contents = field.Contents
|
||||
Offset = field.Offset.Value
|
||||
Size = size.Size
|
||||
Alignment = size.Alignment
|
||||
ConfiguredOffset = field.Offset
|
||||
EditedAtTime = 0UL
|
||||
Type = field.Type
|
||||
}
|
||||
)
|
||||
|
||||
| _ :: _, _ :: _ -> 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 =
|
||||
let fields = CliValueType.ComputeConcreteFields layout f
|
||||
|
||||
{
|
||||
_Fields = fields
|
||||
Layout = layout
|
||||
NextTimestamp = 1UL
|
||||
}
|
||||
|
||||
static member AddField (f : CliField) (vt : CliValueType) : CliValueType =
|
||||
// Recompute all fields with the new one added
|
||||
// TODO: the existence of this function at all is rather dubious, but it's there
|
||||
// at the moment to support delegate types.
|
||||
// The whole function is just a bodge and it will hopefully go away soon; I just don't know how.
|
||||
let prevFields = vt._Fields |> List.map (fun f -> f.Name, f) |> Map.ofList
|
||||
|
||||
let allFields =
|
||||
f
|
||||
:: (vt._Fields
|
||||
|> List.map (fun cf ->
|
||||
{
|
||||
Name = cf.Name
|
||||
Contents = cf.Contents
|
||||
Offset =
|
||||
match vt.Layout with
|
||||
| Layout.Default -> None
|
||||
| Layout.Custom _ -> Some cf.Offset
|
||||
Type = cf.Type
|
||||
}
|
||||
))
|
||||
|
||||
let newFields =
|
||||
CliValueType.ComputeConcreteFields vt.Layout allFields
|
||||
|> List.map (fun field ->
|
||||
match Map.tryFind field.Name prevFields with
|
||||
| Some prev ->
|
||||
{ field with
|
||||
EditedAtTime = prev.EditedAtTime
|
||||
}
|
||||
| None ->
|
||||
{ field with
|
||||
EditedAtTime = vt.NextTimestamp
|
||||
}
|
||||
)
|
||||
|
||||
{
|
||||
_Fields = newFields
|
||||
Layout = vt.Layout
|
||||
NextTimestamp = vt.NextTimestamp + 1UL
|
||||
}
|
||||
|
||||
/// 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
|
||||
// as though it were any other field of any other type, to accommodate Unsafe.As.
|
||||
static member DereferenceField (field : string) (cvt : CliValueType) : CliType =
|
||||
let targetField =
|
||||
cvt._Fields
|
||||
|> List.tryFind (fun f -> f.Name = field)
|
||||
|> Option.defaultWith (fun () -> failwithf $"Field '%s{field}' not found")
|
||||
|
||||
// Identify all fields that overlap with the target field's memory range
|
||||
let targetStart = targetField.Offset
|
||||
let targetEnd = targetField.Offset + targetField.Size
|
||||
|
||||
let affectedFields =
|
||||
cvt._Fields
|
||||
|> List.filter (fun f ->
|
||||
let fieldStart = f.Offset
|
||||
let fieldEnd = f.Offset + f.Size
|
||||
// Fields overlap if their ranges intersect
|
||||
fieldStart < targetEnd && targetStart < fieldEnd
|
||||
)
|
||||
|
||||
match affectedFields with
|
||||
| [] -> failwith "unexpectedly didn't dereference a field"
|
||||
| [ f ] -> f.Contents
|
||||
| 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 =
|
||||
let targetField =
|
||||
CliValueType.FieldsAt offset cvt |> List.tryFind (fun f -> f.Size = size)
|
||||
|
||||
match targetField with
|
||||
| None -> failwith "TODO: couldn't find the field"
|
||||
| Some f -> f.Contents
|
||||
|
||||
static member SizeOf (vt : CliValueType) : SizeofResult =
|
||||
let minimumSize, packingSize =
|
||||
match vt.Layout with
|
||||
| Layout.Custom (size = size ; packingSize = packing) ->
|
||||
size, if packing = 0 then DEFAULT_STRUCT_ALIGNMENT else packing
|
||||
| Layout.Default -> 0, DEFAULT_STRUCT_ALIGNMENT
|
||||
|
||||
if vt._Fields.IsEmpty then
|
||||
{
|
||||
Size = minimumSize
|
||||
Alignment = 1
|
||||
}
|
||||
else
|
||||
// Now we can just use the precomputed offsets and sizes
|
||||
let finalOffset, alignment =
|
||||
vt._Fields
|
||||
|> List.fold
|
||||
(fun (maxEnd, maxAlign) field ->
|
||||
let fieldEnd = field.Offset + field.Size
|
||||
let alignmentCap = min field.Alignment packingSize
|
||||
max maxEnd fieldEnd, max maxAlign alignmentCap
|
||||
)
|
||||
(0, 0)
|
||||
|
||||
let error = finalOffset % alignment
|
||||
|
||||
let size =
|
||||
if error = 0 then
|
||||
finalOffset
|
||||
else
|
||||
finalOffset + (alignment - error)
|
||||
|
||||
{
|
||||
Size = max size minimumSize
|
||||
Alignment = alignment
|
||||
}
|
||||
|
||||
/// Sets the value of the specified field, *without* touching any overlapping fields.
|
||||
/// `DereferenceField` handles resolving conflicts between overlapping fields.
|
||||
static member WithFieldSet (field : string) (value : CliType) (cvt : CliValueType) : CliValueType =
|
||||
{
|
||||
Layout = cvt.Layout
|
||||
_Fields =
|
||||
cvt._Fields
|
||||
|> List.replaceWhere (fun f ->
|
||||
if f.Name = field then
|
||||
{ f with
|
||||
Contents = value
|
||||
EditedAtTime = cvt.NextTimestamp
|
||||
}
|
||||
|> Some
|
||||
else
|
||||
None
|
||||
)
|
||||
NextTimestamp = cvt.NextTimestamp + 1UL
|
||||
}
|
||||
|
||||
/// To facilitate bodges. This function absolutely should not exist.
|
||||
static member TryExactlyOneField (cvt : CliValueType) : CliField option =
|
||||
match cvt._Fields with
|
||||
| [] -> None
|
||||
| [ x ] ->
|
||||
if x.Offset = 0 then
|
||||
Some (CliConcreteField.ToCliField x)
|
||||
else
|
||||
None
|
||||
| _ -> None
|
||||
|
||||
/// To facilitate bodges. This function absolutely should not exist.
|
||||
static member TrySequentialFields (cvt : CliValueType) : CliField list option =
|
||||
let isNone, isSome =
|
||||
cvt._Fields |> List.partition (fun field -> field.ConfiguredOffset.IsNone)
|
||||
|
||||
match isSome with
|
||||
| [] -> Some (isNone |> List.map CliConcreteField.ToCliField)
|
||||
| [ field ] when field.ConfiguredOffset = Some 0 -> Some [ CliConcreteField.ToCliField field ]
|
||||
| _ -> None
|
||||
|
||||
type CliTypeResolutionResult =
|
||||
| Resolved of CliType
|
||||
@@ -208,33 +542,14 @@ module CliType =
|
||||
|
||||
let ofManagedObject (ptr : ManagedHeapAddress) : CliType = CliType.ObjectRef (Some ptr)
|
||||
|
||||
let rec sizeOf (ty : CliType) : int =
|
||||
match ty with
|
||||
| CliType.Numeric ty ->
|
||||
match ty with
|
||||
| CliNumericType.Int32 _ -> 4
|
||||
| CliNumericType.Int64 _ -> 8
|
||||
| CliNumericType.NativeInt _ -> 8
|
||||
| CliNumericType.NativeFloat _ -> 8
|
||||
| CliNumericType.Int8 _ -> 1
|
||||
| CliNumericType.Int16 _ -> 2
|
||||
| CliNumericType.UInt8 _ -> 1
|
||||
| CliNumericType.UInt16 _ -> 2
|
||||
| CliNumericType.Float32 _ -> 4
|
||||
| CliNumericType.Float64 _ -> 8
|
||||
| CliType.Bool _ -> 1
|
||||
| CliType.Char _ -> 2
|
||||
| CliType.ObjectRef _ -> 8
|
||||
| CliType.RuntimePointer _ -> 8
|
||||
| CliType.ValueType vt ->
|
||||
match vt.Fields with
|
||||
| [] -> failwith "is it even possible to instantiate a value type with no fields"
|
||||
| [ field ] -> sizeOf field.Contents
|
||||
| fields ->
|
||||
// TODO: consider struct layout (there's an `Explicit` test that will exercise that)
|
||||
fields |> List.map (_.Contents >> sizeOf) |> List.sum
|
||||
let 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
|
||||
| PrimitiveType.Boolean -> CliType.Bool 0uy
|
||||
| PrimitiveType.Char -> CliType.Char (0uy, 0uy)
|
||||
@@ -257,20 +572,36 @@ module CliType =
|
||||
| PrimitiveType.IntPtr ->
|
||||
{
|
||||
Name = "_value"
|
||||
Contents = CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null)
|
||||
Offset = Some 0
|
||||
Contents =
|
||||
CliType.Numeric (
|
||||
CliNumericType.NativeInt (NativeIntSource.ManagedPointer ManagedPointerSource.Null)
|
||||
)
|
||||
Offset = None
|
||||
Type =
|
||||
AllConcreteTypes.findExistingConcreteType
|
||||
concreteTypes
|
||||
(corelib.IntPtr.Assembly, corelib.IntPtr.Namespace, corelib.IntPtr.Name, ImmutableArray.Empty)
|
||||
|> Option.get
|
||||
}
|
||||
|> List.singleton
|
||||
|> CliValueType.OfFields
|
||||
|> CliValueType.OfFields Layout.Default
|
||||
|> CliType.ValueType
|
||||
| PrimitiveType.UIntPtr ->
|
||||
{
|
||||
Name = "_value"
|
||||
Contents = CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null)
|
||||
Offset = Some 0
|
||||
Contents =
|
||||
CliType.Numeric (
|
||||
CliNumericType.NativeInt (NativeIntSource.ManagedPointer ManagedPointerSource.Null)
|
||||
)
|
||||
Offset = None
|
||||
Type =
|
||||
AllConcreteTypes.findExistingConcreteType
|
||||
concreteTypes
|
||||
(corelib.UIntPtr.Assembly, corelib.UIntPtr.Namespace, corelib.UIntPtr.Name, ImmutableArray.Empty)
|
||||
|> Option.get
|
||||
}
|
||||
|> List.singleton
|
||||
|> CliValueType.OfFields
|
||||
|> CliValueType.OfFields Layout.Default
|
||||
|> CliType.ValueType
|
||||
| PrimitiveType.Object -> CliType.ObjectRef None
|
||||
|
||||
@@ -296,11 +627,11 @@ module CliType =
|
||||
match handle with
|
||||
| ConcreteTypeHandle.Byref _ ->
|
||||
// Byref types are managed references - the zero value is a null reference
|
||||
CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null), concreteTypes
|
||||
CliType.RuntimePointer (CliRuntimePointer.Managed ManagedPointerSource.Null), concreteTypes
|
||||
|
||||
| ConcreteTypeHandle.Pointer _ ->
|
||||
// Pointer types are unmanaged pointers - the zero value is a null pointer
|
||||
CliType.RuntimePointer (CliRuntimePointer.Unmanaged 0L), concreteTypes
|
||||
CliType.RuntimePointer (CliRuntimePointer.Managed ManagedPointerSource.Null), concreteTypes
|
||||
|
||||
| ConcreteTypeHandle.Concrete _ ->
|
||||
// This is a concrete type - look it up in the mapping
|
||||
@@ -314,72 +645,82 @@ module CliType =
|
||||
let typeDef = assembly.TypeDefs.[concreteType.Definition.Get]
|
||||
|
||||
// Check if it's a primitive type by comparing with corelib types FIRST
|
||||
if concreteType.Assembly = corelib.Corelib.Name && concreteType.Generics.IsEmpty then
|
||||
if
|
||||
concreteType.Assembly.FullName = corelib.Corelib.Name.FullName
|
||||
&& concreteType.Generics.IsEmpty
|
||||
then
|
||||
// Check against known primitive types
|
||||
if TypeInfo.NominallyEqual typeDef corelib.Boolean then
|
||||
zeroOfPrimitive PrimitiveType.Boolean, concreteTypes
|
||||
zeroOfPrimitive concreteTypes corelib PrimitiveType.Boolean, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.Char then
|
||||
zeroOfPrimitive PrimitiveType.Char, concreteTypes
|
||||
zeroOfPrimitive concreteTypes corelib PrimitiveType.Char, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.SByte then
|
||||
zeroOfPrimitive PrimitiveType.SByte, concreteTypes
|
||||
zeroOfPrimitive concreteTypes corelib PrimitiveType.SByte, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.Byte then
|
||||
zeroOfPrimitive PrimitiveType.Byte, concreteTypes
|
||||
zeroOfPrimitive concreteTypes corelib PrimitiveType.Byte, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.Int16 then
|
||||
zeroOfPrimitive PrimitiveType.Int16, concreteTypes
|
||||
zeroOfPrimitive concreteTypes corelib PrimitiveType.Int16, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.UInt16 then
|
||||
zeroOfPrimitive PrimitiveType.UInt16, concreteTypes
|
||||
zeroOfPrimitive concreteTypes corelib PrimitiveType.UInt16, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.Int32 then
|
||||
zeroOfPrimitive PrimitiveType.Int32, concreteTypes
|
||||
zeroOfPrimitive concreteTypes corelib PrimitiveType.Int32, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.UInt32 then
|
||||
zeroOfPrimitive PrimitiveType.UInt32, concreteTypes
|
||||
zeroOfPrimitive concreteTypes corelib PrimitiveType.UInt32, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.Int64 then
|
||||
zeroOfPrimitive PrimitiveType.Int64, concreteTypes
|
||||
zeroOfPrimitive concreteTypes corelib PrimitiveType.Int64, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.UInt64 then
|
||||
zeroOfPrimitive PrimitiveType.UInt64, concreteTypes
|
||||
zeroOfPrimitive concreteTypes corelib PrimitiveType.UInt64, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.Single then
|
||||
zeroOfPrimitive PrimitiveType.Single, concreteTypes
|
||||
zeroOfPrimitive concreteTypes corelib PrimitiveType.Single, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.Double then
|
||||
zeroOfPrimitive PrimitiveType.Double, concreteTypes
|
||||
zeroOfPrimitive concreteTypes corelib PrimitiveType.Double, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.String then
|
||||
zeroOfPrimitive PrimitiveType.String, concreteTypes
|
||||
zeroOfPrimitive concreteTypes corelib PrimitiveType.String, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.Object then
|
||||
zeroOfPrimitive PrimitiveType.Object, concreteTypes
|
||||
zeroOfPrimitive concreteTypes corelib PrimitiveType.Object, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.IntPtr then
|
||||
zeroOfPrimitive PrimitiveType.IntPtr, concreteTypes
|
||||
zeroOfPrimitive concreteTypes corelib PrimitiveType.IntPtr, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.UIntPtr then
|
||||
zeroOfPrimitive PrimitiveType.UIntPtr, concreteTypes
|
||||
else if
|
||||
// Check if it's an array type
|
||||
typeDef = corelib.Array
|
||||
then
|
||||
CliType.ObjectRef None, concreteTypes // Arrays are reference types
|
||||
zeroOfPrimitive concreteTypes corelib PrimitiveType.UIntPtr, concreteTypes
|
||||
elif TypeInfo.NominallyEqual typeDef corelib.Array then
|
||||
// Arrays are reference types
|
||||
CliType.ObjectRef None, concreteTypes
|
||||
else if
|
||||
|
||||
// Not a known primitive, now check for cycles
|
||||
Set.contains handle visited
|
||||
then
|
||||
// We're in a cycle - return a default zero value for the type
|
||||
// For value types in cycles, we'll return a null reference as a safe fallback
|
||||
// This should only happen with self-referential types
|
||||
// Value types can't be self-referential unless they are specifically known to the
|
||||
// runtime - for example, System.Byte is a value type with a single field,
|
||||
// of type System.Byte.
|
||||
// Since we check for (nominal) equality against all such types in the first branch,
|
||||
// this code path is only hit with reference types.
|
||||
CliType.ObjectRef None, concreteTypes
|
||||
else
|
||||
let visited = Set.add handle visited
|
||||
// Not a known primitive, check if it's a value type or reference type
|
||||
determineZeroForCustomType concreteTypes assemblies corelib handle concreteType typeDef visited
|
||||
else if
|
||||
|
||||
// Not from corelib or has generics
|
||||
concreteType.Assembly = corelib.Corelib.Name
|
||||
&& typeDef = corelib.Array
|
||||
&& concreteType.Generics.Length = 1
|
||||
then
|
||||
// This is an array type
|
||||
// This is an array type, so null is appropriate
|
||||
CliType.ObjectRef None, concreteTypes
|
||||
else if
|
||||
|
||||
// Custom type - now check for cycles
|
||||
Set.contains handle visited
|
||||
then
|
||||
// We're in a cycle - return a default zero value for the type
|
||||
// For value types in cycles, we'll return a null reference as a safe fallback
|
||||
// This should only happen with self-referential types
|
||||
// We're in a cycle - return a default zero value for the type.
|
||||
// Value types can't be self-referential unless they are specifically known to the
|
||||
// runtime - for example, System.Byte is a value type with a single field,
|
||||
// of type System.Byte.
|
||||
// Since we check for (nominal) equality against all such types in the first branch,
|
||||
// this code path is only hit with reference types.
|
||||
CliType.ObjectRef None, concreteTypes
|
||||
else
|
||||
let visited = Set.add handle visited
|
||||
@@ -430,9 +771,10 @@ module CliType =
|
||||
Name = field.Name
|
||||
Contents = fieldZero
|
||||
Offset = field.Offset
|
||||
Type = fieldHandle
|
||||
}
|
||||
)
|
||||
|> CliValueType.OfFields
|
||||
|> CliValueType.OfFields typeDef.Layout
|
||||
|
||||
CliType.ValueType vt, currentConcreteTypes
|
||||
else
|
||||
@@ -460,20 +802,22 @@ module CliType =
|
||||
// The field type might reference generic parameters of the declaring type
|
||||
let methodGenerics = ImmutableArray.Empty // Fields don't have method generics
|
||||
|
||||
let loadAssembly
|
||||
(assyName : AssemblyName)
|
||||
(ref : AssemblyReferenceHandle)
|
||||
: ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly
|
||||
=
|
||||
match assemblies.TryGetValue assyName.FullName with
|
||||
| true, currentAssy ->
|
||||
let targetAssyRef = currentAssy.AssemblyReferences.[ref]
|
||||
let loadAssembly =
|
||||
{ new IAssemblyLoad with
|
||||
member _.LoadAssembly loaded assyName ref =
|
||||
match loaded.TryGetValue assyName.FullName with
|
||||
| true, currentAssy ->
|
||||
let targetAssyRef = currentAssy.AssemblyReferences.[ref]
|
||||
|
||||
match assemblies.TryGetValue targetAssyRef.Name.FullName with
|
||||
| true, targetAssy -> assemblies, targetAssy
|
||||
| false, _ ->
|
||||
failwithf "Assembly %s not loaded when trying to resolve reference" targetAssyRef.Name.FullName
|
||||
| false, _ -> failwithf "Current assembly %s not loaded when trying to resolve reference" assyName.FullName
|
||||
match loaded.TryGetValue targetAssyRef.Name.FullName with
|
||||
| true, targetAssy -> loaded, targetAssy
|
||||
| false, _ ->
|
||||
failwithf
|
||||
"Assembly %s not loaded when trying to resolve reference"
|
||||
targetAssyRef.Name.FullName
|
||||
| false, _ ->
|
||||
failwithf "Current assembly %s not loaded when trying to resolve reference" assyName.FullName
|
||||
}
|
||||
|
||||
let handle, newCtx =
|
||||
TypeConcretization.concretizeType
|
||||
@@ -493,21 +837,7 @@ module CliType =
|
||||
| CliType.Char (high, low) -> failwith "todo"
|
||||
| CliType.ObjectRef managedHeapAddressOption -> failwith "todo"
|
||||
| CliType.RuntimePointer cliRuntimePointer -> failwith "todo"
|
||||
| CliType.ValueType cvt ->
|
||||
{
|
||||
Fields =
|
||||
cvt.Fields
|
||||
|> List.replaceWhere (fun f ->
|
||||
if f.Name = field then
|
||||
{ f with
|
||||
Contents = value
|
||||
}
|
||||
|> Some
|
||||
else
|
||||
None
|
||||
)
|
||||
}
|
||||
|> CliType.ValueType
|
||||
| CliType.ValueType cvt -> CliValueType.WithFieldSet field value cvt |> CliType.ValueType
|
||||
|
||||
let getField (field : string) (value : CliType) : CliType =
|
||||
match value with
|
||||
@@ -516,6 +846,24 @@ module CliType =
|
||||
| CliType.Char (high, low) -> failwith "todo"
|
||||
| CliType.ObjectRef managedHeapAddressOption -> failwith "todo"
|
||||
| CliType.RuntimePointer cliRuntimePointer -> failwith "todo"
|
||||
| CliType.ValueType cvt ->
|
||||
cvt.Fields
|
||||
|> List.pick (fun f -> if f.Name = field then Some f.Contents else None)
|
||||
| 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,25 +4,133 @@ namespace WoofWare.PawPrint
|
||||
|
||||
type IArithmeticOperation =
|
||||
abstract Int32Int32 : int32 -> int32 -> int32
|
||||
abstract Int32NativeInt : int32 -> nativeint -> nativeint
|
||||
abstract NativeIntInt32 : nativeint -> int32 -> nativeint
|
||||
abstract Int64Int64 : int64 -> int64 -> int64
|
||||
abstract FloatFloat : float -> float -> float
|
||||
abstract NativeIntNativeInt : nativeint -> nativeint -> nativeint
|
||||
abstract Int32ManagedPtr : IlMachineState -> int32 -> ManagedPointerSource -> Choice<ManagedPointerSource, int>
|
||||
abstract ManagedPtrInt32 : IlMachineState -> ManagedPointerSource -> int32 -> Choice<ManagedPointerSource, int>
|
||||
|
||||
abstract ManagedPtrManagedPtr :
|
||||
IlMachineState -> ManagedPointerSource -> ManagedPointerSource -> Choice<ManagedPointerSource, nativeint>
|
||||
|
||||
abstract Name : string
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module ArithmeticOperation =
|
||||
let private addInt32ManagedPtr state v ptr =
|
||||
match ptr with
|
||||
| LocalVariable (sourceThread, methodFrame, whichVar) -> failwith "refusing to add to a local variable address"
|
||||
| Argument (sourceThread, methodFrame, whichVar) -> failwith "refusing to add to an argument address"
|
||||
| Heap managedHeapAddress -> failwith "refusing to add to a heap address"
|
||||
| ArrayIndex (arr, index) -> failwith "TODO: arrays"
|
||||
| Field (src, fieldName) ->
|
||||
let obj = IlMachineState.dereferencePointer state src
|
||||
let offset, _ = CliType.getFieldLayout fieldName obj
|
||||
|
||||
match CliType.getFieldAt (offset + v) obj with
|
||||
| None -> failwith "TODO: couldn't identify field at offset"
|
||||
| Some field ->
|
||||
ManagedPointerSource.Field (src, CliConcreteField.ToCliField(field).Name)
|
||||
|> Choice1Of2
|
||||
| Null -> Choice2Of2 v
|
||||
| InterpretedAsType (managedPointerSource, concreteType) -> failwith "todo"
|
||||
|
||||
let private mulInt32ManagedPtr (state : IlMachineState) v ptr =
|
||||
if v = 0 then
|
||||
Choice2Of2 0
|
||||
elif v = 1 then
|
||||
Choice1Of2 ptr
|
||||
else
|
||||
|
||||
match ptr with
|
||||
| ManagedPointerSource.Null -> Choice2Of2 0
|
||||
| _ -> failwith "refusing to multiply pointers"
|
||||
|
||||
let add =
|
||||
{ new IArithmeticOperation with
|
||||
member _.Int32Int32 a b = (# "add" a b : int32 #)
|
||||
member _.Int64Int64 a b = (# "add" a b : int64 #)
|
||||
member _.FloatFloat a b = (# "add" a b : float #)
|
||||
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"
|
||||
}
|
||||
|
||||
let addOvf =
|
||||
{ new IArithmeticOperation with
|
||||
member _.Int32Int32 a b = (# "add.ovf" a b : int32 #)
|
||||
member _.Int64Int64 a b = (# "add.ovf" a b : int64 #)
|
||||
member _.FloatFloat a b = (# "add.ovf" a b : float #)
|
||||
member _.NativeIntNativeInt a b = (# "add.ovf" a b : nativeint #)
|
||||
member _.Int32NativeInt a b = (# "add.ovf" a b : nativeint #)
|
||||
member _.NativeIntInt32 a b = (# "add.ovf" a b : nativeint #)
|
||||
|
||||
member _.ManagedPtrManagedPtr _ ptr1 ptr2 =
|
||||
match ptr1, ptr2 with
|
||||
| ManagedPointerSource.Null, _ -> Choice1Of2 ptr2
|
||||
| _, ManagedPointerSource.Null -> Choice1Of2 ptr1
|
||||
| _, _ -> failwith "refusing to add two managed pointers"
|
||||
|
||||
member _.Int32ManagedPtr state val1 ptr2 = addInt32ManagedPtr state val1 ptr2
|
||||
member _.ManagedPtrInt32 state ptr1 val2 = addInt32ManagedPtr state val2 ptr1
|
||||
|
||||
member _.Name = "add.ovf"
|
||||
}
|
||||
|
||||
let sub =
|
||||
{ new IArithmeticOperation with
|
||||
member _.Int32Int32 a b = (# "sub" a b : int32 #)
|
||||
member _.Int64Int64 a b = (# "sub" a b : int64 #)
|
||||
member _.FloatFloat a b = (# "sub" a b : float #)
|
||||
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"
|
||||
}
|
||||
|
||||
@@ -31,21 +139,143 @@ module ArithmeticOperation =
|
||||
member _.Int32Int32 a b = (# "mul" a b : int32 #)
|
||||
member _.Int64Int64 a b = (# "mul" a b : int64 #)
|
||||
member _.FloatFloat a b = (# "mul" a b : float #)
|
||||
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"
|
||||
}
|
||||
|
||||
let mulOvf =
|
||||
{ new IArithmeticOperation with
|
||||
member _.Int32Int32 a b = (# "mul.ovf" a b : int32 #)
|
||||
member _.Int64Int64 a b = (# "mul.ovf" a b : int64 #)
|
||||
member _.FloatFloat a b = (# "mul.ovf" a b : float #)
|
||||
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"
|
||||
}
|
||||
|
||||
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>]
|
||||
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
|
||||
match val1, val2 with
|
||||
| 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.ManagedPointer val2 -> failwith "" |> EvalStackValue.ManagedPointer
|
||||
| EvalStackValue.Int32 val1, EvalStackValue.NativeInt val2 ->
|
||||
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.Int64 val1, EvalStackValue.Int64 val2 -> op.Int64Int64 val1 val2 |> EvalStackValue.Int64
|
||||
| EvalStackValue.NativeInt val1, EvalStackValue.Int32 val2 -> failwith "" |> EvalStackValue.NativeInt
|
||||
| EvalStackValue.NativeInt val1, EvalStackValue.NativeInt 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 ->
|
||||
let val1 =
|
||||
match val1 with
|
||||
| NativeIntSource.Verbatim n -> nativeint<int64> n
|
||||
| v -> failwith $"refusing to operate on non-verbatim native int %O{v}"
|
||||
|
||||
let val2 =
|
||||
match val2 with
|
||||
| NativeIntSource.Verbatim n -> nativeint<int64> n
|
||||
| v -> failwith $"refusing to operate on non-verbatim native int %O{v}"
|
||||
|
||||
op.NativeIntNativeInt val1 val2
|
||||
|> int64<nativeint>
|
||||
|> NativeIntSource.Verbatim
|
||||
|> EvalStackValue.NativeInt
|
||||
| EvalStackValue.NativeInt val1, EvalStackValue.ManagedPointer val2 ->
|
||||
failwith "" |> EvalStackValue.ManagedPointer
|
||||
| EvalStackValue.NativeInt val1, EvalStackValue.ObjectRef val2 -> failwith "" |> EvalStackValue.ObjectRef
|
||||
@@ -53,6 +283,13 @@ module BinaryArithmetic =
|
||||
| EvalStackValue.ManagedPointer val1, EvalStackValue.NativeInt val2 ->
|
||||
failwith "" |> EvalStackValue.ManagedPointer
|
||||
| EvalStackValue.ObjectRef val1, EvalStackValue.NativeInt val2 -> failwith "" |> EvalStackValue.ObjectRef
|
||||
| EvalStackValue.ManagedPointer val1, EvalStackValue.Int32 val2 -> failwith "" |> EvalStackValue.ManagedPointer
|
||||
| EvalStackValue.ManagedPointer val1, EvalStackValue.Int32 val2 ->
|
||||
match op.ManagedPtrInt32 state val1 val2 with
|
||||
| Choice1Of2 result -> EvalStackValue.ManagedPointer result
|
||||
| Choice2Of2 result -> EvalStackValue.NativeInt (NativeIntSource.Verbatim (int64<int32> result))
|
||||
| EvalStackValue.ObjectRef val1, EvalStackValue.Int32 val2 -> failwith "" |> EvalStackValue.ObjectRef
|
||||
| EvalStackValue.ManagedPointer val1, EvalStackValue.ManagedPointer val2 ->
|
||||
match op.ManagedPtrManagedPtr state val1 val2 with
|
||||
| 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}"
|
||||
|
@@ -1,5 +1,8 @@
|
||||
namespace WoofWare.PawPrint
|
||||
|
||||
open System.Collections.Immutable
|
||||
open System.Reflection.Metadata
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module Corelib =
|
||||
|
||||
@@ -149,6 +152,66 @@ module Corelib =
|
||||
)
|
||||
|> Seq.exactlyOne
|
||||
|
||||
let exceptionType =
|
||||
corelib.TypeDefs
|
||||
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "Exception" then Some v else None)
|
||||
|> Seq.exactlyOne
|
||||
|
||||
let arithmeticException =
|
||||
corelib.TypeDefs
|
||||
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "ArithmeticException" then Some v else None)
|
||||
|> Seq.exactlyOne
|
||||
|
||||
let divideByZeroException =
|
||||
corelib.TypeDefs
|
||||
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "DivideByZeroException" then Some v else None)
|
||||
|> Seq.exactlyOne
|
||||
|
||||
let overflowException =
|
||||
corelib.TypeDefs
|
||||
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "OverflowException" then Some v else None)
|
||||
|> Seq.exactlyOne
|
||||
|
||||
let stackOverflowException =
|
||||
corelib.TypeDefs
|
||||
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "StackOverflowException" then Some v else None)
|
||||
|> Seq.exactlyOne
|
||||
|
||||
let typeLoadException =
|
||||
corelib.TypeDefs
|
||||
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "TypeLoadException" then Some v else None)
|
||||
|> Seq.exactlyOne
|
||||
|
||||
let indexOutOfRangeException =
|
||||
corelib.TypeDefs
|
||||
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "IndexOutOfRangeException" then Some v else None)
|
||||
|> Seq.exactlyOne
|
||||
|
||||
let invalidCastException =
|
||||
corelib.TypeDefs
|
||||
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "InvalidCastException" then Some v else None)
|
||||
|> Seq.exactlyOne
|
||||
|
||||
let missingFieldException =
|
||||
corelib.TypeDefs
|
||||
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "MissingFieldException" then Some v else None)
|
||||
|> Seq.exactlyOne
|
||||
|
||||
let missingMethodException =
|
||||
corelib.TypeDefs
|
||||
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "MissingMethodException" then Some v else None)
|
||||
|> Seq.exactlyOne
|
||||
|
||||
let nullReferenceException =
|
||||
corelib.TypeDefs
|
||||
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "NullReferenceException" then Some v else None)
|
||||
|> Seq.exactlyOne
|
||||
|
||||
let outOfMemoryException =
|
||||
corelib.TypeDefs
|
||||
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "OutOfMemoryException" then Some v else None)
|
||||
|> Seq.exactlyOne
|
||||
|
||||
{
|
||||
Corelib = corelib
|
||||
String = stringType
|
||||
@@ -179,4 +242,94 @@ module Corelib =
|
||||
TypedReference = typedReferenceType
|
||||
IntPtr = intPtrType
|
||||
UIntPtr = uintPtrType
|
||||
Exception = exceptionType
|
||||
ArithmeticException = arithmeticException
|
||||
DivideByZeroException = divideByZeroException
|
||||
OverflowException = overflowException
|
||||
StackOverflowException = stackOverflowException
|
||||
TypeLoadException = typeLoadException
|
||||
IndexOutOfRangeException = indexOutOfRangeException
|
||||
InvalidCastException = invalidCastException
|
||||
MissingFieldException = missingFieldException
|
||||
MissingMethodException = missingMethodException
|
||||
NullReferenceException = nullReferenceException
|
||||
OutOfMemoryException = outOfMemoryException
|
||||
}
|
||||
|
||||
let concretizeAll
|
||||
(loaded : ImmutableDictionary<string, DumpedAssembly>)
|
||||
(bct : BaseClassTypes<DumpedAssembly>)
|
||||
(t : AllConcreteTypes)
|
||||
: AllConcreteTypes
|
||||
=
|
||||
let ctx =
|
||||
{
|
||||
TypeConcretization.ConcretizationContext.InProgress = ImmutableDictionary.Empty
|
||||
TypeConcretization.ConcretizationContext.ConcreteTypes = t
|
||||
TypeConcretization.ConcretizationContext.LoadedAssemblies = loaded
|
||||
TypeConcretization.ConcretizationContext.BaseTypes = bct
|
||||
}
|
||||
|
||||
let loader =
|
||||
{ new IAssemblyLoad with
|
||||
member _.LoadAssembly _ _ _ =
|
||||
failwith "should have already loaded this assembly"
|
||||
}
|
||||
|
||||
let tys =
|
||||
[
|
||||
bct.String
|
||||
bct.Boolean
|
||||
bct.Char
|
||||
bct.SByte
|
||||
bct.Byte
|
||||
bct.Int16
|
||||
bct.UInt16
|
||||
bct.Int32
|
||||
bct.UInt32
|
||||
bct.Int64
|
||||
bct.UInt64
|
||||
bct.Single
|
||||
bct.Double
|
||||
bct.Array
|
||||
bct.Enum
|
||||
bct.ValueType
|
||||
bct.DelegateType
|
||||
bct.Object
|
||||
bct.RuntimeTypeHandle
|
||||
bct.RuntimeMethodHandle
|
||||
bct.RuntimeFieldHandle
|
||||
bct.RuntimeFieldInfoStub
|
||||
bct.RuntimeFieldHandleInternal
|
||||
bct.RuntimeType
|
||||
bct.Void
|
||||
bct.TypedReference
|
||||
bct.IntPtr
|
||||
bct.UIntPtr
|
||||
]
|
||||
|
||||
(ctx, tys)
|
||||
||> List.fold (fun ctx ty ->
|
||||
let stk =
|
||||
match DumpedAssembly.resolveBaseType ctx.BaseTypes ctx.LoadedAssemblies ty.Assembly ty.BaseType with
|
||||
| ResolvedBaseType.Enum
|
||||
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
|
||||
| ResolvedBaseType.Object
|
||||
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
|
||||
|
||||
let _handle, ctx =
|
||||
TypeConcretization.concretizeType
|
||||
ctx
|
||||
loader
|
||||
ty.Assembly
|
||||
ImmutableArray.Empty
|
||||
ImmutableArray.Empty
|
||||
(TypeDefn.FromDefinition (
|
||||
ComparableTypeDefinitionHandle.Make ty.TypeDefHandle,
|
||||
ty.Assembly.FullName,
|
||||
stk
|
||||
))
|
||||
|
||||
ctx
|
||||
)
|
||||
|> _.ConcreteTypes
|
||||
|
@@ -1,5 +1,7 @@
|
||||
namespace WoofWare.PawPrint
|
||||
|
||||
#nowarn "42"
|
||||
|
||||
/// See I.12.3.2.1 for definition
|
||||
type EvalStackValue =
|
||||
| Int32 of int32
|
||||
@@ -8,9 +10,8 @@ type EvalStackValue =
|
||||
| Float of float
|
||||
| ManagedPointer of ManagedPointerSource
|
||||
| ObjectRef of ManagedHeapAddress
|
||||
// Fraser thinks this isn't really a thing in CoreCLR
|
||||
// | TransientPointer of TransientPointerSource
|
||||
| UserDefinedValueType of EvalStackValueUserType
|
||||
/// This doesn't match what the CLR does in reality, but we can work out whatever we need from it.
|
||||
| UserDefinedValueType of CliValueType
|
||||
|
||||
override this.ToString () =
|
||||
match this with
|
||||
@@ -20,40 +21,7 @@ type EvalStackValue =
|
||||
| EvalStackValue.Float f -> $"Float(%f{f})"
|
||||
| EvalStackValue.ManagedPointer managedPointerSource -> $"Pointer(%O{managedPointerSource})"
|
||||
| EvalStackValue.ObjectRef managedHeapAddress -> $"ObjectRef(%O{managedHeapAddress})"
|
||||
| EvalStackValue.UserDefinedValueType evalStackValues ->
|
||||
let desc =
|
||||
evalStackValues.Fields
|
||||
|> List.map (_.ContentsEval >> string<EvalStackValue>)
|
||||
|> String.concat " | "
|
||||
|
||||
$"Struct(%s{desc})"
|
||||
|
||||
and EvalStackValueField =
|
||||
{
|
||||
Name : string
|
||||
ContentsEval : EvalStackValue
|
||||
Offset : int option
|
||||
}
|
||||
|
||||
and EvalStackValueUserType =
|
||||
{
|
||||
Fields : EvalStackValueField list
|
||||
}
|
||||
|
||||
static member DereferenceField (name : string) (this : EvalStackValueUserType) =
|
||||
// TODO: this doesn't account for overlapping fields
|
||||
this.Fields
|
||||
|> List.pick (fun stackField ->
|
||||
if stackField.Name = name then
|
||||
Some stackField.ContentsEval
|
||||
else
|
||||
None
|
||||
)
|
||||
|
||||
static member OfFields (fields : EvalStackValueField list) =
|
||||
{
|
||||
Fields = fields
|
||||
}
|
||||
| EvalStackValue.UserDefinedValueType evalStackValues -> $"Struct(%O{evalStackValues})"
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module EvalStackValue =
|
||||
@@ -81,6 +49,7 @@ module EvalStackValue =
|
||||
failwith "todo"
|
||||
| NativeIntSource.ManagedPointer _ -> failwith "TODO"
|
||||
| NativeIntSource.FunctionPointer _ -> failwith "TODO"
|
||||
| NativeIntSource.FieldHandlePtr _ -> failwith "TODO"
|
||||
| NativeIntSource.TypeHandlePtr _ -> failwith "TODO"
|
||||
| EvalStackValue.Float f -> failwith "todo"
|
||||
| EvalStackValue.ManagedPointer managedPointerSource ->
|
||||
@@ -109,7 +78,14 @@ module EvalStackValue =
|
||||
match value with
|
||||
| EvalStackValue.Int32 i -> Some (int64<int> 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.ManagedPointer managedPointerSource -> failwith "todo"
|
||||
| EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo"
|
||||
@@ -126,6 +102,52 @@ module EvalStackValue =
|
||||
| EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo"
|
||||
| EvalStackValue.UserDefinedValueType evalStackValues -> failwith "todo"
|
||||
|
||||
/// Then truncates to int32.
|
||||
let convToUInt8 (value : EvalStackValue) : int32 option =
|
||||
match value with
|
||||
| EvalStackValue.Int32 (i : int32) ->
|
||||
let v = (# "conv.u1" i : uint8 #)
|
||||
Some (int32<uint8> v)
|
||||
| EvalStackValue.Int64 int64 ->
|
||||
let v = (# "conv.u1" int64 : uint8 #)
|
||||
Some (int32<uint8> v)
|
||||
| EvalStackValue.NativeInt nativeIntSource -> failwith "todo"
|
||||
| EvalStackValue.Float f -> failwith "todo"
|
||||
| EvalStackValue.ManagedPointer managedPointerSource -> failwith "todo"
|
||||
| EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo"
|
||||
| EvalStackValue.UserDefinedValueType evalStackValues -> failwith "todo"
|
||||
|
||||
let rec ofCliType (v : CliType) : EvalStackValue =
|
||||
match v with
|
||||
| CliType.Numeric numeric ->
|
||||
match numeric with
|
||||
| CliNumericType.Int32 i -> EvalStackValue.Int32 i
|
||||
| CliNumericType.Int64 i -> EvalStackValue.Int64 i
|
||||
| CliNumericType.NativeInt i -> EvalStackValue.NativeInt i
|
||||
// Sign-extend types int8 and int16
|
||||
// Zero-extend unsigned int8/unsigned int16
|
||||
| CliNumericType.Int8 b -> int32<int8> b |> EvalStackValue.Int32
|
||||
| CliNumericType.UInt8 b -> int32<uint8> b |> EvalStackValue.Int32
|
||||
| CliNumericType.Int16 s -> int32<int16> s |> EvalStackValue.Int32
|
||||
| CliNumericType.UInt16 s -> int32<uint16> s |> EvalStackValue.Int32
|
||||
| CliNumericType.Float32 f -> EvalStackValue.Float (float<float32> f)
|
||||
| CliNumericType.Float64 f -> EvalStackValue.Float f
|
||||
| CliNumericType.NativeFloat f -> EvalStackValue.Float f
|
||||
| CliType.ObjectRef i ->
|
||||
match i with
|
||||
| None -> EvalStackValue.ManagedPointer ManagedPointerSource.Null
|
||||
| Some i -> EvalStackValue.ManagedPointer (ManagedPointerSource.Heap i)
|
||||
// Zero-extend bool/char
|
||||
| CliType.Bool b -> int32 b |> EvalStackValue.Int32
|
||||
| CliType.Char (high, low) -> int32 high * 256 + int32 low |> EvalStackValue.Int32
|
||||
| CliType.RuntimePointer ptr ->
|
||||
match ptr with
|
||||
| CliRuntimePointer.Verbatim ptrInt -> NativeIntSource.Verbatim ptrInt |> EvalStackValue.NativeInt
|
||||
| CliRuntimePointer.FieldRegistryHandle ptrInt ->
|
||||
NativeIntSource.FieldHandlePtr ptrInt |> EvalStackValue.NativeInt
|
||||
| CliRuntimePointer.Managed ptr -> ptr |> EvalStackValue.ManagedPointer
|
||||
| CliType.ValueType fields -> EvalStackValue.UserDefinedValueType fields
|
||||
|
||||
let rec toCliTypeCoerced (target : CliType) (popped : EvalStackValue) : CliType =
|
||||
match target with
|
||||
| CliType.Numeric numeric ->
|
||||
@@ -134,10 +156,12 @@ module EvalStackValue =
|
||||
match popped with
|
||||
| EvalStackValue.Int32 i -> CliType.Numeric (CliNumericType.Int32 i)
|
||||
| EvalStackValue.UserDefinedValueType popped ->
|
||||
match popped.Fields with
|
||||
| [] -> failwith "unexpectedly empty"
|
||||
| [ popped ] -> toCliTypeCoerced target popped.ContentsEval
|
||||
| _ -> failwith $"TODO: %O{target}"
|
||||
let popped = CliValueType.DereferenceFieldAt 0 4 popped
|
||||
// TODO: when we have a general mechanism to coerce CliTypes to each other,
|
||||
// do that
|
||||
match popped with
|
||||
| CliType.Numeric (CliNumericType.Int32 i) -> CliType.Numeric (CliNumericType.Int32 i)
|
||||
| _ -> failwith "TODO"
|
||||
| i -> failwith $"TODO: %O{i}"
|
||||
| CliNumericType.Int64 _ ->
|
||||
match popped with
|
||||
@@ -147,7 +171,7 @@ module EvalStackValue =
|
||||
| NativeIntSource.Verbatim i -> CliType.Numeric (CliNumericType.Int64 i)
|
||||
| NativeIntSource.ManagedPointer ptr -> failwith "TODO"
|
||||
| NativeIntSource.FunctionPointer f -> failwith $"TODO: {f}"
|
||||
// CliType.Numeric (CliNumericType.ProvenanceTrackedNativeInt64 f)
|
||||
| NativeIntSource.FieldHandlePtr f -> failwith $"TODO: {f}"
|
||||
| NativeIntSource.TypeHandlePtr f -> failwith $"TODO: {f}"
|
||||
// CliType.Numeric (CliNumericType.TypeHandlePtr f)
|
||||
| i -> failwith $"TODO: %O{i}"
|
||||
@@ -158,9 +182,21 @@ module EvalStackValue =
|
||||
CliNumericType.NativeInt (NativeIntSource.ManagedPointer ptrSrc)
|
||||
|> CliType.Numeric
|
||||
| EvalStackValue.UserDefinedValueType vt ->
|
||||
match vt.Fields with
|
||||
| [] -> failwith "unexpected"
|
||||
| [ vt ] -> toCliTypeCoerced target vt.ContentsEval
|
||||
let popped = CliValueType.DereferenceFieldAt 0 NATIVE_INT_SIZE vt
|
||||
// TODO: when we have a general mechanism to coerce CliTypes to each other,
|
||||
// do that
|
||||
match popped with
|
||||
| CliType.Numeric (CliNumericType.NativeInt i) -> CliType.Numeric (CliNumericType.NativeInt i)
|
||||
| CliType.Numeric (CliNumericType.Int64 i) ->
|
||||
CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.Verbatim i))
|
||||
| CliType.RuntimePointer ptr ->
|
||||
match ptr with
|
||||
| CliRuntimePointer.Verbatim i ->
|
||||
CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.Verbatim i))
|
||||
| CliRuntimePointer.FieldRegistryHandle ptr ->
|
||||
CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.FieldHandlePtr ptr))
|
||||
| CliRuntimePointer.Managed src ->
|
||||
CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.ManagedPointer src))
|
||||
| _ -> failwith $"TODO: {popped}"
|
||||
| _ -> failwith $"TODO: {popped}"
|
||||
| CliNumericType.NativeFloat f -> failwith "todo"
|
||||
@@ -191,11 +227,9 @@ module EvalStackValue =
|
||||
| CliType.ObjectRef _ ->
|
||||
match popped with
|
||||
| EvalStackValue.ManagedPointer ptrSource ->
|
||||
CliRuntimePointerSource.ofManagedPointerSource ptrSource
|
||||
|> CliRuntimePointer.Managed
|
||||
|> CliType.RuntimePointer
|
||||
ptrSource |> CliRuntimePointer.Managed |> CliType.RuntimePointer
|
||||
| EvalStackValue.ObjectRef ptr ->
|
||||
CliRuntimePointerSource.Heap ptr
|
||||
ManagedPointerSource.Heap ptr
|
||||
|> CliRuntimePointer.Managed
|
||||
|> CliType.RuntimePointer
|
||||
| EvalStackValue.NativeInt nativeIntSource ->
|
||||
@@ -204,15 +238,18 @@ module EvalStackValue =
|
||||
| NativeIntSource.Verbatim i -> failwith $"refusing to interpret verbatim native int {i} as a pointer"
|
||||
| NativeIntSource.FunctionPointer _ -> failwith "TODO"
|
||||
| NativeIntSource.TypeHandlePtr _ -> failwith "refusing to interpret type handle ID as an object ref"
|
||||
| NativeIntSource.FieldHandlePtr _ -> failwith "refusing to interpret field handle ID as an object ref"
|
||||
| NativeIntSource.ManagedPointer ptr ->
|
||||
match ptr with
|
||||
| ManagedPointerSource.Null -> CliType.ObjectRef None
|
||||
| ManagedPointerSource.Heap s -> CliType.ObjectRef (Some s)
|
||||
| _ -> failwith "TODO"
|
||||
| EvalStackValue.UserDefinedValueType obj ->
|
||||
match obj.Fields with
|
||||
| [ esv ] -> toCliTypeCoerced target esv.ContentsEval
|
||||
| fields -> failwith $"TODO: don't know how to coerce struct of {fields} to a pointer"
|
||||
let popped = CliValueType.DereferenceFieldAt 0 NATIVE_INT_SIZE obj
|
||||
|
||||
match popped with
|
||||
| CliType.ObjectRef r -> CliType.ObjectRef r
|
||||
| _ -> failwith "TODO"
|
||||
| _ -> failwith $"TODO: {popped}"
|
||||
| CliType.Bool _ ->
|
||||
match popped with
|
||||
@@ -224,22 +261,17 @@ module EvalStackValue =
|
||||
| i -> failwith $"TODO: %O{i}"
|
||||
| CliType.RuntimePointer _ ->
|
||||
match popped with
|
||||
| EvalStackValue.ManagedPointer src ->
|
||||
CliRuntimePointerSource.ofManagedPointerSource src
|
||||
|> CliRuntimePointer.Managed
|
||||
|> CliType.RuntimePointer
|
||||
| EvalStackValue.ManagedPointer src -> src |> CliRuntimePointer.Managed |> CliType.RuntimePointer
|
||||
| EvalStackValue.NativeInt intSrc ->
|
||||
match intSrc with
|
||||
| NativeIntSource.Verbatim i -> CliType.RuntimePointer (CliRuntimePointer.Unmanaged i)
|
||||
| NativeIntSource.ManagedPointer src ->
|
||||
CliRuntimePointerSource.ofManagedPointerSource src
|
||||
|> CliRuntimePointer.Managed
|
||||
|> CliType.RuntimePointer
|
||||
| NativeIntSource.Verbatim i -> CliType.RuntimePointer (CliRuntimePointer.Verbatim i)
|
||||
| NativeIntSource.ManagedPointer src -> src |> CliRuntimePointer.Managed |> CliType.RuntimePointer
|
||||
| NativeIntSource.FunctionPointer methodInfo ->
|
||||
CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.FunctionPointer methodInfo))
|
||||
| NativeIntSource.TypeHandlePtr int64 -> failwith "todo"
|
||||
| NativeIntSource.FieldHandlePtr int64 -> failwith "todo"
|
||||
| EvalStackValue.ObjectRef addr ->
|
||||
CliRuntimePointerSource.Heap addr
|
||||
ManagedPointerSource.Heap addr
|
||||
|> CliRuntimePointer.Managed
|
||||
|> CliType.RuntimePointer
|
||||
| _ -> failwith $"TODO: %O{popped}"
|
||||
@@ -252,91 +284,38 @@ module EvalStackValue =
|
||||
| popped -> failwith $"Unexpectedly wanted a char from {popped}"
|
||||
| CliType.ValueType vt ->
|
||||
match popped with
|
||||
| EvalStackValue.UserDefinedValueType popped ->
|
||||
if vt.Fields.Length <> popped.Fields.Length then
|
||||
// TODO: overlapping fields
|
||||
failwith
|
||||
$"mismatch: popped value type {popped} (length %i{popped.Fields.Length}) into {vt} (length %i{vt.Fields.Length})"
|
||||
| EvalStackValue.UserDefinedValueType popped' ->
|
||||
match CliValueType.TrySequentialFields vt, CliValueType.TrySequentialFields popped' with
|
||||
| Some vt, Some popped ->
|
||||
if vt.Length <> popped.Length then
|
||||
failwith
|
||||
$"mismatch: popped value type {popped} (length %i{popped.Length}) into {vt} (length %i{vt.Length})"
|
||||
|
||||
(vt.Fields, popped.Fields)
|
||||
||> List.map2 (fun field1 popped ->
|
||||
if field1.Name <> popped.Name then
|
||||
failwith $"TODO: name mismatch, {field1.Name} vs {popped.Name}"
|
||||
(vt, popped)
|
||||
||> List.map2 (fun field1 popped ->
|
||||
if field1.Name <> popped.Name then
|
||||
failwith $"TODO: name mismatch, {field1.Name} vs {popped.Name}"
|
||||
|
||||
if field1.Offset <> popped.Offset then
|
||||
failwith $"TODO: offset mismatch for {field1.Name}, {field1.Offset} vs {popped.Offset}"
|
||||
if field1.Offset <> popped.Offset then
|
||||
failwith $"TODO: offset mismatch for {field1.Name}, {field1.Offset} vs {popped.Offset}"
|
||||
|
||||
let contents = toCliTypeCoerced field1.Contents popped.ContentsEval
|
||||
let contents = toCliTypeCoerced field1.Contents (ofCliType popped.Contents)
|
||||
|
||||
{
|
||||
CliField.Name = field1.Name
|
||||
Contents = contents
|
||||
Offset = field1.Offset
|
||||
}
|
||||
)
|
||||
|> CliValueType.OfFields
|
||||
|> CliType.ValueType
|
||||
{
|
||||
CliField.Name = field1.Name
|
||||
Contents = contents
|
||||
Offset = field1.Offset
|
||||
Type = field1.Type
|
||||
}
|
||||
)
|
||||
|> CliValueType.OfFields popped'.Layout
|
||||
|> CliType.ValueType
|
||||
| _, _ -> failwith "TODO: overlapping fields going onto eval stack"
|
||||
| popped ->
|
||||
match vt.Fields with
|
||||
| [ field ] -> toCliTypeCoerced field.Contents popped
|
||||
match CliValueType.TryExactlyOneField vt with
|
||||
| Some field -> toCliTypeCoerced field.Contents popped
|
||||
| _ -> failwith $"TODO: {popped} into value type {target}"
|
||||
|
||||
let rec ofCliType (v : CliType) : EvalStackValue =
|
||||
match v with
|
||||
| CliType.Numeric numeric ->
|
||||
match numeric with
|
||||
| CliNumericType.Int32 i -> EvalStackValue.Int32 i
|
||||
| CliNumericType.Int64 i -> EvalStackValue.Int64 i
|
||||
| CliNumericType.NativeInt i -> EvalStackValue.NativeInt i
|
||||
// Sign-extend types int8 and int16
|
||||
// Zero-extend unsigned int8/unsigned int16
|
||||
| CliNumericType.Int8 b -> int32<int8> b |> EvalStackValue.Int32
|
||||
| CliNumericType.UInt8 b -> int32<uint8> b |> EvalStackValue.Int32
|
||||
| CliNumericType.Int16 s -> int32<int16> s |> EvalStackValue.Int32
|
||||
| CliNumericType.UInt16 s -> int32<uint16> s |> EvalStackValue.Int32
|
||||
| CliNumericType.Float32 f -> EvalStackValue.Float (float<float32> f)
|
||||
| CliNumericType.Float64 f -> EvalStackValue.Float f
|
||||
| CliNumericType.NativeFloat f -> EvalStackValue.Float f
|
||||
| CliType.ObjectRef i ->
|
||||
match i with
|
||||
| None -> EvalStackValue.ManagedPointer ManagedPointerSource.Null
|
||||
| Some i -> EvalStackValue.ManagedPointer (ManagedPointerSource.Heap i)
|
||||
// Zero-extend bool/char
|
||||
| CliType.Bool b -> int32 b |> EvalStackValue.Int32
|
||||
| CliType.Char (high, low) -> int32 high * 256 + int32 low |> EvalStackValue.Int32
|
||||
| CliType.RuntimePointer ptr ->
|
||||
match ptr with
|
||||
| CliRuntimePointer.Unmanaged ptrInt -> NativeIntSource.Verbatim ptrInt |> EvalStackValue.NativeInt
|
||||
| CliRuntimePointer.Managed ptr ->
|
||||
match ptr with
|
||||
| CliRuntimePointerSource.LocalVariable (sourceThread, methodFrame, var) ->
|
||||
ManagedPointerSource.LocalVariable (sourceThread, methodFrame, var)
|
||||
|> EvalStackValue.ManagedPointer
|
||||
| CliRuntimePointerSource.ArrayIndex (arr, ind) ->
|
||||
ManagedPointerSource.ArrayIndex (arr, ind) |> EvalStackValue.ManagedPointer
|
||||
| CliRuntimePointerSource.Argument (sourceThread, methodFrame, var) ->
|
||||
ManagedPointerSource.Argument (sourceThread, methodFrame, var)
|
||||
|> EvalStackValue.ManagedPointer
|
||||
| CliRuntimePointerSource.Heap addr -> EvalStackValue.ObjectRef addr
|
||||
| CliRuntimePointerSource.Null -> EvalStackValue.ManagedPointer ManagedPointerSource.Null
|
||||
| CliRuntimePointerSource.Field (source, fieldName) ->
|
||||
ManagedPointerSource.Field (CliRuntimePointerSource.toManagedPointerSource source, fieldName)
|
||||
|> EvalStackValue.ManagedPointer
|
||||
| CliType.ValueType fields ->
|
||||
// TODO: this is a bit dubious; we're being a bit sloppy with possibly-overlapping fields here
|
||||
fields.Fields
|
||||
|> List.map (fun field ->
|
||||
let contents = ofCliType field.Contents
|
||||
|
||||
{
|
||||
Name = field.Name
|
||||
Offset = field.Offset
|
||||
ContentsEval = contents
|
||||
}
|
||||
)
|
||||
|> EvalStackValueUserType.OfFields
|
||||
|> EvalStackValue.UserDefinedValueType
|
||||
|
||||
type EvalStack =
|
||||
{
|
||||
Values : EvalStackValue list
|
||||
|
@@ -123,24 +123,14 @@ module EvalStackValueComparisons =
|
||||
let rec ceq (var1 : EvalStackValue) (var2 : EvalStackValue) : bool =
|
||||
// Table III.4
|
||||
match var1, var2 with
|
||||
| EvalStackValue.UserDefinedValueType {
|
||||
Fields = [ f ]
|
||||
},
|
||||
v -> ceq f.ContentsEval v
|
||||
| u,
|
||||
EvalStackValue.UserDefinedValueType {
|
||||
Fields = [ f ]
|
||||
} -> ceq u f.ContentsEval
|
||||
| EvalStackValue.UserDefinedValueType {
|
||||
Fields = []
|
||||
},
|
||||
EvalStackValue.UserDefinedValueType {
|
||||
Fields = []
|
||||
} ->
|
||||
// hmm, surely this can't happen, but :shrug:
|
||||
true
|
||||
| EvalStackValue.UserDefinedValueType _, _
|
||||
| _, EvalStackValue.UserDefinedValueType _ -> failwith $"TODO: ceq {var1} vs {var2}"
|
||||
| EvalStackValue.UserDefinedValueType var1, v ->
|
||||
match CliValueType.TryExactlyOneField var1 with
|
||||
| None -> failwith "TODO"
|
||||
| Some var1 -> ceq (EvalStackValue.ofCliType var1.Contents) v
|
||||
| u, EvalStackValue.UserDefinedValueType var2 ->
|
||||
match CliValueType.TryExactlyOneField var2 with
|
||||
| None -> failwith "TODO"
|
||||
| Some var2 -> ceq u (EvalStackValue.ofCliType var2.Contents)
|
||||
| EvalStackValue.Int32 var1, EvalStackValue.Int32 var2 -> var1 = var2
|
||||
| EvalStackValue.Int32 var1, EvalStackValue.NativeInt var2 -> failwith "TODO: int32 CEQ nativeint"
|
||||
| EvalStackValue.Int32 _, _ -> failwith $"bad ceq: Int32 vs {var2}"
|
||||
@@ -173,6 +163,7 @@ module EvalStackValueComparisons =
|
||||
| ManagedPointerSource.LocalVariable _
|
||||
| ManagedPointerSource.Argument _ -> false
|
||||
| ManagedPointerSource.ArrayIndex (arr, index) -> failwith "todo"
|
||||
| ManagedPointerSource.InterpretedAsType (src, ty) -> failwith "todo"
|
||||
| EvalStackValue.ObjectRef _, _ -> failwith $"bad ceq: ObjectRef vs {var2}"
|
||||
| EvalStackValue.ManagedPointer var1, EvalStackValue.ManagedPointer var2 -> var1 = var2
|
||||
| EvalStackValue.ManagedPointer var1, EvalStackValue.NativeInt var2 ->
|
||||
|
@@ -89,6 +89,7 @@ module System_Threading_Monitor =
|
||||
| ManagedPointerSource.Heap addr -> failwith "todo: managed heap"
|
||||
| ManagedPointerSource.ArrayIndex _ -> failwith "todo: array index"
|
||||
| ManagedPointerSource.Field (managedPointerSource, fieldName) -> failwith "todo"
|
||||
| ManagedPointerSource.InterpretedAsType _ -> failwith "TODO"
|
||||
|
||||
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped
|
||||
|
||||
|
@@ -1,5 +1,6 @@
|
||||
namespace WoofWare.PawPrint
|
||||
|
||||
open System.Collections.Immutable
|
||||
open System.Reflection
|
||||
open System.Reflection.Metadata
|
||||
|
||||
@@ -33,8 +34,9 @@ module FieldHandleRegistry =
|
||||
/// Returns a (struct) System.RuntimeFieldHandle, with its contents (reference type) freshly allocated if necessary.
|
||||
let getOrAllocate
|
||||
(baseClassTypes : BaseClassTypes<'corelib>)
|
||||
(allConcreteTypes : AllConcreteTypes)
|
||||
(allocState : 'allocState)
|
||||
(allocate : CliField list -> 'allocState -> ManagedHeapAddress * 'allocState)
|
||||
(allocate : CliValueType -> 'allocState -> ManagedHeapAddress * 'allocState)
|
||||
(declaringAssy : AssemblyName)
|
||||
(declaringType : ConcreteTypeHandle)
|
||||
(handle : FieldDefinitionHandle)
|
||||
@@ -57,9 +59,17 @@ module FieldHandleRegistry =
|
||||
Name = "m_ptr"
|
||||
Contents = CliType.ofManagedObject runtimeFieldInfoStub
|
||||
Offset = None
|
||||
Type =
|
||||
AllConcreteTypes.findExistingConcreteType
|
||||
allConcreteTypes
|
||||
(baseClassTypes.RuntimeFieldInfoStub.Assembly,
|
||||
baseClassTypes.RuntimeFieldInfoStub.Namespace,
|
||||
baseClassTypes.RuntimeFieldInfoStub.Name,
|
||||
ImmutableArray.Empty)
|
||||
|> Option.get
|
||||
}
|
||||
|> List.singleton
|
||||
|> CliValueType.OfFields
|
||||
|> CliValueType.OfFields Layout.Default
|
||||
|> CliType.ValueType
|
||||
|
||||
let handle =
|
||||
@@ -88,50 +98,90 @@ module FieldHandleRegistry =
|
||||
// https://github.com/dotnet/runtime/blob/2b21c73fa2c32fa0195e4a411a435dda185efd08/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L1380
|
||||
{
|
||||
Name = "m_handle"
|
||||
Contents = CliType.RuntimePointer (CliRuntimePointer.Unmanaged newHandle)
|
||||
Contents = CliType.RuntimePointer (CliRuntimePointer.FieldRegistryHandle newHandle)
|
||||
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
|
||||
|> CliValueType.OfFields
|
||||
|> CliValueType.OfFields Layout.Default
|
||||
|> CliType.ValueType
|
||||
|
||||
// https://github.com/dotnet/runtime/blob/1d1bf92fcf43aa6981804dc53c5174445069c9e4/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L1074
|
||||
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
|
||||
[
|
||||
// If we ever implement a GC, something should change here
|
||||
{
|
||||
Name = "m_keepalive"
|
||||
Contents = CliType.ObjectRef None
|
||||
Offset = Some 0
|
||||
Offset = None
|
||||
Type = objType
|
||||
}
|
||||
{
|
||||
Name = "m_c"
|
||||
Contents = CliType.ObjectRef None
|
||||
Offset = Some SIZEOF_OBJ
|
||||
Offset = None
|
||||
Type = objType
|
||||
}
|
||||
{
|
||||
Name = "m_d"
|
||||
Contents = CliType.ObjectRef None
|
||||
Offset = Some (SIZEOF_OBJ * 2)
|
||||
Offset = None
|
||||
Type = objType
|
||||
}
|
||||
{
|
||||
Name = "m_b"
|
||||
Contents = CliType.Numeric (CliNumericType.Int32 0)
|
||||
Offset = Some (SIZEOF_OBJ * 3)
|
||||
Offset = None
|
||||
Type = intType
|
||||
}
|
||||
{
|
||||
Name = "m_e"
|
||||
Contents = CliType.ObjectRef None
|
||||
Offset = Some (SIZEOF_OBJ * 3 + SIZEOF_INT)
|
||||
Offset = None
|
||||
Type = objType
|
||||
}
|
||||
// RuntimeFieldHandleInternal: https://github.com/dotnet/runtime/blob/1d1bf92fcf43aa6981804dc53c5174445069c9e4/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L1048
|
||||
{
|
||||
Name = "m_fieldHandle"
|
||||
Contents = runtimeFieldHandleInternal
|
||||
Offset = Some (SIZEOF_OBJ * 4 + SIZEOF_INT)
|
||||
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
|
||||
|
||||
let alloc, state = allocate runtimeFieldInfoStub allocState
|
||||
|
||||
|
@@ -149,7 +149,73 @@ type StateLoadResult =
|
||||
module IlMachineState =
|
||||
type private Dummy = class end
|
||||
|
||||
let private loadAssembly'
|
||||
(loggerFactory : ILoggerFactory)
|
||||
(dotnetRuntimeDirs : string seq)
|
||||
(referencedInAssembly : DumpedAssembly)
|
||||
(r : AssemblyReferenceHandle)
|
||||
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
|
||||
=
|
||||
let assemblyRef = referencedInAssembly.AssemblyReferences.[r]
|
||||
let assemblyName = assemblyRef.Name
|
||||
|
||||
match assemblies.TryGetValue assemblyName.FullName with
|
||||
| true, v -> v, assemblyName
|
||||
| false, _ ->
|
||||
let logger = loggerFactory.CreateLogger typeof<Dummy>.DeclaringType
|
||||
|
||||
let assy =
|
||||
dotnetRuntimeDirs
|
||||
|> Seq.choose (fun dir ->
|
||||
let file = Path.Combine (dir, assemblyName.Name + ".dll")
|
||||
|
||||
try
|
||||
use f = File.OpenRead file
|
||||
logger.LogInformation ("Loading assembly from file {AssemblyFileLoadPath}", file)
|
||||
Assembly.read loggerFactory (Some file) f |> Some
|
||||
with :? FileNotFoundException ->
|
||||
None
|
||||
)
|
||||
|> Seq.toList
|
||||
|
||||
match assy |> List.tryHead with
|
||||
| None -> failwith $"Could not find a readable DLL in any runtime dir with name %s{assemblyName.Name}.dll"
|
||||
| Some assy -> assy, assemblyName
|
||||
|
||||
/// <summary>
|
||||
/// Create a new IlMachineState which has loaded the given assembly.
|
||||
/// This involves reading assemblies from the disk and doing a complete parse of them, so it might be quite slow!
|
||||
///
|
||||
/// This function doesn't do anything if the referenced assembly has already been loaded.
|
||||
/// </summary>
|
||||
/// <param name="loggerFactory">LoggerFactory into which to emit logs.</param>
|
||||
/// <param name="referencedInAssembly">The assembly which contains an AssemblyReference which causes us to want to load a new assembly.</param>
|
||||
/// <param name="r">The AssemblyReferenceHandle pointing at an assembly we want to load. *Important*: this is an AssemblyReferenceHandle from <c>referencedInAssembly</c>; in general, AssemblyReferenceHandles are only well-defined if you know what assembly they were defined in.</param>
|
||||
/// <param name="state">The immutable state to augment with the new assembly.</param>
|
||||
let loadAssembly
|
||||
(loggerFactory : ILoggerFactory)
|
||||
(referencedInAssembly : DumpedAssembly)
|
||||
(r : AssemblyReferenceHandle)
|
||||
(state : IlMachineState)
|
||||
: IlMachineState * DumpedAssembly * AssemblyName
|
||||
=
|
||||
let dumped, assy =
|
||||
loadAssembly' loggerFactory state.DotnetRuntimeDirs referencedInAssembly r state._LoadedAssemblies
|
||||
|
||||
state.WithLoadedAssembly assy dumped, dumped, assy
|
||||
|
||||
let private loader (loggerFactory : ILoggerFactory) (state : IlMachineState) : IAssemblyLoad =
|
||||
{ new IAssemblyLoad with
|
||||
member _.LoadAssembly loaded assyName ref =
|
||||
let targetAssy, name =
|
||||
loadAssembly' loggerFactory state.DotnetRuntimeDirs loaded.[assyName.FullName] ref loaded
|
||||
|
||||
let newAssys = loaded.SetItem (name.FullName, targetAssy)
|
||||
newAssys, targetAssy
|
||||
}
|
||||
|
||||
let concretizeType
|
||||
(loggerFactory : ILoggerFactory)
|
||||
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
|
||||
(state : IlMachineState)
|
||||
(declaringAssembly : AssemblyName)
|
||||
@@ -169,14 +235,7 @@ module IlMachineState =
|
||||
let handle, ctx =
|
||||
TypeConcretization.concretizeType
|
||||
ctx
|
||||
(fun assyName ref ->
|
||||
let currentAssy = state.LoadedAssembly assyName |> Option.get
|
||||
|
||||
let targetAssy =
|
||||
currentAssy.AssemblyReferences.[ref].Name |> state.LoadedAssembly |> Option.get
|
||||
|
||||
state._LoadedAssemblies, targetAssy
|
||||
)
|
||||
(loader loggerFactory state)
|
||||
declaringAssembly
|
||||
typeGenerics
|
||||
methodGenerics
|
||||
@@ -190,51 +249,6 @@ module IlMachineState =
|
||||
|
||||
state, handle
|
||||
|
||||
/// <summary>
|
||||
/// Create a new IlMachineState which has loaded the given assembly.
|
||||
/// This involves reading assemblies from the disk and doing a complete parse of them, so it might be quite slow!
|
||||
///
|
||||
/// This function doesn't do anything if the referenced assembly has already been loaded.
|
||||
/// </summary>
|
||||
/// <param name="loggerFactory">LoggerFactory into which to emit logs.</param>
|
||||
/// <param name="referencedInAssembly">The assembly which contains an AssemblyReference which causes us to want to load a new assembly.</param>
|
||||
/// <param name="r">The AssemblyReferenceHandle pointing at an assembly we want to load. *Important*: this is an AssemblyReferenceHandle from <c>referencedInAssembly</c>; in general, AssemblyReferenceHandles are only well-defined if you know what assembly they were defined in.</param>
|
||||
/// <param name="state">The immutable state to augment with the new assembly.</param>
|
||||
let loadAssembly
|
||||
(loggerFactory : ILoggerFactory)
|
||||
(referencedInAssembly : DumpedAssembly)
|
||||
(r : AssemblyReferenceHandle)
|
||||
(state : IlMachineState)
|
||||
: IlMachineState * DumpedAssembly * AssemblyName
|
||||
=
|
||||
let assemblyRef = referencedInAssembly.AssemblyReferences.[r]
|
||||
let assemblyName = assemblyRef.Name
|
||||
|
||||
match state.LoadedAssembly assemblyName with
|
||||
| Some v -> state, v, assemblyName
|
||||
| None ->
|
||||
let logger = loggerFactory.CreateLogger typeof<Dummy>.DeclaringType
|
||||
|
||||
let assy =
|
||||
state.DotnetRuntimeDirs
|
||||
|> Seq.choose (fun dir ->
|
||||
let file = Path.Combine (dir, assemblyName.Name + ".dll")
|
||||
|
||||
try
|
||||
use f = File.OpenRead file
|
||||
logger.LogInformation ("Loading assembly from file {AssemblyFileLoadPath}", file)
|
||||
Assembly.read loggerFactory (Some file) f |> Some
|
||||
with :? FileNotFoundException ->
|
||||
None
|
||||
)
|
||||
|> Seq.toList
|
||||
|
||||
match assy |> List.tryHead with
|
||||
| None -> failwith $"Could not find a readable DLL in any runtime dir with name %s{assemblyName.Name}.dll"
|
||||
| Some assy ->
|
||||
|
||||
state.WithLoadedAssembly assemblyName assy, assy, assemblyName
|
||||
|
||||
let rec internal resolveTypeFromName
|
||||
(loggerFactory : ILoggerFactory)
|
||||
(ns : string option)
|
||||
@@ -440,6 +454,54 @@ module IlMachineState =
|
||||
|
||||
resolveTypeFromDefn loggerFactory baseClassTypes sign typeGenericArgsAsDefn methodGenericArgsAsDefn assy state
|
||||
|
||||
/// Resolve a TypeDefinition using concrete type handles from execution context
|
||||
let resolveTypeFromDefnConcrete
|
||||
(loggerFactory : ILoggerFactory)
|
||||
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
|
||||
(ty : TypeDefinitionHandle)
|
||||
(assy : DumpedAssembly)
|
||||
(typeGenericArgs : ConcreteTypeHandle ImmutableArray)
|
||||
(methodGenericArgs : ConcreteTypeHandle ImmutableArray)
|
||||
(state : IlMachineState)
|
||||
: IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo<TypeDefn, TypeDefn>
|
||||
=
|
||||
let typeDef = assy.TypeDefs.[ty]
|
||||
|
||||
// Convert ConcreteTypeHandle to TypeDefn for the generics
|
||||
let typeGenericArgsAsDefn =
|
||||
typeGenericArgs
|
||||
|> Seq.map (fun handle ->
|
||||
Concretization.concreteHandleToTypeDefn
|
||||
baseClassTypes
|
||||
handle
|
||||
state.ConcreteTypes
|
||||
state._LoadedAssemblies
|
||||
)
|
||||
|> ImmutableArray.CreateRange
|
||||
|
||||
let methodGenericArgsAsDefn =
|
||||
methodGenericArgs
|
||||
|> Seq.map (fun handle ->
|
||||
Concretization.concreteHandleToTypeDefn
|
||||
baseClassTypes
|
||||
handle
|
||||
state.ConcreteTypes
|
||||
state._LoadedAssemblies
|
||||
)
|
||||
|> ImmutableArray.CreateRange
|
||||
|
||||
// Map the type definition's generics using the provided type generic arguments
|
||||
let resolvedTypeDef =
|
||||
typeDef
|
||||
|> TypeInfo.mapGeneric (fun (param, _) ->
|
||||
if param.SequenceNumber < typeGenericArgsAsDefn.Length then
|
||||
typeGenericArgsAsDefn.[param.SequenceNumber]
|
||||
else
|
||||
failwithf "Generic type parameter %d out of range" param.SequenceNumber
|
||||
)
|
||||
|
||||
state, assy, resolvedTypeDef
|
||||
|
||||
/// Get zero value for a type that's already been concretized
|
||||
let cliTypeZeroOfHandle
|
||||
(state : IlMachineState)
|
||||
@@ -482,26 +544,6 @@ module IlMachineState =
|
||||
BaseTypes = baseClassTypes
|
||||
}
|
||||
|
||||
// Helper function to get assembly from reference
|
||||
let loadAssembly
|
||||
(currentAssembly : AssemblyName)
|
||||
(assyRef : AssemblyReferenceHandle)
|
||||
: ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly
|
||||
=
|
||||
let assyToLoad =
|
||||
match state.LoadedAssembly currentAssembly with
|
||||
| Some assy -> assy
|
||||
| None -> failwithf "Assembly %s not loaded" currentAssembly.FullName
|
||||
|
||||
let referencedAssy = assyToLoad.AssemblyReferences.[assyRef]
|
||||
|
||||
match state.LoadedAssembly referencedAssy.Name with
|
||||
| Some assy -> state._LoadedAssemblies, assy
|
||||
| None ->
|
||||
// Need to load the assembly
|
||||
let newState, loadedAssy, _ = loadAssembly loggerFactory assyToLoad assyRef state
|
||||
newState._LoadedAssemblies, loadedAssy
|
||||
|
||||
// Concretize each generic argument first
|
||||
let mutable currentCtx = ctx
|
||||
let genericHandles = ImmutableArray.CreateBuilder declaringType.Generics.Length
|
||||
@@ -510,7 +552,7 @@ module IlMachineState =
|
||||
let handle, newCtx =
|
||||
TypeConcretization.concretizeType
|
||||
currentCtx
|
||||
loadAssembly
|
||||
(loader loggerFactory state)
|
||||
declaringType.Assembly
|
||||
ImmutableArray.Empty // No type generics in this context
|
||||
ImmutableArray.Empty // No method generics in this context
|
||||
@@ -522,12 +564,13 @@ module IlMachineState =
|
||||
// Now we need to concretize the type definition itself
|
||||
// If it's a non-generic type, we can use concretizeTypeDefinition directly
|
||||
if declaringType.Generics.IsEmpty then
|
||||
let handle, newCtx =
|
||||
let handle, currentCtx =
|
||||
TypeConcretization.concretizeTypeDefinition currentCtx declaringType.Assembly declaringType.Definition
|
||||
|
||||
let newState =
|
||||
{ state with
|
||||
ConcreteTypes = newCtx.ConcreteTypes
|
||||
ConcreteTypes = currentCtx.ConcreteTypes
|
||||
_LoadedAssemblies = currentCtx.LoadedAssemblies
|
||||
}
|
||||
|
||||
handle, newState
|
||||
@@ -571,7 +614,7 @@ module IlMachineState =
|
||||
(typeGenerics : ConcreteTypeHandle ImmutableArray)
|
||||
(methodGenerics : ConcreteTypeHandle ImmutableArray)
|
||||
(state : IlMachineState)
|
||||
: IlMachineState * CliType
|
||||
: IlMachineState * CliType * ConcreteTypeHandle
|
||||
=
|
||||
|
||||
// First concretize the type
|
||||
@@ -583,11 +626,11 @@ module IlMachineState =
|
||||
state.WithLoadedAssembly assy.Name assy
|
||||
|
||||
let state, handle =
|
||||
concretizeType baseClassTypes state assy.Name typeGenerics methodGenerics ty
|
||||
concretizeType loggerFactory baseClassTypes state assy.Name typeGenerics methodGenerics ty
|
||||
|
||||
// Now get the zero value
|
||||
let zero, state = cliTypeZeroOfHandle state baseClassTypes handle
|
||||
state, zero
|
||||
state, zero, handle
|
||||
|
||||
let pushToEvalStack' (o : EvalStackValue) (thread : ThreadId) (state : IlMachineState) =
|
||||
let activeThreadState = state.ThreadState.[thread]
|
||||
@@ -710,14 +753,9 @@ module IlMachineState =
|
||||
| ResolvedBaseType.Delegate
|
||||
| ResolvedBaseType.Object -> state |> pushToEvalStack (CliType.ofManagedObject constructing) currentThread
|
||||
| ResolvedBaseType.ValueType ->
|
||||
let vt =
|
||||
{
|
||||
CliValueType.Fields = constructed.Fields
|
||||
}
|
||||
|
||||
state
|
||||
// TODO: ordering of fields probably important
|
||||
|> pushToEvalStack (CliType.ValueType vt) currentThread
|
||||
|> pushToEvalStack (CliType.ValueType constructed.Contents) currentThread
|
||||
| ResolvedBaseType.Enum -> failwith "TODO"
|
||||
| None ->
|
||||
match threadStateAtEndOfMethod.MethodState.EvaluationStack.Values with
|
||||
@@ -759,22 +797,7 @@ module IlMachineState =
|
||||
let concretizedMethod, newConcreteTypes, newAssemblies =
|
||||
Concretization.concretizeMethod
|
||||
state.ConcreteTypes
|
||||
(fun assyName ref ->
|
||||
match state.LoadedAssembly assyName with
|
||||
| Some currentAssy ->
|
||||
let targetAssyRef = currentAssy.AssemblyReferences.[ref]
|
||||
|
||||
match state.LoadedAssembly targetAssyRef.Name with
|
||||
| Some _ ->
|
||||
// Assembly already loaded, return existing state
|
||||
state._LoadedAssemblies, state._LoadedAssemblies.[targetAssyRef.Name.FullName]
|
||||
| None ->
|
||||
// Need to load the assembly
|
||||
let newState, loadedAssy, _ = loadAssembly loggerFactory currentAssy ref state
|
||||
newState._LoadedAssemblies, loadedAssy
|
||||
| None ->
|
||||
failwithf "Current assembly %s not loaded when trying to resolve reference" assyName.FullName
|
||||
)
|
||||
(loader loggerFactory state)
|
||||
state._LoadedAssemblies
|
||||
baseClassTypes
|
||||
methodToCall
|
||||
@@ -820,6 +843,7 @@ module IlMachineState =
|
||||
for i = 0 to generics.Length - 1 do
|
||||
let state2, handle =
|
||||
concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
callingAssembly
|
||||
@@ -875,14 +899,7 @@ module IlMachineState =
|
||||
let handle, newCtx =
|
||||
TypeConcretization.concretizeType
|
||||
ctx
|
||||
(fun assyName ref ->
|
||||
let currentAssy = state.LoadedAssembly assyName |> Option.get
|
||||
|
||||
let targetAssy =
|
||||
currentAssy.AssemblyReferences.[ref].Name |> state.LoadedAssembly |> Option.get
|
||||
|
||||
state._LoadedAssemblies, targetAssy
|
||||
)
|
||||
(loader loggerFactory state)
|
||||
(state.ActiveAssembly thread).Name
|
||||
ImmutableArray.Empty // No type generics for the concretization context
|
||||
ImmutableArray.Empty // No method generics for the concretization context
|
||||
@@ -893,6 +910,7 @@ module IlMachineState =
|
||||
state <-
|
||||
{ state with
|
||||
ConcreteTypes = newCtx.ConcreteTypes
|
||||
_LoadedAssemblies = newCtx.LoadedAssemblies
|
||||
}
|
||||
|
||||
handles.ToImmutable (), state
|
||||
@@ -997,14 +1015,7 @@ module IlMachineState =
|
||||
let declaringHandle, newCtx =
|
||||
TypeConcretization.concretizeType
|
||||
ctx
|
||||
(fun assyName ref ->
|
||||
let currentAssy = state.LoadedAssembly assyName |> Option.get
|
||||
|
||||
let targetAssy =
|
||||
currentAssy.AssemblyReferences.[ref].Name |> state.LoadedAssembly |> Option.get
|
||||
|
||||
state._LoadedAssemblies, targetAssy
|
||||
)
|
||||
(loader loggerFactory state)
|
||||
field.DeclaringType.Assembly
|
||||
contextTypeGenerics
|
||||
contextMethodGenerics
|
||||
@@ -1113,13 +1124,13 @@ module IlMachineState =
|
||||
|
||||
let allocateManagedObject
|
||||
(ty : ConcreteTypeHandle)
|
||||
(fields : CliField list)
|
||||
(fields : CliValueType)
|
||||
(state : IlMachineState)
|
||||
: ManagedHeapAddress * IlMachineState
|
||||
=
|
||||
let o =
|
||||
{
|
||||
Fields = fields
|
||||
Contents = fields
|
||||
ConcreteType = ty
|
||||
SyncBlock = SyncBlock.Free
|
||||
}
|
||||
@@ -1190,6 +1201,7 @@ module IlMachineState =
|
||||
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
|
||||
(currentThread : ThreadId)
|
||||
(assy : DumpedAssembly)
|
||||
(genericMethodTypeArgs : ImmutableArray<ConcreteTypeHandle>)
|
||||
(m : MemberReferenceHandle)
|
||||
(state : IlMachineState)
|
||||
: IlMachineState *
|
||||
@@ -1253,6 +1265,7 @@ module IlMachineState =
|
||||
// TODO: generics?
|
||||
let state, t =
|
||||
concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
targetType.Assembly
|
||||
@@ -1270,6 +1283,7 @@ module IlMachineState =
|
||||
// Concretize the field signature from the member reference
|
||||
let state, concreteFieldSig =
|
||||
concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
(state.ActiveAssembly(currentThread).Name)
|
||||
@@ -1287,6 +1301,7 @@ module IlMachineState =
|
||||
// Concretize the field's signature for comparison
|
||||
let state, fieldSigConcrete =
|
||||
concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
assy.Name
|
||||
@@ -1324,11 +1339,12 @@ module IlMachineState =
|
||||
state
|
||||
(fun state ty ->
|
||||
concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
(state.ActiveAssembly(currentThread).Name)
|
||||
concreteExtractedTypeArgs
|
||||
ImmutableArray.Empty
|
||||
genericMethodTypeArgs
|
||||
ty
|
||||
)
|
||||
|
||||
@@ -1341,11 +1357,12 @@ module IlMachineState =
|
||||
state
|
||||
(fun state ty ->
|
||||
concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
assy.Name
|
||||
concreteExtractedTypeArgs
|
||||
ImmutableArray.Empty
|
||||
genericMethodTypeArgs
|
||||
ty
|
||||
)
|
||||
|
||||
@@ -1417,6 +1434,7 @@ module IlMachineState =
|
||||
| ManagedPointerSource.ArrayIndex (arr, index) -> getArrayValue arr index state |> CliType.getField fieldName
|
||||
| ManagedPointerSource.Field (src, fieldName) -> failwith "todo"
|
||||
| ManagedPointerSource.Null -> failwith "TODO: throw NRE"
|
||||
| ManagedPointerSource.InterpretedAsType (src, ty) -> failwith "TODO"
|
||||
|
||||
let setFieldValue
|
||||
(obj : ManagedPointerSource)
|
||||
@@ -1446,8 +1464,14 @@ module IlMachineState =
|
||||
state |> setArrayValue arr v index
|
||||
| ManagedPointerSource.Field (managedPointerSource, fieldName) -> failwith "todo"
|
||||
| ManagedPointerSource.Null -> failwith "TODO: throw NRE"
|
||||
| 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.
|
||||
let constructing = instruction.Arguments.[0]
|
||||
let targetObj = instruction.Arguments.[1]
|
||||
@@ -1455,17 +1479,17 @@ module IlMachineState =
|
||||
|
||||
let targetObj =
|
||||
match targetObj with
|
||||
| CliType.RuntimePointer (CliRuntimePointer.Managed (CliRuntimePointerSource.Heap target))
|
||||
| CliType.RuntimePointer (CliRuntimePointer.Managed (ManagedPointerSource.Heap target))
|
||||
| CliType.ObjectRef (Some target) -> Some target
|
||||
| CliType.ObjectRef None
|
||||
| CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null) -> None
|
||||
| CliType.RuntimePointer (CliRuntimePointer.Managed ManagedPointerSource.Null) -> None
|
||||
| _ -> failwith $"Unexpected target type for delegate: {targetObj}"
|
||||
|
||||
let constructing =
|
||||
match constructing with
|
||||
| CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null)
|
||||
| CliType.RuntimePointer (CliRuntimePointer.Managed ManagedPointerSource.Null)
|
||||
| CliType.ObjectRef None -> failwith "unexpectedly constructing the null delegate"
|
||||
| CliType.RuntimePointer (CliRuntimePointer.Managed (CliRuntimePointerSource.Heap target))
|
||||
| CliType.RuntimePointer (CliRuntimePointer.Managed (ManagedPointerSource.Heap target))
|
||||
| CliType.ObjectRef (Some target) -> target
|
||||
| _ -> failwith $"Unexpectedly not constructing a managed object: {constructing}"
|
||||
|
||||
@@ -1476,24 +1500,42 @@ module IlMachineState =
|
||||
|
||||
// Standard delegate fields in .NET are _target and _methodPtr
|
||||
// Update the fields with the target object and method pointer
|
||||
let updatedFields =
|
||||
// Let's not consider field ordering for reference types like delegates.
|
||||
// Nobody's going to be marshalling a reference type anyway, I hope.
|
||||
{
|
||||
Name = "_target"
|
||||
Contents = CliType.ObjectRef targetObj
|
||||
Offset = None
|
||||
}
|
||||
:: {
|
||||
Name = "_methodPtr"
|
||||
Contents = methodPtr
|
||||
Offset = None
|
||||
}
|
||||
:: heapObj.Fields
|
||||
let allConcreteTypes = state.ConcreteTypes
|
||||
|
||||
let updatedObj =
|
||||
let newContents =
|
||||
heapObj.Contents
|
||||
|> CliValueType.AddField
|
||||
{
|
||||
Name = "_target"
|
||||
Contents = CliType.ObjectRef targetObj
|
||||
Offset = None
|
||||
Type =
|
||||
AllConcreteTypes.findExistingConcreteType
|
||||
allConcreteTypes
|
||||
(baseClassTypes.Object.Assembly,
|
||||
baseClassTypes.Object.Namespace,
|
||||
baseClassTypes.Object.Name,
|
||||
ImmutableArray.Empty)
|
||||
|> Option.get
|
||||
}
|
||||
|> CliValueType.AddField
|
||||
{
|
||||
Name = "_methodPtr"
|
||||
Contents = methodPtr
|
||||
Offset = None
|
||||
Type =
|
||||
AllConcreteTypes.findExistingConcreteType
|
||||
allConcreteTypes
|
||||
(baseClassTypes.Object.Assembly,
|
||||
baseClassTypes.Object.Namespace,
|
||||
baseClassTypes.Object.Name,
|
||||
ImmutableArray.Empty)
|
||||
|> Option.get
|
||||
}
|
||||
|
||||
{ heapObj with
|
||||
Fields = updatedFields
|
||||
Contents = newContents
|
||||
}
|
||||
|
||||
let updatedHeap =
|
||||
@@ -1507,6 +1549,7 @@ module IlMachineState =
|
||||
|
||||
/// Returns the type handle and an allocated System.RuntimeType.
|
||||
let getOrAllocateType
|
||||
(loggerFactory : ILoggerFactory)
|
||||
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
|
||||
(defn : ConcreteTypeHandle)
|
||||
(state : IlMachineState)
|
||||
@@ -1518,10 +1561,18 @@ module IlMachineState =
|
||||
baseClassTypes.Corelib.Name.FullName,
|
||||
SignatureTypeKind.Class
|
||||
)
|
||||
|> concretizeType baseClassTypes state baseClassTypes.Corelib.Name ImmutableArray.Empty ImmutableArray.Empty
|
||||
|> concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
baseClassTypes.Corelib.Name
|
||||
ImmutableArray.Empty
|
||||
ImmutableArray.Empty
|
||||
|
||||
let result, reg, state =
|
||||
TypeHandleRegistry.getOrAllocate
|
||||
state.ConcreteTypes
|
||||
baseClassTypes
|
||||
state
|
||||
(fun fields state -> allocateManagedObject runtimeType fields state)
|
||||
defn
|
||||
@@ -1562,11 +1613,18 @@ module IlMachineState =
|
||||
baseClassTypes.Corelib.Name.FullName,
|
||||
SignatureTypeKind.Class
|
||||
)
|
||||
|> concretizeType baseClassTypes state baseClassTypes.Corelib.Name ImmutableArray.Empty ImmutableArray.Empty
|
||||
|> concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
baseClassTypes.Corelib.Name
|
||||
ImmutableArray.Empty
|
||||
ImmutableArray.Empty
|
||||
|
||||
let result, reg, state =
|
||||
FieldHandleRegistry.getOrAllocate
|
||||
baseClassTypes
|
||||
state.ConcreteTypes
|
||||
state
|
||||
(fun fields state -> allocateManagedObject runtimeType fields state)
|
||||
declaringAssy
|
||||
@@ -1612,7 +1670,10 @@ module IlMachineState =
|
||||
state.ThreadState.[sourceThread].MethodStates.[methodFrame].LocalVariables.[int<uint16> whichVar]
|
||||
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
|
||||
state.ThreadState.[sourceThread].MethodStates.[methodFrame].Arguments.[int<uint16> whichVar]
|
||||
| ManagedPointerSource.Heap addr -> failwith "todo"
|
||||
| ManagedPointerSource.Heap addr ->
|
||||
let result = ManagedHeap.get addr state.ManagedHeap
|
||||
// TODO: this is awfully dubious, this ain't no value type
|
||||
CliType.ValueType result.Contents
|
||||
| ManagedPointerSource.ArrayIndex (arr, index) -> getArrayValue arr index state
|
||||
| ManagedPointerSource.Field (addr, name) ->
|
||||
let obj = dereferencePointer state addr
|
||||
@@ -1620,6 +1681,19 @@ module IlMachineState =
|
||||
match obj with
|
||||
| CliType.ValueType vt -> vt |> CliValueType.DereferenceField name
|
||||
| v -> failwith $"could not find field {name} on object {v}"
|
||||
| ManagedPointerSource.InterpretedAsType (src, ty) ->
|
||||
let src = dereferencePointer state src
|
||||
|
||||
let concrete =
|
||||
match
|
||||
AllConcreteTypes.findExistingConcreteType
|
||||
state.ConcreteTypes
|
||||
(ty.Assembly, ty.Namespace, ty.Name, ty.Generics)
|
||||
with
|
||||
| Some ty -> ty
|
||||
| None -> failwith "not concretised type"
|
||||
|
||||
failwith $"TODO: interpret as type %s{ty.Assembly.Name}.%s{ty.Namespace}.%s{ty.Name}, object %O{src}"
|
||||
|
||||
let lookupTypeDefn
|
||||
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
|
||||
|
@@ -10,6 +10,7 @@ open Microsoft.Extensions.Logging
|
||||
[<RequireQualifiedAccess>]
|
||||
module IlMachineStateExecution =
|
||||
let getTypeOfObj
|
||||
(loggerFactory : ILoggerFactory)
|
||||
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
|
||||
(state : IlMachineState)
|
||||
(esv : EvalStackValue)
|
||||
@@ -19,6 +20,7 @@ module IlMachineStateExecution =
|
||||
| EvalStackValue.Int32 _ ->
|
||||
DumpedAssembly.typeInfoToTypeDefn' baseClassTypes state._LoadedAssemblies baseClassTypes.Int32
|
||||
|> IlMachineState.concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
baseClassTypes.Corelib.Name
|
||||
@@ -27,6 +29,7 @@ module IlMachineStateExecution =
|
||||
| EvalStackValue.Int64 _ ->
|
||||
DumpedAssembly.typeInfoToTypeDefn' baseClassTypes state._LoadedAssemblies baseClassTypes.Int64
|
||||
|> IlMachineState.concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
baseClassTypes.Corelib.Name
|
||||
@@ -36,6 +39,7 @@ module IlMachineStateExecution =
|
||||
| EvalStackValue.Float _ ->
|
||||
DumpedAssembly.typeInfoToTypeDefn' baseClassTypes state._LoadedAssemblies baseClassTypes.Double
|
||||
|> IlMachineState.concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
baseClassTypes.Corelib.Name
|
||||
@@ -51,6 +55,7 @@ module IlMachineStateExecution =
|
||||
| ManagedPointerSource.ArrayIndex (arr, index) -> failwith "todo"
|
||||
| ManagedPointerSource.Null -> failwith "todo"
|
||||
| ManagedPointerSource.Field (managedPointerSource, fieldName) -> failwith "todo"
|
||||
| ManagedPointerSource.InterpretedAsType (src, ty) -> failwith "todo"
|
||||
| EvalStackValue.ObjectRef addr ->
|
||||
let o = ManagedHeap.get addr state.ManagedHeap
|
||||
state, o.ConcreteType
|
||||
@@ -113,16 +118,13 @@ module IlMachineStateExecution =
|
||||
|
||||
match
|
||||
if isIntrinsic then
|
||||
Intrinsics.call baseClassTypes methodToCall thread state
|
||||
Intrinsics.call loggerFactory baseClassTypes methodToCall thread state
|
||||
else
|
||||
None
|
||||
with
|
||||
| Some result -> result
|
||||
| None ->
|
||||
|
||||
if methodToCall.Name = "GetValue" then
|
||||
printfn ""
|
||||
|
||||
// Get zero values for all parameters
|
||||
let state, argZeroObjects =
|
||||
((state, []), methodToCall.Signature.ParameterTypes)
|
||||
@@ -156,7 +158,8 @@ module IlMachineStateExecution =
|
||||
| None -> failwith "unexpectedly no `this` on the eval stack of instance method"
|
||||
| Some this -> this
|
||||
|
||||
let state, callingObjTyHandle = getTypeOfObj baseClassTypes state callingObj
|
||||
let state, callingObjTyHandle =
|
||||
getTypeOfObj loggerFactory baseClassTypes state callingObj
|
||||
|
||||
let callingObjTy =
|
||||
let ty =
|
||||
@@ -200,6 +203,7 @@ module IlMachineStateExecution =
|
||||
let state, retType =
|
||||
meth.Signature.ReturnType
|
||||
|> IlMachineState.concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
meth.DeclaringType.Assembly
|
||||
@@ -211,6 +215,7 @@ module IlMachineStateExecution =
|
||||
||> Seq.mapFold (fun state ty ->
|
||||
ty
|
||||
|> IlMachineState.concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
meth.DeclaringType.Assembly
|
||||
@@ -407,7 +412,7 @@ module IlMachineStateExecution =
|
||||
// where Newobj puts the object pointer on top
|
||||
let thisArg, newState =
|
||||
popAndCoerceArg
|
||||
(CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null))
|
||||
(CliType.RuntimePointer (CliRuntimePointer.Managed ManagedPointerSource.Null))
|
||||
currentState
|
||||
|
||||
currentState <- newState
|
||||
@@ -430,7 +435,7 @@ module IlMachineStateExecution =
|
||||
|
||||
let thisArg, newState =
|
||||
popAndCoerceArg
|
||||
(CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null))
|
||||
(CliType.RuntimePointer (CliRuntimePointer.Managed ManagedPointerSource.Null))
|
||||
currentState
|
||||
|
||||
args.Add thisArg
|
||||
@@ -573,6 +578,7 @@ module IlMachineStateExecution =
|
||||
// Concretize the base type
|
||||
let state, baseTypeHandle =
|
||||
IlMachineState.concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
sourceAssembly.Name
|
||||
@@ -612,6 +618,7 @@ module IlMachineStateExecution =
|
||||
// Concretize the base type
|
||||
let state, baseTypeHandle =
|
||||
IlMachineState.concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
sourceAssembly.Name
|
||||
@@ -663,6 +670,7 @@ module IlMachineStateExecution =
|
||||
state
|
||||
(fun state typeDefn ->
|
||||
IlMachineState.concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
concreteType.Assembly
|
||||
@@ -687,6 +695,7 @@ module IlMachineStateExecution =
|
||||
||> Seq.fold (fun (state, acc) typeDefn ->
|
||||
let state, handle =
|
||||
IlMachineState.concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
concreteType.Assembly
|
||||
|
@@ -1,6 +1,8 @@
|
||||
namespace WoofWare.PawPrint
|
||||
|
||||
open System
|
||||
open System.Collections.Immutable
|
||||
open Microsoft.Extensions.Logging
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module Intrinsics =
|
||||
@@ -14,10 +16,99 @@ module Intrinsics =
|
||||
"System.Private.CoreLib", "ArgumentNullException", "ThrowIfNull"
|
||||
// https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/coreclr/System.Private.CoreLib/src/System/Type.CoreCLR.cs#L82
|
||||
"System.Private.CoreLib", "Type", "GetTypeFromHandle"
|
||||
// https://github.com/dotnet/runtime/blob/108fa7856efcfd39bc991c2d849eabbf7ba5989c/src/libraries/System.Private.CoreLib/src/System/ReadOnlySpan.cs#L161
|
||||
"System.Private.CoreLib", "ReadOnlySpan`1", "get_Length"
|
||||
// https://github.com/dotnet/runtime/blob/9e5e6aa7bc36aeb2a154709a9d1192030c30a2ef/src/libraries/System.Private.CoreLib/src/System/Runtime/CompilerServices/RuntimeHelpers.cs#L153
|
||||
"System.Private.CoreLib", "RuntimeHelpers", "CreateSpan"
|
||||
// https://github.com/dotnet/runtime/blob/d258af50034c192bf7f0a18856bf83d2903d98ae/src/libraries/System.Private.CoreLib/src/System/Math.cs#L127
|
||||
// https://github.com/dotnet/runtime/blob/d258af50034c192bf7f0a18856bf83d2903d98ae/src/libraries/System.Private.CoreLib/src/System/Math.cs#L137
|
||||
"System.Private.CoreLib", "Math", "Abs"
|
||||
// https://github.com/dotnet/runtime/blob/d258af50034c192bf7f0a18856bf83d2903d98ae/src/libraries/System.Private.CoreLib/src/System/Math.cs#L965C10-L1062C19
|
||||
"System.Private.CoreLib", "Math", "Max"
|
||||
// https://github.com/dotnet/runtime/blob/d258af50034c192bf7f0a18856bf83d2903d98ae/src/libraries/System.Private.CoreLib/src/System/Buffer.cs#L150
|
||||
"System.Private.CoreLib", "Buffer", "Memmove"
|
||||
// https://github.com/dotnet/runtime/blob/1c3221b63340d7f81dfd829f3bcd822e582324f6/src/libraries/System.Private.CoreLib/src/System/Threading/Thread.cs#L799
|
||||
"System.Private.CoreLib", "Thread", "get_CurrentThread"
|
||||
]
|
||||
|> Set.ofList
|
||||
|
||||
type private RefTypeProcessingStatus =
|
||||
| InProgress
|
||||
| Completed of bool
|
||||
|
||||
let rec private containsRefType
|
||||
(loggerFactory : ILoggerFactory)
|
||||
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
|
||||
(state : IlMachineState)
|
||||
(seenSoFar : ImmutableDictionary<TypeInfo<TypeDefn, TypeDefn>, RefTypeProcessingStatus>)
|
||||
(td : TypeInfo<TypeDefn, TypeDefn>)
|
||||
: IlMachineState * ImmutableDictionary<_, RefTypeProcessingStatus> * bool
|
||||
=
|
||||
match seenSoFar.TryGetValue td with
|
||||
| true, InProgress ->
|
||||
// We've hit a cycle. Optimistically assume this path does not introduce a reference type.
|
||||
// If another path finds a reference type, its 'true' will override this.
|
||||
state, seenSoFar, false
|
||||
| true, Completed v ->
|
||||
// We've already calculated this; return the memoized result.
|
||||
state, seenSoFar, v
|
||||
| false, _ ->
|
||||
// Check if this type itself is a reference type.
|
||||
let baseType =
|
||||
td.BaseType
|
||||
|> DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies td.Assembly
|
||||
|
||||
match baseType with
|
||||
| ResolvedBaseType.Delegate
|
||||
| ResolvedBaseType.Object ->
|
||||
// Short-circuit: if the type itself is a reference type, we're done.
|
||||
let seenSoFar = seenSoFar.Add (td, Completed true)
|
||||
state, seenSoFar, true
|
||||
| ResolvedBaseType.Enum
|
||||
| ResolvedBaseType.ValueType ->
|
||||
// It's a value type, so we must check its fields.
|
||||
// Mark as in progress before recursing.
|
||||
let seenSoFarWithInProgress = seenSoFar.Add (td, InProgress)
|
||||
|
||||
let stateAfterFieldResolution, nonStaticFields =
|
||||
((state, []), td.Fields)
|
||||
||> List.fold (fun (currentState, acc) field ->
|
||||
if field.IsStatic then
|
||||
currentState, acc
|
||||
else
|
||||
// TODO: generics
|
||||
let newState, _, info =
|
||||
IlMachineState.resolveTypeFromDefn
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
field.Signature
|
||||
ImmutableArray.Empty
|
||||
ImmutableArray.Empty
|
||||
(currentState.LoadedAssembly (td.Assembly) |> Option.get)
|
||||
currentState
|
||||
|
||||
newState, info :: acc
|
||||
)
|
||||
|
||||
// Recurse through the fields, correctly propagating state.
|
||||
let finalState, finalSeenSoFar, fieldsContainRefType =
|
||||
((stateAfterFieldResolution, seenSoFarWithInProgress, false), nonStaticFields)
|
||||
||> List.fold (fun (currentState, currentSeenSoFar, currentResult) field ->
|
||||
if currentResult then
|
||||
(currentState, currentSeenSoFar, true) // Short-circuit
|
||||
else
|
||||
let newState, newSeenSoFar, fieldResult =
|
||||
containsRefType loggerFactory baseClassTypes currentState currentSeenSoFar field
|
||||
|
||||
(newState, newSeenSoFar, currentResult || fieldResult)
|
||||
)
|
||||
|
||||
// Mark as completed with the final result before returning.
|
||||
let finalSeenSoFar = finalSeenSoFar.SetItem (td, Completed fieldsContainRefType)
|
||||
finalState, finalSeenSoFar, fieldsContainRefType
|
||||
|
||||
let call
|
||||
(loggerFactory : ILoggerFactory)
|
||||
(baseClassTypes : BaseClassTypes<_>)
|
||||
(methodToCall : WoofWare.PawPrint.MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle>)
|
||||
(currentThread : ThreadId)
|
||||
@@ -68,9 +159,9 @@ module Intrinsics =
|
||||
let rec go (arg : EvalStackValue) =
|
||||
match arg with
|
||||
| EvalStackValue.UserDefinedValueType vt ->
|
||||
match vt.Fields with
|
||||
| [ field ] -> go field.ContentsEval
|
||||
| _ -> failwith $"TODO: %O{vt}"
|
||||
match CliValueType.TryExactlyOneField vt with
|
||||
| None -> failwith "TODO"
|
||||
| Some field -> go (EvalStackValue.ofCliType field.Contents)
|
||||
| EvalStackValue.ManagedPointer ManagedPointerSource.Null -> failwith "TODO: throw NRE"
|
||||
| EvalStackValue.ObjectRef addr
|
||||
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) -> Some addr
|
||||
@@ -84,36 +175,68 @@ module Intrinsics =
|
||||
{
|
||||
Name = "m_type"
|
||||
Contents = CliType.ObjectRef arg
|
||||
Offset = Some 0
|
||||
Offset = None
|
||||
Type =
|
||||
AllConcreteTypes.findExistingConcreteType
|
||||
state.ConcreteTypes
|
||||
(baseClassTypes.RuntimeType.Assembly,
|
||||
baseClassTypes.RuntimeType.Namespace,
|
||||
baseClassTypes.RuntimeType.Name,
|
||||
ImmutableArray.Empty)
|
||||
|> Option.get
|
||||
}
|
||||
|> List.singleton
|
||||
|> CliValueType.OfFields
|
||||
|> CliValueType.OfFields Layout.Default
|
||||
|
||||
IlMachineState.pushToEvalStack (CliType.ValueType vt) currentThread state
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|
||||
Some state
|
||||
| "System.Private.CoreLib", "Type", "get_IsValueType" ->
|
||||
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
|
||||
| [], ConcreteBool state.ConcreteTypes -> ()
|
||||
| _ -> failwith "bad signature Type.get_IsValueType"
|
||||
|
||||
let this, state = IlMachineState.popEvalStack currentThread state
|
||||
|
||||
let this =
|
||||
match this with
|
||||
| EvalStackValue.ObjectRef ptr ->
|
||||
IlMachineState.dereferencePointer state (ManagedPointerSource.Heap ptr)
|
||||
| EvalStackValue.ManagedPointer ptr -> IlMachineState.dereferencePointer state ptr
|
||||
| EvalStackValue.Float _
|
||||
| EvalStackValue.Int32 _
|
||||
| EvalStackValue.Int64 _ -> failwith "refusing to dereference literal"
|
||||
| _ -> failwith "TODO"
|
||||
// `this` should be of type Type
|
||||
let ty =
|
||||
match this with
|
||||
| CliType.ValueType cvt ->
|
||||
match CliValueType.DereferenceField "m_handle" cvt with
|
||||
| CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.TypeHandlePtr cth)) -> cth
|
||||
| _ -> failwith ""
|
||||
| _ -> failwith "expected a Type"
|
||||
|
||||
let ty = AllConcreteTypes.lookup ty state.ConcreteTypes |> Option.get
|
||||
let ty = state.LoadedAssembly(ty.Assembly).Value.TypeDefs.[ty.Definition.Get]
|
||||
|
||||
let isValueType =
|
||||
match DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies ty.Assembly ty.BaseType with
|
||||
| ResolvedBaseType.Enum
|
||||
| ResolvedBaseType.ValueType -> true
|
||||
| ResolvedBaseType.Object
|
||||
| ResolvedBaseType.Delegate -> false
|
||||
|
||||
IlMachineState.pushToEvalStack (CliType.ofBool isValueType) currentThread state
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|> Some
|
||||
| "System.Private.CoreLib", "Unsafe", "AsPointer" ->
|
||||
// Method signature: 1 generic parameter, we take a Byref of that parameter, and return a TypeDefn.Pointer(Void)
|
||||
let arg, state = IlMachineState.popEvalStack currentThread state
|
||||
|
||||
let toPush =
|
||||
match arg with
|
||||
| EvalStackValue.ManagedPointer ptr ->
|
||||
match ptr with
|
||||
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
|
||||
CliRuntimePointer.Managed (
|
||||
CliRuntimePointerSource.LocalVariable (sourceThread, methodFrame, whichVar)
|
||||
)
|
||||
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
|
||||
CliRuntimePointer.Managed (
|
||||
CliRuntimePointerSource.Argument (sourceThread, methodFrame, whichVar)
|
||||
)
|
||||
| ManagedPointerSource.Heap managedHeapAddress ->
|
||||
CliRuntimePointer.Managed (CliRuntimePointerSource.Heap managedHeapAddress)
|
||||
| ManagedPointerSource.Null -> failwith "todo"
|
||||
| ManagedPointerSource.ArrayIndex _ -> failwith "TODO"
|
||||
| ManagedPointerSource.Field _ -> failwith "TODO"
|
||||
| EvalStackValue.ManagedPointer ptr -> CliRuntimePointer.Managed ptr
|
||||
| x -> failwith $"TODO: Unsafe.AsPointer(%O{x})"
|
||||
|
||||
IlMachineState.pushToEvalStack (CliType.RuntimePointer toPush) currentThread state
|
||||
@@ -150,6 +273,47 @@ module Intrinsics =
|
||||
let result =
|
||||
BitConverter.Int32BitsToSingle arg |> CliNumericType.Float32 |> CliType.Numeric
|
||||
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack result currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|> Some
|
||||
| "System.Private.CoreLib", "BitConverter", "DoubleToUInt64Bits" ->
|
||||
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
|
||||
| [ ConcreteDouble state.ConcreteTypes ], ConcreteUInt64 state.ConcreteTypes -> ()
|
||||
| _ -> failwith "bad signature BitConverter.DoubleToUInt64Bits"
|
||||
|
||||
let arg, state = IlMachineState.popEvalStack currentThread state
|
||||
|
||||
let arg =
|
||||
match arg with
|
||||
| EvalStackValue.Float i -> i
|
||||
| _ -> failwith "$TODO: {arr}"
|
||||
|
||||
let result =
|
||||
BitConverter.DoubleToUInt64Bits arg
|
||||
|> int64<uint64>
|
||||
|> CliNumericType.Int64
|
||||
|> CliType.Numeric
|
||||
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack result currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|> Some
|
||||
| "System.Private.CoreLib", "BitConverter", "UInt64BitsToDouble" ->
|
||||
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
|
||||
| [ ConcreteUInt64 state.ConcreteTypes ], ConcreteDouble state.ConcreteTypes -> ()
|
||||
| _ -> failwith "bad signature BitConverter.DoubleToUInt64Bits"
|
||||
|
||||
let arg, state = IlMachineState.popEvalStack currentThread state
|
||||
|
||||
let arg =
|
||||
match arg with
|
||||
| EvalStackValue.Int64 i -> uint64 i
|
||||
| _ -> failwith "$TODO: {arr}"
|
||||
|
||||
let result =
|
||||
BitConverter.UInt64BitsToDouble arg |> CliNumericType.Float64 |> CliType.Numeric
|
||||
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack result currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
@@ -185,6 +349,44 @@ module Intrinsics =
|
||||
| EvalStackValue.Float f -> BitConverter.DoubleToInt64Bits f |> EvalStackValue.Int64
|
||||
| _ -> failwith "TODO"
|
||||
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack' result currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|> Some
|
||||
| "System.Private.CoreLib", "BitConverter", "SingleToUInt32Bits" ->
|
||||
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
|
||||
| [ ConcreteSingle state.ConcreteTypes ], ConcreteUInt32 state.ConcreteTypes -> ()
|
||||
| _ -> failwith "bad signature BitConverter.SingleToUInt32Bits"
|
||||
|
||||
let arg, state = IlMachineState.popEvalStack currentThread state
|
||||
|
||||
let result =
|
||||
match arg with
|
||||
| EvalStackValue.Float f ->
|
||||
BitConverter.SingleToUInt32Bits (float32<float> f)
|
||||
|> int<uint32>
|
||||
|> EvalStackValue.Int32
|
||||
| _ -> failwith "TODO"
|
||||
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack' result currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|> Some
|
||||
| "System.Private.CoreLib", "BitConverter", "UInt32BitsToSingle" ->
|
||||
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
|
||||
| [ ConcreteUInt32 state.ConcreteTypes ], ConcreteSingle state.ConcreteTypes -> ()
|
||||
| _ -> failwith "bad signature BitConverter.UInt32BitsToSingle"
|
||||
|
||||
let arg, state = IlMachineState.popEvalStack currentThread state
|
||||
|
||||
let result =
|
||||
match arg with
|
||||
| EvalStackValue.Int32 f ->
|
||||
BitConverter.UInt32BitsToSingle (uint32<int> f)
|
||||
|> float<float32>
|
||||
|> EvalStackValue.Float
|
||||
| _ -> failwith "TODO"
|
||||
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack' result currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
@@ -198,7 +400,8 @@ module Intrinsics =
|
||||
let arg1 =
|
||||
match arg1 with
|
||||
| EvalStackValue.ObjectRef h
|
||||
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> h
|
||||
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> Some h
|
||||
| EvalStackValue.ManagedPointer ManagedPointerSource.Null -> None
|
||||
| EvalStackValue.Int32 _
|
||||
| EvalStackValue.Int64 _
|
||||
| EvalStackValue.Float _ -> failwith $"this isn't a string! {arg1}"
|
||||
@@ -209,32 +412,38 @@ module Intrinsics =
|
||||
let arg2 =
|
||||
match arg2 with
|
||||
| EvalStackValue.ObjectRef h
|
||||
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> h
|
||||
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> Some h
|
||||
| EvalStackValue.ManagedPointer ManagedPointerSource.Null -> None
|
||||
| EvalStackValue.Int32 _
|
||||
| EvalStackValue.Int64 _
|
||||
| EvalStackValue.Float _ -> failwith $"this isn't a string! {arg2}"
|
||||
| _ -> failwith $"TODO: %O{arg2}"
|
||||
|
||||
if arg1 = arg2 then
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack (CliType.ofBool true) currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|> Some
|
||||
else
|
||||
let areEqual =
|
||||
match arg1, arg2 with
|
||||
| None, None -> true
|
||||
| Some _, None
|
||||
| None, Some _ -> false
|
||||
| Some arg1, Some arg2 ->
|
||||
if arg1 = arg2 then
|
||||
true
|
||||
else
|
||||
|
||||
let arg1 = ManagedHeap.get arg1 state.ManagedHeap
|
||||
let arg2 = ManagedHeap.get arg2 state.ManagedHeap
|
||||
let arg1 = ManagedHeap.get arg1 state.ManagedHeap
|
||||
let arg2 = ManagedHeap.get arg2 state.ManagedHeap
|
||||
|
||||
if
|
||||
AllocatedNonArrayObject.DereferenceField "_firstChar" arg1
|
||||
<> AllocatedNonArrayObject.DereferenceField "_firstChar" arg2
|
||||
then
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack (CliType.ofBool false) currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|> Some
|
||||
else
|
||||
failwith "TODO"
|
||||
if
|
||||
AllocatedNonArrayObject.DereferenceField "_firstChar" arg1
|
||||
<> AllocatedNonArrayObject.DereferenceField "_firstChar" arg2
|
||||
then
|
||||
false
|
||||
else
|
||||
failwith "TODO"
|
||||
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack (CliType.ofBool areEqual) currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|> Some
|
||||
| _ -> None
|
||||
| "System.Private.CoreLib", "Unsafe", "ReadUnaligned" ->
|
||||
let ptr, state = IlMachineState.popEvalStack currentThread state
|
||||
@@ -245,16 +454,10 @@ module Intrinsics =
|
||||
| EvalStackValue.ManagedPointer src -> IlMachineState.dereferencePointer state src
|
||||
| EvalStackValue.NativeInt src -> failwith "TODO"
|
||||
| EvalStackValue.ObjectRef ptr -> failwith "TODO"
|
||||
| EvalStackValue.UserDefinedValueType {
|
||||
Fields = [ f ]
|
||||
} -> go f.ContentsEval
|
||||
| EvalStackValue.UserDefinedValueType {
|
||||
Fields = []
|
||||
} -> failwith "unexpected no-fields object"
|
||||
| EvalStackValue.UserDefinedValueType {
|
||||
Fields = _ :: _ :: _
|
||||
} ->
|
||||
failwith "TODO: check overlapping fields to see if this is a pointer"
|
||||
| EvalStackValue.UserDefinedValueType vt ->
|
||||
match CliValueType.TryExactlyOneField vt with
|
||||
| None -> failwith "TODO"
|
||||
| Some field -> go (EvalStackValue.ofCliType field.Contents)
|
||||
| EvalStackValue.Int32 _
|
||||
| EvalStackValue.Int64 _
|
||||
| EvalStackValue.Float _ -> failwith $"this isn't a pointer! {ptr}"
|
||||
@@ -299,15 +502,46 @@ module Intrinsics =
|
||||
| [], ConcreteBool state.ConcreteTypes -> ()
|
||||
| _ -> failwith "bad signature for System.Private.CoreLib.RuntimeHelpers.IsReferenceOrContainsReference"
|
||||
|
||||
let generic =
|
||||
AllConcreteTypes.lookup (Seq.exactlyOne methodToCall.Generics) state.ConcreteTypes
|
||||
let arg = Seq.exactlyOne methodToCall.Generics
|
||||
|
||||
let generic =
|
||||
match generic with
|
||||
| None -> failwith "somehow have not already concretised type in IsReferenceOrContainsReferences"
|
||||
| Some generic -> generic
|
||||
let state, result =
|
||||
// Some types appear circular, because they're hardcoded in the runtime. We have to special-case them.
|
||||
match arg with
|
||||
| ConcreteChar state.ConcreteTypes -> state, false
|
||||
| _ ->
|
||||
|
||||
failwith $"TODO: do the thing on %O{generic}"
|
||||
let generic = AllConcreteTypes.lookup arg state.ConcreteTypes
|
||||
|
||||
let generic =
|
||||
match generic with
|
||||
| None -> failwith "somehow have not already concretised type in IsReferenceOrContainsReferences"
|
||||
| Some generic -> generic
|
||||
|
||||
let td =
|
||||
state.LoadedAssembly generic.Assembly
|
||||
|> Option.get
|
||||
|> fun a -> a.TypeDefs.[generic.Definition.Get]
|
||||
|
||||
let baseType =
|
||||
td.BaseType
|
||||
|> DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies generic.Assembly
|
||||
|
||||
match baseType with
|
||||
| ResolvedBaseType.Enum
|
||||
| ResolvedBaseType.ValueType ->
|
||||
td
|
||||
|> TypeInfo.mapGeneric (fun (par, _) -> TypeDefn.GenericTypeParameter par.SequenceNumber)
|
||||
|> containsRefType loggerFactory baseClassTypes state ImmutableDictionary.Empty
|
||||
|> fun (state, _, result) -> state, result
|
||||
| ResolvedBaseType.Object
|
||||
| ResolvedBaseType.Delegate -> state, true
|
||||
|
||||
let state =
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack (CliType.ofBool result) currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|
||||
Some state
|
||||
| "System.Private.CoreLib", "RuntimeHelpers", "InitializeArray" ->
|
||||
// https://github.com/dotnet/runtime/blob/9e5e6aa7bc36aeb2a154709a9d1192030c30a2ef/src/coreclr/System.Private.CoreLib/src/System/Runtime/CompilerServices/RuntimeHelpers.CoreCLR.cs#L18
|
||||
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
|
||||
@@ -319,11 +553,110 @@ module Intrinsics =
|
||||
failwith "TODO: if arg1 contains null handle, throw ArgumentException"
|
||||
|
||||
failwith "TODO: array initialization"
|
||||
| "System.Private.CoreLib", "Unsafe", "As" ->
|
||||
// https://github.com/dotnet/runtime/blob/721fdf6dcb032da1f883d30884e222e35e3d3c99/src/libraries/System.Private.CoreLib/src/System/Runtime/CompilerServices/Unsafe.cs#L64
|
||||
let inputType, retType =
|
||||
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
|
||||
| [ input ], ret -> input, ret
|
||||
| _ -> failwith "bad signature Unsafe.As"
|
||||
|
||||
let from, to_ =
|
||||
match Seq.toList methodToCall.Generics with
|
||||
| [ from ; to_ ] -> from, to_
|
||||
| _ -> failwith "bad generics"
|
||||
|
||||
if ConcreteTypeHandle.Byref to_ <> retType then
|
||||
failwith "bad return type"
|
||||
|
||||
if ConcreteTypeHandle.Byref from <> inputType then
|
||||
failwith "bad input type"
|
||||
|
||||
let from =
|
||||
match AllConcreteTypes.lookup from state.ConcreteTypes with
|
||||
| None -> failwith "somehow have not concretised input type"
|
||||
| Some t -> t
|
||||
|
||||
let to_ =
|
||||
match AllConcreteTypes.lookup to_ state.ConcreteTypes with
|
||||
| None -> failwith "somehow have not concretised ret type"
|
||||
| Some t -> t
|
||||
|
||||
let inputAddr, state = IlMachineState.popEvalStack currentThread state
|
||||
|
||||
let ptr =
|
||||
match inputAddr with
|
||||
| EvalStackValue.Int32 _
|
||||
| EvalStackValue.Int64 _
|
||||
| EvalStackValue.Float _ -> failwith "expected pointer type"
|
||||
| EvalStackValue.NativeInt nativeIntSource -> failwith "todo"
|
||||
| EvalStackValue.ManagedPointer src ->
|
||||
ManagedPointerSource.InterpretedAsType (src, to_)
|
||||
|> EvalStackValue.ManagedPointer
|
||||
| EvalStackValue.ObjectRef addr ->
|
||||
ManagedPointerSource.InterpretedAsType (ManagedPointerSource.Heap addr, to_)
|
||||
|> EvalStackValue.ManagedPointer
|
||||
| EvalStackValue.UserDefinedValueType evalStackValueUserType -> failwith "todo"
|
||||
|
||||
let state =
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack' ptr currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|
||||
Some state
|
||||
| "System.Private.CoreLib", "Unsafe", "SizeOf" ->
|
||||
// https://github.com/dotnet/runtime/blob/721fdf6dcb032da1f883d30884e222e35e3d3c99/src/libraries/System.Private.CoreLib/src/System/Runtime/CompilerServices/Unsafe.cs#L51
|
||||
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
|
||||
| [], ConcreteInt32 state.ConcreteTypes -> ()
|
||||
| _ -> failwith "bad signature Unsafe.SizeOf"
|
||||
|
||||
let ty =
|
||||
match Seq.toList methodToCall.Generics with
|
||||
| [ ty ] -> ty
|
||||
| _ -> failwith "bad generics"
|
||||
|
||||
let zero, state = IlMachineState.cliTypeZeroOfHandle state baseClassTypes ty
|
||||
|
||||
let size = CliType.sizeOf zero
|
||||
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack (CliType.Numeric (CliNumericType.Int32 size)) currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|> Some
|
||||
| "System.Private.CoreLib", "RuntimeHelpers", "CreateSpan" ->
|
||||
// https://github.com/dotnet/runtime/blob/9e5e6aa7bc36aeb2a154709a9d1192030c30a2ef/src/libraries/System.Private.CoreLib/src/System/Runtime/CompilerServices/RuntimeHelpers.cs#L153
|
||||
None
|
||||
| "System.Private.CoreLib", "Type", "op_Equality" ->
|
||||
// https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/Type.cs#L703
|
||||
None
|
||||
| "System.Private.CoreLib", "MemoryMarshal", "GetArrayDataReference" ->
|
||||
// https://github.com/dotnet/runtime/blob/d258af50034c192bf7f0a18856bf83d2903d98ae/src/coreclr/System.Private.CoreLib/src/System/Runtime/InteropServices/MemoryMarshal.CoreCLR.cs#L20
|
||||
let generic = Seq.exactlyOne methodToCall.Generics
|
||||
|
||||
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
|
||||
| [ ConcreteGenericArray state.ConcreteTypes generic ], ConcreteByref t when t = generic -> ()
|
||||
| _ -> failwith "bad signature MemoryMarshal.GetArrayDataReference"
|
||||
|
||||
let arr, state = IlMachineState.popEvalStack currentThread state
|
||||
|
||||
let toPush =
|
||||
match arr with
|
||||
| EvalStackValue.Int32 _
|
||||
| EvalStackValue.Int64 _
|
||||
| EvalStackValue.Float _ -> failwith "expected reference"
|
||||
| EvalStackValue.NativeInt nativeIntSource -> failwith "todo"
|
||||
| EvalStackValue.ObjectRef addr
|
||||
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) ->
|
||||
if not (state.ManagedHeap.Arrays.ContainsKey addr) then
|
||||
failwith "array not found"
|
||||
|
||||
EvalStackValue.ManagedPointer (ManagedPointerSource.ArrayIndex (addr, 0))
|
||||
| EvalStackValue.UserDefinedValueType evalStackValueUserType -> failwith "todo"
|
||||
| EvalStackValue.ManagedPointer ManagedPointerSource.Null -> failwith "TODO: raise NRE"
|
||||
| EvalStackValue.ManagedPointer _ -> failwith "todo"
|
||||
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack' toPush currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|> Some
|
||||
| a, b, c -> failwith $"TODO: implement JIT intrinsic {a}.{b}.{c}"
|
||||
|> Option.map (fun s -> s.WithThreadSwitchedToAssembly callerAssy currentThread |> fst)
|
||||
|
@@ -8,36 +8,18 @@ type SyncBlock =
|
||||
|
||||
type AllocatedNonArrayObject =
|
||||
{
|
||||
Fields : CliField list
|
||||
// TODO: this is a slightly odd domain; the same type for value types as class types!
|
||||
Contents : CliValueType
|
||||
ConcreteType : ConcreteTypeHandle
|
||||
SyncBlock : SyncBlock
|
||||
}
|
||||
|
||||
static member DereferenceField (name : string) (f : AllocatedNonArrayObject) : CliType =
|
||||
// TODO: this is wrong, it doesn't account for overlapping fields
|
||||
f.Fields |> List.find (fun f -> f.Name = name) |> _.Contents
|
||||
CliValueType.DereferenceField name f.Contents
|
||||
|
||||
static member SetField (name : string) (v : CliType) (f : AllocatedNonArrayObject) : AllocatedNonArrayObject =
|
||||
// TODO: this is wrong, it doesn't account for overlapping fields
|
||||
let contents =
|
||||
{
|
||||
Name = name
|
||||
Contents = v
|
||||
Offset = None
|
||||
}
|
||||
|
||||
{ f with
|
||||
Fields =
|
||||
f.Fields
|
||||
|> List.replaceWhere (fun f ->
|
||||
if f.Name = name then
|
||||
Some
|
||||
{ contents with
|
||||
Offset = f.Offset
|
||||
}
|
||||
else
|
||||
None
|
||||
)
|
||||
Contents = CliValueType.WithFieldSet name v f.Contents
|
||||
}
|
||||
|
||||
type AllocatedArray =
|
||||
|
@@ -1,5 +1,6 @@
|
||||
namespace WoofWare.PawPrint
|
||||
|
||||
open System
|
||||
open Microsoft.Extensions.Logging
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
@@ -52,7 +53,7 @@ module NullaryIlOp =
|
||||
| EvalStackValue.NativeInt nativeIntSource ->
|
||||
failwith $"TODO: Native int pointer dereferencing not implemented for {targetType}"
|
||||
| EvalStackValue.ObjectRef managedHeapAddress ->
|
||||
failwith "TODO: Object reference dereferencing not implemented"
|
||||
IlMachineState.dereferencePointer state (ManagedPointerSource.Heap managedHeapAddress)
|
||||
| other -> failwith $"Unexpected eval stack value for Ldind operation: {other}"
|
||||
|
||||
let loadedValue = loadedValue |> EvalStackValue.ofCliType
|
||||
@@ -81,53 +82,39 @@ module NullaryIlOp =
|
||||
| EvalStackValue.ManagedPointer src ->
|
||||
match src with
|
||||
| ManagedPointerSource.Null -> failwith "TODO: throw NullReferenceException"
|
||||
| ManagedPointerSource.InterpretedAsType (src, ty) -> failwith "TODO"
|
||||
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
|
||||
failwith "unexpected - can we really write to an argument?"
|
||||
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
|
||||
{ state with
|
||||
ThreadState =
|
||||
state.ThreadState
|
||||
|> Map.change
|
||||
sourceThread
|
||||
(fun state ->
|
||||
match state with
|
||||
| None -> failwith "tried to store in local variables of nonexistent stack frame"
|
||||
| Some state ->
|
||||
let frame = state.MethodStates.[methodFrame]
|
||||
|
||||
let frame =
|
||||
{ frame with
|
||||
LocalVariables =
|
||||
frame.LocalVariables.SetItem (
|
||||
int<uint16> whichVar,
|
||||
EvalStackValue.toCliTypeCoerced varType valueToStore
|
||||
)
|
||||
}
|
||||
|
||||
{ state with
|
||||
MethodStates = state.MethodStates.SetItem (methodFrame, frame)
|
||||
}
|
||||
|> Some
|
||||
)
|
||||
}
|
||||
state
|
||||
|> IlMachineState.setLocalVariable
|
||||
sourceThread
|
||||
methodFrame
|
||||
whichVar
|
||||
(EvalStackValue.toCliTypeCoerced varType valueToStore)
|
||||
| ManagedPointerSource.Heap managedHeapAddress -> failwith "todo"
|
||||
| ManagedPointerSource.ArrayIndex _ -> failwith "todo"
|
||||
| ManagedPointerSource.Field (managedPointerSource, fieldName) -> failwith "todo"
|
||||
| ManagedPointerSource.Field (managedPointerSource, fieldName) ->
|
||||
state
|
||||
|> IlMachineState.setFieldValue
|
||||
managedPointerSource
|
||||
(EvalStackValue.toCliTypeCoerced varType valueToStore)
|
||||
fieldName
|
||||
| EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo"
|
||||
|
||||
let internal ldElem
|
||||
(targetCliTypeZero : CliType)
|
||||
let internal getArrayElt
|
||||
(index : EvalStackValue)
|
||||
(arr : EvalStackValue)
|
||||
(currentThread : ThreadId)
|
||||
(state : IlMachineState)
|
||||
: ExecutionResult
|
||||
: CliType
|
||||
=
|
||||
let index =
|
||||
match index with
|
||||
| EvalStackValue.NativeInt src ->
|
||||
match src with
|
||||
| NativeIntSource.FunctionPointer _
|
||||
| NativeIntSource.FieldHandlePtr _
|
||||
| NativeIntSource.TypeHandlePtr _
|
||||
| NativeIntSource.ManagedPointer _ -> failwith "Refusing to treat a pointer as an array index"
|
||||
| NativeIntSource.Verbatim i -> i |> int32
|
||||
@@ -141,14 +128,7 @@ module NullaryIlOp =
|
||||
| EvalStackValue.ManagedPointer ManagedPointerSource.Null -> failwith "TODO: throw NRE"
|
||||
| _ -> failwith $"Invalid array: %O{arr}"
|
||||
|
||||
let value = IlMachineState.getArrayValue arrAddr index state
|
||||
|
||||
let state =
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack value currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|
||||
ExecutionResult.Stepped (state, WhatWeDid.Executed)
|
||||
IlMachineState.getArrayValue arrAddr index state
|
||||
|
||||
let internal stElem
|
||||
(targetCliTypeZero : CliType)
|
||||
@@ -164,6 +144,7 @@ module NullaryIlOp =
|
||||
| EvalStackValue.NativeInt src ->
|
||||
match src with
|
||||
| NativeIntSource.FunctionPointer _
|
||||
| NativeIntSource.FieldHandlePtr _
|
||||
| NativeIntSource.TypeHandlePtr _
|
||||
| NativeIntSource.ManagedPointer _ -> failwith "Refusing to treat a pointer as an array index"
|
||||
| NativeIntSource.Verbatim i -> i |> int32
|
||||
@@ -430,7 +411,7 @@ module NullaryIlOp =
|
||||
| Sub ->
|
||||
let val2, 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
|
||||
|> IlMachineState.pushToEvalStack' result currentThread
|
||||
@@ -440,30 +421,84 @@ module NullaryIlOp =
|
||||
| Sub_ovf -> failwith "TODO: Sub_ovf unimplemented"
|
||||
| Sub_ovf_un -> failwith "TODO: Sub_ovf_un unimplemented"
|
||||
| Add ->
|
||||
let val1, state = IlMachineState.popEvalStack currentThread state
|
||||
let val2, state = IlMachineState.popEvalStack currentThread state
|
||||
let result = BinaryArithmetic.execute ArithmeticOperation.add val1 val2
|
||||
let val1, state = IlMachineState.popEvalStack currentThread state
|
||||
let result = BinaryArithmetic.execute ArithmeticOperation.add state val1 val2
|
||||
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack' result currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|> Tuple.withRight WhatWeDid.Executed
|
||||
|> ExecutionResult.Stepped
|
||||
| Add_ovf -> failwith "TODO: Add_ovf unimplemented"
|
||||
| Add_ovf ->
|
||||
let val2, state = IlMachineState.popEvalStack currentThread state
|
||||
let val1, state = IlMachineState.popEvalStack currentThread state
|
||||
|
||||
let result =
|
||||
try
|
||||
BinaryArithmetic.execute ArithmeticOperation.addOvf state val1 val2 |> Ok
|
||||
with :? OverflowException as e ->
|
||||
Error e
|
||||
|
||||
let state =
|
||||
match result with
|
||||
| Ok result -> state |> IlMachineState.pushToEvalStack' result currentThread
|
||||
| Error excToThrow -> failwith "TODO: throw OverflowException"
|
||||
|
||||
state
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|> Tuple.withRight WhatWeDid.Executed
|
||||
|> ExecutionResult.Stepped
|
||||
| Add_ovf_un -> failwith "TODO: Add_ovf_un unimplemented"
|
||||
| Mul ->
|
||||
let val1, state = IlMachineState.popEvalStack currentThread state
|
||||
let val2, state = IlMachineState.popEvalStack currentThread state
|
||||
let result = BinaryArithmetic.execute ArithmeticOperation.mul val1 val2
|
||||
let val1, state = IlMachineState.popEvalStack currentThread state
|
||||
let result = BinaryArithmetic.execute ArithmeticOperation.mul state val1 val2
|
||||
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack' result currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|> Tuple.withRight WhatWeDid.Executed
|
||||
|> ExecutionResult.Stepped
|
||||
| Mul_ovf -> failwith "TODO: Mul_ovf unimplemented"
|
||||
| Mul_ovf ->
|
||||
let val2, state = IlMachineState.popEvalStack currentThread state
|
||||
let val1, state = IlMachineState.popEvalStack currentThread state
|
||||
|
||||
let result =
|
||||
try
|
||||
BinaryArithmetic.execute ArithmeticOperation.mulOvf 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
|
||||
| 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"
|
||||
| Shr ->
|
||||
let shift, state = IlMachineState.popEvalStack currentThread state
|
||||
@@ -490,7 +525,33 @@ module NullaryIlOp =
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|
||||
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped
|
||||
| Shr_un -> failwith "TODO: Shr_un unimplemented"
|
||||
| Shr_un ->
|
||||
let shift, state = IlMachineState.popEvalStack currentThread state
|
||||
let number, state = IlMachineState.popEvalStack currentThread state
|
||||
|
||||
let shift =
|
||||
match shift with
|
||||
| EvalStackValue.Int32 i -> i
|
||||
| EvalStackValue.NativeInt (NativeIntSource.Verbatim i) -> int<int64> i
|
||||
| _ -> failwith $"Not allowed shift of {shift}"
|
||||
|
||||
let result =
|
||||
// See table III.6
|
||||
match number with
|
||||
| EvalStackValue.Int32 i -> uint32<int> i >>> shift |> int32<uint32> |> EvalStackValue.Int32
|
||||
| EvalStackValue.Int64 i -> uint64<int64> i >>> shift |> int64<uint64> |> EvalStackValue.Int64
|
||||
| EvalStackValue.NativeInt (NativeIntSource.Verbatim i) ->
|
||||
(uint64<int64> i >>> shift |> int64<uint64>)
|
||||
|> NativeIntSource.Verbatim
|
||||
|> EvalStackValue.NativeInt
|
||||
| _ -> failwith $"Not allowed to shift {number}"
|
||||
|
||||
let state =
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack' result currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|
||||
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped
|
||||
| Shl ->
|
||||
let shift, state = IlMachineState.popEvalStack currentThread state
|
||||
let number, state = IlMachineState.popEvalStack currentThread state
|
||||
@@ -578,7 +639,37 @@ module NullaryIlOp =
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|
||||
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped
|
||||
| Xor -> failwith "TODO: Xor unimplemented"
|
||||
| Xor ->
|
||||
let v2, state = IlMachineState.popEvalStack currentThread state
|
||||
let v1, state = IlMachineState.popEvalStack currentThread state
|
||||
|
||||
let result =
|
||||
match v1, v2 with
|
||||
| EvalStackValue.Int32 v1, EvalStackValue.Int32 v2 -> v1 ^^^ v2 |> EvalStackValue.Int32
|
||||
| EvalStackValue.Int32 v1, EvalStackValue.NativeInt (NativeIntSource.Verbatim v2) ->
|
||||
int64<int32> v1 ^^^ v2 |> NativeIntSource.Verbatim |> EvalStackValue.NativeInt
|
||||
| EvalStackValue.Int32 _, EvalStackValue.NativeInt _ ->
|
||||
failwith $"can't do binary operation on non-verbatim native int {v2}"
|
||||
| EvalStackValue.Int64 v1, EvalStackValue.Int64 v2 -> v1 ^^^ v2 |> EvalStackValue.Int64
|
||||
| EvalStackValue.NativeInt (NativeIntSource.Verbatim v1), EvalStackValue.Int32 v2 ->
|
||||
v1 ^^^ int64<int32> v2 |> NativeIntSource.Verbatim |> EvalStackValue.NativeInt
|
||||
| EvalStackValue.NativeInt _, EvalStackValue.Int32 _ ->
|
||||
failwith $"can't do binary operation on non-verbatim native int {v1}"
|
||||
| EvalStackValue.NativeInt (NativeIntSource.Verbatim v1),
|
||||
EvalStackValue.NativeInt (NativeIntSource.Verbatim v2) ->
|
||||
v1 ^^^ v2 |> NativeIntSource.Verbatim |> EvalStackValue.NativeInt
|
||||
| EvalStackValue.NativeInt (NativeIntSource.Verbatim _), EvalStackValue.NativeInt _ ->
|
||||
failwith $"can't do binary operation on non-verbatim native int {v2}"
|
||||
| EvalStackValue.NativeInt _, EvalStackValue.NativeInt (NativeIntSource.Verbatim _) ->
|
||||
failwith $"can't do binary operation on non-verbatim native int {v1}"
|
||||
| _, _ -> failwith $"refusing to do binary operation on {v1} and {v2}"
|
||||
|
||||
let state =
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack' result currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|
||||
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped
|
||||
| Conv_I ->
|
||||
let popped, state = IlMachineState.popEvalStack currentThread state
|
||||
let converted = EvalStackValue.toNativeInt popped
|
||||
@@ -649,7 +740,20 @@ module NullaryIlOp =
|
||||
let state = state |> IlMachineState.advanceProgramCounter currentThread
|
||||
|
||||
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped
|
||||
| Conv_U1 -> failwith "TODO: Conv_U1 unimplemented"
|
||||
| Conv_U1 ->
|
||||
let popped, state = IlMachineState.popEvalStack currentThread state
|
||||
let converted = EvalStackValue.convToUInt8 popped
|
||||
|
||||
let state =
|
||||
match converted with
|
||||
| None -> failwith "TODO: Conv_U8 conversion failure unimplemented"
|
||||
| Some conv ->
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack' (EvalStackValue.Int32 conv) currentThread
|
||||
|
||||
let state = state |> IlMachineState.advanceProgramCounter currentThread
|
||||
|
||||
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped
|
||||
| Conv_U2 -> failwith "TODO: Conv_U2 unimplemented"
|
||||
| Conv_U4 -> failwith "TODO: Conv_U4 unimplemented"
|
||||
| Conv_U8 ->
|
||||
@@ -857,7 +961,16 @@ module NullaryIlOp =
|
||||
| Ldind_u8 -> failwith "TODO: Ldind_u8 unimplemented"
|
||||
| Ldind_r4 -> executeLdind LdindTargetType.LdindR4 currentThread state
|
||||
| Ldind_r8 -> executeLdind LdindTargetType.LdindR8 currentThread state
|
||||
| Rem -> failwith "TODO: Rem unimplemented"
|
||||
| Rem ->
|
||||
let val2, state = IlMachineState.popEvalStack currentThread state
|
||||
let val1, state = IlMachineState.popEvalStack currentThread state
|
||||
let result = BinaryArithmetic.execute ArithmeticOperation.rem state val1 val2
|
||||
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack' result currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|> Tuple.withRight WhatWeDid.Executed
|
||||
|> ExecutionResult.Stepped
|
||||
| Rem_un -> failwith "TODO: Rem_un unimplemented"
|
||||
| Volatile -> failwith "TODO: Volatile unimplemented"
|
||||
| Tail -> failwith "TODO: Tail unimplemented"
|
||||
@@ -874,7 +987,22 @@ module NullaryIlOp =
|
||||
| Conv_ovf_i -> failwith "TODO: Conv_ovf_i unimplemented"
|
||||
| Conv_ovf_u -> failwith "TODO: Conv_ovf_u unimplemented"
|
||||
| Neg -> failwith "TODO: Neg unimplemented"
|
||||
| Not -> failwith "TODO: Not unimplemented"
|
||||
| Not ->
|
||||
let val1, state = IlMachineState.popEvalStack currentThread state
|
||||
|
||||
let result =
|
||||
match val1 with
|
||||
| EvalStackValue.Int32 i -> ~~~i |> EvalStackValue.Int32
|
||||
| EvalStackValue.Int64 i -> ~~~i |> EvalStackValue.Int64
|
||||
| EvalStackValue.ManagedPointer _
|
||||
| EvalStackValue.ObjectRef _ -> failwith "refusing to negate a pointer"
|
||||
| _ -> failwith "TODO"
|
||||
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack' result currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|> Tuple.withRight WhatWeDid.Executed
|
||||
|> ExecutionResult.Stepped
|
||||
| Ldind_ref ->
|
||||
let addr, state = IlMachineState.popEvalStack currentThread state
|
||||
|
||||
@@ -885,6 +1013,7 @@ module NullaryIlOp =
|
||||
|
||||
let state =
|
||||
match referenced with
|
||||
| CliType.RuntimePointer (CliRuntimePointer.Managed _)
|
||||
| CliType.ObjectRef _ -> IlMachineState.pushToEvalStack referenced currentThread state
|
||||
| _ -> failwith $"Unexpected non-reference {referenced}"
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
@@ -909,19 +1038,91 @@ module NullaryIlOp =
|
||||
(EvalStackValue.toCliTypeCoerced (CliType.ObjectRef None) value)
|
||||
index
|
||||
| ManagedPointerSource.Field _ -> failwith "TODO"
|
||||
| ManagedPointerSource.InterpretedAsType (src, ty) -> failwith "TODO"
|
||||
| addr -> failwith $"TODO: {addr}"
|
||||
|
||||
let state = state |> IlMachineState.advanceProgramCounter currentThread
|
||||
|
||||
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped
|
||||
| Ldelem_i -> failwith "TODO: Ldelem_i unimplemented"
|
||||
| Ldelem_i1 -> failwith "TODO: Ldelem_i1 unimplemented"
|
||||
| Ldelem_i ->
|
||||
let index, state = IlMachineState.popEvalStack currentThread state
|
||||
let arr, state = IlMachineState.popEvalStack currentThread state
|
||||
|
||||
let value = getArrayElt index arr currentThread state
|
||||
|
||||
match value with
|
||||
| CliType.Numeric (CliNumericType.NativeInt _) -> ()
|
||||
| _ -> failwith "expected native int in Ldelem.i"
|
||||
|
||||
let state =
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack value currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|
||||
ExecutionResult.Stepped (state, WhatWeDid.Executed)
|
||||
| Ldelem_i1 ->
|
||||
let index, state = IlMachineState.popEvalStack currentThread state
|
||||
let arr, state = IlMachineState.popEvalStack currentThread state
|
||||
|
||||
let value = getArrayElt index arr currentThread state
|
||||
|
||||
failwith "TODO: we got back an int8; turn it into int32"
|
||||
|
||||
let state =
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack value currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|
||||
ExecutionResult.Stepped (state, WhatWeDid.Executed)
|
||||
| Ldelem_u1 -> failwith "TODO: Ldelem_u1 unimplemented"
|
||||
| Ldelem_i2 -> failwith "TODO: Ldelem_i2 unimplemented"
|
||||
| Ldelem_i2 ->
|
||||
let index, state = IlMachineState.popEvalStack currentThread state
|
||||
let arr, state = IlMachineState.popEvalStack currentThread state
|
||||
|
||||
let value = getArrayElt index arr currentThread state
|
||||
|
||||
failwith "TODO: we got back an int16; turn it into int32"
|
||||
|
||||
let state =
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack value currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|
||||
ExecutionResult.Stepped (state, WhatWeDid.Executed)
|
||||
| Ldelem_u2 -> failwith "TODO: Ldelem_u2 unimplemented"
|
||||
| Ldelem_i4 -> failwith "TODO: Ldelem_i4 unimplemented"
|
||||
| Ldelem_i4 ->
|
||||
let index, state = IlMachineState.popEvalStack currentThread state
|
||||
let arr, state = IlMachineState.popEvalStack currentThread state
|
||||
|
||||
let value = getArrayElt index arr currentThread state
|
||||
|
||||
match value with
|
||||
| CliType.Numeric (CliNumericType.Int32 _) -> ()
|
||||
| _ -> failwith "expected int32 in Ldelem.i4"
|
||||
|
||||
let state =
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack value currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|
||||
ExecutionResult.Stepped (state, WhatWeDid.Executed)
|
||||
| Ldelem_u4 -> failwith "TODO: Ldelem_u4 unimplemented"
|
||||
| Ldelem_i8 -> failwith "TODO: Ldelem_i8 unimplemented"
|
||||
| Ldelem_i8 ->
|
||||
let index, state = IlMachineState.popEvalStack currentThread state
|
||||
let arr, state = IlMachineState.popEvalStack currentThread state
|
||||
|
||||
let value = getArrayElt index arr currentThread state
|
||||
|
||||
match value with
|
||||
| CliType.Numeric (CliNumericType.Int64 _) -> ()
|
||||
| _ -> failwith "expected int64 in Ldelem.i8"
|
||||
|
||||
let state =
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack value currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|
||||
ExecutionResult.Stepped (state, WhatWeDid.Executed)
|
||||
| Ldelem_u8 -> failwith "TODO: Ldelem_u8 unimplemented"
|
||||
| Ldelem_r4 -> failwith "TODO: Ldelem_r4 unimplemented"
|
||||
| Ldelem_r8 -> failwith "TODO: Ldelem_r8 unimplemented"
|
||||
@@ -929,7 +1130,19 @@ module NullaryIlOp =
|
||||
let index, state = IlMachineState.popEvalStack currentThread state
|
||||
let arr, state = IlMachineState.popEvalStack currentThread state
|
||||
|
||||
ldElem (CliType.ObjectRef None) index arr currentThread state
|
||||
let value = getArrayElt index arr currentThread state
|
||||
|
||||
match value with
|
||||
| CliType.ObjectRef _
|
||||
| CliType.RuntimePointer _ -> ()
|
||||
| _ -> failwith "expected object reference in Ldelem.ref"
|
||||
|
||||
let state =
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack value currentThread
|
||||
|> IlMachineState.advanceProgramCounter currentThread
|
||||
|
||||
ExecutionResult.Stepped (state, WhatWeDid.Executed)
|
||||
| Stelem_i ->
|
||||
let value, state = IlMachineState.popEvalStack currentThread state
|
||||
let index, state = IlMachineState.popEvalStack currentThread state
|
||||
|
@@ -10,6 +10,7 @@ open Microsoft.Extensions.Logging
|
||||
module Program =
|
||||
/// Returns the pointer to the resulting array on the heap.
|
||||
let allocateArgs
|
||||
(loggerFactory : ILoggerFactory)
|
||||
(args : string list)
|
||||
(corelib : BaseClassTypes<DumpedAssembly>)
|
||||
(state : IlMachineState)
|
||||
@@ -18,6 +19,7 @@ module Program =
|
||||
let state, stringType =
|
||||
DumpedAssembly.typeInfoToTypeDefn' corelib state._LoadedAssemblies corelib.String
|
||||
|> IlMachineState.concretizeType
|
||||
loggerFactory
|
||||
corelib
|
||||
state
|
||||
corelib.Corelib.Name
|
||||
@@ -285,7 +287,7 @@ module Program =
|
||||
let arrayAllocation, state =
|
||||
match mainMethodFromMetadata.Signature.ParameterTypes |> Seq.toList with
|
||||
| [ TypeDefn.OneDimensionalArrayLowerBoundZero (TypeDefn.PrimitiveType PrimitiveType.String) ] ->
|
||||
allocateArgs argv baseClassTypes state
|
||||
allocateArgs loggerFactory argv baseClassTypes state
|
||||
| _ -> failwith "Main method must take an array of strings; other signatures not yet implemented"
|
||||
|
||||
match mainMethodFromMetadata.Signature.ReturnType with
|
||||
@@ -300,6 +302,11 @@ module Program =
|
||||
|
||||
logger.LogInformation "Main method class now initialised"
|
||||
|
||||
let state =
|
||||
{ state with
|
||||
ConcreteTypes = Corelib.concretizeAll state._LoadedAssemblies baseClassTypes state.ConcreteTypes
|
||||
}
|
||||
|
||||
// Now that BCL initialisation has taken place and the user-code classes are constructed,
|
||||
// overwrite the main thread completely using the already-concretized method.
|
||||
let methodState =
|
||||
|
@@ -1,5 +1,7 @@
|
||||
namespace WoofWare.PawPrint
|
||||
|
||||
open System.Collections.Immutable
|
||||
|
||||
type TypeHandleRegistry =
|
||||
private
|
||||
{
|
||||
@@ -17,8 +19,10 @@ module TypeHandleRegistry =
|
||||
|
||||
/// Returns an allocated System.RuntimeType as well.
|
||||
let getOrAllocate
|
||||
(allConcreteTypes : AllConcreteTypes)
|
||||
(corelib : BaseClassTypes<DumpedAssembly>)
|
||||
(allocState : 'allocState)
|
||||
(allocate : CliField list -> 'allocState -> ManagedHeapAddress * 'allocState)
|
||||
(allocate : CliValueType -> 'allocState -> ManagedHeapAddress * 'allocState)
|
||||
(def : ConcreteTypeHandle)
|
||||
(reg : TypeHandleRegistry)
|
||||
: ManagedHeapAddress * TypeHandleRegistry * 'allocState
|
||||
@@ -38,17 +42,40 @@ module TypeHandleRegistry =
|
||||
Name = "m_keepalive"
|
||||
Contents = CliType.ObjectRef 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"
|
||||
Contents = CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.Verbatim 0L))
|
||||
Offset = None
|
||||
Type =
|
||||
AllConcreteTypes.findExistingConcreteType
|
||||
allConcreteTypes
|
||||
(corelib.IntPtr.Assembly,
|
||||
corelib.IntPtr.Namespace,
|
||||
corelib.IntPtr.Name,
|
||||
ImmutableArray.Empty)
|
||||
|> Option.get
|
||||
}
|
||||
{
|
||||
Name = "m_handle"
|
||||
Contents = CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.TypeHandlePtr def))
|
||||
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?!
|
||||
// https://github.com/dotnet/runtime/blob/f0168ee80ba9aca18a7e7140b2bb436defda623c/src/coreclr/System.Private.CoreLib/src/System/RuntimeType.CoreCLR.cs#L2496
|
||||
@@ -56,8 +83,14 @@ module TypeHandleRegistry =
|
||||
Name = "GenericParameterCountAny"
|
||||
Contents = CliType.Numeric (CliNumericType.Int32 -1)
|
||||
Offset = None
|
||||
Type =
|
||||
AllConcreteTypes.findExistingConcreteType
|
||||
allConcreteTypes
|
||||
(corelib.Int32.Assembly, corelib.Int32.Namespace, corelib.Int32.Name, ImmutableArray.Empty)
|
||||
|> Option.get
|
||||
}
|
||||
]
|
||||
|> CliValueType.OfFields Layout.Default
|
||||
|
||||
let alloc, state = allocate fields allocState
|
||||
|
||||
|
@@ -28,6 +28,24 @@ module internal UnaryMetadataIlOp =
|
||||
| MetadataToken.MethodSpecification h ->
|
||||
let spec = activeAssy.MethodSpecs.[h]
|
||||
|
||||
let state, methodGenerics =
|
||||
((state, []), spec.Signature)
|
||||
||> Seq.fold (fun (state, acc) typeDefn ->
|
||||
let state, concreteType =
|
||||
IlMachineState.concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
(state.ActiveAssembly thread).Name
|
||||
currentMethod.DeclaringType.Generics
|
||||
currentMethod.Generics
|
||||
typeDefn
|
||||
|
||||
state, concreteType :: acc
|
||||
)
|
||||
|
||||
let methodGenerics = List.rev methodGenerics |> ImmutableArray.CreateRange
|
||||
|
||||
match spec.Method with
|
||||
| MetadataToken.MethodDef token ->
|
||||
let method =
|
||||
@@ -44,6 +62,7 @@ module internal UnaryMetadataIlOp =
|
||||
baseClassTypes
|
||||
thread
|
||||
(state.ActiveAssembly thread)
|
||||
methodGenerics
|
||||
ref
|
||||
state
|
||||
|
||||
@@ -58,6 +77,7 @@ module internal UnaryMetadataIlOp =
|
||||
baseClassTypes
|
||||
thread
|
||||
(state.ActiveAssembly thread)
|
||||
currentMethod.DeclaringType.Generics
|
||||
h
|
||||
state
|
||||
|
||||
@@ -114,6 +134,24 @@ module internal UnaryMetadataIlOp =
|
||||
| MetadataToken.MethodSpecification h ->
|
||||
let spec = activeAssy.MethodSpecs.[h]
|
||||
|
||||
let state, methodGenerics =
|
||||
((state, []), spec.Signature)
|
||||
||> Seq.fold (fun (state, acc) typeDefn ->
|
||||
let state, concreteType =
|
||||
IlMachineState.concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
(state.ActiveAssembly thread).Name
|
||||
currentMethod.DeclaringType.Generics
|
||||
ImmutableArray.Empty
|
||||
typeDefn
|
||||
|
||||
state, concreteType :: acc
|
||||
)
|
||||
|
||||
let methodGenerics = List.rev methodGenerics |> ImmutableArray.CreateRange
|
||||
|
||||
match spec.Method with
|
||||
| MetadataToken.MethodDef token ->
|
||||
let method =
|
||||
@@ -128,6 +166,7 @@ module internal UnaryMetadataIlOp =
|
||||
baseClassTypes
|
||||
thread
|
||||
(state.ActiveAssembly thread)
|
||||
methodGenerics
|
||||
ref
|
||||
state
|
||||
|
||||
@@ -142,6 +181,7 @@ module internal UnaryMetadataIlOp =
|
||||
baseClassTypes
|
||||
thread
|
||||
(state.ActiveAssembly thread)
|
||||
ImmutableArray.Empty
|
||||
h
|
||||
state
|
||||
|
||||
@@ -203,6 +243,7 @@ module internal UnaryMetadataIlOp =
|
||||
baseClassTypes
|
||||
thread
|
||||
(state.ActiveAssembly thread)
|
||||
ImmutableArray.Empty
|
||||
mr
|
||||
state
|
||||
|
||||
@@ -255,7 +296,7 @@ module internal UnaryMetadataIlOp =
|
||||
((state, []), instanceFields)
|
||||
||> List.fold (fun (state, zeros) field ->
|
||||
// TODO: generics
|
||||
let state, zero =
|
||||
let state, zero, concreteType =
|
||||
IlMachineState.cliTypeZeroOf
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
@@ -270,12 +311,13 @@ module internal UnaryMetadataIlOp =
|
||||
Name = field.Name
|
||||
Contents = zero
|
||||
Offset = field.Offset
|
||||
Type = concreteType
|
||||
}
|
||||
|
||||
state, field :: zeros
|
||||
)
|
||||
|
||||
let fields = List.rev fieldZeros
|
||||
let fields = List.rev fieldZeros |> CliValueType.OfFields ctorType.Layout
|
||||
|
||||
// Note: this is a bit unorthodox for value types, which *aren't* heap-allocated.
|
||||
// We'll perform their construction on the heap, though, to keep the interface
|
||||
@@ -354,7 +396,7 @@ module internal UnaryMetadataIlOp =
|
||||
ref
|
||||
| x -> failwith $"TODO: Newarr element type resolution unimplemented for {x}"
|
||||
|
||||
let state, zeroOfType =
|
||||
let state, zeroOfType, concreteTypeHandle =
|
||||
IlMachineState.cliTypeZeroOf
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
@@ -374,7 +416,55 @@ module internal UnaryMetadataIlOp =
|
||||
|> IlMachineState.advanceProgramCounter thread
|
||||
|
||||
state, WhatWeDid.Executed
|
||||
| Box -> failwith "TODO: Box unimplemented"
|
||||
| Box ->
|
||||
let state, ty, assy =
|
||||
match metadataToken with
|
||||
| MetadataToken.TypeDefinition h ->
|
||||
let state, ty = IlMachineState.lookupTypeDefn baseClassTypes state activeAssy h
|
||||
state, ty, activeAssy
|
||||
| MetadataToken.TypeReference ref ->
|
||||
IlMachineState.lookupTypeRef
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
activeAssy
|
||||
currentMethod.DeclaringType.Generics
|
||||
ref
|
||||
| MetadataToken.TypeSpecification spec -> state, activeAssy.TypeSpecs.[spec].Signature, activeAssy
|
||||
| _ -> failwith $"unexpected token {metadataToken} in Box"
|
||||
|
||||
let state, typeHandle =
|
||||
IlMachineState.concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
assy.Name
|
||||
currentMethod.DeclaringType.Generics
|
||||
currentMethod.Generics
|
||||
ty
|
||||
|
||||
let toBox, state = state |> IlMachineState.popEvalStack thread
|
||||
|
||||
let targetType =
|
||||
AllConcreteTypes.lookup typeHandle state.ConcreteTypes |> Option.get
|
||||
|
||||
let defn =
|
||||
state._LoadedAssemblies.[targetType.Assembly.FullName].TypeDefs.[targetType.Definition.Get]
|
||||
|
||||
let baseType =
|
||||
DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies targetType.Assembly defn.BaseType
|
||||
|
||||
let toPush =
|
||||
match baseType with
|
||||
| ResolvedBaseType.Enum
|
||||
| ResolvedBaseType.ValueType -> failwith "TODO: implement Box"
|
||||
| ResolvedBaseType.Object
|
||||
| ResolvedBaseType.Delegate -> toBox
|
||||
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack' toPush thread
|
||||
|> IlMachineState.advanceProgramCounter thread
|
||||
|> Tuple.withRight WhatWeDid.Executed
|
||||
| Ldelema ->
|
||||
let index, state = IlMachineState.popEvalStack thread state
|
||||
let arr, state = IlMachineState.popEvalStack thread state
|
||||
@@ -436,6 +526,7 @@ module internal UnaryMetadataIlOp =
|
||||
|
||||
let state, targetConcreteType =
|
||||
IlMachineState.concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
activeAssy.Name
|
||||
@@ -456,7 +547,8 @@ module internal UnaryMetadataIlOp =
|
||||
if v.ConcreteType = targetConcreteType then
|
||||
actualObj
|
||||
else
|
||||
failwith $"TODO: is {v.ConcreteType} an instance of {targetType} ({targetConcreteType})"
|
||||
failwith
|
||||
$"TODO: is {AllConcreteTypes.lookup v.ConcreteType state.ConcreteTypes |> Option.get} an instance of {AllConcreteTypes.lookup targetConcreteType state.ConcreteTypes |> Option.get}"
|
||||
| false, _ ->
|
||||
|
||||
match state.ManagedHeap.Arrays.TryGetValue addr with
|
||||
@@ -481,7 +573,14 @@ module internal UnaryMetadataIlOp =
|
||||
state, field
|
||||
| MetadataToken.MemberReference mr ->
|
||||
let state, _, field, _ =
|
||||
IlMachineState.resolveMember loggerFactory baseClassTypes thread activeAssy mr state
|
||||
IlMachineState.resolveMember
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
thread
|
||||
activeAssy
|
||||
ImmutableArray.Empty
|
||||
mr
|
||||
state
|
||||
|
||||
match field with
|
||||
| Choice1Of2 _method -> failwith "member reference was unexpectedly a method"
|
||||
@@ -492,17 +591,18 @@ module internal UnaryMetadataIlOp =
|
||||
logger.LogInformation (
|
||||
"Storing in object field {FieldAssembly}.{FieldDeclaringType}.{FieldName} (type {FieldType})",
|
||||
field.DeclaringType.Assembly.Name,
|
||||
field.Name,
|
||||
field.DeclaringType.Name,
|
||||
field.Name,
|
||||
field.Signature
|
||||
)
|
||||
|
||||
let valueToStore, state = IlMachineState.popEvalStack thread state
|
||||
let currentObj, state = IlMachineState.popEvalStack thread state
|
||||
|
||||
let state, declaringTypeHandle, typeGenerics =
|
||||
IlMachineState.concretizeFieldForExecution loggerFactory baseClassTypes thread field state
|
||||
|
||||
let state, zero =
|
||||
let state, zero, concreteTypeHandle =
|
||||
IlMachineState.cliTypeZeroOf
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
@@ -514,8 +614,6 @@ module internal UnaryMetadataIlOp =
|
||||
|
||||
let valueToStore = EvalStackValue.toCliTypeCoerced zero valueToStore
|
||||
|
||||
let currentObj, state = IlMachineState.popEvalStack thread state
|
||||
|
||||
if field.Attributes.HasFlag FieldAttributes.Static then
|
||||
let state =
|
||||
IlMachineState.setStatic declaringTypeHandle field.Name valueToStore state
|
||||
@@ -534,20 +632,7 @@ module internal UnaryMetadataIlOp =
|
||||
match state.ManagedHeap.NonArrayObjects.TryGetValue addr with
|
||||
| false, _ -> failwith $"todo: array {addr}"
|
||||
| true, v ->
|
||||
let v =
|
||||
{ v with
|
||||
Fields =
|
||||
v.Fields
|
||||
|> List.replaceWhere (fun f ->
|
||||
if f.Name = field.Name then
|
||||
{ f with
|
||||
Contents = valueToStore
|
||||
}
|
||||
|> Some
|
||||
else
|
||||
None
|
||||
)
|
||||
}
|
||||
let v = AllocatedNonArrayObject.SetField field.Name valueToStore v
|
||||
|
||||
let heap =
|
||||
{ state.ManagedHeap with
|
||||
@@ -576,6 +661,7 @@ module internal UnaryMetadataIlOp =
|
||||
state |> IlMachineState.setArrayValue arr newValue index
|
||||
| EvalStackValue.ManagedPointer (ManagedPointerSource.Field (managedPointerSource, fieldName)) ->
|
||||
failwith "todo"
|
||||
| EvalStackValue.ManagedPointer (ManagedPointerSource.InterpretedAsType (src, ty)) -> failwith "todo"
|
||||
| EvalStackValue.UserDefinedValueType _ -> failwith "todo"
|
||||
|
||||
state
|
||||
@@ -601,6 +687,7 @@ module internal UnaryMetadataIlOp =
|
||||
baseClassTypes
|
||||
thread
|
||||
(state.ActiveAssembly thread)
|
||||
ImmutableArray.Empty
|
||||
mr
|
||||
state
|
||||
|
||||
@@ -631,7 +718,7 @@ module internal UnaryMetadataIlOp =
|
||||
|
||||
let popped, state = IlMachineState.popEvalStack thread state
|
||||
|
||||
let state, zero =
|
||||
let state, zero, concreteTypeHandle =
|
||||
IlMachineState.cliTypeZeroOf
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
@@ -660,7 +747,14 @@ module internal UnaryMetadataIlOp =
|
||||
state, field
|
||||
| MetadataToken.MemberReference mr ->
|
||||
let state, assyName, field, _ =
|
||||
IlMachineState.resolveMember loggerFactory baseClassTypes thread activeAssy mr state
|
||||
IlMachineState.resolveMember
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
thread
|
||||
activeAssy
|
||||
ImmutableArray.Empty
|
||||
mr
|
||||
state
|
||||
|
||||
match field with
|
||||
| Choice1Of2 _method -> failwith "member reference was unexpectedly a method"
|
||||
@@ -691,7 +785,7 @@ module internal UnaryMetadataIlOp =
|
||||
match IlMachineState.getStatic declaringTypeHandle field.Name state with
|
||||
| Some v -> state, v
|
||||
| None ->
|
||||
let state, zero =
|
||||
let state, zero, concreteTypeHandle =
|
||||
IlMachineState.cliTypeZeroOf
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
@@ -733,7 +827,7 @@ module internal UnaryMetadataIlOp =
|
||||
| false, _ -> failwith $"todo: array {managedHeapAddress}"
|
||||
| true, v ->
|
||||
IlMachineState.pushToEvalStack
|
||||
(v.Fields |> List.find (fun f -> field.Name = f.Name) |> _.Contents)
|
||||
(AllocatedNonArrayObject.DereferenceField field.Name v)
|
||||
thread
|
||||
state
|
||||
| EvalStackValue.ManagedPointer (ManagedPointerSource.ArrayIndex (arr, index)) ->
|
||||
@@ -748,9 +842,11 @@ module internal UnaryMetadataIlOp =
|
||||
IlMachineState.getFieldValue src fieldName state |> CliType.getField field.Name
|
||||
|
||||
IlMachineState.pushToEvalStack currentValue thread state
|
||||
| EvalStackValue.ManagedPointer (ManagedPointerSource.InterpretedAsType (src, ty)) -> failwith "TODO"
|
||||
| EvalStackValue.UserDefinedValueType vt ->
|
||||
let result = vt |> EvalStackValueUserType.DereferenceField field.Name
|
||||
IlMachineState.pushToEvalStack' result thread state
|
||||
let result = vt |> CliValueType.DereferenceField field.Name
|
||||
|
||||
IlMachineState.pushToEvalStack result thread state
|
||||
|
||||
state
|
||||
|> IlMachineState.advanceProgramCounter thread
|
||||
@@ -779,7 +875,15 @@ module internal UnaryMetadataIlOp =
|
||||
state, field
|
||||
| MetadataToken.MemberReference mr ->
|
||||
let state, assyName, field, _ =
|
||||
IlMachineState.resolveMember loggerFactory baseClassTypes thread activeAssy mr state
|
||||
// TODO: generics
|
||||
IlMachineState.resolveMember
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
thread
|
||||
activeAssy
|
||||
ImmutableArray.Empty
|
||||
mr
|
||||
state
|
||||
|
||||
match field with
|
||||
| Choice1Of2 _method -> failwith "member reference was unexpectedly a method"
|
||||
@@ -793,6 +897,7 @@ module internal UnaryMetadataIlOp =
|
||||
|> IlMachineState.pushToEvalStack' result thread
|
||||
|> IlMachineState.advanceProgramCounter thread
|
||||
|> Tuple.withRight WhatWeDid.Executed
|
||||
|
||||
| Ldsfld ->
|
||||
let state, field =
|
||||
match metadataToken with
|
||||
@@ -807,7 +912,14 @@ module internal UnaryMetadataIlOp =
|
||||
state, field
|
||||
| MetadataToken.MemberReference mr ->
|
||||
let state, _, field, _ =
|
||||
IlMachineState.resolveMember loggerFactory baseClassTypes thread activeAssy mr state
|
||||
IlMachineState.resolveMember
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
thread
|
||||
activeAssy
|
||||
ImmutableArray.Empty
|
||||
mr
|
||||
state
|
||||
|
||||
match field with
|
||||
| Choice1Of2 _method -> failwith "member reference was unexpectedly a method"
|
||||
@@ -838,7 +950,7 @@ module internal UnaryMetadataIlOp =
|
||||
let fieldValue, state =
|
||||
match IlMachineState.getStatic declaringTypeHandle field.Name state with
|
||||
| None ->
|
||||
let state, newVal =
|
||||
let state, newVal, concreteTypeHandle =
|
||||
IlMachineState.cliTypeZeroOf
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
@@ -916,7 +1028,7 @@ module internal UnaryMetadataIlOp =
|
||||
let elementType =
|
||||
DumpedAssembly.typeInfoToTypeDefn baseClassTypes state._LoadedAssemblies elementType
|
||||
|
||||
let state, zeroOfType =
|
||||
let state, zeroOfType, concreteTypeHandle =
|
||||
IlMachineState.cliTypeZeroOf
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
@@ -983,6 +1095,7 @@ module internal UnaryMetadataIlOp =
|
||||
IlMachineState.pushToEvalStack toPush thread state
|
||||
|> IlMachineState.advanceProgramCounter thread
|
||||
|> Tuple.withRight WhatWeDid.Executed
|
||||
|
||||
| Initobj ->
|
||||
let popped, state = IlMachineState.popEvalStack thread state
|
||||
let declaringTypeGenerics = currentMethod.DeclaringType.Generics
|
||||
@@ -1012,7 +1125,7 @@ module internal UnaryMetadataIlOp =
|
||||
targetType
|
||||
|> DumpedAssembly.typeInfoToTypeDefn baseClassTypes state._LoadedAssemblies
|
||||
|
||||
let state, zeroOfType =
|
||||
let state, zeroOfType, concreteTypeHandle =
|
||||
IlMachineState.cliTypeZeroOf
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
@@ -1040,12 +1153,14 @@ module internal UnaryMetadataIlOp =
|
||||
| ManagedPointerSource.Field (managedPointerSource, fieldName) ->
|
||||
state |> IlMachineState.setFieldValue managedPointerSource zeroOfType fieldName
|
||||
| ManagedPointerSource.Null -> failwith "runtime error: unexpectedly Initobj'ing null"
|
||||
| ManagedPointerSource.InterpretedAsType (src, ty) -> failwith "TODO"
|
||||
| ManagedPointerSource.Heap _ -> failwith "logic error"
|
||||
| EvalStackValue.UserDefinedValueType evalStackValueUserType -> failwith "todo"
|
||||
|
||||
state
|
||||
|> IlMachineState.advanceProgramCounter thread
|
||||
|> Tuple.withRight WhatWeDid.Executed
|
||||
|
||||
| Ldsflda ->
|
||||
|
||||
// TODO: check whether we should throw FieldAccessException
|
||||
@@ -1067,30 +1182,31 @@ module internal UnaryMetadataIlOp =
|
||||
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
|
||||
| NothingToDo state ->
|
||||
|
||||
if TypeDefn.isManaged field.Signature then
|
||||
match IlMachineState.getStatic declaringTypeHandle field.Name state with
|
||||
| Some v ->
|
||||
IlMachineState.pushToEvalStack v thread state
|
||||
|> IlMachineState.advanceProgramCounter thread
|
||||
|> Tuple.withRight WhatWeDid.Executed
|
||||
| None ->
|
||||
// Field is not yet initialised
|
||||
let state, zero =
|
||||
IlMachineState.cliTypeZeroOf
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
activeAssy
|
||||
field.Signature
|
||||
typeGenerics
|
||||
ImmutableArray.Empty // field can't have its own generics
|
||||
state
|
||||
// TODO: if field type is unmanaged, push an unmanaged pointer
|
||||
// TODO: Note that field may be a static global with an assigned relative virtual address
|
||||
// (the offset of the field from the base address at which its containing PE file is loaded into memory)
|
||||
// where the memory is unmanaged.
|
||||
match IlMachineState.getStatic declaringTypeHandle field.Name state with
|
||||
| Some v ->
|
||||
IlMachineState.pushToEvalStack v thread state
|
||||
|> IlMachineState.advanceProgramCounter thread
|
||||
|> Tuple.withRight WhatWeDid.Executed
|
||||
| None ->
|
||||
// Field is not yet initialised
|
||||
let state, zero, concreteTypeHandle =
|
||||
IlMachineState.cliTypeZeroOf
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
activeAssy
|
||||
field.Signature
|
||||
typeGenerics
|
||||
ImmutableArray.Empty // field can't have its own generics
|
||||
state
|
||||
|
||||
IlMachineState.setStatic declaringTypeHandle field.Name zero state
|
||||
|> IlMachineState.pushToEvalStack (CliType.ObjectRef None) thread
|
||||
|> IlMachineState.advanceProgramCounter thread
|
||||
|> Tuple.withRight WhatWeDid.Executed
|
||||
else
|
||||
failwith "TODO: Ldsflda - push unmanaged pointer"
|
||||
IlMachineState.setStatic declaringTypeHandle field.Name zero state
|
||||
|> IlMachineState.pushToEvalStack (CliType.ObjectRef None) thread
|
||||
|> IlMachineState.advanceProgramCounter thread
|
||||
|> Tuple.withRight WhatWeDid.Executed
|
||||
|
||||
| Ldftn ->
|
||||
let method, methodGenerics =
|
||||
@@ -1142,6 +1258,50 @@ module internal UnaryMetadataIlOp =
|
||||
| Stobj -> failwith "TODO: Stobj unimplemented"
|
||||
| Constrained -> failwith "TODO: Constrained unimplemented"
|
||||
| Ldtoken ->
|
||||
// Helper function to handle type tokens and create RuntimeTypeHandle
|
||||
let handleTypeToken (typeDefn : TypeDefn) (state : IlMachineState) : IlMachineState =
|
||||
let ty = baseClassTypes.RuntimeTypeHandle
|
||||
let field = ty.Fields |> List.exactlyOne
|
||||
|
||||
if field.Name <> "m_type" then
|
||||
failwith $"unexpected field name ${field.Name} for BCL type RuntimeTypeHandle"
|
||||
|
||||
let methodGenerics = currentMethod.Generics
|
||||
let typeGenerics = currentMethod.DeclaringType.Generics
|
||||
|
||||
let state, handle =
|
||||
IlMachineState.concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
activeAssy.Name
|
||||
typeGenerics
|
||||
methodGenerics
|
||||
typeDefn
|
||||
|
||||
let alloc, state =
|
||||
IlMachineState.getOrAllocateType loggerFactory baseClassTypes handle state
|
||||
|
||||
let vt =
|
||||
// https://github.com/dotnet/runtime/blob/2b21c73fa2c32fa0195e4a411a435dda185efd08/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L92
|
||||
{
|
||||
Name = "m_type"
|
||||
Contents = CliType.ObjectRef (Some alloc)
|
||||
Offset = None
|
||||
Type =
|
||||
AllConcreteTypes.findExistingConcreteType
|
||||
state.ConcreteTypes
|
||||
(baseClassTypes.Object.Assembly,
|
||||
baseClassTypes.Object.Namespace,
|
||||
baseClassTypes.Object.Name,
|
||||
ImmutableArray.Empty)
|
||||
|> Option.get
|
||||
}
|
||||
|> List.singleton
|
||||
|> CliValueType.OfFields Layout.Default
|
||||
|
||||
IlMachineState.pushToEvalStack (CliType.ValueType vt) thread state
|
||||
|
||||
let state =
|
||||
match metadataToken with
|
||||
| MetadataToken.FieldDefinition h ->
|
||||
@@ -1179,6 +1339,7 @@ module internal UnaryMetadataIlOp =
|
||||
|
||||
let state, handle =
|
||||
IlMachineState.concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
assy.Name
|
||||
@@ -1186,16 +1347,25 @@ module internal UnaryMetadataIlOp =
|
||||
methodGenerics
|
||||
typeDefn
|
||||
|
||||
let alloc, state = IlMachineState.getOrAllocateType baseClassTypes handle state
|
||||
let alloc, state =
|
||||
IlMachineState.getOrAllocateType loggerFactory baseClassTypes handle state
|
||||
|
||||
let vt =
|
||||
{
|
||||
Name = "m_type"
|
||||
Contents = CliType.ObjectRef (Some alloc)
|
||||
Offset = None
|
||||
Type =
|
||||
AllConcreteTypes.findExistingConcreteType
|
||||
state.ConcreteTypes
|
||||
(baseClassTypes.Object.Assembly,
|
||||
baseClassTypes.Object.Namespace,
|
||||
baseClassTypes.Object.Name,
|
||||
ImmutableArray.Empty)
|
||||
|> Option.get
|
||||
}
|
||||
|> List.singleton
|
||||
|> CliValueType.OfFields
|
||||
|> CliValueType.OfFields Layout.Default
|
||||
|
||||
IlMachineState.pushToEvalStack (CliType.ValueType vt) thread state
|
||||
| MetadataToken.TypeReference h ->
|
||||
@@ -1214,6 +1384,7 @@ module internal UnaryMetadataIlOp =
|
||||
|
||||
let state, handle =
|
||||
IlMachineState.concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
assy.Name
|
||||
@@ -1221,60 +1392,102 @@ module internal UnaryMetadataIlOp =
|
||||
methodGenerics
|
||||
typeDefn
|
||||
|
||||
let alloc, state = IlMachineState.getOrAllocateType baseClassTypes handle state
|
||||
let alloc, state =
|
||||
IlMachineState.getOrAllocateType loggerFactory baseClassTypes handle state
|
||||
|
||||
let vt =
|
||||
{
|
||||
Name = "m_type"
|
||||
Contents = CliType.ObjectRef (Some alloc)
|
||||
Offset = None
|
||||
Type =
|
||||
AllConcreteTypes.findExistingConcreteType
|
||||
state.ConcreteTypes
|
||||
(baseClassTypes.Object.Assembly,
|
||||
baseClassTypes.Object.Namespace,
|
||||
baseClassTypes.Object.Name,
|
||||
ImmutableArray.Empty)
|
||||
|> Option.get
|
||||
}
|
||||
|> List.singleton
|
||||
|> CliValueType.OfFields
|
||||
|> CliValueType.OfFields Layout.Default
|
||||
|
||||
IlMachineState.pushToEvalStack (CliType.ValueType vt) thread state
|
||||
| MetadataToken.TypeDefinition h ->
|
||||
let ty = baseClassTypes.RuntimeTypeHandle
|
||||
let field = ty.Fields |> List.exactlyOne
|
||||
|
||||
if field.Name <> "m_type" then
|
||||
failwith $"unexpected field name ${field.Name} for BCL type RuntimeTypeHandle"
|
||||
|
||||
let methodGenerics = currentMethod.Generics
|
||||
|
||||
let typeGenerics = currentMethod.DeclaringType.Generics
|
||||
|
||||
let state, typeDefn =
|
||||
IlMachineState.lookupTypeDefn baseClassTypes state activeAssy h
|
||||
|
||||
let state, handle =
|
||||
IlMachineState.concretizeType
|
||||
baseClassTypes
|
||||
state
|
||||
activeAssy.Name
|
||||
typeGenerics
|
||||
methodGenerics
|
||||
typeDefn
|
||||
|
||||
let alloc, state = IlMachineState.getOrAllocateType baseClassTypes handle state
|
||||
|
||||
let vt =
|
||||
{
|
||||
Name = "m_type"
|
||||
Contents = CliType.ObjectRef (Some alloc)
|
||||
Offset = None
|
||||
}
|
||||
|> List.singleton
|
||||
|> CliValueType.OfFields
|
||||
|
||||
IlMachineState.pushToEvalStack (CliType.ValueType vt) thread state
|
||||
handleTypeToken typeDefn state
|
||||
| _ -> failwith $"Unexpected metadata token %O{metadataToken} in LdToken"
|
||||
|
||||
state
|
||||
|> IlMachineState.advanceProgramCounter thread
|
||||
|> Tuple.withRight WhatWeDid.Executed
|
||||
| Cpobj -> failwith "TODO: Cpobj unimplemented"
|
||||
| Ldobj -> failwith "TODO: Ldobj unimplemented"
|
||||
| Ldobj ->
|
||||
let state, ty, assy =
|
||||
match metadataToken with
|
||||
| MetadataToken.TypeDefinition h ->
|
||||
let state, ty = IlMachineState.lookupTypeDefn baseClassTypes state activeAssy h
|
||||
state, ty, activeAssy
|
||||
| MetadataToken.TypeReference ref ->
|
||||
IlMachineState.lookupTypeRef
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
activeAssy
|
||||
currentMethod.DeclaringType.Generics
|
||||
ref
|
||||
| MetadataToken.TypeSpecification spec -> state, activeAssy.TypeSpecs.[spec].Signature, activeAssy
|
||||
| _ -> failwith $"unexpected token {metadataToken} in Ldobj"
|
||||
|
||||
let state, typeHandle =
|
||||
IlMachineState.concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
assy.Name
|
||||
currentMethod.DeclaringType.Generics
|
||||
currentMethod.Generics
|
||||
ty
|
||||
|
||||
let addr, state = state |> IlMachineState.popEvalStack thread
|
||||
|
||||
let obj =
|
||||
match addr with
|
||||
| EvalStackValue.ObjectRef addr ->
|
||||
IlMachineState.dereferencePointer state (ManagedPointerSource.Heap addr)
|
||||
| EvalStackValue.ManagedPointer ptr -> IlMachineState.dereferencePointer state ptr
|
||||
| EvalStackValue.Float _
|
||||
| EvalStackValue.Int64 _
|
||||
| EvalStackValue.Int32 _ -> failwith "refusing to interpret constant as address"
|
||||
| _ -> failwith "TODO"
|
||||
|
||||
let targetType =
|
||||
AllConcreteTypes.lookup typeHandle state.ConcreteTypes |> Option.get
|
||||
|
||||
let defn =
|
||||
state._LoadedAssemblies.[targetType.Assembly.FullName].TypeDefs.[targetType.Definition.Get]
|
||||
|
||||
let baseType =
|
||||
DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies targetType.Assembly defn.BaseType
|
||||
|
||||
let toPush =
|
||||
match baseType with
|
||||
| ResolvedBaseType.Enum
|
||||
| ResolvedBaseType.ValueType ->
|
||||
failwith
|
||||
$"TODO: push %O{obj} as type %s{targetType.Assembly.Name}.%s{targetType.Namespace}.%s{targetType.Name}"
|
||||
| ResolvedBaseType.Object
|
||||
| ResolvedBaseType.Delegate ->
|
||||
// III.4.13: reference types are just copied as pointers.
|
||||
// We should have received a pointer, so let's just pass it back.
|
||||
obj
|
||||
|
||||
state
|
||||
|> IlMachineState.pushToEvalStack toPush thread
|
||||
|> IlMachineState.advanceProgramCounter thread
|
||||
|> Tuple.withRight WhatWeDid.Executed
|
||||
| Sizeof ->
|
||||
let state, ty, assy =
|
||||
match metadataToken with
|
||||
@@ -1289,10 +1502,12 @@ module internal UnaryMetadataIlOp =
|
||||
activeAssy
|
||||
currentMethod.DeclaringType.Generics
|
||||
ref
|
||||
| MetadataToken.TypeSpecification spec -> state, activeAssy.TypeSpecs.[spec].Signature, activeAssy
|
||||
| _ -> failwith $"unexpected token {metadataToken} in Sizeof"
|
||||
|
||||
let state, typeHandle =
|
||||
IlMachineState.concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
assy.Name
|
||||
|
@@ -2,12 +2,13 @@ namespace WoofWare.PawPrint
|
||||
|
||||
open System.Collections.Immutable
|
||||
open System.Reflection
|
||||
open System.Reflection.Metadata
|
||||
open Microsoft.Extensions.Logging
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||
module internal UnaryStringTokenIlOp =
|
||||
let execute
|
||||
(loggerFactory : ILoggerFactory)
|
||||
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
|
||||
(op : UnaryStringTokenIlOp)
|
||||
(sh : StringToken)
|
||||
@@ -55,17 +56,35 @@ module internal UnaryStringTokenIlOp =
|
||||
Name = "_firstChar"
|
||||
Contents = CliType.ofChar state.ManagedHeap.StringArrayData.[dataAddr]
|
||||
Offset = None
|
||||
Type =
|
||||
AllConcreteTypes.findExistingConcreteType
|
||||
state.ConcreteTypes
|
||||
(baseClassTypes.Char.Assembly,
|
||||
baseClassTypes.Char.Namespace,
|
||||
baseClassTypes.Char.Name,
|
||||
ImmutableArray.Empty)
|
||||
|> Option.get
|
||||
}
|
||||
{
|
||||
Name = "_stringLength"
|
||||
Contents = CliType.Numeric (CliNumericType.Int32 stringToAllocate.Length)
|
||||
Offset = None
|
||||
Type =
|
||||
AllConcreteTypes.findExistingConcreteType
|
||||
state.ConcreteTypes
|
||||
(baseClassTypes.Int32.Assembly,
|
||||
baseClassTypes.Int32.Namespace,
|
||||
baseClassTypes.Int32.Name,
|
||||
ImmutableArray.Empty)
|
||||
|> Option.get
|
||||
}
|
||||
]
|
||||
|> CliValueType.OfFields Layout.Default
|
||||
|
||||
let state, stringType =
|
||||
DumpedAssembly.typeInfoToTypeDefn' baseClassTypes state._LoadedAssemblies baseClassTypes.String
|
||||
|> IlMachineState.concretizeType
|
||||
loggerFactory
|
||||
baseClassTypes
|
||||
state
|
||||
baseClassTypes.Corelib.Name
|
||||
|
@@ -10,7 +10,6 @@
|
||||
<Compile Include="List.fs" />
|
||||
<Compile Include="ImmutableArray.fs" />
|
||||
<Compile Include="Result.fs" />
|
||||
<Compile Include="Constants.fs" />
|
||||
<Compile Include="Corelib.fs" />
|
||||
<Compile Include="AbstractMachineDomain.fs" />
|
||||
<Compile Include="BasicCliType.fs" />
|
||||
@@ -21,10 +20,10 @@
|
||||
<Compile Include="Exceptions.fs" />
|
||||
<Compile Include="EvalStack.fs" />
|
||||
<Compile Include="EvalStackValueComparisons.fs" />
|
||||
<Compile Include="BinaryArithmetic.fs" />
|
||||
<Compile Include="MethodState.fs" />
|
||||
<Compile Include="ThreadState.fs" />
|
||||
<Compile Include="IlMachineState.fs" />
|
||||
<Compile Include="BinaryArithmetic.fs" />
|
||||
<Compile Include="Intrinsics.fs" />
|
||||
<Compile Include="IlMachineStateExecution.fs" />
|
||||
<Compile Include="NullaryIlOp.fs" />
|
||||
|
6
flake.lock
generated
6
flake.lock
generated
@@ -20,11 +20,11 @@
|
||||
},
|
||||
"nixpkgs": {
|
||||
"locked": {
|
||||
"lastModified": 1755736253,
|
||||
"narHash": "sha256-jlIQRypNhB1PcB1BE+expE4xZeJxzoAGr1iUbHQta8s=",
|
||||
"lastModified": 1756381814,
|
||||
"narHash": "sha256-tzo7YvAsGlzo4WiIHT0ooR59VHu+aKRQdHk7sIyoia4=",
|
||||
"owner": "NixOS",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "596312aae91421d6923f18cecce934a7d3bfd6b8",
|
||||
"rev": "aca2499b79170038df0dbaec8bf2f689b506ad32",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
|
Reference in New Issue
Block a user