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

Implement Dup, Newarr (#9)

Browse Source
This commit is contained in:
Patrick Stevens
2025-05-18 22:04:21 +01:00
committed by GitHub
parent 049e8c8fab
commit 22c299ff2a
7 changed files with 181 additions and 38 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
WoofWare.PawPrint.Test/TestBasicLock.fs
View File

@@ -9,7 +9,7 @@ open WoofWare.PawPrint.Test
open WoofWare.DotnetRuntimeLocator
[<TestFixture>]
module TestBasicLick =
module TestBasicLock =
let assy = typeof<RunResult>.Assembly
[<Test ; Explicit "This test doesn't run yet">]

74
WoofWare.PawPrint/AbstractMachine.fs
View File

@@ -688,13 +688,13 @@ module IlMachineState =
// alloc, state
let allocateArray
(elementType : WoofWare.PawPrint.TypeInfo)
(zeroOfType : unit -> CliType)
(len : int)
(state : IlMachineState)
: ManagedHeapAddress * IlMachineState
=
let zeroElement (_ : int) : CliType = failwith "TODO"
let initialisation = zeroElement |> Seq.init len |> ImmutableArray.CreateRange
let initialisation =
(fun _ -> zeroOfType ()) |> Seq.init len |> ImmutableArray.CreateRange
let o : AllocatedArray =
{
@@ -949,7 +949,31 @@ module AbstractMachine =
|> Tuple.withRight WhatWeDid.Executed
|> ExecutionResult.Stepped
| Pop -> failwith "todo"
| Dup -> 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 = threadState.MethodState.EvaluationStack.Values |> List.head
{ threadState with
ThreadState.MethodState.EvaluationStack =
{
Values = topValue :: threadState.MethodState.EvaluationStack.Values
}
}
|> Some
)
}
|> IlMachineState.advanceProgramCounter currentThread
|> Tuple.withRight WhatWeDid.Executed
|> ExecutionResult.Stepped
| Ret ->
let threadStateAtEndOfMethod = state.ThreadState.[currentThread]
@@ -1237,6 +1261,7 @@ module AbstractMachine =
let private executeUnaryMetadata
(loggerFactory : ILoggerFactory)
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(op : UnaryMetadataTokenIlOp)
(metadataToken : MetadataToken)
(state : IlMachineState)
@@ -1342,7 +1367,33 @@ module AbstractMachine =
|> fun assy -> assy.TypeDefs.[defn]
| x -> failwith $"TODO: {x}"
failwith $"TODO: {elementType.Name}"
let baseType =
elementType.BaseType
|> TypeInfo.resolveBaseType
(fun (x : DumpedAssembly) -> x.Name)
(fun x y -> x.TypeDefs.[y])
baseClassTypes
elementType.Assembly
let zeroOfType =
match baseType with
| ResolvedBaseType.Object ->
// initialise with null references
fun () -> CliType.ObjectRef None
| ResolvedBaseType.Enum -> failwith "todo"
| ResolvedBaseType.ValueType -> failwith "todo"
| ResolvedBaseType.Delegate -> failwith "todo"
let alloc, state = IlMachineState.allocateArray zeroOfType len state
let state =
{ state with
ThreadState = state.ThreadState |> Map.add thread currentState
}
|> IlMachineState.pushToEvalStack (CliType.ObjectRef (Some alloc)) thread
|> IlMachineState.advanceProgramCounter thread
state, WhatWeDid.Executed
| Box -> failwith "todo"
| Ldelema -> failwith "todo"
| Isinst -> failwith "todo"
@@ -1436,7 +1487,7 @@ module AbstractMachine =
| Jmp -> failwith "todo"
let private executeUnaryStringToken
(stringType : WoofWare.PawPrint.TypeInfo)
(baseClassTypes : BaseClassTypes<'a>)
(op : UnaryStringTokenIlOp)
(sh : StringToken)
(state : IlMachineState)
@@ -1456,7 +1507,7 @@ module AbstractMachine =
let state = state |> IlMachineState.setStringData dataAddr stringToAllocate
let stringInstanceFields =
stringType.Fields
baseClassTypes.String.Fields
|> List.choose (fun field ->
if int (field.Attributes &&& FieldAttributes.Static) = 0 then
Some (field.Name, field.Signature)
@@ -1481,7 +1532,8 @@ module AbstractMachine =
"_stringLength", CliType.Numeric (CliNumericType.Int32 stringToAllocate.Length)
]
let addr, state = IlMachineState.allocateManagedObject stringType fields state
let addr, state =
IlMachineState.allocateManagedObject baseClassTypes.String fields state
addr,
{ state with
@@ -1572,7 +1624,7 @@ module AbstractMachine =
let executeOneStep
(loggerFactory : ILoggerFactory)
(stringType : WoofWare.PawPrint.TypeInfo)
(baseClassTypes : BaseClassTypes<DumpedAssembly>)
(state : IlMachineState)
(thread : ThreadId)
: ExecutionResult
@@ -1604,9 +1656,9 @@ module AbstractMachine =
| IlOp.Nullary op -> executeNullary state thread op
| IlOp.UnaryConst unaryConstIlOp -> executeUnaryConst state thread unaryConstIlOp |> ExecutionResult.Stepped
| IlOp.UnaryMetadataToken (unaryMetadataTokenIlOp, bytes) ->
executeUnaryMetadata loggerFactory unaryMetadataTokenIlOp bytes state thread
executeUnaryMetadata loggerFactory baseClassTypes unaryMetadataTokenIlOp bytes state thread
|> ExecutionResult.Stepped
| IlOp.Switch immutableArray -> failwith "todo"
| IlOp.UnaryStringToken (unaryStringTokenIlOp, stringHandle) ->
executeUnaryStringToken stringType unaryStringTokenIlOp stringHandle state thread
executeUnaryStringToken baseClassTypes unaryStringTokenIlOp stringHandle state thread
|> ExecutionResult.Stepped

6
WoofWare.PawPrint/Assembly.fs
View File

@@ -243,6 +243,8 @@ module Assembly =
let peReader = new PEReader (dllBytes)
let metadataReader = peReader.GetMetadataReader ()
let assy = metadataReader.GetAssemblyDefinition () |> AssemblyDefinition.make
let entryPoint =
peReader.PEHeaders.CorHeader.EntryPointTokenOrRelativeVirtualAddress
|> fun x -> if x = 0 then None else Some x
@@ -270,7 +272,7 @@ module Assembly =
let builder = ImmutableDictionary.CreateBuilder ()
for ty in metadataReader.TypeDefinitions do
builder.Add (ty, TypeInfo.read loggerFactory peReader metadataReader ty)
builder.Add (ty, TypeInfo.read loggerFactory peReader assy.Name metadataReader ty)
builder.ToImmutable ()
@@ -330,8 +332,6 @@ module Assembly =
| StringToken.String s -> metadataReader.GetString s
| StringToken.UserString s -> metadataReader.GetUserString s
let assy = metadataReader.GetAssemblyDefinition () |> AssemblyDefinition.make
let rootNamespace, nonRootNamespaces =
metadataReader.GetNamespaceDefinitionRoot ()
|> Namespace.make metadataReader.GetString metadataReader.GetNamespaceDefinition

39
WoofWare.PawPrint/Corelib.fs Normal file
View File

@@ -0,0 +1,39 @@
namespace WoofWare.PawPrint
[<RequireQualifiedAccess>]
module Corelib =
let getBaseTypes (corelib : DumpedAssembly) : BaseClassTypes<DumpedAssembly> =
let stringType =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "String" then Some v else None)
|> Seq.exactlyOne
let arrayType =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "Array" then Some v else None)
|> Seq.exactlyOne
let enumType =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "Enum" then Some v else None)
|> Seq.exactlyOne
let objType =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "Object" then Some v else None)
|> Seq.exactlyOne
let valueType =
corelib.TypeDefs
|> Seq.choose (fun (KeyValue (_, v)) -> if v.Name = "ValueType" then Some v else None)
|> Seq.exactlyOne
{
Corelib = corelib
String = stringType
Array = arrayType
Enum = enumType
ValueType = valueType
Object = objType
}

18
WoofWare.PawPrint/Program.fs
View File

@@ -10,19 +10,19 @@ module Program =
/// Returns the pointer to the resulting array on the heap.
let allocateArgs
(args : string list)
(stringAssy : DumpedAssembly, stringType : TypeInfo, arrayType : TypeInfo)
(corelib : BaseClassTypes<DumpedAssembly>)
(state : IlMachineState)
: ManagedHeapAddress * IlMachineState
=
let argsAllocations, state =
(state, args)
||> Seq.mapFold (fun state arg ->
IlMachineState.allocateManagedObject stringType (failwith "TODO: assert fields and populate") state
IlMachineState.allocateManagedObject corelib.String (failwith "TODO: assert fields and populate") state
// TODO: set the char values in memory
)
let arrayAllocation, state =
IlMachineState.allocateArray stringType args.Length state
IlMachineState.allocateArray (fun () -> CliType.ObjectRef None) args.Length state
let state =
((state, 0), argsAllocations)
@@ -90,18 +90,12 @@ module Program =
state._LoadedAssemblies.[coreLib]
let stringType =
corelib.TypeDefs
|> Seq.pick (fun (KeyValue (_, v)) -> if v.Name = "String" then Some v else None)
let arrayType =
corelib.TypeDefs
|> Seq.pick (fun (KeyValue (_, v)) -> if v.Name = "Array" then Some v else None)
let baseClassTypes = Corelib.getBaseTypes corelib
let arrayAllocation, state =
match mainMethod.Signature.ParameterTypes |> Seq.toList with
| [ TypeDefn.OneDimensionalArrayLowerBoundZero (TypeDefn.PrimitiveType PrimitiveType.String) ] ->
allocateArgs argv (corelib, stringType, arrayType) state
allocateArgs argv baseClassTypes state
| _ -> failwith "Main method must take an array of strings; other signatures not yet implemented"
match mainMethod.Signature.ReturnType with
@@ -118,7 +112,7 @@ module Program =
dumped.Name
let rec go (state : IlMachineState) =
match AbstractMachine.executeOneStep loggerFactory stringType state mainThread with
match AbstractMachine.executeOneStep loggerFactory baseClassTypes state mainThread with
| ExecutionResult.Terminated (state, terminatingThread) -> state, terminatingThread
| ExecutionResult.Stepped (state', whatWeDid) ->

79
WoofWare.PawPrint/TypeInfo.fs
View File

@@ -34,6 +34,12 @@ type BaseTypeInfo =
| TypeSpec of TypeSpecificationHandle
| ForeignAssemblyType of assemblyName : AssemblyName * TypeDefinitionHandle
type ResolvedBaseType =
| Enum
| ValueType
| Object
| Delegate
type MethodImplParsed =
| MethodImplementation of MethodImplementationHandle
| MethodDefinition of MethodDefinitionHandle
@@ -87,6 +93,21 @@ type TypeInfo =
/// The metadata token handle that uniquely identifies this type in the assembly.
/// </summary>
TypeDefHandle : TypeDefinitionHandle
/// <summary>
/// The assembly in which this type is defined.
/// </summary>
Assembly : AssemblyName
}
type BaseClassTypes<'corelib> =
{
Corelib : 'corelib
String : TypeInfo
Array : TypeInfo
Enum : TypeInfo
ValueType : TypeInfo
Object : TypeInfo
}
[<RequireQualifiedAccess>]
@@ -94,6 +115,7 @@ module TypeInfo =
let internal read
(loggerFactory : ILoggerFactory)
(peReader : PEReader)
(thisAssembly : AssemblyName)
(metadataReader : MetadataReader)
(typeHandle : TypeDefinitionHandle)
: TypeInfo
@@ -121,17 +143,6 @@ module TypeInfo =
|> Seq.map (fun h -> FieldInfo.make metadataReader.GetString h (metadataReader.GetFieldDefinition h))
|> Seq.toList
let baseType =
match MetadataToken.ofEntityHandle typeDef.BaseType with
| TypeReference typeReferenceHandle -> Some (BaseTypeInfo.TypeRef typeReferenceHandle)
| TypeDefinition typeDefinitionHandle ->
if typeDefinitionHandle.IsNil then
None
else
Some (BaseTypeInfo.TypeDef typeDefinitionHandle)
| TypeSpecification typeSpecHandle -> Some (BaseTypeInfo.TypeSpec typeSpecHandle)
| t -> failwith $"Unrecognised base-type entity identifier: %O{t}"
let name = metadataReader.GetString typeDef.Name
let ns = metadataReader.GetString typeDef.Namespace
let typeAttrs = typeDef.Attributes
@@ -152,6 +163,17 @@ module TypeInfo =
)
|> Seq.toList
let baseType =
match MetadataToken.ofEntityHandle typeDef.BaseType with
| TypeReference typeReferenceHandle -> Some (BaseTypeInfo.TypeRef typeReferenceHandle)
| TypeDefinition typeDefinitionHandle ->
if typeDefinitionHandle.IsNil then
None
else
Some (BaseTypeInfo.TypeDef typeDefinitionHandle)
| TypeSpecification typeSpecHandle -> Some (BaseTypeInfo.TypeSpec typeSpecHandle)
| t -> failwith $"Unrecognised base-type entity identifier: %O{t}"
{
Namespace = ns
Name = name
@@ -162,4 +184,39 @@ module TypeInfo =
TypeAttributes = typeAttrs
Attributes = attrs
TypeDefHandle = typeHandle
Assembly = thisAssembly
}
let rec resolveBaseType<'corelib>
(getName : 'corelib -> AssemblyName)
(getType : 'corelib -> TypeDefinitionHandle -> TypeInfo)
(baseClassTypes : BaseClassTypes<'corelib>)
(sourceAssembly : AssemblyName)
(value : BaseTypeInfo option)
: ResolvedBaseType
=
match value with
| None -> ResolvedBaseType.Object
| Some value ->
match value with
| BaseTypeInfo.TypeDef typeDefinitionHandle ->
if sourceAssembly = getName baseClassTypes.Corelib then
//if typeDefinitionHandle = baseClassTypes.Enum.TypeDefHandle then
// ResolvedBaseType.Enum
//elif typeDefinitionHandle = baseClassTypes.ValueType.TypeDefHandle then
// ResolvedBaseType.ValueType
//else
let baseType = getType baseClassTypes.Corelib typeDefinitionHandle
resolveBaseType getName getType baseClassTypes sourceAssembly baseType.BaseType
else
failwith "unexpected base type not in corelib"
| BaseTypeInfo.TypeRef typeReferenceHandle -> failwith "todo"
| BaseTypeInfo.TypeSpec typeSpecificationHandle -> failwith "todo"
| BaseTypeInfo.ForeignAssemblyType (assemblyName, typeDefinitionHandle) ->
resolveBaseType
getName
getType
baseClassTypes
assemblyName
(Some (BaseTypeInfo.TypeDef typeDefinitionHandle))

1
WoofWare.PawPrint/WoofWare.PawPrint.fsproj
View File

@@ -20,6 +20,7 @@
<Compile Include="MethodInfo.fs" />
<Compile Include="TypeInfo.fs" />
<Compile Include="Assembly.fs" />
<Compile Include="Corelib.fs" />
<Compile Include="BasicCliType.fs" />
<Compile Include="ManagedHeap.fs" />
<Compile Include="AbstractMachineDomain.fs" />