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

Add extremely basic support for generics (#10)

Browse Source
This commit is contained in:
Patrick Stevens
2025-05-19 16:55:46 +01:00
committed by GitHub
parent 22c299ff2a
commit bc389f1f23
9 changed files with 517 additions and 310 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
CSharpExample/CSharpExample.csproj
View File

@@ -1,7 +1,8 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>netstandard2.0</TargetFramework>
<TargetFramework>net9.0</TargetFramework>
<OutputType>Exe</OutputType>
</PropertyGroup>
</Project>

12
CSharpExample/Class1.cs
View File

@@ -1,5 +1,6 @@
using System;
using System.IO;
using System.Threading;
namespace HelloWorldApp
{
@@ -7,11 +8,18 @@ namespace HelloWorldApp
{
static int Main(string[] args)
{
object locker = new FileInfo("hi");
lock (locker)
object locker = new object();
bool lockTaken = false;
try
{
Monitor.Enter(locker, ref lockTaken);
return 1;
}
finally
{
if (lockTaken)
Monitor.Exit(locker);
}
}
}
}

605
WoofWare.PawPrint/AbstractMachine.fs
View File

@@ -19,78 +19,12 @@ type ManagedObject =
SyncBlock : unit
}
type ReferenceType =
| String of string
| ManagedObject of fields : FieldSlot list
| Array of len : int * containedType : Type
and Type =
| ReferenceType of ReferenceType
| ValueType
[<RequireQualifiedAccess>]
module Type =
let rec sizeOnHeapRef (r : ReferenceType) : int =
match r with
| ReferenceType.String s ->
// UTF-16, so two bytes per char
2 * s.Length
| ReferenceType.ManagedObject fields -> fields |> Seq.sumBy (fun slot -> slot.FieldSize)
| ReferenceType.Array (len, ty) -> sizeOf ty * len + 4 // for the len
and sizeOf (t : Type) : int =
match t with
| ReferenceType t -> sizeOnHeapRef t
| ValueType -> failwith "todo"
let sizeOfTypeDefn (assy : DumpedAssembly) (t : WoofWare.PawPrint.TypeDefn) : int =
match t with
| TypeDefn.PrimitiveType prim ->
match prim with
| PrimitiveType.Void -> failwith "todo"
| PrimitiveType.Boolean -> failwith "todo"
| PrimitiveType.Char -> failwith "todo"
| PrimitiveType.SByte -> failwith "todo"
| PrimitiveType.Byte -> failwith "todo"
| PrimitiveType.Int16 -> failwith "todo"
| PrimitiveType.UInt16 -> failwith "todo"
| PrimitiveType.Int32 -> 4
| PrimitiveType.UInt32 -> failwith "todo"
| PrimitiveType.Int64 -> failwith "todo"
| PrimitiveType.UInt64 -> failwith "todo"
| PrimitiveType.Single -> failwith "todo"
| PrimitiveType.Double -> failwith "todo"
| PrimitiveType.String -> failwith "todo"
| PrimitiveType.TypedReference -> failwith "todo"
| PrimitiveType.IntPtr -> failwith "todo"
| PrimitiveType.UIntPtr -> failwith "todo"
| PrimitiveType.Object -> failwith "todo"
| TypeDefn.FromDefinition (handle, kind) ->
match kind with
| SignatureTypeKind.Unknown -> failwith "todo"
| SignatureTypeKind.Class -> 8
| SignatureTypeKind.ValueType ->
let ty = assy.TypeDefs.[handle]
failwith $"TODO: %O{ty}"
| s -> raise (System.ArgumentOutOfRangeException ())
| _ -> failwith $"oh no: %O{t}"
let ofTypeInfo (assy : DumpedAssembly) (t : WoofWare.PawPrint.TypeInfo) : Type =
// TODO: is value type?
t.Fields
|> List.map (fun field ->
{
FieldName = field.Name
FieldSize = sizeOfTypeDefn assy field.Signature
}
)
|> ReferenceType.ManagedObject
|> Type.ReferenceType
type MethodReturnState =
{
JumpTo : MethodState
WasInitialisingType : (TypeDefinitionHandle * AssemblyName) option
/// The Newobj instruction means we need to push a reference immediately after Ret.
WasConstructingObj : ManagedHeapAddress option
}
and MethodState =
@@ -116,11 +50,48 @@ and MethodState =
static member advanceProgramCounter (state : MethodState) =
MethodState.jumpProgramCounter (IlOp.NumberOfBytes state.ExecutingMethod.Locations.[state.IlOpIndex]) state
static member peekEvalStack (state : MethodState) : EvalStackValue option = EvalStack.Peek state.EvaluationStack
static member pushToEvalStack' (e : EvalStackValue) (state : MethodState) : MethodState =
{ state with
EvaluationStack = EvalStack.Push' e state.EvaluationStack
}
static member pushToEvalStack (o : CliType) (state : MethodState) : MethodState =
{ state with
EvaluationStack = EvalStack.Push o state.EvaluationStack
}
/// Pop the eval stack into the given argument slot.
static member popFromStackToArg (index : int) (state : MethodState) : MethodState =
let popped, state = MethodState.popFromStack state
let arg =
if index < state.Arguments.Length then
state.Arguments.[index]
else
failwith
$"Tried to get element {index} of the args list for method {state.ExecutingMethod.Name}, which has only {state.Arguments.Length} elements"
let popped = EvalStackValue.toCliTypeCoerced arg popped
{ state with
Arguments = state.Arguments.SetItem (index, popped)
}
static member loadArgument (index : int) (state : MethodState) : MethodState =
// Correct CIL guarantees that we are loading an argument from an index that exists.
{ state with
EvaluationStack = state.EvaluationStack |> EvalStack.Push state.Arguments.[index]
}
MethodState.pushToEvalStack state.Arguments.[index] state
static member popFromStack (state : MethodState) : EvalStackValue * MethodState =
let popped, newStack = EvalStack.Pop state.EvaluationStack
let state =
{ state with
EvaluationStack = newStack
}
popped, state
static member popFromStackToVariable (localVariableIndex : int) (state : MethodState) : MethodState =
if localVariableIndex >= state.LocalVariables.Length then
@@ -130,43 +101,33 @@ and MethodState =
if localVariableIndex < 0 || localVariableIndex >= 65535 then
failwith $"Incorrect CIL encountered: local variable index has value %i{localVariableIndex}"
let popped, newStack = EvalStack.Pop state.EvaluationStack
let popped, state = MethodState.popFromStack state
let desiredValue =
match state.LocalVariables.[localVariableIndex] with
| CliType.Numeric numeric ->
match numeric with
| CliNumericType.Int32 _ ->
match popped with
| EvalStackValue.Int32 i -> CliType.Numeric (CliNumericType.Int32 i)
| i -> failwith $"TODO: %O{i}"
| CliNumericType.Int64 int64 -> failwith "todo"
| CliNumericType.NativeInt int64 -> failwith "todo"
| CliNumericType.NativeFloat f -> failwith "todo"
| CliNumericType.Int8 b -> failwith "todo"
| CliNumericType.Int16 s -> failwith "todo"
| CliNumericType.UInt8 b -> failwith "todo"
| CliNumericType.UInt16 s -> failwith "todo"
| CliNumericType.Float32 f -> failwith "todo"
| CliNumericType.Float64 f -> failwith "todo"
| CliType.ObjectRef _ ->
match popped with
| EvalStackValue.ManagedPointer addr -> CliType.ObjectRef addr
| i -> failwith $"TODO: %O{i}"
| CliType.Bool _ ->
match popped with
| EvalStackValue.Int32 i ->
// Bools are zero-extended
CliType.Bool (i % 256 |> byte)
| i -> failwith $"TODO: %O{i}"
| i -> failwith $"TODO: %O{i}"
EvalStackValue.toCliTypeCoerced state.LocalVariables.[localVariableIndex] popped
{ state with
EvaluationStack = newStack
LocalVariables = state.LocalVariables.SetItem (localVariableIndex, desiredValue)
}
static member Empty (method : WoofWare.PawPrint.MethodInfo) (returnState : MethodReturnState option) =
/// `args` must be populated with entries of the right type.
/// 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
(method : WoofWare.PawPrint.MethodInfo)
(args : ImmutableArray<CliType>)
(returnState : MethodReturnState option)
: MethodState
=
do
if method.IsStatic then
if args.Length <> method.Parameters.Length then
failwith
$"Static method {method.Name} should have had %i{method.Parameters.Length} parameters, but was given %i{args.Length}"
else if args.Length <> method.Parameters.Length + 1 then
failwith
$"Non-static method {method.Name} should have had %i{method.Parameters.Length + 1} parameters, but was given %i{args.Length}"
let localVariableSig =
match method.LocalVars with
| None -> ImmutableArray.Empty
@@ -174,49 +135,13 @@ 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 localVars =
localVariableSig
|> Seq.map (fun var ->
match var with
| TypeDefn.PrimitiveType primitiveType ->
match primitiveType with
| PrimitiveType.Void -> failwith "todo"
| PrimitiveType.Boolean -> CliType.Bool 0uy
| PrimitiveType.Char -> failwith "todo"
| PrimitiveType.SByte -> failwith "todo"
| PrimitiveType.Byte -> failwith "todo"
| PrimitiveType.Int16 -> failwith "todo"
| PrimitiveType.UInt16 -> failwith "todo"
| PrimitiveType.Int32 -> CliType.Numeric (CliNumericType.Int32 0)
| PrimitiveType.UInt32 -> failwith "todo"
| PrimitiveType.Int64 -> CliType.Numeric (CliNumericType.Int64 0L)
| PrimitiveType.UInt64 -> failwith "todo"
| PrimitiveType.Single -> failwith "todo"
| PrimitiveType.Double -> failwith "todo"
| PrimitiveType.String -> failwith "todo"
| PrimitiveType.TypedReference -> failwith "todo"
| PrimitiveType.IntPtr -> failwith "todo"
| PrimitiveType.UIntPtr -> failwith "todo"
| PrimitiveType.Object -> CliType.ObjectRef None
| TypeDefn.Array (elt, shape) -> failwith "todo"
| TypeDefn.Pinned typeDefn -> failwith "todo"
| TypeDefn.Pointer typeDefn -> failwith "todo"
| TypeDefn.Byref typeDefn -> failwith "todo"
| TypeDefn.OneDimensionalArrayLowerBoundZero elements -> failwith "todo"
| TypeDefn.Modified (original, afterMod, modificationRequired) -> failwith "todo"
| TypeDefn.FromReference _ -> CliType.ObjectRef None
| TypeDefn.FromDefinition (_, signatureTypeKind) -> failwith "todo"
| TypeDefn.GenericInstantiation (generic, args) -> failwith "todo"
| TypeDefn.FunctionPointer typeMethodSignature -> failwith "todo"
| TypeDefn.GenericTypeParameter index -> failwith "todo"
| TypeDefn.GenericMethodParameter index -> failwith "todo"
)
|> ImmutableArray.CreateRange
localVariableSig |> Seq.map CliType.zeroOf |> ImmutableArray.CreateRange
{
EvaluationStack = EvalStack.Empty
LocalVariables = localVars
IlOpIndex = 0
Arguments = Array.zeroCreate method.Parameters.Length |> ImmutableArray.ToImmutableArray
Arguments = args
ExecutingMethod = method
LocalMemoryPool = ()
ReturnState = returnState
@@ -235,6 +160,16 @@ type ThreadState =
ActiveAssembly = activeAssy
}
static member popFromEvalStack (state : ThreadState) : EvalStackValue * ThreadState =
let ret, popped = state.MethodState |> MethodState.popFromStack
let state =
{ state with
MethodState = popped
}
ret, state
type WhatWeDid =
| Executed
/// We didn't run what you wanted, because we have to do class initialisation first.
@@ -358,14 +293,20 @@ module IlMachineState =
(name : string)
(assy : DumpedAssembly)
(state : IlMachineState)
: IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo
: 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 -> state, assy, typeDef
| 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
@@ -381,7 +322,7 @@ module IlMachineState =
(fromAssembly : DumpedAssembly)
(ty : WoofWare.PawPrint.ExportedType)
(state : IlMachineState)
: IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo
: IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo<TypeDefn>
=
match ty.Data with
| NonForwarded _ -> failwith "Somehow didn't find type definition but it is exported"
@@ -394,7 +335,7 @@ module IlMachineState =
(referencedInAssembly : DumpedAssembly)
(target : TypeRef)
(state : IlMachineState)
: IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo
: IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo<TypeDefn>
=
match target.ResolutionScope with
| AssemblyReference r ->
@@ -418,7 +359,12 @@ module IlMachineState =
|> Seq.toList
match targetType with
| [ t ] -> state, assy, t
| [ 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
@@ -431,20 +377,117 @@ module IlMachineState =
(ty : TypeReferenceHandle)
(assy : DumpedAssembly)
(state : IlMachineState)
: IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo
: IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo<TypeDefn>
=
let target = assy.TypeRefs.[ty]
resolveTypeFromRef loggerFactory assy target state
let resolveTypeFromSpec
let rec resolveTypeFromDefn
(loggerFactory : ILoggerFactory)
(ty : TypeDefn)
(assy : DumpedAssembly)
(state : IlMachineState)
: IlMachineState *
DumpedAssembly *
WoofWare.PawPrint.TypeInfo<WoofWare.PawPrint.GenericParameter> *
TypeDefn ImmutableArray option
=
match ty with
| TypeDefn.GenericInstantiation (generic, args) ->
let state, _, generic, subArgs =
resolveTypeFromDefn loggerFactory generic assy state
match subArgs with
| Some _ -> failwith "unexpectedly had multiple generic instantiations for the same type"
| None ->
state, assy, generic, Some args
| TypeDefn.FromDefinition (defn, _typeKind) -> state, assy, assy.TypeDefs.[defn], None
| s -> failwith $"todo: {s}"
let rec resolveTypeFromSpec
(loggerFactory : ILoggerFactory)
(ty : TypeSpecificationHandle)
(assy : DumpedAssembly)
(state : IlMachineState)
: IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo
: IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo<TypeDefn>
=
failwith "TODO"
let state, assy, generic, args =
resolveTypeFromDefn loggerFactory assy.TypeSpecs.[ty].Signature assy state
match args with
| None ->
let generic =
generic
|> TypeInfo.mapGeneric (fun _ -> failwith<TypeDefn> "no generic parameters")
state, assy, generic
| Some args ->
let generic = TypeInfo.withGenerics args generic
state, assy, generic
let callMethod
(wasInitialising : (TypeDefinitionHandle * AssemblyName) option)
(wasConstructing : ManagedHeapAddress option)
(methodToCall : WoofWare.PawPrint.MethodInfo)
(thread : ThreadId)
(threadState : ThreadState)
(state : IlMachineState)
: IlMachineState
=
let newFrame =
if methodToCall.IsStatic then
let args = ImmutableArray.CreateBuilder methodToCall.Parameters.Length
let mutable afterPop = threadState.MethodState
for i = 0 to methodToCall.Parameters.Length - 1 do
let poppedArg, afterPop' = afterPop |> MethodState.popFromStack
let zeroArg = CliType.zeroOf methodToCall.Signature.ParameterTypes.[i]
let poppedArg = EvalStackValue.toCliTypeCoerced zeroArg poppedArg
afterPop <- afterPop'
args.Add poppedArg
MethodState.Empty
methodToCall
(args.ToImmutable ())
(Some
{
JumpTo = afterPop |> MethodState.advanceProgramCounter
WasInitialisingType = None
WasConstructingObj = wasConstructing
})
else
let args = ImmutableArray.CreateBuilder (methodToCall.Parameters.Length + 1)
let poppedArg, afterPop = threadState.MethodState |> MethodState.popFromStack
args.Add (EvalStackValue.toCliTypeCoerced (CliType.ObjectRef None) poppedArg)
let mutable afterPop = afterPop
for i = 1 to methodToCall.Parameters.Length do
let poppedArg, afterPop' = afterPop |> MethodState.popFromStack
let zeroArg = CliType.zeroOf methodToCall.Signature.ParameterTypes.[i - 1]
let poppedArg = EvalStackValue.toCliTypeCoerced zeroArg poppedArg
afterPop <- afterPop'
args.Add poppedArg
MethodState.Empty
methodToCall
(args.ToImmutable ())
(Some
{
JumpTo = afterPop |> MethodState.advanceProgramCounter
WasInitialisingType = wasInitialising
WasConstructingObj = wasConstructing
})
let newThreadState =
{ threadState with
MethodState = newFrame
}
{ state with
ThreadState = state.ThreadState |> Map.add thread newThreadState
}
let rec loadClass
(loggerFactory : ILoggerFactory)
@@ -555,24 +598,7 @@ module IlMachineState =
// TODO: factor out the common bit.
let currentThreadState = state.ThreadState.[currentThread]
let newMethodState =
MethodState.Empty
ctorMethod
(Some
{
JumpTo = currentThreadState.MethodState |> MethodState.advanceProgramCounter
WasInitialisingType = Some (typeDefHandle, assemblyName)
})
{ state with
ThreadState =
state.ThreadState
|> Map.add
currentThread
{ currentThreadState with
MethodState = newMethodState
}
}
callMethod (Some (typeDefHandle, assemblyName)) None ctorMethod currentThread currentThreadState state
|> FirstLoadThis
| None ->
// No constructor, just continue.
@@ -593,6 +619,7 @@ module IlMachineState =
(loggerFactory : ILoggerFactory)
(thread : ThreadId)
(methodToCall : WoofWare.PawPrint.MethodInfo)
(weAreConstructingObj : ManagedHeapAddress option)
(state : IlMachineState)
: IlMachineState * WhatWeDid
=
@@ -604,60 +631,29 @@ module IlMachineState =
loadClass loggerFactory (fst methodToCall.DeclaringType) (snd methodToCall.DeclaringType) thread state
with
| NothingToDo state ->
// TODO: factor this out, it's the same as the Initialized flow
let newThreadState =
{ threadState with
MethodState =
MethodState.Empty
methodToCall
(Some
{
JumpTo = threadState.MethodState |> MethodState.advanceProgramCounter
WasInitialisingType = None
})
}
{ state with
ThreadState = state.ThreadState |> Map.add thread newThreadState
},
WhatWeDid.Executed
callMethod None weAreConstructingObj methodToCall thread threadState state, WhatWeDid.Executed
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| true, TypeInitState.Initialized ->
let newThreadState =
{ threadState with
MethodState =
MethodState.Empty
methodToCall
(Some
{
JumpTo = threadState.MethodState |> MethodState.advanceProgramCounter
WasInitialisingType = None
})
}
{ state with
ThreadState = state.ThreadState |> Map.add thread newThreadState
},
WhatWeDid.Executed
callMethod None weAreConstructingObj methodToCall thread threadState state, WhatWeDid.Executed
| true, InProgress threadId -> state, WhatWeDid.BlockedOnClassInit threadId
let initial (dotnetRuntimeDirs : ImmutableArray<string>) (entryAssembly : DumpedAssembly) : IlMachineState =
let assyName = entryAssembly.ThisAssemblyDefinition.Name
{
NextThreadId = 0
// CallStack = []
ManagedHeap = ManagedHeap.Empty
ThreadState = Map.empty
InternedStrings = ImmutableDictionary.Empty
_LoadedAssemblies = ImmutableDictionary.Empty
Statics = ImmutableDictionary.Empty
TypeInitTable = ImmutableDictionary.Empty
DotnetRuntimeDirs = dotnetRuntimeDirs
}
.WithLoadedAssembly
assyName
entryAssembly
let state =
{
NextThreadId = 0
// CallStack = []
ManagedHeap = ManagedHeap.Empty
ThreadState = Map.empty
InternedStrings = ImmutableDictionary.Empty
_LoadedAssemblies = ImmutableDictionary.Empty
Statics = ImmutableDictionary.Empty
TypeInitTable = ImmutableDictionary.Empty
DotnetRuntimeDirs = dotnetRuntimeDirs
}
state.WithLoadedAssembly assyName entryAssembly
let addThread
(newThreadState : MethodState)
@@ -728,8 +724,8 @@ module IlMachineState =
ManagedHeap = heap
}
let allocateManagedObject
(typeInfo : WoofWare.PawPrint.TypeInfo)
let allocateManagedObject<'generic>
(typeInfo : WoofWare.PawPrint.TypeInfo<'generic>)
(fields : (string * CliType) list)
(state : IlMachineState)
: ManagedHeapAddress * IlMachineState
@@ -737,7 +733,7 @@ module IlMachineState =
let o =
{
Fields = Map.ofList fields
Type = typeInfo
Type = TypeInfoCrate.make typeInfo
}
let alloc, heap = state.ManagedHeap |> ManagedHeap.AllocateNonArray o
@@ -749,7 +745,7 @@ module IlMachineState =
alloc, state
let pushToEvalStack (o : CliType) (thread : ThreadId) (state : IlMachineState) =
let pushToEvalStack' (o : EvalStackValue) (thread : ThreadId) (state : IlMachineState) =
{ state with
ThreadState =
state.ThreadState
@@ -760,8 +756,24 @@ module IlMachineState =
| None -> failwith "Logic error: tried to push to stack of a nonexistent thread"
| Some threadState ->
{ threadState with
ThreadState.MethodState.EvaluationStack =
threadState.MethodState.EvaluationStack |> EvalStack.Push o
ThreadState.MethodState = threadState.MethodState |> MethodState.pushToEvalStack' o
}
|> Some
)
}
let pushToEvalStack (o : CliType) (thread : ThreadId) (state : IlMachineState) : IlMachineState =
{ state with
ThreadState =
state.ThreadState
|> Map.change
thread
(fun threadState ->
match threadState with
| None -> failwith "Logic error: tried to push to stack of a nonexistent thread"
| Some threadState ->
{ threadState with
ThreadState.MethodState = threadState.MethodState |> MethodState.pushToEvalStack o
}
|> Some
)
@@ -779,8 +791,8 @@ module IlMachineState =
| None -> failwith "Logic error: tried to push to stack of a nonexistent thread"
| Some threadState ->
{ threadState with
ThreadState.MethodState.EvaluationStack =
threadState.MethodState.EvaluationStack |> EvalStack.Push (failwith "TODO")
ThreadState.MethodState =
threadState.MethodState |> MethodState.pushToEvalStack (failwith "TODO")
}
|> Some
)
@@ -810,6 +822,19 @@ module IlMachineState =
}
}
let peekEvalStack (thread : ThreadId) (state : IlMachineState) : EvalStackValue option =
MethodState.peekEvalStack state.ThreadState.[thread].MethodState
let popEvalStack (thread : ThreadId) (state : IlMachineState) : EvalStackValue * IlMachineState =
let ret, popped = ThreadState.popFromEvalStack state.ThreadState.[thread]
let state =
{ state with
ThreadState = state.ThreadState |> Map.add thread popped
}
ret, state
let setArrayValue
(arrayAllocation : ManagedHeapAddress)
(v : CliType)
@@ -950,27 +975,13 @@ module AbstractMachine =
|> ExecutionResult.Stepped
| Pop -> failwith "todo"
| Dup ->
{ state with
ThreadState =
state.ThreadState
|> Map.change
currentThread
(fun threadState ->
match threadState with
| None -> failwith "thread didn't exist"
| Some threadState ->
let topValue =
match IlMachineState.peekEvalStack currentThread state with
| None -> failwith "tried to Dup when nothing on top of stack"
| Some v -> v
let topValue = threadState.MethodState.EvaluationStack.Values |> List.head
{ threadState with
ThreadState.MethodState.EvaluationStack =
{
Values = topValue :: threadState.MethodState.EvaluationStack.Values
}
}
|> Some
)
}
state
|> IlMachineState.pushToEvalStack' topValue currentThread
|> IlMachineState.advanceProgramCounter currentThread
|> Tuple.withRight WhatWeDid.Executed
|> ExecutionResult.Stepped
@@ -1003,6 +1014,13 @@ module AbstractMachine =
}
}
let state =
match returnState.WasConstructingObj with
| None -> state
| Some constructing ->
state
|> IlMachineState.pushToEvalStack (CliType.OfManagedObject constructing) currentThread
match threadStateAtEndOfMethod.MethodState.EvaluationStack.Values with
| [] ->
// no return value
@@ -1015,7 +1033,7 @@ module AbstractMachine =
|> IlMachineState.pushToStackCoerced retVal retType currentThread
|> Tuple.withRight WhatWeDid.Executed
|> ExecutionResult.Stepped
| vals ->
| _ ->
failwith
"Unexpected interpretation result has a local evaluation stack with more than one element on RET"
@@ -1128,7 +1146,27 @@ module AbstractMachine =
| Conv_I8 -> failwith "todo"
| Conv_R4 -> failwith "todo"
| Conv_R8 -> failwith "todo"
| Conv_U -> failwith "todo"
| Conv_U ->
let popped, state = IlMachineState.popEvalStack currentThread state
let converted = EvalStackValue.toUnsignedNativeInt popped
let state =
match converted with
| None -> failwith "TODO"
| Some conv ->
// > If overflow occurs when converting one integer type to another, the high-order bits are silently truncated.
let conv =
if conv > uint64 System.Int64.MaxValue then
(conv % uint64 System.Int64.MaxValue) |> int64
else
int64 conv
state
|> IlMachineState.pushToEvalStack' (EvalStackValue.NativeInt conv) currentThread
let state = state |> IlMachineState.advanceProgramCounter currentThread
(state, WhatWeDid.Executed) |> ExecutionResult.Stepped
| Conv_U1 -> failwith "todo"
| Conv_U2 -> failwith "todo"
| Conv_U4 -> failwith "todo"
@@ -1290,13 +1328,13 @@ module AbstractMachine =
state.WithThreadSwitchedToAssembly (snd methodToCall.DeclaringType) thread
|> fst
|> IlMachineState.callMethodInActiveAssembly loggerFactory thread methodToCall
|> IlMachineState.callMethodInActiveAssembly loggerFactory thread methodToCall None
// TODO: push the instance pointer if necessary
// TODO: push args?
| Callvirt -> failwith "todo"
| Castclass -> failwith "todo"
| Newobj ->
// TODO: Pass the allocation as the first argument to the constructor. Check the rest of what
// newobj is supposed to do, and do it.
let state, assy, ctor =
match metadataToken with
| MethodDef md ->
@@ -1313,22 +1351,7 @@ module AbstractMachine =
let fields =
ctorType.Fields
|> List.map (fun field ->
let zeroedAllocation =
match field.Signature with
| TypeDefn.PrimitiveType ty -> failwith "todo"
| TypeDefn.Array _ -> failwith "todo"
| TypeDefn.Pinned _ -> failwith "todo"
| TypeDefn.Pointer _ -> failwith "todo"
| TypeDefn.Byref _ -> failwith "todo"
| TypeDefn.OneDimensionalArrayLowerBoundZero _ -> failwith "todo"
| TypeDefn.Modified _ -> failwith "todo"
| TypeDefn.FromReference _ -> failwith "todo"
| TypeDefn.FromDefinition _ -> failwith "todo"
| TypeDefn.GenericInstantiation _ -> failwith "todo"
| TypeDefn.FunctionPointer _ -> failwith "todo"
| TypeDefn.GenericTypeParameter _ -> failwith "todo"
| TypeDefn.GenericMethodParameter _ -> failwith "todo"
let zeroedAllocation = CliType.zeroOf field.Signature
field.Name, zeroedAllocation
)
@@ -1337,21 +1360,32 @@ module AbstractMachine =
let state =
state
|> IlMachineState.pushToEvalStack (CliType.OfManagedObject allocatedAddr) thread
|> IlMachineState.pushToEvalStack'
(EvalStackValue.ManagedPointer (ManagedPointerSource.Heap allocatedAddr))
thread
let log = loggerFactory.CreateLogger "newobj"
log.LogInformation ("{ctor}", ctor)
let state, whatWeDid =
state.WithThreadSwitchedToAssembly assy thread
|> fst
|> IlMachineState.callMethodInActiveAssembly loggerFactory thread ctor
|> IlMachineState.callMethodInActiveAssembly loggerFactory thread ctor (Some allocatedAddr)
state, whatWeDid
match whatWeDid with
| SuspendedForClassInit -> failwith "unexpectedly suspended while initialising constructor"
| BlockedOnClassInit threadBlockingUs -> failwith "todo"
| Executed -> ()
// TODO: once the constructor has finished, load the object onto the stack
state, WhatWeDid.Executed
| Newarr ->
let currentState = state.ThreadState.[thread]
let popped, newStack = EvalStack.Pop currentState.MethodState.EvaluationStack
let popped, newMethodState = MethodState.popFromStack currentState.MethodState
let currentState =
{ currentState with
ThreadState.MethodState.EvaluationStack = newStack
ThreadState.MethodState = newMethodState
}
let len =
@@ -1414,23 +1448,20 @@ module AbstractMachine =
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| NothingToDo state ->
let popped, evalStack =
EvalStack.Pop state.ThreadState.[thread].MethodState.EvaluationStack
let popped, state = IlMachineState.popEvalStack thread state
let toStore =
match popped with
| EvalStackValue.ManagedPointer addr -> CliType.ObjectRef addr
| EvalStackValue.ManagedPointer source ->
match source with
| ManagedPointerSource.LocalVariable -> failwith "todo"
| ManagedPointerSource.Heap addr -> CliType.ObjectRef (Some addr)
| ManagedPointerSource.Null -> CliType.ObjectRef None
| _ -> failwith "TODO"
let newThreadState =
{ state.ThreadState.[thread] with
ThreadState.MethodState.EvaluationStack = evalStack
}
let state =
{ state with
Statics = state.Statics.SetItem ((field.DeclaringType, activeAssy.Name), toStore)
ThreadState = state.ThreadState |> Map.add thread newThreadState
}
state, WhatWeDid.Executed
@@ -1474,9 +1505,9 @@ module AbstractMachine =
failwith "TODO: push unmanaged pointer"
| Ldftn -> failwith "todo"
| Stobj -> failwith "todo"
| Constrained -> failwith "todo"
| Ldtoken -> failwith "todo"
| Cpobj -> failwith "todo"
| Constrained -> failwith "todo: constrained"
| Ldtoken -> failwith "todo: ldtoken"
| Cpobj -> failwith "todo: cpobj"
| Ldobj -> failwith "todo"
| Sizeof -> failwith "todo"
| Calli -> failwith "todo"
@@ -1533,7 +1564,11 @@ module AbstractMachine =
]
let addr, state =
IlMachineState.allocateManagedObject baseClassTypes.String fields state
IlMachineState.allocateManagedObject
(baseClassTypes.String
|> TypeInfo.mapGeneric (fun _ -> failwith<unit> "string is not generic"))
fields
state
addr,
{ state with
@@ -1609,7 +1644,15 @@ module AbstractMachine =
| Ble_un i -> failwith "todo"
| Blt_un i -> failwith "todo"
| Ldloc_s b -> failwith "todo"
| Ldloca_s b -> failwith "todo"
| Ldloca_s b ->
let state =
state
|> IlMachineState.pushToEvalStack'
(EvalStackValue.ManagedPointer (ManagedPointerSource.LocalVariable))
currentThread
|> IlMachineState.advanceProgramCounter currentThread
state, WhatWeDid.Executed
| Ldarga s -> failwith "todo"
| Ldarg_s b -> failwith "todo"
| Ldarga_s b -> failwith "todo"

14
WoofWare.PawPrint/Assembly.fs
View File

@@ -42,7 +42,8 @@ type DumpedAssembly =
/// <summary>
/// Dictionary of all type definitions in this assembly, keyed by their handle.
/// </summary>
TypeDefs : IReadOnlyDictionary<TypeDefinitionHandle, WoofWare.PawPrint.TypeInfo>
TypeDefs :
IReadOnlyDictionary<TypeDefinitionHandle, WoofWare.PawPrint.TypeInfo<WoofWare.PawPrint.GenericParameter>>
/// <summary>
/// Dictionary of all type references in this assembly, keyed by their handle.
@@ -140,7 +141,8 @@ type DumpedAssembly =
/// <summary>
/// Internal lookup for type definitions by namespace and name.
/// </summary>
_TypeDefsLookup : ImmutableDictionary<string * string, WoofWare.PawPrint.TypeInfo>
_TypeDefsLookup :
ImmutableDictionary<string * string, WoofWare.PawPrint.TypeInfo<WoofWare.PawPrint.GenericParameter>>
}
static member internal BuildExportedTypesLookup
@@ -196,7 +198,7 @@ type DumpedAssembly =
static member internal BuildTypeDefsLookup
(logger : ILogger)
(name : AssemblyName)
(typeDefs : WoofWare.PawPrint.TypeInfo seq)
(typeDefs : WoofWare.PawPrint.TypeInfo<WoofWare.PawPrint.GenericParameter> seq)
=
let result = ImmutableDictionary.CreateBuilder ()
let keys = HashSet ()
@@ -224,7 +226,11 @@ type DumpedAssembly =
| false, _ -> None
| true, v -> Some v
member this.TypeDef (``namespace`` : string) (name : string) : WoofWare.PawPrint.TypeInfo option =
member this.TypeDef
(``namespace`` : string)
(name : string)
: WoofWare.PawPrint.TypeInfo<WoofWare.PawPrint.GenericParameter> option
=
match this._TypeDefsLookup.TryGetValue ((``namespace``, name)) with
| false, _ -> None
| true, v -> Some v

37
WoofWare.PawPrint/BasicCliType.fs
View File

@@ -83,3 +83,40 @@ type CliType =
CliType.Char (byte (int c / 256), byte (int c % 256))
static member OfManagedObject (ptr : ManagedHeapAddress) = CliType.ObjectRef (Some ptr)
[<RequireQualifiedAccess>]
module CliType =
let zeroOf (ty : TypeDefn) : CliType =
match ty with
| TypeDefn.PrimitiveType primitiveType ->
match primitiveType with
| PrimitiveType.Void -> failwith "todo"
| PrimitiveType.Boolean -> CliType.Bool 0uy
| PrimitiveType.Char -> CliType.Char (0uy, 0uy)
| PrimitiveType.SByte -> CliType.Numeric (CliNumericType.Int8 0y)
| PrimitiveType.Byte -> CliType.Numeric (CliNumericType.UInt8 0uy)
| PrimitiveType.Int16 -> CliType.Numeric (CliNumericType.Int16 0s)
| PrimitiveType.UInt16 -> CliType.Numeric (CliNumericType.UInt16 0us)
| PrimitiveType.Int32 -> CliType.Numeric (CliNumericType.Int32 0)
| PrimitiveType.UInt32 -> failwith "todo"
| PrimitiveType.Int64 -> CliType.Numeric (CliNumericType.Int64 0L)
| PrimitiveType.UInt64 -> failwith "todo"
| PrimitiveType.Single -> CliType.Numeric (CliNumericType.Float32 0.0f)
| 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.Object -> CliType.ObjectRef None
| TypeDefn.Array _ -> CliType.ObjectRef None
| TypeDefn.Pinned typeDefn -> failwith "todo"
| TypeDefn.Pointer _ -> CliType.ObjectRef None
| TypeDefn.Byref _ -> CliType.ObjectRef None
| TypeDefn.OneDimensionalArrayLowerBoundZero _ -> CliType.ObjectRef None
| TypeDefn.Modified (original, afterMod, modificationRequired) -> failwith "todo"
| TypeDefn.FromReference (typeReferenceHandle, signatureTypeKind) -> failwith "todo"
| TypeDefn.FromDefinition (typeDefinitionHandle, signatureTypeKind) -> failwith "todo"
| TypeDefn.GenericInstantiation (generic, args) -> failwith "todo"
| TypeDefn.FunctionPointer typeMethodSignature -> failwith "todo"
| TypeDefn.GenericTypeParameter index -> failwith "todo"
| TypeDefn.GenericMethodParameter index -> failwith "todo"

84
WoofWare.PawPrint/EvalStack.fs
View File

@@ -1,17 +1,79 @@
namespace WoofWare.PawPrint
open Microsoft.FSharp.Core
type ManagedPointerSource =
| LocalVariable
| Heap of ManagedHeapAddress
| Null
/// See I.12.3.2.1 for definition
type EvalStackValue =
| Int32 of int32
| Int64 of int64
| NativeInt of int64
| Float of float
/// allowed to be null
| ManagedPointer of ManagedHeapAddress option
| ManagedPointer of ManagedPointerSource
| ObjectRef of ManagedHeapAddress
| TransientPointer of int
// Fraser thinks this isn't really a thing in CoreCLR
// | TransientPointer of TransientPointerSource
| UserDefinedValueType
[<RequireQualifiedAccess>]
module EvalStackValue =
/// The conversion performed by Conv_u.
let toUnsignedNativeInt (value : EvalStackValue) : uint64 option =
// Table III.8
match value with
| EvalStackValue.Int32 i ->
if i >= 0 then
Some (uint64 i)
else
// Zero-extend.
failwith "todo"
| EvalStackValue.Int64 i -> if i >= 0L then Some (uint64 i) else failwith "todo"
| EvalStackValue.NativeInt i -> if i >= 0L then Some (uint64 i) else failwith "todo"
| EvalStackValue.Float f -> failwith "todo"
| EvalStackValue.ManagedPointer managedPointerSource -> failwith "todo"
| EvalStackValue.ObjectRef managedHeapAddress -> failwith "todo"
| EvalStackValue.UserDefinedValueType -> failwith "todo"
let toCliTypeCoerced (target : CliType) (popped : EvalStackValue) : CliType =
match target with
| CliType.Numeric numeric ->
match numeric with
| CliNumericType.Int32 _ ->
match popped with
| EvalStackValue.Int32 i -> CliType.Numeric (CliNumericType.Int32 i)
| i -> failwith $"TODO: %O{i}"
| CliNumericType.Int64 int64 -> failwith "todo"
| CliNumericType.NativeInt int64 -> failwith "todo"
| CliNumericType.NativeFloat f -> failwith "todo"
| CliNumericType.Int8 b -> failwith "todo"
| CliNumericType.Int16 s -> failwith "todo"
| CliNumericType.UInt8 b -> failwith "todo"
| CliNumericType.UInt16 s -> failwith "todo"
| CliNumericType.Float32 f -> failwith "todo"
| CliNumericType.Float64 f -> failwith "todo"
| CliType.ObjectRef _ ->
match popped with
| EvalStackValue.ManagedPointer ptrSource ->
match ptrSource with
| ManagedPointerSource.LocalVariable ->
failwith "TODO: trying to fit a local variable address into an ObjectRef"
| ManagedPointerSource.Heap managedHeapAddress -> CliType.ObjectRef (Some managedHeapAddress)
| ManagedPointerSource.Null -> CliType.ObjectRef None
| i -> failwith $"TODO: %O{i}"
| CliType.Bool _ ->
match popped with
| EvalStackValue.Int32 i ->
// Bools are zero-extended
CliType.Bool (i % 256 |> byte)
| EvalStackValue.ManagedPointer src ->
failwith $"unexpectedly tried to convert a managed pointer (%O{src}) into a bool"
| i -> failwith $"TODO: %O{i}"
| i -> failwith $"TODO: %O{i}"
type EvalStack =
{
Values : EvalStackValue list
@@ -33,6 +95,13 @@ type EvalStack =
v, stack
static member Peek (stack : EvalStack) : EvalStackValue option = stack.Values |> List.tryHead
static member Push' (v : EvalStackValue) (stack : EvalStack) : EvalStack =
{
Values = v :: stack.Values
}
static member Push (v : CliType) (stack : EvalStack) : EvalStack =
let v =
match v with
@@ -50,12 +119,13 @@ type EvalStack =
| CliNumericType.Float32 f -> failwith "todo"
| CliNumericType.Float64 f -> failwith "todo"
| CliNumericType.NativeFloat f -> failwith "todo"
| CliType.ObjectRef i -> EvalStackValue.ManagedPointer i
| CliType.ObjectRef i ->
match i with
| None -> EvalStackValue.ManagedPointer ManagedPointerSource.Null
| Some i -> EvalStackValue.ManagedPointer (ManagedPointerSource.Heap i)
// Zero-extend bool/char
| CliType.Bool b -> int32 b |> EvalStackValue.Int32
| CliType.Char (high, low) -> int32 high * 256 + int32 low |> EvalStackValue.Int32
| CliType.RuntimePointer cliRuntimePointer -> failwith "todo"
{
Values = v :: stack.Values
}
EvalStack.Push' v stack

2
WoofWare.PawPrint/ManagedHeap.fs
View File

@@ -5,7 +5,7 @@ open System.Collections.Immutable
type AllocatedNonArrayObject =
{
Fields : Map<string, CliType>
Type : WoofWare.PawPrint.TypeInfo
Type : WoofWare.PawPrint.TypeInfoCrate
}
type AllocatedArray =

15
WoofWare.PawPrint/Program.fs
View File

@@ -17,7 +17,11 @@ module Program =
let argsAllocations, state =
(state, args)
||> Seq.mapFold (fun state arg ->
IlMachineState.allocateManagedObject corelib.String (failwith "TODO: assert fields and populate") state
IlMachineState.allocateManagedObject
(corelib.String
|> TypeInfo.mapGeneric (fun _ -> failwith<unit> "there are no generics here"))
(failwith "TODO: assert fields and populate")
state
// TODO: set the char values in memory
)
@@ -65,7 +69,10 @@ module Program =
// 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.
|> IlMachineState.addThread (MethodState.Empty mainMethod None) dumped.Name
// 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
let rec loadInitialState (state : IlMachineState) =
match
@@ -106,9 +113,7 @@ module Program =
let state, mainThread =
state
|> IlMachineState.addThread
{ MethodState.Empty mainMethod None with
Arguments = ImmutableArray.Create (CliType.OfManagedObject arrayAllocation)
}
(MethodState.Empty mainMethod (ImmutableArray.Create (CliType.OfManagedObject arrayAllocation)) None)
dumped.Name
let rec go (state : IlMachineState) =

55
WoofWare.PawPrint/TypeInfo.fs
View File

@@ -48,7 +48,7 @@ type MethodImplParsed =
/// Represents detailed information about a type definition in a .NET assembly.
/// This is a strongly-typed representation of TypeDefinition from System.Reflection.Metadata.
/// </summary>
type TypeInfo =
type TypeInfo<'generic> =
{
/// <summary>The namespace containing the type.</summary>
Namespace : string
@@ -98,27 +98,60 @@ type TypeInfo =
/// The assembly in which this type is defined.
/// </summary>
Assembly : AssemblyName
Generics : 'generic ImmutableArray
}
type TypeInfoEval<'ret> =
abstract Eval<'a> : TypeInfo<'a> -> 'ret
type TypeInfoCrate =
abstract Apply<'ret> : TypeInfoEval<'ret> -> 'ret
[<RequireQualifiedAccess>]
module TypeInfoCrate =
let make<'a> (t : TypeInfo<'a>) =
{ new TypeInfoCrate with
member _.Apply e = e.Eval t
}
type BaseClassTypes<'corelib> =
{
Corelib : 'corelib
String : TypeInfo
Array : TypeInfo
Enum : TypeInfo
ValueType : TypeInfo
Object : TypeInfo
String : TypeInfo<WoofWare.PawPrint.GenericParameter>
Array : TypeInfo<WoofWare.PawPrint.GenericParameter>
Enum : TypeInfo<WoofWare.PawPrint.GenericParameter>
ValueType : TypeInfo<WoofWare.PawPrint.GenericParameter>
Object : TypeInfo<WoofWare.PawPrint.GenericParameter>
}
[<RequireQualifiedAccess>]
module TypeInfo =
let withGenerics<'a, 'b> (gen : 'b ImmutableArray) (t : TypeInfo<'a>) : TypeInfo<'b> =
{
Namespace = t.Namespace
Name = t.Name
Methods = t.Methods
MethodImpls = t.MethodImpls
Fields = t.Fields
BaseType = t.BaseType
TypeAttributes = t.TypeAttributes
Attributes = t.Attributes
TypeDefHandle = t.TypeDefHandle
Assembly = t.Assembly
Generics = gen
}
let mapGeneric<'a, 'b> (f : 'a -> 'b) (t : TypeInfo<'a>) : TypeInfo<'b> =
withGenerics (t.Generics |> Seq.map f |> ImmutableArray.CreateRange) t
let internal read
(loggerFactory : ILoggerFactory)
(peReader : PEReader)
(thisAssembly : AssemblyName)
(metadataReader : MetadataReader)
(typeHandle : TypeDefinitionHandle)
: TypeInfo
: TypeInfo<WoofWare.PawPrint.GenericParameter>
=
let typeDef = metadataReader.GetTypeDefinition typeHandle
let methods = typeDef.GetMethods ()
@@ -152,6 +185,9 @@ module TypeInfo =
|> Seq.map (fun h -> CustomAttribute.make h (metadataReader.GetCustomAttribute h))
|> Seq.toList
let genericParams =
GenericParameter.readAll metadataReader (typeDef.GetGenericParameters ())
let methods =
methods
|> Seq.choose (fun m ->
@@ -185,11 +221,12 @@ module TypeInfo =
Attributes = attrs
TypeDefHandle = typeHandle
Assembly = thisAssembly
Generics = genericParams
}
let rec resolveBaseType<'corelib>
let rec resolveBaseType<'corelib, 'generic>
(getName : 'corelib -> AssemblyName)
(getType : 'corelib -> TypeDefinitionHandle -> TypeInfo)
(getType : 'corelib -> TypeDefinitionHandle -> TypeInfo<'generic>)
(baseClassTypes : BaseClassTypes<'corelib>)
(sourceAssembly : AssemblyName)
(value : BaseTypeInfo option)