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

Climb type hierarchy to instantiate base classes (#1)

Browse Source
This commit is contained in:
Patrick Stevens
2025-03-01 21:43:55 +00:00
committed by GitHub
parent 99c846af4e
commit fc821884ca
18 changed files with 1575 additions and 706 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
HelloWorld/HelloWorld.fsproj
View File

@@ -1,8 +1,9 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>net9.0</TargetFramework>
<OutputType>Exe</OutputType>
<TargetFramework>net9.0</TargetFramework>
<SelfContained>true</SelfContained>
</PropertyGroup>
<ItemGroup>

35
WoofWare.PawPrint.App/Program.fs
View File

@@ -3,6 +3,7 @@ namespace WoofWare.PawPrint
open System
open System.Collections.Immutable
open System.IO
open Microsoft.Extensions.Logging
open WoofWare.DotnetRuntimeLocator
module Program =
@@ -10,12 +11,12 @@ module Program =
let allocateArgs (args : string list) (state : IlMachineState) : ManagedHeapAddress * IlMachineState =
let argsAllocations, state =
(state, args)
||> Seq.mapFold (fun state arg -> IlMachineState.Allocate (ReferenceType.String arg) state
||> Seq.mapFold (fun state arg -> IlMachineState.allocate (ReferenceType.String arg) state
// TODO: set the char values in memory
)
let arrayAllocation, state =
IlMachineState.Allocate
IlMachineState.allocate
(ReferenceType.Array (args.Length, Type.ReferenceType ReferenceType.ManagedObject))
state
// TODO: set the length of the array
@@ -24,7 +25,7 @@ module Program =
((state, 0), argsAllocations)
||> Seq.fold (fun (state, i) arg ->
let state =
IlMachineState.SetArrayValue arrayAllocation (CliObject.OfManagedObject arg) i state
IlMachineState.setArrayValue arrayAllocation (CliObject.OfManagedObject arg) i state
state, i + 1
)
@@ -33,16 +34,25 @@ module Program =
arrayAllocation, state
let reallyMain (argv : string[]) : int =
let loggerFactory =
LoggerFactory.Create (fun builder ->
builder.AddConsole (fun options -> options.LogToStandardErrorThreshold <- LogLevel.Debug)
|> ignore<ILoggingBuilder>
)
let logger = loggerFactory.CreateLogger "WoofWare.PawPrint.App"
match argv |> Array.toList with
| dllPath :: args ->
let dotnetRuntimes =
// TODO: work out which runtime it expects to use. For now we just use the first one we find.
DotnetEnvironmentInfo.Get().Frameworks
|> Seq.map (fun fi -> Path.Combine (fi.Path, fi.Version.ToString ()))
|> Seq.toArray
// TODO: work out which runtime it expects to use, parsing the runtimeconfig etc and using DotnetRuntimeLocator. For now we assume we're self-contained.
// DotnetEnvironmentInfo.Get().Frameworks
// |> Seq.map (fun fi -> Path.Combine (fi.Path, fi.Version.ToString ()))
// |> ImmutableArray.CreateRange
ImmutableArray.Create (FileInfo(dllPath).Directory.FullName)
use fileStream = new FileStream (dllPath, FileMode.Open, FileAccess.Read)
let dumped = Assembly.read fileStream
let dumped = Assembly.read loggerFactory fileStream
let entryPoint =
match dumped.MainMethod with
@@ -54,7 +64,7 @@ module Program =
if mainMethod.Signature.GenericParameterCount > 0 then
failwith "Refusing to execute generic main method"
let state = IlMachineState.Initial dumped
let state = IlMachineState.initial dotnetRuntimes dumped
let arrayAllocation, state =
match mainMethod.Signature.ParameterTypes |> Seq.toList with
@@ -68,7 +78,8 @@ module Program =
let state, mainThread =
state
|> IlMachineState.AddThread
|> IlMachineState.addThread
// TODO: we need to load the main method's class first, and that's a faff with the current layout
{ MethodState.Empty mainMethod None with
Arguments = ImmutableArray.Create (CliObject.OfManagedObject arrayAllocation)
}
@@ -76,11 +87,11 @@ module Program =
let mutable state = state
while true do
state <- AbstractMachine.executeOneStep dotnetRuntimes state mainThread
state <- fst (AbstractMachine.executeOneStep loggerFactory state mainThread)
0
| _ ->
Console.Error.WriteLine "Supply exactly one DLL path"
logger.LogCritical "Supply exactly one DLL path"
1
[<EntryPoint>]

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

@@ -14,6 +14,7 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="Microsoft.Extensions.Logging.Console" Version="9.0.2" />
<PackageReference Include="WoofWare.DotnetRuntimeLocator" Version="0.1.11" />
</ItemGroup>

675
WoofWare.PawPrint/AbstractMachine.fs
View File

@@ -4,7 +4,9 @@ open System
open System.Collections.Generic
open System.Collections.Immutable
open System.IO
open System.Reflection
open System.Reflection.Metadata
open Microsoft.Extensions.Logging
open Microsoft.FSharp.Core
type ThreadId = | ThreadId of int
@@ -24,8 +26,10 @@ type EvalStackValue =
type BasicCliObject =
/// Can be assigned the null value 0
/// This is the 'O' type.
| ObjectReference of ManagedHeapAddress option
| PointerType of unit option
/// This is the '&' type.
| PointerType of ManagedHeapAddress option
| Int32 of int32
| Int64 of int64
| NativeInt of int64
@@ -108,32 +112,41 @@ type EvalStack =
Values = v :: stack.Values
}
type MethodState =
type MethodReturnState =
{
JumpTo : MethodState
/// A stack of the types we're initialising.
/// Once we perform the jump, we're back in the context of the top one of these.
WasInitialising : (TypeDefinitionHandle * AssemblyName) list
}
and MethodState =
{
// TODO: local variables are initialised to 0 if the localsinit flag is set for the method
LocalVariables : CliObject ImmutableArray
IlOpIndex : int
EvaluationStack : EvalStack
Arguments : CliObject ImmutableArray
ExecutingMethod : MethodInfo
ExecutingMethod : WoofWare.PawPrint.MethodInfo
/// We don't implement the local memory pool right now
LocalMemoryPool : unit
/// On return, we restore this state. This should be Some almost always; an exception is the entry point.
ReturnState : MethodState option
ReturnState : MethodReturnState option
}
static member AdvanceProgramCounter (state : MethodState) =
static member advanceProgramCounter (state : MethodState) =
{ state with
IlOpIndex = state.IlOpIndex + 1
}
static member LoadArgument (index : int) (state : MethodState) : MethodState =
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]
}
static member Empty (method : MethodInfo) (returnState : MethodState option) =
static member Empty (method : WoofWare.PawPrint.MethodInfo) (returnState : MethodReturnState option) =
{
EvaluationStack = EvalStack.Empty
LocalVariables =
@@ -215,6 +228,22 @@ type ManagedHeap =
Contents = heap.Contents.RemoveRange(a + offset, size).InsertRange (a + offset, v)
}
type WhatWeDid =
| Executed
/// We didn't run what you wanted, because we have to do class initialisation first.
| SuspendedForClassInit
| NotTellingYou
/// We can't proceed until this thread has finished the class initialisation work it's doing.
| BlockedOnClassInit of threadBlockingUs : ThreadId
/// Represents the state of a type's initialization in the CLI
type TypeInitState =
| InProgress of ThreadId // Being initialized by this thread
| Initialized
/// Tracks the initialization state of types across assemblies
type TypeInitTable = ImmutableDictionary<TypeDefinitionHandle * AssemblyName, TypeInitState>
type IlMachineState =
{
NextThreadId : int
@@ -224,13 +253,313 @@ type IlMachineState =
ManagedHeap : ManagedHeap
ThreadState : Map<ThreadId, ThreadState>
InternedStrings : ImmutableDictionary<StringToken, ManagedHeapAddress>
ActiveAssemblyName : string
LoadedAssemblies : Map<string, DumpedAssembly>
ActiveAssemblyName : AssemblyName
/// Keyed by FullName. (Sometimes an assembly has a PublicKey when we read it from the disk, but we
/// only have a reference to it by an AssemblyName without a PublicKey.)
_LoadedAssemblies : ImmutableDictionary<string, DumpedAssembly>
/// Tracks initialization state of types across assemblies
TypeInitTable : TypeInitTable
Statics : ImmutableDictionary<TypeDefinitionHandle * AssemblyName, ManagedHeapAddress>
DotnetRuntimeDirs : string ImmutableArray
}
member this.ActiveAssembly = this.LoadedAssemblies.[this.ActiveAssemblyName]
member this.WithLoadedAssembly (name : AssemblyName) (value : DumpedAssembly) =
{ this with
_LoadedAssemblies = this._LoadedAssemblies.Add (name.FullName, value)
}
static member Initial (entryAssembly : DumpedAssembly) : IlMachineState =
member this.LoadedAssembly (name : AssemblyName) : DumpedAssembly option =
match this._LoadedAssemblies.TryGetValue name.FullName with
| false, _ -> None
| true, v -> Some v
member this.ActiveAssembly =
match this.LoadedAssembly this.ActiveAssemblyName with
| Some v -> v
| None ->
let available = this._LoadedAssemblies.Keys |> String.concat " ; "
failwith
$"Somehow we believe the active assembly is {this.ActiveAssemblyName}, but only had the following available: {available}"
type StateLoadResult =
| NothingToDo of IlMachineState
| FirstLoadThis of IlMachineState
[<RequireQualifiedAccess>]
module IlMachineState =
type private Dummy = class end
let loadAssembly
(loggerFactory : ILoggerFactory)
(referencedInAssembly : DumpedAssembly)
(r : AssemblyReferenceHandle)
(state : IlMachineState)
: IlMachineState * DumpedAssembly * AssemblyName
=
let assemblyRef = referencedInAssembly.AssemblyReferences.[r]
let assemblyName = assemblyRef.Name
match state.LoadedAssembly assemblyName with
| Some v -> state, v, assemblyName
| None ->
let logger = loggerFactory.CreateLogger typeof<Dummy>.DeclaringType
let assy =
state.DotnetRuntimeDirs
|> Seq.choose (fun dir ->
let file = Path.Combine (dir, assemblyName.Name + ".dll")
try
use f = File.OpenRead file
logger.LogInformation ("Loading assembly from file {AssemblyFileLoadPath}", file)
Assembly.read loggerFactory f |> Some
with :? FileNotFoundException ->
None
)
|> Seq.exactlyOne
state.WithLoadedAssembly assemblyName assy, assy, assemblyName
let rec internal resolveTypeFromName
(loggerFactory : ILoggerFactory)
(ns : string option)
(name : string)
(assy : DumpedAssembly)
(state : IlMachineState)
: IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo
=
match ns with
| None -> failwith "what are the semantics here"
| Some ns ->
match assy.TypeDef ns name with
| Some typeDef -> 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: {ns} {name}"
and resolveTypeFromExport
(loggerFactory : ILoggerFactory)
(fromAssembly : DumpedAssembly)
(ty : WoofWare.PawPrint.ExportedType)
(state : IlMachineState)
: IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo
=
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
and resolveTypeFromRef
(loggerFactory : ILoggerFactory)
(referencedInAssembly : DumpedAssembly)
(target : TypeRef)
(state : IlMachineState)
: IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo
=
match target.ResolutionScope with
| AssemblyReference r ->
let state, assy, newAssyName =
loadAssembly loggerFactory referencedInAssembly r 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 ] -> 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}"
and resolveType
(loggerFactory : ILoggerFactory)
(ty : TypeReferenceHandle)
(assy : DumpedAssembly)
(state : IlMachineState)
: IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo
=
let target = assy.TypeRefs.[ty]
resolveTypeFromRef loggerFactory assy target state
let rec loadClass
(loggerFactory : ILoggerFactory)
(typeDefHandle : TypeDefinitionHandle)
(assemblyName : AssemblyName)
(currentThread : ThreadId)
(state : IlMachineState)
: StateLoadResult
=
if typeDefHandle.IsNil then
failwith "Called `loadClass` with a nil typedef"
let logger = loggerFactory.CreateLogger typeof<Dummy>.DeclaringType
match state.TypeInitTable.TryGetValue ((typeDefHandle, assemblyName)) with
| true, TypeInitState.Initialized ->
// Type already initialized; nothing to do
StateLoadResult.NothingToDo state
| true, 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
| true, TypeInitState.InProgress _ ->
// This is usually signalled by WhatWeDid.Blocked
failwith "TODO: this thread has to wait for the other thread to finish initialisation"
| false, _ ->
// We have work to do!
// Get the current assembly - possibly switching if needed
let origAssemblyName = state.ActiveAssemblyName
let state =
if assemblyName <> state.ActiveAssemblyName then
{ state with
ActiveAssemblyName = assemblyName
}
else
state
let sourceAssembly = state.LoadedAssembly assemblyName |> Option.get
let typeDef =
match sourceAssembly.TypeDefs.TryGetValue typeDefHandle with
| false, _ -> failwith $"Failed to find type definition {typeDefHandle} in {assemblyName.Name}"
| true, v -> v
logger.LogDebug ("Resolving type {TypeDefNamespace}.{TypeDefName}", typeDef.Namespace, typeDef.Name)
// First mark as in-progress to detect cycles
let state =
{ state with
TypeInitTable =
state.TypeInitTable.Add ((typeDefHandle, assemblyName), TypeInitState.InProgress currentThread)
}
// 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
| ForeignAssemblyType (baseAssemblyName, baseTypeHandle) ->
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
| TypeDef typeDefinitionHandle ->
logger.LogDebug (
"Resolved base type of {TypeDefNamespace}.{TypeDefName} to this assembly, typedef",
typeDef.Namespace,
typeDef.Name
)
match
loadClass loggerFactory typeDefinitionHandle state.ActiveAssemblyName currentThread state
with
| FirstLoadThis state -> Error state
| NothingToDo state -> Ok state
| TypeRef typeReferenceHandle ->
let state, assy, targetType =
resolveType loggerFactory typeReferenceHandle state.ActiveAssembly state
logger.LogDebug (
"Resolved base type of {TypeDefNamespace}.{TypeDefName} to this assembly, typeref, {BaseTypeNamespace}.{BaseTypeName}",
typeDef.Namespace,
typeDef.Name,
targetType.Namespace,
targetType.Name
)
match loadClass loggerFactory targetType.TypeDefHandle assy.Name currentThread state with
| FirstLoadThis state -> Error state
| NothingToDo state -> Ok state
| TypeSpec typeSpecificationHandle -> failwith "todo"
| None -> Ok state // No base type (or it's System.Object)
match firstDoBaseClass with
| Error state -> FirstLoadThis state
| Ok state ->
// 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 ctorMethod ->
// Call the class constructor!
let currentThreadState = state.ThreadState.[currentThread]
let newMethodState =
MethodState.Empty
ctorMethod
(Some
{
JumpTo = currentThreadState.MethodState
WasInitialising = [ typeDefHandle, assemblyName ]
})
{ state with
ThreadState =
state.ThreadState
|> Map.add
currentThread
{ currentThreadState with
MethodState = newMethodState
}
}
|> FirstLoadThis
| None ->
// No constructor, just continue.
// Mark the type as initialized.
let state =
{ state with
TypeInitTable =
let key = typeDefHandle, assemblyName
assert (state.TypeInitTable.ContainsKey key)
state.TypeInitTable.SetItem (key, TypeInitState.Initialized)
}
// Restore original assembly context if needed
if origAssemblyName <> assemblyName then
{ state with
ActiveAssemblyName = origAssemblyName
}
else
state
|> NothingToDo
let initial (dotnetRuntimeDirs : ImmutableArray<string>) (entryAssembly : DumpedAssembly) : IlMachineState =
let assyName = entryAssembly.ThisAssemblyDefinition.Name
{
@@ -241,27 +570,28 @@ type IlMachineState =
ThreadState = Map.empty
InternedStrings = ImmutableDictionary.Empty
ActiveAssemblyName = assyName
LoadedAssemblies = Map.ofList [ assyName, entryAssembly ]
_LoadedAssemblies = ImmutableDictionary.Empty
Statics = ImmutableDictionary.Empty
TypeInitTable = ImmutableDictionary.Empty
DotnetRuntimeDirs = dotnetRuntimeDirs
}
.WithLoadedAssembly
assyName
entryAssembly
static member AddThread (newThreadState : MethodState) (state : IlMachineState) : IlMachineState * ThreadId =
let addThread (newThreadState : MethodState) (state : IlMachineState) : IlMachineState * ThreadId =
let thread = ThreadId state.NextThreadId
let newState =
{
{ state with
NextThreadId = state.NextThreadId + 1
EvalStacks = state.EvalStacks |> Map.add thread EvalStack.Empty
// CallStack = state.CallStack
ManagedHeap = state.ManagedHeap
ThreadState = state.ThreadState |> Map.add thread (ThreadState.New newThreadState)
InternedStrings = state.InternedStrings
ActiveAssemblyName = state.ActiveAssemblyName
LoadedAssemblies = state.LoadedAssemblies
}
newState, thread
static member Allocate (o : ReferenceType) (state : IlMachineState) : ManagedHeapAddress * IlMachineState =
let allocate (o : ReferenceType) (state : IlMachineState) : ManagedHeapAddress * IlMachineState =
let alloc, heap = ManagedHeap.Allocate o state.ManagedHeap
alloc,
@@ -269,7 +599,7 @@ type IlMachineState =
ManagedHeap = heap
}
static member PushToStack (o : CliObject) (thread : ThreadId) (state : IlMachineState) =
let pushToStack (o : CliObject) (thread : ThreadId) (state : IlMachineState) =
{ state with
EvalStacks =
state.EvalStacks
@@ -282,7 +612,7 @@ type IlMachineState =
)
}
static member SetArrayValue
let setArrayValue
(arrayAllocation : ManagedHeapAddress)
(v : CliObject)
(index : int)
@@ -296,7 +626,7 @@ type IlMachineState =
ManagedHeap = heap
}
static member AdvanceProgramCounter (thread : ThreadId) (state : IlMachineState) : IlMachineState =
let advanceProgramCounter (thread : ThreadId) (state : IlMachineState) : IlMachineState =
{ state with
ThreadState =
state.ThreadState
@@ -307,13 +637,13 @@ type IlMachineState =
| None -> failwith "expected state"
| Some (state : ThreadState) ->
{ state with
MethodState = state.MethodState |> MethodState.AdvanceProgramCounter
MethodState = state.MethodState |> MethodState.advanceProgramCounter
}
|> Some
)
}
static member LoadArgument (thread : ThreadId) (index : int) (state : IlMachineState) : IlMachineState =
let loadArgument (thread : ThreadId) (index : int) (state : IlMachineState) : IlMachineState =
{ state with
ThreadState =
state.ThreadState
@@ -324,38 +654,79 @@ type IlMachineState =
| None -> failwith "expected state"
| Some state ->
{ state with
MethodState = state.MethodState |> MethodState.LoadArgument index
MethodState = state.MethodState |> MethodState.loadArgument index
}
|> Some
)
}
let callMethod
(loggerFactory : ILoggerFactory)
(thread : ThreadId)
(methodToCall : WoofWare.PawPrint.MethodInfo)
(state : IlMachineState)
: IlMachineState * WhatWeDid
=
let threadState = state.ThreadState.[thread]
match state.TypeInitTable.TryGetValue methodToCall.DeclaringType with
| false, _ ->
match
loadClass loggerFactory (fst methodToCall.DeclaringType) (snd methodToCall.DeclaringType) thread state
with
| NothingToDo state -> state, WhatWeDid.SuspendedForClassInit
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| true, TypeInitState.Initialized ->
let newThreadState =
{ threadState with
MethodState =
MethodState.Empty
methodToCall
(Some
{
JumpTo = threadState.MethodState
WasInitialising = []
})
}
{ state with
ThreadState = state.ThreadState |> Map.add thread newThreadState
},
WhatWeDid.Executed
| true, InProgress threadId -> state, WhatWeDid.BlockedOnClassInit threadId
[<RequireQualifiedAccess>]
module AbstractMachine =
type private Dummy = class end
let internal executeNullary
(state : IlMachineState)
(currentThread : ThreadId)
(op : NullaryIlOp)
: IlMachineState
: IlMachineState * WhatWeDid
=
match op with
| Nop -> state |> IlMachineState.AdvanceProgramCounter currentThread
| Nop -> IlMachineState.advanceProgramCounter currentThread state, WhatWeDid.Executed
| LdArg0 ->
state
|> IlMachineState.LoadArgument currentThread 0
|> IlMachineState.AdvanceProgramCounter currentThread
|> IlMachineState.loadArgument currentThread 0
|> IlMachineState.advanceProgramCounter currentThread
|> Tuple.withRight WhatWeDid.Executed
| LdArg1 ->
state
|> IlMachineState.LoadArgument currentThread 1
|> IlMachineState.AdvanceProgramCounter currentThread
|> IlMachineState.loadArgument currentThread 1
|> IlMachineState.advanceProgramCounter currentThread
|> Tuple.withRight WhatWeDid.Executed
| LdArg2 ->
state
|> IlMachineState.LoadArgument currentThread 2
|> IlMachineState.AdvanceProgramCounter currentThread
|> IlMachineState.loadArgument currentThread 2
|> IlMachineState.advanceProgramCounter currentThread
|> Tuple.withRight WhatWeDid.Executed
| LdArg3 ->
state
|> IlMachineState.LoadArgument currentThread 3
|> IlMachineState.AdvanceProgramCounter currentThread
|> IlMachineState.loadArgument currentThread 3
|> IlMachineState.advanceProgramCounter currentThread
|> Tuple.withRight WhatWeDid.Executed
| Ldloc_0 -> failwith "todo"
| Ldloc_1 -> failwith "todo"
| Ldloc_2 -> failwith "todo"
@@ -480,102 +851,91 @@ module AbstractMachine =
| Stelem_r4 -> failwith "todo"
| Stelem_r8 -> failwith "todo"
| Stelem_ref -> failwith "todo"
| Cpblk -> failwith "todo"
| Initblk -> failwith "todo"
| Conv_ovf_u1 -> failwith "todo"
| Conv_ovf_u2 -> failwith "todo"
| Conv_ovf_u4 -> failwith "todo"
| Conv_ovf_u8 -> failwith "todo"
| Conv_ovf_i1 -> failwith "todo"
| Conv_ovf_i2 -> failwith "todo"
| Conv_ovf_i4 -> failwith "todo"
| Conv_ovf_i8 -> failwith "todo"
| Break -> failwith "todo"
| Conv_r_un -> failwith "todo"
| Arglist -> failwith "todo"
| Ckfinite -> failwith "todo"
| Readonly -> failwith "todo"
| Refanytype -> failwith "todo"
let private resolveMember
(loggerFactory : ILoggerFactory)
(m : MemberReferenceHandle)
(state : IlMachineState)
: IlMachineState * AssemblyName * WoofWare.PawPrint.MethodInfo
=
// TODO: do we need to initialise the parent class here?
let mem = state.ActiveAssembly.Members.[m]
let memberSig =
match mem.Signature with
| MemberSignature.Field _ -> failwith "tried to resolveMember on a field; not yet implemented"
| MemberSignature.Method method -> method
let memberName : string = state.ActiveAssembly.Strings mem.Name
let parent =
match mem.Parent with
| MetadataToken.TypeReference typeRef -> typeRef
| parent -> failwith $"Unexpected: {parent}"
let state, assy, targetType =
IlMachineState.resolveType loggerFactory parent state.ActiveAssembly state
let availableMethods =
targetType.Methods
|> List.filter (fun mi -> mi.Name = memberName)
|> List.filter (fun mi -> mi.Signature = memberSig)
let method =
match availableMethods with
| [] ->
failwith
$"Could not find member {memberName} with the right signature on {targetType.Namespace}.{targetType.Name}"
| [ x ] -> x
| _ ->
failwith
$"Multiple overloads matching signature for call to {targetType.Namespace}.{targetType.Name}'s {memberName}!"
state, assy.Name, method
let private executeUnaryMetadata
(dotnetRuntimeDirs : string[])
(loggerFactory : ILoggerFactory)
(op : UnaryMetadataTokenIlOp)
(metadataToken : MetadataToken)
(state : IlMachineState)
(thread : ThreadId)
: IlMachineState
: IlMachineState * WhatWeDid
=
match op with
| Call ->
// TODO: make an abstraction for "call this method" that wraps up all the `loadClass` stuff too
let state, methodToCall =
match metadataToken with
| MetadataToken.MethodSpecification h ->
// TODO: do we need to initialise the parent class here?
let spec = state.ActiveAssembly.MethodSpecs.[h]
match spec.Method with
| MetadataToken.MethodDef token -> state, state.ActiveAssembly.Methods.[token]
| k -> failwith $"Unrecognised kind: %O{k}"
| MetadataToken.MemberReference h ->
let mem = state.ActiveAssembly.Members.[h]
let state, assy, method = resolveMember loggerFactory h state
let memberSig =
match mem.Signature with
| MemberSignature.Field _ -> failwith "Trying to CALL a field?!"
| MemberSignature.Method method -> method
let memberName : string = state.ActiveAssembly.Strings mem.Name
let parent =
match mem.Parent with
| MetadataToken.TypeReference typeRef -> state.ActiveAssembly.TypeRefs.[typeRef]
| parent -> failwith $"Unexpected: {parent}"
match parent.ResolutionScope with
| AssemblyReference r ->
let state, assy, newAssyName =
let assemblyRef = state.ActiveAssembly.AssemblyReferences.[r]
let assemblyName = state.ActiveAssembly.Strings assemblyRef.Name
match state.LoadedAssemblies.TryGetValue assemblyName with
| true, v -> state, v, assemblyName
| false, _ ->
let assy =
dotnetRuntimeDirs
|> Seq.choose (fun dir ->
let file = Path.Combine (dir, assemblyName + ".dll")
try
use f = File.OpenRead file
Console.Error.WriteLine $"Loading {file}"
Assembly.read f |> Some
with :? FileNotFoundException ->
None
)
|> Seq.exactlyOne
{ state with
LoadedAssemblies = state.LoadedAssemblies |> Map.add assemblyName assy
},
assy,
assemblyName
let nsPath =
state.ActiveAssembly.Strings(parent.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 = state.ActiveAssembly.Strings parent.Name then
Some ty
else
None
)
|> Seq.exactlyOne
let availableMethods =
targetType.Methods
|> List.filter (fun mi -> mi.Name = memberName)
|> List.filter (fun mi -> mi.Signature = memberSig)
let method =
match availableMethods with
| [] -> failwith $"Could not find member {memberName} with the right signature in CALL"
| [ x ] -> x
| _ -> failwith $"Multiple overloads matching signature for call to {memberName}!"
{ state with
ActiveAssemblyName = newAssyName
},
method
| k -> failwith $"Unexpected: {k}"
{ state with
ActiveAssemblyName = assy
},
method
| MetadataToken.MethodDef defn -> state, state.ActiveAssembly.Methods.[defn]
| k -> failwith $"Unrecognised kind: %O{k}"
@@ -583,16 +943,32 @@ module AbstractMachine =
let threadState = state.ThreadState.[thread]
{ threadState with
MethodState = MethodState.Empty methodToCall (Some threadState.MethodState)
MethodState =
MethodState.Empty
methodToCall
(Some
{
JumpTo = threadState.MethodState
WasInitialising = []
})
}
// TODO check what we did and report it, when we do the TODOs above about class init
{ state with
ThreadState = state.ThreadState |> Map.add thread threadState
}
},
WhatWeDid.NotTellingYou
| Callvirt -> failwith "todo"
| Castclass -> failwith "todo"
| Newobj -> failwith "todo"
| Newobj ->
let state, assy, ctor =
match metadataToken with
| MethodDef md -> state, state.ActiveAssemblyName, state.ActiveAssembly.Methods.[md]
| MemberReference mr -> resolveMember loggerFactory mr state
| x -> failwith $"Unexpected metadata token for constructor: %O{x}"
failwith $"TODO: %s{ctor.Name}"
| Newarr -> failwith "todo"
| Box -> failwith "todo"
| Ldelema -> failwith "todo"
@@ -606,20 +982,58 @@ module AbstractMachine =
| Stelem -> failwith "todo"
| Ldelem -> failwith "todo"
| Initobj -> failwith "todo"
| Ldsflda -> failwith "todo"
| Ldsflda ->
// TODO: check whether we should throw FieldAccessException
let fieldHandle =
match metadataToken with
| MetadataToken.FieldDefinition f -> f
| t -> failwith $"Unexpectedly asked to load a non-field: {t}"
match state.ActiveAssembly.Fields.TryGetValue fieldHandle with
| false, _ -> failwith "TODO: throw MissingFieldException"
| true, field ->
match
IlMachineState.loadClass loggerFactory field.DeclaringType state.ActiveAssemblyName thread state
with
| FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
| NothingToDo state ->
if TypeDefn.isManaged field.Signature then
match state.Statics.TryGetValue ((field.DeclaringType, state.ActiveAssemblyName)) with
| true, v ->
IlMachineState.pushToStack (CliObject.Basic (BasicCliObject.PointerType (Some v))) thread state
|> IlMachineState.advanceProgramCounter thread
|> Tuple.withRight WhatWeDid.Executed
| false, _ ->
let allocation, state = state |> IlMachineState.allocate (failwith "")
state
|> IlMachineState.pushToStack
(CliObject.Basic (BasicCliObject.PointerType (Some allocation)))
thread
|> Tuple.withRight WhatWeDid.Executed
else
failwith "TODO: push unmanaged pointer"
| Ldftn -> failwith "todo"
| Stobj -> failwith "todo"
| Constrained -> failwith "todo"
| Ldtoken -> failwith "todo"
| Cpobj -> failwith "todo"
| Ldobj -> failwith "todo"
| Sizeof -> failwith "todo"
| Calli -> failwith "todo"
| Unbox -> failwith "todo"
| Ldvirtftn -> failwith "todo"
| Mkrefany -> failwith "todo"
| Refanyval -> failwith "todo"
| Jmp -> failwith "todo"
let private executeUnaryStringToken
(op : UnaryStringTokenIlOp)
(sh : StringToken)
(state : IlMachineState)
(thread : ThreadId)
: IlMachineState
: IlMachineState * WhatWeDid
=
match op with
| UnaryStringTokenIlOp.Ldstr ->
@@ -627,7 +1041,7 @@ module AbstractMachine =
match state.InternedStrings.TryGetValue sh with
| false, _ ->
let toAllocate = state.ActiveAssembly.Strings sh
let addr, state = IlMachineState.Allocate (ReferenceType.String toAllocate) state
let addr, state = IlMachineState.allocate (ReferenceType.String toAllocate) state
addr,
{ state with
@@ -636,7 +1050,7 @@ module AbstractMachine =
| true, v -> v, state
let state =
IlMachineState.PushToStack
IlMachineState.pushToStack
(CliObject.Basic (BasicCliObject.ObjectReference (Some addressToLoad)))
thread
state
@@ -645,21 +1059,30 @@ module AbstractMachine =
let mutable state = state
for i = 0 to 4 do
state <- IlMachineState.AdvanceProgramCounter thread state
state <- IlMachineState.advanceProgramCounter thread state
state
state, WhatWeDid.Executed
let executeOneStep (dotnetRuntimePath : string[]) (state : IlMachineState) (thread : ThreadId) : IlMachineState =
let executeOneStep
(loggerFactory : ILoggerFactory)
(state : IlMachineState)
(thread : ThreadId)
: IlMachineState * WhatWeDid
=
let logger = loggerFactory.CreateLogger typeof<Dummy>.DeclaringType
let instruction = state.ThreadState.[thread].MethodState
Console.Error.WriteLine
$"[DBG] Executing one step! Now executing: {instruction.IlOpIndex} in {instruction.ExecutingMethod.Name}"
logger.LogDebug (
"Executing one step (index {ExecutingIlOpIndex} in method {ExecutingMethodName}",
instruction.IlOpIndex,
instruction.ExecutingMethod.Name
)
match instruction.ExecutingMethod.Locations.[instruction.IlOpIndex] with
| IlOp.Nullary op -> executeNullary state thread op
| UnaryConst unaryConstIlOp -> failwith "todo"
| UnaryMetadataToken (unaryMetadataTokenIlOp, bytes) ->
executeUnaryMetadata dotnetRuntimePath unaryMetadataTokenIlOp bytes state thread
executeUnaryMetadata loggerFactory unaryMetadataTokenIlOp bytes state thread
| Switch immutableArray -> failwith "todo"
| UnaryStringToken (unaryStringTokenIlOp, stringHandle) ->
executeUnaryStringToken unaryStringTokenIlOp stringHandle state thread

239
WoofWare.PawPrint/Assembly.fs
View File

@@ -4,71 +4,36 @@ open System
open System.Collections.Generic
open System.Collections.Immutable
open System.IO
open System.Reflection
open System.Reflection.Metadata
open System.Reflection.Metadata.Ecma335
open System.Reflection.PortableExecutable
open Microsoft.Extensions.Logging
open Microsoft.FSharp.Core
type AssemblyDefinition =
{
Name : string
Name : AssemblyName
}
type Namespace =
{
Name : StringToken
Parent : NamespaceDefinitionHandle
TypeDefinitions : ImmutableArray<TypeDefinitionHandle>
ExportedTypes : ImmutableArray<ExportedTypeHandle>
}
[<RequireQualifiedAccess>]
module Namespace =
/// Returns also the children.
let make
(getString : StringHandle -> string)
(getNamespace : NamespaceDefinitionHandle -> NamespaceDefinition)
(ns : NamespaceDefinition)
: Namespace * ImmutableDictionary<string list, Namespace>
=
let children = ImmutableDictionary.CreateBuilder ()
let rec inner (path : string list) (ns : NamespaceDefinition) : Namespace =
for child in ns.NamespaceDefinitions do
let rendered = getNamespace child
let location = getString rendered.Name :: path
children.Add (List.rev location, inner location rendered)
{
Name = StringToken.String ns.Name
Parent = ns.Parent
TypeDefinitions = ns.TypeDefinitions
ExportedTypes = ns.ExportedTypes
}
let result = inner [] ns
result, children.ToImmutable ()
[<RequireQualifiedAccess>]
module AssemblyDefinition =
let make
(strings : StringToken -> string)
(assy : System.Reflection.Metadata.AssemblyDefinition)
: AssemblyDefinition
=
let make (assy : System.Reflection.Metadata.AssemblyDefinition) : AssemblyDefinition =
{
Name = strings (StringToken.String assy.Name)
Name = assy.GetAssemblyName ()
}
type DumpedAssembly =
{
TypeDefs : IReadOnlyDictionary<TypeDefinitionHandle, TypeInfo>
TypeRefs : IReadOnlyDictionary<TypeReferenceHandle, TypeRef>
Methods : IReadOnlyDictionary<MethodDefinitionHandle, MethodInfo>
Logger : ILogger
TypeDefs : IReadOnlyDictionary<TypeDefinitionHandle, WoofWare.PawPrint.TypeInfo>
TypeRefs : IReadOnlyDictionary<TypeReferenceHandle, WoofWare.PawPrint.TypeRef>
Methods : IReadOnlyDictionary<MethodDefinitionHandle, WoofWare.PawPrint.MethodInfo>
Members : IReadOnlyDictionary<MemberReferenceHandle, WoofWare.PawPrint.MemberReference<MetadataToken>>
Fields : IReadOnlyDictionary<FieldDefinitionHandle, WoofWare.PawPrint.FieldInfo>
MainMethod : MethodDefinitionHandle option
/// Map of four-byte int token to metadata
MethodDefinitions : Map<int, MethodDefinition>
MethodDefinitions : ImmutableDictionary<int, MethodDefinition>
MethodSpecs : ImmutableDictionary<MethodSpecificationHandle, MethodSpec>
Strings : StringToken -> string
AssemblyReferences : ImmutableDictionary<AssemblyReferenceHandle, WoofWare.PawPrint.AssemblyReference>
@@ -77,14 +42,110 @@ type DumpedAssembly =
NonRootNamespaces : ImmutableDictionary<string list, Namespace>
// TODO: work out how to render all the strings up front, then drop this
PeReader : PEReader
Attributes : ImmutableDictionary<CustomAttributeHandle, WoofWare.PawPrint.CustomAttribute>
ExportedTypes : ImmutableDictionary<ExportedTypeHandle, WoofWare.PawPrint.ExportedType>
_ExportedTypesLookup : ImmutableDictionary<string option * string, WoofWare.PawPrint.ExportedType>
_TypeRefsLookup : ImmutableDictionary<string * string, WoofWare.PawPrint.TypeRef>
_TypeDefsLookup : ImmutableDictionary<string * string, WoofWare.PawPrint.TypeInfo>
}
static member internal BuildExportedTypesLookup
(logger : ILogger)
(name : AssemblyName)
(types : WoofWare.PawPrint.ExportedType seq)
: ImmutableDictionary<string option * string, WoofWare.PawPrint.ExportedType>
=
let result = ImmutableDictionary.CreateBuilder ()
let keys = HashSet ()
for ty in types do
let key = ty.Namespace, ty.Name
if keys.Add key then
result.Add (key, ty)
else
logger.LogWarning (
"Duplicate types exported from assembly {ThisAssemblyName}: namespace {DuplicatedTypeNamespace}, type {DuplicatedTypeName}. Ignoring the duplicate.",
name,
ty.Namespace,
ty.Name
)
result.Remove key |> ignore<bool>
result.ToImmutable ()
static member internal BuildTypeRefsLookup
(logger : ILogger)
(name : AssemblyName)
(typeRefs : WoofWare.PawPrint.TypeRef seq)
=
let result = ImmutableDictionary.CreateBuilder ()
let keys = HashSet ()
for ty in typeRefs do
let key = (ty.Namespace, ty.Name)
if keys.Add key then
result.Add (key, ty)
else
// TODO: this is all very dubious, the ResolutionScope is supposed to tell us how to disambiguate these
logger.LogWarning (
"Duplicate type refs from assembly {ThisAssemblyName}: namespace {DuplicatedTypeNamespace}, type {DuplicatedTypeName}. Ignoring the duplicate.",
name,
ty.Namespace,
ty.Name
)
result.ToImmutable ()
static member internal BuildTypeDefsLookup
(logger : ILogger)
(name : AssemblyName)
(typeDefs : WoofWare.PawPrint.TypeInfo seq)
=
let result = ImmutableDictionary.CreateBuilder ()
let keys = HashSet ()
for ty in typeDefs do
let key = (ty.Namespace, ty.Name)
if keys.Add key then
result.Add (key, ty)
else
// TODO: this is all very dubious, the ResolutionScope is supposed to tell us how to disambiguate these
logger.LogWarning (
"Duplicate type defs from assembly {ThisAssemblyName}: namespace {DuplicatedTypeNamespace}, type {DuplicatedTypeName}. Ignoring the duplicate.",
name,
ty.Namespace,
ty.Name
)
result.ToImmutable ()
member this.Name = this.ThisAssemblyDefinition.Name
member this.TypeRef (``namespace`` : string) (name : string) : WoofWare.PawPrint.TypeRef option =
match this._TypeRefsLookup.TryGetValue ((``namespace``, name)) with
| false, _ -> None
| true, v -> Some v
member this.TypeDef (``namespace`` : string) (name : string) : WoofWare.PawPrint.TypeInfo option =
match this._TypeDefsLookup.TryGetValue ((``namespace``, name)) with
| false, _ -> None
| true, v -> Some v
member this.ExportedType (``namespace`` : string option) (name : string) : WoofWare.PawPrint.ExportedType option =
match this._ExportedTypesLookup.TryGetValue ((``namespace``, name)) with
| false, _ -> None
| true, v -> Some v
interface IDisposable with
member this.Dispose () = this.PeReader.Dispose ()
[<RequireQualifiedAccess>]
module Assembly =
let read (dllBytes : Stream) : DumpedAssembly =
let read (loggerFactory : ILoggerFactory) (dllBytes : Stream) : DumpedAssembly =
let peReader = new PEReader (dllBytes)
let metadataReader = peReader.GetMetadataReader ()
@@ -95,20 +156,19 @@ module Assembly =
let entryPointMethod =
entryPoint |> Option.map MetadataTokens.MethodDefinitionHandle
let assemblyRefs =
let builder = ImmutableDictionary.CreateBuilder ()
for ref in metadataReader.AssemblyReferences do
builder.Add (ref, AssemblyReference.make (metadataReader.GetAssemblyReference ref))
builder.ToImmutable ()
let typeRefs =
let builder = ImmutableDictionary.CreateBuilder ()
for ty in metadataReader.TypeReferences do
let typeRef = metadataReader.GetTypeReference ty
let result =
{
Name = StringToken.String typeRef.Name
Namespace = StringToken.String typeRef.Namespace
ResolutionScope = MetadataToken.ofEntityHandle typeRef.ResolutionScope
}
builder.Add (ty, result)
builder.Add (ty, TypeRef.make metadataReader ty)
builder.ToImmutable ()
@@ -116,7 +176,7 @@ module Assembly =
let builder = ImmutableDictionary.CreateBuilder ()
for ty in metadataReader.TypeDefinitions do
builder.Add (ty, TypeInfo.read peReader metadataReader ty)
builder.Add (ty, TypeInfo.read loggerFactory peReader metadataReader ty)
builder.ToImmutable ()
@@ -127,14 +187,15 @@ module Assembly =
|> ImmutableDictionary.CreateRange
let methodDefnMetadata =
metadataReader.MethodDefinitions
|> Seq.map (fun mh ->
let result = ImmutableDictionary.CreateBuilder ()
for mh in metadataReader.MethodDefinitions do
let def = metadataReader.GetMethodDefinition mh
let eh : EntityHandle = MethodDefinitionHandle.op_Implicit mh
let token = MetadataTokens.GetToken eh
token, def
)
|> Map.ofSeq
result.Add (token, def)
result.ToImmutable ()
let methodSpecs =
Seq.init
@@ -153,6 +214,7 @@ module Assembly =
builder.Add (
c,
MemberReference.make<MetadataToken>
metadataReader.GetString
MetadataToken.ofEntityHandle
(metadataReader.GetMemberReference c)
)
@@ -165,22 +227,47 @@ module Assembly =
| StringToken.String s -> metadataReader.GetString s
| StringToken.UserString s -> metadataReader.GetUserString s
let assemblyRefs =
let builder = ImmutableDictionary.CreateBuilder ()
for ref in metadataReader.AssemblyReferences do
builder.Add (ref, AssemblyReference.make (metadataReader.GetAssemblyReference ref))
builder.ToImmutable ()
let assy =
metadataReader.GetAssemblyDefinition () |> AssemblyDefinition.make strings
let assy = metadataReader.GetAssemblyDefinition () |> AssemblyDefinition.make
let rootNamespace, nonRootNamespaces =
metadataReader.GetNamespaceDefinitionRoot ()
|> Namespace.make metadataReader.GetString metadataReader.GetNamespaceDefinition
let fields =
let result = ImmutableDictionary.CreateBuilder ()
for field in metadataReader.FieldDefinitions do
let fieldDefn =
metadataReader.GetFieldDefinition field
|> FieldInfo.make metadataReader.GetString field
result.Add (field, fieldDefn)
result.ToImmutable ()
let exportedTypes =
let result = ImmutableDictionary.CreateBuilder ()
for ty in metadataReader.ExportedTypes do
result.Add (ty, ExportedType.make metadataReader.GetString ty (metadataReader.GetExportedType ty))
result.ToImmutable ()
let attrs =
let result = ImmutableDictionary.CreateBuilder ()
for field in metadataReader.CustomAttributes do
let fieldDefn =
metadataReader.GetCustomAttribute field |> CustomAttribute.make field
result.Add (field, fieldDefn)
result.ToImmutable ()
let logger = loggerFactory.CreateLogger assy.Name.Name
{
Logger = logger
TypeDefs = typeDefs
TypeRefs = typeRefs
MainMethod = entryPointMethod
@@ -189,11 +276,17 @@ module Assembly =
MethodSpecs = methodSpecs
Members = memberReferences
Strings = strings
Fields = fields
AssemblyReferences = assemblyRefs
ThisAssemblyDefinition = assy
RootNamespace = rootNamespace
NonRootNamespaces = nonRootNamespaces
PeReader = peReader
Attributes = attrs
ExportedTypes = exportedTypes
_ExportedTypesLookup = DumpedAssembly.BuildExportedTypesLookup logger assy.Name exportedTypes.Values
_TypeRefsLookup = DumpedAssembly.BuildTypeRefsLookup logger assy.Name typeRefs.Values
_TypeDefsLookup = DumpedAssembly.BuildTypeDefsLookup logger assy.Name typeDefs.Values
}
let print (main : MethodDefinitionHandle) (dumped : DumpedAssembly) : unit =

19
WoofWare.PawPrint/CustomAttribute.fs Normal file
View File

@@ -0,0 +1,19 @@
namespace WoofWare.PawPrint
open System.Reflection.Metadata
type CustomAttribute =
{
Handle : CustomAttributeHandle
Constructor : MetadataToken
}
[<RequireQualifiedAccess>]
module CustomAttribute =
let make (handle : CustomAttributeHandle) (attr : System.Reflection.Metadata.CustomAttribute) : CustomAttribute =
let ctor = attr.Constructor |> MetadataToken.ofEntityHandle
{
Handle = handle
Constructor = ctor
}

50
WoofWare.PawPrint/ExportedType.fs Normal file
View File

@@ -0,0 +1,50 @@
namespace WoofWare.PawPrint
open System.Reflection
open System.Reflection.Metadata
type ExportedTypeData =
| ForwardsTo of AssemblyReferenceHandle
| NonForwarded of ExportedTypeHandle
type ExportedType =
{
Handle : ExportedTypeHandle
Name : string
Namespace : string option
NamespaceDefn : NamespaceDefinitionHandle
TypeAttrs : TypeAttributes
Data : ExportedTypeData
}
[<RequireQualifiedAccess>]
module ExportedType =
let make
(getString : StringHandle -> string)
(handle : ExportedTypeHandle)
(ty : System.Reflection.Metadata.ExportedType)
: ExportedType
=
let name = getString ty.Name
let ns = getString ty.Namespace
let impl = MetadataToken.ofEntityHandle ty.Implementation
let nsDef = ty.NamespaceDefinition
let data =
if ty.IsForwarder then
match impl with
| MetadataToken.AssemblyReference e -> ExportedTypeData.ForwardsTo e
| _ -> failwith $"Expected forwarder type to have an assembly reference: {impl}"
else
match impl with
| MetadataToken.ExportedType impl -> ExportedTypeData.NonForwarded impl
| _ -> failwith $"Expected ExportedType implementation but got {impl}"
{
Handle = handle
Name = name
Namespace = if nsDef.IsNil then None else Some ns
NamespaceDefn = nsDef
TypeAttrs = ty.Attributes
Data = data
}

27
WoofWare.PawPrint/FieldInfo.fs Normal file
View File

@@ -0,0 +1,27 @@
namespace WoofWare.PawPrint
open System.Reflection.Metadata
type FieldInfo =
{
Handle : FieldDefinitionHandle
Name : string
DeclaringType : TypeDefinitionHandle
Signature : TypeDefn
Attributes : System.Reflection.FieldAttributes
}
[<RequireQualifiedAccess>]
module FieldInfo =
let make (getString : StringHandle -> string) (handle : FieldDefinitionHandle) (def : FieldDefinition) : FieldInfo =
let name = getString def.Name
let fieldSig = def.DecodeSignature (TypeDefn.typeProvider, ())
let declaringType = def.GetDeclaringType ()
{
Name = name
Signature = fieldSig
DeclaringType = declaringType
Handle = handle
Attributes = def.Attributes
}

100
WoofWare.PawPrint/IlOp.fs
View File

@@ -18,70 +18,6 @@ module StringToken =
| HandleKind.String -> StringToken.String (MetadataTokens.StringHandle value)
| v -> failwith $"Unrecognised string handle kind: {v}"
type MetadataToken =
| MethodDef of MethodDefinitionHandle
| MethodSpecification of MethodSpecificationHandle
| MemberReference of MemberReferenceHandle
| TypeReference of TypeReferenceHandle
| ModuleDefinition of ModuleDefinitionHandle
| AssemblyReference of AssemblyReferenceHandle
| TypeSpecification of TypeSpecificationHandle
| TypeDefinition of TypeDefinitionHandle
| FieldDefinition of FieldDefinitionHandle
| Parameter of ParameterHandle
| InterfaceImplementation of InterfaceImplementationHandle
[<RequireQualifiedAccess>]
module MetadataToken =
let ofInt (value : int32) : MetadataToken =
let asRowNum = value &&& 0x00FFFFFF
match LanguagePrimitives.EnumOfValue<byte, HandleKind> (byte (value &&& 0xFF000000 >>> 24)) with
| HandleKind.ModuleDefinition -> MetadataToken.ModuleDefinition (failwith "TODO")
| HandleKind.TypeReference -> MetadataToken.TypeReference (MetadataTokens.TypeReferenceHandle asRowNum)
| HandleKind.TypeDefinition -> MetadataToken.TypeDefinition (MetadataTokens.TypeDefinitionHandle asRowNum)
| HandleKind.FieldDefinition -> MetadataToken.FieldDefinition (MetadataTokens.FieldDefinitionHandle asRowNum)
| HandleKind.MethodDefinition -> MetadataToken.MethodDef (MetadataTokens.MethodDefinitionHandle asRowNum)
| HandleKind.Parameter -> MetadataToken.Parameter (MetadataTokens.ParameterHandle asRowNum)
| HandleKind.InterfaceImplementation ->
MetadataToken.InterfaceImplementation (MetadataTokens.InterfaceImplementationHandle asRowNum)
| HandleKind.MemberReference -> MetadataToken.MemberReference (MetadataTokens.MemberReferenceHandle asRowNum)
| HandleKind.Constant -> failwith "todo"
| HandleKind.CustomAttribute -> failwith "todo"
| HandleKind.DeclarativeSecurityAttribute -> failwith "todo"
| HandleKind.StandaloneSignature -> failwith "todo"
| HandleKind.EventDefinition -> failwith "todo"
| HandleKind.PropertyDefinition -> failwith "todo"
| HandleKind.MethodImplementation -> failwith "todo"
| HandleKind.ModuleReference -> failwith "todo"
| HandleKind.TypeSpecification ->
MetadataToken.TypeSpecification (MetadataTokens.TypeSpecificationHandle asRowNum)
| HandleKind.AssemblyDefinition -> failwith "todo"
| HandleKind.AssemblyReference ->
MetadataToken.AssemblyReference (MetadataTokens.AssemblyReferenceHandle asRowNum)
| HandleKind.AssemblyFile -> failwith "todo"
| HandleKind.ExportedType -> failwith "todo"
| HandleKind.ManifestResource -> failwith "todo"
| HandleKind.GenericParameter -> failwith "todo"
| HandleKind.MethodSpecification ->
MetadataToken.MethodSpecification (MetadataTokens.MethodSpecificationHandle asRowNum)
| HandleKind.GenericParameterConstraint -> failwith "todo"
| HandleKind.Document -> failwith "todo"
| HandleKind.MethodDebugInformation -> failwith "todo"
| HandleKind.LocalScope -> failwith "todo"
| HandleKind.LocalVariable -> failwith "todo"
| HandleKind.LocalConstant -> failwith "todo"
| HandleKind.ImportScope -> failwith "todo"
| HandleKind.CustomDebugInformation -> failwith "todo"
| HandleKind.UserString -> failwith "todo"
| HandleKind.Blob -> failwith "todo"
| HandleKind.Guid -> failwith "todo"
| HandleKind.String -> failwith "todo"
| HandleKind.NamespaceDefinition -> failwith "todo"
| h -> failwith $"Unrecognised kind: {h}"
let ofEntityHandle (eh : EntityHandle) : MetadataToken = ofInt (eh.GetHashCode ())
type MemberSignature =
| Field of TypeDefn
| Method of TypeMethodSignature<TypeDefn>
@@ -89,6 +25,7 @@ type MemberSignature =
type MemberReference<'parent> =
{
Name : StringToken
PrettyName : string
Parent : 'parent
Signature : MemberSignature
}
@@ -110,6 +47,7 @@ type MemberRefSigSwitch =
[<RequireQualifiedAccess>]
module MemberReference =
let make<'parent>
(getString : StringHandle -> string)
(makeParent : EntityHandle -> 'parent)
(mr : System.Reflection.Metadata.MemberReference)
: MemberReference<'parent>
@@ -129,6 +67,7 @@ module MemberReference =
{
Name = name
PrettyName = getString mr.Name
// Horrible abuse to get this as an int
Parent = makeParent mr.Parent
Signature = signature
@@ -138,7 +77,7 @@ type AssemblyReference =
{
Culture : StringToken
Flags : AssemblyFlags
Name : StringToken
Name : AssemblyName
Version : Version
}
@@ -148,7 +87,7 @@ module AssemblyReference =
{
Culture = StringToken.String ref.Culture
Flags = ref.Flags
Name = StringToken.String ref.Name
Name = ref.GetAssemblyName ()
Version = ref.Version
}
@@ -221,6 +160,14 @@ type NullaryIlOp =
| Conv_U2
| Conv_U4
| Conv_U8
| Conv_ovf_u1
| Conv_ovf_u2
| Conv_ovf_u4
| Conv_ovf_u8
| Conv_ovf_i1
| Conv_ovf_i2
| Conv_ovf_i4
| Conv_ovf_i8
| LdLen
| Endfilter
| Endfinally
@@ -283,12 +230,22 @@ type NullaryIlOp =
| Stelem_r4
| Stelem_r8
| Stelem_ref
| Cpblk
| Initblk
| Break
| Conv_r_un
| Arglist
| Ckfinite
| Readonly
| Refanytype
type UnaryConstIlOp =
| Stloc of uint16
| Stloc_s of int8
| Ldc_I8 of int64
| Ldc_I4 of int32
| Ldc_R4 of single
| Ldc_R8 of float
| Ldc_I4_s of int8
| Br of int32
| Br_s of int8
@@ -325,9 +282,14 @@ type UnaryConstIlOp =
| Leave_s of int8
| Starg_s of uint8
| Starg of uint16
| Unaligned of uint8
| Ldloc of uint16
| Ldloca of uint16
| Ldarg of uint16
type UnaryMetadataTokenIlOp =
| Call
| Calli
| Callvirt
| Castclass
| Newobj
@@ -351,6 +313,12 @@ type UnaryMetadataTokenIlOp =
| Ldtoken
| Cpobj
| Ldobj
| Sizeof
| Unbox
| Ldvirtftn
| Mkrefany
| Refanyval
| Jmp
type UnaryStringTokenIlOp = | Ldstr

435
WoofWare.PawPrint/MethodInfo.fs Normal file
View File

@@ -0,0 +1,435 @@
namespace WoofWare.PawPrint
#nowarn "9"
open System.Collections.Immutable
open System.Reflection
open System.Reflection.Metadata
open System.Reflection.PortableExecutable
open Microsoft.Extensions.Logging
type Parameter =
{
Name : string
DefaultValue : Constant
SequenceNumber : int
}
[<RequireQualifiedAccess>]
module Parameter =
let readAll (metadata : MetadataReader) (param : ParameterHandleCollection) : Parameter ImmutableArray =
param
|> Seq.map (fun param ->
let param = metadata.GetParameter param
{
Name = metadata.GetString param.Name
DefaultValue = metadata.GetConstant (param.GetDefaultValue ())
SequenceNumber = param.SequenceNumber
}
)
|> ImmutableArray.CreateRange
type GenericParameter =
{
Name : string
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 MethodInfo =
{
DeclaringType : TypeDefinitionHandle * AssemblyName
Handle : MethodDefinitionHandle
Name : string
/// also stores the offset of this instruction
Instructions : (IlOp * int) list
/// inverted Instructions: a mapping of program counter to op
Locations : Map<int, IlOp>
Parameters : Parameter ImmutableArray
Generics : GenericParameter ImmutableArray
Signature : TypeMethodSignature<TypeDefn>
IsPinvokeImpl : bool
LocalsInit : bool
IsStatic : bool
}
[<RequireQualifiedAccess>]
module MethodInfo =
type private Dummy = class end
type private MethodBody =
{
Instructions : (IlOp * int) list
LocalInit : bool
MaxStackSize : int
ExceptionRegions : ImmutableArray<ExceptionRegion>
}
let private readMetadataToken (reader : byref<BlobReader>) : MetadataToken =
reader.ReadUInt32 () |> int |> MetadataToken.ofInt
let private readStringToken (reader : byref<BlobReader>) : StringToken =
let value = reader.ReadUInt32 () |> int
StringToken.ofInt value
// TODO: each opcode probably ought to store how many bytes it takes, so we can advance the program counter?
let private readOpCode (reader : byref<BlobReader>) : ILOpCode =
let op = reader.ReadByte ()
if op = 0xFEuy then
let op2 = reader.ReadByte ()
LanguagePrimitives.EnumOfValue (0xFE00us ||| (uint16 op2))
else
LanguagePrimitives.EnumOfValue (uint16 op)
let private readMethodBody (peReader : PEReader) (methodDef : MethodDefinition) : MethodBody option =
if methodDef.RelativeVirtualAddress = 0 then
None
else
let methodBody = peReader.GetMethodBody methodDef.RelativeVirtualAddress
let ilBytes = methodBody.GetILBytes ()
use bytes = fixed ilBytes
let mutable reader : BlobReader = BlobReader (bytes, ilBytes.Length)
let rec readInstructions acc =
if reader.Offset >= ilBytes.Length then
List.rev acc
else
let offset = reader.Offset
let opCode = readOpCode (&reader)
let opCode =
match opCode with
| ILOpCode.Nop -> IlOp.Nullary NullaryIlOp.Nop
| ILOpCode.Break -> IlOp.Nullary NullaryIlOp.Break
| ILOpCode.Ldarg_0 -> IlOp.Nullary NullaryIlOp.LdArg0
| ILOpCode.Ldarg_1 -> IlOp.Nullary NullaryIlOp.LdArg1
| ILOpCode.Ldarg_2 -> IlOp.Nullary NullaryIlOp.LdArg2
| ILOpCode.Ldarg_3 -> IlOp.Nullary NullaryIlOp.LdArg3
| ILOpCode.Ldloc_0 -> IlOp.Nullary NullaryIlOp.Ldloc_0
| ILOpCode.Ldloc_1 -> IlOp.Nullary NullaryIlOp.Ldloc_1
| ILOpCode.Ldloc_2 -> IlOp.Nullary NullaryIlOp.Ldloc_2
| ILOpCode.Ldloc_3 -> IlOp.Nullary NullaryIlOp.Ldloc_3
| ILOpCode.Stloc_0 -> IlOp.Nullary NullaryIlOp.Stloc_0
| ILOpCode.Stloc_1 -> IlOp.Nullary NullaryIlOp.Stloc_1
| ILOpCode.Stloc_2 -> IlOp.Nullary NullaryIlOp.Stloc_2
| ILOpCode.Stloc_3 -> IlOp.Nullary NullaryIlOp.Stloc_3
| ILOpCode.Ldarg_s -> IlOp.UnaryConst (UnaryConstIlOp.Ldarg_s (reader.ReadByte ()))
| ILOpCode.Ldarga_s -> IlOp.UnaryConst (UnaryConstIlOp.Ldarga_s (reader.ReadByte ()))
| ILOpCode.Starg_s -> IlOp.UnaryConst (UnaryConstIlOp.Starg_s (reader.ReadByte ()))
| ILOpCode.Ldloc_s -> IlOp.UnaryConst (UnaryConstIlOp.Ldloc_s (reader.ReadByte ()))
| ILOpCode.Ldloca_s -> IlOp.UnaryConst (UnaryConstIlOp.Ldloca_s (reader.ReadByte ()))
| ILOpCode.Stloc_s -> IlOp.UnaryConst (UnaryConstIlOp.Stloc_s (reader.ReadSByte ()))
| ILOpCode.Ldnull -> IlOp.Nullary NullaryIlOp.LdNull
| ILOpCode.Ldc_i4_m1 -> IlOp.Nullary NullaryIlOp.LdcI4_m1
| ILOpCode.Ldc_i4_0 -> IlOp.Nullary NullaryIlOp.LdcI4_0
| ILOpCode.Ldc_i4_1 -> IlOp.Nullary NullaryIlOp.LdcI4_1
| ILOpCode.Ldc_i4_2 -> IlOp.Nullary NullaryIlOp.LdcI4_2
| ILOpCode.Ldc_i4_3 -> IlOp.Nullary NullaryIlOp.LdcI4_3
| ILOpCode.Ldc_i4_4 -> IlOp.Nullary NullaryIlOp.LdcI4_4
| ILOpCode.Ldc_i4_5 -> IlOp.Nullary NullaryIlOp.LdcI4_5
| ILOpCode.Ldc_i4_6 -> IlOp.Nullary NullaryIlOp.LdcI4_6
| ILOpCode.Ldc_i4_7 -> IlOp.Nullary NullaryIlOp.LdcI4_7
| ILOpCode.Ldc_i4_8 -> IlOp.Nullary NullaryIlOp.LdcI4_8
| ILOpCode.Ldc_i4_s -> IlOp.UnaryConst (UnaryConstIlOp.Ldc_I4_s (reader.ReadSByte ()))
| ILOpCode.Ldc_i4 -> IlOp.UnaryConst (UnaryConstIlOp.Ldc_I4 (reader.ReadInt32 ()))
| ILOpCode.Ldc_i8 -> IlOp.UnaryConst (UnaryConstIlOp.Ldc_I8 (reader.ReadInt64 ()))
| ILOpCode.Ldc_r4 -> IlOp.UnaryConst (UnaryConstIlOp.Ldc_R4 (reader.ReadSingle ()))
| ILOpCode.Ldc_r8 -> IlOp.UnaryConst (UnaryConstIlOp.Ldc_R8 (reader.ReadDouble ()))
| ILOpCode.Dup -> IlOp.Nullary NullaryIlOp.Dup
| ILOpCode.Pop -> IlOp.Nullary NullaryIlOp.Pop
| ILOpCode.Jmp ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Jmp, readMetadataToken &reader)
| ILOpCode.Call ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Call, readMetadataToken &reader)
| ILOpCode.Calli ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Calli, readMetadataToken &reader)
| ILOpCode.Ret -> IlOp.Nullary NullaryIlOp.Ret
| ILOpCode.Br_s -> IlOp.UnaryConst (UnaryConstIlOp.Br_s (reader.ReadSByte ()))
| ILOpCode.Brfalse_s -> IlOp.UnaryConst (UnaryConstIlOp.Brfalse_s (reader.ReadSByte ()))
| ILOpCode.Brtrue_s -> IlOp.UnaryConst (UnaryConstIlOp.Brtrue_s (reader.ReadSByte ()))
| ILOpCode.Beq_s -> IlOp.UnaryConst (UnaryConstIlOp.Beq_s (reader.ReadSByte ()))
| ILOpCode.Bge_s -> IlOp.UnaryConst (UnaryConstIlOp.Bge_s (reader.ReadSByte ()))
| ILOpCode.Bgt_s -> IlOp.UnaryConst (UnaryConstIlOp.Bgt_s (reader.ReadSByte ()))
| ILOpCode.Ble_s -> IlOp.UnaryConst (UnaryConstIlOp.Ble_s (reader.ReadSByte ()))
| ILOpCode.Blt_s -> IlOp.UnaryConst (UnaryConstIlOp.Blt_s (reader.ReadSByte ()))
| ILOpCode.Bne_un_s -> IlOp.UnaryConst (UnaryConstIlOp.Bne_un_s (reader.ReadSByte ()))
| ILOpCode.Bge_un_s -> IlOp.UnaryConst (UnaryConstIlOp.Bge_un_s (reader.ReadSByte ()))
| ILOpCode.Bgt_un_s -> IlOp.UnaryConst (UnaryConstIlOp.Bgt_un_s (reader.ReadSByte ()))
| ILOpCode.Ble_un_s -> IlOp.UnaryConst (UnaryConstIlOp.Ble_un_s (reader.ReadSByte ()))
| ILOpCode.Blt_un_s -> IlOp.UnaryConst (UnaryConstIlOp.Blt_un_s (reader.ReadSByte ()))
| ILOpCode.Br -> IlOp.UnaryConst (UnaryConstIlOp.Br (reader.ReadInt32 ()))
| ILOpCode.Brfalse -> IlOp.UnaryConst (UnaryConstIlOp.Brfalse (reader.ReadInt32 ()))
| ILOpCode.Brtrue -> IlOp.UnaryConst (UnaryConstIlOp.Brtrue (reader.ReadInt32 ()))
| ILOpCode.Beq -> IlOp.UnaryConst (UnaryConstIlOp.Beq (reader.ReadInt32 ()))
| ILOpCode.Bge -> IlOp.UnaryConst (UnaryConstIlOp.Bge (reader.ReadInt32 ()))
| ILOpCode.Bgt -> IlOp.UnaryConst (UnaryConstIlOp.Bgt (reader.ReadInt32 ()))
| ILOpCode.Ble -> IlOp.UnaryConst (UnaryConstIlOp.Ble (reader.ReadInt32 ()))
| ILOpCode.Blt -> IlOp.UnaryConst (UnaryConstIlOp.Blt (reader.ReadInt32 ()))
| ILOpCode.Bne_un -> IlOp.UnaryConst (UnaryConstIlOp.Bne_un (reader.ReadInt32 ()))
| ILOpCode.Bge_un -> IlOp.UnaryConst (UnaryConstIlOp.Bge_un (reader.ReadInt32 ()))
| ILOpCode.Bgt_un -> IlOp.UnaryConst (UnaryConstIlOp.Bgt_un (reader.ReadInt32 ()))
| ILOpCode.Ble_un -> IlOp.UnaryConst (UnaryConstIlOp.Ble_un (reader.ReadInt32 ()))
| ILOpCode.Blt_un -> IlOp.UnaryConst (UnaryConstIlOp.Blt_un (reader.ReadInt32 ()))
| ILOpCode.Switch ->
let count = reader.ReadUInt32 ()
if count > uint32 System.Int32.MaxValue then
failwith "Debugger error: can't create a jump table with more than int32.Max entries"
let count = int count
let result = ImmutableArray.CreateBuilder count
for i = 0 to count - 1 do
result.Add (reader.ReadInt32 ())
IlOp.Switch (result.ToImmutable ())
| ILOpCode.Ldind_i -> IlOp.Nullary NullaryIlOp.Ldind_i
| ILOpCode.Ldind_i1 -> IlOp.Nullary NullaryIlOp.Ldind_i1
| ILOpCode.Ldind_u1 -> IlOp.Nullary NullaryIlOp.Ldind_u1
| ILOpCode.Ldind_i2 -> IlOp.Nullary NullaryIlOp.Ldind_i2
| ILOpCode.Ldind_u2 -> IlOp.Nullary NullaryIlOp.Ldind_u2
| ILOpCode.Ldind_i4 -> IlOp.Nullary NullaryIlOp.Ldind_i4
| ILOpCode.Ldind_u4 -> IlOp.Nullary NullaryIlOp.Ldind_u4
| ILOpCode.Ldind_i8 -> IlOp.Nullary NullaryIlOp.Ldind_i8
| ILOpCode.Ldind_r4 -> IlOp.Nullary NullaryIlOp.Ldind_r4
| ILOpCode.Ldind_r8 -> IlOp.Nullary NullaryIlOp.Ldind_r8
| ILOpCode.Ldind_ref -> IlOp.Nullary NullaryIlOp.Ldind_ref
| ILOpCode.Stind_ref -> IlOp.Nullary NullaryIlOp.Stind_ref
| ILOpCode.Stind_i1 -> IlOp.Nullary NullaryIlOp.Stind_I1
| ILOpCode.Stind_i2 -> IlOp.Nullary NullaryIlOp.Stind_I2
| ILOpCode.Stind_i4 -> IlOp.Nullary NullaryIlOp.Stind_I4
| ILOpCode.Stind_i8 -> IlOp.Nullary NullaryIlOp.Stind_I8
| ILOpCode.Stind_r4 -> IlOp.Nullary NullaryIlOp.Stind_R4
| ILOpCode.Stind_r8 -> IlOp.Nullary NullaryIlOp.Stind_R8
| ILOpCode.Add -> IlOp.Nullary NullaryIlOp.Add
| ILOpCode.Sub -> IlOp.Nullary NullaryIlOp.Sub
| ILOpCode.Mul -> IlOp.Nullary NullaryIlOp.Mul
| ILOpCode.Div -> IlOp.Nullary NullaryIlOp.Div
| ILOpCode.Div_un -> IlOp.Nullary NullaryIlOp.Div_un
| ILOpCode.Rem -> IlOp.Nullary NullaryIlOp.Rem
| ILOpCode.Rem_un -> IlOp.Nullary NullaryIlOp.Rem_un
| ILOpCode.And -> IlOp.Nullary NullaryIlOp.And
| ILOpCode.Or -> IlOp.Nullary NullaryIlOp.Or
| ILOpCode.Xor -> IlOp.Nullary NullaryIlOp.Xor
| ILOpCode.Shl -> IlOp.Nullary NullaryIlOp.Shl
| ILOpCode.Shr -> IlOp.Nullary NullaryIlOp.Shr
| ILOpCode.Shr_un -> IlOp.Nullary NullaryIlOp.Shr_un
| ILOpCode.Neg -> IlOp.Nullary NullaryIlOp.Neg
| ILOpCode.Not -> IlOp.Nullary NullaryIlOp.Not
| ILOpCode.Conv_i1 -> IlOp.Nullary NullaryIlOp.Conv_I1
| ILOpCode.Conv_i2 -> IlOp.Nullary NullaryIlOp.Conv_I2
| ILOpCode.Conv_i4 -> IlOp.Nullary NullaryIlOp.Conv_I4
| ILOpCode.Conv_i8 -> IlOp.Nullary NullaryIlOp.Conv_I8
| ILOpCode.Conv_r4 -> IlOp.Nullary NullaryIlOp.Conv_R4
| ILOpCode.Conv_r8 -> IlOp.Nullary NullaryIlOp.Conv_R8
| ILOpCode.Conv_u4 -> IlOp.Nullary NullaryIlOp.Conv_U4
| ILOpCode.Conv_u8 -> IlOp.Nullary NullaryIlOp.Conv_U8
| ILOpCode.Callvirt ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Callvirt, readMetadataToken &reader)
| ILOpCode.Cpobj ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Cpobj, readMetadataToken &reader)
| ILOpCode.Ldobj ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Ldobj, readMetadataToken &reader)
| ILOpCode.Ldstr -> IlOp.UnaryStringToken (UnaryStringTokenIlOp.Ldstr, readStringToken &reader)
| ILOpCode.Newobj ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Newobj, readMetadataToken &reader)
| ILOpCode.Castclass ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Castclass, readMetadataToken &reader)
| ILOpCode.Isinst ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Isinst, readMetadataToken &reader)
| ILOpCode.Conv_r_un -> IlOp.Nullary NullaryIlOp.Conv_r_un
| ILOpCode.Unbox ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Unbox, readMetadataToken &reader)
| ILOpCode.Throw -> IlOp.Nullary NullaryIlOp.Throw
| ILOpCode.Ldfld ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Ldfld, readMetadataToken &reader)
| ILOpCode.Ldflda ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Ldflda, readMetadataToken &reader)
| ILOpCode.Stfld ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Stfld, readMetadataToken &reader)
| ILOpCode.Ldsfld ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Ldsfld, readMetadataToken &reader)
| ILOpCode.Ldsflda ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Ldsflda, readMetadataToken &reader)
| ILOpCode.Stsfld ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Stsfld, readMetadataToken &reader)
| ILOpCode.Stobj ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Stobj, readMetadataToken &reader)
| ILOpCode.Conv_ovf_i_un -> IlOp.Nullary NullaryIlOp.Conv_ovf_i_un
| ILOpCode.Conv_ovf_i1_un -> IlOp.Nullary NullaryIlOp.Conv_ovf_i1_un
| ILOpCode.Conv_ovf_i2_un -> IlOp.Nullary NullaryIlOp.Conv_ovf_i2_un
| ILOpCode.Conv_ovf_i4_un -> IlOp.Nullary NullaryIlOp.Conv_ovf_i4_un
| ILOpCode.Conv_ovf_i8_un -> IlOp.Nullary NullaryIlOp.Conv_ovf_i8_un
| ILOpCode.Conv_ovf_u_un -> IlOp.Nullary NullaryIlOp.Conv_ovf_u_un
| ILOpCode.Conv_ovf_u1_un -> IlOp.Nullary NullaryIlOp.Conv_ovf_u1_un
| ILOpCode.Conv_ovf_u2_un -> IlOp.Nullary NullaryIlOp.Conv_ovf_u2_un
| ILOpCode.Conv_ovf_u4_un -> IlOp.Nullary NullaryIlOp.Conv_ovf_u4_un
| ILOpCode.Conv_ovf_u8_un -> IlOp.Nullary NullaryIlOp.Conv_ovf_u8_un
| ILOpCode.Box ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Box, readMetadataToken &reader)
| ILOpCode.Newarr ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Newarr, readMetadataToken &reader)
| ILOpCode.Ldlen -> IlOp.Nullary NullaryIlOp.LdLen
| ILOpCode.Ldelema ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Ldelema, readMetadataToken &reader)
| ILOpCode.Ldelem_i1 -> IlOp.Nullary NullaryIlOp.Ldelem_i1
| ILOpCode.Ldelem_u1 -> IlOp.Nullary NullaryIlOp.Ldelem_u1
| ILOpCode.Ldelem_i2 -> IlOp.Nullary NullaryIlOp.Ldelem_i2
| ILOpCode.Ldelem_u2 -> IlOp.Nullary NullaryIlOp.Ldelem_u2
| ILOpCode.Ldelem_i4 -> IlOp.Nullary NullaryIlOp.Ldelem_i4
| ILOpCode.Ldelem_u4 -> IlOp.Nullary NullaryIlOp.Ldelem_u4
| ILOpCode.Ldelem_i8 -> IlOp.Nullary NullaryIlOp.Ldelem_i8
| ILOpCode.Ldelem_i -> IlOp.Nullary NullaryIlOp.Ldelem_i
| ILOpCode.Ldelem_r4 -> IlOp.Nullary NullaryIlOp.Ldelem_r4
| ILOpCode.Ldelem_r8 -> IlOp.Nullary NullaryIlOp.Ldelem_r8
| ILOpCode.Ldelem_ref -> IlOp.Nullary NullaryIlOp.Ldelem_ref
| ILOpCode.Stelem_i -> IlOp.Nullary NullaryIlOp.Stelem_i
| ILOpCode.Stelem_i1 -> IlOp.Nullary NullaryIlOp.Stelem_i1
| ILOpCode.Stelem_i2 -> IlOp.Nullary NullaryIlOp.Stelem_i2
| ILOpCode.Stelem_i4 -> IlOp.Nullary NullaryIlOp.Stelem_i4
| ILOpCode.Stelem_i8 -> IlOp.Nullary NullaryIlOp.Stelem_i8
| ILOpCode.Stelem_r4 -> IlOp.Nullary NullaryIlOp.Stelem_r4
| ILOpCode.Stelem_r8 -> IlOp.Nullary NullaryIlOp.Stelem_r8
| ILOpCode.Stelem_ref -> IlOp.Nullary NullaryIlOp.Stelem_ref
| ILOpCode.Ldelem ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Ldelem, readMetadataToken &reader)
| ILOpCode.Stelem ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Stelem, readMetadataToken &reader)
| ILOpCode.Unbox_any ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Unbox_Any, readMetadataToken &reader)
| ILOpCode.Conv_ovf_i1 -> IlOp.Nullary NullaryIlOp.Conv_ovf_i1
| ILOpCode.Conv_ovf_u1 -> IlOp.Nullary NullaryIlOp.Conv_ovf_u1
| ILOpCode.Conv_ovf_i2 -> IlOp.Nullary NullaryIlOp.Conv_ovf_i2
| ILOpCode.Conv_ovf_u2 -> IlOp.Nullary NullaryIlOp.Conv_ovf_u2
| ILOpCode.Conv_ovf_i4 -> IlOp.Nullary NullaryIlOp.Conv_ovf_i4
| ILOpCode.Conv_ovf_u4 -> IlOp.Nullary NullaryIlOp.Conv_ovf_u4
| ILOpCode.Conv_ovf_i8 -> IlOp.Nullary NullaryIlOp.Conv_ovf_i8
| ILOpCode.Conv_ovf_u8 -> IlOp.Nullary NullaryIlOp.Conv_ovf_u8
| ILOpCode.Refanyval ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Refanyval, readMetadataToken &reader)
| ILOpCode.Ckfinite -> IlOp.Nullary NullaryIlOp.Ckfinite
| ILOpCode.Mkrefany ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Mkrefany, readMetadataToken &reader)
| ILOpCode.Ldtoken ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Ldtoken, readMetadataToken &reader)
| ILOpCode.Conv_u2 -> IlOp.Nullary NullaryIlOp.Conv_U2
| ILOpCode.Conv_u1 -> IlOp.Nullary NullaryIlOp.Conv_U1
| ILOpCode.Conv_i -> IlOp.Nullary NullaryIlOp.Conv_I
| ILOpCode.Conv_ovf_i -> IlOp.Nullary NullaryIlOp.Conv_ovf_i
| ILOpCode.Conv_ovf_u -> IlOp.Nullary NullaryIlOp.Conv_ovf_u
| ILOpCode.Add_ovf -> IlOp.Nullary NullaryIlOp.Add_ovf
| ILOpCode.Add_ovf_un -> IlOp.Nullary NullaryIlOp.Add_ovf_un
| ILOpCode.Mul_ovf -> IlOp.Nullary NullaryIlOp.Mul_ovf
| ILOpCode.Mul_ovf_un -> IlOp.Nullary NullaryIlOp.Mul_ovf_un
| ILOpCode.Sub_ovf -> IlOp.Nullary NullaryIlOp.Sub_ovf
| ILOpCode.Sub_ovf_un -> IlOp.Nullary NullaryIlOp.Sub_ovf_un
| ILOpCode.Endfinally -> IlOp.Nullary NullaryIlOp.Endfinally
| ILOpCode.Leave -> IlOp.UnaryConst (UnaryConstIlOp.Leave (reader.ReadInt32 ()))
| ILOpCode.Leave_s -> IlOp.UnaryConst (UnaryConstIlOp.Leave_s (reader.ReadSByte ()))
| ILOpCode.Stind_i -> IlOp.Nullary NullaryIlOp.Stind_I
| ILOpCode.Conv_u -> IlOp.Nullary NullaryIlOp.Conv_U
| ILOpCode.Arglist -> IlOp.Nullary NullaryIlOp.Arglist
| ILOpCode.Ceq -> IlOp.Nullary NullaryIlOp.Ceq
| ILOpCode.Cgt -> IlOp.Nullary NullaryIlOp.Cgt
| ILOpCode.Cgt_un -> IlOp.Nullary NullaryIlOp.Cgt_un
| ILOpCode.Clt -> IlOp.Nullary NullaryIlOp.Clt
| ILOpCode.Clt_un -> IlOp.Nullary NullaryIlOp.Clt_un
| ILOpCode.Ldftn ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Ldftn, readMetadataToken &reader)
| ILOpCode.Ldvirtftn ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Ldvirtftn, readMetadataToken &reader)
| ILOpCode.Ldarg -> IlOp.UnaryConst (UnaryConstIlOp.Ldarg (reader.ReadUInt16 ()))
| ILOpCode.Ldarga -> IlOp.UnaryConst (UnaryConstIlOp.Ldarga (reader.ReadUInt16 ()))
| ILOpCode.Starg -> IlOp.UnaryConst (UnaryConstIlOp.Starg (reader.ReadUInt16 ()))
| ILOpCode.Ldloc -> IlOp.UnaryConst (UnaryConstIlOp.Ldloc (reader.ReadUInt16 ()))
| ILOpCode.Ldloca -> IlOp.UnaryConst (UnaryConstIlOp.Ldloca (reader.ReadUInt16 ()))
| ILOpCode.Stloc -> IlOp.UnaryConst (UnaryConstIlOp.Stloc (reader.ReadUInt16 ()))
| ILOpCode.Localloc -> IlOp.Nullary NullaryIlOp.Localloc
| ILOpCode.Endfilter -> IlOp.Nullary NullaryIlOp.Endfilter
| ILOpCode.Unaligned -> IlOp.UnaryConst (UnaryConstIlOp.Unaligned (reader.ReadByte ()))
| ILOpCode.Volatile -> IlOp.Nullary NullaryIlOp.Volatile
| ILOpCode.Tail -> IlOp.Nullary NullaryIlOp.Tail
| ILOpCode.Initobj ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Initobj, readMetadataToken &reader)
| ILOpCode.Constrained ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Constrained, readMetadataToken &reader)
| ILOpCode.Cpblk -> IlOp.Nullary NullaryIlOp.Cpblk
| ILOpCode.Initblk -> IlOp.Nullary NullaryIlOp.Initblk
| ILOpCode.Rethrow -> IlOp.Nullary NullaryIlOp.Rethrow
| ILOpCode.Sizeof ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Sizeof, readMetadataToken &reader)
| ILOpCode.Refanytype -> IlOp.Nullary NullaryIlOp.Refanytype
| ILOpCode.Readonly -> IlOp.Nullary NullaryIlOp.Readonly
| i -> failwithf "Unknown opcode: %A" i
readInstructions ((opCode, offset) :: acc)
let instructions = readInstructions []
{
Instructions = instructions
LocalInit = methodBody.LocalVariablesInitialized
MaxStackSize = methodBody.MaxStack
ExceptionRegions = methodBody.ExceptionRegions
}
|> Some
let read
(loggerFactory : ILoggerFactory)
(peReader : PEReader)
(metadataReader : MetadataReader)
(methodHandle : MethodDefinitionHandle)
: MethodInfo option
=
let assemblyName = metadataReader.GetAssemblyDefinition().GetAssemblyName ()
let methodDef = metadataReader.GetMethodDefinition methodHandle
let methodName = metadataReader.GetString methodDef.Name
let methodSig = methodDef.DecodeSignature (TypeDefn.typeProvider, ())
let methodBody = readMethodBody peReader methodDef
let declaringType = methodDef.GetDeclaringType ()
match methodBody with
| None ->
let logger = loggerFactory.CreateLogger typeof<Dummy>.DeclaringType
logger.LogDebug ("No method body for {MethodWithoutBody}", metadataReader.GetString methodDef.Name)
None
| Some methodBody ->
let methodParams = Parameter.readAll metadataReader (methodDef.GetParameters ())
let methodGenericParams =
GenericParameter.readAll metadataReader (methodDef.GetGenericParameters ())
{
DeclaringType = (declaringType, assemblyName)
Handle = methodHandle
Name = methodName
Instructions = methodBody.Instructions
Locations = methodBody.Instructions |> List.map (fun (a, b) -> b, a) |> Map.ofList
Parameters = methodParams
Generics = methodGenericParams
Signature = TypeMethodSignature.make methodSig
IsPinvokeImpl = methodDef.Attributes.HasFlag MethodAttributes.PinvokeImpl
LocalsInit = methodBody.LocalInit
IsStatic = not methodSig.Header.IsInstance
}
|> Some

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

@@ -0,0 +1,39 @@
namespace WoofWare.PawPrint
open System.Collections.Immutable
open System.Reflection.Metadata
type Namespace =
{
PrettyName : string
Parent : NamespaceDefinitionHandle
TypeDefinitions : ImmutableArray<TypeDefinitionHandle>
ExportedTypes : ImmutableArray<ExportedTypeHandle>
}
[<RequireQualifiedAccess>]
module Namespace =
/// Returns also the children.
let make
(getString : StringHandle -> string)
(getNamespace : NamespaceDefinitionHandle -> NamespaceDefinition)
(ns : NamespaceDefinition)
: Namespace * ImmutableDictionary<string list, Namespace>
=
let children = ImmutableDictionary.CreateBuilder ()
let rec inner (path : string list) (ns : NamespaceDefinition) : Namespace =
for child in ns.NamespaceDefinitions do
let rendered = getNamespace child
let location = getString rendered.Name :: path
children.Add (List.rev location, inner location rendered)
{
PrettyName = getString ns.Name
Parent = ns.Parent
TypeDefinitions = ns.TypeDefinitions
ExportedTypes = ns.ExportedTypes
}
let result = inner [] ns
result, children.ToImmutable ()

94
WoofWare.PawPrint/Tokens.fs Normal file
View File

@@ -0,0 +1,94 @@
namespace WoofWare.PawPrint
open System.Reflection.Metadata
open System.Reflection.Metadata.Ecma335
type MetadataToken =
| MethodImplementation of MethodImplementationHandle
| MethodDef of MethodDefinitionHandle
| MethodSpecification of MethodSpecificationHandle
| MemberReference of MemberReferenceHandle
| TypeReference of TypeReferenceHandle
| AssemblyReference of AssemblyReferenceHandle
| TypeSpecification of TypeSpecificationHandle
| TypeDefinition of TypeDefinitionHandle
| FieldDefinition of FieldDefinitionHandle
| Parameter of ParameterHandle
| InterfaceImplementation of InterfaceImplementationHandle
| ExportedType of ExportedTypeHandle
| StandaloneSignature of StandaloneSignatureHandle
| EventDefinition of EventDefinitionHandle
| Constant of ConstantHandle
| CustomAttribute of CustomAttributeHandle
| DeclarativeSecurityAttribute of DeclarativeSecurityAttributeHandle
| PropertyDefinition of PropertyDefinitionHandle
| ModuleReference of ModuleReferenceHandle
| AssemblyFile of AssemblyFileHandle
| ManifestResource of ManifestResourceHandle
| GenericParameter of GenericParameterHandle
| GenericParameterConstraint of GenericParameterConstraintHandle
| Document of DocumentHandle
| MethodDebugInformation of MethodDebugInformationHandle
| LocalScope of LocalScopeHandle
| LocalVariable of LocalVariableHandle
| LocalConstant of LocalConstantHandle
| ImportScope of ImportScopeHandle
| CustomDebugInformation of CustomDebugInformationHandle
[<RequireQualifiedAccess>]
module MetadataToken =
let ofInt (value : int32) : MetadataToken =
let asRowNum = value &&& 0x00FFFFFF
match LanguagePrimitives.EnumOfValue<byte, HandleKind> (byte (value &&& 0xFF000000 >>> 24)) with
| HandleKind.ModuleDefinition -> failwith "TODO"
| HandleKind.TypeReference -> MetadataToken.TypeReference (MetadataTokens.TypeReferenceHandle asRowNum)
| HandleKind.TypeDefinition -> MetadataToken.TypeDefinition (MetadataTokens.TypeDefinitionHandle asRowNum)
| HandleKind.FieldDefinition -> MetadataToken.FieldDefinition (MetadataTokens.FieldDefinitionHandle asRowNum)
| HandleKind.MethodDefinition -> MetadataToken.MethodDef (MetadataTokens.MethodDefinitionHandle asRowNum)
| HandleKind.Parameter -> MetadataToken.Parameter (MetadataTokens.ParameterHandle asRowNum)
| HandleKind.InterfaceImplementation ->
MetadataToken.InterfaceImplementation (MetadataTokens.InterfaceImplementationHandle asRowNum)
| HandleKind.MemberReference -> MetadataToken.MemberReference (MetadataTokens.MemberReferenceHandle asRowNum)
| HandleKind.Constant -> MetadataToken.Constant (MetadataTokens.ConstantHandle asRowNum)
| HandleKind.CustomAttribute -> MetadataToken.CustomAttribute (MetadataTokens.CustomAttributeHandle asRowNum)
| HandleKind.DeclarativeSecurityAttribute ->
MetadataToken.DeclarativeSecurityAttribute (MetadataTokens.DeclarativeSecurityAttributeHandle asRowNum)
| HandleKind.StandaloneSignature ->
MetadataToken.StandaloneSignature (MetadataTokens.StandaloneSignatureHandle asRowNum)
| HandleKind.EventDefinition -> MetadataToken.EventDefinition (MetadataTokens.EventDefinitionHandle asRowNum)
| HandleKind.PropertyDefinition ->
MetadataToken.PropertyDefinition (MetadataTokens.PropertyDefinitionHandle asRowNum)
| HandleKind.MethodImplementation ->
MetadataToken.MethodImplementation (MetadataTokens.MethodImplementationHandle asRowNum)
| HandleKind.ModuleReference -> MetadataToken.ModuleReference (MetadataTokens.ModuleReferenceHandle asRowNum)
| HandleKind.TypeSpecification ->
MetadataToken.TypeSpecification (MetadataTokens.TypeSpecificationHandle asRowNum)
| HandleKind.AssemblyDefinition -> failwith "TODO"
| HandleKind.AssemblyReference ->
MetadataToken.AssemblyReference (MetadataTokens.AssemblyReferenceHandle asRowNum)
| HandleKind.AssemblyFile -> MetadataToken.AssemblyFile (MetadataTokens.AssemblyFileHandle asRowNum)
| HandleKind.ExportedType -> MetadataToken.ExportedType (MetadataTokens.ExportedTypeHandle asRowNum)
| HandleKind.ManifestResource -> MetadataToken.ManifestResource (MetadataTokens.ManifestResourceHandle asRowNum)
| HandleKind.GenericParameter -> MetadataToken.GenericParameter (MetadataTokens.GenericParameterHandle asRowNum)
| HandleKind.MethodSpecification ->
MetadataToken.MethodSpecification (MetadataTokens.MethodSpecificationHandle asRowNum)
| HandleKind.GenericParameterConstraint ->
MetadataToken.GenericParameterConstraint (MetadataTokens.GenericParameterConstraintHandle asRowNum)
| HandleKind.Document -> MetadataToken.Document (MetadataTokens.DocumentHandle asRowNum)
| HandleKind.MethodDebugInformation ->
MetadataToken.MethodDebugInformation (MetadataTokens.MethodDebugInformationHandle asRowNum)
| HandleKind.LocalScope -> MetadataToken.LocalScope (MetadataTokens.LocalScopeHandle asRowNum)
| HandleKind.LocalVariable -> MetadataToken.LocalVariable (MetadataTokens.LocalVariableHandle asRowNum)
| HandleKind.LocalConstant -> MetadataToken.LocalConstant (MetadataTokens.LocalConstantHandle asRowNum)
| HandleKind.ImportScope -> MetadataToken.ImportScope (MetadataTokens.ImportScopeHandle asRowNum)
| HandleKind.CustomDebugInformation ->
MetadataToken.CustomDebugInformation (MetadataTokens.CustomDebugInformationHandle asRowNum)
| HandleKind.UserString -> failwith "TODO"
| HandleKind.Blob -> failwith "TODO"
| HandleKind.Guid -> failwith "TODO"
| HandleKind.String -> failwith "TODO"
| HandleKind.NamespaceDefinition -> failwith "TODO"
| h -> failwith $"Unrecognised kind: {h}"
let ofEntityHandle (eh : EntityHandle) : MetadataToken = ofInt (eh.GetHashCode ())

6
WoofWare.PawPrint/Tuple.fs Normal file
View File

@@ -0,0 +1,6 @@
namespace WoofWare.PawPrint
[<RequireQualifiedAccess>]
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

22
WoofWare.PawPrint/TypeDefn.fs
View File

@@ -24,7 +24,6 @@ module TypeMethodSignature =
RequiredParameterCount = p.RequiredParameterCount
}
type PrimitiveType =
| Void
| Boolean
@@ -69,6 +68,7 @@ type PrimitiveType =
type TypeDefn =
| PrimitiveType of PrimitiveType
| Array of elt : TypeDefn * shape : ArrayShape
| Pinned of TypeDefn
| Pointer of TypeDefn
| Byref of TypeDefn
@@ -83,6 +83,22 @@ type TypeDefn =
[<RequireQualifiedAccess>]
module TypeDefn =
let isManaged (typeDefn : TypeDefn) : bool =
match typeDefn with
| PrimitiveType primitiveType -> failwith "todo"
| Array (elt, shape) -> failwith "todo"
| Pinned typeDefn -> failwith "todo"
| Pointer typeDefn -> failwith "todo"
| Byref typeDefn -> failwith "todo"
| OneDimensionalArrayLowerBoundZero elements -> failwith "todo"
| Modified (original, afterMod, modificationRequired) -> failwith "todo"
| FromReference signatureTypeKind -> true
| FromDefinition signatureTypeKind -> failwith "todo"
| GenericInstantiation (generic, args) -> failwith "todo"
| FunctionPointer typeMethodSignature -> failwith "todo"
| GenericTypeParameter index -> failwith "todo"
| GenericMethodParameter index -> failwith "todo"
let fromTypeCode (s : SignatureTypeCode) : TypeDefn =
match s with
| SignatureTypeCode.Invalid -> failwith "todo"
@@ -121,7 +137,9 @@ module TypeDefn =
let typeProvider =
{ new ISignatureTypeProvider<TypeDefn, unit> with
member this.GetArrayType (elementType : TypeDefn, shape : ArrayShape) : TypeDefn = failwith "TODO"
member this.GetArrayType (elementType : TypeDefn, shape : ArrayShape) : TypeDefn =
TypeDefn.Array (elementType, shape)
member this.GetByReferenceType (elementType : TypeDefn) : TypeDefn = TypeDefn.Byref elementType
member this.GetSZArrayType (elementType : TypeDefn) : TypeDefn =

483
WoofWare.PawPrint/TypeInfo.fs
View File

@@ -1,29 +1,13 @@
namespace WoofWare.PawPrint
#nowarn "9"
open System
open System.Collections.Generic
open System.Collections.Immutable
open System.Reflection
open System.Reflection.Metadata
open System.Reflection.Metadata.Ecma335
open System.Reflection.PortableExecutable
open Microsoft.Extensions.Logging
open Microsoft.FSharp.Core
type Parameter =
{
Name : string
DefaultValue : Constant
SequenceNumber : int
}
type GenericParameter =
{
Name : string
SequenceNumber : int
}
type MethodSpec =
{
Method : MetadataToken
@@ -37,444 +21,88 @@ module MethodSpec =
Method = MetadataToken.ofInt (p.Method.GetHashCode ())
}
type MethodInfo =
{
Handle : MethodDefinitionHandle
Name : string
/// also stores the offset of this instruction
Instructions : (IlOp * int) list
/// inverted Instructions: a mapping of program counter to op
Locations : Map<int, IlOp>
Parameters : Parameter ImmutableArray
Generics : GenericParameter ImmutableArray
Signature : TypeMethodSignature<TypeDefn>
IsPinvokeImpl : bool
LocalsInit : bool
}
type BaseTypeInfo =
| TypeDef of TypeDefinitionHandle
| TypeRef of TypeReferenceHandle
| TypeSpec of TypeSpecificationHandle
| ForeignAssemblyType of assemblyName : AssemblyName * TypeDefinitionHandle
type MethodImplParsed =
| MethodImplementation of MethodImplementationHandle
| MethodDefinition of MethodDefinitionHandle
type TypeInfo =
{
Namespace : string
Name : string
Methods : MethodInfo list
MethodImpls : ImmutableDictionary<MethodImplementationHandle, EntityHandle>
}
type TypeRef =
{
Name : StringToken
Namespace : StringToken
ResolutionScope : MetadataToken
Methods : WoofWare.PawPrint.MethodInfo list
MethodImpls : ImmutableDictionary<MethodImplementationHandle, MethodImplParsed>
Fields : WoofWare.PawPrint.FieldInfo list
BaseType : BaseTypeInfo option
TypeAttributes : TypeAttributes
Attributes : WoofWare.PawPrint.CustomAttribute list
TypeDefHandle : TypeDefinitionHandle
}
[<RequireQualifiedAccess>]
module TypeInfo =
let private readOpCode (reader : byref<BlobReader>) : ILOpCode =
let op = reader.ReadByte ()
if op = 0xFEuy then
let op2 = reader.ReadByte ()
LanguagePrimitives.EnumOfValue (0xFE00us ||| (uint16 op2))
else
LanguagePrimitives.EnumOfValue (uint16 op)
let private readMetadataToken (reader : byref<BlobReader>) : MetadataToken =
reader.ReadUInt32 () |> int |> MetadataToken.ofInt
let private readStringToken (reader : byref<BlobReader>) : StringToken =
let value = reader.ReadUInt32 () |> int
StringToken.ofInt value
type private MethodBody =
{
Instructions : (IlOp * int) list
LocalInit : bool
MaxStackSize : int
ExceptionRegions : ImmutableArray<ExceptionRegion>
}
let private readMethodBody (peReader : PEReader) (methodDef : MethodDefinition) : MethodBody option =
if methodDef.RelativeVirtualAddress = 0 then
None
else
let methodBody = peReader.GetMethodBody methodDef.RelativeVirtualAddress
let ilBytes = methodBody.GetILBytes ()
use bytes = fixed ilBytes
let mutable reader : BlobReader = BlobReader (bytes, ilBytes.Length)
let rec readInstructions acc =
if reader.Offset >= ilBytes.Length then
List.rev acc
else
let offset = reader.Offset
let opCode = readOpCode (&reader)
let opCode =
match opCode with
| ILOpCode.Nop -> IlOp.Nullary NullaryIlOp.Nop
| ILOpCode.Break -> failwith "todo"
| ILOpCode.Ldarg_0 -> IlOp.Nullary NullaryIlOp.LdArg0
| ILOpCode.Ldarg_1 -> IlOp.Nullary NullaryIlOp.LdArg1
| ILOpCode.Ldarg_2 -> IlOp.Nullary NullaryIlOp.LdArg2
| ILOpCode.Ldarg_3 -> IlOp.Nullary NullaryIlOp.LdArg3
| ILOpCode.Ldloc_0 -> IlOp.Nullary NullaryIlOp.Ldloc_0
| ILOpCode.Ldloc_1 -> IlOp.Nullary NullaryIlOp.Ldloc_1
| ILOpCode.Ldloc_2 -> IlOp.Nullary NullaryIlOp.Ldloc_2
| ILOpCode.Ldloc_3 -> IlOp.Nullary NullaryIlOp.Ldloc_3
| ILOpCode.Stloc_0 -> IlOp.Nullary NullaryIlOp.Stloc_0
| ILOpCode.Stloc_1 -> IlOp.Nullary NullaryIlOp.Stloc_1
| ILOpCode.Stloc_2 -> IlOp.Nullary NullaryIlOp.Stloc_2
| ILOpCode.Stloc_3 -> IlOp.Nullary NullaryIlOp.Stloc_3
| ILOpCode.Ldarg_s -> IlOp.UnaryConst (UnaryConstIlOp.Ldarg_s (reader.ReadByte ()))
| ILOpCode.Ldarga_s -> IlOp.UnaryConst (UnaryConstIlOp.Ldarga_s (reader.ReadByte ()))
| ILOpCode.Starg_s -> IlOp.UnaryConst (UnaryConstIlOp.Starg_s (reader.ReadByte ()))
| ILOpCode.Ldloc_s -> IlOp.UnaryConst (UnaryConstIlOp.Ldloc_s (reader.ReadByte ()))
| ILOpCode.Ldloca_s -> IlOp.UnaryConst (UnaryConstIlOp.Ldloca_s (reader.ReadByte ()))
| ILOpCode.Stloc_s -> IlOp.UnaryConst (UnaryConstIlOp.Stloc_s (reader.ReadSByte ()))
| ILOpCode.Ldnull -> IlOp.Nullary NullaryIlOp.LdNull
| ILOpCode.Ldc_i4_m1 -> IlOp.Nullary NullaryIlOp.LdcI4_m1
| ILOpCode.Ldc_i4_0 -> IlOp.Nullary NullaryIlOp.LdcI4_0
| ILOpCode.Ldc_i4_1 -> IlOp.Nullary NullaryIlOp.LdcI4_1
| ILOpCode.Ldc_i4_2 -> IlOp.Nullary NullaryIlOp.LdcI4_2
| ILOpCode.Ldc_i4_3 -> IlOp.Nullary NullaryIlOp.LdcI4_3
| ILOpCode.Ldc_i4_4 -> IlOp.Nullary NullaryIlOp.LdcI4_4
| ILOpCode.Ldc_i4_5 -> IlOp.Nullary NullaryIlOp.LdcI4_5
| ILOpCode.Ldc_i4_6 -> IlOp.Nullary NullaryIlOp.LdcI4_6
| ILOpCode.Ldc_i4_7 -> IlOp.Nullary NullaryIlOp.LdcI4_7
| ILOpCode.Ldc_i4_8 -> IlOp.Nullary NullaryIlOp.LdcI4_8
| ILOpCode.Ldc_i4_s -> IlOp.UnaryConst (UnaryConstIlOp.Ldc_I4_s (reader.ReadSByte ()))
| ILOpCode.Ldc_i4 -> IlOp.UnaryConst (UnaryConstIlOp.Ldc_I4 (reader.ReadInt32 ()))
| ILOpCode.Ldc_i8 -> IlOp.UnaryConst (UnaryConstIlOp.Ldc_I8 (reader.ReadInt64 ()))
| ILOpCode.Ldc_r4 -> failwith "todo"
| ILOpCode.Ldc_r8 -> failwith "todo"
| ILOpCode.Dup -> IlOp.Nullary NullaryIlOp.Dup
| ILOpCode.Pop -> IlOp.Nullary NullaryIlOp.Pop
| ILOpCode.Jmp -> failwith "todo"
| ILOpCode.Call ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Call, readMetadataToken &reader)
| ILOpCode.Calli -> failwith "todo"
| ILOpCode.Ret -> IlOp.Nullary NullaryIlOp.Ret
| ILOpCode.Br_s -> IlOp.UnaryConst (UnaryConstIlOp.Br_s (reader.ReadSByte ()))
| ILOpCode.Brfalse_s -> IlOp.UnaryConst (UnaryConstIlOp.Brfalse_s (reader.ReadSByte ()))
| ILOpCode.Brtrue_s -> IlOp.UnaryConst (UnaryConstIlOp.Brtrue_s (reader.ReadSByte ()))
| ILOpCode.Beq_s -> IlOp.UnaryConst (UnaryConstIlOp.Beq_s (reader.ReadSByte ()))
| ILOpCode.Bge_s -> IlOp.UnaryConst (UnaryConstIlOp.Bge_s (reader.ReadSByte ()))
| ILOpCode.Bgt_s -> IlOp.UnaryConst (UnaryConstIlOp.Bgt_s (reader.ReadSByte ()))
| ILOpCode.Ble_s -> IlOp.UnaryConst (UnaryConstIlOp.Ble_s (reader.ReadSByte ()))
| ILOpCode.Blt_s -> IlOp.UnaryConst (UnaryConstIlOp.Blt_s (reader.ReadSByte ()))
| ILOpCode.Bne_un_s -> IlOp.UnaryConst (UnaryConstIlOp.Bne_un_s (reader.ReadSByte ()))
| ILOpCode.Bge_un_s -> IlOp.UnaryConst (UnaryConstIlOp.Bge_un_s (reader.ReadSByte ()))
| ILOpCode.Bgt_un_s -> IlOp.UnaryConst (UnaryConstIlOp.Bgt_un_s (reader.ReadSByte ()))
| ILOpCode.Ble_un_s -> IlOp.UnaryConst (UnaryConstIlOp.Ble_un_s (reader.ReadSByte ()))
| ILOpCode.Blt_un_s -> IlOp.UnaryConst (UnaryConstIlOp.Blt_un_s (reader.ReadSByte ()))
| ILOpCode.Br -> IlOp.UnaryConst (UnaryConstIlOp.Br (reader.ReadInt32 ()))
| ILOpCode.Brfalse -> IlOp.UnaryConst (UnaryConstIlOp.Brfalse (reader.ReadInt32 ()))
| ILOpCode.Brtrue -> IlOp.UnaryConst (UnaryConstIlOp.Brtrue (reader.ReadInt32 ()))
| ILOpCode.Beq -> IlOp.UnaryConst (UnaryConstIlOp.Beq (reader.ReadInt32 ()))
| ILOpCode.Bge -> IlOp.UnaryConst (UnaryConstIlOp.Bge (reader.ReadInt32 ()))
| ILOpCode.Bgt -> IlOp.UnaryConst (UnaryConstIlOp.Bgt (reader.ReadInt32 ()))
| ILOpCode.Ble -> IlOp.UnaryConst (UnaryConstIlOp.Ble (reader.ReadInt32 ()))
| ILOpCode.Blt -> IlOp.UnaryConst (UnaryConstIlOp.Blt (reader.ReadInt32 ()))
| ILOpCode.Bne_un -> IlOp.UnaryConst (UnaryConstIlOp.Bne_un (reader.ReadInt32 ()))
| ILOpCode.Bge_un -> IlOp.UnaryConst (UnaryConstIlOp.Bge_un (reader.ReadInt32 ()))
| ILOpCode.Bgt_un -> IlOp.UnaryConst (UnaryConstIlOp.Bgt_un (reader.ReadInt32 ()))
| ILOpCode.Ble_un -> IlOp.UnaryConst (UnaryConstIlOp.Ble_un (reader.ReadInt32 ()))
| ILOpCode.Blt_un -> IlOp.UnaryConst (UnaryConstIlOp.Blt_un (reader.ReadInt32 ()))
| ILOpCode.Switch ->
let count = reader.ReadUInt32 ()
if count > uint32 Int32.MaxValue then
failwith "Debugger error: can't create a jump table with more than int32.Max entries"
let count = int count
let result = ImmutableArray.CreateBuilder count
for i = 0 to count - 1 do
result.Add (reader.ReadInt32 ())
IlOp.Switch (result.ToImmutable ())
| ILOpCode.Ldind_i -> IlOp.Nullary NullaryIlOp.Ldind_i
| ILOpCode.Ldind_i1 -> IlOp.Nullary NullaryIlOp.Ldind_i1
| ILOpCode.Ldind_u1 -> IlOp.Nullary NullaryIlOp.Ldind_u1
| ILOpCode.Ldind_i2 -> IlOp.Nullary NullaryIlOp.Ldind_i2
| ILOpCode.Ldind_u2 -> IlOp.Nullary NullaryIlOp.Ldind_u2
| ILOpCode.Ldind_i4 -> IlOp.Nullary NullaryIlOp.Ldind_i4
| ILOpCode.Ldind_u4 -> IlOp.Nullary NullaryIlOp.Ldind_u4
| ILOpCode.Ldind_i8 -> IlOp.Nullary NullaryIlOp.Ldind_i8
| ILOpCode.Ldind_r4 -> IlOp.Nullary NullaryIlOp.Ldind_r4
| ILOpCode.Ldind_r8 -> IlOp.Nullary NullaryIlOp.Ldind_r8
| ILOpCode.Ldind_ref -> IlOp.Nullary NullaryIlOp.Ldind_ref
| ILOpCode.Stind_ref -> IlOp.Nullary NullaryIlOp.Stind_ref
| ILOpCode.Stind_i1 -> IlOp.Nullary NullaryIlOp.Stind_I1
| ILOpCode.Stind_i2 -> IlOp.Nullary NullaryIlOp.Stind_I2
| ILOpCode.Stind_i4 -> IlOp.Nullary NullaryIlOp.Stind_I4
| ILOpCode.Stind_i8 -> IlOp.Nullary NullaryIlOp.Stind_I8
| ILOpCode.Stind_r4 -> IlOp.Nullary NullaryIlOp.Stind_R4
| ILOpCode.Stind_r8 -> IlOp.Nullary NullaryIlOp.Stind_R8
| ILOpCode.Add -> IlOp.Nullary NullaryIlOp.Add
| ILOpCode.Sub -> IlOp.Nullary NullaryIlOp.Sub
| ILOpCode.Mul -> IlOp.Nullary NullaryIlOp.Mul
| ILOpCode.Div -> IlOp.Nullary NullaryIlOp.Div
| ILOpCode.Div_un -> IlOp.Nullary NullaryIlOp.Div_un
| ILOpCode.Rem -> IlOp.Nullary NullaryIlOp.Rem
| ILOpCode.Rem_un -> IlOp.Nullary NullaryIlOp.Rem_un
| ILOpCode.And -> IlOp.Nullary NullaryIlOp.And
| ILOpCode.Or -> IlOp.Nullary NullaryIlOp.Or
| ILOpCode.Xor -> IlOp.Nullary NullaryIlOp.Xor
| ILOpCode.Shl -> IlOp.Nullary NullaryIlOp.Shl
| ILOpCode.Shr -> IlOp.Nullary NullaryIlOp.Shr
| ILOpCode.Shr_un -> IlOp.Nullary NullaryIlOp.Shr_un
| ILOpCode.Neg -> IlOp.Nullary NullaryIlOp.Neg
| ILOpCode.Not -> IlOp.Nullary NullaryIlOp.Not
| ILOpCode.Conv_i1 -> IlOp.Nullary NullaryIlOp.Conv_I1
| ILOpCode.Conv_i2 -> IlOp.Nullary NullaryIlOp.Conv_I2
| ILOpCode.Conv_i4 -> IlOp.Nullary NullaryIlOp.Conv_I4
| ILOpCode.Conv_i8 -> IlOp.Nullary NullaryIlOp.Conv_I8
| ILOpCode.Conv_r4 -> IlOp.Nullary NullaryIlOp.Conv_R4
| ILOpCode.Conv_r8 -> IlOp.Nullary NullaryIlOp.Conv_R8
| ILOpCode.Conv_u4 -> IlOp.Nullary NullaryIlOp.Conv_U4
| ILOpCode.Conv_u8 -> IlOp.Nullary NullaryIlOp.Conv_U8
| ILOpCode.Callvirt ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Callvirt, readMetadataToken &reader)
| ILOpCode.Cpobj ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Cpobj, readMetadataToken &reader)
| ILOpCode.Ldobj ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Ldobj, readMetadataToken &reader)
| ILOpCode.Ldstr -> IlOp.UnaryStringToken (UnaryStringTokenIlOp.Ldstr, readStringToken &reader)
| ILOpCode.Newobj ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Newobj, readMetadataToken &reader)
| ILOpCode.Castclass ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Castclass, readMetadataToken &reader)
| ILOpCode.Isinst ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Isinst, readMetadataToken &reader)
| ILOpCode.Conv_r_un -> failwith "todo"
| ILOpCode.Unbox -> failwith "todo"
| ILOpCode.Throw -> IlOp.Nullary NullaryIlOp.Throw
| ILOpCode.Ldfld ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Ldfld, readMetadataToken &reader)
| ILOpCode.Ldflda ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Ldflda, readMetadataToken &reader)
| ILOpCode.Stfld ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Stfld, readMetadataToken &reader)
| ILOpCode.Ldsfld ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Ldsfld, readMetadataToken &reader)
| ILOpCode.Ldsflda ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Ldsflda, readMetadataToken &reader)
| ILOpCode.Stsfld ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Stsfld, readMetadataToken &reader)
| ILOpCode.Stobj ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Stobj, readMetadataToken &reader)
| ILOpCode.Conv_ovf_i_un -> IlOp.Nullary NullaryIlOp.Conv_ovf_i_un
| ILOpCode.Conv_ovf_i1_un -> IlOp.Nullary NullaryIlOp.Conv_ovf_i1_un
| ILOpCode.Conv_ovf_i2_un -> IlOp.Nullary NullaryIlOp.Conv_ovf_i2_un
| ILOpCode.Conv_ovf_i4_un -> IlOp.Nullary NullaryIlOp.Conv_ovf_i4_un
| ILOpCode.Conv_ovf_i8_un -> IlOp.Nullary NullaryIlOp.Conv_ovf_i8_un
| ILOpCode.Conv_ovf_u_un -> IlOp.Nullary NullaryIlOp.Conv_ovf_u_un
| ILOpCode.Conv_ovf_u1_un -> IlOp.Nullary NullaryIlOp.Conv_ovf_u1_un
| ILOpCode.Conv_ovf_u2_un -> IlOp.Nullary NullaryIlOp.Conv_ovf_u2_un
| ILOpCode.Conv_ovf_u4_un -> IlOp.Nullary NullaryIlOp.Conv_ovf_u4_un
| ILOpCode.Conv_ovf_u8_un -> IlOp.Nullary NullaryIlOp.Conv_ovf_u8_un
| ILOpCode.Box ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Box, readMetadataToken &reader)
| ILOpCode.Newarr ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Newarr, readMetadataToken &reader)
| ILOpCode.Ldlen -> IlOp.Nullary NullaryIlOp.LdLen
| ILOpCode.Ldelema ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Ldelema, readMetadataToken &reader)
| ILOpCode.Ldelem_i1 -> IlOp.Nullary NullaryIlOp.Ldelem_i1
| ILOpCode.Ldelem_u1 -> IlOp.Nullary NullaryIlOp.Ldelem_u1
| ILOpCode.Ldelem_i2 -> IlOp.Nullary NullaryIlOp.Ldelem_i2
| ILOpCode.Ldelem_u2 -> IlOp.Nullary NullaryIlOp.Ldelem_u2
| ILOpCode.Ldelem_i4 -> IlOp.Nullary NullaryIlOp.Ldelem_i4
| ILOpCode.Ldelem_u4 -> IlOp.Nullary NullaryIlOp.Ldelem_u4
| ILOpCode.Ldelem_i8 -> IlOp.Nullary NullaryIlOp.Ldelem_i8
| ILOpCode.Ldelem_i -> IlOp.Nullary NullaryIlOp.Ldelem_i
| ILOpCode.Ldelem_r4 -> IlOp.Nullary NullaryIlOp.Ldelem_r4
| ILOpCode.Ldelem_r8 -> IlOp.Nullary NullaryIlOp.Ldelem_r8
| ILOpCode.Ldelem_ref -> IlOp.Nullary NullaryIlOp.Ldelem_ref
| ILOpCode.Stelem_i -> IlOp.Nullary NullaryIlOp.Stelem_i
| ILOpCode.Stelem_i1 -> IlOp.Nullary NullaryIlOp.Stelem_i1
| ILOpCode.Stelem_i2 -> IlOp.Nullary NullaryIlOp.Stelem_i2
| ILOpCode.Stelem_i4 -> IlOp.Nullary NullaryIlOp.Stelem_i4
| ILOpCode.Stelem_i8 -> IlOp.Nullary NullaryIlOp.Stelem_i8
| ILOpCode.Stelem_r4 -> IlOp.Nullary NullaryIlOp.Stelem_r4
| ILOpCode.Stelem_r8 -> IlOp.Nullary NullaryIlOp.Stelem_r8
| ILOpCode.Stelem_ref -> IlOp.Nullary NullaryIlOp.Stelem_ref
| ILOpCode.Ldelem ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Ldelem, readMetadataToken &reader)
| ILOpCode.Stelem ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Stelem, readMetadataToken &reader)
| ILOpCode.Unbox_any ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Unbox_Any, readMetadataToken &reader)
| ILOpCode.Conv_ovf_i1 -> failwith "todo"
| ILOpCode.Conv_ovf_u1 -> failwith "todo"
| ILOpCode.Conv_ovf_i2 -> failwith "todo"
| ILOpCode.Conv_ovf_u2 -> failwith "todo"
| ILOpCode.Conv_ovf_i4 -> failwith "todo"
| ILOpCode.Conv_ovf_u4 -> failwith "todo"
| ILOpCode.Conv_ovf_i8 -> failwith "todo"
| ILOpCode.Conv_ovf_u8 -> failwith "todo"
| ILOpCode.Refanyval -> failwith "todo"
| ILOpCode.Ckfinite -> failwith "todo"
| ILOpCode.Mkrefany -> failwith "todo"
| ILOpCode.Ldtoken ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Ldtoken, readMetadataToken &reader)
| ILOpCode.Conv_u2 -> IlOp.Nullary NullaryIlOp.Conv_U2
| ILOpCode.Conv_u1 -> IlOp.Nullary NullaryIlOp.Conv_U1
| ILOpCode.Conv_i -> IlOp.Nullary NullaryIlOp.Conv_I
| ILOpCode.Conv_ovf_i -> IlOp.Nullary NullaryIlOp.Conv_ovf_i
| ILOpCode.Conv_ovf_u -> IlOp.Nullary NullaryIlOp.Conv_ovf_u
| ILOpCode.Add_ovf -> IlOp.Nullary NullaryIlOp.Add_ovf
| ILOpCode.Add_ovf_un -> IlOp.Nullary NullaryIlOp.Add_ovf_un
| ILOpCode.Mul_ovf -> IlOp.Nullary NullaryIlOp.Mul_ovf
| ILOpCode.Mul_ovf_un -> IlOp.Nullary NullaryIlOp.Mul_ovf_un
| ILOpCode.Sub_ovf -> IlOp.Nullary NullaryIlOp.Sub_ovf
| ILOpCode.Sub_ovf_un -> IlOp.Nullary NullaryIlOp.Sub_ovf_un
| ILOpCode.Endfinally -> IlOp.Nullary NullaryIlOp.Endfinally
| ILOpCode.Leave -> IlOp.UnaryConst (UnaryConstIlOp.Leave (reader.ReadInt32 ()))
| ILOpCode.Leave_s -> IlOp.UnaryConst (UnaryConstIlOp.Leave_s (reader.ReadSByte ()))
| ILOpCode.Stind_i -> failwith "todo"
| ILOpCode.Conv_u -> IlOp.Nullary NullaryIlOp.Conv_U
| ILOpCode.Arglist -> failwith "todo"
| ILOpCode.Ceq -> IlOp.Nullary NullaryIlOp.Ceq
| ILOpCode.Cgt -> IlOp.Nullary NullaryIlOp.Cgt
| ILOpCode.Cgt_un -> IlOp.Nullary NullaryIlOp.Cgt_un
| ILOpCode.Clt -> IlOp.Nullary NullaryIlOp.Clt
| ILOpCode.Clt_un -> IlOp.Nullary NullaryIlOp.Clt_un
| ILOpCode.Ldftn ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Ldftn, readMetadataToken &reader)
| ILOpCode.Ldvirtftn -> failwith "todo"
| ILOpCode.Ldarg -> failwith "todo"
| ILOpCode.Ldarga -> failwith "todo"
| ILOpCode.Starg -> IlOp.UnaryConst (UnaryConstIlOp.Starg (reader.ReadUInt16 ()))
| ILOpCode.Ldloc -> failwith "todo"
| ILOpCode.Ldloca -> failwith "todo"
| ILOpCode.Stloc -> IlOp.UnaryConst (UnaryConstIlOp.Stloc (reader.ReadUInt16 ()))
| ILOpCode.Localloc -> IlOp.Nullary NullaryIlOp.Localloc
| ILOpCode.Endfilter -> IlOp.Nullary NullaryIlOp.Endfilter
| ILOpCode.Unaligned -> failwith "todo"
| ILOpCode.Volatile -> IlOp.Nullary NullaryIlOp.Volatile
| ILOpCode.Tail -> IlOp.Nullary NullaryIlOp.Tail
| ILOpCode.Initobj ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Initobj, readMetadataToken &reader)
| ILOpCode.Constrained ->
IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Constrained, readMetadataToken &reader)
| ILOpCode.Cpblk -> failwith "todo"
| ILOpCode.Initblk -> failwith "todo"
| ILOpCode.Rethrow -> IlOp.Nullary NullaryIlOp.Rethrow
| ILOpCode.Sizeof -> failwith "todo"
| ILOpCode.Refanytype -> failwith "todo"
| ILOpCode.Readonly -> failwith "todo"
| i -> failwithf "Unknown opcode: %A" i
readInstructions ((opCode, offset) :: acc)
let instructions = readInstructions []
{
Instructions = instructions
LocalInit = methodBody.LocalVariablesInitialized
MaxStackSize = methodBody.MaxStack
ExceptionRegions = methodBody.ExceptionRegions
}
|> Some
let private readMethodParams
(metadata : MetadataReader)
(param : ParameterHandleCollection)
: Parameter ImmutableArray
=
param
|> Seq.map (fun param ->
let param = metadata.GetParameter param
{
Name = metadata.GetString param.Name
DefaultValue = metadata.GetConstant (param.GetDefaultValue ())
SequenceNumber = param.SequenceNumber
}
)
|> ImmutableArray.CreateRange
let private readGenericMethodParam
(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
let private readMethod
(peReader : PEReader)
(metadataReader : MetadataReader)
(methodHandle : MethodDefinitionHandle)
: MethodInfo option
=
let methodDef = metadataReader.GetMethodDefinition methodHandle
let methodName = metadataReader.GetString methodDef.Name
let methodSig = methodDef.DecodeSignature (TypeDefn.typeProvider, ())
let methodBody = readMethodBody peReader methodDef
match methodBody with
| None ->
Console.Error.WriteLine $"[INF] No method body for {metadataReader.GetString methodDef.Name}"
None
| Some methodBody ->
let methodParams = readMethodParams metadataReader (methodDef.GetParameters ())
let methodGenericParams =
readGenericMethodParam metadataReader (methodDef.GetGenericParameters ())
{
Handle = methodHandle
Name = methodName
Instructions = methodBody.Instructions
Locations = methodBody.Instructions |> List.map (fun (a, b) -> b, a) |> Map.ofList
Parameters = methodParams
Generics = methodGenericParams
Signature = TypeMethodSignature.make methodSig
IsPinvokeImpl = methodDef.Attributes.HasFlag MethodAttributes.PinvokeImpl
LocalsInit = methodBody.LocalInit
}
|> Some
let internal read
(loggerFactory : ILoggerFactory)
(peReader : PEReader)
(metadataReader : MetadataReader)
(typeHandle : TypeDefinitionHandle)
: TypeInfo
=
let typeDef = metadataReader.GetTypeDefinition (typeHandle)
let typeDef = metadataReader.GetTypeDefinition typeHandle
let methods = typeDef.GetMethods ()
let methodImpls =
typeDef.GetMethodImplementations ()
|> Seq.map (fun handle ->
let m = metadataReader.GetMethodImplementation handle
let methodBody = MetadataToken.ofEntityHandle m.MethodBody
if not (m.MethodBody.Kind.HasFlag HandleKind.MethodImplementation) then
failwith "unexpected kind"
match methodBody with
| MetadataToken.MethodImplementation t ->
KeyValuePair (handle, MethodImplParsed.MethodImplementation t)
| MetadataToken.MethodDef t -> KeyValuePair (handle, MethodImplParsed.MethodDefinition t)
| k -> failwith $"unexpected kind: {k}"
KeyValuePair (handle, m.MethodBody)
)
|> ImmutableDictionary.CreateRange
let fields =
metadataReader.FieldDefinitions
|> 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
let attrs =
typeDef.GetCustomAttributes ()
|> Seq.map (fun h -> CustomAttribute.make h (metadataReader.GetCustomAttribute h))
|> Seq.toList
{
Namespace = metadataReader.GetString (typeDef.Namespace)
Name = metadataReader.GetString (typeDef.Name)
Namespace = ns
Name = name
Methods =
methods
|> Seq.choose (fun m ->
let result = readMethod peReader metadataReader m
let result = MethodInfo.read loggerFactory peReader metadataReader m
match result with
| None -> None
@@ -482,4 +110,9 @@ module TypeInfo =
)
|> Seq.toList
MethodImpls = methodImpls
Fields = fields
BaseType = baseType
TypeAttributes = typeAttrs
Attributes = attrs
TypeDefHandle = typeHandle
}

24
WoofWare.PawPrint/TypeRef.fs Normal file
View File

@@ -0,0 +1,24 @@
namespace WoofWare.PawPrint
open System.Reflection.Metadata
type TypeRef =
{
Name : string
Namespace : string
ResolutionScope : WoofWare.PawPrint.MetadataToken
}
[<RequireQualifiedAccess>]
module TypeRef =
let make (metadataReader : MetadataReader) (ty : TypeReferenceHandle) : TypeRef =
let typeRef = metadataReader.GetTypeReference ty
let prettyName = metadataReader.GetString typeRef.Name
let prettyNamespace = metadataReader.GetString typeRef.Namespace
let resolutionScope = MetadataToken.ofEntityHandle typeRef.ResolutionScope
{
Name = prettyName
Namespace = prettyNamespace
ResolutionScope = resolutionScope
}

12
WoofWare.PawPrint/WoofWare.PawPrint.fsproj
View File

@@ -6,12 +6,24 @@
<ItemGroup>
<Compile Include="BitTwiddling.fs" />
<Compile Include="Tuple.fs" />
<None Include="Executable.fs" />
<Compile Include="Tokens.fs" />
<Compile Include="TypeRef.fs" />
<Compile Include="CustomAttribute.fs" />
<Compile Include="Namespace.fs" />
<Compile Include="ExportedType.fs" />
<Compile Include="TypeDefn.fs" />
<Compile Include="FieldInfo.fs" />
<Compile Include="IlOp.fs" />
<Compile Include="MethodInfo.fs" />
<Compile Include="TypeInfo.fs" />
<Compile Include="Assembly.fs" />
<Compile Include="AbstractMachine.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="Microsoft.Extensions.Logging.Abstractions" Version="9.0.2" />
</ItemGroup>
</Project>

15
nix/deps.json
View File

@@ -59,6 +59,16 @@
"version": "17.13.0",
"hash": "sha256-GKrIxeyQo5Az1mztfQgea1kGtJwonnNOrXK/0ULfu8o="
},
{
"pname": "Microsoft.Extensions.DependencyInjection.Abstractions",
"version": "9.0.2",
"hash": "sha256-WoTLgw/OlXhgN54Szip0Zpne7i/YTXwZ1ZLCPcHV6QM="
},
{
"pname": "Microsoft.Extensions.Logging.Abstractions",
"version": "9.0.2",
"hash": "sha256-mCxeuc+37XY0bmZR+z4p1hrZUdTZEg+FRcs/m6dAQDU="
},
{
"pname": "Microsoft.NET.Test.Sdk",
"version": "17.13.0",
@@ -179,6 +189,11 @@
"version": "5.0.0",
"hash": "sha256-6mW3N6FvcdNH/pB58pl+pFSCGWgyaP4hfVtC/SMWDV4="
},
{
"pname": "System.Diagnostics.DiagnosticSource",
"version": "9.0.2",
"hash": "sha256-vhlhNgWeEosMB3DyneAUgH2nlpHORo7vAIo5Bx5Dgrc="
},
{
"pname": "System.Reflection.Metadata",
"version": "1.6.0",