patrick/WoofWare.PawPrint
1
0
Fork 0
mirror of https://github.com/Smaug123/WoofWare.PawPrint synced 2025-10-15 10:38:40 +00:00
Code Issues Packages Projects Releases Wiki Activity

Compare commits

base: patrick:9afc7efea128e46f9cd1a00adcce8e7e50aa7418
Branches Tags
patrick:main patrick:net10 patrick:expand-exceptions-2 patrick:castclass patrick:runtime-types patrick:more-ldind
..
compare: patrick:runtime-types
Branches Tags
patrick:net10 patrick:main patrick:expand-exceptions-2 patrick:castclass patrick:runtime-types patrick:more-ldind

4 Commits
9afc7efea1 ... runtime-ty

Author SHA1 Message Date
Smaug123
a7150e3294 Oh god there is so much 2025-06-29 21:07:28 +01:00
Smaug123
ab4c251c97 WIP 2025-06-29 20:39:59 +01:00
Smaug123
cbbde0c4ba Merge branch 'main' into runtime-types 2025-06-27 21:43:08 +01:00
Smaug123
8aa33b5606 Fully realise runtime types 2025-06-27 21:24:13 +01:00
58 changed files with 2183 additions and 6375 deletions
Expand all files Collapse all files

140
CLAUDE.md
View File

@@ -42,13 +42,8 @@ dotnet fantomas .
```
### Running the Application
A playground C# file is in CSharpExample/Class1.cs.
This environment is convenient for running WoofWare.PawPrint against a standalone DLL.
Interpolate the appropriate strings like `{Platform}` as necessary depending on the current environment and the output of the `dotnet publish`.
```bash
dotnet publish --self-contained --runtime {Platform} CSharpExample/
dotnet run --project WoofWare.PawPrint.App/WoofWare.PawPrint.App.fsproj -- CSharpExample/bin/{Configuration}/{Framework}/{Platform}/publish/CSharpExample.dll
dotnet publish --self-contained --runtime-id osx-arm64 CSharpExample/ && dotnet run --project WoofWare.PawPrint.App/WoofWare.PawPrint.App.fsproj -- CSharpExample/bin/Debug/net9.0/osx-arm64/publish/CSharpExample.dll
```
## Architecture
@@ -67,13 +62,10 @@ 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
- 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
- Uses NUnit as the test framework
- Test cases are defined in `TestCases.fs`
- C# source files in `sources/` are compiled and executed by the runtime as test cases
- `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
@@ -89,17 +81,15 @@ dotnet run --project WoofWare.PawPrint.App/WoofWare.PawPrint.App.fsproj -- CShar
* Functions should be fully type-annotated, to give the most helpful error messages on type mismatches.
* Generally, prefer to fully-qualify discriminated union cases in `match` statements.
* ALWAYS fully-qualify enum cases when constructing them and matching on them (e.g., `PrimitiveType.Int16` not `Int16`).
* When writing a "TODO" `failwith`, specify in the error message what the condition is that triggers the failure, so that a failing run can easily be traced back to its cause.
* If a field name begins with an underscore (like `_LoadedAssemblies`), do not mutate it directly. Only mutate it via whatever intermediate methods have been defined for that purpose (like `WithLoadedAssembly`).
### Development Workflow
When adding new IL instruction support:
1. Add the instruction to `IlOp.fs`
2. Implement execution logic in `AbstractMachine.fs`
3. Add a test case in `sourcesPure/` or `sourcesImpure/` (C# file) that exercises the instruction, remembering also to add the file as an EmbeddedResource in WoofWare.PawPrint.Test.fsproj
4. Add the test case to `TestPureCases.fs` or `TestImpureCases.fs`
3. Add a test case in `sources/` (C# file) that exercises the instruction
4. Add the test case to `TestCases.fs`
5. Run tests to verify implementation
The project uses deterministic builds and treats warnings as errors to maintain code quality.
@@ -108,121 +98,3 @@ It strongly prefers to avoid special-casing to get around problems, but instead
### Common Gotchas
* I've named several types in such a way as to overlap with built-in types, e.g. MethodInfo is in both WoofWare.PawPrint and System.Reflection.Metadata namespaces. Build errors can usually be fixed by fully-qualifying the type.
## Type Concretization System
### Overview
Type concretization converts abstract type definitions (`TypeDefn`) to concrete runtime types (`ConcreteTypeHandle`). This is essential because IL operations need exact types at runtime, including all generic instantiations. The system separates type concretization from IL execution, ensuring types are properly loaded before use.
### Key Concepts
#### Generic Parameters
- **Common error**: "Generic type/method parameter X out of range" probably means you're missing the proper generic context: some caller has passed the wrong list of generics through somewhere.
#### Assembly Context
TypeRefs must be resolved in the context of the assembly where they're defined, not where they're used. When resolving a TypeRef, always use the assembly that contains the TypeRef in its metadata.
### Common Scenarios and Solutions
#### Nested Generic Contexts
When inside `Array.Empty<T>()` calling `AsRef<T>`, the `T` refers to the outer method's generic parameter. Pass the current executing method's generics as context:
```fsharp
let currentMethod = state.ThreadState.[thread].MethodState.ExecutingMethod
concretizeMethodWithTypeGenerics ... currentMethod.Generics state
```
#### Field Access in Generic Contexts
When accessing `EmptyArray<T>.Value` from within `Array.Empty<T>()`, use both type and method generics:
```fsharp
let contextTypeGenerics = currentMethod.DeclaringType.Generics
let contextMethodGenerics = currentMethod.Generics
```
#### Call vs CallMethod
- `callMethodInActiveAssembly` expects unconcretized methods and does concretization internally
- `callMethod` expects already-concretized methods
- The refactoring changed to concretizing before calling to ensure types are loaded
### Common Pitfalls
1. **Don't create new generic parameters when they already exist**. It's *very rarely* correct to instantiate `TypeDefn.Generic{Type,Method}Parameter` yourself:
```fsharp
// Wrong: field.DeclaringType.Generics |> List.mapi (fun i _ -> TypeDefn.GenericTypeParameter i)
// Right: field.DeclaringType.Generics
```
2. **Assembly loading context**: The `loadAssembly` function expects the assembly that contains the reference as the first parameter, not the target assembly
3. **Type forwarding**: Use `Assembly.resolveTypeRef` which handles type forwarding and exported types correctly
### Key Files for Type System
- **TypeConcretisation.fs**: Core type concretization logic
- `concretizeType`: Main entry point
- `concretizeGenericInstantiation`: Handles generic instantiations like `List<T>`
- `ConcretizationContext`: Tracks state during concretization
- **IlMachineState.fs**:
- `concretizeMethodForExecution`: Prepares methods for execution
- `concretizeFieldForExecution`: Prepares fields for access
- Manages the flow of generic contexts through execution
- **Assembly.fs**:
- `resolveTypeRef`: Resolves type references across assemblies
- `resolveTypeFromName`: Handles type forwarding and exported types
- `resolveTypeFromExport`: Follows type forwarding chains
### Debugging Type Concretization Issues
When encountering errors:
1. Check the generic context (method name, generic parameters)
2. Verify the assembly context being used
3. Identify the TypeDefn variant being concretized
4. Add logging to see generic contexts: `failwithf "Failed to concretize: %A" typeDefn`
5. Check if you're in a generic method calling another generic method
6. Verify TypeRefs are being resolved in the correct assembly
## Common Type System Patterns
### Creating TypeDefn from Type Metadata
When you need to create a `TypeDefn` from type metadata (e.g., from a `TypeInfo`), there's a common pattern that involves:
1. Resolving the base type to determine `SignatureTypeKind`
2. Creating the base `TypeDefn.FromDefinition`
3. For generic types, creating a `GenericInstantiation` with type parameters
This pattern is implemented in `UnaryMetadataIlOp.lookupTypeDefn`. Example usage:
```fsharp
let state, typeDefn =
UnaryMetadataIlOp.lookupTypeDefn
baseClassTypes
state
activeAssembly
typeDefHandle
```
### Field Signature Comparison in Generic Contexts
When comparing field signatures in generic contexts (e.g., when resolving member references), signatures must be concretized before comparison. This ensures generic type parameters are properly substituted:
```fsharp
// Concretize both signatures before comparing
let state, concreteFieldSig = concretizeType ... fieldSig
let state, fieldSigConcrete = concretizeType ... fi.Signature
if fieldSigConcrete = concreteFieldSig then ...
```
### Static vs Instance Fields
When constructing objects with `Newobj`:
- Only instance fields should be included in the object
- Static fields belong to the type, not instances
- Filter using: `field.Attributes.HasFlag FieldAttributes.Static`
Example:
```fsharp
let instanceFields =
ctorType.Fields
|> List.filter (fun field -> not (field.Attributes.HasFlag FieldAttributes.Static))
```

5
CSharpExample/CSharpExample.csproj
View File

@@ -6,11 +6,6 @@
<AllowUnsafeBlocks>true</AllowUnsafeBlocks>
<WarningsAsErrors>false</WarningsAsErrors>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
<EnableDefaultItems>false</EnableDefaultItems>
</PropertyGroup>
<ItemGroup>
<Compile Include="Class1.cs" />
</ItemGroup>
</Project>

340
WoofWare.PawPrint.Domain/Assembly.fs
View File

@@ -45,7 +45,10 @@ type DumpedAssembly =
/// Dictionary of all type definitions in this assembly, keyed by their handle.
/// </summary>
TypeDefs :
IReadOnlyDictionary<TypeDefinitionHandle, WoofWare.PawPrint.TypeInfo<GenericParamFromMetadata, TypeDefn>>
IReadOnlyDictionary<
TypeDefinitionHandle,
WoofWare.PawPrint.TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
>
/// <summary>
/// Dictionary of all type references in this assembly, keyed by their handle.
@@ -64,7 +67,7 @@ type DumpedAssembly =
Methods :
IReadOnlyDictionary<
MethodDefinitionHandle,
WoofWare.PawPrint.MethodInfo<GenericParamFromMetadata, GenericParamFromMetadata, TypeDefn>
WoofWare.PawPrint.MethodInfo<FakeUnit, WoofWare.PawPrint.GenericParameter, TypeDefn>
>
/// <summary>
@@ -76,7 +79,7 @@ type DumpedAssembly =
/// Dictionary of all field definitions in this assembly, keyed by their handle.
/// </summary>
Fields :
IReadOnlyDictionary<FieldDefinitionHandle, WoofWare.PawPrint.FieldInfo<GenericParamFromMetadata, TypeDefn>>
IReadOnlyDictionary<FieldDefinitionHandle, WoofWare.PawPrint.FieldInfo<FakeUnit, WoofWare.PawPrint.TypeDefn>>
/// <summary>
/// The entry point method of the assembly, if one exists.
@@ -144,7 +147,10 @@ type DumpedAssembly =
/// Internal lookup for type definitions by namespace and name.
/// </summary>
_TypeDefsLookup :
ImmutableDictionary<string * string, WoofWare.PawPrint.TypeInfo<GenericParamFromMetadata, TypeDefn>>
ImmutableDictionary<
string * string,
WoofWare.PawPrint.TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
>
}
static member internal BuildExportedTypesLookup
@@ -200,7 +206,7 @@ type DumpedAssembly =
static member internal BuildTypeDefsLookup
(logger : ILogger)
(name : AssemblyName)
(typeDefs : WoofWare.PawPrint.TypeInfo<GenericParamFromMetadata, TypeDefn> seq)
(typeDefs : WoofWare.PawPrint.TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn> seq)
=
let result = ImmutableDictionary.CreateBuilder ()
let keys = HashSet ()
@@ -231,7 +237,7 @@ type DumpedAssembly =
member this.TypeDef
(``namespace`` : string)
(name : string)
: WoofWare.PawPrint.TypeInfo<GenericParamFromMetadata, TypeDefn> option
: WoofWare.PawPrint.TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn> option
=
match this._TypeDefsLookup.TryGetValue ((``namespace``, name)) with
| false, _ -> None
@@ -246,15 +252,14 @@ type DumpedAssembly =
member this.Dispose () = this.PeReader.Dispose ()
type TypeResolutionResult =
type TypeResolutionResult<'generic> =
| FirstLoadAssy of WoofWare.PawPrint.AssemblyReference
| Resolved of DumpedAssembly * TypeInfo<TypeDefn, TypeDefn>
| Resolved of DumpedAssembly * TypeInfo<'generic, WoofWare.PawPrint.TypeDefn>
override this.ToString () : string =
match this with
| TypeResolutionResult.FirstLoadAssy a -> $"FirstLoadAssy(%s{a.Name.FullName})"
| TypeResolutionResult.Resolved (assy, ty) ->
$"Resolved(%s{assy.Name.FullName}: {string<TypeInfo<TypeDefn, TypeDefn>> ty})"
| TypeResolutionResult.Resolved (assy, ty) -> $"Resolved(%s{assy.Name.FullName}: {ty})"
[<RequireQualifiedAccess>]
module Assembly =
@@ -424,53 +429,44 @@ module Assembly =
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
(referencedInAssembly : DumpedAssembly)
(target : TypeRef)
(genericArgs : ImmutableArray<TypeDefn>)
: TypeResolutionResult
(genericArgs : ImmutableArray<'generic>)
: TypeResolutionResult<'generic>
=
match target.ResolutionScope with
| TypeRefResolutionScope.Assembly r ->
match referencedInAssembly.AssemblyReferences.TryGetValue r with
| false, _ ->
failwithf
"AssemblyReferenceHandle %A not found in assembly %s. Available references: %A"
r
referencedInAssembly.Name.FullName
(referencedInAssembly.AssemblyReferences.Keys |> Seq.toList)
| true, assemblyRef ->
let assemblyRef = referencedInAssembly.AssemblyReferences.[r]
let assemblyName = assemblyRef.Name
match assemblies.TryGetValue assemblyName.FullName with
| false, _ -> TypeResolutionResult.FirstLoadAssy assemblyRef
| true, assy ->
let nsPath = target.Namespace.Split '.' |> Array.toList
let nsPath = target.Namespace.Split '.' |> Array.toList
let targetNs = assy.NonRootNamespaces.[nsPath]
let targetNs = assy.NonRootNamespaces.[nsPath]
let targetType =
targetNs.TypeDefinitions
|> Seq.choose (fun td ->
let ty = assy.TypeDefs.[td]
let targetType =
targetNs.TypeDefinitions
|> Seq.choose (fun td ->
let ty = assy.TypeDefs.[td]
if ty.Name = target.Name && ty.Namespace = target.Namespace then
Some ty
else
None
)
|> Seq.toList
if ty.Name = target.Name && ty.Namespace = target.Namespace then
Some ty
else
None
)
|> Seq.toList
match targetType with
| [ t ] ->
let t =
t |> TypeInfo.mapGeneric (fun (param, md) -> genericArgs.[param.SequenceNumber])
match targetType with
| [ t ] ->
let t = t |> TypeInfo.mapGeneric (fun _ param -> genericArgs.[param.SequenceNumber])
TypeResolutionResult.Resolved (assy, t)
| _ :: _ :: _ -> failwith $"Multiple matching type definitions! {nsPath} {target.Name}"
| [] ->
match assy.ExportedType (Some target.Namespace) target.Name with
| None -> failwith $"Failed to find type {nsPath} {target.Name} in {assy.Name.FullName}!"
| Some ty -> resolveTypeFromExport assy assemblies ty genericArgs
TypeResolutionResult.Resolved (assy, t)
| _ :: _ :: _ -> failwith $"Multiple matching type definitions! {nsPath} {target.Name}"
| [] ->
match assy.ExportedType (Some target.Namespace) target.Name with
| None -> failwith $"Failed to find type {nsPath} {target.Name} in {assy.Name.FullName}!"
| Some ty -> resolveTypeFromExport assy assemblies ty genericArgs
| k -> failwith $"Unexpected: {k}"
and resolveTypeFromName
@@ -478,8 +474,8 @@ module Assembly =
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
(ns : string option)
(name : string)
(genericArgs : ImmutableArray<TypeDefn>)
: TypeResolutionResult
(genericArgs : ImmutableArray<'generic>)
: TypeResolutionResult<'generic>
=
match ns with
| None -> failwith "what are the semantics here"
@@ -489,7 +485,7 @@ module Assembly =
| Some typeDef ->
let typeDef =
typeDef
|> TypeInfo.mapGeneric (fun (param, md) -> genericArgs.[param.SequenceNumber])
|> TypeInfo.mapGeneric (fun _ param -> genericArgs.[param.SequenceNumber])
TypeResolutionResult.Resolved (assy, typeDef)
| None ->
@@ -506,8 +502,8 @@ module Assembly =
(fromAssembly : DumpedAssembly)
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
(ty : WoofWare.PawPrint.ExportedType)
(genericArgs : ImmutableArray<TypeDefn>)
: TypeResolutionResult
(genericArgs : ImmutableArray<'generic>)
: TypeResolutionResult<'generic>
=
match ty.Data with
| NonForwarded _ -> failwith "Somehow didn't find type definition but it is exported"
@@ -532,7 +528,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 assy.TypeRefs.[r] ImmutableArray<unit>.Empty with
| TypeResolutionResult.FirstLoadAssy _ ->
failwith
"seems pretty unlikely that we could have constructed this object without loading its base type"
@@ -560,3 +556,249 @@ module DumpedAssembly =
| None -> ResolvedBaseType.Object
go source baseTypeInfo
// TODO: this is in totally the wrong place, it was just convenient to put it here
/// Returns a mapping whose keys are assembly full name * type definition.
let concretiseType
(mapping : AllConcreteTypes)
(baseTypes : BaseClassTypes<'corelib>)
(getCorelibAssembly : 'corelib -> AssemblyName)
(getTypeInfo :
ComparableTypeDefinitionHandle
-> AssemblyName
-> TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>)
(resolveTypeRef : TypeRef -> TypeResolutionResult<'a>)
(typeGenerics : (AssemblyName * TypeDefn) ImmutableArray)
(methodGenerics : (AssemblyName * TypeDefn) ImmutableArray)
(defn : AssemblyName * TypeDefn)
: Map<string * TypeDefn, ConcreteTypeHandle> * AllConcreteTypes
=
// Track types currently being processed to detect cycles
let rec concretiseTypeRec
(inProgress : Map<string * TypeDefn, ConcreteTypeHandle>)
(newlyCreated : Map<string * TypeDefn, ConcreteTypeHandle>)
(mapping : AllConcreteTypes)
(assy : AssemblyName)
(typeDefn : TypeDefn)
: ConcreteTypeHandle * Map<string * TypeDefn, ConcreteTypeHandle> * AllConcreteTypes
=
// First check if we're already processing this type (cycle)
match inProgress |> Map.tryFind (assy.FullName, typeDefn) with
| Some handle -> handle, newlyCreated, mapping
| None ->
// Check if already concretised in this session
match newlyCreated |> Map.tryFind (assy.FullName, typeDefn) with
| Some handle -> handle, newlyCreated, mapping
| None ->
match typeDefn with
| PrimitiveType primitiveType ->
let typeInfo =
match primitiveType with
| PrimitiveType.Boolean -> baseTypes.Boolean
| PrimitiveType.Char -> baseTypes.Char
| PrimitiveType.SByte -> baseTypes.SByte
| PrimitiveType.Byte -> baseTypes.Byte
| PrimitiveType.Int16 -> baseTypes.Int16
| PrimitiveType.UInt16 -> baseTypes.UInt16
| PrimitiveType.Int32 -> baseTypes.Int32
| PrimitiveType.UInt32 -> baseTypes.UInt32
| PrimitiveType.Int64 -> baseTypes.Int64
| PrimitiveType.UInt64 -> baseTypes.UInt64
| PrimitiveType.Single -> baseTypes.Single
| PrimitiveType.Double -> baseTypes.Double
| PrimitiveType.String -> baseTypes.String
| PrimitiveType.TypedReference -> failwith "TypedReference not supported in BaseClassTypes"
| PrimitiveType.IntPtr -> failwith "IntPtr not supported in BaseClassTypes"
| PrimitiveType.UIntPtr -> failwith "UIntPtr not supported in BaseClassTypes"
| PrimitiveType.Object -> baseTypes.Object
let cth, concreteType, mapping =
ConcreteType.make
mapping
typeInfo.Assembly
typeInfo.Namespace
typeInfo.Name
typeInfo.TypeDefHandle
[]
let handle, mapping = mapping |> AllConcreteTypes.add concreteType
handle,
newlyCreated
|> Map.add ((getCorelibAssembly baseTypes.Corelib).FullName, typeDefn) handle,
mapping
| Void -> failwith "Void is not a real type and cannot be concretised"
| Array (elt, shape) ->
let eltHandle, newlyCreated, mapping =
concretiseTypeRec inProgress newlyCreated mapping elt
let arrayTypeInfo = baseTypes.Array
let cth, concreteType, mapping =
ConcreteType.make
mapping
arrayTypeInfo.Assembly
arrayTypeInfo.Namespace
arrayTypeInfo.Name
arrayTypeInfo.TypeDefHandle
[ eltHandle ]
let handle, mapping = mapping |> AllConcreteTypes.add concreteType
handle, newlyCreated |> Map.add typeDefn handle, mapping
| OneDimensionalArrayLowerBoundZero elements ->
let eltHandle, newlyCreated, mapping =
concretiseTypeRec inProgress newlyCreated mapping elements
let arrayTypeInfo = baseTypes.Array
let cth, concreteType, mapping =
ConcreteType.make
mapping
arrayTypeInfo.Assembly
arrayTypeInfo.Namespace
arrayTypeInfo.Name
arrayTypeInfo.TypeDefHandle
[ eltHandle ]
let handle, mapping = mapping |> AllConcreteTypes.add concreteType
handle,
newlyCreated
|> Map.add ((getCorelibAssembly baseTypes.Corelib).FullName, typeDefn) handle,
mapping
| Pointer inner -> failwith "Pointer types require special handling - no TypeDefinition available"
| Byref inner -> failwith "Byref types require special handling - no TypeDefinition available"
| Pinned inner -> failwith "Pinned types require special handling - no TypeDefinition available"
| GenericTypeParameter index ->
if index < typeGenerics.Length then
concretiseTypeRec inProgress newlyCreated mapping typeGenerics.[index]
else
failwithf "Generic type parameter index %d out of range" index
| GenericMethodParameter index ->
if index < methodGenerics.Length then
concretiseTypeRec inProgress newlyCreated mapping methodGenerics.[index]
else
failwithf "Generic method parameter index %d out of range" index
| FromDefinition (typeDefHandle, assemblyFullName, _) ->
let assemblyName = AssemblyName assemblyFullName
let typeInfo = getTypeInfo typeDefHandle assemblyName
let cth, concreteType, mapping =
ConcreteType.make mapping assemblyName typeInfo.Namespace typeInfo.Name typeDefHandle.Get []
let handle, mapping = mapping |> AllConcreteTypes.add concreteType
handle, newlyCreated |> Map.add (assemblyFullName, typeDefn) handle, mapping
| FromReference (typeRef, sigKind) ->
match resolveTypeRef typeRef with
| TypeResolutionResult.FirstLoadAssy assy -> failwith "TODO"
| TypeResolutionResult.Resolved (resolvedAssy, typeInfo) ->
let cth, concreteType, mapping =
ConcreteType.make
mapping
resolvedAssy.Name
typeInfo.Namespace
typeInfo.Name
typeInfo.TypeDefHandle
[]
let handle, mapping = mapping |> AllConcreteTypes.add concreteType
handle, newlyCreated |> Map.add typeDefn handle, mapping
| GenericInstantiation (genericDef, args) ->
// This is the tricky case - we might have self-reference
// First, allocate a handle for this type
let tempHandle = ConcreteTypeHandle mapping.NextHandle
let mapping =
{ mapping with
NextHandle = mapping.NextHandle + 1
}
let inProgress = inProgress |> Map.add typeDefn tempHandle
// Concretise all type arguments first
let rec concretiseArgs
(acc : ConcreteTypeHandle list)
(newlyCreated : Map<TypeDefn, ConcreteTypeHandle>)
(mapping : AllConcreteTypes)
(args : TypeDefn list)
: ConcreteTypeHandle list * Map<TypeDefn, ConcreteTypeHandle> * AllConcreteTypes
=
match args with
| [] -> List.rev acc, newlyCreated, mapping
| arg :: rest ->
let argHandle, newlyCreated, mapping =
concretiseTypeRec inProgress newlyCreated mapping arg
concretiseArgs (argHandle :: acc) newlyCreated mapping rest
let argHandles, newlyCreated, mapping =
concretiseArgs [] newlyCreated mapping (args |> Seq.toList)
// Now extract the definition from the generic def
match genericDef with
| FromDefinition (typeDefHandle, assemblyFullName, _) ->
let assemblyName = AssemblyName (assemblyFullName)
let typeInfo = getTypeInfo typeDefHandle assemblyName
let cth, concreteType, mapping =
ConcreteType.make
mapping
assemblyName
typeInfo.Namespace
typeInfo.Name
typeDefHandle.Get
argHandles
// Update the pre-allocated entry
let mapping =
{ mapping with
Mapping = mapping.Mapping |> Map.add tempHandle concreteType
}
tempHandle, newlyCreated |> Map.add typeDefn tempHandle, mapping
| FromReference (typeRef, _) ->
match resolveTypeRef typeRef with
| TypeResolutionResult.FirstLoadAssy _ -> failwith "TODO"
| TypeResolutionResult.Resolved (resolvedAssy, typeInfo) ->
let cth, concreteType, mapping =
ConcreteType.make
mapping
resolvedAssy.Name
typeInfo.Namespace
typeInfo.Name
typeInfo.TypeDefHandle
argHandles
let mapping =
{ mapping with
Mapping = mapping.Mapping |> Map.add tempHandle concreteType
}
tempHandle, newlyCreated |> Map.add typeDefn tempHandle, mapping
| _ -> failwithf "Generic instantiation of non-definition type: %A" genericDef
| Modified (original, afterMod, required) ->
failwith "Modified types require special handling - not yet implemented"
| FunctionPointer _ -> failwith "Function pointer concretisation not implemented"
let _, newlyCreated, finalMapping =
concretiseTypeRec Map.empty Map.empty mapping (fst defn) (snd defn)
newlyCreated, finalMapping

37
WoofWare.PawPrint.Domain/ComparableFieldDefinitionHandle.fs
View File

@@ -1,37 +0,0 @@
namespace WoofWare.PawPrint
open System
open System.Reflection.Metadata
[<CustomEquality>]
[<CustomComparison>]
type ComparableFieldDefinitionHandle =
private
{
_Inner : FieldDefinitionHandle
}
override this.Equals other =
match other with
| :? ComparableFieldDefinitionHandle as other -> this._Inner.GetHashCode () = other._Inner.GetHashCode ()
| _ -> false
override this.GetHashCode () : int = this._Inner.GetHashCode ()
interface IComparable<ComparableFieldDefinitionHandle> with
member this.CompareTo (other : ComparableFieldDefinitionHandle) : int =
this._Inner.GetHashCode().CompareTo (other._Inner.GetHashCode ())
interface IComparable with
member this.CompareTo (other : obj) : int =
match other with
| :? ComparableFieldDefinitionHandle as other ->
(this :> IComparable<ComparableFieldDefinitionHandle>).CompareTo other
| _ -> failwith "invalid comparison"
static member Make (h : FieldDefinitionHandle) =
{
_Inner = h
}
member this.Get = this._Inner

117
WoofWare.PawPrint.Domain/ConcreteType.fs
View File

@@ -1,6 +1,6 @@
namespace WoofWare.PawPrint
open System.Collections.Immutable
open System
open System.Reflection
open System.Reflection.Metadata
@@ -16,26 +16,20 @@ module FakeUnit =
/// A type which has been concretised, runtime-representable, etc.
[<CustomEquality>]
[<NoComparison>]
type ConcreteType<'typeGeneric> =
[<CustomComparison>]
type ConcreteType<'typeGeneric when 'typeGeneric : comparison and 'typeGeneric :> IComparable<'typeGeneric>> =
private
{
/// Do not use this, because it's intended to be private; use the accessor `.Assembly : AssemblyName`
/// instead.
_AssemblyName : AssemblyName
/// Do not use this, because it's intended to be private; use the accessor `.Definition` instead.
_Definition : ComparableTypeDefinitionHandle
/// Do not use this, because it's intended to be private; use the accessor `.Name` instead.
_Name : string
/// Do not use this, because it's intended to be private; use the accessor `.Namespace` instead.
_Namespace : string
/// Do not use this, because it's intended to be private; use the accessor `.Generics` instead.
_Generics : ImmutableArray<'typeGeneric>
_Name : string
_Generics : 'typeGeneric list
}
member this.Assembly : AssemblyName = this._AssemblyName
member this.Definition : ComparableTypeDefinitionHandle = this._Definition
member this.Generics : ImmutableArray<'typeGeneric> = this._Generics
member this.Generics : 'typeGeneric list = this._Generics
member this.Name = this._Name
member this.Namespace = this._Namespace
@@ -50,31 +44,116 @@ type ConcreteType<'typeGeneric> =
override this.GetHashCode () : int =
hash (this._AssemblyName.FullName, this._Definition, this._Generics)
interface IComparable<ConcreteType<'typeGeneric>> with
member this.CompareTo (other : ConcreteType<'typeGeneric>) : int =
let comp = this._AssemblyName.FullName.CompareTo other._AssemblyName.FullName
if comp = 0 then
let comp =
(this._Definition :> IComparable<ComparableTypeDefinitionHandle>).CompareTo other._Definition
if comp = 0 then
let thisGen = (this._Generics : 'typeGeneric list) :> IComparable<'typeGeneric list>
thisGen.CompareTo other._Generics
else
comp
else
comp
interface IComparable with
member this.CompareTo other =
match other with
| :? ConcreteType<'typeGeneric> as other ->
(this :> IComparable<ConcreteType<'typeGeneric>>).CompareTo other
| _ -> failwith "bad comparison"
/// Because a runtime type may depend on itself by some chain of generics, we need to break the indirection;
/// we do so by storing all concrete types in some global mapping and then referring to them only by handle.
type ConcreteTypeHandle = | ConcreteTypeHandle of int
type AllConcreteTypes =
{
Mapping : Map<ConcreteTypeHandle, ConcreteType<ConcreteTypeHandle>>
NextHandle : int
}
static member Empty =
{
Mapping = Map.empty
NextHandle = 0
}
[<RequireQualifiedAccess>]
module AllConcreteTypes =
let lookup (cth : ConcreteTypeHandle) (this : AllConcreteTypes) : ConcreteType<ConcreteTypeHandle> option =
this.Mapping |> Map.tryFind cth
let lookup' (ct : ConcreteType<ConcreteTypeHandle>) (this : AllConcreteTypes) : ConcreteTypeHandle option =
failwith "TODO"
/// `source` is AssemblyName * Namespace * Name
let add (ct : ConcreteType<ConcreteTypeHandle>) (this : AllConcreteTypes) : ConcreteTypeHandle * AllConcreteTypes =
let toRet = ConcreteTypeHandle this.NextHandle
let newState =
{
NextHandle = this.NextHandle + 1
Mapping = this.Mapping |> Map.add toRet ct
}
toRet, newState
[<RequireQualifiedAccess>]
module ConcreteType =
let make
(mapping : AllConcreteTypes)
(assemblyName : AssemblyName)
(ns : string)
(name : string)
(defn : TypeDefinitionHandle)
(generics : ConcreteTypeHandle list)
: ConcreteTypeHandle * ConcreteType<_> * AllConcreteTypes
=
let toAdd =
{
_AssemblyName = assemblyName
_Definition = ComparableTypeDefinitionHandle.Make defn
_Name = name
_Namespace = ns
_Generics = generics
}
let added, mapping = AllConcreteTypes.add toAdd mapping
added, toAdd, mapping
let make'
(assemblyName : AssemblyName)
(defn : TypeDefinitionHandle)
(ns : string)
(name : string)
(genericParam : ImmutableArray<GenericParamFromMetadata>)
: ConcreteType<GenericParamFromMetadata>
(genericParamCount : int)
: ConcreteType<FakeUnit>
=
{
_AssemblyName = assemblyName
_Definition = ComparableTypeDefinitionHandle.Make defn
_Name = name
_Namespace = ns
_Generics = genericParam
_Name = name
_Generics = List.replicate genericParamCount FakeUnit.FakeUnit
}
let mapGeneric<'a, 'b> (f : int -> 'a -> 'b) (x : ConcreteType<'a>) : ConcreteType<'b> =
let generics = x._Generics |> Seq.mapi f |> ImmutableArray.CreateRange
let mapGeneric<'a, 'b
when 'a : comparison and 'a :> IComparable<'a> and 'b : equality and 'b : comparison and 'b :> IComparable<'b>>
(f : int -> 'a -> 'b)
(x : ConcreteType<'a>)
: ConcreteType<'b>
=
let generics = x._Generics |> List.mapi f
{
_AssemblyName = x._AssemblyName
_Definition = x._Definition
_Generics = generics
_Name = x._Name
_Namespace = x._Namespace
_Name = x._Name
}

46
WoofWare.PawPrint.Domain/FieldInfo.fs
View File

@@ -1,5 +1,6 @@
namespace WoofWare.PawPrint
open System
open System.Reflection
open System.Reflection.Metadata
@@ -7,7 +8,7 @@ open System.Reflection.Metadata
/// Represents detailed information about a field in a .NET assembly.
/// This is a strongly-typed representation of FieldDefinition from System.Reflection.Metadata.
/// </summary>
type FieldInfo<'typeGeneric, 'fieldGeneric> =
type FieldInfo<'typeGeneric, 'sigGeneric when 'typeGeneric : comparison and 'typeGeneric :> IComparable<'typeGeneric>> =
{
/// <summary>
/// The metadata token handle that uniquely identifies this field in the assembly.
@@ -25,7 +26,7 @@ type FieldInfo<'typeGeneric, 'fieldGeneric> =
/// <summary>
/// The type of the field.
/// </summary>
Signature : 'fieldGeneric
Signature : 'sigGeneric
/// <summary>
/// The attributes applied to this field, including visibility, static/instance,
@@ -34,8 +35,6 @@ type FieldInfo<'typeGeneric, 'fieldGeneric> =
Attributes : FieldAttributes
}
member this.HasFieldRVA = this.Attributes.HasFlag FieldAttributes.HasFieldRVA
override this.ToString () : string =
$"%s{this.DeclaringType.Assembly.Name}.{this.DeclaringType.Name}.%s{this.Name}"
@@ -46,22 +45,18 @@ module FieldInfo =
(assembly : AssemblyName)
(handle : FieldDefinitionHandle)
(def : FieldDefinition)
: FieldInfo<GenericParamFromMetadata, TypeDefn>
: FieldInfo<FakeUnit, TypeDefn>
=
let name = mr.GetString def.Name
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 = mr.GetTypeDefinition(declaringType).GetGenericParameters().Count
let decType = mr.GetTypeDefinition (declaringType)
let declaringTypeNamespace = mr.GetString decType.Namespace
let declaringTypeName = mr.GetString decType.Name
let declaringType =
ConcreteType.make assembly declaringType declaringTypeNamespace declaringTypeName typeGenerics
ConcreteType.make' assembly declaringType declaringTypeNamespace declaringTypeName typeGenerics
{
Name = name
@@ -71,7 +66,12 @@ module FieldInfo =
Attributes = def.Attributes
}
let mapTypeGenerics<'a, 'b, 'field> (f : int -> 'a -> 'b) (input : FieldInfo<'a, 'field>) : FieldInfo<'b, 'field> =
let mapTypeGenerics<'a, 'b, 'sigGen
when 'a :> IComparable<'a> and 'a : comparison and 'b :> IComparable<'b> and 'b : comparison>
(f : int -> 'a -> 'b)
(input : FieldInfo<'a, 'sigGen>)
: FieldInfo<'b, 'sigGen>
=
let declaringType = input.DeclaringType |> ConcreteType.mapGeneric f
{
@@ -80,5 +80,23 @@ module FieldInfo =
DeclaringType = declaringType
Signature = input.Signature
Attributes = input.Attributes
}
let mapSigGenerics<'a, 'b, 'state, 'typeGen when 'typeGen :> IComparable<'typeGen> and 'typeGen : comparison>
(state : 'state)
(f : 'state -> 'a -> 'state * 'b)
(input : FieldInfo<'typeGen, 'a>)
: FieldInfo<'typeGen, 'b> * 'state
=
let state, signature = f state input.Signature
let ret =
{
Handle = input.Handle
Name = input.Name
DeclaringType = input.DeclaringType
Signature = signature
Attributes = input.Attributes
}
ret, state

85
WoofWare.PawPrint.Domain/GenericParameter.fs
View File

@@ -1,85 +0,0 @@
namespace WoofWare.PawPrint
open System.Collections.Immutable
open System.Reflection
open System.Reflection.Metadata
type GenericVariance =
| Covariant
| Contravariant
type GenericConstraint =
| Reference
| NonNullableValue
type GenericParamMetadata =
{
Variance : GenericVariance option
Constraint : GenericConstraint option
RequiresParameterlessConstructor : bool
}
/// <summary>
/// Represents a generic type or method parameter definition.
/// Corresponds to GenericParameter in System.Reflection.Metadata.
/// </summary>
type GenericParameter =
{
/// <summary>The name of the generic parameter (e.g., 'T', 'TKey', etc.).</summary>
Name : string
/// <summary>
/// The zero-based index of the generic parameter in the generic parameter list.
/// For example, in Dictionary&lt;TKey, TValue&rt;, TKey has index 0 and TValue has index 1.
/// </summary>
SequenceNumber : int
}
type GenericParamFromMetadata = GenericParameter * GenericParamMetadata
[<RequireQualifiedAccess>]
module GenericParameter =
let readAll
(metadata : MetadataReader)
(param : GenericParameterHandleCollection)
: GenericParamFromMetadata ImmutableArray
=
param
|> Seq.map (fun param ->
let param = metadata.GetGenericParameter param
let requiresParamlessCons =
param.Attributes.HasFlag GenericParameterAttributes.DefaultConstructorConstraint
let constr =
if param.Attributes.HasFlag GenericParameterAttributes.NotNullableValueTypeConstraint then
Some GenericConstraint.NonNullableValue
elif param.Attributes.HasFlag GenericParameterAttributes.ReferenceTypeConstraint then
Some GenericConstraint.Reference
else
None
let variance =
if param.Attributes.HasFlag GenericParameterAttributes.Contravariant then
Some GenericVariance.Contravariant
elif param.Attributes.HasFlag GenericParameterAttributes.Covariant then
Some GenericVariance.Covariant
else
None
let md =
{
Variance = variance
Constraint = constr
RequiresParameterlessConstructor = requiresParamlessCons
}
let p =
{
Name = metadata.GetString param.Name
SequenceNumber = param.Index
}
p, md
)
|> ImmutableArray.CreateRange

3
WoofWare.PawPrint.Domain/IlOp.fs
View File

@@ -78,9 +78,6 @@ type NullaryIlOp =
| Not
| Shr
| Shr_un
/// Shifts an integer value to the left (in zeroes) by a specified number of bits, pushing the result onto the evaluation stack.
/// Top of stack is number of bits to be shifted.
/// Inserts a zero bit in the lowest positions.
| Shl
| Conv_ovf_i
| Conv_ovf_u

22
WoofWare.PawPrint.Domain/ImmutableArray.fs
View File

@@ -1,22 +0,0 @@
namespace WoofWare.PawPrint
open System.Collections.Immutable
[<RequireQualifiedAccess>]
module internal ImmutableArray =
let inline map ([<InlineIfLambda>] f : 'a -> 'b) (arr : ImmutableArray<'a>) : ImmutableArray<'b> =
let b = ImmutableArray.CreateBuilder ()
for i in arr do
b.Add (f i)
b.ToImmutable ()
let inline mapi ([<InlineIfLambda>] f : int -> 'a -> 'b) (arr : ImmutableArray<'a>) : ImmutableArray<'b> =
let b = ImmutableArray.CreateBuilder ()
for i = 0 to arr.Length - 1 do
b.Add (f i arr.[i])
b.ToImmutable ()

204
WoofWare.PawPrint.Domain/MethodInfo.fs
View File

@@ -52,6 +52,40 @@ module Parameter =
result.ToImmutable ()
/// <summary>
/// Represents a generic type or method parameter definition.
/// Corresponds to GenericParameter in System.Reflection.Metadata.
/// </summary>
type GenericParameter =
{
/// <summary>The name of the generic parameter (e.g., 'T', 'TKey', etc.).</summary>
Name : string
/// <summary>
/// The zero-based index of the generic parameter in the generic parameter list.
/// For example, in Dictionary&lt;TKey, TValue&rt;, TKey has index 0 and TValue has index 1.
/// </summary>
SequenceNumber : int
}
[<RequireQualifiedAccess>]
module GenericParameter =
let readAll
(metadata : MetadataReader)
(param : GenericParameterHandleCollection)
: GenericParameter ImmutableArray
=
param
|> Seq.map (fun param ->
let param = metadata.GetGenericParameter param
{
Name = metadata.GetString param.Name
SequenceNumber = param.Index
}
)
|> ImmutableArray.CreateRange
type ExceptionOffset =
{
TryLength : int
@@ -83,7 +117,7 @@ type ExceptionRegion =
| ExceptionRegionKind.Fault -> ExceptionRegion.Fault offset
| _ -> raise (ArgumentOutOfRangeException ())
type MethodInstructions<'methodVars> =
type MethodInstructions<'methodVar> =
{
/// <summary>
/// The IL instructions that compose the method body, along with their offset positions.
@@ -103,14 +137,14 @@ type MethodInstructions<'methodVars> =
/// </summary>
LocalsInit : bool
LocalVars : ImmutableArray<'methodVars> option
LocalVars : ImmutableArray<'methodVar> option
ExceptionRegions : ImmutableArray<ExceptionRegion>
}
[<RequireQualifiedAccess>]
module MethodInstructions =
let onlyRet () : MethodInstructions<'methodVars> =
let onlyRet<'a> () : MethodInstructions<'a> =
let op = IlOp.Nullary NullaryIlOp.Ret
{
@@ -121,20 +155,43 @@ module MethodInstructions =
ExceptionRegions = ImmutableArray.Empty
}
let setLocalVars<'a, 'b> (v : ImmutableArray<'b> option) (s : MethodInstructions<'a>) : MethodInstructions<'b> =
{
Instructions = s.Instructions
Locations = s.Locations
LocalsInit = s.LocalsInit
LocalVars = v
ExceptionRegions = s.ExceptionRegions
}
let map<'a, 'b, 'state>
(state : 'state)
(f : 'state -> 'a -> 'b * 'state)
(i : MethodInstructions<'a>)
: MethodInstructions<'b> * 'state
=
let vars, state =
match i.LocalVars with
| None -> None, state
| Some v ->
let result = ImmutableArray.CreateBuilder v.Length
let mutable state = state
for i = 0 to v.Length - 1 do
let res, state' = f state v.[i]
state <- state'
result.Add res
Some (result.ToImmutable ()), state
let result =
{
Instructions = i.Instructions
Locations = i.Locations
LocalsInit = i.LocalsInit
LocalVars = vars
ExceptionRegions = i.ExceptionRegions
}
result, state
/// <summary>
/// Represents detailed information about a method in a .NET assembly.
/// This is a strongly-typed representation of MethodDefinition from System.Reflection.Metadata.
/// </summary>
type MethodInfo<'typeGenerics, 'methodGenerics, 'methodVars> =
type MethodInfo<'typeGenerics, 'methodGenerics, 'methodVars
when 'typeGenerics :> IComparable<'typeGenerics> and 'typeGenerics : comparison> =
{
/// <summary>
/// The type that declares this method, along with its assembly information.
@@ -172,7 +229,8 @@ type MethodInfo<'typeGenerics, 'methodGenerics, 'methodVars> =
Signature : TypeMethodSignature<'methodVars>
/// <summary>
/// The signature as it was read from assembly metadata.
/// The signature of the method, including return type and parameter types, as read directly from metadata
/// (not made concrete in a running instance of the program).
/// </summary>
RawSignature : TypeMethodSignature<TypeDefn>
@@ -207,12 +265,9 @@ type MethodInfo<'typeGenerics, 'methodGenerics, 'methodVars> =
member this.IsPinvokeImpl : bool =
this.MethodAttributes.HasFlag MethodAttributes.PinvokeImpl
[<RequireQualifiedAccess>]
module MethodInfo =
let isJITIntrinsic
member this.IsJITIntrinsic<'a, 'b, 'c when 'a :> IComparable<'a> and 'a : comparison>
(getMemberRefParentType : MemberReferenceHandle -> TypeRef)
(methodDefs : IReadOnlyDictionary<MethodDefinitionHandle, MethodInfo<'a, 'b, 'c>>)
(this : MethodInfo<'d, 'e, 'f>)
: bool
=
this.CustomAttributes
@@ -232,68 +287,82 @@ module MethodInfo =
| con -> failwith $"TODO: {con}"
)
let mapTypeGenerics<'a, 'b, 'methodGen, 'vars>
(f : 'a -> 'b)
(m : MethodInfo<'a, 'methodGen, 'vars>)
: MethodInfo<'b, 'methodGen, 'vars>
=
{
DeclaringType = m.DeclaringType |> ConcreteType.mapGeneric (fun _ -> f)
Handle = m.Handle
Name = m.Name
Instructions = m.Instructions
Parameters = m.Parameters
Generics = m.Generics
Signature = m.Signature
RawSignature = m.RawSignature
CustomAttributes = m.CustomAttributes
MethodAttributes = m.MethodAttributes
ImplAttributes = m.ImplAttributes
IsStatic = m.IsStatic
}
let mapMethodGenerics<'a, 'b, 'vars, 'typeGen>
[<RequireQualifiedAccess>]
module MethodInfo =
let mapTypeGenerics<'a, 'b, 'methodGen, 'methodVars
when 'a :> IComparable<'a> and 'a : comparison and 'b : comparison and 'b :> IComparable<'b>>
(f : int -> 'a -> 'b)
(m : MethodInfo<'typeGen, 'a, 'vars>)
: MethodInfo<'typeGen, 'b, 'vars>
(m : MethodInfo<'a, 'methodGen, 'methodVars>)
: MethodInfo<'b, 'methodGen, 'methodVars>
=
let generics = m.Generics |> Seq.mapi f |> ImmutableArray.CreateRange
{
DeclaringType = m.DeclaringType |> ConcreteType.mapGeneric f
Handle = m.Handle
Name = m.Name
Instructions = m.Instructions
Parameters = m.Parameters
Generics = m.Generics
Signature = m.Signature
CustomAttributes = m.CustomAttributes
MethodAttributes = m.MethodAttributes
ImplAttributes = m.ImplAttributes
IsStatic = m.IsStatic
RawSignature = m.RawSignature
}
let mapMethodGenerics<'a, 'b, 'typeGen, 'methodVars when 'typeGen :> IComparable<'typeGen> and 'typeGen : comparison>
(f : int -> 'a -> 'b)
(m : MethodInfo<'typeGen, 'a, 'methodVars>)
: MethodInfo<'typeGen, 'b, 'methodVars>
=
{
DeclaringType = m.DeclaringType
Handle = m.Handle
Name = m.Name
Instructions = m.Instructions
Parameters = m.Parameters
Generics = generics
Generics = m.Generics |> Seq.mapi f |> ImmutableArray.CreateRange
Signature = m.Signature
RawSignature = m.RawSignature
CustomAttributes = m.CustomAttributes
MethodAttributes = m.MethodAttributes
ImplAttributes = m.ImplAttributes
IsStatic = m.IsStatic
RawSignature = m.RawSignature
}
let setMethodVars
(vars2 : MethodInstructions<'vars2> option)
(signature : TypeMethodSignature<'vars2>)
(m : MethodInfo<'typeGen, 'methodGen, 'vars1>)
: MethodInfo<'typeGen, 'methodGen, 'vars2>
let mapVarGenerics<'a, 'b, 'state, 'typeGen, 'methodGen
when 'typeGen :> IComparable<'typeGen> and 'typeGen : comparison>
(state : 'state)
(f : 'state -> 'a -> 'b * 'state)
(m : MethodInfo<'typeGen, 'methodGen, 'a>)
: MethodInfo<'typeGen, 'methodGen, 'b> * 'state
=
{
DeclaringType = m.DeclaringType
Handle = m.Handle
Name = m.Name
Instructions = vars2
Parameters = m.Parameters
Generics = m.Generics
Signature = signature
RawSignature = m.RawSignature
CustomAttributes = m.CustomAttributes
MethodAttributes = m.MethodAttributes
ImplAttributes = m.ImplAttributes
IsStatic = m.IsStatic
}
let instructions, state =
match m.Instructions with
| None -> None, state
| Some i ->
let result, state = MethodInstructions.map state f i
Some result, state
let signature, state = m.Signature |> TypeMethodSignature.map f state
let result =
{
DeclaringType = m.DeclaringType
Handle = m.Handle
Name = m.Name
Instructions = instructions
Parameters = m.Parameters
Generics = m.Generics
Signature = signature
CustomAttributes = m.CustomAttributes
MethodAttributes = m.MethodAttributes
ImplAttributes = m.ImplAttributes
IsStatic = m.IsStatic
RawSignature = m.RawSignature
}
result, state
type private Dummy = class end
@@ -642,7 +711,7 @@ module MethodInfo =
(peReader : PEReader)
(metadataReader : MetadataReader)
(methodHandle : MethodDefinitionHandle)
: MethodInfo<GenericParamFromMetadata, GenericParamFromMetadata, TypeDefn> option
: MethodInfo<FakeUnit, GenericParameter, TypeDefn> option
=
let logger = loggerFactory.CreateLogger "MethodInfo"
let assemblyName = metadataReader.GetAssemblyDefinition().GetAssemblyName ()
@@ -683,8 +752,7 @@ module MethodInfo =
let declaringTypeName = metadataReader.GetString declaringDefn.Name
let declaringTypeGenericParams =
metadataReader.GetTypeDefinition(declaringType).GetGenericParameters ()
|> GenericParameter.readAll metadataReader
metadataReader.GetTypeDefinition(declaringType).GetGenericParameters().Count
let attrs =
let result = ImmutableArray.CreateBuilder ()
@@ -705,7 +773,7 @@ module MethodInfo =
GenericParameter.readAll metadataReader (methodDef.GetGenericParameters ())
let declaringType =
ConcreteType.make
ConcreteType.make'
assemblyName
declaringType
declaringTypeNamespace
@@ -720,17 +788,17 @@ module MethodInfo =
Parameters = methodParams
Generics = methodGenericParams
Signature = typeSig
RawSignature = typeSig
MethodAttributes = methodDef.Attributes
CustomAttributes = attrs
IsStatic = not methodSig.Header.IsInstance
ImplAttributes = implAttrs
RawSignature = typeSig
}
|> Some
let rec resolveBaseType
(methodGenerics : TypeDefn ImmutableArray option)
(executingMethod : MethodInfo<TypeDefn, 'methodGen, 'vars>)
(executingMethod : MethodInfo<TypeDefn, 'methodGen, 'methodVars>)
(td : TypeDefn)
: ResolvedBaseType
=

11
WoofWare.PawPrint.Domain/MethodSpec.fs
View File

@@ -15,17 +15,6 @@ type MethodSpec =
/// </summary>
Method : MetadataToken
/// <summary>
/// The actual type arguments for generic instantiation.
/// </summary>
/// <example>
/// For <c>Volatile.Read&lt;System.IO.TextWriter&gt;</c>, the <c>Signature</c> is <c>[System.IO.TextWriter]</c>.
/// </example>
/// <remarks>
/// The contents might themselves be <c>TypeDefn.GenericMethodParameter</c>, for example.
/// This happens when the method is itself being called from within a generic method, and the generic parameters
/// of the spec are being instantiated with generic parameters from the caller.
/// </remarks>
Signature : TypeDefn ImmutableArray
}

1149
WoofWare.PawPrint.Domain/TypeConcretisation.fs
View File

File diff suppressed because it is too large Load Diff

66
WoofWare.PawPrint.Domain/TypeDefn.fs
View File

@@ -56,32 +56,32 @@ module TypeMethodSignature =
}
let map<'a, 'b, 'state>
(f : 'state -> 'a -> 'b * 'state)
(state : 'state)
(f : 'state -> 'a -> 'state * 'b)
(signature : TypeMethodSignature<'a>)
: 'state * TypeMethodSignature<'b>
(s : TypeMethodSignature<'a>)
: TypeMethodSignature<'b> * 'state
=
let state, ret = f state signature.ReturnType
let ret, state = s.ReturnType |> f state
let state, pars =
((state, []), signature.ParameterTypes)
||> List.fold (fun (state, acc) par ->
let state, result = f state par
let state, paramTypes =
((state, []), s.ParameterTypes)
||> List.fold (fun (state, acc) ty ->
let result, state = f state ty
state, result :: acc
)
let pars = List.rev pars
let paramTypes = paramTypes |> List.rev
let answer =
let result =
{
Header = signature.Header
Header = s.Header
ParameterTypes = paramTypes
GenericParameterCount = s.GenericParameterCount
RequiredParameterCount = s.RequiredParameterCount
ReturnType = ret
ParameterTypes = pars
GenericParameterCount = signature.GenericParameterCount
RequiredParameterCount = signature.RequiredParameterCount
}
state, answer
result, state
/// See I.8.2.2
type PrimitiveType =
@@ -149,28 +149,6 @@ type PrimitiveType =
| PrimitiveType.UIntPtr -> "uintptr"
| PrimitiveType.Object -> "obj"
[<RequireQualifiedAccess>]
module PrimitiveType =
let sizeOf (pt : PrimitiveType) : int =
match pt with
| PrimitiveType.Boolean -> 1
| PrimitiveType.Char -> 2
| PrimitiveType.SByte -> 1
| PrimitiveType.Byte -> 1
| PrimitiveType.Int16 -> 2
| PrimitiveType.UInt16 -> 2
| PrimitiveType.Int32 -> 4
| PrimitiveType.UInt32 -> 4
| PrimitiveType.Int64 -> 8
| PrimitiveType.UInt64 -> 8
| PrimitiveType.Single -> 4
| PrimitiveType.Double -> 8
| PrimitiveType.String -> 8
| PrimitiveType.TypedReference -> failwith "todo"
| PrimitiveType.IntPtr -> 8
| PrimitiveType.UIntPtr -> 8
| PrimitiveType.Object -> 8
type TypeDefn =
| PrimitiveType of PrimitiveType
// TODO: array shapes
@@ -184,21 +162,7 @@ type TypeDefn =
| FromDefinition of ComparableTypeDefinitionHandle * assemblyFullName : string * SignatureTypeKind
| GenericInstantiation of generic : TypeDefn * args : ImmutableArray<TypeDefn>
| FunctionPointer of TypeMethodSignature<TypeDefn>
/// <summary>
/// A class/interface generic.
/// </summary>
/// <example>
/// The type <c>List&lt;T&gt;</c> has a generic parameter; an instance method on that <c>List</c> would refer to
/// <c>T</c> as <c>GenericTypeParameter 0</c>.
/// </example>
| GenericTypeParameter of index : int
/// <summary>
/// A method generic.
/// </summary>
/// <example>
/// The method <c>List.map&lt;'a, 'b&gt;</c> takes two generic parameters; those are referred to as
/// <c>GenericMethodParameter 0</c> and <c>GenericMethodParameter 1</c> respectively.
/// </example>
| GenericMethodParameter of index : int
/// Not really a type: this indicates the *absence* of a return value.
| Void

164
WoofWare.PawPrint.Domain/TypeInfo.fs
View File

@@ -1,6 +1,5 @@
namespace WoofWare.PawPrint
open System
open System.Collections.Generic
open System.Collections.Immutable
open System.Reflection
@@ -20,15 +19,6 @@ type MethodImplParsed =
| MethodImplementation of MethodImplementationHandle
| MethodDefinition of MethodDefinitionHandle
type InterfaceImplementation =
{
/// TypeDefinition, TypeReference, or TypeSpecification
InterfaceHandle : MetadataToken
/// The assembly which InterfaceHandle is relative to
RelativeToAssembly : AssemblyName
}
/// <summary>
/// Represents detailed information about a type definition in a .NET assembly.
/// This is a strongly-typed representation of TypeDefinition from System.Reflection.Metadata.
@@ -44,7 +34,7 @@ type TypeInfo<'generic, 'fieldGeneric> =
/// <summary>
/// All methods defined within this type.
/// </summary>
Methods : WoofWare.PawPrint.MethodInfo<GenericParamFromMetadata, GenericParamFromMetadata, TypeDefn> list
Methods : WoofWare.PawPrint.MethodInfo<FakeUnit, WoofWare.PawPrint.GenericParameter, TypeDefn> list
/// <summary>
/// Method implementation mappings for this type, often used for interface implementations
@@ -55,7 +45,7 @@ type TypeInfo<'generic, 'fieldGeneric> =
/// <summary>
/// Fields defined in this type.
/// </summary>
Fields : WoofWare.PawPrint.FieldInfo<GenericParamFromMetadata, 'fieldGeneric> list
Fields : WoofWare.PawPrint.FieldInfo<FakeUnit, 'fieldGeneric> list
/// <summary>
/// The base type that this type inherits from, or None for types that don't have a base type
@@ -81,8 +71,6 @@ type TypeInfo<'generic, 'fieldGeneric> =
/// </summary>
TypeDefHandle : TypeDefinitionHandle
DeclaringType : TypeDefinitionHandle
/// <summary>
/// The assembly in which this type is defined.
/// </summary>
@@ -91,38 +79,13 @@ type TypeInfo<'generic, 'fieldGeneric> =
Generics : 'generic ImmutableArray
Events : EventDefn ImmutableArray
ImplementedInterfaces : InterfaceImplementation ImmutableArray
}
member this.IsInterface = this.TypeAttributes.HasFlag TypeAttributes.Interface
member this.IsNested =
[
TypeAttributes.NestedPublic
TypeAttributes.NestedPrivate
TypeAttributes.NestedFamily
TypeAttributes.NestedAssembly
TypeAttributes.NestedFamANDAssem
TypeAttributes.NestedFamORAssem
]
|> List.exists this.TypeAttributes.HasFlag
override this.ToString () =
$"%s{this.Assembly.Name}.%s{this.Namespace}.%s{this.Name}"
static member NominallyEqual
(a : TypeInfo<'generic, 'fieldGeneric>)
(b : TypeInfo<'generic, 'fieldGeneric>)
: bool
=
a.Assembly.FullName = b.Assembly.FullName
&& a.Namespace = b.Namespace
&& a.Name = b.Name
&& a.Generics = b.Generics
type TypeInfoEval<'ret> =
abstract Eval<'a, 'field> : TypeInfo<'a, 'field> -> 'ret
abstract Eval<'a, 'fieldGeneric> : TypeInfo<'a, 'fieldGeneric> -> 'ret
type TypeInfoCrate =
abstract Apply<'ret> : TypeInfoEval<'ret> -> 'ret
@@ -134,7 +97,7 @@ type TypeInfoCrate =
[<RequireQualifiedAccess>]
module TypeInfoCrate =
let make<'a, 'field> (t : TypeInfo<'a, 'field>) : TypeInfoCrate =
let make<'a, 'b> (t : TypeInfo<'a, 'b>) : TypeInfoCrate =
{ new TypeInfoCrate with
member _.Apply e = e.Eval t
@@ -156,48 +119,37 @@ module TypeInfoCrate =
type BaseClassTypes<'corelib> =
{
Corelib : 'corelib
String : TypeInfo<GenericParamFromMetadata, TypeDefn>
Boolean : TypeInfo<GenericParamFromMetadata, TypeDefn>
Char : TypeInfo<GenericParamFromMetadata, TypeDefn>
SByte : TypeInfo<GenericParamFromMetadata, TypeDefn>
Byte : TypeInfo<GenericParamFromMetadata, TypeDefn>
Int16 : TypeInfo<GenericParamFromMetadata, TypeDefn>
UInt16 : TypeInfo<GenericParamFromMetadata, TypeDefn>
Int32 : TypeInfo<GenericParamFromMetadata, TypeDefn>
UInt32 : TypeInfo<GenericParamFromMetadata, TypeDefn>
Int64 : TypeInfo<GenericParamFromMetadata, TypeDefn>
UInt64 : TypeInfo<GenericParamFromMetadata, TypeDefn>
Single : TypeInfo<GenericParamFromMetadata, TypeDefn>
Double : TypeInfo<GenericParamFromMetadata, TypeDefn>
Array : TypeInfo<GenericParamFromMetadata, TypeDefn>
Enum : TypeInfo<GenericParamFromMetadata, TypeDefn>
ValueType : TypeInfo<GenericParamFromMetadata, TypeDefn>
DelegateType : TypeInfo<GenericParamFromMetadata, TypeDefn>
Object : TypeInfo<GenericParamFromMetadata, TypeDefn>
RuntimeMethodHandle : TypeInfo<GenericParamFromMetadata, TypeDefn>
RuntimeFieldHandle : TypeInfo<GenericParamFromMetadata, TypeDefn>
RuntimeTypeHandle : TypeInfo<GenericParamFromMetadata, TypeDefn>
RuntimeFieldInfoStub : TypeInfo<GenericParamFromMetadata, TypeDefn>
RuntimeFieldHandleInternal : TypeInfo<GenericParamFromMetadata, TypeDefn>
RuntimeType : TypeInfo<GenericParamFromMetadata, TypeDefn>
Void : TypeInfo<GenericParamFromMetadata, TypeDefn>
TypedReference : TypeInfo<GenericParamFromMetadata, TypeDefn>
IntPtr : TypeInfo<GenericParamFromMetadata, TypeDefn>
UIntPtr : TypeInfo<GenericParamFromMetadata, TypeDefn>
String : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
Boolean : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
Char : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
SByte : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
Byte : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
Int16 : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
UInt16 : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
Int32 : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
UInt32 : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
Int64 : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
UInt64 : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
Single : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
Double : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
Array : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
Enum : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
ValueType : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
DelegateType : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
Object : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
RuntimeMethodHandle : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
RuntimeFieldHandle : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
RuntimeTypeHandle : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
RuntimeType : TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
}
[<RequireQualifiedAccess>]
module TypeInfo =
let rec fullName (get : TypeDefinitionHandle -> TypeInfo<_, _>) (ty : TypeInfo<'a, 'b>) =
if ty.IsNested then
let parent = get ty.DeclaringType |> fullName get
$"%s{parent}.{ty.Name}"
else if not (String.IsNullOrEmpty ty.Namespace) then
$"{ty.Namespace}.{ty.Name}"
else
ty.Name
let withGenerics<'a, 'b, 'field> (gen : 'b ImmutableArray) (t : TypeInfo<'a, 'field>) : TypeInfo<'b, 'field> =
let withGenerics<'a, 'b, 'fieldSig>
(gen : 'b ImmutableArray)
(t : TypeInfo<'a, 'fieldSig>)
: TypeInfo<'b, 'fieldSig>
=
{
Namespace = t.Namespace
Name = t.Name
@@ -208,15 +160,13 @@ module TypeInfo =
TypeAttributes = t.TypeAttributes
Attributes = t.Attributes
TypeDefHandle = t.TypeDefHandle
DeclaringType = t.DeclaringType
Assembly = t.Assembly
Generics = gen
Events = t.Events
ImplementedInterfaces = t.ImplementedInterfaces
}
let mapGeneric<'a, 'b, 'field> (f : 'a -> 'b) (t : TypeInfo<'a, 'field>) : TypeInfo<'b, 'field> =
withGenerics (t.Generics |> ImmutableArray.map f) t
let mapGeneric<'a, 'b, 'fieldSig> (f : int -> 'a -> 'b) (t : TypeInfo<'a, 'fieldSig>) : TypeInfo<'b, 'fieldSig> =
withGenerics (t.Generics |> Seq.mapi f |> ImmutableArray.CreateRange) t
let internal read
(loggerFactory : ILoggerFactory)
@@ -224,10 +174,9 @@ module TypeInfo =
(thisAssembly : AssemblyName)
(metadataReader : MetadataReader)
(typeHandle : TypeDefinitionHandle)
: TypeInfo<GenericParamFromMetadata, TypeDefn>
: TypeInfo<WoofWare.PawPrint.GenericParameter, WoofWare.PawPrint.TypeDefn>
=
let typeDef = metadataReader.GetTypeDefinition typeHandle
let declaringType = typeDef.GetDeclaringType ()
let methods = typeDef.GetMethods ()
let methodImpls =
@@ -294,20 +243,6 @@ module TypeInfo =
result.ToImmutable ()
let interfaces =
let result = ImmutableArray.CreateBuilder ()
for i in typeDef.GetInterfaceImplementations () do
let impl = metadataReader.GetInterfaceImplementation i
{
InterfaceHandle = MetadataToken.ofEntityHandle impl.Interface
RelativeToAssembly = thisAssembly
}
|> result.Add
result.ToImmutable ()
{
Namespace = ns
Name = name
@@ -321,8 +256,6 @@ module TypeInfo =
Assembly = thisAssembly
Generics = genericParams
Events = events
ImplementedInterfaces = interfaces
DeclaringType = declaringType
}
let isBaseType<'corelib>
@@ -346,11 +279,11 @@ module TypeInfo =
else
None
let rec resolveBaseType<'corelib, 'generic, 'field>
let rec resolveBaseType<'corelib, 'generic, 'fieldGeneric>
(baseClassTypes : BaseClassTypes<'corelib>)
(getName : 'corelib -> AssemblyName)
(getTypeDef : 'corelib -> TypeDefinitionHandle -> TypeInfo<'generic, 'field>)
(getTypeRef : 'corelib -> TypeReferenceHandle -> TypeInfo<'generic, 'field>)
(getTypeDef : 'corelib -> TypeDefinitionHandle -> TypeInfo<'generic, 'fieldGeneric>)
(getTypeRef : 'corelib -> TypeReferenceHandle -> TypeInfo<'generic, 'fieldGeneric>)
(sourceAssembly : AssemblyName)
(value : BaseTypeInfo option)
: ResolvedBaseType
@@ -380,25 +313,18 @@ module TypeInfo =
(Some (BaseTypeInfo.TypeDef typeDefinitionHandle))
let toTypeDefn
(baseClassTypes : BaseClassTypes<'corelib>)
(corelib : BaseClassTypes<'corelib>)
(getName : 'corelib -> AssemblyName)
(getTypeDef : 'corelib -> TypeDefinitionHandle -> TypeInfo<'generic, 'field>)
(getTypeRef : 'corelib -> TypeReferenceHandle -> TypeInfo<'generic, 'field>)
(ty : TypeInfo<TypeDefn, TypeDefn>)
(getTypeDef : 'corelib -> TypeDefinitionHandle -> TypeInfo<'generic, 'fieldGeneric>)
(getTypeRef : 'corelib -> TypeReferenceHandle -> TypeInfo<'generic, 'fieldGeneric>)
(ty : TypeInfo<'generic, 'fieldGeneric>)
: TypeDefn
=
let stk =
match resolveBaseType baseClassTypes getName getTypeDef getTypeRef ty.Assembly ty.BaseType with
match resolveBaseType corelib getName getTypeDef getTypeRef ty.Assembly ty.BaseType with
| ResolvedBaseType.Enum
| ResolvedBaseType.ValueType -> SignatureTypeKind.ValueType
| ResolvedBaseType.Object
| ResolvedBaseType.Delegate -> SignatureTypeKind.Class
| ResolvedBaseType.Object -> SignatureTypeKind.Class
| ResolvedBaseType.Delegate -> failwith "todo"
let defn =
TypeDefn.FromDefinition (ComparableTypeDefinitionHandle.Make ty.TypeDefHandle, ty.Assembly.FullName, stk)
if ty.Generics.IsEmpty then
defn
else
let generics = ty.Generics
TypeDefn.GenericInstantiation (defn, generics)
TypeDefn.FromDefinition (ComparableTypeDefinitionHandle.Make ty.TypeDefHandle, ty.Assembly.FullName, stk)

4
WoofWare.PawPrint.Domain/WoofWare.PawPrint.Domain.fsproj
View File

@@ -7,16 +7,13 @@
<ItemGroup>
<Compile Include="StringToken.fs" />
<Compile Include="ImmutableArray.fs" />
<Compile Include="Tokens.fs" />
<Compile Include="TypeRef.fs" />
<Compile Include="IlOp.fs" />
<Compile Include="CustomAttribute.fs" />
<Compile Include="GenericParameter.fs" />
<Compile Include="AssemblyReference.fs" />
<Compile Include="EventDefn.fs" />
<Compile Include="ComparableTypeDefinitionHandle.fs" />
<Compile Include="ComparableFieldDefinitionHandle.fs" />
<Compile Include="ComparableSignatureHeader.fs" />
<Compile Include="TypeDefn.fs" />
<Compile Include="ConcreteType.fs" />
@@ -29,7 +26,6 @@
<Compile Include="ExportedType.fs" />
<Compile Include="TypeSpec.fs" />
<Compile Include="Assembly.fs" />
<Compile Include="TypeConcretisation.fs" />
</ItemGroup>
<ItemGroup>

2
WoofWare.PawPrint.Test/LoggerFactory.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

3
WoofWare.PawPrint.Test/TestHarness.fs
View File

@@ -25,9 +25,10 @@ module MockEnv =
System_Threading_Monitor = System_Threading_MonitorMock.Empty
}
type EndToEndTestCase =
type TestCase =
{
FileName : string
ExpectedReturnCode : int
NativeImpls : NativeImpls
LocalVariablesOfMain : CliType list option
}

49
WoofWare.PawPrint.Test/TestImpureCases.fs
View File

@@ -20,10 +20,11 @@ module TestImpureCases =
FileName = "WriteLine.cs"
ExpectedReturnCode = 1
NativeImpls = NativeImpls.PassThru ()
LocalVariablesOfMain = [] |> Some
}
]
let cases : EndToEndTestCase list =
let cases : TestCase list =
[
{
FileName = "InstaQuit.cs"
@@ -46,10 +47,12 @@ module TestImpureCases =
ExecutionResult.Terminated (state, thread)
}
}
LocalVariablesOfMain = [] |> Some
}
]
let runTest (case : EndToEndTestCase) : unit =
[<TestCaseSource(nameof cases)>]
let ``Can evaluate C# files`` (case : TestCase) : unit =
let source = Assembly.getEmbeddedResourceAsString case.FileName assy
let image = Roslyn.compile [ source ]
let messages, loggerFactory = LoggerFactory.makeTest ()
@@ -72,6 +75,15 @@ module TestImpureCases =
| ret -> failwith $"expected program to return an int, but it returned %O{ret}"
exitCode |> shouldEqual case.ExpectedReturnCode
let finalVariables =
terminalState.ThreadState.[terminatingThread].MethodState.LocalVariables
|> Seq.toList
match case.LocalVariablesOfMain with
| None -> ()
| Some expected -> finalVariables |> shouldEqual expected
with _ ->
for message in messages () do
System.Console.Error.WriteLine $"{message}"
@@ -79,8 +91,33 @@ module TestImpureCases =
reraise ()
[<TestCaseSource(nameof unimplemented)>]
[<Explicit>]
let ``Can evaluate C# files, unimplemented`` (case : EndToEndTestCase) = runTest case
[<Explicit "not yet implemented">]
let ``Can evaluate C# files, unimplemented`` (case : TestCase) : unit =
let source = Assembly.getEmbeddedResourceAsString case.FileName assy
let image = Roslyn.compile [ source ]
let messages, loggerFactory = LoggerFactory.makeTest ()
[<TestCaseSource(nameof cases)>]
let ``Can evaluate C# files`` (case : EndToEndTestCase) = runTest case
let dotnetRuntimes =
DotnetRuntime.SelectForDll assy.Location |> ImmutableArray.CreateRange
use peImage = new MemoryStream (image)
try
let terminalState, terminatingThread =
Program.run loggerFactory (Some case.FileName) peImage dotnetRuntimes case.NativeImpls []
let exitCode =
match terminalState.ThreadState.[terminatingThread].MethodState.EvaluationStack.Values with
| [] -> failwith "expected program to return a value, but it returned void"
| head :: _ ->
match head with
| EvalStackValue.Int32 i -> i
| ret -> failwith $"expected program to return an int, but it returned %O{ret}"
exitCode |> shouldEqual case.ExpectedReturnCode
with _ ->
for message in messages () do
System.Console.Error.WriteLine $"{message}"
reraise ()

201
WoofWare.PawPrint.Test/TestPureCases.fs
View File

@@ -16,84 +16,108 @@ 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 ()
LocalVariablesOfMain = [] |> Some
}
{
FileName = "ComplexTryCatch.cs"
ExpectedReturnCode = 14
NativeImpls = NativeImpls.PassThru ()
LocalVariablesOfMain =
[
4
20
115
12
1
10
2
112
12
1111
42
99
25
50
123
20
35
5
11111
100001
]
|> List.map (fun i -> CliType.Numeric (CliNumericType.Int32 i))
|> Some
}
{
FileName = "ResizeArray.cs"
ExpectedReturnCode = 109
NativeImpls = MockEnv.make ()
}
{
FileName = "Sizeof.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
}
{
FileName = "LdtokenField.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
LocalVariablesOfMain = [ CliType.Numeric (CliNumericType.Int32 10) ] |> Some
}
]
let cases : EndToEndTestCase list =
let cases : TestCase 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 ()
LocalVariablesOfMain = [ CliType.Numeric (CliNumericType.Int32 1) ] |> Some
}
{
FileName = "StaticVariables.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
LocalVariablesOfMain = None
}
{
FileName = "Ldind.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
LocalVariablesOfMain =
[
// `failures`
CliType.Numeric (CliNumericType.Int32 0)
// Return value
CliType.Numeric (CliNumericType.Int32 0)
]
|> Some
}
{
FileName = "CustomDelegate.cs"
ExpectedReturnCode = 8
NativeImpls = MockEnv.make ()
LocalVariablesOfMain =
[
// filter
CliType.ObjectRef (Some (ManagedHeapAddress 2))
// result
CliType.OfBool true
// result, cloned for "if(result)" check
CliType.OfBool true
// ret
CliType.Numeric (CliNumericType.Int32 8)
]
|> Some
}
{
FileName = "ArgumentOrdering.cs"
ExpectedReturnCode = 0
ExpectedReturnCode = 42
NativeImpls = MockEnv.make ()
LocalVariablesOfMain =
[
// localVar
CliType.Numeric (CliNumericType.Int32 42)
// t
CliType.ValueType [ CliType.Numeric (CliNumericType.Int32 42) ]
// return value
CliType.Numeric (CliNumericType.Int32 42)
]
|> Some
}
{
FileName = "BasicLock.cs"
@@ -104,55 +128,85 @@ module TestPureCases =
{ mock with
System_Threading_Monitor = System_Threading_Monitor.passThru
}
LocalVariablesOfMain =
[
// Four variables:
// locker
CliType.ObjectRef (Some (ManagedHeapAddress 2))
// a copy of locker, taken so that the contents of the implicit `finally` have a stable copy
CliType.ObjectRef (Some (ManagedHeapAddress 2))
// out param of `ReliableEnter`
CliType.OfBool true
// return value
CliType.Numeric (CliNumericType.Int32 1)
]
|> Some
}
{
FileName = "TriangleNumber.cs"
ExpectedReturnCode = 10
NativeImpls = MockEnv.make ()
LocalVariablesOfMain =
[
// answer
CliType.Numeric (CliNumericType.Int32 10)
// i
CliType.Numeric (CliNumericType.Int32 5)
// End-loop condition
CliType.OfBool false
// Ret
CliType.Numeric (CliNumericType.Int32 10)
]
|> Some
}
{
FileName = "ExceptionWithNoOpFinally.cs"
ExpectedReturnCode = 3
NativeImpls = MockEnv.make ()
LocalVariablesOfMain =
[
// Variable 1 is `x`, variable 2 is the implicit return value
4
3
]
|> List.map (fun i -> CliType.Numeric (CliNumericType.Int32 i))
|> Some
}
{
FileName = "ExceptionWithNoOpCatch.cs"
ExpectedReturnCode = 10
NativeImpls = MockEnv.make ()
LocalVariablesOfMain = [ CliType.Numeric (CliNumericType.Int32 10) ] |> Some
}
{
FileName = "Floats.cs"
ExpectedReturnCode = 0
NativeImpls = MockEnv.make ()
LocalVariablesOfMain = None
}
{
FileName = "TryCatchWithThrowInBody.cs"
ExpectedReturnCode = 4
NativeImpls = MockEnv.make ()
LocalVariablesOfMain =
[
// one variable is x, one variable is the return value which also happens to have the same value
4
4
]
|> List.map (fun i -> CliType.Numeric (CliNumericType.Int32 i))
|> Some
}
{
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 ()
LocalVariablesOfMain = None
}
]
let runTest (case : EndToEndTestCase) : unit =
[<TestCaseSource(nameof cases)>]
let ``Can evaluate C# files`` (case : TestCase) : unit =
let source = Assembly.getEmbeddedResourceAsString case.FileName assy
let image = Roslyn.compile [ source ]
let messages, loggerFactory = LoggerFactory.makeTest ()
@@ -179,6 +233,14 @@ module TestPureCases =
exitCode |> shouldEqual realResult.ExitCode
exitCode |> shouldEqual case.ExpectedReturnCode
let finalVariables =
terminalState.ThreadState.[terminatingThread].MethodState.LocalVariables
|> Seq.toList
match case.LocalVariablesOfMain with
| None -> ()
| Some expected -> finalVariables |> shouldEqual expected
with _ ->
for message in messages () do
System.Console.Error.WriteLine $"{message}"
@@ -186,8 +248,33 @@ module TestPureCases =
reraise ()
[<TestCaseSource(nameof unimplemented)>]
[<Explicit>]
let ``Can evaluate C# files, unimplemented`` (case : EndToEndTestCase) = runTest case
[<Explicit "not yet implemented">]
let ``Can evaluate C# files, unimplemented`` (case : TestCase) : unit =
let source = Assembly.getEmbeddedResourceAsString case.FileName assy
let image = Roslyn.compile [ source ]
let messages, loggerFactory = LoggerFactory.makeTest ()
[<TestCaseSource(nameof cases)>]
let ``Can evaluate C# files`` (case : EndToEndTestCase) = runTest case
let dotnetRuntimes =
DotnetRuntime.SelectForDll assy.Location |> ImmutableArray.CreateRange
use peImage = new MemoryStream (image)
try
let terminalState, terminatingThread =
Program.run loggerFactory (Some case.FileName) peImage dotnetRuntimes case.NativeImpls []
let exitCode =
match terminalState.ThreadState.[terminatingThread].MethodState.EvaluationStack.Values with
| [] -> failwith "expected program to return a value, but it returned void"
| head :: _ ->
match head with
| EvalStackValue.Int32 i -> i
| ret -> failwith $"expected program to return an int, but it returned %O{ret}"
exitCode |> shouldEqual case.ExpectedReturnCode
with _ ->
for message in messages () do
System.Console.Error.WriteLine $"{message}"
reraise ()

28
WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj
View File

@@ -4,6 +4,9 @@
<TargetFramework>net9.0</TargetFramework>
<IsPackable>false</IsPackable>
<OutputType>Exe</OutputType>
<IsTestProject>true</IsTestProject>
<TestingPlatformDotnetTestSupport>true</TestingPlatformDotnetTestSupport>
<EnableNUnitRunner>true</EnableNUnitRunner>
</PropertyGroup>
<ItemGroup>
@@ -16,8 +19,25 @@
<Compile Include="TestImpureCases.fs" />
</ItemGroup>
<ItemGroup>
<EmbeddedResource Include="sourcesPure\*.cs" />
<EmbeddedResource Include="sourcesImpure\*.cs" />
<EmbeddedResource Include="sourcesPure\BasicLock.cs" />
<EmbeddedResource Include="sourcesPure\Floats.cs" />
<EmbeddedResource Include="sourcesPure\NoOp.cs" />
<EmbeddedResource Include="sourcesPure\StaticVariables.cs" />
<EmbeddedResource Include="sourcesPure\Ldelema.cs" />
<EmbeddedResource Include="sourcesPure\ExceptionWithNoOpCatch.cs" />
<EmbeddedResource Include="sourcesPure\ExceptionWithNoOpFinally.cs" />
<EmbeddedResource Include="sourcesPure\TryCatchWithThrowInBody.cs" />
<EmbeddedResource Include="sourcesPure\ComplexTryCatch.cs" />
<EmbeddedResource Include="sourcesPure\TriangleNumber.cs" />
<EmbeddedResource Include="sourcesPure\Threads.cs" />
<EmbeddedResource Include="sourcesPure\ResizeArray.cs" />
<EmbeddedResource Include="sourcesPure\ArgumentOrdering.cs" />
<EmbeddedResource Include="sourcesPure\CustomDelegate.cs" />
<EmbeddedResource Include="sourcesPure\Ldind.cs" />
</ItemGroup>
<ItemGroup>
<EmbeddedResource Include="sourcesImpure\WriteLine.cs" />
<EmbeddedResource Include="sourcesImpure\InstaQuit.cs" />
</ItemGroup>
<ItemGroup>
@@ -25,10 +45,10 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="NUnit" Version="4.4.0"/>
<PackageReference Include="NUnit3TestAdapter" Version="5.1.0"/>
<PackageReference Include="FsUnit" Version="7.1.1"/>
<PackageReference Include="NUnit3TestAdapter" Version="5.0.0"/>
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.14.1"/>
<PackageReference Include="NUnit" Version="4.3.2"/>
<PackageReference Include="Microsoft.CodeAnalysis.CSharp" Version="4.14.0"/>
<PackageReference Include="Microsoft.Extensions.Logging.Abstractions" Version="9.0.6" />
<PackageReference Include="WoofWare.DotnetRuntimeLocator" Version="0.3.2"/>

32
WoofWare.PawPrint.Test/sourcesPure/ArgumentOrdering.cs
View File

@@ -10,40 +10,10 @@ public class Program
}
}
public struct Calculator
{
private int baseValue;
public Calculator(int initial)
{
baseValue = initial;
}
public int Add(int a, int b, int c)
{
return baseValue + a + b + c;
}
public int SubtractIsh(int a, int b)
{
return baseValue - a + b;
}
}
public static int Main(string[] args)
{
int localVar = 42;
TestStruct t = new TestStruct(ref localVar);
if (t.Value != 42) return 1;
Calculator calc = new Calculator(10);
int addResult = calc.Add(1, 2, 3); // Should be 10 + 1 + 2 + 3 = 16
if (addResult != 16) return 2;
// Test 2: Verify order matters
int subResult = calc.SubtractIsh(3, 2); // Should be 10 - 3 + 2 = 9
if (subResult != 9) return 3;
return 0;
return t.Value;
}
}

120
WoofWare.PawPrint.Test/sourcesPure/CrossAssemblyTypes.cs
View File

@@ -1,120 +0,0 @@
using System;
using System.Collections.Generic;
using System.Collections;
// Test cross-assembly type resolution using standard library types
public class CrossAssemblyTypeTest
{
public static int TestSystemTypes()
{
// Test various System types to ensure proper assembly resolution
// System.DateTime
var date = new DateTime(2023, 1, 1);
if (date.Year != 2023) return 1;
// System.Guid
var guid = Guid.Empty;
if (guid != Guid.Empty) return 2;
// System.TimeSpan
var timeSpan = TimeSpan.FromMinutes(30);
if (timeSpan.TotalMinutes != 30) return 3;
return 0;
}
public static int TestCollectionTypes()
{
// Test various collection types from different assemblies
// Dictionary<TKey, TValue>
var dict = new Dictionary<string, int>();
dict["test"] = 42;
if (dict["test"] != 42) return 1;
// HashSet<T>
var hashSet = new HashSet<int>();
hashSet.Add(1);
hashSet.Add(2);
hashSet.Add(1); // duplicate
if (hashSet.Count != 2) return 2;
// Queue<T>
var queue = new Queue<string>();
queue.Enqueue("first");
queue.Enqueue("second");
if (queue.Dequeue() != "first") return 3;
return 0;
}
public static int TestGenericInterfaces()
{
// Test generic interfaces across assemblies
var list = new List<int> { 1, 2, 3 };
// IEnumerable<T>
IEnumerable<int> enumerable = list;
int count = 0;
foreach (int item in enumerable)
{
count++;
}
if (count != 3) return 1;
// ICollection<T>
ICollection<int> collection = list;
if (collection.Count != 3) return 2;
// IList<T>
IList<int> ilist = list;
if (ilist[0] != 1) return 3;
return 0;
}
}
// Test Array.Empty<T> which was mentioned in the diff as a specific case
public class ArrayEmptyTest
{
public static int TestArrayEmpty()
{
// Test Array.Empty<T> for different types
var emptyInts = Array.Empty<int>();
var emptyStrings = Array.Empty<string>();
if (emptyInts.Length != 0) return 1;
if (emptyStrings.Length != 0) return 2;
// Verify they are different instances for different types
// but same instance for same type
var emptyInts2 = Array.Empty<int>();
if (!ReferenceEquals(emptyInts, emptyInts2)) return 3;
return 0;
}
}
class Program
{
static int Main(string[] args)
{
int result;
result = CrossAssemblyTypeTest.TestSystemTypes();
if (result != 0) return 100 + result;
result = CrossAssemblyTypeTest.TestCollectionTypes();
if (result != 0) return 200 + result;
result = CrossAssemblyTypeTest.TestGenericInterfaces();
if (result != 0) return 300 + result;
result = ArrayEmptyTest.TestArrayEmpty();
if (result != 0) return 400 + result;
return 0; // All tests passed
}
}

142
WoofWare.PawPrint.Test/sourcesPure/GenericEdgeCases.cs
View File

@@ -1,142 +0,0 @@
using System;
using System.Collections.Generic;
// Test edge cases with generic parameters as mentioned in the diff
public class GenericParameterEdgeCases
{
// Test method with multiple generic parameters
public static T2 Convert<T1, T2>(T1 input, Func<T1, T2> converter)
{
return converter(input);
}
// Test nested generic method calls
public static List<T> WrapInList<T>(T item)
{
var list = new List<T>();
list.Add(item);
return list;
}
public static int TestMultipleGenericParameters()
{
// Test Convert method with different type combinations
string result1 = Convert<int, string>(42, x => x.ToString());
if (result1 != "42") return 1;
int result2 = Convert<string, int>("123", x => int.Parse(x));
if (result2 != 123) return 2;
return 0;
}
public static int TestNestedGenericMethodCalls()
{
// Test calling generic method from within another generic method
var intList = WrapInList<int>(42);
if (intList.Count != 1) return 1;
if (intList[0] != 42) return 2;
var stringList = WrapInList<string>("test");
if (stringList.Count != 1) return 3;
if (stringList[0] != "test") return 4;
return 0;
}
}
// Test deeply nested generic types
public class DeepNestingTest
{
public static int TestDeeplyNestedGenerics()
{
// Test Dictionary<string, List<Dictionary<int, string>>>
var complexType = new Dictionary<string, List<Dictionary<int, string>>>();
var innerDict = new Dictionary<int, string>();
innerDict[1] = "one";
innerDict[2] = "two";
var listOfDicts = new List<Dictionary<int, string>>();
listOfDicts.Add(innerDict);
complexType["test"] = listOfDicts;
if (complexType["test"].Count != 1) return 1;
if (complexType["test"][0][1] != "one") return 2;
if (complexType["test"][0][2] != "two") return 3;
return 0;
}
}
// Test generic constraints and inheritance scenarios
public class GenericConstraintTest<T> where T : class
{
private T value;
public GenericConstraintTest(T val)
{
value = val;
}
public bool IsNull()
{
return value == null;
}
public static int TestGenericConstraints()
{
var test = new GenericConstraintTest<string>("hello");
if (test.IsNull()) return 1;
var nullTest = new GenericConstraintTest<string>(null);
if (!nullTest.IsNull()) return 2;
return 0;
}
}
// Test generic field access scenarios mentioned in the diff
public class GenericFieldAccess<T>
{
public static T DefaultValue = default(T);
public static int TestStaticGenericField()
{
// Test that static fields work correctly with generics
if (GenericFieldAccess<int>.DefaultValue != 0) return 1;
// Test that different instantiations have different static fields
GenericFieldAccess<int>.DefaultValue = 42;
if (GenericFieldAccess<int>.DefaultValue != 42) return 2;
if (GenericFieldAccess<string>.DefaultValue != null) return 3;
return 0;
}
}
class Program
{
static int Main(string[] args)
{
int result;
result = GenericParameterEdgeCases.TestMultipleGenericParameters();
if (result != 0) return 100 + result;
result = GenericParameterEdgeCases.TestNestedGenericMethodCalls();
if (result != 0) return 200 + result;
result = DeepNestingTest.TestDeeplyNestedGenerics();
if (result != 0) return 300 + result;
result = GenericConstraintTest<string>.TestGenericConstraints();
if (result != 0) return 400 + result;
result = GenericFieldAccess<int>.TestStaticGenericField();
if (result != 0) return 500 + result;
return 0; // All tests passed
}
}

19
WoofWare.PawPrint.Test/sourcesPure/InitializeArray.cs
View File

@@ -1,19 +0,0 @@
using System.Linq;
namespace HelloWorldApp
{
class Program
{
static int Main(string[] args)
{
int[] array = new[] { 1, 2, 3 };
if (array.Sum() != 60)
{
return 1;
}
return 0;
}
}
}

339
WoofWare.PawPrint.Test/sourcesPure/InterfaceDispatch.cs
View File

@@ -1,339 +0,0 @@
using System;
public class InterfaceDispatchTests
{
public static int Main(string[] argv)
{
int result = 0;
result |= TestBasicInterface();
result |= TestExplicitImplementation() << 1;
result |= TestMultipleInterfaces() << 2;
result |= TestInterfaceInheritance() << 3;
result |= TestDiamondInheritance() << 4;
result |= TestGenericInterface() << 5;
result |= TestCovariantInterface() << 6;
result |= TestReimplementation() << 7;
// TODO
/*
result |= TestStructInterface() << 8;
result |= TestNullDispatch() << 9;
*/
result |= TestSharedMethodSignature() << 10;
return result;
}
// Test 1: Basic interface dispatch
static int TestBasicInterface()
{
ISimple obj = new SimpleImpl();
return obj.GetValue() == 42 ? 0 : 1;
}
// Test 2: Explicit interface implementation
static int TestExplicitImplementation()
{
var obj = new ExplicitImpl();
IExplicit iface = obj;
// Direct call should return 10, interface call should return 20
if (obj.GetValue() != 10) return 1;
if (iface.GetValue() != 20) return 1;
return 0;
}
// Test 3: Multiple interfaces
static int TestMultipleInterfaces()
{
var obj = new MultiImpl();
IFirst first = obj;
ISecond second = obj;
if (first.GetFirst() != 1) return 1;
if (second.GetSecond() != 2) return 1;
return 0;
}
// Test 4: Interface inheritance
static int TestInterfaceInheritance()
{
IDerived obj = new DerivedImpl();
IBase baseIface = obj;
if (baseIface.GetBase() != 100) return 1;
if (obj.GetDerived() != 200) return 1;
return 0;
}
// Test 5: Diamond inheritance pattern
static int TestDiamondInheritance()
{
var obj = new DiamondImpl();
ILeft left = obj;
IRight right = obj;
IDiamond diamond = obj;
if (left.GetValue() != 300) return 1;
if (right.GetValue() != 300) return 1;
if (diamond.GetDiamondValue() != 400) return 1;
return 0;
}
// Test 6: Generic interface dispatch
static int TestGenericInterface()
{
IGeneric<int> intObj = new GenericImpl<int>();
IGeneric<string> strObj = new GenericImpl<string>();
if (intObj.Process(5) != 3) return 1;
if (strObj.Process("test") != 5) return 1;
return 0;
}
// Test 7: Covariant interface dispatch
static int TestCovariantInterface()
{
ICovariant<string> strCov = new CovariantImpl();
ICovariant<object> objCov = strCov; // Covariance allows this
object result = objCov.Get();
if (!(result is string s && s == "covariant")) return 1;
return 0;
}
// Test 8: Interface reimplementation in derived class
static int TestReimplementation()
{
BaseClass baseObj = new DerivedClass();
IReimpl iface = baseObj;
// Should call derived implementation
if (iface.Method() != 500) return 1;
// Now test with base reference
BaseClass pureBase = new BaseClass();
IReimpl baseIface = pureBase;
if (baseIface.Method() != 600) return 1;
return 0;
}
// Test 9: Struct implementing interface
static int TestStructInterface()
{
StructImpl s = new StructImpl { Value = 700 };
ISimple boxed = s; // Boxing happens here
if (boxed.GetValue() != 700) return 1;
// Verify boxing created a copy
s.Value = 800;
if (boxed.GetValue() != 700) return 1; // Should still be 700
return 0;
}
// Test 10: Null dispatch (should throw)
static int TestNullDispatch()
{
ISimple nullRef = null;
try
{
nullRef.GetValue();
return 1; // Should have thrown
}
catch (NullReferenceException)
{
return 0; // Expected
}
}
// Test 11: Same method signature on multiple unrelated interfaces
static int TestSharedMethodSignature()
{
var obj = new SharedMethodImpl();
IReader reader = obj;
IScanner scanner = obj;
// Both interfaces should be satisfied by the single implementation
if (reader.Read() != "shared") return 1;
if (scanner.Read() != "shared") return 1;
// Also test with explicit + implicit combination
var mixed = new MixedSharedImpl();
IReader readerMixed = mixed;
IScanner scannerMixed = mixed;
if (readerMixed.Read() != "explicit-reader") return 1;
if (scannerMixed.Read() != "implicit-scanner") return 1;
if (mixed.Read() != "implicit-scanner") return 1; // Public method
return 0;
}
// Test interfaces and implementations
interface ISimple
{
int GetValue();
}
class SimpleImpl : ISimple
{
public int GetValue() => 42;
}
interface IExplicit
{
int GetValue();
}
class ExplicitImpl : IExplicit
{
public int GetValue() => 10;
int IExplicit.GetValue() => 20;
}
interface IFirst
{
int GetFirst();
}
interface ISecond
{
int GetSecond();
}
class MultiImpl : IFirst, ISecond
{
public int GetFirst() => 1;
public int GetSecond() => 2;
}
interface IBase
{
int GetBase();
}
interface IDerived : IBase
{
int GetDerived();
}
class DerivedImpl : IDerived
{
public int GetBase() => 100;
public int GetDerived() => 200;
}
interface ICommon
{
int GetValue();
}
interface ILeft : ICommon
{
}
interface IRight : ICommon
{
}
interface IDiamond : ILeft, IRight
{
int GetDiamondValue();
}
class DiamondImpl : IDiamond
{
public int GetValue() => 300;
public int GetDiamondValue() => 400;
}
interface IGeneric<T>
{
int Process(T value);
}
class GenericImpl<T> : IGeneric<T>
{
public int Process(T value)
{
if (typeof(T) == typeof(int))
{
return 3;
}
if (typeof(T) == typeof(string))
{
return 5;
}
return 0;
}
}
interface ICovariant<out T>
{
T Get();
}
class CovariantImpl : ICovariant<string>
{
public string Get() => "covariant";
}
interface IReimpl
{
int Method();
}
class BaseClass : IReimpl
{
public virtual int Method() => 600;
}
class DerivedClass : BaseClass, IReimpl
{
public override int Method() => 500;
}
struct StructImpl : ISimple
{
public int Value;
public int GetValue() => Value;
}
interface IReader
{
string Read();
}
interface IScanner
{
string Read(); // Same signature as IReader.Read()
}
// Single implicit implementation satisfies both interfaces
class SharedMethodImpl : IReader, IScanner
{
public string Read() => "shared";
}
// Mixed: explicit for one, implicit for the other
class MixedSharedImpl : IReader, IScanner
{
// Explicit implementation for IReader
string IReader.Read() => "explicit-reader";
// Implicit implementation (public) - satisfies IScanner
public string Read() => "implicit-scanner";
}
}

7
WoofWare.PawPrint.Test/sourcesPure/Ldind.cs
View File

@@ -39,7 +39,7 @@ unsafe class LdindTest
failures += TestTruncation();
// Test with managed pointers (ref)
failures += TestManagedPointers();
// failures += TestManagedPointers();
// Test Ldind.i (native int)
failures += TestLdindI();
@@ -325,10 +325,7 @@ unsafe class LdindTest
}
// Test with array element
int[] array = new int[3];
array[0] = 10;
array[1] = 20;
array[2] = 30;
int[] array = { 10, 20, 30 };
ref int element = ref array[1];
if (element != 20)
{

128
WoofWare.PawPrint.Test/sourcesPure/LdtokenField.cs
View File

@@ -1,128 +0,0 @@
using System;
using System.Linq;
using System.Reflection;
using System.Runtime.CompilerServices;
namespace LdtokenFieldTest
{
class Program
{
// Various field types to test ldtoken with
public static int StaticIntField = 42;
public string InstanceStringField = "test";
private readonly double PrivateReadonlyField = 3.14;
internal decimal InternalField;
protected bool ProtectedField;
public static readonly DateTime StaticReadonlyField = DateTime.MinValue;
// Generic type fields
public GenericClass<int>.NestedClass<string> GenericField;
static int Main(string[] args)
{
int testsFailed = 0;
// Test 1: Static field via FieldInfo
FieldInfo staticField = typeof(Program).GetField(nameof(StaticIntField));
if (staticField == null || staticField.FieldType != typeof(int))
{
testsFailed++;
}
// Test 2: Instance field via FieldInfo
FieldInfo instanceField = typeof(Program).GetField(nameof(InstanceStringField));
if (instanceField == null || instanceField.FieldType != typeof(string))
{
testsFailed++;
}
// Test 3: Private field via FieldInfo with binding flags
FieldInfo privateField = typeof(Program).GetField("PrivateReadonlyField",
BindingFlags.NonPublic | BindingFlags.Instance);
if (privateField == null || privateField.FieldType != typeof(double))
{
testsFailed++;
}
// Test 4: Using RuntimeFieldHandle directly
RuntimeFieldHandle handle = staticField.FieldHandle;
FieldInfo fieldFromHandle = FieldInfo.GetFieldFromHandle(handle);
if (!ReferenceEquals(fieldFromHandle, staticField))
{
testsFailed++;
}
// Test 5: Field from generic type
Type genericType = typeof(GenericClass<>);
FieldInfo genericFieldInfo = genericType.GetField("GenericField");
if (genericFieldInfo == null)
{
testsFailed++;
}
// Test 6: Field from nested type
Type nestedType = typeof(OuterClass.InnerClass);
FieldInfo nestedField = nestedType.GetField("NestedField");
if (nestedField == null || nestedField.FieldType != typeof(int))
{
testsFailed++;
}
// Test 7: Field handle with generic context
Type constructedGeneric = typeof(GenericClass<int>);
FieldInfo constructedField = constructedGeneric.GetField("GenericField");
RuntimeFieldHandle genericHandle = constructedField.FieldHandle;
FieldInfo reconstructed = FieldInfo.GetFieldFromHandle(genericHandle, constructedGeneric.TypeHandle);
if (reconstructed.DeclaringType != constructedGeneric)
{
testsFailed++;
}
// Test 8: Struct field
Type structType = typeof(TestStruct);
FieldInfo structField = structType.GetField("StructField");
if (structField == null || structField.FieldType != typeof(long))
{
testsFailed++;
}
// Test 9: Volatile field
FieldInfo volatileField = typeof(VolatileFieldClass).GetField("VolatileField");
if (volatileField == null || !volatileField.GetRequiredCustomModifiers().Any(t => t == typeof(IsVolatile)))
{
testsFailed++;
}
return testsFailed;
}
}
// Supporting types for testing
public class GenericClass<T>
{
public T GenericField;
public class NestedClass<U>
{
public U NestedGenericField;
}
}
public class OuterClass
{
public class InnerClass
{
public int NestedField = 100;
}
}
public struct TestStruct
{
public long StructField;
}
public class VolatileFieldClass
{
public volatile int VolatileField;
}
}

118
WoofWare.PawPrint.Test/sourcesPure/Sizeof.cs
View File

@@ -1,118 +0,0 @@
using System;
using System.Runtime.InteropServices;
unsafe public class Program
{
public struct SmallStruct
{
public byte Value;
}
public struct MediumStruct
{
public int Value1;
public int Value2;
}
public struct LargeStruct
{
public long Value1;
public long Value2;
public long Value3;
public long Value4;
}
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: Pointer types
unsafe
{
if (sizeof(IntPtr) != sizeof(void*)) return 19;
if (sizeof(UIntPtr) != sizeof(void*)) return 20;
}
// Test 7: Using sizeof in expressions
int totalSize = sizeof(int) + sizeof(long) + sizeof(byte);
if (totalSize != 13) return 21;
// Test 8: Array element size calculation
int arrayElementSize = sizeof(MediumStruct);
int arraySize = arrayElementSize * 3;
if (arraySize != 24) return 22;
// Test 9: Conditional using sizeof
bool is32Bit = sizeof(IntPtr) == 4;
bool is64Bit = sizeof(IntPtr) == 8;
if (!is32Bit && !is64Bit) return 23;
if (is32Bit && is64Bit) return 24;
// Test 10: Sizeof in switch statement
int result = 0;
switch (sizeof(int))
{
case 1:
result = 1;
break;
case 2:
result = 2;
break;
case 4:
result = 4;
break;
case 8:
result = 8;
break;
default:
result = -1;
break;
}
if (result != 4) return 25;
return 0;
}
}

2
WoofWare.PawPrint.Test/sourcesPure/StaticVariables.cs
View File

@@ -20,7 +20,7 @@ public class GenericCounter<T>
class Program
{
static int Main(string[] argv)
static int Main()
{
// Test that different generic instantiations have separate static variables

41
WoofWare.PawPrint.Test/sourcesPure/TestOr.cs
View File

@@ -1,41 +0,0 @@
public class TestOr
{
public static int Main(string[] args)
{
// Test 1: Bitwise OR with Int32
int a32 = 12; // Binary: 1100
int b32 = 10; // Binary: 1010
int result32 = a32 | b32; // Should be 14 (Binary: 1110)
if (result32 != 14) return 1;
// Test 2: Bitwise OR with Int64
long a64 = 0x00FF00FFL;
long b64 = 0xFF00FF00L;
long result64 = a64 | b64;
if (result64 != 0xFFFFFFFFL) return 2;
// Test 3: Mixed bitwise OR (Int32 and native int)
int aMixed = 15; // Binary: 1111
nint bMixed = 240; // Binary: 11110000
nint resultMixed = aMixed | bMixed; // Should be 255 (Binary: 11111111)
if (resultMixed != 255) return 3;
// Test 4: OR with itself
int self = 42;
int selfResult = self | self;
if (selfResult != 42) return 4;
// Test 5: OR with 0
int withZero = 123;
int zeroResult = withZero | 0;
if (zeroResult != 123) return 5;
// Test 6: Native int OR native int
nint nativeA = 0x0F;
nint nativeB = 0xF0;
nint nativeResult = nativeA | nativeB; // Should be 0xFF
if (nativeResult != 0xFF) return 6;
return 0;
}
}

34
WoofWare.PawPrint.Test/sourcesPure/TestShl.cs
View File

@@ -1,34 +0,0 @@
public class TestShl
{
public static int Main(string[] args)
{
// Test 1: Shift Left with Int32
int value32 = 5; // Binary: 0101
int shift32 = 2;
int result32 = value32 << shift32; // Should be 20 (Binary: 10100)
if (result32 != 20) return 1;
// Test 2: Shift Left with Int64
long value64 = 7L; // Binary: 0111
int shift64 = 3;
long result64 = value64 << shift64; // Should be 56 (Binary: 111000)
if (result64 != 56L) return 2;
// Test 3: Shift by 0
int noShiftValue = 42;
int noShiftResult = noShiftValue << 0;
if (noShiftResult != 42) return 3;
// Test 4: Shift by 1
int singleShiftResult = noShiftValue << 1;
if (singleShiftResult != 84) return 4;
// Test 5: Shift with native int
nint nativeValue = 3;
int nativeShift = 4;
nint nativeResult = nativeValue << nativeShift; // Should be 48
if (nativeResult != 48) return 5;
return 0;
}
}

35
WoofWare.PawPrint.Test/sourcesPure/TestShr.cs
View File

@@ -1,35 +0,0 @@
public class TestShr
{
public static int Main(string[] args)
{
// Test 1: Shift Right with Int32
int value32 = 20; // Binary: 10100
int shift32 = 2;
int result32 = value32 >> shift32; // Should be 5 (Binary: 0101)
if (result32 != 5) return 1;
// Test 2: Shift Right with Int64
long value64 = 56L; // Binary: 111000
int shift64 = 3;
long result64 = value64 >> shift64; // Should be 7 (Binary: 0111)
if (result64 != 7L) return 2;
// Test 3: Right shift preserving sign (negative number)
int negative = -16;
int negativeResult = negative >> 2; // Should be -4
if (negativeResult != -4) return 3;
// Test 4: Shift by 0
int noShiftValue = 99;
int noShiftResult = noShiftValue >> 0;
if (noShiftResult != 99) return 4;
// Test 5: Shift with native int
nint nativeValue = 48;
int nativeShift = 4;
nint nativeResult = nativeValue >> nativeShift; // Should be 3
if (nativeResult != 3) return 5;
return 0;
}
}

112
WoofWare.PawPrint.Test/sourcesPure/TypeConcretization.cs
View File

@@ -1,112 +0,0 @@
using System;
using System.Collections.Generic;
// Test basic type concretization
public class BasicTypeTest
{
public static int TestBasicTypes()
{
// Test primitive types
int i = 42;
string s = "hello";
bool b = true;
if (i != 42) return 1;
if (s != "hello") return 2;
if (!b) return 3;
return 0;
}
}
// Test generic type instantiation
public class GenericTypeTest<T>
{
private T value;
public GenericTypeTest(T val)
{
value = val;
}
public T GetValue()
{
return value;
}
public static int TestGenericInstantiation()
{
var intTest = new GenericTypeTest<int>(123);
var stringTest = new GenericTypeTest<string>("test");
if (intTest.GetValue() != 123) return 1;
if (stringTest.GetValue() != "test") return 2;
return 0;
}
}
// Test nested generic types
public class NestedGenericTest
{
public static int TestNestedGenerics()
{
var listOfInts = new List<int>();
listOfInts.Add(1);
listOfInts.Add(2);
if (listOfInts.Count != 2) return 1;
if (listOfInts[0] != 1) return 2;
if (listOfInts[1] != 2) return 3;
var listOfLists = new List<List<int>>();
listOfLists.Add(listOfInts);
if (listOfLists.Count != 1) return 4;
if (listOfLists[0].Count != 2) return 5;
return 0;
}
}
// Test generic methods
public class GenericMethodTest
{
public static T Identity<T>(T input)
{
return input;
}
public static int TestGenericMethods()
{
int intResult = Identity<int>(42);
string stringResult = Identity<string>("hello");
if (intResult != 42) return 1;
if (stringResult != "hello") return 2;
return 0;
}
}
class Program
{
static int Main(string[] args)
{
int result;
result = BasicTypeTest.TestBasicTypes();
if (result != 0) return 100 + result;
result = GenericTypeTest<int>.TestGenericInstantiation();
if (result != 0) return 200 + result;
result = NestedGenericTest.TestNestedGenerics();
if (result != 0) return 300 + result;
result = GenericMethodTest.TestGenericMethods();
if (result != 0) return 400 + result;
return 0; // All tests passed
}
}

76
WoofWare.PawPrint/AbstractMachine.fs
View File

@@ -60,18 +60,22 @@ module AbstractMachine =
let delegateToRun = state.ManagedHeap.NonArrayObjects.[delegateToRunAddr]
let target =
match delegateToRun.Fields.["_target"] with
| CliType.ObjectRef addr -> addr
| x -> failwith $"TODO: delegate target wasn't an object ref: %O{x}"
if delegateToRun.Fields.["_target"] <> CliType.ObjectRef None then
failwith "TODO: delegate target wasn't None"
let methodPtr =
match delegateToRun.Fields.["_methodPtr"] with
| CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.FunctionPointer mi)) -> mi
| d -> failwith $"unexpectedly not a method pointer in delegate invocation: {d}"
let typeGenerics =
instruction.ExecutingMethod.DeclaringType.Generics |> ImmutableArray.CreateRange
let methodGenerics = instruction.ExecutingMethod.Generics
let methodPtr =
methodPtr |> MethodInfo.mapTypeGenerics (fun i _ -> typeGenerics.[i])
// When we return, we need to go back up the stack
match state |> IlMachineState.returnStackFrame loggerFactory baseClassTypes thread with
| None -> failwith "unexpectedly nowhere to return from delegate"
@@ -82,42 +86,23 @@ module AbstractMachine =
(state, instruction.Arguments)
||> Seq.fold (fun state arg -> IlMachineState.pushToEvalStack arg thread state)
// The odd little calling convention strikes again: we push the `target` parameter on top of the
// stack, although that doesn't actually happen in the CLR.
// We'll pretend we're constructing an object, so that the calling convention gets respected in
// `callMethod`.
let state, constructing =
match target with
| None -> state, None
| Some target ->
let state =
IlMachineState.pushToEvalStack (CliType.ObjectRef (Some target)) thread state
state, Some target
let state, _ =
state.WithThreadSwitchedToAssembly methodPtr.DeclaringType.Assembly thread
// Don't advance the program counter again on return; that was already done by the Callvirt that
// caused this delegate to be invoked.
let currentThreadState = state.ThreadState.[thread]
let state =
IlMachineStateExecution.callMethod
let state, result =
state
|> IlMachineState.callMethodInActiveAssembly
loggerFactory
baseClassTypes
None
constructing
false
false
thread
false
methodGenerics
methodPtr
thread
currentThreadState
state
None
ExecutionResult.Stepped (state, WhatWeDid.Executed)
ExecutionResult.Stepped (state, result)
| _ ->
let outcome =
@@ -126,55 +111,42 @@ module AbstractMachine =
targetType.Namespace,
targetType.Name,
instruction.ExecutingMethod.Name,
instruction.ExecutingMethod.Signature.ParameterTypes,
instruction.ExecutingMethod.Signature.ReturnType
instruction.ExecutingMethod.RawSignature.ParameterTypes,
instruction.ExecutingMethod.RawSignature.ReturnType
with
| "System.Private.CoreLib",
"System",
"Environment",
"GetProcessorCount",
[],
ConcretePrimitive state.ConcreteTypes PrimitiveType.Int32 ->
TypeDefn.PrimitiveType PrimitiveType.Int32 ->
let env = ISystem_Environment_Env.get impls
env.GetProcessorCount thread state
| "System.Private.CoreLib",
"System",
"Environment",
"_Exit",
[ ConcretePrimitive state.ConcreteTypes PrimitiveType.Int32 ],
ConcreteVoid state.ConcreteTypes ->
[ TypeDefn.PrimitiveType PrimitiveType.Int32 ],
TypeDefn.Void ->
let env = ISystem_Environment_Env.get impls
env._Exit thread state
| "System.Private.CoreLib",
"System.Threading",
"Monitor",
"ReliableEnter",
[ ConcretePrimitive state.ConcreteTypes PrimitiveType.Object
ConcreteByref (ConcretePrimitive state.ConcreteTypes PrimitiveType.Boolean) ],
ConcreteVoid state.ConcreteTypes ->
[ TypeDefn.PrimitiveType PrimitiveType.Object
TypeDefn.Byref (TypeDefn.PrimitiveType PrimitiveType.Boolean) ],
TypeDefn.Void ->
let env = ISystem_Threading_Monitor_Env.get impls
env.ReliableEnter thread state
| "System.Private.CoreLib",
"System.Threading",
"Monitor",
"Exit",
[ ConcretePrimitive state.ConcreteTypes PrimitiveType.Object ],
ConcreteVoid state.ConcreteTypes ->
[ TypeDefn.PrimitiveType PrimitiveType.Object ],
TypeDefn.Void ->
let env = ISystem_Threading_Monitor_Env.get impls
env.Exit thread state
| "System.Private.CoreLib",
"System",
"Type",
"GetField",
[ ConcretePrimitive state.ConcreteTypes PrimitiveType.String ; ty ],
ret ->
let ty = AllConcreteTypes.lookup ty state.ConcreteTypes |> Option.get
let ret = AllConcreteTypes.lookup ret state.ConcreteTypes |> Option.get
match ty.Namespace, ty.Name, ty.Generics.IsEmpty, ret.Namespace, ret.Name, ret.Generics.IsEmpty with
| "System.Reflection", "BindingFlags", true, "System.Reflection", "FieldInfo", true ->
failwith "TODO: GetField"
| _ -> failwith "unexpected signature for Type.GetField"
| assy, ns, typeName, methName, param, retType ->
failwith
$"TODO: tried to IL-interpret a method in {assy} {ns}.{typeName} named {methName} with no implementation; {param} -> {retType}"

3
WoofWare.PawPrint/AbstractMachineDomain.fs
View File

@@ -14,3 +14,6 @@ type ManagedHeapAddress =
override this.ToString () : string =
match this with
| ManagedHeapAddress.ManagedHeapAddress i -> $"<object #%i{i}>"
[<Measure>]
type typeHandle

348
WoofWare.PawPrint/BasicCliType.fs
View File

@@ -1,5 +1,6 @@
namespace WoofWare.PawPrint
open System
open System.Collections.Immutable
open System.Reflection
open System.Reflection.Metadata
@@ -62,8 +63,8 @@ type UnsignedNativeIntSource =
type NativeIntSource =
| Verbatim of int64
| ManagedPointer of ManagedPointerSource
| FunctionPointer of MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle>
| TypeHandlePtr of ConcreteTypeHandle
| FunctionPointer of MethodInfo<FakeUnit, WoofWare.PawPrint.GenericParameter, TypeDefn>
| TypeHandlePtr of int64<typeHandle>
override this.ToString () : string =
match this with
@@ -71,7 +72,7 @@ type NativeIntSource =
| NativeIntSource.ManagedPointer ptr -> $"<managed pointer {ptr}>"
| NativeIntSource.FunctionPointer methodDefinition ->
$"<pointer to {methodDefinition.Name} in {methodDefinition.DeclaringType.Assembly.Name}>"
| NativeIntSource.TypeHandlePtr ptr -> $"<type ID %O{ptr}>"
| NativeIntSource.TypeHandlePtr ptr -> $"<type ID %i{ptr}>"
[<RequireQualifiedAccess>]
module NativeIntSource =
@@ -113,6 +114,18 @@ type CliNumericType =
| Float32 of float32
| Float64 of float
type CliValueType =
private
| Bool of byte
/// A UTF-16 code unit, i.e. two bytes. We store the most significant one first.
| Char of byte * byte
| UInt8 of uint8
| UInt16 of uint16
| Int8 of int8
| Int16 of int16
| Float32 of float32
| Float64 of float
[<RequireQualifiedAccess>]
type CliRuntimePointerSource =
| LocalVariable of sourceThread : ThreadId * methodFrame : int * whichVar : uint16
@@ -139,12 +152,15 @@ type CliType =
| RuntimePointer of CliRuntimePointer
/// This is *not* a CLI type as such. I don't actually know its status. A value type is represented simply
/// as a concatenated list of its fields.
| ValueType of CliValueType
| ValueType of CliType list
and CliValueType =
{
Fields : (string * CliType) list
}
/// In fact any non-zero value will do for True, but we'll use 1
static member OfBool (b : bool) = CliType.Bool (if b then 1uy else 0uy)
static member OfChar (c : char) =
CliType.Char (byte (int c / 256), byte (int c % 256))
static member OfManagedObject (ptr : ManagedHeapAddress) = CliType.ObjectRef (Some ptr)
type CliTypeResolutionResult =
| Resolved of CliType
@@ -152,37 +168,6 @@ type CliTypeResolutionResult =
[<RequireQualifiedAccess>]
module CliType =
/// In fact any non-zero value will do for True, but we'll use 1
let ofBool (b : bool) : CliType = CliType.Bool (if b then 1uy else 0uy)
let ofChar (c : char) : CliType =
CliType.Char (byte (int c / 256), byte (int c % 256))
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 zeroOfPrimitive (primitiveType : PrimitiveType) : CliType =
match primitiveType with
@@ -208,213 +193,96 @@ module CliType =
| PrimitiveType.UIntPtr -> CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null)
| PrimitiveType.Object -> CliType.ObjectRef None
let rec zeroOf
(concreteTypes : AllConcreteTypes)
let rec zeroOfTypeDefn
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
(corelib : BaseClassTypes<DumpedAssembly>)
(handle : ConcreteTypeHandle)
: CliType * AllConcreteTypes
(assy : DumpedAssembly)
(typeGenerics : TypeDefn ImmutableArray)
(methodGenerics : TypeDefn ImmutableArray)
(ty : TypeDefn)
: CliTypeResolutionResult
=
zeroOfWithVisited concreteTypes assemblies corelib handle Set.empty
match ty with
| TypeDefn.PrimitiveType primitiveType -> CliTypeResolutionResult.Resolved (zeroOfPrimitive primitiveType)
| TypeDefn.Array _ -> CliTypeResolutionResult.Resolved (CliType.ObjectRef None)
| TypeDefn.Pinned typeDefn -> failwith "todo"
| TypeDefn.Pointer _ ->
CliRuntimePointer.Managed CliRuntimePointerSource.Null
|> CliType.RuntimePointer
|> CliTypeResolutionResult.Resolved
| TypeDefn.Byref _ -> CliTypeResolutionResult.Resolved (CliType.ObjectRef None)
| TypeDefn.OneDimensionalArrayLowerBoundZero _ -> CliTypeResolutionResult.Resolved (CliType.ObjectRef None)
| TypeDefn.Modified (original, afterMod, modificationRequired) -> failwith "todo"
| TypeDefn.FromReference (typeRef, signatureTypeKind) ->
match signatureTypeKind with
| SignatureTypeKind.Unknown -> failwith "todo"
| SignatureTypeKind.ValueType ->
match Assembly.resolveTypeRef assemblies assy typeRef typeGenerics with
| TypeResolutionResult.Resolved (sourceAssy, ty) ->
let fields =
ty.Fields
|> List.filter (fun field -> not (field.Attributes.HasFlag FieldAttributes.Static))
|> List.map (fun fi ->
match
zeroOfTypeDefn assemblies corelib sourceAssy typeGenerics methodGenerics fi.Signature
with
| CliTypeResolutionResult.Resolved ty -> Ok ty
| CliTypeResolutionResult.FirstLoad a -> Error a
)
|> Result.allOkOrError
and zeroOfWithVisited
(concreteTypes : AllConcreteTypes)
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
(corelib : BaseClassTypes<DumpedAssembly>)
(handle : ConcreteTypeHandle)
(visited : Set<ConcreteTypeHandle>)
: CliType * AllConcreteTypes
=
match fields with
| Error (_, []) -> failwith "logic error"
| Error (_, f :: _) -> CliTypeResolutionResult.FirstLoad f
| Ok fields -> CliType.ValueType fields |> CliTypeResolutionResult.Resolved
| TypeResolutionResult.FirstLoadAssy assy -> CliTypeResolutionResult.FirstLoad assy
| SignatureTypeKind.Class -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved
| _ -> raise (ArgumentOutOfRangeException ())
| TypeDefn.FromDefinition (typeDefinitionHandle, _, signatureTypeKind) ->
let typeDef = assy.TypeDefs.[typeDefinitionHandle.Get]
// Handle constructed types first
match handle with
| ConcreteTypeHandle.Byref _ ->
// Byref types are managed references - the zero value is a null reference
CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null), concreteTypes
| ConcreteTypeHandle.Pointer _ ->
// Pointer types are unmanaged pointers - the zero value is a null pointer
CliType.RuntimePointer (CliRuntimePointer.Unmanaged 0L), concreteTypes
| ConcreteTypeHandle.Concrete _ ->
// This is a concrete type - look it up in the mapping
let concreteType =
match AllConcreteTypes.lookup handle concreteTypes with
| Some ct -> ct
| None -> failwithf "ConcreteTypeHandle %A not found in AllConcreteTypes" handle
// Get the type definition from the assembly
let assembly = assemblies.[concreteType.Assembly.FullName]
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
// Check against known primitive types
if TypeInfo.NominallyEqual typeDef corelib.Boolean then
zeroOfPrimitive PrimitiveType.Boolean, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.Char then
zeroOfPrimitive PrimitiveType.Char, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.SByte then
zeroOfPrimitive PrimitiveType.SByte, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.Byte then
zeroOfPrimitive PrimitiveType.Byte, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.Int16 then
zeroOfPrimitive PrimitiveType.Int16, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.UInt16 then
zeroOfPrimitive PrimitiveType.UInt16, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.Int32 then
zeroOfPrimitive PrimitiveType.Int32, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.UInt32 then
zeroOfPrimitive PrimitiveType.UInt32, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.Int64 then
zeroOfPrimitive PrimitiveType.Int64, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.UInt64 then
zeroOfPrimitive PrimitiveType.UInt64, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.Single then
zeroOfPrimitive PrimitiveType.Single, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.Double then
zeroOfPrimitive PrimitiveType.Double, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.String then
zeroOfPrimitive PrimitiveType.String, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.Object then
zeroOfPrimitive PrimitiveType.Object, concreteTypes
elif TypeInfo.NominallyEqual typeDef corelib.IntPtr then
zeroOfPrimitive 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
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
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
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
CliType.ObjectRef None, concreteTypes
if typeDef = corelib.Int32 then
zeroOfPrimitive PrimitiveType.Int32 |> CliTypeResolutionResult.Resolved
elif typeDef = corelib.Int64 then
zeroOfPrimitive PrimitiveType.Int64 |> CliTypeResolutionResult.Resolved
elif typeDef = corelib.UInt32 then
zeroOfPrimitive PrimitiveType.UInt32 |> CliTypeResolutionResult.Resolved
elif typeDef = corelib.UInt64 then
zeroOfPrimitive PrimitiveType.UInt64 |> CliTypeResolutionResult.Resolved
else
let visited = Set.add handle visited
// Custom type - need to determine if it's a value type or reference type
determineZeroForCustomType concreteTypes assemblies corelib handle concreteType typeDef visited
// TODO: the rest
match signatureTypeKind with
| SignatureTypeKind.Unknown -> failwith "todo"
| SignatureTypeKind.ValueType ->
let fields =
typeDef.Fields
// oh lord, this is awfully ominous - I really don't want to store the statics here
|> List.filter (fun field -> not (field.Attributes.HasFlag FieldAttributes.Static))
|> List.map (fun fi ->
match zeroOfTypeDefn assemblies corelib assy typeGenerics methodGenerics fi.Signature with
| CliTypeResolutionResult.Resolved ty -> Ok ty
| CliTypeResolutionResult.FirstLoad a -> Error a
)
|> Result.allOkOrError
and private determineZeroForCustomType
(concreteTypes : AllConcreteTypes)
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
(corelib : BaseClassTypes<DumpedAssembly>)
(handle : ConcreteTypeHandle)
(concreteType : ConcreteType<ConcreteTypeHandle>)
(typeDef : WoofWare.PawPrint.TypeInfo<GenericParamFromMetadata, TypeDefn>)
(visited : Set<ConcreteTypeHandle>)
: CliType * AllConcreteTypes
=
match fields with
| Error (_, []) -> failwith "logic error"
| Error (_, f :: _) -> CliTypeResolutionResult.FirstLoad f
| Ok fields ->
// Determine if this is a value type by checking inheritance
let isValueType =
match DumpedAssembly.resolveBaseType corelib assemblies typeDef.Assembly typeDef.BaseType with
| ResolvedBaseType.ValueType
| ResolvedBaseType.Enum -> true
| ResolvedBaseType.Delegate -> false // Delegates are reference types
| ResolvedBaseType.Object -> false
CliType.ValueType fields |> CliTypeResolutionResult.Resolved
| SignatureTypeKind.Class -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved
| _ -> raise (ArgumentOutOfRangeException ())
| TypeDefn.GenericInstantiation (generic, args) ->
zeroOfTypeDefn assemblies corelib assy args methodGenerics generic
| TypeDefn.FunctionPointer typeMethodSignature -> failwith "todo"
| TypeDefn.GenericTypeParameter index ->
// TODO: can generics depend on other generics? presumably, so we pass the array down again
zeroOfTypeDefn assemblies corelib assy typeGenerics methodGenerics typeGenerics.[index]
| TypeDefn.GenericMethodParameter index ->
zeroOfTypeDefn assemblies corelib assy typeGenerics methodGenerics methodGenerics.[index]
| TypeDefn.Void -> failwith "should never construct an element of type Void"
if isValueType then
// It's a value type - need to create zero values for all non-static fields
let mutable currentConcreteTypes = concreteTypes
let fieldZeros =
typeDef.Fields
|> List.filter (fun field -> not (field.Attributes.HasFlag FieldAttributes.Static))
|> List.map (fun field ->
// Need to concretize the field type with the concrete type's generics
let fieldTypeDefn = field.Signature
let fieldHandle, updatedConcreteTypes =
concretizeFieldType currentConcreteTypes assemblies corelib concreteType fieldTypeDefn
currentConcreteTypes <- updatedConcreteTypes
let fieldZero, updatedConcreteTypes2 =
zeroOfWithVisited currentConcreteTypes assemblies corelib fieldHandle visited
currentConcreteTypes <- updatedConcreteTypes2
(field.Name, fieldZero)
)
let vt =
{
Fields = fieldZeros
}
CliType.ValueType vt, currentConcreteTypes
else
// It's a reference type
CliType.ObjectRef None, concreteTypes
and private concretizeFieldType
(concreteTypes : AllConcreteTypes)
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
(corelib : BaseClassTypes<DumpedAssembly>)
(declaringType : ConcreteType<ConcreteTypeHandle>)
(fieldType : TypeDefn)
: ConcreteTypeHandle * AllConcreteTypes
=
// Create a concretization context
let ctx =
{
TypeConcretization.ConcretizationContext.InProgress = ImmutableDictionary.Empty
TypeConcretization.ConcretizationContext.ConcreteTypes = concreteTypes
TypeConcretization.ConcretizationContext.LoadedAssemblies = assemblies
TypeConcretization.ConcretizationContext.BaseTypes = corelib
}
// 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]
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
let handle, newCtx =
TypeConcretization.concretizeType
ctx
loadAssembly
declaringType.Assembly
declaringType.Generics
methodGenerics
fieldType
handle, newCtx.ConcreteTypes
let rec zeroOf (concreteTypes : AllConcreteTypes) (cth : ConcreteTypeHandle) : CliType =
let ty = AllConcreteTypes.lookup cth concreteTypes |> Option.get
failwith "TODO"

41
WoofWare.PawPrint/Corelib.fs
View File

@@ -114,41 +114,6 @@ module Corelib =
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "RuntimeFieldHandle" then Some v else None)
|> Seq.exactlyOne
let voidType =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "Void" then Some v else None)
|> Seq.exactlyOne
let typedReferenceType =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "TypedReference" then Some v else None)
|> Seq.exactlyOne
let intPtrType =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "IntPtr" then Some v else None)
|> Seq.exactlyOne
let uintPtrType =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "UIntPtr" then Some v else None)
|> Seq.exactlyOne
let runtimeFieldInfoStubType =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "RuntimeFieldInfoStub" then Some v else None)
|> Seq.exactlyOne
let runtimeFieldHandleInternalType =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) ->
if v.Name = "RuntimeFieldHandleInternal" then
Some v
else
None
)
|> Seq.exactlyOne
{
Corelib = corelib
String = stringType
@@ -172,11 +137,5 @@ module Corelib =
RuntimeTypeHandle = runtimeTypeHandleType
RuntimeMethodHandle = runtimeMethodHandleType
RuntimeFieldHandle = runtimeFieldHandleType
RuntimeFieldInfoStub = runtimeFieldInfoStubType
RuntimeFieldHandleInternal = runtimeFieldHandleInternalType
RuntimeType = runtimeTypeType
Void = voidType
TypedReference = typedReferenceType
IntPtr = intPtrType
UIntPtr = uintPtrType
}

58
WoofWare.PawPrint/EvalStack.fs
View File

@@ -10,8 +10,7 @@ type EvalStackValue =
| 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
| UserDefinedValueType of EvalStackValue list
override this.ToString () =
match this with
@@ -22,11 +21,7 @@ type EvalStackValue =
| 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 " | "
let desc = evalStackValues |> List.map string<EvalStackValue> |> String.concat " | "
$"Struct(%s{desc})"
[<RequireQualifiedAccess>]
@@ -92,8 +87,8 @@ module EvalStackValue =
/// Then truncates to int64.
let convToUInt64 (value : EvalStackValue) : int64 option =
match value with
| EvalStackValue.Int32 i -> Some (int64 (uint32 i))
| EvalStackValue.Int64 int64 -> Some int64
| EvalStackValue.Int32 i -> if i >= 0 then Some (int64 i) else failwith "TODO"
| EvalStackValue.Int64 int64 -> failwith "todo"
| EvalStackValue.NativeInt nativeIntSource -> failwith "todo"
| EvalStackValue.Float f -> failwith "todo"
| EvalStackValue.ManagedPointer managedPointerSource -> failwith "todo"
@@ -107,7 +102,7 @@ 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 ] -> toCliTypeCoerced target popped
| i -> failwith $"TODO: %O{i}"
| CliNumericType.Int64 _ ->
match popped with
@@ -182,7 +177,7 @@ module EvalStackValue =
| _ -> failwith "TODO"
| EvalStackValue.UserDefinedValueType fields ->
match fields with
| [ esv ] -> toCliTypeCoerced target (snd esv)
| [ esv ] -> toCliTypeCoerced target esv
| fields -> failwith $"TODO: don't know how to coerce struct of {fields} to a pointer"
| _ -> failwith $"TODO: {popped}"
| CliType.Bool _ ->
@@ -197,7 +192,7 @@ module EvalStackValue =
match popped with
| EvalStackValue.ManagedPointer src ->
match src with
| ManagedPointerSource.Heap addr -> CliType.ofManagedObject addr
| ManagedPointerSource.Heap addr -> CliType.OfManagedObject addr
| ManagedPointerSource.Null -> CliType.ObjectRef None
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, var) ->
CliRuntimePointerSource.LocalVariable (sourceThread, methodFrame, var)
@@ -207,10 +202,7 @@ module EvalStackValue =
CliRuntimePointerSource.Argument (sourceThread, methodFrame, var)
|> CliRuntimePointer.Managed
|> CliType.RuntimePointer
| ManagedPointerSource.ArrayIndex (arr, index) ->
CliRuntimePointerSource.ArrayIndex (arr, index)
|> CliRuntimePointer.Managed
|> CliType.RuntimePointer
| ManagedPointerSource.ArrayIndex _ -> failwith "TODO"
| EvalStackValue.NativeInt intSrc ->
match intSrc with
| NativeIntSource.Verbatim i -> CliType.RuntimePointer (CliRuntimePointer.Unmanaged i)
@@ -238,31 +230,16 @@ module EvalStackValue =
let low = i % 256
CliType.Char (byte<int> high, byte<int> low)
| popped -> failwith $"Unexpectedly wanted a char from {popped}"
| CliType.ValueType vt ->
| CliType.ValueType fields ->
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})"
if fields.Length <> popped.Length then
failwith "mismatch"
let fields =
List.map2
(fun (name1, v1) (name2, v2) ->
if name1 <> name2 then
failwith $"TODO: name mismatch, {name1} vs {name2}"
name1, toCliTypeCoerced v1 v2
)
vt.Fields
popped
{
Fields = fields
}
|> CliType.ValueType
List.map2 toCliTypeCoerced fields popped |> CliType.ValueType
| popped ->
match vt.Fields with
| [ _, target ] -> toCliTypeCoerced target popped
match fields with
| [ target ] -> toCliTypeCoerced target popped
| _ -> failwith $"TODO: {popped} into value type {target}"
let rec ofCliType (v : CliType) : EvalStackValue =
@@ -303,10 +280,7 @@ module EvalStackValue =
|> 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
| CliType.ValueType fields -> fields |> List.map ofCliType |> EvalStackValue.UserDefinedValueType
type EvalStack =
{
@@ -340,5 +314,3 @@ type EvalStack =
let v = EvalStackValue.ofCliType v
EvalStack.Push' v stack
static member PeekNthFromTop (n : int) (stack : EvalStack) : EvalStackValue option = stack.Values |> List.tryItem n

8
WoofWare.PawPrint/EvalStackValueComparisons.fs
View File

@@ -120,14 +120,9 @@ module EvalStackValueComparisons =
failwith "TODO"
| other1, other2 -> failwith $"Cgt.un instruction invalid for comparing {other1} vs {other2}"
let rec ceq (var1 : EvalStackValue) (var2 : EvalStackValue) : bool =
let 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.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}"
@@ -156,3 +151,4 @@ module EvalStackValueComparisons =
| EvalStackValue.ManagedPointer var1, EvalStackValue.NativeInt var2 ->
failwith $"TODO (CEQ): managed pointer vs nativeint"
| EvalStackValue.ManagedPointer _, _ -> failwith $"bad ceq: ManagedPointer vs {var2}"
| EvalStackValue.UserDefinedValueType _, _ -> failwith $"bad ceq: UserDefinedValueType vs {var2}"

27
WoofWare.PawPrint/Exceptions.fs
View File

@@ -1,32 +1,29 @@
namespace WoofWare.PawPrint
open System
open System.Collections.Immutable
/// Represents a location in the code where an exception occurred
type ExceptionStackFrame<'typeGen, 'methodGen, 'methodVar
when 'typeGen : comparison and 'typeGen :> IComparable<'typeGen>> =
type ExceptionStackFrame =
{
Method : WoofWare.PawPrint.MethodInfo<'typeGen, 'methodGen, 'methodVar>
Method : WoofWare.PawPrint.MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle>
/// The number of bytes into the IL of the method we were in
IlOffset : int
}
/// Represents a CLI exception being propagated
type CliException<'typeGen, 'methodGen, 'methodVar when 'typeGen : comparison and 'typeGen :> IComparable<'typeGen>> =
type CliException =
{
/// The exception object allocated on the heap
ExceptionObject : ManagedHeapAddress
/// Stack trace built during unwinding
StackTrace : ExceptionStackFrame<'typeGen, 'methodGen, 'methodVar> list
StackTrace : ExceptionStackFrame list
}
/// Represents what to do after executing a finally/filter block
type ExceptionContinuation<'typeGen, 'methodGen, 'methodVar
when 'typeGen : comparison and 'typeGen :> IComparable<'typeGen>> =
type ExceptionContinuation =
| ResumeAfterFinally of targetPC : int
| PropagatingException of exn : CliException<'typeGen, 'methodGen, 'methodVar>
| ResumeAfterFilter of handlerPC : int * exn : CliException<'typeGen, 'methodGen, 'methodVar>
| PropagatingException of exn : CliException
| ResumeAfterFilter of handlerPC : int * exn : CliException
/// Helper functions for exception handling
[<RequireQualifiedAccess>]
@@ -34,7 +31,7 @@ module ExceptionHandling =
/// Check if an exception type matches a catch handler type
let private isExceptionAssignableTo
(exceptionType : ConcreteTypeHandle)
(exceptionTypeCrate : TypeInfoCrate)
(catchTypeToken : MetadataToken)
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
: bool
@@ -46,8 +43,8 @@ module ExceptionHandling =
/// Also returns `isFinally : bool`: whether this is a `finally` block (as opposed to e.g. a `catch`).
let findExceptionHandler
(currentPC : int)
(exceptionType : ConcreteTypeHandle)
(method : WoofWare.PawPrint.MethodInfo<'typeGen, 'methodGeneric, 'methodVar>)
(exceptionTypeCrate : TypeInfoCrate)
(method : WoofWare.PawPrint.MethodInfo<'typeGeneric, 'methodGeneric, 'methodVar>)
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
: (WoofWare.PawPrint.ExceptionRegion * bool) option // handler, isFinally
=
@@ -62,7 +59,7 @@ module ExceptionHandling =
| ExceptionRegion.Catch (typeToken, offset) ->
if currentPC >= offset.TryOffset && currentPC < offset.TryOffset + offset.TryLength then
// Check if exception type matches
if isExceptionAssignableTo exceptionType typeToken assemblies then
if isExceptionAssignableTo exceptionTypeCrate typeToken assemblies then
Some (region, false)
else
None
@@ -125,7 +122,7 @@ module ExceptionHandling =
/// Get the active exception regions at a given offset
let getActiveRegionsAtOffset
(offset : int)
(method : WoofWare.PawPrint.MethodInfo<'a, 'b, 'c>)
(method : WoofWare.PawPrint.MethodInfo<'typeGeneric, 'methodGeneric, 'methodVar>)
: WoofWare.PawPrint.ExceptionRegion list
=
match method.Instructions with

2
WoofWare.PawPrint/ExternImplementations/System.Threading.Monitor.fs
View File

@@ -82,7 +82,7 @@ module System_Threading_Monitor =
| ManagedPointerSource.Null -> failwith "logic error"
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) ->
state
|> IlMachineState.setLocalVariable sourceThread methodFrame whichVar (CliType.ofBool true)
|> IlMachineState.setLocalVariable sourceThread methodFrame whichVar (CliType.OfBool true)
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) ->
failwith "not really expecting to *edit* an argument..."
| ManagedPointerSource.Heap addr -> failwith "todo: managed heap"

111
WoofWare.PawPrint/FieldHandleRegistry.fs
View File

@@ -1,111 +0,0 @@
namespace WoofWare.PawPrint
open System.Reflection
open System.Reflection.Metadata
type FieldHandle =
private
{
AssemblyFullName : string
DeclaringType : ConcreteTypeHandle
FieldHandle : ComparableFieldDefinitionHandle
}
type FieldHandleRegistry =
private
{
FieldHandleToId : Map<FieldHandle, int64>
FieldHandleToField : Map<ManagedHeapAddress, FieldHandle>
FieldToHandle : Map<FieldHandle, ManagedHeapAddress>
NextHandle : int64
}
[<RequireQualifiedAccess>]
module FieldHandleRegistry =
let empty () =
{
FieldHandleToField = Map.empty
FieldToHandle = Map.empty
FieldHandleToId = Map.empty
NextHandle = 1L
}
/// Returns a (struct) System.RuntimeFieldHandle, with its contents (reference type) freshly allocated if necessary.
let getOrAllocate
(baseClassTypes : BaseClassTypes<'corelib>)
(allocState : 'allocState)
(allocate : (string * CliType) list -> 'allocState -> ManagedHeapAddress * 'allocState)
(declaringAssy : AssemblyName)
(declaringType : ConcreteTypeHandle)
(handle : FieldDefinitionHandle)
(reg : FieldHandleRegistry)
: CliType * FieldHandleRegistry * 'allocState
=
let runtimeFieldHandle (runtimeFieldInfoStub : ManagedHeapAddress) =
// RuntimeFieldHandle is a struct; it contains one field, an IRuntimeFieldInfo
// https://github.com/dotnet/runtime/blob/1d1bf92fcf43aa6981804dc53c5174445069c9e4/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L1048
// In practice we expect to use RuntimeFieldInfoStub for that IRuntimeFieldInfo:
// https://github.com/dotnet/runtime/blob/1d1bf92fcf43aa6981804dc53c5174445069c9e4/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L1157
let runtimeFieldHandleType = baseClassTypes.RuntimeFieldHandle
let field = runtimeFieldHandleType.Fields |> List.exactlyOne
if field.Name <> "m_ptr" then
failwith $"unexpected field name %s{field.Name} for BCL type RuntimeFieldHandle"
{
Fields = [ "m_ptr", CliType.ofManagedObject runtimeFieldInfoStub ]
}
|> CliType.ValueType
let handle =
{
AssemblyFullName = declaringAssy.FullName
FieldHandle = ComparableFieldDefinitionHandle.Make handle
DeclaringType = declaringType
}
match Map.tryFind handle reg.FieldToHandle with
| Some v -> runtimeFieldHandle v, reg, allocState
| None ->
let newHandle = reg.NextHandle
let runtimeFieldHandleInternal =
let field = baseClassTypes.RuntimeFieldHandleInternal.Fields |> List.exactlyOne
if field.Name <> "m_handle" then
failwith $"unexpected field name %s{field.Name} for BCL type RuntimeFieldHandleInternal"
match field.Signature with
| TypeDefn.PrimitiveType PrimitiveType.IntPtr -> ()
| s -> failwith $"bad sig: {s}"
{
Fields = [ "m_handle", CliType.RuntimePointer (CliRuntimePointer.Unmanaged newHandle) ]
}
|> CliType.ValueType
let runtimeFieldInfoStub =
[
// 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
// RuntimeFieldHandleInternal: https://github.com/dotnet/runtime/blob/1d1bf92fcf43aa6981804dc53c5174445069c9e4/src/coreclr/System.Private.CoreLib/src/System/RuntimeHandles.cs#L1048
"m_fieldHandle", runtimeFieldHandleInternal
]
let alloc, state = allocate runtimeFieldInfoStub allocState
let reg =
{
FieldHandleToField = reg.FieldHandleToField |> Map.add alloc handle
FieldToHandle = reg.FieldToHandle |> Map.add handle alloc
FieldHandleToId = reg.FieldHandleToId |> Map.add handle newHandle
NextHandle = reg.NextHandle + 1L
}
runtimeFieldHandle alloc, reg, state

1651
WoofWare.PawPrint/IlMachineState.fs
View File

File diff suppressed because it is too large Load Diff

849
WoofWare.PawPrint/IlMachineStateExecution.fs
View File

@@ -1,849 +0,0 @@
namespace WoofWare.PawPrint
open System
open System.Collections.Immutable
open System.Reflection
open System.Reflection.Metadata
open System.Runtime.CompilerServices
open Microsoft.Extensions.Logging
[<RequireQualifiedAccess>]
module IlMachineStateExecution =
let getTypeOfObj
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(state : IlMachineState)
(esv : EvalStackValue)
: IlMachineState * ConcreteTypeHandle
=
match esv with
| EvalStackValue.Int32 _ ->
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make baseClassTypes.Int32.TypeDefHandle,
baseClassTypes.Corelib.Name.FullName,
SignatureTypeKind.ValueType
)
|> IlMachineState.concretizeType
baseClassTypes
state
baseClassTypes.Corelib.Name
ImmutableArray.Empty
ImmutableArray.Empty
| EvalStackValue.Int64 _ ->
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make baseClassTypes.Int64.TypeDefHandle,
baseClassTypes.Corelib.Name.FullName,
SignatureTypeKind.ValueType
)
|> IlMachineState.concretizeType
baseClassTypes
state
baseClassTypes.Corelib.Name
ImmutableArray.Empty
ImmutableArray.Empty
| EvalStackValue.NativeInt nativeIntSource -> failwith "todo"
| EvalStackValue.Float _ ->
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make baseClassTypes.Double.TypeDefHandle,
baseClassTypes.Corelib.Name.FullName,
SignatureTypeKind.ValueType
)
|> IlMachineState.concretizeType
baseClassTypes
state
baseClassTypes.Corelib.Name
ImmutableArray.Empty
ImmutableArray.Empty
| EvalStackValue.ManagedPointer src ->
match src with
| ManagedPointerSource.LocalVariable (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.Argument (sourceThread, methodFrame, whichVar) -> failwith "todo"
| ManagedPointerSource.Heap addr ->
let o = ManagedHeap.Get addr state.ManagedHeap
state, o.ConcreteType
| ManagedPointerSource.ArrayIndex (arr, index) -> failwith "todo"
| ManagedPointerSource.Null -> failwith "todo"
| EvalStackValue.ObjectRef addr ->
let o = ManagedHeap.Get addr state.ManagedHeap
state, o.ConcreteType
| EvalStackValue.UserDefinedValueType tuples -> failwith "todo"
let isAssignableFrom
(objToCast : ConcreteTypeHandle)
(possibleTargetType : ConcreteTypeHandle)
(state : IlMachineState)
: bool
=
if objToCast = possibleTargetType then
true
else
let objToCast' = AllConcreteTypes.lookup objToCast state.ConcreteTypes |> Option.get
let possibleTargetType' =
AllConcreteTypes.lookup possibleTargetType state.ConcreteTypes |> Option.get
// TODO: null can be assigned to any reference type; might not be relevant here?
match possibleTargetType with
| ConcreteObj state.ConcreteTypes -> true
| ConcreteValueType state.ConcreteTypes when failwith "check if objToCast inherits ValueType" -> true
| _ ->
// Claude describes the algorithm here:
// https://claude.ai/chat/f15e23f6-a27b-4655-9e69-e4d445dd1249
failwith
$"TODO: check inheritance chain and interfaces: is {objToCast'} assignable from {possibleTargetType'}?"
let callMethod
(loggerFactory : ILoggerFactory)
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(wasInitialising : ConcreteTypeHandle option)
(wasConstructing : ManagedHeapAddress option)
(performInterfaceResolution : bool)
(wasClassConstructor : bool)
(advanceProgramCounterOfCaller : bool)
(methodGenerics : ImmutableArray<ConcreteTypeHandle>)
(methodToCall : WoofWare.PawPrint.MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle>)
(thread : ThreadId)
(threadState : ThreadState)
(state : IlMachineState)
: IlMachineState
=
let logger = loggerFactory.CreateLogger "CallMethod"
let activeAssy = state.ActiveAssembly thread
// Check for intrinsics first
let isIntrinsic =
MethodInfo.isJITIntrinsic
(fun handle ->
match activeAssy.Members.[handle].Parent with
| MetadataToken.TypeReference r -> activeAssy.TypeRefs.[r]
| x -> failwith $"{x}"
)
activeAssy.Methods
methodToCall
match
if isIntrinsic then
Intrinsics.call 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)
||> List.fold (fun (state, zeros) tyHandle ->
let zero, state = IlMachineState.cliTypeZeroOfHandle state baseClassTypes tyHandle
state, zero :: zeros
)
let argZeroObjects = List.rev argZeroObjects
let activeMethodState = threadState.MethodStates.[threadState.ActiveMethodState]
let state, methodToCall =
match methodToCall.Instructions, performInterfaceResolution, methodToCall.IsStatic with
| None, true, false ->
logger.LogDebug (
"Identifying target of virtual call for {TypeName}.{MethodName}",
methodToCall.DeclaringType.Name,
methodToCall.Name
)
// This might be an interface implementation, or implemented by native code.
// If native code, we'll deal with that when we actually start implementing.
// Since we're not static, there's a `this` on the eval stack.
// It comes *below* all the arguments.
let callingObj =
match
activeMethodState.EvaluationStack
|> EvalStack.PeekNthFromTop methodToCall.Parameters.Length
with
| None -> failwith "unexpectedly no `this` on the eval stack of instance method"
| Some this -> this
let state, callingObjTyHandle = getTypeOfObj baseClassTypes state callingObj
let callingObjTy =
let ty =
AllConcreteTypes.lookup callingObjTyHandle state.ConcreteTypes |> Option.get
state.LoadedAssembly(ty.Assembly).Value.TypeDefs.[ty.Definition.Get]
let declaringAssy = state.LoadedAssembly(methodToCall.DeclaringType.Assembly).Value
let methodDeclaringType =
declaringAssy.TypeDefs.[methodToCall.DeclaringType.Definition.Get]
let interfaceExplicitNamedMethod =
if methodDeclaringType.IsInterface then
Some
$"{TypeInfo.fullName (fun h -> declaringAssy.TypeDefs.[h]) methodDeclaringType}.{methodToCall.Name}"
else
None
// Does type `callingObjTy` implement this method? If so, this is probably a JIT intrinsic or
// is supplied by the runtime.
let selfImplementation, state =
(state, callingObjTy.Methods)
||> List.mapFold (fun state meth ->
if
meth.Signature.GenericParameterCount
<> methodToCall.Signature.GenericParameterCount
|| meth.Signature.RequiredParameterCount
<> methodToCall.Signature.RequiredParameterCount
then
None, state
else if
meth.Name <> methodToCall.Name && Some meth.Name <> interfaceExplicitNamedMethod
then
None, state
else
// TODO: check if methodToCall's declaringtype is an interface; if so, check the possible prefixed name first
let state, retType =
meth.Signature.ReturnType
|> IlMachineState.concretizeType
baseClassTypes
state
meth.DeclaringType.Assembly
methodToCall.DeclaringType.Generics
methodToCall.Generics
let paramTypes, state =
(state, meth.Signature.ParameterTypes)
||> Seq.mapFold (fun state ty ->
ty
|> IlMachineState.concretizeType
baseClassTypes
state
meth.DeclaringType.Assembly
methodToCall.DeclaringType.Generics
methodToCall.Generics
|> fun (a, b) -> b, a
)
let paramTypes = List.ofSeq paramTypes
if
isAssignableFrom retType methodToCall.Signature.ReturnType state
&& paramTypes = methodToCall.Signature.ParameterTypes
then
Some (meth, Some meth.Name = interfaceExplicitNamedMethod), state
else
None, state
)
let selfImplementation =
selfImplementation
|> List.choose id
|> List.sortBy (fun (_, isInterface) -> if isInterface then -1 else 0)
match selfImplementation with
| (impl, true) :: l when (l |> List.forall (fun (_, b) -> not b)) ->
logger.LogDebug "Found concrete implementation from an interface"
let typeGenerics =
AllConcreteTypes.lookup callingObjTyHandle state.ConcreteTypes
|> Option.get
|> _.Generics
let state, meth, _ =
IlMachineState.concretizeMethodWithAllGenerics
loggerFactory
baseClassTypes
typeGenerics
impl
methodGenerics
state
state, meth
| [ impl, false ] ->
logger.LogDebug "Found concrete implementation"
// Yes, callingObjTy implements the method directly. No need to look up interfaces.
let typeGenerics =
AllConcreteTypes.lookup callingObjTyHandle state.ConcreteTypes
|> Option.get
|> _.Generics
let state, meth, _ =
IlMachineState.concretizeMethodWithAllGenerics
loggerFactory
baseClassTypes
typeGenerics
impl
methodGenerics
state
state, meth
| _ :: _ ->
selfImplementation
|> List.map (fun (m, _) -> m.Name)
|> String.concat ", "
|> failwithf "multiple options: %s"
| [] ->
logger.LogDebug "No concrete implementation found; scanning interfaces"
// If not, what interfaces does it implement, and do any of those implement the method?
let possibleInterfaceMethods, state =
(state, callingObjTy.ImplementedInterfaces)
||> Seq.mapFold (fun state impl ->
let assy = state.LoadedAssembly impl.RelativeToAssembly |> Option.get
let state, defn =
match impl.InterfaceHandle with
| MetadataToken.TypeDefinition defn ->
let state, defn = IlMachineState.lookupTypeDefn baseClassTypes state assy defn
let state, _, defn =
// TODO: generics
IlMachineState.resolveTypeFromDefn
loggerFactory
baseClassTypes
defn
ImmutableArray.Empty
ImmutableArray.Empty
assy
state
state, defn
| MetadataToken.TypeReference ty ->
let state, defn, assy =
IlMachineState.lookupTypeRef loggerFactory baseClassTypes state assy Seq.empty ty
state, failwith "TODO"
| MetadataToken.TypeSpecification spec ->
// TODO: generics
let state, assy, defn =
IlMachineState.resolveTypeFromSpec
loggerFactory
baseClassTypes
spec
assy
ImmutableArray.Empty
ImmutableArray.Empty
state
state, defn
| handle -> failwith $"unexpected: {handle}"
logger.LogDebug (
"Interface {InterfaceName} (generics: {InterfaceGenerics})",
defn.Name,
defn.Generics
)
let s, state =
defn.Methods
|> Seq.filter (fun mi -> mi.Name = methodToCall.Name
// TODO: also the rest of the signature
)
|> Seq.mapFold
(fun state meth ->
// TODO: generics
let state, mi, _ =
IlMachineState.concretizeMethodForExecution
loggerFactory
baseClassTypes
thread
meth
None
(if defn.Generics.IsEmpty then None else Some defn.Generics)
state
mi, state
)
state
s, state
)
let possibleInterfaceMethods = possibleInterfaceMethods |> Seq.concat |> Seq.toList
match possibleInterfaceMethods with
| [] ->
logger.LogDebug "No interface implementation found either"
state, methodToCall
| [ meth ] ->
logger.LogDebug (
"Exactly one interface implementation found {DeclaringTypeNamespace}.{DeclaringTypeName}.{MethodName} ({MethodGenerics})",
meth.DeclaringType.Namespace,
meth.DeclaringType.Name,
meth.Name,
meth.Generics
)
state, meth
| _ -> failwith "TODO: handle overloads"
| _, _, true
| _, false, _
| Some _, _, _ -> state, methodToCall
// Helper to pop and coerce a single argument
let popAndCoerceArg zeroType methodState =
let value, newState = MethodState.popFromStack methodState
EvalStackValue.toCliTypeCoerced zeroType value, newState
// Collect arguments based on calling convention
let args, afterPop =
if methodToCall.IsStatic then
// Static method: pop args in reverse order
let args = ImmutableArray.CreateBuilder methodToCall.Parameters.Length
let mutable currentState = activeMethodState
for i = methodToCall.Parameters.Length - 1 downto 0 do
let arg, newState = popAndCoerceArg argZeroObjects.[i] currentState
args.Add arg
currentState <- newState
args.Reverse ()
args.ToImmutable (), currentState
else
// Instance method: handle `this` pointer
let argCount = methodToCall.Parameters.Length
let args = ImmutableArray.CreateBuilder (argCount + 1)
let mutable currentState = activeMethodState
match wasConstructing with
| Some _ ->
// Constructor: `this` is on top of stack, by our own odd little calling convention
// where Newobj puts the object pointer on top
let thisArg, newState =
popAndCoerceArg
(CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null))
currentState
currentState <- newState
// Pop remaining args in reverse
for i = argCount - 1 downto 0 do
let arg, newState = popAndCoerceArg argZeroObjects.[i] currentState
args.Add arg
currentState <- newState
args.Add thisArg
args.Reverse ()
args.ToImmutable (), currentState
| None ->
// Regular instance method: args then `this`
for i = argCount - 1 downto 0 do
let arg, newState = popAndCoerceArg argZeroObjects.[i] currentState
args.Add arg
currentState <- newState
let thisArg, newState =
popAndCoerceArg
(CliType.RuntimePointer (CliRuntimePointer.Managed CliRuntimePointerSource.Null))
currentState
args.Add thisArg
currentState <- newState
args.Reverse ()
args.ToImmutable (), currentState
// Helper to create new frame with assembly loading
let rec createNewFrame state =
let returnInfo =
Some
{
JumpTo = threadState.ActiveMethodState
WasInitialisingType = wasInitialising
WasConstructingObj = wasConstructing
}
match
MethodState.Empty
state.ConcreteTypes
baseClassTypes
state._LoadedAssemblies
(state.ActiveAssembly thread)
methodToCall
methodGenerics
args
returnInfo
with
| Ok frame -> state, frame
| Error toLoad ->
let state' =
(state, toLoad)
||> List.fold (fun s (asmRef : WoofWare.PawPrint.AssemblyReference) ->
let s, _, _ =
IlMachineState.loadAssembly
loggerFactory
(state.LoadedAssembly methodToCall.DeclaringType.Assembly |> Option.get)
(fst asmRef.Handle)
s
s
)
createNewFrame state'
let state, newFrame = createNewFrame state
let oldFrame =
if wasClassConstructor || not advanceProgramCounterOfCaller then
afterPop
else
afterPop |> MethodState.advanceProgramCounter
let newThreadState =
{ threadState with
MethodStates = threadState.MethodStates.Add(newFrame).SetItem (threadState.ActiveMethodState, oldFrame)
ActiveMethodState = threadState.MethodStates.Length
}
{ state with
ThreadState = state.ThreadState |> Map.add thread newThreadState
}
let rec loadClass
(loggerFactory : ILoggerFactory)
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(ty : ConcreteTypeHandle)
(currentThread : ThreadId)
(state : IlMachineState)
: StateLoadResult
=
let logger = loggerFactory.CreateLogger "LoadClass"
match TypeInitTable.tryGet ty state.TypeInitTable with
| Some TypeInitState.Initialized ->
// Type already initialized; nothing to do
StateLoadResult.NothingToDo state
| Some (TypeInitState.InProgress tid) when tid = currentThread ->
// We're already initializing this type on this thread; just proceed with the initialisation, no extra
// class loading required.
StateLoadResult.NothingToDo state
| Some (TypeInitState.InProgress _) ->
// This is usually signalled by WhatWeDid.Blocked
failwith
"TODO: cross-thread class init synchronization unimplemented - this thread has to wait for the other thread to finish initialisation"
| None ->
// We have work to do!
// Look up the concrete type from the handle
let concreteType =
match AllConcreteTypes.lookup ty state.ConcreteTypes with
| Some ct -> ct
| None -> failwith $"ConcreteTypeHandle {ty} not found in ConcreteTypes mapping"
let state, origAssyName =
state.WithThreadSwitchedToAssembly concreteType.Assembly currentThread
let sourceAssembly = state.LoadedAssembly concreteType.Assembly |> Option.get
let typeDef =
match sourceAssembly.TypeDefs.TryGetValue concreteType.Definition.Get with
| false, _ ->
failwith
$"Failed to find type definition {concreteType.Definition.Get} in {concreteType.Assembly.FullName}"
| true, v -> v
logger.LogDebug ("Resolving type {TypeDefNamespace}.{TypeDefName}", typeDef.Namespace, typeDef.Name)
// First mark as in-progress to detect cycles
let state = state.WithTypeBeginInit currentThread ty
// Check if the type has a base type that needs initialization
let firstDoBaseClass =
match typeDef.BaseType with
| Some baseTypeInfo ->
// Determine if base type is in the same or different assembly
match baseTypeInfo with
| BaseTypeInfo.ForeignAssemblyType _ -> failwith "TODO"
//logger.LogDebug (
// "Resolved base type of {TypeDefNamespace}.{TypeDefName} to foreign assembly {ForeignAssemblyName}",
// typeDef.Namespace,
// typeDef.Name,
// baseAssemblyName.Name
//)
//match loadClass loggerFactory baseTypeHandle baseAssemblyName currentThread state with
//| FirstLoadThis state -> Error state
//| NothingToDo state -> Ok state
| BaseTypeInfo.TypeDef typeDefinitionHandle ->
logger.LogDebug (
"Resolved base type of {TypeDefNamespace}.{TypeDefName} to this assembly, typedef",
typeDef.Namespace,
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
)
// Concretize the base type
let state, baseTypeHandle =
IlMachineState.concretizeType
baseClassTypes
state
sourceAssembly.Name
concreteType.Generics
// TODO: surely we have generics in scope here?
ImmutableArray.Empty
baseTypeDefn
// Recursively load the base class
match loadClass loggerFactory baseClassTypes baseTypeHandle currentThread state with
| FirstLoadThis state -> Error state
| NothingToDo state -> Ok state
| BaseTypeInfo.TypeRef typeReferenceHandle ->
let state, assy, targetType =
// TypeRef won't have any generics; it would be a TypeSpec if it did
IlMachineState.resolveType
loggerFactory
typeReferenceHandle
ImmutableArray.Empty
(state.ActiveAssembly currentThread)
state
logger.LogDebug (
"Resolved base type of {TypeDefNamespace}.{TypeDefName} to a typeref in assembly {ResolvedAssemblyName}, {BaseTypeNamespace}.{BaseTypeName}",
typeDef.Namespace,
typeDef.Name,
assy.Name.Name,
targetType.Namespace,
targetType.Name
)
// 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
)
// Concretize the base type
let state, baseTypeHandle =
IlMachineState.concretizeType
baseClassTypes
state
sourceAssembly.Name
concreteType.Generics
// TODO: surely we have generics in scope here?
ImmutableArray.Empty
baseTypeDefn
// Recursively load the base class
match loadClass loggerFactory baseClassTypes baseTypeHandle currentThread state with
| FirstLoadThis state -> Error state
| NothingToDo state -> Ok state
| BaseTypeInfo.TypeSpec typeSpecificationHandle ->
failwith "TODO: TypeSpec base type loading unimplemented"
| None -> Ok state // No base type (or it's System.Object)
match firstDoBaseClass with
| Error state -> FirstLoadThis state
| Ok state ->
// TODO: also need to initialise all interfaces implemented by the type
// Find the class constructor (.cctor) if it exists
let cctor =
typeDef.Methods
|> List.tryFind (fun method -> method.Name = ".cctor" && method.IsStatic && method.Parameters.IsEmpty)
match cctor with
| Some cctorMethod ->
// Call the class constructor! Note that we *don't* use `callMethodInActiveAssembly`, because that
// performs class loading, but we're already in the middle of loading this class.
// TODO: factor out the common bit.
let currentThreadState = state.ThreadState.[currentThread]
// Convert the method's type generics from TypeDefn to ConcreteTypeHandle
let cctorMethodWithTypeGenerics =
cctorMethod
|> MethodInfo.mapTypeGenerics (fun (par, _) -> concreteType.Generics.[par.SequenceNumber])
// Convert method generics (should be empty for cctor)
let cctorMethodWithMethodGenerics =
cctorMethodWithTypeGenerics
|> MethodInfo.mapMethodGenerics (fun _ -> failwith "cctor cannot be generic")
// Convert method signature from TypeDefn to ConcreteTypeHandle using concretization
let state, convertedSignature =
cctorMethodWithMethodGenerics.Signature
|> TypeMethodSignature.map
state
(fun state typeDefn ->
IlMachineState.concretizeType
baseClassTypes
state
concreteType.Assembly
concreteType.Generics
// no method generics for cctor
ImmutableArray.Empty
typeDefn
)
// Convert method instructions (local variables)
let state, convertedInstructions =
match cctorMethodWithMethodGenerics.Instructions with
| None -> state, None
| Some methodInstr ->
let state, convertedLocalVars =
match methodInstr.LocalVars with
| None -> state, None
| Some localVars ->
// Concretize each local variable type
let state, convertedVars =
((state, []), localVars)
||> Seq.fold (fun (state, acc) typeDefn ->
let state, handle =
IlMachineState.concretizeType
baseClassTypes
state
concreteType.Assembly
concreteType.Generics
ImmutableArray.Empty // no method generics for cctor
typeDefn
state, handle :: acc
)
|> Tuple.rmap ImmutableArray.CreateRange
state, Some convertedVars
state, Some (MethodInstructions.setLocalVars convertedLocalVars methodInstr)
let fullyConvertedMethod =
MethodInfo.setMethodVars convertedInstructions convertedSignature cctorMethodWithMethodGenerics
callMethod
loggerFactory
baseClassTypes
(Some ty)
None
true
true
false
// constructor is surely not generic
ImmutableArray.Empty
fullyConvertedMethod
currentThread
currentThreadState
state
|> FirstLoadThis
| None ->
// No constructor, just continue.
// Mark the type as initialized.
let state = state.WithTypeEndInit currentThread ty
// Restore original assembly context if needed
state.WithThreadSwitchedToAssembly origAssyName currentThread
|> fst
|> NothingToDo
let ensureTypeInitialised
(loggerFactory : ILoggerFactory)
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(thread : ThreadId)
(ty : ConcreteTypeHandle)
(state : IlMachineState)
: IlMachineState * WhatWeDid
=
match TypeInitTable.tryGet ty state.TypeInitTable with
| None ->
match loadClass loggerFactory baseClassTypes ty thread state with
| NothingToDo state -> state, WhatWeDid.Executed
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| Some TypeInitState.Initialized -> state, WhatWeDid.Executed
| Some (InProgress threadId) ->
if threadId = thread then
// II.10.5.3.2: avoid the deadlock by simply proceeding.
state, WhatWeDid.Executed
else
state, WhatWeDid.BlockedOnClassInit threadId
/// It may be useful to *not* advance the program counter of the caller, e.g. if you're using `callMethodInActiveAssembly`
/// as a convenient way to move to a different method body rather than to genuinely perform a call.
/// (Delegates do this, for example: we get a call to invoke the delegate, and then we implement the delegate as
/// another call to its function pointer.)
let callMethodInActiveAssembly
(loggerFactory : ILoggerFactory)
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(thread : ThreadId)
(performInterfaceResolution : bool)
(advanceProgramCounterOfCaller : bool)
(methodGenerics : TypeDefn ImmutableArray option)
(methodToCall : WoofWare.PawPrint.MethodInfo<TypeDefn, GenericParamFromMetadata, TypeDefn>)
(weAreConstructingObj : ManagedHeapAddress option)
(typeArgsFromMetadata : TypeDefn ImmutableArray option)
(state : IlMachineState)
: IlMachineState * WhatWeDid
=
let threadState = state.ThreadState.[thread]
let state, concretizedMethod, declaringTypeHandle =
IlMachineState.concretizeMethodForExecution
loggerFactory
baseClassTypes
thread
methodToCall
methodGenerics
typeArgsFromMetadata
state
let state, typeInit =
ensureTypeInitialised loggerFactory baseClassTypes thread declaringTypeHandle state
match typeInit with
| WhatWeDid.Executed ->
callMethod
loggerFactory
baseClassTypes
None
weAreConstructingObj
performInterfaceResolution
false
advanceProgramCounterOfCaller
concretizedMethod.Generics
concretizedMethod
thread
threadState
state,
WhatWeDid.Executed
| _ -> state, typeInit

14
WoofWare.PawPrint/ImmutableArray.fs
View File

@@ -1,14 +0,0 @@
namespace WoofWare.PawPrint
open System.Collections.Immutable
[<RequireQualifiedAccess>]
module internal ImmutableArray =
let map (f : 'a -> 'b) (arr : ImmutableArray<'a>) : ImmutableArray<'b> =
let b = ImmutableArray.CreateBuilder ()
for i in arr do
b.Add (f i)
b.ToImmutable ()

307
WoofWare.PawPrint/Intrinsics.fs
View File

@@ -1,307 +0,0 @@
namespace WoofWare.PawPrint
open System
[<RequireQualifiedAccess>]
module Intrinsics =
let private safeIntrinsics =
[
// The IL implementation is fine: https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/Runtime/CompilerServices/Unsafe.cs#L677
"System.Private.CoreLib", "Unsafe", "AsRef"
// https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/String.cs#L739-L750
"System.Private.CoreLib", "String", "get_Length"
// https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/ArgumentNullException.cs#L54
"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"
]
|> Set.ofList
let call
(baseClassTypes : BaseClassTypes<_>)
(methodToCall : WoofWare.PawPrint.MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle>)
(currentThread : ThreadId)
(state : IlMachineState)
: IlMachineState option
=
let callerAssy =
state.ThreadState.[currentThread].MethodState.ExecutingMethod.DeclaringType.Assembly
if
methodToCall.DeclaringType.Assembly.Name = "System.Private.CoreLib"
&& methodToCall.DeclaringType.Name = "Volatile"
then
// These are all safely implemented in IL, just inefficient.
// https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/Threading/Volatile.cs#L13
None
elif
Set.contains
(methodToCall.DeclaringType.Assembly.Name, methodToCall.DeclaringType.Name, methodToCall.Name)
safeIntrinsics
then
None
else
match methodToCall.DeclaringType.Assembly.Name, methodToCall.DeclaringType.Name, methodToCall.Name with
| "System.Private.CoreLib", "Type", "get_TypeHandle" ->
// TODO: check return type is RuntimeTypeHandle
match methodToCall.Signature.ParameterTypes with
| _ :: _ -> failwith "bad signature Type.get_TypeHandle"
| _ -> ()
// https://github.com/dotnet/runtime/blob/ec11903827fc28847d775ba17e0cd1ff56cfbc2e/src/libraries/System.Private.CoreLib/src/System/Type.cs#L470
// no args, returns RuntimeTypeHandle, a struct with a single field (a RuntimeType class)
// The thing on top of the stack will be a RuntimeType.
let arg, state = IlMachineState.popEvalStack currentThread state
let arg =
let rec go (arg : EvalStackValue) =
match arg with
| EvalStackValue.UserDefinedValueType [ _, s ] -> go s
| EvalStackValue.ManagedPointer ManagedPointerSource.Null -> failwith "TODO: throw NRE"
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap addr) -> Some addr
| s -> failwith $"TODO: called with unrecognised arg %O{s}"
go arg
let state =
let vt =
{
Fields = [ "m_type", CliType.ObjectRef arg ]
}
IlMachineState.pushToEvalStack (CliType.ValueType vt) currentThread state
|> IlMachineState.advanceProgramCounter currentThread
Some state
| "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"
| x -> failwith $"TODO: Unsafe.AsPointer(%O{x})"
IlMachineState.pushToEvalStack (CliType.RuntimePointer toPush) currentThread state
|> IlMachineState.advanceProgramCounter currentThread
|> Some
| "System.Private.CoreLib", "BitConverter", "SingleToInt32Bits" ->
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
| [ ConcreteSingle state.ConcreteTypes ], ConcreteInt32 state.ConcreteTypes -> ()
| _ -> failwith "bad signature BitConverter.SingleToInt32Bits"
let arg, state = IlMachineState.popEvalStack currentThread state
let result =
match arg with
| EvalStackValue.Float f -> BitConverter.SingleToInt32Bits (float32<float> f) |> EvalStackValue.Int32
| _ -> failwith "TODO"
state
|> IlMachineState.pushToEvalStack' result currentThread
|> IlMachineState.advanceProgramCounter currentThread
|> Some
| "System.Private.CoreLib", "BitConverter", "Int32BitsToSingle" ->
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
| [ ConcreteInt32 state.ConcreteTypes ], ConcreteSingle state.ConcreteTypes -> ()
| _ -> failwith "bad signature BitConverter.Int64BitsToSingle"
let arg, state = IlMachineState.popEvalStack currentThread state
let arg =
match arg with
| EvalStackValue.Int32 i -> i
| _ -> failwith "$TODO: {arr}"
let result =
BitConverter.Int32BitsToSingle arg |> CliNumericType.Float32 |> CliType.Numeric
state
|> IlMachineState.pushToEvalStack result currentThread
|> IlMachineState.advanceProgramCounter currentThread
|> Some
| "System.Private.CoreLib", "BitConverter", "Int64BitsToDouble" ->
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
| [ ConcreteInt64 state.ConcreteTypes ], ConcreteDouble state.ConcreteTypes -> ()
| _ -> failwith "bad signature BitConverter.Int64BitsToDouble"
let arg, state = IlMachineState.popEvalStack currentThread state
let arg =
match arg with
| EvalStackValue.Int64 i -> i
| _ -> failwith "$TODO: {arr}"
let result =
BitConverter.Int64BitsToDouble arg |> CliNumericType.Float64 |> CliType.Numeric
state
|> IlMachineState.pushToEvalStack result currentThread
|> IlMachineState.advanceProgramCounter currentThread
|> Some
| "System.Private.CoreLib", "BitConverter", "DoubleToInt64Bits" ->
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
| [ ConcreteDouble state.ConcreteTypes ], ConcreteInt64 state.ConcreteTypes -> ()
| _ -> failwith "bad signature BitConverter.DoubleToInt64Bits"
let arg, state = IlMachineState.popEvalStack currentThread state
let result =
match arg with
| EvalStackValue.Float f -> BitConverter.DoubleToInt64Bits f |> EvalStackValue.Int64
| _ -> failwith "TODO"
state
|> IlMachineState.pushToEvalStack' result currentThread
|> IlMachineState.advanceProgramCounter currentThread
|> Some
| "System.Private.CoreLib", "String", "Equals" ->
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
| [ ConcreteString state.ConcreteTypes ; ConcreteString state.ConcreteTypes ],
ConcreteBool state.ConcreteTypes ->
let arg1, state = IlMachineState.popEvalStack currentThread state
let arg1 =
match arg1 with
| EvalStackValue.ObjectRef h
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> h
| EvalStackValue.Int32 _
| EvalStackValue.Int64 _
| EvalStackValue.Float _ -> failwith $"this isn't a string! {arg1}"
| _ -> failwith $"TODO: %O{arg1}"
let arg2, state = IlMachineState.popEvalStack currentThread state
let arg2 =
match arg2 with
| EvalStackValue.ObjectRef h
| EvalStackValue.ManagedPointer (ManagedPointerSource.Heap h) -> h
| 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 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"
| _ -> None
| "System.Private.CoreLib", "Unsafe", "ReadUnaligned" ->
let ptr, state = IlMachineState.popEvalStack currentThread state
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.NativeInt src -> failwith "TODO"
| EvalStackValue.ObjectRef ptr -> failwith "TODO"
| EvalStackValue.UserDefinedValueType [ _, field ] -> go field
| EvalStackValue.UserDefinedValueType []
| EvalStackValue.UserDefinedValueType (_ :: _ :: _)
| EvalStackValue.Int32 _
| EvalStackValue.Int64 _
| EvalStackValue.Float _ -> failwith $"this isn't a pointer! {ptr}"
go ptr
let state =
state
|> IlMachineState.pushToEvalStack v currentThread
|> IlMachineState.advanceProgramCounter currentThread
Some state
| "System.Private.CoreLib", "String", "op_Implicit" ->
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
| [ par ], ret ->
let par = state.ConcreteTypes |> AllConcreteTypes.lookup par |> Option.get
let ret = state.ConcreteTypes |> AllConcreteTypes.lookup ret |> Option.get
if
par.Namespace = "System"
&& par.Name = "String"
&& ret.Namespace = "System"
&& ret.Name = "ReadOnlySpan`1"
then
match ret.Generics |> Seq.toList with
| [ gen ] ->
let gen = state.ConcreteTypes |> AllConcreteTypes.lookup gen |> Option.get
if gen.Namespace = "System" && gen.Name = "Char" then
// This is just an optimisation
// https://github.com/dotnet/runtime/blob/ab105b51f8b50ec5567d7cfe9001ca54dd6f64c3/src/libraries/System.Private.CoreLib/src/System/String.cs#L363-L366
None
else
failwith "TODO: unexpected params to String.op_Implicit"
| _ -> failwith "TODO: unexpected params to String.op_Implicit"
else
failwith "TODO: unexpected params to String.op_Implicit"
| _ -> failwith "TODO: unexpected params to String.op_Implicit"
| "System.Private.CoreLib", "RuntimeHelpers", "IsReferenceOrContainsReferences" ->
// https://github.com/dotnet/runtime/blob/1d1bf92fcf43aa6981804dc53c5174445069c9e4/src/coreclr/System.Private.CoreLib/src/System/Runtime/CompilerServices/RuntimeHelpers.CoreCLR.cs#L207
match methodToCall.Signature.ParameterTypes, methodToCall.Signature.ReturnType with
| [], ConcreteBool state.ConcreteTypes -> ()
| _ -> failwith "bad signature for System.Private.CoreLib.RuntimeHelpers.IsReferenceOrContainsReference"
let generic =
AllConcreteTypes.lookup (Seq.exactlyOne methodToCall.Generics) state.ConcreteTypes
let generic =
match generic with
| None -> failwith "somehow have not already concretised type in IsReferenceOrContainsReferences"
| Some generic -> generic
failwith $"TODO: do the thing on %O{generic}"
| "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
| [ ConcreteNonGenericArray state.ConcreteTypes ; ConcreteRuntimeFieldHandle state.ConcreteTypes ],
ConcreteVoid state.ConcreteTypes -> ()
| _ -> failwith "bad signature for System.Private.CoreLib.RuntimeHelpers.InitializeArray"
failwith "TODO: if arg0 is null, throw NRE"
failwith "TODO: if arg1 contains null handle, throw ArgumentException"
failwith "TODO: array initialization"
| "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
| a, b, c -> failwith $"TODO: implement JIT intrinsic {a}.{b}.{c}"
|> Option.map (fun s -> s.WithThreadSwitchedToAssembly callerAssy currentThread |> fst)

6
WoofWare.PawPrint/ManagedHeap.fs
View File

@@ -9,7 +9,7 @@ type SyncBlock =
type AllocatedNonArrayObject =
{
Fields : Map<string, CliType>
ConcreteType : ConcreteTypeHandle
Type : WoofWare.PawPrint.TypeInfoCrate
SyncBlock : SyncBlock
}
@@ -119,10 +119,6 @@ type ManagedHeap =
arr.Elements.[offset]
static member Get (alloc : ManagedHeapAddress) (heap : ManagedHeap) : AllocatedNonArrayObject =
// TODO: arrays too
heap.NonArrayObjects.[alloc]
static member SetArrayValue
(alloc : ManagedHeapAddress)
(offset : int)

20
WoofWare.PawPrint/MethodState.fs
View File

@@ -28,7 +28,7 @@ and MethodState =
/// Track which exception regions are currently active (innermost first)
ActiveExceptionRegions : ExceptionRegion list
/// When executing a finally/fault/filter, we need to know where to return
ExceptionContinuation : ExceptionContinuation<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle> option
ExceptionContinuation : ExceptionContinuation option
}
member this.IlOpIndex = this._IlOpIndex
@@ -64,7 +64,7 @@ and MethodState =
EvaluationStack = EvalStack.Empty
}
static member setExceptionContinuation (cont : ExceptionContinuation<_, _, _>) (state : MethodState) : MethodState =
static member setExceptionContinuation (cont : ExceptionContinuation) (state : MethodState) : MethodState =
{ state with
ExceptionContinuation = Some cont
}
@@ -136,8 +136,8 @@ and MethodState =
/// If `method` is an instance method, `args` must be of length 1+numParams.
/// If `method` is static, `args` must be of length numParams.
static member Empty
(concreteTypes : AllConcreteTypes)
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(types : AllConcreteTypes)
(corelib : BaseClassTypes<DumpedAssembly>)
(loadedAssemblies : ImmutableDictionary<string, DumpedAssembly>)
(containingAssembly : DumpedAssembly)
(method : WoofWare.PawPrint.MethodInfo<ConcreteTypeHandle, ConcreteTypeHandle, ConcreteTypeHandle>)
@@ -165,18 +165,20 @@ and MethodState =
// I think valid code should remain valid if we unconditionally localsInit - it should be undefined
// to use an uninitialised value? Not checked this; TODO.
let requiredAssemblies = ResizeArray<WoofWare.PawPrint.AssemblyReference> ()
let localVars =
let result = ImmutableArray.CreateBuilder ()
for var in localVariableSig do
// Note: This assumes all types have already been concretized
// If this fails with "ConcreteTypeHandle not found", it means
// we need to ensure types are concretized before creating the MethodState
let zero, _ = CliType.zeroOf concreteTypes loadedAssemblies baseClassTypes var
result.Add zero
CliType.zeroOf types var |> result.Add
result.ToImmutable ()
if requiredAssemblies.Count > 0 then
Error (requiredAssemblies |> Seq.toList)
else
let activeRegions = ExceptionHandling.getActiveRegionsAtOffset 0 method
{

124
WoofWare.PawPrint/NullaryIlOp.fs
View File

@@ -46,9 +46,7 @@ module NullaryIlOp =
| 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]
| ManagedPointerSource.ArrayIndex _ -> failwith "TODO: array index pointer dereferencing not implemented"
// Unified Ldind implementation
let private executeLdind
@@ -440,8 +438,8 @@ module NullaryIlOp =
|> Tuple.withRight WhatWeDid.Executed
|> ExecutionResult.Stepped
| Sub ->
let val2, state = IlMachineState.popEvalStack currentThread state
let val1, state = IlMachineState.popEvalStack currentThread state
let val2, state = IlMachineState.popEvalStack currentThread state
let result = BinaryArithmetic.execute ArithmeticOperation.sub val1 val2
state
@@ -477,119 +475,11 @@ module NullaryIlOp =
| Mul_ovf_un -> failwith "TODO: Mul_ovf_un unimplemented"
| Div -> failwith "TODO: Div unimplemented"
| Div_un -> failwith "TODO: Div_un unimplemented"
| Shr ->
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 -> i >>> shift |> EvalStackValue.Int32
| EvalStackValue.Int64 i -> i >>> shift |> EvalStackValue.Int64
| EvalStackValue.NativeInt (NativeIntSource.Verbatim i) ->
(i >>> shift) |> 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
| Shr -> failwith "TODO: Shr unimplemented"
| Shr_un -> failwith "TODO: Shr_un unimplemented"
| Shl ->
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 -> i <<< shift |> EvalStackValue.Int32
| EvalStackValue.Int64 i -> i <<< shift |> EvalStackValue.Int64
| EvalStackValue.NativeInt (NativeIntSource.Verbatim i) ->
(i <<< shift) |> 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
| And ->
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
| Or ->
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
| Shl -> failwith "TODO: Shl unimplemented"
| And -> failwith "TODO: And unimplemented"
| Or -> failwith "TODO: Or unimplemented"
| Xor -> failwith "TODO: Xor unimplemented"
| Conv_I ->
let popped, state = IlMachineState.popEvalStack currentThread state
@@ -777,7 +667,7 @@ module NullaryIlOp =
match
ExceptionHandling.findExceptionHandler
currentMethodState.IlOpIndex
heapObject.ConcreteType
heapObject.Type
currentMethodState.ExecutingMethod
state._LoadedAssemblies
with

241
WoofWare.PawPrint/Program.fs
View File

@@ -3,7 +3,6 @@ namespace WoofWare.PawPrint
open System
open System.Collections.Immutable
open System.IO
open System.Reflection.Metadata
open Microsoft.Extensions.Logging
[<RequireQualifiedAccess>]
@@ -15,23 +14,14 @@ module Program =
(state : IlMachineState)
: ManagedHeapAddress * IlMachineState
=
let state, stringType =
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make corelib.String.TypeDefHandle,
corelib.Corelib.Name.FullName,
SignatureTypeKind.Class
)
|> IlMachineState.concretizeType
corelib
state
corelib.Corelib.Name
ImmutableArray.Empty
ImmutableArray.Empty
let argsAllocations, state =
(state, args)
||> Seq.mapFold (fun state arg ->
IlMachineState.allocateManagedObject stringType (failwith "TODO: assert fields and populate") state
IlMachineState.allocateManagedObject
(corelib.String
|> TypeInfo.mapGeneric (fun _ _ -> failwith "there are no generics here"))
(failwith "TODO: assert fields and populate")
state
// TODO: set the char values in memory
)
@@ -42,7 +32,7 @@ module Program =
((state, 0), argsAllocations)
||> Seq.fold (fun (state, i) arg ->
let state =
IlMachineState.setArrayValue arrayAllocation (CliType.ofManagedObject arg) i state
IlMachineState.setArrayValue arrayAllocation (CliType.OfManagedObject arg) i state
state, i + 1
)
@@ -93,180 +83,76 @@ module Program =
| None -> failwith "No entry point in input DLL"
| Some d -> d
let mainMethodFromMetadata = dumped.Methods.[entryPoint]
let mainMethod = dumped.Methods.[entryPoint]
if mainMethodFromMetadata.Signature.GenericParameterCount > 0 then
if mainMethod.Signature.GenericParameterCount > 0 then
failwith "Refusing to execute generic main method"
let state = IlMachineState.initial loggerFactory dotnetRuntimeDirs dumped
// Find the core library by traversing the type hierarchy of the main method's declaring type
// until we reach System.Object
let rec handleBaseTypeInfo
(state : IlMachineState)
(baseTypeInfo : BaseTypeInfo)
(currentAssembly : DumpedAssembly)
(continueWithGeneric :
IlMachineState
-> TypeInfo<GenericParamFromMetadata, TypeDefn>
-> DumpedAssembly
-> IlMachineState * BaseClassTypes<DumpedAssembly> option)
(continueWithResolved :
IlMachineState
-> TypeInfo<TypeDefn, TypeDefn>
-> DumpedAssembly
-> IlMachineState * BaseClassTypes<DumpedAssembly> option)
: IlMachineState * BaseClassTypes<DumpedAssembly> option
=
match baseTypeInfo with
| BaseTypeInfo.TypeRef typeRefHandle ->
// Look up the TypeRef from the handle
let typeRef = currentAssembly.TypeRefs.[typeRefHandle]
let mainMethod' =
mainMethod
|> MethodInfo.mapTypeGenerics (fun _ -> failwith "Refusing to execute generic main method")
|> MethodInfo.mapMethodGenerics (fun _ -> failwith "Refusing to execute generic main method")
let rec go state =
// Resolve the type reference to find which assembly it's in
match
Assembly.resolveTypeRef state._LoadedAssemblies currentAssembly typeRef ImmutableArray.Empty
with
| TypeResolutionResult.FirstLoadAssy assyRef ->
// Need to load this assembly first
let handle, definedIn = assyRef.Handle
let state, _, _ =
IlMachineState.loadAssembly
loggerFactory
state._LoadedAssemblies.[definedIn.FullName]
handle
state
go state
| TypeResolutionResult.Resolved (resolvedAssembly, resolvedType) ->
continueWithResolved state resolvedType resolvedAssembly
go state
| BaseTypeInfo.TypeDef typeDefHandle ->
// Base type is in the same assembly
let baseType = currentAssembly.TypeDefs.[typeDefHandle]
continueWithGeneric state baseType currentAssembly
| BaseTypeInfo.TypeSpec _ -> failwith "Type specs not yet supported in base type traversal"
| BaseTypeInfo.ForeignAssemblyType (assemblyName, typeDefHandle) ->
// Base type is in a foreign assembly
match state._LoadedAssemblies.TryGetValue assemblyName.FullName with
| true, foreignAssembly ->
let baseType = foreignAssembly.TypeDefs.[typeDefHandle]
continueWithGeneric state baseType foreignAssembly
| false, _ -> failwith $"Foreign assembly {assemblyName.FullName} not loaded"
let rec findCoreLibraryAssemblyFromGeneric
(state : IlMachineState)
(currentType : TypeInfo<GenericParamFromMetadata, TypeDefn>)
(currentAssembly : DumpedAssembly)
=
match currentType.BaseType with
| None ->
// We've reached the root (System.Object), so this assembly contains the core library
let baseTypes = Corelib.getBaseTypes currentAssembly
state, Some baseTypes
| Some baseTypeInfo ->
handleBaseTypeInfo
state
baseTypeInfo
currentAssembly
findCoreLibraryAssemblyFromGeneric
findCoreLibraryAssemblyFromResolved
and findCoreLibraryAssemblyFromResolved
(state : IlMachineState)
(currentType : TypeInfo<TypeDefn, TypeDefn>)
(currentAssembly : DumpedAssembly)
=
match currentType.BaseType with
| None ->
// We've reached the root (System.Object), so this assembly contains the core library
let baseTypes = Corelib.getBaseTypes currentAssembly
state, Some baseTypes
| Some baseTypeInfo ->
handleBaseTypeInfo
state
baseTypeInfo
currentAssembly
findCoreLibraryAssemblyFromGeneric
findCoreLibraryAssemblyFromResolved
let mainMethod, state =
mainMethod'
|> MethodInfo.mapVarGenerics state (fun state generic -> failwith "")
let rec computeState (baseClassTypes : BaseClassTypes<DumpedAssembly> option) (state : IlMachineState) =
match baseClassTypes with
| Some baseTypes ->
// We already have base class types, can directly create the concretized method
// Use the original method from metadata, but convert FakeUnit to TypeDefn
let rawMainMethod =
mainMethodFromMetadata
|> MethodInfo.mapTypeGenerics (fun (i, _) -> TypeDefn.GenericTypeParameter i.SequenceNumber)
// The thread's state is slightly fake: we will need to put arguments onto the stack before actually
// executing the main method.
// We construct the thread here before we are entirely ready, because we need a thread from which to
// initialise the class containing the main method.
// Once we've obtained e.g. the String and Array classes, we can populate the args array.
match
MethodState.Empty
state.ConcreteTypes
(Option.toObj baseClassTypes)
state._LoadedAssemblies
dumped
// pretend there are no instructions, so we avoid preparing anything
{ mainMethod with
Instructions = Some (MethodInstructions.onlyRet ())
}
ImmutableArray.Empty
(ImmutableArray.CreateRange [ CliType.ObjectRef None ])
None
with
| Ok meth -> IlMachineState.addThread meth dumped.Name state, baseClassTypes
| Error requiresRefs ->
let state =
(state, requiresRefs)
||> List.fold (fun state ref ->
let handle, referencingAssy = ref.Handle
let referencingAssy = state.LoadedAssembly referencingAssy |> Option.get
let state, _, _ =
IlMachineState.loadAssembly loggerFactory referencingAssy handle state
let state, concretizedMainMethod, _ =
IlMachineState.concretizeMethodWithTypeGenerics
loggerFactory
baseTypes
ImmutableArray.Empty // No type generics for main method's declaring type
{ rawMainMethod with
Instructions = Some (MethodInstructions.onlyRet ())
}
None
dumped.Name
ImmutableArray.Empty
state
)
// Create the method state with the concretized method
match
MethodState.Empty
state.ConcreteTypes
baseTypes
state._LoadedAssemblies
dumped
concretizedMainMethod
ImmutableArray.Empty
(ImmutableArray.CreateRange [ CliType.ObjectRef None ])
None
with
| Ok concretizedMeth -> IlMachineState.addThread concretizedMeth dumped.Name state, Some baseTypes
| Error _ -> failwith "Unexpected failure creating method state with concretized method"
| None ->
// We need to discover the core library by traversing the type hierarchy
let mainMethodType =
dumped.TypeDefs.[mainMethodFromMetadata.DeclaringType.Definition.Get]
let corelib =
let coreLib =
state._LoadedAssemblies.Keys
|> Seq.tryFind (fun x -> x.StartsWith ("System.Private.CoreLib, ", StringComparison.Ordinal))
let state, baseTypes =
findCoreLibraryAssemblyFromGeneric state mainMethodType dumped
coreLib
|> Option.map (fun coreLib -> state._LoadedAssemblies.[coreLib] |> Corelib.getBaseTypes)
computeState baseTypes state
computeState corelib state
let (state, mainThread), baseClassTypes = state |> computeState None
// Now that we have base class types, concretize the main method for use in the rest of the function
let state, concretizedMainMethod, mainTypeHandle =
match baseClassTypes with
| Some baseTypes ->
let rawMainMethod =
mainMethodFromMetadata
|> MethodInfo.mapTypeGenerics (fun (i, _) -> TypeDefn.GenericTypeParameter i.SequenceNumber)
IlMachineState.concretizeMethodWithTypeGenerics
loggerFactory
baseTypes
ImmutableArray.Empty // No type generics for main method's declaring type
rawMainMethod
None
dumped.Name
ImmutableArray.Empty
state
| None -> failwith "Expected base class types to be available at this point"
let rec loadInitialState (state : IlMachineState) =
match
state
|> IlMachineStateExecution.loadClass
|> IlMachineState.loadClass
loggerFactory
(Option.toObj baseClassTypes)
mainTypeHandle
(AllConcreteTypes.lookup' mainMethod.DeclaringType state.ConcreteTypes
|> Option.get)
mainThread
with
| StateLoadResult.NothingToDo ilMachineState -> ilMachineState
@@ -287,12 +173,12 @@ module Program =
| Some c -> c
let arrayAllocation, state =
match mainMethodFromMetadata.Signature.ParameterTypes |> Seq.toList with
match mainMethod'.Signature.ParameterTypes |> Seq.toList with
| [ TypeDefn.OneDimensionalArrayLowerBoundZero (TypeDefn.PrimitiveType PrimitiveType.String) ] ->
allocateArgs argv baseClassTypes state
| _ -> failwith "Main method must take an array of strings; other signatures not yet implemented"
match mainMethodFromMetadata.Signature.ReturnType with
match mainMethod'.Signature.ReturnType with
| TypeDefn.PrimitiveType PrimitiveType.Int32 -> ()
| _ -> failwith "Main method must return int32; other types not currently supported"
@@ -305,7 +191,7 @@ module Program =
logger.LogInformation "Main method class now initialised"
// Now that BCL initialisation has taken place and the user-code classes are constructed,
// overwrite the main thread completely using the already-concretized method.
// overwrite the main thread completely.
let methodState =
match
MethodState.Empty
@@ -313,9 +199,9 @@ module Program =
baseClassTypes
state._LoadedAssemblies
dumped
concretizedMainMethod
mainMethod
ImmutableArray.Empty
(ImmutableArray.Create (CliType.ofManagedObject arrayAllocation))
(ImmutableArray.Create (CliType.OfManagedObject arrayAllocation))
None
with
| Ok s -> s
@@ -331,7 +217,12 @@ module Program =
{ state with
ThreadState = state.ThreadState |> Map.add mainThread threadState
}
|> IlMachineStateExecution.ensureTypeInitialised loggerFactory baseClassTypes mainThread mainTypeHandle
|> IlMachineState.ensureTypeInitialised
loggerFactory
baseClassTypes
mainThread
(AllConcreteTypes.lookup' methodState.ExecutingMethod.DeclaringType state.ConcreteTypes
|> Option.get)
match init with
| WhatWeDid.SuspendedForClassInit -> failwith "TODO: suspended for class init"

2
WoofWare.PawPrint/Tuple.fs
View File

@@ -4,5 +4,3 @@ namespace WoofWare.PawPrint
module internal Tuple =
let withLeft<'a, 'b> (x : 'a) (y : 'b) : 'a * 'b = x, y
let withRight<'a, 'b> (y : 'b) (x : 'a) = x, y
let lmap<'a, 'b, 'c> (f : 'a -> 'c) (x : 'a, y : 'b) : 'c * 'b = f x, y
let rmap<'a, 'b, 'c> (f : 'b -> 'c) (x : 'a, y : 'b) : 'a * 'c = x, f y

28
WoofWare.PawPrint/TypeHandleRegistry.fs
View File

@@ -1,10 +1,18 @@
namespace WoofWare.PawPrint
type CanonicalTypeIdentity =
{
AssemblyFullName : string
FullyQualifiedTypeName : string
Generics : CanonicalTypeIdentity list
}
type TypeHandleRegistry =
private
{
TypeHandleToType : Map<ManagedHeapAddress, ConcreteTypeHandle>
TypeToHandle : Map<ConcreteTypeHandle, ManagedHeapAddress>
TypeHandleToType : Map<int64<typeHandle>, CanonicalTypeIdentity>
TypeToHandle : Map<CanonicalTypeIdentity, int64<typeHandle> * ManagedHeapAddress>
NextHandle : int64<typeHandle>
}
[<RequireQualifiedAccess>]
@@ -13,20 +21,23 @@ module TypeHandleRegistry =
{
TypeHandleToType = Map.empty
TypeToHandle = Map.empty
NextHandle = 1L<typeHandle>
}
/// Returns an allocated System.RuntimeType as well.
let getOrAllocate
(allocState : 'allocState)
(allocate : (string * CliType) list -> 'allocState -> ManagedHeapAddress * 'allocState)
(def : ConcreteTypeHandle)
(def : CanonicalTypeIdentity)
(reg : TypeHandleRegistry)
: ManagedHeapAddress * TypeHandleRegistry * 'allocState
: (int64<typeHandle> * ManagedHeapAddress) * TypeHandleRegistry * 'allocState
=
match Map.tryFind def reg.TypeToHandle with
| Some v -> v, reg, allocState
| None ->
let handle = reg.NextHandle
// Here follows the class System.RuntimeType, which is an internal class type with a constructor
// whose only purpose is to throw.
let fields =
@@ -35,7 +46,7 @@ module TypeHandleRegistry =
"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))
"m_handle", CliType.Numeric (CliNumericType.NativeInt (NativeIntSource.TypeHandlePtr handle))
// 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)
@@ -45,8 +56,9 @@ module TypeHandleRegistry =
let reg =
{
TypeHandleToType = reg.TypeHandleToType |> Map.add alloc def
TypeToHandle = reg.TypeToHandle |> Map.add def alloc
NextHandle = handle + 1L<typeHandle>
TypeHandleToType = reg.TypeHandleToType |> Map.add handle def
TypeToHandle = reg.TypeToHandle |> Map.add def (handle, alloc)
}
alloc, reg, state
(handle, alloc), reg, state

85
WoofWare.PawPrint/UnaryConstIlOp.fs
View File

@@ -212,33 +212,7 @@ module internal UnaryConstIlOp =
else
id
|> Tuple.withRight WhatWeDid.Executed
| Blt_s b ->
let value2, state = IlMachineState.popEvalStack currentThread state
let value1, state = IlMachineState.popEvalStack currentThread state
let isLessThan =
match value1, value2 with
| EvalStackValue.Int32 v1, EvalStackValue.Int32 v2 -> v1 < v2
| EvalStackValue.Int32 i, EvalStackValue.NativeInt nativeIntSource -> failwith "todo"
| EvalStackValue.Int32 i, _ -> failwith $"invalid comparison, {i} with {value2}"
| EvalStackValue.Int64 v1, EvalStackValue.Int64 v2 -> v1 < v2
| EvalStackValue.Int64 i, _ -> failwith $"invalid comparison, {i} with {value2}"
| EvalStackValue.NativeInt nativeIntSource, _ -> failwith "todo"
| EvalStackValue.Float v1, EvalStackValue.Float v2 -> failwith "todo"
| EvalStackValue.Float f, _ -> failwith $"invalid comparison, {f} with {value2}"
| EvalStackValue.ManagedPointer v1, EvalStackValue.ManagedPointer v2 -> failwith "todo"
| EvalStackValue.ManagedPointer v1, _ -> failwith $"invalid comparison, {v1} with {value2}"
| EvalStackValue.ObjectRef _, _ -> failwith "todo"
| EvalStackValue.UserDefinedValueType _, _ ->
failwith "unexpectedly tried to compare user-defined value type"
state
|> IlMachineState.advanceProgramCounter currentThread
|> if isLessThan then
IlMachineState.jumpProgramCounter currentThread (int<int8> b)
else
id
|> Tuple.withRight WhatWeDid.Executed
| Blt_s b -> failwith "TODO: Blt_s unimplemented"
| Ble_s b ->
let value2, state = IlMachineState.popEvalStack currentThread state
let value1, state = IlMachineState.popEvalStack currentThread state
@@ -266,33 +240,7 @@ module internal UnaryConstIlOp =
else
id
|> Tuple.withRight WhatWeDid.Executed
| Bgt_s b ->
let value2, state = IlMachineState.popEvalStack currentThread state
let value1, state = IlMachineState.popEvalStack currentThread state
let isGreaterThan =
match value1, value2 with
| EvalStackValue.Int32 v1, EvalStackValue.Int32 v2 -> v1 > v2
| EvalStackValue.Int32 i, EvalStackValue.NativeInt nativeIntSource -> failwith "todo"
| EvalStackValue.Int32 i, _ -> failwith $"invalid comparison, {i} with {value2}"
| EvalStackValue.Int64 v1, EvalStackValue.Int64 v2 -> v1 > v2
| EvalStackValue.Int64 i, _ -> failwith $"invalid comparison, {i} with {value2}"
| EvalStackValue.NativeInt nativeIntSource, _ -> failwith "todo"
| EvalStackValue.Float v1, EvalStackValue.Float v2 -> failwith "todo"
| EvalStackValue.Float f, _ -> failwith $"invalid comparison, {f} with {value2}"
| EvalStackValue.ManagedPointer v1, EvalStackValue.ManagedPointer v2 -> failwith "todo"
| EvalStackValue.ManagedPointer v1, _ -> failwith $"invalid comparison, {v1} with {value2}"
| EvalStackValue.ObjectRef _, _ -> failwith "todo"
| EvalStackValue.UserDefinedValueType _, _ ->
failwith "unexpectedly tried to compare user-defined value type"
state
|> IlMachineState.advanceProgramCounter currentThread
|> if isGreaterThan then
IlMachineState.jumpProgramCounter currentThread (int<int8> b)
else
id
|> Tuple.withRight WhatWeDid.Executed
| Bgt_s b -> failwith "TODO: Bgt_s unimplemented"
| Bge_s b ->
let value2, state = IlMachineState.popEvalStack currentThread state
let value1, state = IlMachineState.popEvalStack currentThread state
@@ -403,34 +351,7 @@ module internal UnaryConstIlOp =
else
id
|> Tuple.withRight WhatWeDid.Executed
| Bne_un_s b ->
// Table III.4
let value2, state = IlMachineState.popEvalStack currentThread state
let value1, state = IlMachineState.popEvalStack currentThread state
let isNotEqual =
match value1, value2 with
| EvalStackValue.Int32 v1, EvalStackValue.Int32 v2 -> v1 <> v2
| EvalStackValue.Int32 v1, EvalStackValue.NativeInt v2 -> failwith "TODO"
| EvalStackValue.Int32 v1, _ -> failwith $"invalid comparison, {v1} with {value2}"
| _, EvalStackValue.Int32 v2 -> failwith $"invalid comparison, {value1} with {v2}"
| EvalStackValue.Int64 v1, EvalStackValue.Int64 v2 -> v1 <> v2
| EvalStackValue.Int64 v1, _ -> failwith $"invalid comparison, {v1} with {value2}"
| _, EvalStackValue.Int64 v2 -> failwith $"invalid comparison, {value1} with {v2}"
| EvalStackValue.Float v1, EvalStackValue.Float v2 -> v1 <> v2
| _, EvalStackValue.Float v2 -> failwith $"invalid comparison, {value1} with {v2}"
| 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
| _, _ -> failwith $"TODO {value1} {value2} (see table III.4)"
state
|> IlMachineState.advanceProgramCounter currentThread
|> if isNotEqual then
IlMachineState.jumpProgramCounter currentThread (int b)
else
id
|> Tuple.withRight WhatWeDid.Executed
| Bne_un_s b -> failwith "TODO: Bne_un_s unimplemented"
| Bge_un_s b ->
let value2, state = IlMachineState.popEvalStack currentThread state
let value1, state = IlMachineState.popEvalStack currentThread state

617
WoofWare.PawPrint/UnaryMetadataIlOp.fs
View File

File diff suppressed because it is too large Load Diff

24
WoofWare.PawPrint/UnaryStringTokenIlOp.fs
View File

@@ -1,14 +1,12 @@
namespace WoofWare.PawPrint
open System.Collections.Immutable
open System.Reflection
open System.Reflection.Metadata
[<RequireQualifiedAccess>]
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module internal UnaryStringTokenIlOp =
let execute
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(baseClassTypes : BaseClassTypes<'a>)
(op : UnaryStringTokenIlOp)
(sh : StringToken)
(state : IlMachineState)
@@ -49,24 +47,16 @@ module internal UnaryStringTokenIlOp =
let fields =
[
"_firstChar", CliType.ofChar state.ManagedHeap.StringArrayData.[dataAddr]
"_firstChar", CliType.OfChar state.ManagedHeap.StringArrayData.[dataAddr]
"_stringLength", CliType.Numeric (CliNumericType.Int32 stringToAllocate.Length)
]
let state, stringType =
TypeDefn.FromDefinition (
ComparableTypeDefinitionHandle.Make baseClassTypes.String.TypeDefHandle,
baseClassTypes.Corelib.Name.FullName,
SignatureTypeKind.Class
)
|> IlMachineState.concretizeType
baseClassTypes
let addr, state =
IlMachineState.allocateManagedObject
(baseClassTypes.String
|> TypeInfo.mapGeneric (fun _ _ -> failwith "string is not generic"))
fields
state
baseClassTypes.Corelib.Name
ImmutableArray.Empty
ImmutableArray.Empty
let addr, state = IlMachineState.allocateManagedObject stringType fields state
addr,
{ state with

4
WoofWare.PawPrint/WoofWare.PawPrint.fsproj
View File

@@ -7,13 +7,11 @@
<ItemGroup>
<Compile Include="Tuple.fs" />
<Compile Include="ImmutableArray.fs" />
<Compile Include="Result.fs" />
<Compile Include="Corelib.fs" />
<Compile Include="AbstractMachineDomain.fs" />
<Compile Include="BasicCliType.fs" />
<Compile Include="TypeHandleRegistry.fs" />
<Compile Include="FieldHandleRegistry.fs" />
<Compile Include="ManagedHeap.fs" />
<Compile Include="TypeInitialisation.fs" />
<Compile Include="Exceptions.fs" />
@@ -23,8 +21,6 @@
<Compile Include="MethodState.fs" />
<Compile Include="ThreadState.fs" />
<Compile Include="IlMachineState.fs" />
<Compile Include="Intrinsics.fs" />
<Compile Include="IlMachineStateExecution.fs" />
<Compile Include="NullaryIlOp.fs" />
<Compile Include="UnaryMetadataIlOp.fs" />
<Compile Include="UnaryStringTokenIlOp.fs" />

6
flake.lock generated
View File

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

101
nix/deps.json
View File

@@ -21,8 +21,8 @@
},
{
"pname": "FSharp.Core",
"version": "9.0.303",
"hash": "sha256-AxR6wqodeU23KOTgkUfIgbavgbcSuzD4UBP+tiFydgA="
"version": "9.0.202",
"hash": "sha256-64Gub0qemmCoMa1tDus6TeTuB1+5sHfE6KD2j4o84mA="
},
{
"pname": "FsUnit",
@@ -31,33 +31,33 @@
},
{
"pname": "Microsoft.ApplicationInsights",
"version": "2.23.0",
"hash": "sha256-5sf3bg7CZZjHseK+F3foOchEhmVeioePxMZVvS6Rjb0="
"version": "2.22.0",
"hash": "sha256-mUQ63atpT00r49ca50uZu2YCiLg3yd6r3HzTryqcuEA="
},
{
"pname": "Microsoft.AspNetCore.App.Ref",
"version": "8.0.19",
"hash": "sha256-QySX2bih1UvwmLcn9cy1j+RuvZZwbcFKggL5Y/WcTnw="
"version": "8.0.17",
"hash": "sha256-NNGXfUV5RVt1VqLI99NlHoBkt2Vv/Hg3TAHzm8nGM8M="
},
{
"pname": "Microsoft.AspNetCore.App.Runtime.linux-arm64",
"version": "8.0.19",
"hash": "sha256-69S+Ywyc5U8PDsVkkCVvZdHOgWb6ZZ3+f4UA0MLOLFI="
"version": "8.0.17",
"hash": "sha256-Eunz3nZF5r8a9nqwdeorQPgqd5G+Z4ddofMeAk6VmnA="
},
{
"pname": "Microsoft.AspNetCore.App.Runtime.linux-x64",
"version": "8.0.19",
"hash": "sha256-u50rdLuoADSDCthx2Fg+AnT192TalHhFrzFCfMgmTn4="
"version": "8.0.17",
"hash": "sha256-SWdah72tC5i2CQL4mRUYfHC0Kh8+C2jiskIIeC74smY="
},
{
"pname": "Microsoft.AspNetCore.App.Runtime.osx-arm64",
"version": "8.0.19",
"hash": "sha256-QAKu2xD4UQ4+gX79ynNQ0aA07D+EW6Ke0jRiTZne8CY="
"version": "8.0.17",
"hash": "sha256-y55EGfQ2FzrY2X5+Ne5N3dqi5WNHkFTGVW1hEMrh6OI="
},
{
"pname": "Microsoft.AspNetCore.App.Runtime.osx-x64",
"version": "8.0.19",
"hash": "sha256-v5lzESMpodrH2grgk8ojA6BLDUfyxX5r6YY5Pgq61tA="
"version": "8.0.17",
"hash": "sha256-uRCCNPevPemvKIuUxy/VtQlgskChbiAauMWVK/xhoc0="
},
{
"pname": "Microsoft.CodeAnalysis.Analyzers",
@@ -106,48 +106,48 @@
},
{
"pname": "Microsoft.NETCore.App.Host.linux-arm64",
"version": "8.0.19",
"hash": "sha256-R86Kqzi3FUuPZlgj3zNOObLAvXtnGrS2mxsBAxWIZrY="
"version": "8.0.17",
"hash": "sha256-pzOqFCd+UrIXmWGDfds5GxkI+Asjx30yFtLIuHFu/h4="
},
{
"pname": "Microsoft.NETCore.App.Host.linux-x64",
"version": "8.0.19",
"hash": "sha256-a9t/bX+WIKOu9q2R52b/hPGwOpkAgpYuP42SW2QXTak="
"version": "8.0.17",
"hash": "sha256-AGnEGHcO2hfvChG3xEGOTA6dX4MiYPB7FoBkmWz3dc8="
},
{
"pname": "Microsoft.NETCore.App.Host.osx-arm64",
"version": "8.0.19",
"hash": "sha256-VaeGPR+6ApGNtQpEaky2rdUKd4X/Pp3xFGaSgUfGNiE="
"version": "8.0.17",
"hash": "sha256-fpMzkOWaA3OFNtHsqOk9s9xKVrcrqOyKHxE7jk8hebg="
},
{
"pname": "Microsoft.NETCore.App.Host.osx-x64",
"version": "8.0.19",
"hash": "sha256-hw7WMpTq7o544uSNvWUCIr6IRt5xZOo+eERMnwAbYyk="
"version": "8.0.17",
"hash": "sha256-Hrn01x+S+gnGEEHhr6mN6bPyqVAhp5u3CqgWwQbh4To="
},
{
"pname": "Microsoft.NETCore.App.Ref",
"version": "8.0.19",
"hash": "sha256-4ymel0R1c0HrX0plAWubJPzev52y0Fsx1esyQ1R7bXc="
"version": "8.0.17",
"hash": "sha256-tKawpjkMjV0ysNIWWrgHTiLxncZJDRNiDkQBwl255l4="
},
{
"pname": "Microsoft.NETCore.App.Runtime.linux-arm64",
"version": "8.0.19",
"hash": "sha256-hqhpd8yT8bv05DhFTuMhfsaSISpLs3t4oM+R/ZkJH80="
"version": "8.0.17",
"hash": "sha256-FutphE4bEjd8s6ZqpFXrD1zuCDkNCJ7Vnl0pBm86HBA="
},
{
"pname": "Microsoft.NETCore.App.Runtime.linux-x64",
"version": "8.0.19",
"hash": "sha256-Ou51zUFTPESAAzP/z0+sLDAAXC54+oDlESBBT12M2lM="
"version": "8.0.17",
"hash": "sha256-6YVEXiJ3b2gZAYri8iSRBdi/J+0DEl7FcwBX6h1Unkg="
},
{
"pname": "Microsoft.NETCore.App.Runtime.osx-arm64",
"version": "8.0.19",
"hash": "sha256-IC/e8AmT9twcXwzFmXAelf4ctMbg4ancKPGrPLFMNn8="
"version": "8.0.17",
"hash": "sha256-J3dfDial8GHyKQMFuBNFtOMD/mOK58vjrK2ZtrYObZg="
},
{
"pname": "Microsoft.NETCore.App.Runtime.osx-x64",
"version": "8.0.19",
"hash": "sha256-Rb0z0PT/FHyk/Fgjj9W3WDpkDMKJoXR9DgHB1cJeZSA="
"version": "8.0.17",
"hash": "sha256-WnkJyhSBHMw/VtLHWy0AFwzzkbIC1YQugFuj3Adg+Ks="
},
{
"pname": "Microsoft.NETCore.Platforms",
@@ -171,38 +171,33 @@
},
{
"pname": "Microsoft.Testing.Extensions.Telemetry",
"version": "1.7.3",
"hash": "sha256-Z6WsY2FCUbNnT5HJd7IOrfOvqknVXp6PWzTVeb0idVg="
"version": "1.5.3",
"hash": "sha256-bIXwPSa3jkr2b6xINOqMUs6/uj/r4oVFM7xq3uVIZDU="
},
{
"pname": "Microsoft.Testing.Extensions.TrxReport.Abstractions",
"version": "1.7.3",
"hash": "sha256-PTee04FHyTHx/gF5NLckXuVje807G51MzkPrZ1gkgCw="
"version": "1.5.3",
"hash": "sha256-IfMRfcyaIKEMRtx326ICKtinDBEfGw/Sv8ZHawJ96Yc="
},
{
"pname": "Microsoft.Testing.Extensions.VSTestBridge",
"version": "1.7.3",
"hash": "sha256-8d+wZmucfSO7PsviHjVxYB4q6NcjgxvnCUpLePq35sM="
"version": "1.5.3",
"hash": "sha256-XpM/yFjhLSsuzyDV+xKubs4V1zVVYiV05E0+N4S1h0g="
},
{
"pname": "Microsoft.Testing.Platform",
"version": "1.7.3",
"hash": "sha256-cavX11P5o9rooqC3ZHw5h002OKRg2ZNR/VaRwpNTQYA="
"version": "1.5.3",
"hash": "sha256-y61Iih6w5D79dmrj2V675mcaeIiHoj1HSa1FRit2BLM="
},
{
"pname": "Microsoft.Testing.Platform.MSBuild",
"version": "1.7.3",
"hash": "sha256-cREl529UQ/c5atT8KimMgrgNdy6MrAd0sBGT8sXRRPM="
},
{
"pname": "Microsoft.TestPlatform.AdapterUtilities",
"version": "17.13.0",
"hash": "sha256-Vr+3Tad/h/nk7f/5HMExn3HvCGFCarehFAzJSfCBaOc="
"version": "1.5.3",
"hash": "sha256-YspvjE5Jfi587TAfsvfDVJXNrFOkx1B3y1CKV6m7YLY="
},
{
"pname": "Microsoft.TestPlatform.ObjectModel",
"version": "17.13.0",
"hash": "sha256-6S0fjfj8vA+h6dJVNwLi6oZhYDO/I/6hBZaq2VTW+Uk="
"version": "17.12.0",
"hash": "sha256-3XBHBSuCxggAIlHXmKNQNlPqMqwFlM952Av6RrLw1/w="
},
{
"pname": "Microsoft.TestPlatform.ObjectModel",
@@ -236,13 +231,13 @@
},
{
"pname": "NUnit",
"version": "4.4.0",
"hash": "sha256-5geF5QOF+X/WkuCEgkPVKH4AdKx4U0olpU07S8+G3nU="
"version": "4.3.2",
"hash": "sha256-0RWe8uFoxYp6qhPlDDEghOMcKJgyw2ybvEoAqBLebeE="
},
{
"pname": "NUnit3TestAdapter",
"version": "5.1.0",
"hash": "sha256-5z470sFjV67wGHaw8KfmSloIAYe81Dokp0f8I6zXsDc="
"version": "5.0.0",
"hash": "sha256-7jZM4qAbIzne3AcdFfMbvbgogqpxvVe6q2S7Ls8xQy0="
},
{
"pname": "runtime.any.System.Runtime",