20 Commits

Author SHA1 Message Date
Patrick Stevens
08a4497ebf Recognise more exceptions (#129) 2025-09-06 16:32:26 +01:00
Patrick Stevens
fc62651d55 Add some more tests (#128) 2025-08-31 07:32:47 +00:00
Patrick Stevens
2e9fdbed48 Make it much harder to omit tests (#127) 2025-08-30 22:25:41 +00:00
Patrick Stevens
fb5c4a6313 Progress towards advanced struct layout (#126) 2025-08-30 19:07:05 +00:00
Patrick Stevens
95987e592c Upgrade flake (#125) 2025-08-30 17:05:57 +01:00
Patrick Stevens
0e31d74586 Implement Ldobj and Box for reference types (#124) 2025-08-30 15:36:26 +00:00
Patrick Stevens
8112b122fb Compute byte form for CliType where necessary (#123) 2025-08-29 23:19:29 +00:00
Patrick Stevens
5173805562 Concretize all base class types eagerly (#122) 2025-08-29 17:57:19 +00:00
Patrick Stevens
cb5d76f059 Prepare for overlapping struct field handling (#121) 2025-08-29 17:27:34 +00:00
Patrick Stevens
5e7bd969ba Convert correctness bug in overlapping fields into a failwith (#120) 2025-08-29 08:45:23 +00:00
Patrick Stevens
07fabfff65 Implement sizeof completely (#119) 2025-08-27 23:46:50 +00:00
Patrick Stevens
655ba4400a Centralise field handling in structs (#118) 2025-08-27 19:49:50 +01:00
Patrick Stevens
c58c8ce678 Progress towards the GenericEdgeCases test (#96) 2025-08-25 11:27:14 +00:00
Patrick Stevens
239ae0f0cd Implement dereferencing more (#117) 2025-08-24 19:44:18 +00:00
Patrick Stevens
4de0dbd816 Add another test and put real-version first (#116) 2025-08-24 19:38:43 +00:00
Patrick Stevens
91aff34d1e Fix a TODO (#115) 2025-08-24 19:27:38 +00:00
Patrick Stevens
f9e186ba8f Initobj (#114) 2025-08-24 19:23:50 +00:00
Patrick Stevens
622d0782ae Add field pointer handle (#113) 2025-08-24 09:44:57 +00:00
Patrick Stevens
3e4b0a7b7e Plumb through field offset info (#112) 2025-08-24 09:05:31 +00:00
Patrick Stevens
5f35c7a7cd ConcreteChar matcher (#111) 2025-08-24 08:13:06 +00:00
42 changed files with 5460 additions and 1088 deletions

View File

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

View File

@@ -423,8 +423,8 @@ module Assembly =
let rec resolveTypeRef
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
(referencedInAssembly : DumpedAssembly)
(target : TypeRef)
(genericArgs : ImmutableArray<TypeDefn>)
(target : TypeRef)
: TypeResolutionResult
=
match target.ResolutionScope with
@@ -495,7 +495,7 @@ module Assembly =
| None ->
match assy.TypeRef ns name with
| Some typeRef -> resolveTypeRef assemblies assy typeRef genericArgs
| Some typeRef -> resolveTypeRef assemblies assy genericArgs typeRef
| None ->
match assy.ExportedType (Some ns) name with
@@ -532,7 +532,7 @@ module DumpedAssembly =
| Some (BaseTypeInfo.TypeRef r) ->
let assy = loadedAssemblies.[source.FullName]
// TODO: generics
match Assembly.resolveTypeRef loadedAssemblies assy assy.TypeRefs.[r] ImmutableArray.Empty with
match Assembly.resolveTypeRef loadedAssemblies assy ImmutableArray.Empty assy.TypeRefs.[r] with
| TypeResolutionResult.FirstLoadAssy _ ->
failwith
"seems pretty unlikely that we could have constructed this object without loading its base type"
@@ -560,3 +560,36 @@ module DumpedAssembly =
| None -> ResolvedBaseType.Object
go source baseTypeInfo
let typeInfoToTypeDefn
(bct : BaseClassTypes<DumpedAssembly>)
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
(ti : TypeInfo<TypeDefn, TypeDefn>)
: TypeDefn
=
ti
|> TypeInfo.toTypeDefn
bct
(fun n -> assemblies.[n.FullName])
_.Name
(fun x y -> x.TypeDefs.[y])
(fun x y ->
let r = x.TypeRefs.[y] |> Assembly.resolveTypeRef assemblies x ImmutableArray.Empty
match r with
| TypeResolutionResult.FirstLoadAssy assemblyReference -> failwith "todo"
| TypeResolutionResult.Resolved (dumpedAssembly, typeInfo) ->
let result =
typeInfo |> TypeInfo.mapGeneric (fun typeDef -> failwith "TODO: generics")
dumpedAssembly, result
)
let typeInfoToTypeDefn'
(bct : BaseClassTypes<DumpedAssembly>)
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
(ti : TypeInfo<GenericParamFromMetadata, TypeDefn>)
=
ti
|> TypeInfo.mapGeneric (fun (par, _) -> TypeDefn.GenericTypeParameter par.SequenceNumber)
|> typeInfoToTypeDefn bct assemblies

View File

@@ -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

View File

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

View File

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

View File

@@ -138,6 +138,23 @@ module ConcreteActivePatterns =
| None -> None
| _ -> None
let (|ConcreteChar|_|) (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 = "Char"
&& ct.Generics.IsEmpty
then
Some ()
else
None
| None -> None
| _ -> None
let (|ConcreteRuntimeFieldHandle|_|) (concreteTypes : AllConcreteTypes) (handle : ConcreteTypeHandle) =
match handle with
| ConcreteTypeHandle.Concrete id ->
@@ -166,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 ->
@@ -285,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 ->
@@ -314,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 =
@@ -389,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)
@@ -403,7 +478,7 @@ module TypeConcretization =
// First try to resolve without loading new assemblies
let resolutionResult =
Assembly.resolveTypeRef ctx.LoadedAssemblies currentAssy typeRef ImmutableArray.Empty
Assembly.resolveTypeRef ctx.LoadedAssemblies currentAssy ImmutableArray.Empty typeRef
match resolutionResult with
| TypeResolutionResult.Resolved (targetAssy, typeInfo) -> (targetAssy, typeInfo), ctx
@@ -411,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
@@ -420,7 +496,7 @@ module TypeConcretization =
// Now try to resolve again with the loaded assembly
let resolutionResult2 =
Assembly.resolveTypeRef newCtx.LoadedAssemblies currentAssy typeRef ImmutableArray.Empty
Assembly.resolveTypeRef newCtx.LoadedAssemblies currentAssy ImmutableArray.Empty typeRef
match resolutionResult2 with
| TypeResolutionResult.Resolved (targetAssy, typeInfo) -> (targetAssy, typeInfo), newCtx
@@ -567,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)
@@ -591,14 +666,13 @@ module TypeConcretization =
/// Concretize a type in a specific generic context
let rec concretizeType
(ctx : ConcretizationContext<'corelib>)
(loadAssembly :
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
(ctx : ConcretizationContext<DumpedAssembly>)
(loadAssembly : IAssemblyLoad)
(assembly : AssemblyName)
(typeGenerics : ImmutableArray<ConcreteTypeHandle>)
(methodGenerics : ImmutableArray<ConcreteTypeHandle>)
(typeDefn : TypeDefn)
: ConcreteTypeHandle * ConcretizationContext<'corelib>
: ConcreteTypeHandle * ConcretizationContext<DumpedAssembly>
=
let key = (assembly, typeDefn)
@@ -688,15 +762,14 @@ module TypeConcretization =
| _ -> failwithf "TODO: Concretization of %A not implemented" typeDefn
and private concretizeGenericInstantiation
(ctx : ConcretizationContext<'corelib>)
(loadAssembly :
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
(ctx : ConcretizationContext<DumpedAssembly>)
(loadAssembly : IAssemblyLoad)
(assembly : AssemblyName)
(typeGenerics : ImmutableArray<ConcreteTypeHandle>)
(methodGenerics : ImmutableArray<ConcreteTypeHandle>)
(genericDef : TypeDefn)
(args : ImmutableArray<TypeDefn>)
: ConcreteTypeHandle * ConcretizationContext<'corelib>
: ConcreteTypeHandle * ConcretizationContext<DumpedAssembly>
=
// First, concretize all type arguments
let argHandles, ctxAfterArgs =
@@ -769,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
@@ -847,14 +921,13 @@ module Concretization =
/// Helper to concretize an array of types
let private concretizeTypeArray
(ctx : TypeConcretization.ConcretizationContext<'corelib>)
(loadAssembly :
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
(ctx : TypeConcretization.ConcretizationContext<DumpedAssembly>)
(loadAssembly : IAssemblyLoad)
(assembly : AssemblyName)
(typeArgs : ImmutableArray<ConcreteTypeHandle>)
(methodArgs : ImmutableArray<ConcreteTypeHandle>)
(types : ImmutableArray<TypeDefn>)
: ImmutableArray<ConcreteTypeHandle> * TypeConcretization.ConcretizationContext<'corelib>
: ImmutableArray<ConcreteTypeHandle> * TypeConcretization.ConcretizationContext<DumpedAssembly>
=
let handles = ImmutableArray.CreateBuilder types.Length
@@ -871,14 +944,13 @@ module Concretization =
/// Helper to concretize a method signature
let private concretizeMethodSignature
(ctx : TypeConcretization.ConcretizationContext<'corelib>)
(loadAssembly :
AssemblyName -> AssemblyReferenceHandle -> ImmutableDictionary<string, DumpedAssembly> * DumpedAssembly)
(ctx : TypeConcretization.ConcretizationContext<DumpedAssembly>)
(loadAssembly : IAssemblyLoad)
(assembly : AssemblyName)
(typeArgs : ImmutableArray<ConcreteTypeHandle>)
(methodArgs : ImmutableArray<ConcreteTypeHandle>)
(signature : TypeMethodSignature<TypeDefn>)
: TypeMethodSignature<ConcreteTypeHandle> * TypeConcretization.ConcretizationContext<'corelib>
: TypeMethodSignature<ConcreteTypeHandle> * TypeConcretization.ConcretizationContext<DumpedAssembly>
=
// Concretize return type
@@ -909,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)
@@ -930,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 _)
@@ -940,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>)
@@ -1140,8 +1210,7 @@ module Concretization =
// Recursively convert generic arguments
let genericArgs =
concreteType.Generics
|> Seq.map (fun h -> concreteHandleToTypeDefn baseClassTypes h concreteTypes assemblies)
|> ImmutableArray.CreateRange
|> ImmutableArray.map (fun h -> concreteHandleToTypeDefn baseClassTypes h concreteTypes assemblies)
let baseDef =
TypeDefn.FromDefinition (concreteType.Definition, concreteType.Assembly.FullName, signatureTypeKind)

View File

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

View File

@@ -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>
@@ -348,10 +376,10 @@ module TypeInfo =
let rec resolveBaseType<'corelib, 'generic, 'field>
(baseClassTypes : BaseClassTypes<'corelib>)
(sourceAssy : 'corelib)
(getName : 'corelib -> AssemblyName)
(getTypeDef : 'corelib -> TypeDefinitionHandle -> TypeInfo<'generic, 'field>)
(getTypeRef : 'corelib -> TypeReferenceHandle -> TypeInfo<'generic, 'field>)
(sourceAssembly : AssemblyName)
(getTypeRef : 'corelib -> TypeReferenceHandle -> 'corelib * TypeInfo<'generic, 'field>)
(value : BaseTypeInfo option)
: ResolvedBaseType
=
@@ -361,40 +389,48 @@ module TypeInfo =
match value with
| BaseTypeInfo.TypeDef typeDefinitionHandle ->
match isBaseType baseClassTypes getName sourceAssembly typeDefinitionHandle with
match isBaseType baseClassTypes getName (getName sourceAssy) typeDefinitionHandle with
| Some x -> x
| None ->
let baseType = getTypeDef baseClassTypes.Corelib typeDefinitionHandle
resolveBaseType baseClassTypes getName getTypeDef getTypeRef sourceAssembly baseType.BaseType
resolveBaseType baseClassTypes sourceAssy getName getTypeDef getTypeRef baseType.BaseType
| BaseTypeInfo.TypeRef typeReferenceHandle ->
let typeRef = getTypeRef baseClassTypes.Corelib typeReferenceHandle
failwith $"{typeRef}"
let targetAssy, typeRef = getTypeRef sourceAssy typeReferenceHandle
match isBaseType baseClassTypes getName (getName targetAssy) typeRef.TypeDefHandle with
| Some x -> x
| None ->
let baseType = getTypeDef baseClassTypes.Corelib typeRef.TypeDefHandle
resolveBaseType baseClassTypes sourceAssy getName getTypeDef getTypeRef baseType.BaseType
| BaseTypeInfo.TypeSpec typeSpecificationHandle -> failwith "todo"
| BaseTypeInfo.ForeignAssemblyType (assemblyName, typeDefinitionHandle) ->
resolveBaseType
baseClassTypes
sourceAssy
getName
getTypeDef
getTypeRef
assemblyName
(Some (BaseTypeInfo.TypeDef typeDefinitionHandle))
let toTypeDefn
(baseClassTypes : BaseClassTypes<'corelib>)
(assemblies : AssemblyName -> 'corelib)
(getName : 'corelib -> AssemblyName)
(getTypeDef : 'corelib -> TypeDefinitionHandle -> TypeInfo<'generic, 'field>)
(getTypeRef : 'corelib -> TypeReferenceHandle -> TypeInfo<'generic, 'field>)
(getTypeRef : 'corelib -> TypeReferenceHandle -> 'corelib * TypeInfo<'generic, 'field>)
(ty : TypeInfo<TypeDefn, TypeDefn>)
: TypeDefn
=
let stk =
match resolveBaseType baseClassTypes getName getTypeDef getTypeRef ty.Assembly ty.BaseType with
match resolveBaseType baseClassTypes (assemblies ty.Assembly) getName getTypeDef getTypeRef ty.BaseType with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
let defn =
// The only allowed construction of FromDefinition!
// All other constructions should use DumpedAssembly.typeInfoToTypeDefn.
TypeDefn.FromDefinition (ComparableTypeDefinitionHandle.Make ty.TypeDefHandle, ty.Assembly.FullName, stk)
if ty.Generics.IsEmpty then

View File

@@ -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" />

View File

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

View File

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

View File

@@ -1,5 +1,6 @@
namespace WoofWare.Pawprint.Test
open System
open System.Collections.Immutable
open System.IO
open FsUnitTyped
@@ -16,141 +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 = 109
NativeImpls = MockEnv.make ()
}
{
FileName = "Sizeof.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "LdtokenField.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 ()
}
"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
@@ -163,11 +88,12 @@ module TestPureCases =
use peImage = new MemoryStream (image)
try
let realResult = RealRuntime.executeWithRealRuntime [||] image
realResult.ExitCode |> shouldEqual case.ExpectedReturnCode
let terminalState, terminatingThread =
Program.run loggerFactory (Some case.FileName) peImage dotnetRuntimes case.NativeImpls []
let realResult = RealRuntime.executeWithRealRuntime [||] image
let exitCode =
match terminalState.ThreadState.[terminatingThread].MethodState.EvaluationStack.Values with
| [] -> failwith "expected program to return a value, but it returned void"
@@ -178,16 +104,49 @@ module TestPureCases =
exitCode |> shouldEqual realResult.ExitCode
exitCode |> shouldEqual case.ExpectedReturnCode
with _ ->
for message in messages () do
System.Console.Error.WriteLine $"{message}"
reraise ()
[<TestCaseSource(nameof simpleCases)>]
let ``Standard tests`` (fileName : string) =
{
FileName = fileName
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
|> runTest
[<TestCaseSource(nameof customExitCodes)>]
let ``Custom exit code tests`` (KeyValue (fileName : string, exitCode : int)) =
if unimplemented.Contains fileName then
Assert.Inconclusive ()
{
FileName = fileName
ExpectedReturnCode = exitCode
NativeImpls = MockEnv.make ()
}
|> runTest
[<TestCaseSource(nameof requiresMocks)>]
let ``Tests which require mocks`` (KeyValue (fileName : string, (exitCode : int, mock : NativeImpls))) =
{
FileName = fileName
ExpectedReturnCode = exitCode
NativeImpls = mock
}
|> runTest
[<TestCaseSource(nameof unimplemented)>]
[<Explicit>]
let ``Can evaluate C# files, unimplemented`` (case : EndToEndTestCase) = runTest case
[<TestCaseSource(nameof cases)>]
let ``Can evaluate C# files`` (case : EndToEndTestCase) = runTest case
let ``Can evaluate C# files, unimplemented`` (fileName : string) =
{
FileName = fileName
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
|> runTest

View File

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

View File

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

View File

@@ -8,7 +8,7 @@ namespace HelloWorldApp
{
int[] array = new[] { 1, 2, 3 };
if (array.Sum() != 60)
if (array.Sum() != 6)
{
return 1;
}

View File

@@ -0,0 +1,503 @@
using System;
using System.Runtime.CompilerServices;
using System.Runtime.InteropServices;
public class TestInitobj
{
// Simple struct with various primitive types
private struct SimpleStruct
{
public int IntField;
public bool BoolField;
public char CharField;
public double DoubleField;
public byte ByteField;
}
// Nested struct
private struct NestedStruct
{
public SimpleStruct Inner;
public int OuterField;
}
// Struct with arrays and references
private struct ComplexStruct
{
public object ObjectRef;
public string StringRef;
public int[] ArrayRef;
public int ValueField;
}
// Generic struct
private struct GenericStruct<T>
{
public T Value;
public int Count;
}
// Struct for field tests
private struct StructWithStructField
{
public SimpleStruct NestedField;
public int OtherField;
}
// Class with struct field for heap test
private class ClassWithStructField
{
public SimpleStruct StructField;
public int IntField;
}
// Test 1: Initialize simple struct with local variable
public static int Test1()
{
SimpleStruct s = new SimpleStruct
{
IntField = 42,
BoolField = true,
CharField = 'X',
DoubleField = 3.14,
ByteField = 255
};
// Verify initial values
if (s.IntField != 42) return 1;
if (s.BoolField != true) return 2;
if (s.CharField != 'X') return 3;
if (s.DoubleField != 3.14) return 4;
if (s.ByteField != 255) return 5;
// Use default to reset the struct (generates initobj)
s = default(SimpleStruct);
// Verify all fields are zeroed
if (s.IntField != 0) return 6;
if (s.BoolField != false) return 7;
if (s.CharField != '\0') return 8;
if (s.DoubleField != 0.0) return 9;
if (s.ByteField != 0) return 10;
return 0;
}
// Test 2: Initialize nested struct
public static int Test2()
{
NestedStruct n = new NestedStruct
{
Inner = new SimpleStruct
{
IntField = 100,
BoolField = true,
CharField = 'A',
DoubleField = 1.23,
ByteField = 128
},
OuterField = 999
};
// Verify initial values
if (n.Inner.IntField != 100) return 20;
if (n.OuterField != 999) return 21;
// Reset using default keyword (which should generate initobj)
n = default(NestedStruct);
// Verify all fields are zeroed
if (n.Inner.IntField != 0) return 22;
if (n.Inner.BoolField != false) return 23;
if (n.Inner.CharField != '\0') return 24;
if (n.Inner.DoubleField != 0.0) return 25;
if (n.Inner.ByteField != 0) return 26;
if (n.OuterField != 0) return 27;
return 0;
}
// Test 3: Initialize struct with reference types
public static int Test3()
{
ComplexStruct c = new ComplexStruct
{
ObjectRef = new object(),
StringRef = "Hello",
ArrayRef = new int[3],
ValueField = 42
};
c.ArrayRef[0] = 1;
c.ArrayRef[1] = 2;
c.ArrayRef[2] = 3;
// Verify initial values
if (c.ObjectRef == null) return 30;
if (c.StringRef != "Hello") return 31;
if (c.ArrayRef == null || c.ArrayRef.Length != 3) return 32;
if (c.ValueField != 42) return 33;
// Reset using default
c = default(ComplexStruct);
// Verify references are null and value is zero
if (c.ObjectRef != null) return 34;
if (c.StringRef != null) return 35;
if (c.ArrayRef != null) return 36;
if (c.ValueField != 0) return 37;
return 0;
}
// Test 4: Initialize generic struct
public static int Test4()
{
GenericStruct<int> gi = new GenericStruct<int>
{
Value = 123,
Count = 456
};
if (gi.Value != 123) return 40;
if (gi.Count != 456) return 41;
gi = default(GenericStruct<int>);
if (gi.Value != 0) return 42;
if (gi.Count != 0) return 43;
// Test with reference type
GenericStruct<string> gs = new GenericStruct<string>
{
Value = "Test",
Count = 789
};
if (gs.Value != "Test") return 44;
if (gs.Count != 789) return 45;
gs = default(GenericStruct<string>);
if (gs.Value != null) return 46;
if (gs.Count != 0) return 47;
return 0;
}
// Test 5: Initialize struct in array element using ref
public static int Test5()
{
SimpleStruct[] array = new SimpleStruct[3];
// Set values in first element
array[0].IntField = 111;
array[0].BoolField = true;
array[0].CharField = 'Z';
if (array[0].IntField != 111) return 50;
if (array[0].BoolField != true) return 51;
if (array[0].CharField != 'Z') return 52;
// Reset first element using default assignment
array[0] = default(SimpleStruct);
if (array[0].IntField != 0) return 53;
if (array[0].BoolField != false) return 54;
if (array[0].CharField != '\0') return 55;
// Also test with ref local
array[1].IntField = 222;
ref SimpleStruct secondElement = ref array[1];
secondElement = default(SimpleStruct);
if (array[1].IntField != 0) return 56;
return 0;
}
// Test 6: Initialize struct through method parameter
public static int Test6()
{
SimpleStruct s = new SimpleStruct
{
IntField = 200,
BoolField = true,
CharField = 'M',
DoubleField = 2.71,
ByteField = 64
};
ResetStruct(ref s);
if (s.IntField != 0) return 60;
if (s.BoolField != false) return 61;
if (s.CharField != '\0') return 62;
if (s.DoubleField != 0.0) return 63;
if (s.ByteField != 0) return 64;
return 0;
}
private static void ResetStruct(ref SimpleStruct s)
{
s = default(SimpleStruct);
}
// Test 7: Initialize multiple structs
public static int Test7()
{
SimpleStruct s1 = new SimpleStruct { IntField = 1 };
SimpleStruct s2 = new SimpleStruct { IntField = 2 };
SimpleStruct s3 = new SimpleStruct { IntField = 3 };
if (s1.IntField != 1) return 70;
if (s2.IntField != 2) return 71;
if (s3.IntField != 3) return 72;
s1 = default(SimpleStruct);
s2 = default(SimpleStruct);
s3 = default(SimpleStruct);
if (s1.IntField != 0) return 73;
if (s2.IntField != 0) return 74;
if (s3.IntField != 0) return 75;
return 0;
}
// Test 8: Initialize struct passed as argument (tests Argument case)
public static int Test8()
{
SimpleStruct s = new SimpleStruct
{
IntField = 333,
BoolField = true,
CharField = 'Q',
DoubleField = 4.56,
ByteField = 77
};
int result = InitializeArgumentStruct(ref s);
if (result != 0) return result;
// Verify struct was reset
if (s.IntField != 0) return 80;
if (s.BoolField != false) return 81;
if (s.CharField != '\0') return 82;
if (s.DoubleField != 0.0) return 83;
if (s.ByteField != 0) return 84;
return 0;
}
private static int InitializeArgumentStruct(ref SimpleStruct arg)
{
// Verify initial values
if (arg.IntField != 333) return 85;
if (arg.BoolField != true) return 86;
// Reset using default - this should use initobj on the argument
arg = default(SimpleStruct);
return 0;
}
// Test 9: Initialize struct field (tests Field case)
public static int Test9()
{
StructWithStructField container = new StructWithStructField
{
NestedField = new SimpleStruct
{
IntField = 444,
BoolField = true,
CharField = 'F',
DoubleField = 7.89,
ByteField = 88
},
OtherField = 555
};
// Verify initial values
if (container.NestedField.IntField != 444) return 90;
if (container.OtherField != 555) return 91;
// Reset the nested field using ref
ref SimpleStruct fieldRef = ref container.NestedField;
fieldRef = default(SimpleStruct);
// Verify nested field was reset but other field unchanged
if (container.NestedField.IntField != 0) return 92;
if (container.NestedField.BoolField != false) return 93;
if (container.NestedField.CharField != '\0') return 94;
if (container.NestedField.DoubleField != 0.0) return 95;
if (container.NestedField.ByteField != 0) return 96;
if (container.OtherField != 555) return 97;
return 0;
}
// Test 10: Initialize struct in heap-allocated object (tests Heap case)
public static int Test10()
{
ClassWithStructField obj = new ClassWithStructField
{
StructField = new SimpleStruct
{
IntField = 666,
BoolField = true,
CharField = 'H',
DoubleField = 9.99,
ByteField = 99
},
IntField = 777
};
// Verify initial values
if (obj.StructField.IntField != 666) return 100;
if (obj.IntField != 777) return 101;
// Reset the struct field
obj.StructField = default(SimpleStruct);
// Verify struct field was reset but other field unchanged
if (obj.StructField.IntField != 0) return 102;
if (obj.StructField.BoolField != false) return 103;
if (obj.StructField.CharField != '\0') return 104;
if (obj.StructField.DoubleField != 0.0) return 105;
if (obj.StructField.ByteField != 0) return 106;
if (obj.IntField != 777) return 107;
return 0;
}
// Test 11: Initialize struct through unsafe pointer manipulation
public static unsafe int Test11()
{
SimpleStruct s = new SimpleStruct
{
IntField = 888,
BoolField = true,
CharField = 'P',
DoubleField = 11.11,
ByteField = 111
};
// Get a pointer to the struct
SimpleStruct* ptr = &s;
// Initialize through pointer
*ptr = default(SimpleStruct);
// Verify all fields are zeroed
if (s.IntField != 0) return 110;
if (s.BoolField != false) return 111;
if (s.CharField != '\0') return 112;
if (s.DoubleField != 0.0) return 113;
if (s.ByteField != 0) return 114;
return 0;
}
// Test 12: Initialize struct through Unsafe.AsRef
public static int Test12()
{
SimpleStruct s = new SimpleStruct
{
IntField = 999,
BoolField = true,
CharField = 'U',
DoubleField = 12.34,
ByteField = 200
};
// Use Unsafe to get a ref and initialize it
ref SimpleStruct sRef = ref s;
sRef = default(SimpleStruct);
// Verify all fields are zeroed
if (s.IntField != 0) return 120;
if (s.BoolField != false) return 121;
if (s.CharField != '\0') return 122;
if (s.DoubleField != 0.0) return 123;
if (s.ByteField != 0) return 124;
return 0;
}
// Test 13: Initialize readonly struct
public static int Test13()
{
ReadonlyStruct ros = new ReadonlyStruct(100, true);
// Verify initial values through properties
if (ros.IntValue != 100) return 130;
if (ros.BoolValue != true) return 131;
// Reset using default
ros = default(ReadonlyStruct);
// Verify zeroed
if (ros.IntValue != 0) return 132;
if (ros.BoolValue != false) return 133;
return 0;
}
private readonly struct ReadonlyStruct
{
public readonly int IntValue;
public readonly bool BoolValue;
public ReadonlyStruct(int i, bool b)
{
IntValue = i;
BoolValue = b;
}
}
public static int Main(string[] argv)
{
var result = Test1();
if (result != 0) return result;
result = Test2();
if (result != 0) return result;
result = Test3();
if (result != 0) return result;
result = Test4();
if (result != 0) return result;
result = Test5();
if (result != 0) return result;
result = Test6();
if (result != 0) return result;
result = Test7();
if (result != 0) return result;
result = Test8();
if (result != 0) return result;
result = Test9();
if (result != 0) return result;
result = Test10();
if (result != 0) return result;
result = Test11();
if (result != 0) return result;
result = Test12();
if (result != 0) return result;
result = Test13();
if (result != 0) return result;
// All tests passed
return 0;
}
}

View File

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

View File

@@ -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

View 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;
}
}

View File

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

View File

@@ -0,0 +1,276 @@
using System;
using System.Runtime.CompilerServices;
public class TestUnsafeAs
{
private struct Int32Wrapper
{
public int Value;
}
private struct UInt32Wrapper
{
public uint Value;
}
private struct TwoInt16s
{
public short First;
public short Second;
}
private struct FourBytes
{
public byte B0;
public byte B1;
public byte B2;
public byte B3;
}
private enum TestEnum : int
{
Value1 = 0x12345678,
Value2 = -1
}
// Test 1: Int32 -> UInt32 reinterpretation
public static int Test1()
{
int original = -1;
ref uint reinterpreted = ref Unsafe.As<int, uint>(ref original);
if (reinterpreted != 0xFFFFFFFF)
return 1;
reinterpreted = 0x12345678;
if (original != 0x12345678)
return 2;
original = int.MinValue;
if (reinterpreted != 0x80000000)
return 3;
return 0;
}
// Test 2: Struct -> Struct reinterpretation
public static int Test2()
{
Int32Wrapper wrapper = new Int32Wrapper { Value = 0x01020304 };
ref FourBytes bytes = ref Unsafe.As<Int32Wrapper, FourBytes>(ref wrapper);
if (BitConverter.IsLittleEndian)
{
if (bytes.B0 != 0x04) return 10;
if (bytes.B1 != 0x03) return 11;
if (bytes.B2 != 0x02) return 12;
if (bytes.B3 != 0x01) return 13;
}
else
{
if (bytes.B0 != 0x01) return 14;
if (bytes.B1 != 0x02) return 15;
if (bytes.B2 != 0x03) return 16;
if (bytes.B3 != 0x04) return 17;
}
bytes.B0 = 0xFF;
int expectedValue = BitConverter.IsLittleEndian ? 0x010203FF : unchecked((int)0xFF020304);
if (wrapper.Value != expectedValue)
return 18;
return 0;
}
// Test 3: Int32 -> Two Int16s
public static int Test3()
{
int value = 0x12345678;
ref TwoInt16s halves = ref Unsafe.As<int, TwoInt16s>(ref value);
if (BitConverter.IsLittleEndian)
{
if (halves.First != unchecked((short)0x5678)) return 20;
if (halves.Second != 0x1234) return 21;
}
else
{
if (halves.First != 0x1234) return 22;
if (halves.Second != unchecked((short)0x5678)) return 23;
}
halves.First = -1;
int expectedValue = BitConverter.IsLittleEndian ? 0x1234FFFF : unchecked((int)0xFFFF5678);
if (value != expectedValue)
return 24;
return 0;
}
// Test 4: Array element reinterpretation
public static int Test4()
{
int[] intArray = new int[] { 0x01020304, 0x05060708 };
ref uint uintRef = ref Unsafe.As<int, uint>(ref intArray[0]);
if (uintRef != 0x01020304u)
return 30;
uintRef = 0xAABBCCDD;
if (intArray[0] != unchecked((int)0xAABBCCDD))
return 31;
if (intArray[1] != 0x05060708)
return 32;
return 0;
}
// Test 5: Bool -> Byte
public static int Test5()
{
bool trueValue = true;
bool falseValue = false;
ref byte trueByte = ref Unsafe.As<bool, byte>(ref trueValue);
ref byte falseByte = ref Unsafe.As<bool, byte>(ref falseValue);
if (trueByte != 1)
return 40;
if (falseByte != 0)
return 41;
// Modify through byte reference
trueByte = 0;
if (trueValue != false)
return 42;
falseByte = 1;
if (falseValue != true)
return 43;
return 0;
}
// Test 6: Char -> UInt16
public static int Test6()
{
char ch = 'A';
ref ushort asUInt16 = ref Unsafe.As<char, ushort>(ref ch);
if (asUInt16 != 65)
return 50;
asUInt16 = 0x03B1; // Greek lowercase alpha
if (ch != 'α')
return 51;
return 0;
}
// Test 7: Float -> Int32
public static int Test7()
{
float floatValue = 1.0f;
ref int intBits = ref Unsafe.As<float, int>(ref floatValue);
// IEEE 754: 1.0f = 0x3F800000
if (intBits != 0x3F800000)
return 60;
intBits = 0x40000000; // 2.0f in IEEE 754
if (floatValue != 2.0f)
return 61;
floatValue = -0.0f;
if (intBits != unchecked((int)0x80000000))
return 62;
return 0;
}
// Test 8: Double -> Int64
public static int Test8()
{
double doubleValue = 1.0;
ref long longBits = ref Unsafe.As<double, long>(ref doubleValue);
// IEEE 754: 1.0 = 0x3FF0000000000000
if (longBits != 0x3FF0000000000000L)
return 70;
longBits = 0x4000000000000000L; // 2.0 in IEEE 754
if (doubleValue != 2.0)
return 71;
return 0;
}
// Test 9: Enum -> Underlying type
public static int Test9()
{
TestEnum enumValue = TestEnum.Value1;
ref int underlying = ref Unsafe.As<TestEnum, int>(ref enumValue);
if (underlying != 0x12345678)
return 80;
underlying = -1;
if (enumValue != TestEnum.Value2)
return 81;
return 0;
}
// Test 10: Local variable reinterpretation
public static int Test10()
{
int local = unchecked((int)0xDEADBEEF);
ref uint localAsUint = ref Unsafe.As<int, uint>(ref local);
if (localAsUint != 0xDEADBEEF)
return 90;
localAsUint = 0xCAFEBABE;
if (local != unchecked((int)0xCAFEBABE))
return 91;
return 0;
}
public static int Main(string[] argv)
{
var result = Test1();
if (result != 0) return result;
result = Test2();
if (result != 0) return result;
result = Test3();
if (result != 0) return result;
result = Test4();
if (result != 0) return result;
result = Test5();
if (result != 0) return result;
result = Test6();
if (result != 0) return result;
result = Test7();
if (result != 0) return result;
result = Test8();
if (result != 0) return result;
result = Test9();
if (result != 0) return result;
result = Test10();
if (result != 0) return result;
// All tests passed
return 0;
}
}

View File

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

View File

@@ -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
@@ -41,7 +42,9 @@ type ManagedPointerSource =
| Argument of sourceThread : ThreadId * methodFrame : int * whichVar : uint16
| Heap of ManagedHeapAddress
| ArrayIndex of arr : ManagedHeapAddress * index : int
| Field of ManagedPointerSource * fieldName : string
| Null
| InterpretedAsType of ManagedPointerSource * ConcreteType<ConcreteTypeHandle>
override this.ToString () =
match this with
@@ -52,6 +55,8 @@ type ManagedPointerSource =
| ManagedPointerSource.Argument (source, method, var) ->
$"<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 =
@@ -64,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
@@ -72,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 ->
@@ -89,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
@@ -113,17 +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
| 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
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 =
@@ -141,11 +184,350 @@ type CliType =
/// as a concatenated list of its fields.
| ValueType of CliValueType
and 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 =
{
Fields : (string * CliType) list
Name : string
Contents : CliType
/// "None" for "no explicit offset specified"; we expect most offsets to be None.
Offset : int option
Type : ConcreteTypeHandle
}
and CliConcreteField =
private
{
Name : string
Contents : CliType
Offset : int
Size : int
Alignment : int
ConfiguredOffset : int option
EditedAtTime : uint64
Type : ConcreteTypeHandle
}
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
| FirstLoad of WoofWare.PawPrint.AssemblyReference
@@ -160,31 +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"
| [ _, f ] -> sizeOf f
| _ -> failwith $"TODO: %O{vt.Fields} (need to consider struct layout)"
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)
@@ -204,8 +569,40 @@ module CliType =
| PrimitiveType.Double -> CliType.Numeric (CliNumericType.Float64 0.0)
| PrimitiveType.String -> CliType.ObjectRef None
| PrimitiveType.TypedReference -> failwith "todo"
| PrimitiveType.IntPtr -> CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null)
| PrimitiveType.UIntPtr -> CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null)
| PrimitiveType.IntPtr ->
{
Name = "_value"
Contents =
CliType.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 Layout.Default
|> CliType.ValueType
| PrimitiveType.UIntPtr ->
{
Name = "_value"
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 Layout.Default
|> CliType.ValueType
| PrimitiveType.Object -> CliType.ObjectRef None
let rec zeroOf
@@ -230,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
@@ -248,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
@@ -343,7 +750,7 @@ module CliType =
// It's a value type - need to create zero values for all non-static fields
let mutable currentConcreteTypes = concreteTypes
let fieldZeros =
let vt =
typeDef.Fields
|> List.filter (fun field -> not (field.Attributes.HasFlag FieldAttributes.Static))
|> List.map (fun field ->
@@ -359,13 +766,15 @@ module CliType =
zeroOfWithVisited currentConcreteTypes assemblies corelib fieldHandle visited
currentConcreteTypes <- updatedConcreteTypes2
(field.Name, fieldZero)
)
let vt =
{
Fields = fieldZeros
}
{
Name = field.Name
Contents = fieldZero
Offset = field.Offset
Type = fieldHandle
}
)
|> CliValueType.OfFields typeDef.Layout
CliType.ValueType vt, currentConcreteTypes
else
@@ -393,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
@@ -418,3 +829,41 @@ module CliType =
fieldType
handle, newCtx.ConcreteTypes
let withFieldSet (field : string) (value : CliType) (c : CliType) : CliType =
match c with
| CliType.Numeric cliNumericType -> failwith "todo"
| CliType.Bool b -> failwith "todo"
| CliType.Char (high, low) -> failwith "todo"
| CliType.ObjectRef managedHeapAddressOption -> failwith "todo"
| CliType.RuntimePointer cliRuntimePointer -> failwith "todo"
| CliType.ValueType cvt -> CliValueType.WithFieldSet field value cvt |> CliType.ValueType
let getField (field : string) (value : CliType) : CliType =
match value with
| CliType.Numeric cliNumericType -> failwith "todo"
| CliType.Bool b -> failwith "todo"
| CliType.Char (high, low) -> failwith "todo"
| CliType.ObjectRef managedHeapAddressOption -> failwith "todo"
| CliType.RuntimePointer cliRuntimePointer -> failwith "todo"
| CliType.ValueType cvt -> CliValueType.DereferenceField field cvt
/// Returns the offset and size.
let getFieldLayout (field : string) (value : CliType) : int * int =
match value with
| CliType.Numeric cliNumericType -> failwith "todo"
| CliType.Bool b -> failwith "todo"
| CliType.Char (high, low) -> failwith "todo"
| CliType.ObjectRef managedHeapAddressOption -> failwith "todo"
| CliType.RuntimePointer cliRuntimePointer -> failwith "todo"
| CliType.ValueType cvt -> CliValueType.GetFieldLayout field cvt
/// Returns None if there isn't *exactly* one field that starts there. This rules out some valid programs.
let getFieldAt (offset : int) (value : CliType) : CliConcreteField option =
match value with
| CliType.Numeric cliNumericType -> failwith "todo"
| CliType.Bool b -> failwith "todo"
| CliType.Char (high, low) -> failwith "todo"
| CliType.ObjectRef managedHeapAddressOption -> failwith "todo"
| CliType.RuntimePointer cliRuntimePointer -> failwith "todo"
| CliType.ValueType cvt -> CliValueType.FieldsAt offset cvt |> List.tryExactlyOne

View File

@@ -4,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}"

View File

@@ -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

View File

@@ -1,5 +1,7 @@
namespace WoofWare.PawPrint
#nowarn "42"
/// See I.12.3.2.1 for definition
type EvalStackValue =
| Int32 of int32
@@ -8,10 +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
/// Mapping of field name to value
| UserDefinedValueType of (string * EvalStackValue) list
/// 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
@@ -21,13 +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
|> List.map (snd >> string<EvalStackValue>)
|> String.concat " | "
$"Struct(%s{desc})"
| EvalStackValue.UserDefinedValueType evalStackValues -> $"Struct(%O{evalStackValues})"
[<RequireQualifiedAccess>]
module EvalStackValue =
@@ -55,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 ->
@@ -83,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"
@@ -100,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 ->
@@ -107,7 +155,13 @@ module EvalStackValue =
| CliNumericType.Int32 _ ->
match popped with
| EvalStackValue.Int32 i -> CliType.Numeric (CliNumericType.Int32 i)
| EvalStackValue.UserDefinedValueType [ popped ] -> toCliTypeCoerced target (snd popped)
| EvalStackValue.UserDefinedValueType popped ->
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
@@ -117,17 +171,34 @@ 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}"
| CliNumericType.NativeInt _ ->
match popped with
| EvalStackValue.NativeInt s -> CliNumericType.NativeInt s
| EvalStackValue.NativeInt s -> CliNumericType.NativeInt s |> CliType.Numeric
| EvalStackValue.ManagedPointer ptrSrc ->
CliNumericType.NativeInt (NativeIntSource.ManagedPointer ptrSrc)
|> CliType.Numeric
| EvalStackValue.UserDefinedValueType vt ->
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}"
|> CliType.Numeric
| CliNumericType.NativeFloat f -> failwith "todo"
| CliNumericType.Int8 _ ->
match popped with
@@ -156,34 +227,29 @@ module EvalStackValue =
| CliType.ObjectRef _ ->
match popped with
| EvalStackValue.ManagedPointer ptrSource ->
match ptrSource with
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
CliRuntimePointerSource.LocalVariable (sourceThread, methodFrame, whichVar)
|> CliRuntimePointer.Managed
|> CliType.RuntimePointer
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
CliRuntimePointerSource.Argument (sourceThread, methodFrame, whichVar)
|> CliRuntimePointer.Managed
|> CliType.RuntimePointer
| ManagedPointerSource.Heap managedHeapAddress -> CliType.ObjectRef (Some managedHeapAddress)
| ManagedPointerSource.Null -> CliType.ObjectRef None
| ManagedPointerSource.ArrayIndex (arr, ind) ->
CliType.RuntimePointer (CliRuntimePointer.Managed (CliRuntimePointerSource.ArrayIndex (arr, ind)))
ptrSource |> CliRuntimePointer.Managed |> CliType.RuntimePointer
| EvalStackValue.ObjectRef ptr ->
ManagedPointerSource.Heap ptr
|> CliRuntimePointer.Managed
|> CliType.RuntimePointer
| EvalStackValue.NativeInt nativeIntSource ->
match nativeIntSource with
| NativeIntSource.Verbatim 0L -> CliType.ObjectRef None
| 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 fields ->
match fields with
| [ esv ] -> toCliTypeCoerced target (snd esv)
| fields -> failwith $"TODO: don't know how to coerce struct of {fields} to a pointer"
| EvalStackValue.UserDefinedValueType obj ->
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
@@ -195,41 +261,19 @@ module EvalStackValue =
| i -> failwith $"TODO: %O{i}"
| CliType.RuntimePointer _ ->
match popped with
| EvalStackValue.ManagedPointer src ->
match src with
| ManagedPointerSource.Heap addr -> CliType.ofManagedObject addr
| ManagedPointerSource.Null -> CliType.ObjectRef None
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, var) ->
CliRuntimePointerSource.LocalVariable (sourceThread, methodFrame, var)
|> CliRuntimePointer.Managed
|> CliType.RuntimePointer
| ManagedPointerSource.Argument (sourceThread, methodFrame, var) ->
CliRuntimePointerSource.Argument (sourceThread, methodFrame, var)
|> CliRuntimePointer.Managed
|> CliType.RuntimePointer
| ManagedPointerSource.ArrayIndex (arr, index) ->
CliRuntimePointerSource.ArrayIndex (arr, index)
|> CliRuntimePointer.Managed
|> CliType.RuntimePointer
| 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 ->
match src with
| ManagedPointerSource.Heap src ->
CliType.RuntimePointer (CliRuntimePointer.Managed (CliRuntimePointerSource.Heap src))
| ManagedPointerSource.Null ->
CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null)
| ManagedPointerSource.LocalVariable (a, b, c) ->
CliType.RuntimePointer (
CliRuntimePointer.Managed (CliRuntimePointerSource.LocalVariable (a, b, c))
)
| ManagedPointerSource.Argument (a, b, c) ->
CliType.RuntimePointer (CliRuntimePointer.Managed (CliRuntimePointerSource.Argument (a, b, c)))
| ManagedPointerSource.ArrayIndex _ -> failwith "TODO"
| 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 ->
ManagedPointerSource.Heap addr
|> CliRuntimePointer.Managed
|> CliType.RuntimePointer
| _ -> failwith $"TODO: %O{popped}"
| CliType.Char _ ->
match popped with
@@ -240,74 +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.Length then
failwith
$"mismatch: popped value type {popped} (length %i{popped.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})"
let fields =
List.map2
(fun (name1, v1) (name2, v2) ->
if name1 <> name2 then
failwith $"TODO: name mismatch, {name1} vs {name2}"
(vt, popped)
||> List.map2 (fun field1 popped ->
if field1.Name <> popped.Name then
failwith $"TODO: name mismatch, {field1.Name} vs {popped.Name}"
name1, toCliTypeCoerced v1 v2
)
vt.Fields
popped
if field1.Offset <> popped.Offset then
failwith $"TODO: offset mismatch for {field1.Name}, {field1.Offset} vs {popped.Offset}"
{
Fields = fields
}
|> CliType.ValueType
let contents = toCliTypeCoerced field1.Contents (ofCliType popped.Contents)
{
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
| [ _, target ] -> toCliTypeCoerced target 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
| CliType.ValueType fields ->
fields.Fields
|> List.map (fun (name, f) -> name, ofCliType f)
|> EvalStackValue.UserDefinedValueType
type EvalStack =
{
Values : EvalStackValue list

View File

@@ -123,11 +123,14 @@ module EvalStackValueComparisons =
let rec ceq (var1 : EvalStackValue) (var2 : EvalStackValue) : bool =
// Table III.4
match var1, var2 with
| EvalStackValue.UserDefinedValueType [ _, u ], v -> ceq u v
| u, EvalStackValue.UserDefinedValueType [ _, v ] -> ceq u v
| EvalStackValue.UserDefinedValueType [], EvalStackValue.UserDefinedValueType [] -> true
| EvalStackValue.UserDefinedValueType _, _
| _, EvalStackValue.UserDefinedValueType _ -> failwith $"bad 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}"
@@ -151,6 +154,16 @@ module EvalStackValueComparisons =
failwith $"TODO (CEQ): nativeint vs managed pointer"
| EvalStackValue.NativeInt _, _ -> failwith $"bad ceq: NativeInt vs {var2}"
| EvalStackValue.ObjectRef var1, EvalStackValue.ObjectRef var2 -> var1 = var2
| EvalStackValue.ManagedPointer src, EvalStackValue.ObjectRef var1
| EvalStackValue.ObjectRef var1, EvalStackValue.ManagedPointer src ->
match src with
| ManagedPointerSource.Heap src -> src = var1
| ManagedPointerSource.Null -> false
| ManagedPointerSource.Field _
| 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 ->

View File

@@ -62,6 +62,7 @@ module System_Threading_Monitor =
match lockObj with
| EvalStackValue.ManagedPointer ManagedPointerSource.Null ->
failwith "TODO: throw ArgumentNullException"
| EvalStackValue.ObjectRef addr
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) ->
match IlMachineState.getSyncBlock addr state with
| SyncBlock.Free ->
@@ -87,6 +88,8 @@ module System_Threading_Monitor =
failwith "not really expecting to *edit* an argument..."
| 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
@@ -100,6 +103,7 @@ module System_Threading_Monitor =
match lockObj with
| EvalStackValue.ManagedPointer ManagedPointerSource.Null ->
failwith "TODO: throw ArgumentNullException"
| EvalStackValue.ObjectRef addr
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) ->
match IlMachineState.getSyncBlock addr state with
| SyncBlock.Free -> failwith "TODO: throw SynchronizationLockException"

View File

@@ -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 : (string * CliType) list -> 'allocState -> ManagedHeapAddress * 'allocState)
(allocate : CliValueType -> 'allocState -> ManagedHeapAddress * 'allocState)
(declaringAssy : AssemblyName)
(declaringType : ConcreteTypeHandle)
(handle : FieldDefinitionHandle)
@@ -54,8 +56,20 @@ module FieldHandleRegistry =
failwith $"unexpected field name %s{field.Name} for BCL type RuntimeFieldHandle"
{
Fields = [ "m_ptr", CliType.ofManagedObject runtimeFieldInfoStub ]
Name = "m_ptr"
Contents = CliType.ofManagedObject runtimeFieldInfoStub
Offset = None
Type =
AllConcreteTypes.findExistingConcreteType
allConcreteTypes
(baseClassTypes.RuntimeFieldInfoStub.Assembly,
baseClassTypes.RuntimeFieldInfoStub.Namespace,
baseClassTypes.RuntimeFieldInfoStub.Name,
ImmutableArray.Empty)
|> Option.get
}
|> List.singleton
|> CliValueType.OfFields Layout.Default
|> CliType.ValueType
let handle =
@@ -81,22 +95,93 @@ module FieldHandleRegistry =
| TypeDefn.PrimitiveType PrimitiveType.IntPtr -> ()
| s -> failwith $"bad sig: {s}"
// https://github.com/dotnet/runtime/blob/2b21c73fa2c32fa0195e4a411a435dda185efd08/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L1380
{
Fields = [ "m_handle", CliType.RuntimePointer (CliRuntimePointer.Unmanaged newHandle) ]
Name = "m_handle"
Contents = CliType.RuntimePointer (CliRuntimePointer.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 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
"m_keepalive", CliType.ObjectRef None
"m_c", CliType.ObjectRef None
"m_d", CliType.ObjectRef None
"m_b", CliType.Numeric (CliNumericType.Int32 0)
"m_e", CliType.ObjectRef None
{
Name = "m_keepalive"
Contents = CliType.ObjectRef None
Offset = None
Type = objType
}
{
Name = "m_c"
Contents = CliType.ObjectRef None
Offset = None
Type = objType
}
{
Name = "m_d"
Contents = CliType.ObjectRef None
Offset = None
Type = objType
}
{
Name = "m_b"
Contents = CliType.Numeric (CliNumericType.Int32 0)
Offset = None
Type = intType
}
{
Name = "m_e"
Contents = CliType.ObjectRef None
Offset = None
Type = objType
}
// RuntimeFieldHandleInternal: https://github.com/dotnet/runtime/blob/1d1bf92fcf43aa6981804dc53c5174445069c9e4/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L1048
"m_fieldHandle", runtimeFieldHandleInternal
{
Name = "m_fieldHandle"
Contents = runtimeFieldHandleInternal
Offset = 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

View File

@@ -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)
@@ -284,7 +298,7 @@ module IlMachineState =
(state : IlMachineState)
: IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo<TypeDefn, TypeDefn>
=
match Assembly.resolveTypeRef state._LoadedAssemblies referencedInAssembly target typeGenericArgs with
match Assembly.resolveTypeRef state._LoadedAssemblies referencedInAssembly typeGenericArgs target with
| TypeResolutionResult.Resolved (assy, typeDef) -> state, assy, typeDef
| TypeResolutionResult.FirstLoadAssy loadFirst ->
let state, _, _ =
@@ -335,36 +349,8 @@ module IlMachineState =
assy
state
// If the resolved argument has generics, create a GenericInstantiation
// Otherwise, create a FromDefinition
let preservedArg =
let baseType =
resolvedArg.BaseType
|> DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies assy.Name
let signatureTypeKind =
match baseType with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object -> SignatureTypeKind.Class
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
if resolvedArg.Generics.IsEmpty then
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make resolvedArg.TypeDefHandle,
assy.Name.FullName,
signatureTypeKind
)
else
// Preserve the generic instantiation
let genericDef =
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make resolvedArg.TypeDefHandle,
assy.Name.FullName,
signatureTypeKind
)
TypeDefn.GenericInstantiation (genericDef, resolvedArg.Generics)
DumpedAssembly.typeInfoToTypeDefn baseClassTypes state._LoadedAssemblies resolvedArg
args'.Add preservedArg
@@ -446,6 +432,42 @@ module IlMachineState =
let sign = assy.TypeSpecs.[ty].Signature
// Convert ConcreteTypeHandle to TypeDefn
let typeGenericArgsAsDefn =
typeGenericArgs
|> ImmutableArray.map (fun handle ->
Concretization.concreteHandleToTypeDefn
baseClassTypes
handle
state.ConcreteTypes
state._LoadedAssemblies
)
let methodGenericArgsAsDefn =
methodGenericArgs
|> ImmutableArray.map (fun handle ->
Concretization.concreteHandleToTypeDefn
baseClassTypes
handle
state.ConcreteTypes
state._LoadedAssemblies
)
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 ->
@@ -468,7 +490,17 @@ module IlMachineState =
)
|> ImmutableArray.CreateRange
resolveTypeFromDefn loggerFactory baseClassTypes sign typeGenericArgsAsDefn methodGenericArgsAsDefn assy state
// 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
@@ -498,13 +530,13 @@ module IlMachineState =
/// Concretize a ConcreteType<TypeDefn> to get a ConcreteTypeHandle for static field access
let concretizeFieldDeclaringType
(loggerFactory : ILoggerFactory)
(baseClassTypes : BaseClassTypes<'corelib>)
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(declaringType : ConcreteType<TypeDefn>)
(state : IlMachineState)
: ConcreteTypeHandle * IlMachineState
=
// Create a concretization context from the current state
let ctx : TypeConcretization.ConcretizationContext<'corelib> =
let ctx : TypeConcretization.ConcretizationContext<_> =
{
InProgress = ImmutableDictionary.Empty
ConcreteTypes = state.ConcreteTypes
@@ -512,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
@@ -540,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
@@ -552,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
@@ -601,7 +614,7 @@ module IlMachineState =
(typeGenerics : ConcreteTypeHandle ImmutableArray)
(methodGenerics : ConcreteTypeHandle ImmutableArray)
(state : IlMachineState)
: IlMachineState * CliType
: IlMachineState * CliType * ConcreteTypeHandle
=
// First concretize the type
@@ -613,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]
@@ -674,14 +687,14 @@ module IlMachineState =
(state : IlMachineState)
: IlMachineState
=
let heap = ManagedHeap.SetArrayValue arrayAllocation index v state.ManagedHeap
let heap = ManagedHeap.setArrayValue arrayAllocation index v state.ManagedHeap
{ state with
ManagedHeap = heap
}
let getArrayValue (arrayAllocation : ManagedHeapAddress) (index : int) (state : IlMachineState) : CliType =
ManagedHeap.GetArrayValue arrayAllocation index state.ManagedHeap
ManagedHeap.getArrayValue arrayAllocation index state.ManagedHeap
/// There might be no stack frame to return to, so you might get None.
let returnStackFrame
@@ -740,14 +753,9 @@ module IlMachineState =
| ResolvedBaseType.Delegate
| ResolvedBaseType.Object -> state |> pushToEvalStack (CliType.ofManagedObject constructing) currentThread
| ResolvedBaseType.ValueType ->
let vt =
{
Fields = Map.toList 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
@@ -789,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
@@ -850,6 +843,7 @@ module IlMachineState =
for i = 0 to generics.Length - 1 do
let state2, handle =
concretizeType
loggerFactory
baseClassTypes
state
callingAssembly
@@ -905,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
@@ -923,6 +910,7 @@ module IlMachineState =
state <-
{ state with
ConcreteTypes = newCtx.ConcreteTypes
_LoadedAssemblies = newCtx.LoadedAssemblies
}
handles.ToImmutable (), state
@@ -1027,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
@@ -1069,7 +1050,7 @@ module IlMachineState =
Logger = logger
NextThreadId = 0
// CallStack = []
ManagedHeap = ManagedHeap.Empty
ManagedHeap = ManagedHeap.empty
ThreadState = Map.empty
InternedStrings = ImmutableDictionary.Empty
_LoadedAssemblies = ImmutableDictionary.Empty
@@ -1115,7 +1096,7 @@ module IlMachineState =
Elements = initialisation
}
let alloc, heap = state.ManagedHeap |> ManagedHeap.AllocateArray o
let alloc, heap = state.ManagedHeap |> ManagedHeap.allocateArray o
let state =
{ state with
@@ -1125,7 +1106,7 @@ module IlMachineState =
alloc, state
let allocateStringData (len : int) (state : IlMachineState) : int * IlMachineState =
let addr, heap = state.ManagedHeap |> ManagedHeap.AllocateString len
let addr, heap = state.ManagedHeap |> ManagedHeap.allocateString len
let state =
{ state with
@@ -1135,7 +1116,7 @@ module IlMachineState =
addr, state
let setStringData (addr : int) (contents : string) (state : IlMachineState) : IlMachineState =
let heap = ManagedHeap.SetStringData addr contents state.ManagedHeap
let heap = ManagedHeap.setStringData addr contents state.ManagedHeap
{ state with
ManagedHeap = heap
@@ -1143,18 +1124,18 @@ module IlMachineState =
let allocateManagedObject
(ty : ConcreteTypeHandle)
(fields : (string * CliType) list)
(fields : CliValueType)
(state : IlMachineState)
: ManagedHeapAddress * IlMachineState
=
let o =
{
Fields = Map.ofList fields
Contents = fields
ConcreteType = ty
SyncBlock = SyncBlock.Free
}
let alloc, heap = state.ManagedHeap |> ManagedHeap.AllocateNonArray o
let alloc, heap = state.ManagedHeap |> ManagedHeap.allocateNonArray o
let state =
{ state with
@@ -1220,6 +1201,7 @@ module IlMachineState =
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(currentThread : ThreadId)
(assy : DumpedAssembly)
(genericMethodTypeArgs : ImmutableArray<ConcreteTypeHandle>)
(m : MemberReferenceHandle)
(state : IlMachineState)
: IlMachineState *
@@ -1283,6 +1265,7 @@ module IlMachineState =
// TODO: generics?
let state, t =
concretizeType
loggerFactory
baseClassTypes
state
targetType.Assembly
@@ -1300,6 +1283,7 @@ module IlMachineState =
// Concretize the field signature from the member reference
let state, concreteFieldSig =
concretizeType
loggerFactory
baseClassTypes
state
(state.ActiveAssembly(currentThread).Name)
@@ -1317,6 +1301,7 @@ module IlMachineState =
// Concretize the field's signature for comparison
let state, fieldSigConcrete =
concretizeType
loggerFactory
baseClassTypes
state
assy.Name
@@ -1354,11 +1339,12 @@ module IlMachineState =
state
(fun state ty ->
concretizeType
loggerFactory
baseClassTypes
state
(state.ActiveAssembly(currentThread).Name)
concreteExtractedTypeArgs
ImmutableArray.Empty
genericMethodTypeArgs
ty
)
@@ -1371,11 +1357,12 @@ module IlMachineState =
state
(fun state ty ->
concretizeType
loggerFactory
baseClassTypes
state
assy.Name
concreteExtractedTypeArgs
ImmutableArray.Empty
genericMethodTypeArgs
ty
)
@@ -1429,13 +1416,62 @@ module IlMachineState =
: IlMachineState
=
{ state with
ManagedHeap = state.ManagedHeap |> ManagedHeap.SetSyncBlock addr syncBlockValue
ManagedHeap = state.ManagedHeap |> ManagedHeap.setSyncBlock addr syncBlockValue
}
let getSyncBlock (addr : ManagedHeapAddress) (state : IlMachineState) : SyncBlock =
state.ManagedHeap |> ManagedHeap.GetSyncBlock addr
state.ManagedHeap |> ManagedHeap.getSyncBlock addr
let executeDelegateConstructor (instruction : MethodState) (state : IlMachineState) : IlMachineState =
let getFieldValue (obj : ManagedPointerSource) (fieldName : string) (state : IlMachineState) : CliType =
match obj with
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
getLocalVariable sourceThread methodFrame whichVar state
|> CliType.getField fieldName
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.Heap addr ->
ManagedHeap.get addr state.ManagedHeap
|> AllocatedNonArrayObject.DereferenceField fieldName
| 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)
(v : CliType)
(fieldName : string)
(state : IlMachineState)
: IlMachineState
=
match obj with
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
let v =
getLocalVariable sourceThread methodFrame whichVar state
|> CliType.withFieldSet fieldName v
state |> setLocalVariable sourceThread methodFrame whichVar v
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.Heap addr ->
let newValue =
ManagedHeap.get addr state.ManagedHeap
|> AllocatedNonArrayObject.SetField fieldName v
{ state with
ManagedHeap = ManagedHeap.set addr newValue state.ManagedHeap
}
| ManagedPointerSource.ArrayIndex (arr, index) ->
let v = getArrayValue arr index state |> CliType.withFieldSet fieldName v
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
(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]
@@ -1443,12 +1479,17 @@ module IlMachineState =
let targetObj =
match targetObj with
| CliType.ObjectRef target -> target
| CliType.RuntimePointer (CliRuntimePointer.Managed (ManagedPointerSource.Heap target))
| CliType.ObjectRef (Some target) -> Some target
| CliType.ObjectRef None
| CliType.RuntimePointer (CliRuntimePointer.Managed ManagedPointerSource.Null) -> None
| _ -> failwith $"Unexpected target type for delegate: {targetObj}"
let constructing =
match constructing with
| CliType.RuntimePointer (CliRuntimePointer.Managed ManagedPointerSource.Null)
| CliType.ObjectRef None -> failwith "unexpectedly constructing the null delegate"
| CliType.RuntimePointer (CliRuntimePointer.Managed (ManagedPointerSource.Heap target))
| CliType.ObjectRef (Some target) -> target
| _ -> failwith $"Unexpectedly not constructing a managed object: {constructing}"
@@ -1459,14 +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 =
heapObj.Fields
|> Map.add "_target" (CliType.ObjectRef targetObj)
|> Map.add "_methodPtr" methodPtr
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 =
@@ -1480,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)
@@ -1491,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
@@ -1535,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
@@ -1578,6 +1663,38 @@ module IlMachineState =
| false, _ -> None
| true, v -> Some v
let rec dereferencePointer (state : IlMachineState) (src : ManagedPointerSource) : CliType =
match src with
| ManagedPointerSource.Null -> failwith "TODO: throw NRE"
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
state.ThreadState.[sourceThread].MethodStates.[methodFrame].LocalVariables.[int<uint16> whichVar]
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
state.ThreadState.[sourceThread].MethodStates.[methodFrame].Arguments.[int<uint16> whichVar]
| ManagedPointerSource.Heap addr ->
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
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>)
(state : IlMachineState)
@@ -1586,42 +1703,7 @@ module IlMachineState =
: IlMachineState * TypeDefn
=
let defn = activeAssy.TypeDefs.[typeDef]
let baseType =
defn.BaseType
|> DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies defn.Assembly
let signatureTypeKind =
match baseType with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object -> SignatureTypeKind.Class
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
let result =
if defn.Generics.IsEmpty then
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make defn.TypeDefHandle,
defn.Assembly.FullName,
signatureTypeKind
)
else
// Preserve the generic instantiation by converting GenericParameters to TypeDefn.GenericTypeParameter
let genericDef =
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make defn.TypeDefHandle,
defn.Assembly.FullName,
signatureTypeKind
)
let genericArgs =
defn.Generics
|> Seq.mapi (fun i _ -> TypeDefn.GenericTypeParameter i)
|> ImmutableArray.CreateRange
TypeDefn.GenericInstantiation (genericDef, genericArgs)
state, result
state, DumpedAssembly.typeInfoToTypeDefn' baseClassTypes state._LoadedAssemblies defn
let lookupTypeRef
(loggerFactory : ILoggerFactory)
@@ -1649,25 +1731,4 @@ module IlMachineState =
let state, assy, resolved =
resolveTypeFromRef loggerFactory activeAssy ref typeGenerics state
let baseType =
resolved.BaseType
|> DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies assy.Name
let signatureTypeKind =
match baseType with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object -> SignatureTypeKind.Class
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
let result =
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make resolved.TypeDefHandle,
assy.Name.FullName,
signatureTypeKind
)
if resolved.Generics.IsEmpty then
state, result, assy
else
failwith "TODO: add generics"
state, DumpedAssembly.typeInfoToTypeDefn baseClassTypes state._LoadedAssemblies resolved, assy

View File

@@ -10,6 +10,7 @@ open Microsoft.Extensions.Logging
[<RequireQualifiedAccess>]
module IlMachineStateExecution =
let getTypeOfObj
(loggerFactory : ILoggerFactory)
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(state : IlMachineState)
(esv : EvalStackValue)
@@ -17,24 +18,18 @@ module IlMachineStateExecution =
=
match esv with
| EvalStackValue.Int32 _ ->
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make baseClassTypes.Int32.TypeDefHandle,
baseClassTypes.Corelib.Name.FullName,
SignatureTypeKind.ValueType
)
DumpedAssembly.typeInfoToTypeDefn' baseClassTypes state._LoadedAssemblies baseClassTypes.Int32
|> IlMachineState.concretizeType
loggerFactory
baseClassTypes
state
baseClassTypes.Corelib.Name
ImmutableArray.Empty
ImmutableArray.Empty
| EvalStackValue.Int64 _ ->
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make baseClassTypes.Int64.TypeDefHandle,
baseClassTypes.Corelib.Name.FullName,
SignatureTypeKind.ValueType
)
DumpedAssembly.typeInfoToTypeDefn' baseClassTypes state._LoadedAssemblies baseClassTypes.Int64
|> IlMachineState.concretizeType
loggerFactory
baseClassTypes
state
baseClassTypes.Corelib.Name
@@ -42,12 +37,9 @@ module IlMachineStateExecution =
ImmutableArray.Empty
| EvalStackValue.NativeInt nativeIntSource -> failwith "todo"
| EvalStackValue.Float _ ->
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make baseClassTypes.Double.TypeDefHandle,
baseClassTypes.Corelib.Name.FullName,
SignatureTypeKind.ValueType
)
DumpedAssembly.typeInfoToTypeDefn' baseClassTypes state._LoadedAssemblies baseClassTypes.Double
|> IlMachineState.concretizeType
loggerFactory
baseClassTypes
state
baseClassTypes.Corelib.Name
@@ -58,12 +50,14 @@ module IlMachineStateExecution =
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.Heap addr ->
let o = ManagedHeap.Get addr state.ManagedHeap
let o = ManagedHeap.get addr state.ManagedHeap
state, o.ConcreteType
| ManagedPointerSource.ArrayIndex (arr, index) -> failwith "todo"
| ManagedPointerSource.Null -> failwith "todo"
| ManagedPointerSource.Field (managedPointerSource, fieldName) -> failwith "todo"
| ManagedPointerSource.InterpretedAsType (src, ty) -> failwith "todo"
| EvalStackValue.ObjectRef addr ->
let o = ManagedHeap.Get addr state.ManagedHeap
let o = ManagedHeap.get addr state.ManagedHeap
state, o.ConcreteType
| EvalStackValue.UserDefinedValueType tuples -> failwith "todo"
@@ -124,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)
@@ -167,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 =
@@ -211,6 +203,7 @@ module IlMachineStateExecution =
let state, retType =
meth.Signature.ReturnType
|> IlMachineState.concretizeType
loggerFactory
baseClassTypes
state
meth.DeclaringType.Assembly
@@ -222,6 +215,7 @@ module IlMachineStateExecution =
||> Seq.mapFold (fun state ty ->
ty
|> IlMachineState.concretizeType
loggerFactory
baseClassTypes
state
meth.DeclaringType.Assembly
@@ -418,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
@@ -441,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
@@ -578,34 +572,13 @@ module IlMachineStateExecution =
typeDef.Name
)
// TypeDef won't have any generics; it would be a TypeSpec if it did
// Create a TypeDefn from the TypeDef handle
let baseTypeDefn =
let baseTypeDef = sourceAssembly.TypeDefs.[typeDefinitionHandle]
let baseType =
baseTypeDef.BaseType
|> DumpedAssembly.resolveBaseType
baseClassTypes
state._LoadedAssemblies
sourceAssembly.Name
let signatureTypeKind =
match baseType with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make typeDefinitionHandle,
sourceAssembly.Name.FullName,
signatureTypeKind
)
DumpedAssembly.typeInfoToTypeDefn' baseClassTypes state._LoadedAssemblies typeDef
// Concretize the base type
let state, baseTypeHandle =
IlMachineState.concretizeType
loggerFactory
baseClassTypes
state
sourceAssembly.Name
@@ -639,26 +612,13 @@ module IlMachineStateExecution =
// Create a TypeDefn from the resolved TypeRef
let baseTypeDefn =
let baseType =
targetType.BaseType
|> DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies assy.Name
let signatureTypeKind =
match baseType with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make targetType.TypeDefHandle,
assy.Name.FullName,
signatureTypeKind
)
targetType
|> DumpedAssembly.typeInfoToTypeDefn baseClassTypes state._LoadedAssemblies
// Concretize the base type
let state, baseTypeHandle =
IlMachineState.concretizeType
loggerFactory
baseClassTypes
state
sourceAssembly.Name
@@ -710,6 +670,7 @@ module IlMachineStateExecution =
state
(fun state typeDefn ->
IlMachineState.concretizeType
loggerFactory
baseClassTypes
state
concreteType.Assembly
@@ -734,6 +695,7 @@ module IlMachineStateExecution =
||> Seq.fold (fun (state, acc) typeDefn ->
let state, handle =
IlMachineState.concretizeType
loggerFactory
baseClassTypes
state
concreteType.Assembly

View File

@@ -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)
@@ -42,6 +133,8 @@ module Intrinsics =
None
else
// In general, some implementations are in:
// https://github.com/dotnet/runtime/blob/108fa7856efcfd39bc991c2d849eabbf7ba5989c/src/coreclr/tools/Common/TypeSystem/IL/Stubs/UnsafeIntrinsics.cs#L192
match methodToCall.DeclaringType.Assembly.Name, methodToCall.DeclaringType.Name, methodToCall.Name with
| "System.Private.CoreLib", "Type", "get_TypeHandle" ->
// TODO: check return type is RuntimeTypeHandle
@@ -50,7 +143,14 @@ module Intrinsics =
| _ -> ()
// https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/Type.cs#L470
// TODO: check return type is RuntimeTypeHandle
match methodToCall.Signature.ParameterTypes with
| _ :: _ -> failwith "bad signature Type.get_TypeHandle"
| _ -> ()
// no args, returns RuntimeTypeHandle, a struct with a single field (a RuntimeType class)
// https://github.com/dotnet/runtime/blob/1d1bf92fcf43aa6981804dc53c5174445069c9e4/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L18
// The thing on top of the stack will be a RuntimeType.
let arg, state = IlMachineState.popEvalStack currentThread state
@@ -58,8 +158,12 @@ module Intrinsics =
let arg =
let rec go (arg : EvalStackValue) =
match arg with
| EvalStackValue.UserDefinedValueType [ _, s ] -> go s
| EvalStackValue.UserDefinedValueType 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
| s -> failwith $"TODO: called with unrecognised arg %O{s}"
@@ -67,34 +171,72 @@ module Intrinsics =
let state =
let vt =
// https://github.com/dotnet/runtime/blob/2b21c73fa2c32fa0195e4a411a435dda185efd08/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L92
{
Fields = [ "m_type", CliType.ObjectRef arg ]
Name = "m_type"
Contents = CliType.ObjectRef arg
Offset = None
Type =
AllConcreteTypes.findExistingConcreteType
state.ConcreteTypes
(baseClassTypes.RuntimeType.Assembly,
baseClassTypes.RuntimeType.Namespace,
baseClassTypes.RuntimeType.Name,
ImmutableArray.Empty)
|> Option.get
}
|> List.singleton
|> 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"
| EvalStackValue.ManagedPointer ptr -> CliRuntimePointer.Managed ptr
| x -> failwith $"TODO: Unsafe.AsPointer(%O{x})"
IlMachineState.pushToEvalStack (CliType.RuntimePointer toPush) currentThread state
@@ -131,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
@@ -166,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
@@ -179,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}"
@@ -190,29 +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 arg1.Fields.["_firstChar"] <> arg2.Fields.["_firstChar"] 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
@@ -220,19 +451,13 @@ module Intrinsics =
let v : CliType =
let rec go ptr =
match ptr with
| EvalStackValue.ManagedPointer src ->
match src with
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.Heap managedHeapAddress -> failwith "todo"
| ManagedPointerSource.ArrayIndex (arr, index) ->
state |> IlMachineState.getArrayValue arr index
| ManagedPointerSource.Null -> failwith "TODO: throw NRE"
| EvalStackValue.ManagedPointer src -> IlMachineState.dereferencePointer state src
| EvalStackValue.NativeInt src -> failwith "TODO"
| EvalStackValue.ObjectRef ptr -> failwith "TODO"
| EvalStackValue.UserDefinedValueType [ _, field ] -> go field
| EvalStackValue.UserDefinedValueType []
| EvalStackValue.UserDefinedValueType (_ :: _ :: _)
| EvalStackValue.UserDefinedValueType 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}"
@@ -277,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
@@ -297,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)

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

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

View File

@@ -8,11 +8,20 @@ type SyncBlock =
type AllocatedNonArrayObject =
{
Fields : Map<string, CliType>
// 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 =
CliValueType.DereferenceField name f.Contents
static member SetField (name : string) (v : CliType) (f : AllocatedNonArrayObject) : AllocatedNonArrayObject =
{ f with
Contents = CliValueType.WithFieldSet name v f.Contents
}
type AllocatedArray =
{
Length : int
@@ -29,7 +38,9 @@ type ManagedHeap =
StringArrayData : ImmutableArray<char>
}
static member Empty : ManagedHeap =
[<RequireQualifiedAccess>]
module ManagedHeap =
let empty : ManagedHeap =
{
NonArrayObjects = Map.empty
FirstAvailableAddress = 1
@@ -37,12 +48,12 @@ type ManagedHeap =
StringArrayData = ImmutableArray.Empty
}
static member GetSyncBlock (addr : ManagedHeapAddress) (heap : ManagedHeap) : SyncBlock =
let getSyncBlock (addr : ManagedHeapAddress) (heap : ManagedHeap) : SyncBlock =
match heap.NonArrayObjects.TryGetValue addr with
| false, _ -> failwith "TODO: getting sync block of array"
| true, v -> v.SyncBlock
static member SetSyncBlock (addr : ManagedHeapAddress) (syncValue : SyncBlock) (heap : ManagedHeap) : ManagedHeap =
let setSyncBlock (addr : ManagedHeapAddress) (syncValue : SyncBlock) (heap : ManagedHeap) : ManagedHeap =
match heap.NonArrayObjects.TryGetValue addr with
| false, _ -> failwith "TODO: locked on an array object"
| true, v ->
@@ -55,7 +66,7 @@ type ManagedHeap =
NonArrayObjects = heap.NonArrayObjects |> Map.add addr newV
}
static member AllocateArray (ty : AllocatedArray) (heap : ManagedHeap) : ManagedHeapAddress * ManagedHeap =
let allocateArray (ty : AllocatedArray) (heap : ManagedHeap) : ManagedHeapAddress * ManagedHeap =
let addr = heap.FirstAvailableAddress
let heap =
@@ -68,7 +79,7 @@ type ManagedHeap =
ManagedHeapAddress addr, heap
static member AllocateString (len : int) (heap : ManagedHeap) : int * ManagedHeap =
let allocateString (len : int) (heap : ManagedHeap) : int * ManagedHeap =
let addr = heap.StringArrayData.Length
let heap =
@@ -80,7 +91,7 @@ type ManagedHeap =
addr, heap
static member SetStringData (addr : int) (contents : string) (heap : ManagedHeap) : ManagedHeap =
let setStringData (addr : int) (contents : string) (heap : ManagedHeap) : ManagedHeap =
let newArr =
(heap.StringArrayData, seq { 0 .. contents.Length - 1 })
||> Seq.fold (fun data count -> data.SetItem (addr + count, contents.[count]))
@@ -92,11 +103,7 @@ type ManagedHeap =
heap
static member AllocateNonArray
(ty : AllocatedNonArrayObject)
(heap : ManagedHeap)
: ManagedHeapAddress * ManagedHeap
=
let allocateNonArray (ty : AllocatedNonArrayObject) (heap : ManagedHeap) : ManagedHeapAddress * ManagedHeap =
let addr = heap.FirstAvailableAddress
let heap =
@@ -109,7 +116,7 @@ type ManagedHeap =
ManagedHeapAddress addr, heap
static member GetArrayValue (alloc : ManagedHeapAddress) (offset : int) (heap : ManagedHeap) : CliType =
let getArrayValue (alloc : ManagedHeapAddress) (offset : int) (heap : ManagedHeap) : CliType =
match heap.Arrays.TryGetValue alloc with
| false, _ -> failwith "TODO: array not on heap"
| true, arr ->
@@ -119,17 +126,17 @@ type ManagedHeap =
arr.Elements.[offset]
static member Get (alloc : ManagedHeapAddress) (heap : ManagedHeap) : AllocatedNonArrayObject =
let get (alloc : ManagedHeapAddress) (heap : ManagedHeap) : AllocatedNonArrayObject =
// TODO: arrays too
heap.NonArrayObjects.[alloc]
static member SetArrayValue
(alloc : ManagedHeapAddress)
(offset : int)
(v : CliType)
(heap : ManagedHeap)
: ManagedHeap
=
let set (alloc : ManagedHeapAddress) (v : AllocatedNonArrayObject) (heap : ManagedHeap) : ManagedHeap =
// TODO: arrays too
{ heap with
NonArrayObjects = heap.NonArrayObjects |> Map.add alloc v
}
let setArrayValue (alloc : ManagedHeapAddress) (offset : int) (v : CliType) (heap : ManagedHeap) : ManagedHeap =
let newArrs =
heap.Arrays
|> Map.change

View File

@@ -1,5 +1,6 @@
namespace WoofWare.PawPrint
open System
open Microsoft.Extensions.Logging
[<RequireQualifiedAccess>]
@@ -37,19 +38,6 @@ module NullaryIlOp =
| LdindR4 -> CliType.Numeric (CliNumericType.Float32 0.0f)
| LdindR8 -> CliType.Numeric (CliNumericType.Float64 0.0)
/// Retrieve a value from a pointer
let private loadFromPointerSource (state : IlMachineState) (src : ManagedPointerSource) : CliType =
match src with
| ManagedPointerSource.Null -> failwith "unexpected null pointer in Ldind operation"
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
state.ThreadState.[sourceThread].MethodStates.[methodFrame].Arguments.[int<uint16> whichVar]
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
state.ThreadState.[sourceThread].MethodStates.[methodFrame].LocalVariables.[int<uint16> whichVar]
| ManagedPointerSource.Heap managedHeapAddress -> failwith "TODO: Heap pointer dereferencing not implemented"
| ManagedPointerSource.ArrayIndex (arr, index) ->
let arr = state.ManagedHeap.Arrays.[arr]
arr.Elements.[index]
// Unified Ldind implementation
let private executeLdind
(targetType : LdindTargetType)
@@ -61,11 +49,11 @@ module NullaryIlOp =
let loadedValue =
match popped with
| EvalStackValue.ManagedPointer src -> loadFromPointerSource state src
| EvalStackValue.ManagedPointer src -> IlMachineState.dereferencePointer state src
| 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
@@ -94,52 +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) ->
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
@@ -153,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)
@@ -176,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
@@ -442,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
@@ -452,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
@@ -502,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
@@ -590,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
@@ -661,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 ->
@@ -684,6 +776,7 @@ module NullaryIlOp =
let popped =
match popped with
| EvalStackValue.ManagedPointer ManagedPointerSource.Null -> failwith "TODO: throw NRE"
| EvalStackValue.ObjectRef addr
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) -> addr
| _ -> failwith $"can't get len of {popped}"
@@ -868,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"
@@ -885,26 +987,33 @@ 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
let referenced =
match addr with
| EvalStackValue.ManagedPointer src ->
match src with
| ManagedPointerSource.Null -> failwith "TODO: throw NRE"
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
state.ThreadState.[sourceThread].MethodStates.[methodFrame].LocalVariables
.[int<uint16> whichVar]
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
state.ThreadState.[sourceThread].MethodStates.[methodFrame].Arguments.[int<uint16> whichVar]
| ManagedPointerSource.Heap managedHeapAddress -> failwith "todo"
| ManagedPointerSource.ArrayIndex _ -> failwith "todo"
| EvalStackValue.ManagedPointer src -> IlMachineState.dereferencePointer state src
| a -> failwith $"TODO: {a}"
let state =
match referenced with
| CliType.RuntimePointer (CliRuntimePointer.Managed _)
| CliType.ObjectRef _ -> IlMachineState.pushToEvalStack referenced currentThread state
| _ -> failwith $"Unexpected non-reference {referenced}"
|> IlMachineState.advanceProgramCounter currentThread
@@ -928,19 +1037,92 @@ module NullaryIlOp =
arr
(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"
@@ -948,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

View File

@@ -10,18 +10,16 @@ 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)
: ManagedHeapAddress * IlMachineState
=
let state, stringType =
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make corelib.String.TypeDefHandle,
corelib.Corelib.Name.FullName,
SignatureTypeKind.Class
)
DumpedAssembly.typeInfoToTypeDefn' corelib state._LoadedAssemblies corelib.String
|> IlMachineState.concretizeType
loggerFactory
corelib
state
corelib.Corelib.Name
@@ -126,7 +124,7 @@ module Program =
let rec go state =
// Resolve the type reference to find which assembly it's in
match
Assembly.resolveTypeRef state._LoadedAssemblies currentAssembly typeRef ImmutableArray.Empty
Assembly.resolveTypeRef state._LoadedAssemblies currentAssembly ImmutableArray.Empty typeRef
with
| TypeResolutionResult.FirstLoadAssy assyRef ->
// Need to load this assembly first
@@ -289,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
@@ -304,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 =

View File

@@ -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 : (string * CliType) list -> 'allocState -> ManagedHeapAddress * 'allocState)
(allocate : CliValueType -> 'allocState -> ManagedHeapAddress * 'allocState)
(def : ConcreteTypeHandle)
(reg : TypeHandleRegistry)
: ManagedHeapAddress * TypeHandleRegistry * 'allocState
@@ -29,17 +33,64 @@ module TypeHandleRegistry =
// Here follows the class System.RuntimeType, which is an internal class type with a constructor
// whose only purpose is to throw.
// https://github.com/dotnet/runtime/blob/2b21c73fa2c32fa0195e4a411a435dda185efd08/src/libraries/System.Private.CoreLib/src/System/RuntimeType.cs#L14
// and https://github.com/dotnet/runtime/blob/f0168ee80ba9aca18a7e7140b2bb436defda623c/src/coreclr/System.Private.CoreLib/src/System/RuntimeType.CoreCLR.cs#L44
let fields =
[
// for the GC, I think?
"m_keepalive", CliType.ObjectRef None
// TODO: this is actually a System.IntPtr https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/coreclr/nativeaot/Runtime.Base/src/System/Primitives.cs#L339
"m_cache", CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.Verbatim 0L))
"m_handle", CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.TypeHandlePtr def))
{
Name = "m_keepalive"
Contents = CliType.ObjectRef None
Offset = None
Type =
AllConcreteTypes.findExistingConcreteType
allConcreteTypes
(corelib.Object.Assembly,
corelib.Object.Namespace,
corelib.Object.Name,
ImmutableArray.Empty)
|> Option.get
}
{
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
"GenericParameterCountAny", CliType.Numeric (CliNumericType.Int32 -1)
{
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

View File

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

View File

@@ -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
@@ -265,10 +306,18 @@ module internal UnaryMetadataIlOp =
ImmutableArray.Empty
state
state, (field.Name, zero) :: zeros
let field =
{
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
@@ -347,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
@@ -367,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
@@ -409,22 +506,10 @@ module internal UnaryMetadataIlOp =
let activeAssy = state.ActiveAssembly thread
let ty = activeAssy.TypeDefs.[td]
let baseTy =
DumpedAssembly.resolveBaseType
baseClassTypes
state._LoadedAssemblies
activeAssy.Name
ty.BaseType
let result =
DumpedAssembly.typeInfoToTypeDefn' baseClassTypes state._LoadedAssemblies ty
let sigType =
match baseTy with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object -> SignatureTypeKind.Class
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
state,
TypeDefn.FromDefinition (ComparableTypeDefinitionHandle.Make td, activeAssy.Name.FullName, sigType)
state, result
| MetadataToken.TypeSpecification handle ->
state, state.ActiveAssembly(thread).TypeSpecs.[handle].Signature
| MetadataToken.TypeReference handle ->
@@ -436,26 +521,12 @@ module internal UnaryMetadataIlOp =
ImmutableArray.Empty
state
let baseTy =
DumpedAssembly.resolveBaseType baseClassTypes state._LoadedAssemblies assy.Name resol.BaseType
let sigType =
match baseTy with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object -> SignatureTypeKind.Class
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
state,
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make resol.TypeDefHandle,
assy.Name.FullName,
sigType
)
state, DumpedAssembly.typeInfoToTypeDefn baseClassTypes state._LoadedAssemblies resol
| m -> failwith $"unexpected metadata token {m} in IsInst"
let state, targetConcreteType =
IlMachineState.concretizeType
loggerFactory
baseClassTypes
state
activeAssy.Name
@@ -469,13 +540,15 @@ module internal UnaryMetadataIlOp =
// null IsInstance check always succeeds and results in a null reference
EvalStackValue.ManagedPointer ManagedPointerSource.Null
| EvalStackValue.ManagedPointer (ManagedPointerSource.LocalVariable _) -> failwith "TODO"
| EvalStackValue.ObjectRef addr
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) ->
match state.ManagedHeap.NonArrayObjects.TryGetValue addr with
| true, v ->
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
@@ -500,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"
@@ -511,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
@@ -533,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
@@ -548,33 +627,41 @@ module internal UnaryMetadataIlOp =
| EvalStackValue.Int64 _ -> failwith "unexpectedly setting field on an int64"
| EvalStackValue.NativeInt _ -> failwith "unexpectedly setting field on a nativeint"
| EvalStackValue.Float _ -> failwith "unexpectedly setting field on a float"
| EvalStackValue.ManagedPointer source ->
match source with
| ManagedPointerSource.Null -> failwith "TODO: raise NullReferenceException"
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
state
|> IlMachineState.setLocalVariable sourceThread methodFrame whichVar valueToStore
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.ArrayIndex (arr, index) ->
state |> IlMachineState.setArrayValue arr valueToStore index
| ManagedPointerSource.Heap addr ->
match state.ManagedHeap.NonArrayObjects.TryGetValue addr with
| false, _ -> failwith $"todo: array {addr}"
| true, v ->
let v =
{ v with
Fields = v.Fields |> Map.add field.Name valueToStore
}
| EvalStackValue.ObjectRef addr
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) ->
match state.ManagedHeap.NonArrayObjects.TryGetValue addr with
| false, _ -> failwith $"todo: array {addr}"
| true, v ->
let v = AllocatedNonArrayObject.SetField field.Name valueToStore v
let heap =
{ state.ManagedHeap with
NonArrayObjects = state.ManagedHeap.NonArrayObjects |> Map.add addr v
}
{ state with
ManagedHeap = heap
let heap =
{ state.ManagedHeap with
NonArrayObjects = state.ManagedHeap.NonArrayObjects |> Map.add addr v
}
| EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo"
{ state with
ManagedHeap = heap
}
| EvalStackValue.ManagedPointer ManagedPointerSource.Null ->
failwith "TODO: raise NullReferenceException"
| EvalStackValue.ManagedPointer (ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar)) ->
let newValue =
IlMachineState.getLocalVariable sourceThread methodFrame whichVar state
|> CliType.withFieldSet field.Name valueToStore
state
|> IlMachineState.setLocalVariable sourceThread methodFrame whichVar newValue
| EvalStackValue.ManagedPointer (ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar)) ->
failwith "todo"
| EvalStackValue.ManagedPointer (ManagedPointerSource.ArrayIndex (arr, index)) ->
let newValue =
IlMachineState.getArrayValue arr index state
|> CliType.withFieldSet field.Name valueToStore
state |> IlMachineState.setArrayValue arr newValue index
| EvalStackValue.ManagedPointer (ManagedPointerSource.Field (managedPointerSource, fieldName)) ->
failwith "todo"
| EvalStackValue.ManagedPointer (ManagedPointerSource.InterpretedAsType (src, ty)) -> failwith "todo"
| EvalStackValue.UserDefinedValueType _ -> failwith "todo"
state
@@ -600,6 +687,7 @@ module internal UnaryMetadataIlOp =
baseClassTypes
thread
(state.ActiveAssembly thread)
ImmutableArray.Empty
mr
state
@@ -630,7 +718,7 @@ module internal UnaryMetadataIlOp =
let popped, state = IlMachineState.popEvalStack thread state
let state, zero =
let state, zero, concreteTypeHandle =
IlMachineState.cliTypeZeroOf
loggerFactory
baseClassTypes
@@ -659,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"
@@ -690,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
@@ -713,39 +808,96 @@ module internal UnaryMetadataIlOp =
| EvalStackValue.Int64 int64 -> failwith "todo: int64"
| EvalStackValue.NativeInt nativeIntSource -> failwith $"todo: nativeint {nativeIntSource}"
| EvalStackValue.Float f -> failwith "todo: float"
| EvalStackValue.ManagedPointer managedPointerSource ->
match managedPointerSource with
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
let currentValue =
state.ThreadState.[sourceThread].MethodStates.[methodFrame].LocalVariables
.[int<uint16> whichVar]
| EvalStackValue.ManagedPointer (ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar)) ->
let currentValue =
state.ThreadState.[sourceThread].MethodStates.[methodFrame].LocalVariables
.[int<uint16> whichVar]
|> CliType.getField field.Name
IlMachineState.pushToEvalStack currentValue thread state
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
let currentValue =
state.ThreadState.[sourceThread].MethodStates.[methodFrame].Arguments.[int<uint16> whichVar]
IlMachineState.pushToEvalStack currentValue thread state
| EvalStackValue.ManagedPointer (ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar)) ->
let currentValue =
state.ThreadState.[sourceThread].MethodStates.[methodFrame].Arguments.[int<uint16> whichVar]
|> CliType.getField field.Name
IlMachineState.pushToEvalStack currentValue thread state
| ManagedPointerSource.Heap managedHeapAddress ->
match state.ManagedHeap.NonArrayObjects.TryGetValue managedHeapAddress with
| false, _ -> failwith $"todo: array {managedHeapAddress}"
| true, v -> IlMachineState.pushToEvalStack v.Fields.[field.Name] thread state
| ManagedPointerSource.ArrayIndex (arr, index) ->
let currentValue = state |> IlMachineState.getArrayValue arr index
IlMachineState.pushToEvalStack currentValue thread state
| ManagedPointerSource.Null -> failwith "TODO: raise NullReferenceException"
| EvalStackValue.ObjectRef managedHeapAddress -> failwith $"todo: {managedHeapAddress}"
| EvalStackValue.UserDefinedValueType fields ->
let result =
fields |> List.pick (fun (k, v) -> if k = field.Name then Some v else None)
IlMachineState.pushToEvalStack currentValue thread state
| EvalStackValue.ObjectRef managedHeapAddress
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap managedHeapAddress) ->
match state.ManagedHeap.NonArrayObjects.TryGetValue managedHeapAddress with
| false, _ -> failwith $"todo: array {managedHeapAddress}"
| true, v ->
IlMachineState.pushToEvalStack
(AllocatedNonArrayObject.DereferenceField field.Name v)
thread
state
| EvalStackValue.ManagedPointer (ManagedPointerSource.ArrayIndex (arr, index)) ->
let currentValue =
state |> IlMachineState.getArrayValue arr index |> CliType.getField field.Name
IlMachineState.pushToEvalStack' result thread state
IlMachineState.pushToEvalStack currentValue thread state
| EvalStackValue.ManagedPointer ManagedPointerSource.Null ->
failwith "TODO: raise NullReferenceException"
| EvalStackValue.ManagedPointer (ManagedPointerSource.Field (src, fieldName)) ->
let currentValue =
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 |> CliValueType.DereferenceField field.Name
IlMachineState.pushToEvalStack result thread state
state
|> IlMachineState.advanceProgramCounter thread
|> Tuple.withRight WhatWeDid.Executed
| Ldflda -> failwith "TODO: Ldflda unimplemented"
| Ldflda ->
let ptr, state = IlMachineState.popEvalStack thread state
let ptr =
match ptr with
| Int32 _
| Int64 _
| Float _ -> failwith "expected pointer type"
| NativeInt nativeIntSource -> failwith "todo"
| ManagedPointer src -> src
| ObjectRef addr -> ManagedPointerSource.Heap addr
| UserDefinedValueType evalStackValueUserType -> failwith "todo"
let state, field =
match metadataToken with
| MetadataToken.FieldDefinition f ->
let field =
activeAssy.Fields.[f]
|> FieldInfo.mapTypeGenerics (fun _ -> failwith "no generics allowed on FieldDefinition")
state, field
| MetadataToken.MemberReference mr ->
let state, assyName, field, _ =
// TODO: generics
IlMachineState.resolveMember
loggerFactory
baseClassTypes
thread
activeAssy
ImmutableArray.Empty
mr
state
match field with
| Choice1Of2 _method -> failwith "member reference was unexpectedly a method"
| Choice2Of2 field -> state, field
| t -> failwith $"Unexpectedly asked to load from a non-field: {t}"
let result =
ManagedPointerSource.Field (ptr, field.Name) |> EvalStackValue.ManagedPointer
state
|> IlMachineState.pushToEvalStack' result thread
|> IlMachineState.advanceProgramCounter thread
|> Tuple.withRight WhatWeDid.Executed
| Ldsfld ->
let state, field =
match metadataToken with
@@ -760,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"
@@ -791,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
@@ -867,14 +1026,9 @@ module internal UnaryMetadataIlOp =
| _ -> failwith $"expected heap allocation for array, got {arr}"
let elementType =
TypeInfo.toTypeDefn
baseClassTypes
_.Name
(fun x y -> x.TypeDefs.[y])
(fun x y -> x.TypeRefs.[y] |> failwithf "%+A")
elementType
DumpedAssembly.typeInfoToTypeDefn baseClassTypes state._LoadedAssemblies elementType
let state, zeroOfType =
let state, zeroOfType, concreteTypeHandle =
IlMachineState.cliTypeZeroOf
loggerFactory
baseClassTypes
@@ -941,7 +1095,72 @@ module internal UnaryMetadataIlOp =
IlMachineState.pushToEvalStack toPush thread state
|> IlMachineState.advanceProgramCounter thread
|> Tuple.withRight WhatWeDid.Executed
| Initobj -> failwith "TODO: Initobj unimplemented"
| Initobj ->
let popped, state = IlMachineState.popEvalStack thread state
let declaringTypeGenerics = currentMethod.DeclaringType.Generics
let state, assy, targetType =
match metadataToken with
| MetadataToken.TypeDefinition defn ->
state,
activeAssy,
activeAssy.TypeDefs.[defn]
|> TypeInfo.mapGeneric (fun (p, _) -> TypeDefn.GenericTypeParameter p.SequenceNumber)
| MetadataToken.TypeSpecification spec ->
let state, assy, ty =
IlMachineState.resolveTypeFromSpecConcrete
loggerFactory
baseClassTypes
spec
activeAssy
declaringTypeGenerics
currentMethod.Generics
state
state, assy, ty
| x -> failwith $"TODO: Ldelem element type resolution unimplemented for {x}"
let targetType =
targetType
|> DumpedAssembly.typeInfoToTypeDefn baseClassTypes state._LoadedAssemblies
let state, zeroOfType, concreteTypeHandle =
IlMachineState.cliTypeZeroOf
loggerFactory
baseClassTypes
assy
targetType
declaringTypeGenerics
ImmutableArray.Empty
state
let state =
match popped with
| EvalStackValue.Int32 _
| EvalStackValue.Int64 _
| EvalStackValue.NativeInt _
| EvalStackValue.Float _ -> failwith "unexpectedly not an address"
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr)
| EvalStackValue.ObjectRef addr -> failwith "todo"
| EvalStackValue.ManagedPointer src ->
match src with
| ManagedPointerSource.LocalVariable (thread, frame, var) ->
state |> IlMachineState.setLocalVariable thread frame var zeroOfType
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.ArrayIndex (arr, index) ->
state |> IlMachineState.setArrayValue arr zeroOfType index
| 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
@@ -963,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 =
@@ -1038,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 ->
@@ -1070,28 +1334,12 @@ module internal UnaryMetadataIlOp =
methodGenerics
state
let stk =
match
DumpedAssembly.resolveBaseType
baseClassTypes
state._LoadedAssemblies
assy.Name
typeDefn.BaseType
with
| ResolvedBaseType.ValueType
| ResolvedBaseType.Enum -> SignatureTypeKind.ValueType
| ResolvedBaseType.Delegate
| ResolvedBaseType.Object -> SignatureTypeKind.Class
let typeDefn =
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make typeDefn.TypeDefHandle,
assy.Name.FullName,
stk
)
DumpedAssembly.typeInfoToTypeDefn baseClassTypes state._LoadedAssemblies typeDefn
let state, handle =
IlMachineState.concretizeType
loggerFactory
baseClassTypes
state
assy.Name
@@ -1099,12 +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 =
{
Fields = [ "m_type", CliType.ObjectRef (Some alloc) ]
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
| MetadataToken.TypeReference h ->
@@ -1123,6 +1384,7 @@ module internal UnaryMetadataIlOp =
let state, handle =
IlMachineState.concretizeType
loggerFactory
baseClassTypes
state
assy.Name
@@ -1130,52 +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 =
{
Fields = [ "m_type", CliType.ObjectRef (Some alloc) ]
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
| 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 =
{
Fields = [ "m_type", CliType.ObjectRef (Some alloc) ]
}
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
@@ -1190,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

View File

@@ -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)
@@ -27,6 +28,8 @@ module internal UnaryStringTokenIlOp =
let state = state |> IlMachineState.setStringData dataAddr stringToAllocate
// String type is:
// https://github.com/dotnet/runtime/blob/f0168ee80ba9aca18a7e7140b2bb436defda623c/src/libraries/System.Private.CoreLib/src/System/String.cs#L26
let stringInstanceFields =
baseClassTypes.String.Fields
|> List.choose (fun field ->
@@ -49,17 +52,39 @@ module internal UnaryStringTokenIlOp =
let fields =
[
"_firstChar", CliType.ofChar state.ManagedHeap.StringArrayData.[dataAddr]
"_stringLength", CliType.Numeric (CliNumericType.Int32 stringToAllocate.Length)
{
Name = "_firstChar"
Contents = CliType.ofChar state.ManagedHeap.StringArrayData.[dataAddr]
Offset = None
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 =
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make baseClassTypes.String.TypeDefHandle,
baseClassTypes.Corelib.Name.FullName,
SignatureTypeKind.Class
)
DumpedAssembly.typeInfoToTypeDefn' baseClassTypes state._LoadedAssemblies baseClassTypes.String
|> IlMachineState.concretizeType
loggerFactory
baseClassTypes
state
baseClassTypes.Corelib.Name

View File

@@ -7,6 +7,7 @@
<ItemGroup>
<Compile Include="Tuple.fs" />
<Compile Include="List.fs" />
<Compile Include="ImmutableArray.fs" />
<Compile Include="Result.fs" />
<Compile Include="Corelib.fs" />
@@ -19,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
View File

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