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

Allow CliType.zeroOf to load other assemblies (#30)

Browse Source
This commit is contained in:
Patrick Stevens
2025-06-01 15:31:59 +01:00
committed by GitHub
parent e0ad3a3b54
commit 4c55bbe5e7
10 changed files with 438 additions and 165 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
WoofWare.PawPrint/AbstractMachine.fs
View File

@@ -68,7 +68,10 @@ module AbstractMachine =
match outcome with
| ExecutionResult.Terminated (state, terminating) -> ExecutionResult.Terminated (state, terminating)
| ExecutionResult.Stepped (state, whatWeDid) ->
ExecutionResult.Stepped (IlMachineState.returnStackFrame thread state |> Option.get, whatWeDid)
ExecutionResult.Stepped (
IlMachineState.returnStackFrame loggerFactory thread state |> Option.get,
whatWeDid
)
| Some instructions ->
@@ -93,7 +96,7 @@ module AbstractMachine =
)
match instruction.ExecutingMethod.Instructions.Value.Locations.[instruction.IlOpIndex] with
| IlOp.Nullary op -> NullaryIlOp.execute state thread op
| IlOp.Nullary op -> NullaryIlOp.execute loggerFactory state thread op
| IlOp.UnaryConst unaryConstIlOp ->
UnaryConstIlOp.execute state thread unaryConstIlOp |> ExecutionResult.Stepped
| IlOp.UnaryMetadataToken (unaryMetadataTokenIlOp, bytes) ->

95
WoofWare.PawPrint/Assembly.fs
View File

@@ -245,6 +245,10 @@ type DumpedAssembly =
interface IDisposable with
member this.Dispose () = this.PeReader.Dispose ()
type TypeResolutionResult =
| FirstLoadAssy of WoofWare.PawPrint.AssemblyReference
| Resolved of DumpedAssembly * TypeInfo<TypeDefn>
[<RequireQualifiedAccess>]
module Assembly =
let read (loggerFactory : ILoggerFactory) (originalPath : string option) (dllBytes : Stream) : DumpedAssembly =
@@ -264,7 +268,7 @@ module Assembly =
let builder = ImmutableDictionary.CreateBuilder ()
for ref in metadataReader.AssemblyReferences do
builder.Add (ref, AssemblyReference.make (metadataReader.GetAssemblyReference ref))
builder.Add (ref, AssemblyReference.make ref (metadataReader.GetAssemblyReference ref))
builder.ToImmutable ()
@@ -419,3 +423,92 @@ module Assembly =
instructions.Instructions
|> List.map (fun (op, index) -> IlOp.Format op index)
|> List.iter Console.WriteLine
let rec resolveTypeRef
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
(referencedInAssembly : DumpedAssembly)
(target : TypeRef)
: TypeResolutionResult
=
match target.ResolutionScope with
| TypeRefResolutionScope.Assembly r ->
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 targetNs = assy.NonRootNamespaces.[nsPath]
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
match targetType with
| [ t ] ->
// If resolved from TypeDef (above), it won't have generic parameters, I hope?
let t =
t |> TypeInfo.mapGeneric (fun _ -> failwith<TypeDefn> "no generic parameters")
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
| k -> failwith $"Unexpected: {k}"
and internal resolveTypeFromName
(assy : DumpedAssembly)
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
(ns : string option)
(name : string)
: TypeResolutionResult
=
match ns with
| None -> failwith "what are the semantics here"
| Some ns ->
match assy.TypeDef ns name with
| Some typeDef ->
// If resolved from TypeDef, it won't have generic parameters, I hope?
let typeDef =
typeDef
|> TypeInfo.mapGeneric (fun _ -> failwith<TypeDefn> "no generic parameters")
TypeResolutionResult.Resolved (assy, typeDef)
| None ->
match assy.TypeRef ns name with
| Some typeRef -> resolveTypeRef assemblies assy typeRef
| None ->
match assy.ExportedType (Some ns) name with
| Some export -> resolveTypeFromExport assy assemblies export
| None -> failwith $"TODO: type resolution unimplemented for {ns} {name}"
and resolveTypeFromExport
(fromAssembly : DumpedAssembly)
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
(ty : WoofWare.PawPrint.ExportedType)
: TypeResolutionResult
=
match ty.Data with
| NonForwarded _ -> failwith "Somehow didn't find type definition but it is exported"
| ForwardsTo assy ->
let assy = fromAssembly.AssemblyReferences.[assy]
match assemblies.TryGetValue assy.Name.FullName with
| false, _ -> TypeResolutionResult.FirstLoadAssy assy
| true, toAssy -> resolveTypeFromName toAssy assemblies ty.Namespace ty.Name

9
WoofWare.PawPrint/AssemblyReference.fs
View File

@@ -2,9 +2,11 @@ namespace WoofWare.PawPrint
open System
open System.Reflection
open System.Reflection.Metadata
type AssemblyReference =
{
Handle : AssemblyReferenceHandle
Culture : StringToken
Flags : AssemblyFlags
Name : AssemblyName
@@ -13,8 +15,13 @@ type AssemblyReference =
[<RequireQualifiedAccess>]
module AssemblyReference =
let make (ref : System.Reflection.Metadata.AssemblyReference) : AssemblyReference =
let make
(handle : AssemblyReferenceHandle)
(ref : System.Reflection.Metadata.AssemblyReference)
: AssemblyReference
=
{
Handle = handle
Culture = StringToken.String ref.Culture
Flags = ref.Flags
Name = ref.GetAssemblyName ()

49
WoofWare.PawPrint/BasicCliType.fs
View File

@@ -91,9 +91,19 @@ type CliType =
static member OfManagedObject (ptr : ManagedHeapAddress) = CliType.ObjectRef (Some ptr)
type CliTypeResolutionResult =
| Resolved of CliType
| FirstLoad of WoofWare.PawPrint.AssemblyReference
[<RequireQualifiedAccess>]
module CliType =
let rec zeroOf (generics : TypeDefn ImmutableArray) (ty : TypeDefn) : CliType =
let rec zeroOf
(assemblies : ImmutableDictionary<string, DumpedAssembly>)
(assy : DumpedAssembly)
(generics : TypeDefn ImmutableArray)
(ty : TypeDefn)
: CliTypeResolutionResult
=
match ty with
| TypeDefn.PrimitiveType primitiveType ->
match primitiveType with
@@ -111,33 +121,44 @@ module CliType =
| PrimitiveType.Double -> CliType.Numeric (CliNumericType.Float64 0.0)
| PrimitiveType.String -> CliType.ObjectRef None
| PrimitiveType.TypedReference -> failwith "todo"
| PrimitiveType.IntPtr -> failwith "todo"
| PrimitiveType.UIntPtr -> failwith "todo"
| PrimitiveType.IntPtr -> CliType.Numeric (CliNumericType.Int64 0L)
| PrimitiveType.UIntPtr -> CliType.Numeric (CliNumericType.Int64 0L)
| PrimitiveType.Object -> CliType.ObjectRef None
| TypeDefn.Array _ -> CliType.ObjectRef None
|> CliTypeResolutionResult.Resolved
| TypeDefn.Array _ -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved
| TypeDefn.Pinned typeDefn -> failwith "todo"
| TypeDefn.Pointer _ -> CliType.ObjectRef None
| TypeDefn.Byref _ -> CliType.ObjectRef None
| TypeDefn.OneDimensionalArrayLowerBoundZero _ -> CliType.ObjectRef None
| TypeDefn.Pointer _ -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved
| TypeDefn.Byref _ -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved
| TypeDefn.OneDimensionalArrayLowerBoundZero _ -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved
| TypeDefn.Modified (original, afterMod, modificationRequired) -> failwith "todo"
| TypeDefn.FromReference (typeRef, signatureTypeKind) ->
match signatureTypeKind with
| SignatureTypeKind.Unknown -> failwith "todo"
| SignatureTypeKind.ValueType -> failwith "todo"
| SignatureTypeKind.Class -> CliType.ObjectRef None
| SignatureTypeKind.ValueType ->
match Assembly.resolveTypeRef assemblies assy typeRef with
| TypeResolutionResult.Resolved (_, ty) -> failwith $"TODO: {ty}"
| TypeResolutionResult.FirstLoadAssy assy -> CliTypeResolutionResult.FirstLoad assy
| SignatureTypeKind.Class -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved
| _ -> raise (ArgumentOutOfRangeException ())
| TypeDefn.FromDefinition (typeDefinitionHandle, signatureTypeKind) ->
match signatureTypeKind with
| SignatureTypeKind.Unknown -> failwith "todo"
| SignatureTypeKind.ValueType -> failwith "todo"
| SignatureTypeKind.Class -> CliType.ObjectRef None
| SignatureTypeKind.ValueType ->
let typeDef = assy.TypeDefs.[typeDefinitionHandle]
let fields =
typeDef.Fields
|> List.map (fun fi -> zeroOf assemblies assy generics fi.Signature)
CliType.ObjectRef None |> CliTypeResolutionResult.Resolved
| SignatureTypeKind.Class -> CliType.ObjectRef None |> CliTypeResolutionResult.Resolved
| _ -> raise (ArgumentOutOfRangeException ())
| TypeDefn.GenericInstantiation (generic, args) ->
// TODO: this is rather concerning and probably incorrect
zeroOf args generic
zeroOf assemblies assy args generic
| TypeDefn.FunctionPointer typeMethodSignature -> failwith "todo"
| TypeDefn.GenericTypeParameter index ->
// TODO: can generics depend on other generics? presumably, so we pass the array down again
zeroOf generics generics.[index]
| TypeDefn.GenericMethodParameter index -> zeroOf generics generics.[index]
zeroOf assemblies assy generics generics.[index]
| TypeDefn.GenericMethodParameter index -> zeroOf assemblies assy generics generics.[index]
| TypeDefn.Void -> failwith "should never construct an element of type Void"

268
WoofWare.PawPrint/IlMachineState.fs
View File

@@ -198,27 +198,11 @@ module IlMachineState =
(state : IlMachineState)
: IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo<TypeDefn>
=
match ns with
| None -> failwith "what are the semantics here"
| Some ns ->
match assy.TypeDef ns name with
| Some typeDef ->
// If resolved from TypeDef, it won't have generic parameters, I hope?
let typeDef =
typeDef
|> TypeInfo.mapGeneric (fun _ -> failwith<TypeDefn> "no generic parameters")
state, assy, typeDef
| None ->
match assy.TypeRef ns name with
| Some typeRef -> resolveTypeFromRef loggerFactory assy typeRef state
| None ->
match assy.ExportedType (Some ns) name with
| Some export -> resolveTypeFromExport loggerFactory assy export state
| None -> failwith $"TODO: type resolution unimplemented for {ns} {name}"
match Assembly.resolveTypeFromName assy state._LoadedAssemblies ns name with
| TypeResolutionResult.Resolved (assy, typeDef) -> state, assy, typeDef
| TypeResolutionResult.FirstLoadAssy loadFirst ->
let state, _, _ = loadAssembly loggerFactory assy loadFirst.Handle state
resolveTypeFromName loggerFactory ns name assy state
and resolveTypeFromExport
(loggerFactory : ILoggerFactory)
@@ -227,11 +211,11 @@ module IlMachineState =
(state : IlMachineState)
: IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo<TypeDefn>
=
match ty.Data with
| NonForwarded _ -> failwith "Somehow didn't find type definition but it is exported"
| ForwardsTo assy ->
let state, targetAssy, _ = loadAssembly loggerFactory fromAssembly assy state
resolveTypeFromName loggerFactory ty.Namespace ty.Name targetAssy state
match Assembly.resolveTypeFromExport fromAssembly state._LoadedAssemblies ty with
| TypeResolutionResult.Resolved (assy, typeDef) -> state, assy, typeDef
| TypeResolutionResult.FirstLoadAssy loadFirst ->
let state, _, _ = loadAssembly loggerFactory fromAssembly loadFirst.Handle state
resolveTypeFromExport loggerFactory fromAssembly ty state
and resolveTypeFromRef
(loggerFactory : ILoggerFactory)
@@ -240,40 +224,13 @@ module IlMachineState =
(state : IlMachineState)
: IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo<TypeDefn>
=
match target.ResolutionScope with
| TypeRefResolutionScope.Assembly r ->
let state, assy, newAssyName =
loadAssembly loggerFactory referencedInAssembly r state
match Assembly.resolveTypeRef state._LoadedAssemblies referencedInAssembly target with
| TypeResolutionResult.Resolved (assy, typeDef) -> state, assy, typeDef
| TypeResolutionResult.FirstLoadAssy loadFirst ->
let state, _, _ =
loadAssembly loggerFactory referencedInAssembly loadFirst.Handle state
let nsPath = target.Namespace.Split '.' |> Array.toList
let targetNs = assy.NonRootNamespaces.[nsPath]
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
match targetType with
| [ t ] ->
// If resolved from TypeDef (above), it won't have generic parameters, I hope?
let t =
t |> TypeInfo.mapGeneric (fun _ -> failwith<TypeDefn> "no generic parameters")
state, 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 loggerFactory assy ty state
| k -> failwith $"Unexpected: {k}"
resolveTypeFromRef loggerFactory referencedInAssembly target state
and resolveType
(loggerFactory : ILoggerFactory)
@@ -309,7 +266,7 @@ module IlMachineState =
| TypeDefn.FromDefinition (defn, _typeKind) -> state, assy, assy.TypeDefs.[defn], None
| s -> failwith $"TODO: resolveTypeFromDefn unimplemented for {s}"
let rec resolveTypeFromSpec
let resolveTypeFromSpec
(loggerFactory : ILoggerFactory)
(ty : TypeSpecificationHandle)
(assy : DumpedAssembly)
@@ -330,7 +287,22 @@ module IlMachineState =
let generic = TypeInfo.withGenerics args generic
state, assy, generic
let rec cliTypeZeroOf
(loggerFactory : ILoggerFactory)
(assy : DumpedAssembly)
(ty : TypeDefn)
(generics : TypeDefn ImmutableArray)
(state : IlMachineState)
: IlMachineState * CliType
=
match CliType.zeroOf state._LoadedAssemblies assy generics ty with
| CliTypeResolutionResult.Resolved result -> state, result
| CliTypeResolutionResult.FirstLoad ref ->
let state, _, _ = loadAssembly loggerFactory assy ref.Handle state
cliTypeZeroOf loggerFactory assy ty generics state
let callMethod
(loggerFactory : ILoggerFactory)
(wasInitialising : (TypeDefinitionHandle * AssemblyName) option)
(wasConstructing : ManagedHeapAddress option)
(wasClassConstructor : bool)
@@ -341,9 +313,25 @@ module IlMachineState =
(state : IlMachineState)
: IlMachineState
=
let state, argZeroObjects =
((state, []), methodToCall.Signature.ParameterTypes)
||> List.fold (fun (state, zeros) ty ->
let state, zero =
cliTypeZeroOf
loggerFactory
(state.ActiveAssembly thread)
ty
(generics |> Option.defaultValue ImmutableArray.Empty)
state
state, zero :: zeros
)
let argZeroObjects = List.rev argZeroObjects
let activeMethodState = threadState.MethodStates.[threadState.ActiveMethodState]
let newFrame, oldFrame =
let state, newFrame, oldFrame =
if methodToCall.IsStatic then
let args = ImmutableArray.CreateBuilder methodToCall.Parameters.Length
let mutable afterPop = activeMethodState
@@ -351,10 +339,7 @@ module IlMachineState =
for i = 0 to methodToCall.Parameters.Length - 1 do
let poppedArg, afterPop' = afterPop |> MethodState.popFromStack
let zeroArg =
CliType.zeroOf
(generics |> Option.defaultValue ImmutableArray.Empty)
methodToCall.Signature.ParameterTypes.[i]
let zeroArg = argZeroObjects.[i]
let poppedArg = EvalStackValue.toCliTypeCoerced zeroArg poppedArg
afterPop <- afterPop'
@@ -362,16 +347,37 @@ module IlMachineState =
args.Reverse ()
let newFrame =
MethodState.Empty
methodToCall
(args.ToImmutable ())
(Some
{
JumpTo = threadState.ActiveMethodState
WasInitialisingType = wasInitialising
WasConstructingObj = wasConstructing
})
let rec newFrame (state : IlMachineState) =
let meth =
MethodState.Empty
state._LoadedAssemblies
(state.ActiveAssembly thread)
methodToCall
(args.ToImmutable ())
(Some
{
JumpTo = threadState.ActiveMethodState
WasInitialisingType = wasInitialising
WasConstructingObj = wasConstructing
})
match meth with
| Ok r -> state, r
| Error toLoad ->
(state, toLoad)
||> List.fold (fun state (toLoad : WoofWare.PawPrint.AssemblyReference) ->
let state, _, _ =
loadAssembly
loggerFactory
(state.LoadedAssembly (snd methodToCall.DeclaringType) |> Option.get)
toLoad.Handle
state
state
)
|> newFrame
let state, newFrame = newFrame state
let oldFrame =
if wasClassConstructor then
@@ -379,7 +385,7 @@ module IlMachineState =
else
afterPop |> MethodState.advanceProgramCounter
newFrame, oldFrame
state, newFrame, oldFrame
else
let args = ImmutableArray.CreateBuilder (methodToCall.Parameters.Length + 1)
let poppedArg, afterPop = activeMethodState |> MethodState.popFromStack
@@ -387,9 +393,7 @@ module IlMachineState =
for i = 1 to methodToCall.Parameters.Length do
let poppedArg, afterPop' = afterPop |> MethodState.popFromStack
// TODO: generics
let zeroArg =
CliType.zeroOf ImmutableArray.Empty methodToCall.Signature.ParameterTypes.[i - 1]
let zeroArg = argZeroObjects.[i - 1]
let poppedArg = EvalStackValue.toCliTypeCoerced zeroArg poppedArg
afterPop <- afterPop'
@@ -403,19 +407,39 @@ module IlMachineState =
args.Reverse ()
let newFrame =
MethodState.Empty
methodToCall
(args.ToImmutable ())
(Some
{
JumpTo = threadState.ActiveMethodState
WasInitialisingType = wasInitialising
WasConstructingObj = wasConstructing
})
let rec newFrame (state : IlMachineState) =
let meth =
MethodState.Empty
state._LoadedAssemblies
(state.ActiveAssembly thread)
methodToCall
(args.ToImmutable ())
(Some
{
JumpTo = threadState.ActiveMethodState
WasInitialisingType = wasInitialising
WasConstructingObj = wasConstructing
})
match meth with
| Ok r -> state, r
| Error toLoad ->
(state, toLoad)
||> List.fold (fun state (toLoad : WoofWare.PawPrint.AssemblyReference) ->
let state, _, _ =
loadAssembly
loggerFactory
(state.LoadedAssembly (snd methodToCall.DeclaringType) |> Option.get)
toLoad.Handle
state
state
)
|> newFrame
let state, newFrame = newFrame state
let oldFrame = afterPop |> MethodState.advanceProgramCounter
newFrame, oldFrame
state, newFrame, oldFrame
let newThreadState =
{ threadState with
@@ -535,6 +559,7 @@ module IlMachineState =
let currentThreadState = state.ThreadState.[currentThread]
callMethod
loggerFactory
(Some (typeDefHandle, assemblyName))
None
true
@@ -555,6 +580,26 @@ module IlMachineState =
|> fst
|> NothingToDo
let ensureTypeInitialised
(loggerFactory : ILoggerFactory)
(thread : ThreadId)
(ty : TypeDefinitionHandle * AssemblyName)
(state : IlMachineState)
: IlMachineState * WhatWeDid
=
match TypeInitTable.tryGet ty state.TypeInitTable with
| None ->
match loadClass loggerFactory (fst ty) (snd 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
let callMethodInActiveAssembly
(loggerFactory : ILoggerFactory)
(thread : ThreadId)
@@ -566,25 +611,14 @@ module IlMachineState =
=
let threadState = state.ThreadState.[thread]
match TypeInitTable.tryGet methodToCall.DeclaringType state.TypeInitTable with
| None ->
match
loadClass loggerFactory (fst methodToCall.DeclaringType) (snd methodToCall.DeclaringType) thread state
with
| NothingToDo state ->
callMethod None weAreConstructingObj false generics methodToCall thread threadState state,
WhatWeDid.Executed
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| Some TypeInitState.Initialized ->
callMethod None weAreConstructingObj false generics methodToCall thread threadState state,
let state, typeInit =
ensureTypeInitialised loggerFactory thread methodToCall.DeclaringType state
match typeInit with
| WhatWeDid.Executed ->
callMethod loggerFactory None weAreConstructingObj false generics methodToCall thread threadState state,
WhatWeDid.Executed
| Some (InProgress threadId) ->
if threadId = thread then
// II.10.5.3.2: avoid the deadlock by simply proceeding.
callMethod None weAreConstructingObj false generics methodToCall thread threadState state,
WhatWeDid.Executed
else
state, WhatWeDid.BlockedOnClassInit threadId
| _ -> state, typeInit
let initial
(lf : ILoggerFactory)
@@ -861,7 +895,12 @@ module IlMachineState =
state, assy.Name, Choice1Of2 method
/// There might be no stack frame to return to, so you might get None.
let returnStackFrame (currentThread : ThreadId) (state : IlMachineState) : IlMachineState option =
let returnStackFrame
(loggerFactory : ILoggerFactory)
(currentThread : ThreadId)
(state : IlMachineState)
: IlMachineState option
=
let threadStateAtEndOfMethod = state.ThreadState.[currentThread]
match threadStateAtEndOfMethod.MethodState.ReturnState with
@@ -906,8 +945,15 @@ module IlMachineState =
| TypeDefn.Void -> state
| retType ->
// TODO: generics
let toPush =
EvalStackValue.toCliTypeCoerced (CliType.zeroOf ImmutableArray.Empty retType) retVal
let state, zero =
cliTypeZeroOf
loggerFactory
(state.ActiveAssembly currentThread)
retType
ImmutableArray.Empty
state
let toPush = EvalStackValue.toCliTypeCoerced zero retVal
state |> pushToEvalStack toPush currentThread
| _ ->

24
WoofWare.PawPrint/MethodState.fs
View File

@@ -102,10 +102,12 @@ 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
(loadedAssemblies : ImmutableDictionary<string, DumpedAssembly>)
(containingAssembly : DumpedAssembly)
(method : WoofWare.PawPrint.MethodInfo)
(args : ImmutableArray<CliType>)
(returnState : MethodReturnState option)
: MethodState
: Result<MethodState, WoofWare.PawPrint.AssemblyReference list>
=
do
if method.IsStatic then
@@ -125,11 +127,24 @@ and MethodState =
| Some vars -> vars
// 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 =
// TODO: generics?
localVariableSig
|> Seq.map (CliType.zeroOf ImmutableArray.Empty)
|> ImmutableArray.CreateRange
let result = ImmutableArray.CreateBuilder ()
for var in localVariableSig do
match CliType.zeroOf loadedAssemblies containingAssembly ImmutableArray.Empty var with
| CliTypeResolutionResult.Resolved t -> result.Add t
| CliTypeResolutionResult.FirstLoad (assy : WoofWare.PawPrint.AssemblyReference) ->
requiredAssemblies.Add assy
result.ToImmutable ()
if requiredAssemblies.Count > 0 then
Error (requiredAssemblies |> Seq.toList)
else
{
EvaluationStack = EvalStack.Empty
@@ -140,3 +155,4 @@ and MethodState =
LocalMemoryPool = ()
ReturnState = returnState
}
|> Ok

12
WoofWare.PawPrint/NullaryIlOp.fs
View File

@@ -2,6 +2,8 @@ namespace WoofWare.PawPrint
#nowarn "42"
open Microsoft.Extensions.Logging
type private IArithmeticOperation =
abstract Int32Int32 : int32 -> int32 -> int32
abstract Int64Int64 : int64 -> int64 -> int64
@@ -108,7 +110,13 @@ module NullaryIlOp =
| ManagedPointerSource.Heap managedHeapAddress -> failwith "todo"
| EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo"
let internal execute (state : IlMachineState) (currentThread : ThreadId) (op : NullaryIlOp) : ExecutionResult =
let internal execute
(loggerFactory : ILoggerFactory)
(state : IlMachineState)
(currentThread : ThreadId)
(op : NullaryIlOp)
: ExecutionResult
=
match op with
| Nop ->
(IlMachineState.advanceProgramCounter currentThread state, WhatWeDid.Executed)
@@ -187,7 +195,7 @@ module NullaryIlOp =
|> Tuple.withRight WhatWeDid.Executed
|> ExecutionResult.Stepped
| Ret ->
match IlMachineState.returnStackFrame currentThread state with
match IlMachineState.returnStackFrame loggerFactory currentThread state with
| None -> ExecutionResult.Terminated (state, currentThread)
| Some state -> (state, WhatWeDid.Executed) |> ExecutionResult.Stepped
| LdcI4_0 ->

25
WoofWare.PawPrint/Program.fs
View File

@@ -72,9 +72,17 @@ module Program =
// 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.
|> IlMachineState.addThread
(MethodState.Empty mainMethod (ImmutableArray.CreateRange [ CliType.ObjectRef None ]) None)
dumped.Name
|> fun s ->
match
MethodState.Empty
s._LoadedAssemblies
dumped
mainMethod
(ImmutableArray.CreateRange [ CliType.ObjectRef None ])
None
with
| Ok meth -> IlMachineState.addThread meth dumped.Name s
| Error requiresRefs -> failwith "TODO: I'd be surprised if this could ever happen in a valid program"
let rec loadInitialState (state : IlMachineState) =
match
@@ -113,7 +121,16 @@ module Program =
// Now that BCL initialisation has taken place, overwrite the main thread completely.
let methodState =
MethodState.Empty mainMethod (ImmutableArray.Create (CliType.OfManagedObject arrayAllocation)) None
match
MethodState.Empty
state._LoadedAssemblies
dumped
mainMethod
(ImmutableArray.Create (CliType.OfManagedObject arrayAllocation))
None
with
| Ok s -> s
| Error _ -> failwith "TODO: I'd be surprised if this could ever happen in a valid program"
let threadState =
{ state.ThreadState.[mainThread] with

2
WoofWare.PawPrint/TypeInfo.fs
View File

@@ -55,6 +55,8 @@ type TypeInfo<'generic> =
/// <summary>
/// The base type that this type inherits from, or None for types that don't have a base type
/// (like System.Object).
///
/// Value types inherit *directly* from System.ValueType; enums directly from System.Enum.
/// </summary>
BaseType : BaseTypeInfo option

112
WoofWare.PawPrint/UnaryMetadataIlOp.fs
View File

@@ -64,6 +64,8 @@ module internal UnaryMetadataIlOp =
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| Callvirt ->
let logger = loggerFactory.CreateLogger "Callvirt"
let method, generics =
match metadataToken with
| MetadataToken.MethodDef defn ->
@@ -79,6 +81,18 @@ module internal UnaryMetadataIlOp =
| None -> failwith "nothing on stack when Callvirt called"
| Some obj -> obj
do
let assy = state.LoadedAssembly (snd method.DeclaringType) |> Option.get
let ty = assy.TypeDefs.[fst method.DeclaringType]
logger.LogTrace (
"Calling method {Assembly}.{Type}.{CallvirtMethod} on object {CallvirtObject}",
assy.Name.Name,
ty.Name,
method.Name,
currentObj
)
let methodToCall =
match currentObj with
| EvalStackValue.ManagedPointer src ->
@@ -113,6 +127,8 @@ module internal UnaryMetadataIlOp =
|> IlMachineState.callMethodInActiveAssembly loggerFactory thread generics methodToCall None
| Castclass -> failwith "TODO: Castclass unimplemented"
| Newobj ->
let logger = loggerFactory.CreateLogger "Newobj"
let state, assy, ctor =
match metadataToken with
| MethodDef md ->
@@ -128,18 +144,42 @@ module internal UnaryMetadataIlOp =
| Choice2Of2 _field -> failwith "unexpectedly NewObj found a constructor which is a field"
| x -> failwith $"Unexpected metadata token for constructor: %O{x}"
let state, init =
IlMachineState.ensureTypeInitialised loggerFactory thread ctor.DeclaringType state
match init with
| WhatWeDid.BlockedOnClassInit state -> failwith "TODO: another thread is running the initialiser"
| WhatWeDid.SuspendedForClassInit -> state, SuspendedForClassInit
| WhatWeDid.Executed ->
let ctorType, ctorAssembly = ctor.DeclaringType
let ctorAssembly = state.LoadedAssembly ctorAssembly |> Option.get
let ctorType = ctorAssembly.TypeDefs.[ctorType]
let fields =
ctorType.Fields
|> List.map (fun field ->
// TODO: I guess the type itself can have generics, which should be passed in as this array?
let zeroedAllocation = CliType.zeroOf ImmutableArray.Empty field.Signature
field.Name, zeroedAllocation
do
logger.LogDebug (
"Creating object of type {ConstructorAssembly}.{ConstructorType}",
ctorAssembly.Name.Name,
ctorType.Name
)
let state, fieldZeros =
((state, []), ctorType.Fields)
||> List.fold (fun (state, zeros) field ->
// TODO: generics
let state, zero =
IlMachineState.cliTypeZeroOf
loggerFactory
ctorAssembly
field.Signature
ImmutableArray.Empty
state
state, (field.Name, zero) :: zeros
)
let fields = List.rev fieldZeros
let allocatedAddr, state =
IlMachineState.allocateManagedObject ctorType fields state
@@ -175,21 +215,26 @@ module internal UnaryMetadataIlOp =
| EvalStackValue.Int32 v -> v
| popped -> failwith $"unexpectedly popped value %O{popped} to serve as array len"
let elementType =
let elementType, baseType =
match metadataToken with
| MetadataToken.TypeDefinition defn ->
state.LoadedAssembly currentState.ActiveAssembly
|> Option.get
|> fun assy -> assy.TypeDefs.[defn]
| x -> failwith $"TODO: Newarr element type resolution unimplemented for {x}"
let assy = state.LoadedAssembly currentState.ActiveAssembly |> Option.get
let elementType = assy.TypeDefs.[defn]
let baseType =
elementType.BaseType
|> TypeInfo.resolveBaseType
(fun (x : DumpedAssembly) -> x.Name)
(fun x y -> x.TypeDefs.[y])
baseClassTypes
elementType.Assembly
let baseType =
elementType.BaseType
|> TypeInfo.resolveBaseType
(fun (x : DumpedAssembly) -> x.Name)
(fun x y -> x.TypeDefs.[y])
baseClassTypes
elementType.Assembly
elementType, baseType
| MetadataToken.TypeSpecification spec ->
let assy = state.LoadedAssembly currentState.ActiveAssembly |> Option.get
let elementType = assy.TypeSpecs.[spec]
failwith ""
| x -> failwith $"TODO: Newarr element type resolution unimplemented for {x}"
let zeroOfType =
match baseType with
@@ -254,8 +299,16 @@ module internal UnaryMetadataIlOp =
let valueToStore, state = IlMachineState.popEvalStack thread state
let valueToStore =
EvalStackValue.toCliTypeCoerced (CliType.zeroOf ImmutableArray.Empty field.Signature) valueToStore
let state, zero =
// TODO: generics
IlMachineState.cliTypeZeroOf
loggerFactory
(state.ActiveAssembly thread)
field.Signature
ImmutableArray.Empty
state
let valueToStore = EvalStackValue.toCliTypeCoerced zero valueToStore
let currentObj, state = IlMachineState.popEvalStack thread state
@@ -328,8 +381,11 @@ module internal UnaryMetadataIlOp =
let popped, state = IlMachineState.popEvalStack thread state
let toStore =
EvalStackValue.toCliTypeCoerced (CliType.zeroOf ImmutableArray.Empty field.Signature) popped
let state, zero =
// TODO: generics
IlMachineState.cliTypeZeroOf loggerFactory activeAssy field.Signature ImmutableArray.Empty state
let toStore = EvalStackValue.toCliTypeCoerced zero popped
let state =
state.SetStatic (field.DeclaringType, activeAssy.Name) field.Name toStore
@@ -427,19 +483,23 @@ module internal UnaryMetadataIlOp =
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| NothingToDo state ->
// TODO: generics
let generics = ImmutableArray.Empty
let fieldValue, state =
match state.Statics.TryGetValue ((field.DeclaringType, activeAssy.Name)) with
| false, _ ->
// TODO: generics
let newVal = CliType.zeroOf ImmutableArray.Empty field.Signature
let state, newVal =
IlMachineState.cliTypeZeroOf loggerFactory activeAssy field.Signature generics state
newVal, state.SetStatic (field.DeclaringType, activeAssy.Name) field.Name newVal
| true, v ->
match v.TryGetValue field.Name with
| true, v -> v, state
| false, _ ->
// TODO: generics
let newVal = CliType.zeroOf ImmutableArray.Empty field.Signature
let state, newVal =
IlMachineState.cliTypeZeroOf loggerFactory activeAssy field.Signature generics state
newVal, state.SetStatic (field.DeclaringType, activeAssy.Name) field.Name newVal
do