diff --git a/.envrc b/.envrc
index 3550a30..e75d028 100644
--- a/.envrc
+++ b/.envrc
@@ -1 +1,23 @@
use flake
+DOTNET_PATH=$(readlink "$(which dotnet)")
+SETTINGS_FILE=$(find . -maxdepth 1 -type f -name '*.sln.DotSettings.user')
+MSBUILD=$(realpath "$(find "$(dirname "$DOTNET_PATH")/../share/dotnet/sdk" -maxdepth 2 -type f -name MSBuild.dll)")
+if [ -f "$SETTINGS_FILE" ] ; then
+ xmlstarlet ed --inplace \
+ -N wpf="http://schemas.microsoft.com/winfx/2006/xaml/presentation" \
+ -N x="http://schemas.microsoft.com/winfx/2006/xaml" \
+ -N s="clr-namespace:System;assembly=mscorlib" \
+ -N ss="urn:shemas-jetbrains-com:settings-storage-xaml" \
+ --update "//s:String[@x:Key='/Default/Environment/Hierarchy/Build/BuildTool/DotNetCliExePath/@EntryValue']" \
+ --value "$(realpath "$(dirname "$DOTNET_PATH")/../share/dotnet/dotnet")" \
+ "$SETTINGS_FILE"
+
+ xmlstarlet ed --inplace \
+ -N wpf="http://schemas.microsoft.com/winfx/2006/xaml/presentation" \
+ -N x="http://schemas.microsoft.com/winfx/2006/xaml" \
+ -N s="clr-namespace:System;assembly=mscorlib" \
+ -N ss="urn:shemas-jetbrains-com:settings-storage-xaml" \
+ --update "//s:String[@x:Key='/Default/Environment/Hierarchy/Build/BuildTool/CustomBuildToolPath/@EntryValue']" \
+ --value "$MSBUILD" \
+ "$SETTINGS_FILE"
+fi
diff --git a/DotnetRuntime.sln b/DotnetRuntime.sln
deleted file mode 100644
index b8421f8..0000000
--- a/DotnetRuntime.sln
+++ /dev/null
@@ -1,29 +0,0 @@
-
-Microsoft Visual Studio Solution File, Format Version 12.00
-#
-Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.DotnetRuntime", "WoofWare.DotnetRuntime\WoofWare.DotnetRuntime.fsproj", "{5A19255D-8235-44B2-AC33-ECC33DA0D28C}"
-EndProject
-Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.DotnetRuntime.Test", "WoofWare.DotnetRuntime.Test\WoofWare.DotnetRuntime.Test.fsproj", "{BB6B58B5-3D61-4628-8C5E-9300011FA9BA}"
-EndProject
-Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.DotnetRuntime.App", "WoofWare.DotnetRuntime.App\WoofWare.DotnetRuntime.App.fsproj", "{03D35F0B-AA7E-41B6-BC74-3DF37BBC76B5}"
-EndProject
-Global
- GlobalSection(SolutionConfigurationPlatforms) = preSolution
- Debug|Any CPU = Debug|Any CPU
- Release|Any CPU = Release|Any CPU
- EndGlobalSection
- GlobalSection(ProjectConfigurationPlatforms) = postSolution
- {5A19255D-8235-44B2-AC33-ECC33DA0D28C}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
- {5A19255D-8235-44B2-AC33-ECC33DA0D28C}.Debug|Any CPU.Build.0 = Debug|Any CPU
- {5A19255D-8235-44B2-AC33-ECC33DA0D28C}.Release|Any CPU.ActiveCfg = Release|Any CPU
- {5A19255D-8235-44B2-AC33-ECC33DA0D28C}.Release|Any CPU.Build.0 = Release|Any CPU
- {BB6B58B5-3D61-4628-8C5E-9300011FA9BA}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
- {BB6B58B5-3D61-4628-8C5E-9300011FA9BA}.Debug|Any CPU.Build.0 = Debug|Any CPU
- {BB6B58B5-3D61-4628-8C5E-9300011FA9BA}.Release|Any CPU.ActiveCfg = Release|Any CPU
- {BB6B58B5-3D61-4628-8C5E-9300011FA9BA}.Release|Any CPU.Build.0 = Release|Any CPU
- {03D35F0B-AA7E-41B6-BC74-3DF37BBC76B5}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
- {03D35F0B-AA7E-41B6-BC74-3DF37BBC76B5}.Debug|Any CPU.Build.0 = Debug|Any CPU
- {03D35F0B-AA7E-41B6-BC74-3DF37BBC76B5}.Release|Any CPU.ActiveCfg = Release|Any CPU
- {03D35F0B-AA7E-41B6-BC74-3DF37BBC76B5}.Release|Any CPU.Build.0 = Release|Any CPU
- EndGlobalSection
-EndGlobal
diff --git a/HelloWorld/HelloWorld.fsproj b/HelloWorld/HelloWorld.fsproj
new file mode 100644
index 0000000..dadc839
--- /dev/null
+++ b/HelloWorld/HelloWorld.fsproj
@@ -0,0 +1,12 @@
+
+
+
+ Exe
+ net9.0
+
+
+
+
+
+
+
diff --git a/WoofWare.DotnetRuntime.App/Program.fs b/HelloWorld/Program.fs
similarity index 56%
rename from WoofWare.DotnetRuntime.App/Program.fs
rename to HelloWorld/Program.fs
index fe82c7c..526e538 100644
--- a/WoofWare.DotnetRuntime.App/Program.fs
+++ b/HelloWorld/Program.fs
@@ -1,7 +1,9 @@
-namespace WoofWare.DotnetRuntime
+namespace HelloWorld
module Program =
- let reallyMain (argv : string[]) : int = 0
+ let reallyMain argv =
+ System.Console.WriteLine "Hello, world!"
+ 0
[]
let main argv =
diff --git a/WoofWare.DotnetRuntime/Domain.fs b/WoofWare.DotnetRuntime/Domain.fs
deleted file mode 100644
index f3a00e3..0000000
--- a/WoofWare.DotnetRuntime/Domain.fs
+++ /dev/null
@@ -1,3 +0,0 @@
-namespace WoofWare.DotnetRuntime
-
-type MsIlInstruction = | Something
diff --git a/WoofWare.DotnetRuntime/WoofWare.DotnetRuntime.fsproj b/WoofWare.DotnetRuntime/WoofWare.DotnetRuntime.fsproj
deleted file mode 100644
index 671dc8d..0000000
--- a/WoofWare.DotnetRuntime/WoofWare.DotnetRuntime.fsproj
+++ /dev/null
@@ -1,11 +0,0 @@
-
-
-
- net8.0
-
-
-
-
-
-
-
diff --git a/WoofWare.PawPrint.App/Program.fs b/WoofWare.PawPrint.App/Program.fs
new file mode 100644
index 0000000..cf02c7e
--- /dev/null
+++ b/WoofWare.PawPrint.App/Program.fs
@@ -0,0 +1,84 @@
+namespace WoofWare.PawPrint
+
+open System
+open System.Collections.Immutable
+open System.IO
+
+module Program =
+ /// Returns the pointer to the resulting array on the heap.
+ 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
+ // TODO: set the char values in memory
+ )
+
+ let arrayAllocation, state =
+ IlMachineState.Allocate
+ (ReferenceType.Array (args.Length, Type.ReferenceType ReferenceType.ManagedObject))
+ state
+ // TODO: set the length of the array
+
+ let state =
+ ((state, 0), argsAllocations)
+ ||> Seq.fold (fun (state, i) arg ->
+ let state =
+ IlMachineState.SetArrayValue arrayAllocation (CliObject.OfManagedObject arg) i state
+
+ state, i + 1
+ )
+ |> fst
+
+ arrayAllocation, state
+
+ let reallyMain (argv : string[]) : int =
+ match argv |> Array.toList with
+ | dllPath :: args ->
+ use fileStream = new FileStream (dllPath, FileMode.Open, FileAccess.Read)
+ let dumped = Assembly.read fileStream
+ let mainMethod = dumped.Methods.[dumped.MainMethod]
+
+ if mainMethod.Signature.GenericParameterCount > 0 then
+ failwith "Refusing to execute generic main method"
+
+ let state = IlMachineState.Initial
+
+ let arrayAllocation, state =
+ match mainMethod.Signature.ParameterTypes |> Seq.toList with
+ | [ TypeDefn.OneDimensionalArrayLowerBoundZero (TypeDefn.PrimitiveType PrimitiveType.String) ] ->
+ allocateArgs args state
+ | _ -> failwith "Main method must take an array of strings; other signatures not yet implemented"
+
+ match mainMethod.Signature.ReturnType with
+ | TypeDefn.PrimitiveType PrimitiveType.Int32 -> ()
+ | _ -> failwith "Main method must return int32; other types not currently supported"
+
+ let state, mainThread =
+ state
+ |> IlMachineState.AddThread
+ {
+ LocalVariables = ImmutableArray.Empty
+ IlOpIndex = 0
+ EvaluationStack = EvalStack.Empty
+ Arguments = ImmutableArray.Create (CliObject.OfManagedObject arrayAllocation)
+ ExecutingMethod = dumped.Methods.[dumped.MainMethod]
+ LocalMemoryPool = ()
+ ReturnState = None
+ }
+
+ let mutable state = state
+
+ while true do
+ state <- AbstractMachine.executeOneStep state dumped mainThread
+
+ 0
+ | _ ->
+ Console.Error.WriteLine "Supply exactly one DLL path"
+ 1
+
+ []
+ let main argv =
+ try
+ reallyMain argv
+ with _ ->
+ reraise ()
diff --git a/WoofWare.DotnetRuntime.App/WoofWare.DotnetRuntime.App.fsproj b/WoofWare.PawPrint.App/WoofWare.PawPrint.App.fsproj
similarity index 61%
rename from WoofWare.DotnetRuntime.App/WoofWare.DotnetRuntime.App.fsproj
rename to WoofWare.PawPrint.App/WoofWare.PawPrint.App.fsproj
index aa59b24..ebce71d 100644
--- a/WoofWare.DotnetRuntime.App/WoofWare.DotnetRuntime.App.fsproj
+++ b/WoofWare.PawPrint.App/WoofWare.PawPrint.App.fsproj
@@ -1,7 +1,7 @@
- net8.0
+ net9.0
Exe
@@ -10,7 +10,7 @@
-
+
diff --git a/WoofWare.DotnetRuntime.Test/TestThing.fs b/WoofWare.PawPrint.Test/TestThing.fs
similarity index 78%
rename from WoofWare.DotnetRuntime.Test/TestThing.fs
rename to WoofWare.PawPrint.Test/TestThing.fs
index 903fa55..c9e2100 100644
--- a/WoofWare.DotnetRuntime.Test/TestThing.fs
+++ b/WoofWare.PawPrint.Test/TestThing.fs
@@ -1,4 +1,4 @@
-namespace WoofWare.DotnetRuntime.Test
+namespace WoofWare.Pawprint.Test
open FsUnitTyped
open NUnit.Framework
diff --git a/WoofWare.DotnetRuntime.Test/WoofWare.DotnetRuntime.Test.fsproj b/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj
similarity index 89%
rename from WoofWare.DotnetRuntime.Test/WoofWare.DotnetRuntime.Test.fsproj
rename to WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj
index a643810..52bffd0 100644
--- a/WoofWare.DotnetRuntime.Test/WoofWare.DotnetRuntime.Test.fsproj
+++ b/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj
@@ -14,7 +14,7 @@
-
+
diff --git a/WoofWare.PawPrint.sln b/WoofWare.PawPrint.sln
new file mode 100644
index 0000000..b7caefa
--- /dev/null
+++ b/WoofWare.PawPrint.sln
@@ -0,0 +1,35 @@
+
+Microsoft Visual Studio Solution File, Format Version 12.00
+#
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.PawPrint", "WoofWare.PawPrint\WoofWare.PawPrint.fsproj", "{505F34FE-76ED-4E17-BDE4-C8A59848A4A3}"
+EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.PawPrint.App", "WoofWare.PawPrint.App\WoofWare.PawPrint.App.fsproj", "{D661BF46-97C1-458B-838B-77ED0378A1A9}"
+EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.PawPrint.Test", "WoofWare.PawPrint.Test\WoofWare.PawPrint.Test.fsproj", "{486548FC-E4CC-491E-98B9-D43AEB304C25}"
+EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "HelloWorld", "HelloWorld\HelloWorld.fsproj", "{E74D79B2-1C4D-4B21-BECB-83D361D54C02}"
+EndProject
+Global
+ GlobalSection(SolutionConfigurationPlatforms) = preSolution
+ Debug|Any CPU = Debug|Any CPU
+ Release|Any CPU = Release|Any CPU
+ EndGlobalSection
+ GlobalSection(ProjectConfigurationPlatforms) = postSolution
+ {505F34FE-76ED-4E17-BDE4-C8A59848A4A3}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+ {505F34FE-76ED-4E17-BDE4-C8A59848A4A3}.Debug|Any CPU.Build.0 = Debug|Any CPU
+ {505F34FE-76ED-4E17-BDE4-C8A59848A4A3}.Release|Any CPU.ActiveCfg = Release|Any CPU
+ {505F34FE-76ED-4E17-BDE4-C8A59848A4A3}.Release|Any CPU.Build.0 = Release|Any CPU
+ {D661BF46-97C1-458B-838B-77ED0378A1A9}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+ {D661BF46-97C1-458B-838B-77ED0378A1A9}.Debug|Any CPU.Build.0 = Debug|Any CPU
+ {D661BF46-97C1-458B-838B-77ED0378A1A9}.Release|Any CPU.ActiveCfg = Release|Any CPU
+ {D661BF46-97C1-458B-838B-77ED0378A1A9}.Release|Any CPU.Build.0 = Release|Any CPU
+ {486548FC-E4CC-491E-98B9-D43AEB304C25}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+ {486548FC-E4CC-491E-98B9-D43AEB304C25}.Debug|Any CPU.Build.0 = Debug|Any CPU
+ {486548FC-E4CC-491E-98B9-D43AEB304C25}.Release|Any CPU.ActiveCfg = Release|Any CPU
+ {486548FC-E4CC-491E-98B9-D43AEB304C25}.Release|Any CPU.Build.0 = Release|Any CPU
+ {E74D79B2-1C4D-4B21-BECB-83D361D54C02}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+ {E74D79B2-1C4D-4B21-BECB-83D361D54C02}.Debug|Any CPU.Build.0 = Debug|Any CPU
+ {E74D79B2-1C4D-4B21-BECB-83D361D54C02}.Release|Any CPU.ActiveCfg = Release|Any CPU
+ {E74D79B2-1C4D-4B21-BECB-83D361D54C02}.Release|Any CPU.Build.0 = Release|Any CPU
+ EndGlobalSection
+EndGlobal
diff --git a/WoofWare.PawPrint/AbstractMachine.fs b/WoofWare.PawPrint/AbstractMachine.fs
new file mode 100644
index 0000000..9327064
--- /dev/null
+++ b/WoofWare.PawPrint/AbstractMachine.fs
@@ -0,0 +1,386 @@
+namespace WoofWare.PawPrint
+
+open System.Collections.Immutable
+open Microsoft.FSharp.Core
+
+type ThreadId = | ThreadId of int
+
+type ManagedHeapAddress = | ManagedHeapAddress of int
+
+type EvalStackValue =
+ | Int32 of int32
+ | Int64 of int64
+ | NativeInt of int64
+ | Float of float
+ /// allowed to be null
+ | ManagedPointer of ManagedHeapAddress option
+ | ObjectRef of ManagedHeapAddress
+ | TransientPointer of int
+ | UserDefinedValueType
+
+type BasicCliObject =
+ /// Can be assigned the null value 0
+ | ObjectReference of ManagedHeapAddress option
+ | PointerType of unit option
+ | Int32 of int32
+ | Int64 of int64
+ | NativeInt of int64
+ | NativeFloat of float
+
+type CliObject =
+ private
+ | Basic of BasicCliObject
+ | Bool of byte
+ /// A UTF-16 code unit, i.e. two bytes. We store the most significant one first.
+ | Char of byte * byte
+ | UInt8 of uint8
+ | UInt16 of uint16
+ | Int8 of int8
+ | Int16 of int16
+ | Float32 of float32
+ | Float64 of float32
+
+ /// In fact any non-zero value will do for True, but we'll use 1
+ static member OfBool (b : bool) = CliObject.Bool (if b then 1uy else 0uy)
+
+ static member OfChar (c : char) =
+ CliObject.Char (byte (int c / 256), byte (int c % 256))
+
+ static member OfManagedObject (ptr : ManagedHeapAddress) =
+ CliObject.Basic (BasicCliObject.ObjectReference (Some ptr))
+
+type ReferenceType =
+ | String of string
+ | ManagedObject
+ | Array of len : int * containedType : Type
+
+ static member SizeOnHeap (r : ReferenceType) =
+ match r with
+ | ReferenceType.String s -> 2 * s.Length
+ | ReferenceType.ManagedObject -> 8
+ | ReferenceType.Array (len, ty) -> Type.SizeOf ty * len + 4 // for the len
+
+and Type =
+ | ReferenceType of ReferenceType
+ | ValueType
+
+ static member SizeOf (t : Type) : int =
+ match t with
+ | ReferenceType t -> ReferenceType.SizeOnHeap t
+ | ValueType -> failwith "todo"
+
+
+type EvalStack =
+ {
+ Values : EvalStackValue list
+ }
+
+ static member Empty : EvalStack =
+ {
+ Values = []
+ }
+
+ static member Push (v : CliObject) (stack : EvalStack) =
+ let v =
+ match v with
+ | CliObject.Basic (BasicCliObject.Int32 i) -> EvalStackValue.Int32 i
+ | CliObject.Basic (BasicCliObject.Int64 i) -> EvalStackValue.Int64 i
+ | CliObject.Basic (BasicCliObject.NativeInt i) -> failwith "TODO"
+ | CliObject.Basic (BasicCliObject.NativeFloat i) -> failwith "TODO"
+ | CliObject.Basic (BasicCliObject.ObjectReference i) -> EvalStackValue.ManagedPointer i
+ | CliObject.Basic (BasicCliObject.PointerType i) -> failwith "TODO"
+ // Zero-extend unsigned int8/unsigned int16/bool/char
+ | CliObject.Bool b -> int32 b |> EvalStackValue.Int32
+ | CliObject.Char (high, low) -> int32 high * 256 + int32 low |> EvalStackValue.Int32
+ | CliObject.UInt8 b -> int32 b |> EvalStackValue.Int32
+ | CliObject.UInt16 b -> int32 b |> EvalStackValue.Int32
+ // Sign-extend types int8 and int16
+ | CliObject.Int8 b -> int32 b |> EvalStackValue.Int32
+ | CliObject.Int16 b -> int32 b |> EvalStackValue.Int32
+ | Float32 f -> failwith "todo"
+ | Float64 f -> failwith "todo"
+
+ {
+ Values = v :: stack.Values
+ }
+
+type 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
+ /// 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
+ }
+
+ static member AdvanceProgramCounter (state : MethodState) =
+ { state with
+ IlOpIndex = state.IlOpIndex + 1
+ }
+
+ 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]
+ }
+
+type ThreadState =
+ {
+ // TODO: thread-local storage, synchronisation state, exception handling context
+ MethodState : MethodState
+ }
+
+ static member New (methodState : MethodState) =
+ {
+ MethodState = methodState
+ }
+
+type ManagedHeap =
+ {
+ /// We store the size of the allocation too.
+ Types : Map
+ Contents : ImmutableArray
+ FirstAvailableAddress : int
+ }
+
+ static member Empty : ManagedHeap =
+ {
+ Types = Map.empty
+ // We'll leave the null reference empty.
+ Contents = ImmutableArray.Create None
+ FirstAvailableAddress = 1
+ }
+
+ static member Allocate (ty : ReferenceType) (heap : ManagedHeap) : ManagedHeapAddress * ManagedHeap =
+ let size = ReferenceType.SizeOnHeap ty
+
+ assert (heap.Contents.Length = heap.FirstAvailableAddress)
+ let contents = heap.Contents.AddRange (Seq.replicate size None)
+
+ let heap =
+ {
+ FirstAvailableAddress = heap.FirstAvailableAddress + size
+ Types = heap.Types |> Map.add (ManagedHeapAddress heap.FirstAvailableAddress) (ty, size)
+ Contents = contents
+ }
+
+ ManagedHeapAddress heap.FirstAvailableAddress, heap
+
+ static member SetValue
+ (alloc : ManagedHeapAddress)
+ (offset : int)
+ (v : CliObject)
+ (heap : ManagedHeap)
+ : ManagedHeap
+ =
+ let ty, _ = heap.Types.[alloc]
+ let size = ReferenceType.SizeOnHeap ty
+ let (ManagedHeapAddress a) = alloc
+
+ let v =
+ match v with
+ | CliObject.Basic (BasicCliObject.ObjectReference o) ->
+ if size <> 8 then
+ failwith
+ $"precondition failed! trying to write mismatched size 8 to array whose elements are size %i{size}"
+
+ match o with
+ | None -> Array.replicate 8 (Some 0uy)
+ | Some (ManagedHeapAddress ptr) -> System.BitConverter.GetBytes (uint64 ptr) |> Array.map Some
+ | _ -> failwith $"TODO: %O{v}"
+
+ { heap with
+ Contents = heap.Contents.RemoveRange(a + offset, size).InsertRange (a + offset, v)
+ }
+
+type IlMachineState =
+ {
+ NextThreadId : int
+ EvalStacks : Map
+ // CallStack : StackFrame list
+ /// Multiple managed heaps are allowed, but we hopefully only need one.
+ ManagedHeap : ManagedHeap
+ ThreadState : Map
+ }
+
+ static member Initial : IlMachineState =
+ {
+ NextThreadId = 0
+ EvalStacks = Map.empty
+ // CallStack = []
+ ManagedHeap = ManagedHeap.Empty
+ ThreadState = Map.empty
+ }
+
+ static member AddThread (newThreadState : MethodState) (state : IlMachineState) : IlMachineState * ThreadId =
+ let thread = ThreadId state.NextThreadId
+
+ let newState =
+ {
+ 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)
+ }
+
+ newState, thread
+
+ static member Allocate (o : ReferenceType) (state : IlMachineState) : ManagedHeapAddress * IlMachineState =
+ let alloc, heap = ManagedHeap.Allocate o state.ManagedHeap
+
+ alloc,
+ { state with
+ ManagedHeap = heap
+ }
+
+ static member SetArrayValue
+ (arrayAllocation : ManagedHeapAddress)
+ (v : CliObject)
+ (index : int)
+ (state : IlMachineState)
+ : IlMachineState
+ =
+ // TODO: actually we need to skip the first four bytes because they hold the length
+ let heap = ManagedHeap.SetValue arrayAllocation index v state.ManagedHeap
+
+ { state with
+ ManagedHeap = heap
+ }
+
+ static member AdvanceProgramCounter (thread : ThreadId) (state : IlMachineState) : IlMachineState =
+ { state with
+ ThreadState =
+ state.ThreadState
+ |> Map.change
+ thread
+ (fun state ->
+ match state with
+ | None -> failwith "expected state"
+ | Some (state : ThreadState) ->
+ { state with
+ MethodState = state.MethodState |> MethodState.AdvanceProgramCounter
+ }
+ |> Some
+ )
+ }
+
+ static member LoadArgument (thread : ThreadId) (index : int) (state : IlMachineState) : IlMachineState =
+ { state with
+ ThreadState =
+ state.ThreadState
+ |> Map.change
+ thread
+ (fun state ->
+ match state with
+ | None -> failwith "expected state"
+ | Some state ->
+ { state with
+ MethodState = state.MethodState |> MethodState.LoadArgument index
+ }
+ |> Some
+ )
+ }
+
+[]
+module AbstractMachine =
+ let internal executeNullary
+ (state : IlMachineState)
+ (currentThread : ThreadId)
+ (dumped : DumpedAssembly)
+ (op : NullaryIlOp)
+ : IlMachineState
+ =
+ match op with
+ | Nop -> state |> IlMachineState.AdvanceProgramCounter currentThread
+ | LdArg0 ->
+ state
+ |> IlMachineState.LoadArgument currentThread 0
+ |> IlMachineState.AdvanceProgramCounter currentThread
+ | LdArg1 ->
+ state
+ |> IlMachineState.LoadArgument currentThread 1
+ |> IlMachineState.AdvanceProgramCounter currentThread
+ | LdArg2 ->
+ state
+ |> IlMachineState.LoadArgument currentThread 2
+ |> IlMachineState.AdvanceProgramCounter currentThread
+ | LdArg3 ->
+ state
+ |> IlMachineState.LoadArgument currentThread 3
+ |> IlMachineState.AdvanceProgramCounter currentThread
+ | Ldloc_0 -> failwith "todo"
+ | Ldloc_1 -> failwith "todo"
+ | Ldloc_2 -> failwith "todo"
+ | Ldloc_3 -> failwith "todo"
+ | Pop -> failwith "todo"
+ | Dup -> failwith "todo"
+ | Ret -> failwith "todo"
+ | LdcI4_0 -> failwith "todo"
+ | LdcI4_1 -> failwith "todo"
+ | LdcI4_2 -> failwith "todo"
+ | LdcI4_3 -> failwith "todo"
+ | LdcI4_4 -> failwith "todo"
+ | LdcI4_5 -> failwith "todo"
+ | LdcI4_6 -> failwith "todo"
+ | LdcI4_7 -> failwith "todo"
+ | LdcI4_8 -> failwith "todo"
+ | LdcI4_m1 -> failwith "todo"
+ | LdNull -> failwith "todo"
+ | Ceq -> failwith "todo"
+ | Cgt -> failwith "todo"
+ | Cgt_un -> failwith "todo"
+ | Clt -> failwith "todo"
+ | Clt_un -> failwith "todo"
+ | Stloc_0 -> failwith "todo"
+ | Stloc_1 -> failwith "todo"
+ | Stloc_2 -> failwith "todo"
+ | Stloc_3 -> failwith "todo"
+ | Sub -> failwith "todo"
+ | Sub_ovf -> failwith "todo"
+ | Sub_ovf_un -> failwith "todo"
+ | Add -> failwith "todo"
+ | Add_ovf -> failwith "todo"
+ | Add_ovf_un -> failwith "todo"
+ | Mul -> failwith "todo"
+ | Mul_ovf -> failwith "todo"
+ | Mul_ovf_un -> failwith "todo"
+ | Div -> failwith "todo"
+ | Div_un -> failwith "todo"
+ | Shr -> failwith "todo"
+ | Shr_un -> failwith "todo"
+ | Shl -> failwith "todo"
+ | And -> failwith "todo"
+ | Or -> failwith "todo"
+ | Xor -> failwith "todo"
+ | Conv_I -> failwith "todo"
+ | Conv_I1 -> failwith "todo"
+ | Conv_I2 -> failwith "todo"
+ | Conv_I4 -> failwith "todo"
+ | Conv_I8 -> failwith "todo"
+ | Conv_R4 -> failwith "todo"
+ | Conv_R8 -> failwith "todo"
+ | Conv_U -> failwith "todo"
+ | Conv_U1 -> failwith "todo"
+ | Conv_U2 -> failwith "todo"
+ | Conv_U4 -> failwith "todo"
+ | Conv_U8 -> failwith "todo"
+ | LdLen -> failwith "todo"
+ | Endfilter -> failwith "todo"
+ | Endfinally -> failwith "todo"
+ | Rethrow -> failwith "todo"
+ | Throw -> failwith "todo"
+
+ let executeOneStep (state : IlMachineState) (dumped : DumpedAssembly) (thread : ThreadId) : IlMachineState =
+ let instruction = state.ThreadState.[thread].MethodState
+
+ match instruction.ExecutingMethod.Locations.[instruction.IlOpIndex] with
+ | IlOp.Nullary op -> executeNullary state thread dumped op
+ | UnaryConst unaryConstIlOp -> failwith "todo"
+ | UnaryMetadataToken (unaryMetadataTokenIlOp, bytes) -> failwith "todo"
+ | Switch immutableArray -> failwith "todo"
diff --git a/WoofWare.PawPrint/Assembly.fs b/WoofWare.PawPrint/Assembly.fs
new file mode 100644
index 0000000..d7013b3
--- /dev/null
+++ b/WoofWare.PawPrint/Assembly.fs
@@ -0,0 +1,59 @@
+namespace WoofWare.PawPrint
+
+open System
+open System.Collections.Generic
+open System.Collections.Immutable
+open System.IO
+open System.Reflection.Metadata
+open System.Reflection.Metadata.Ecma335
+open System.Reflection.PortableExecutable
+open Microsoft.FSharp.Core
+
+type DumpedAssembly =
+ {
+ Types : TypeInfo list
+ Methods : IReadOnlyDictionary
+ MainMethod : MethodDefinitionHandle
+ }
+
+[]
+module Assembly =
+ let read (dllBytes : Stream) : DumpedAssembly =
+ use peReader = new PEReader (dllBytes)
+ let metadataReader = peReader.GetMetadataReader ()
+
+ let entryPoint =
+ peReader.PEHeaders.CorHeader.EntryPointTokenOrRelativeVirtualAddress
+ |> fun x -> if x = 0 then failwith "No entry point" else x
+
+ let entryPointMethod = MetadataTokens.MethodDefinitionHandle entryPoint
+
+ let result =
+ metadataReader.TypeDefinitions
+ |> Seq.map (TypeInfo.read peReader metadataReader)
+ |> Seq.toList
+
+ let methods =
+ result
+ |> List.collect (fun ty -> ty.Methods |> List.map (fun mi -> KeyValuePair (mi.Handle, mi)))
+ |> ImmutableDictionary.CreateRange
+
+ {
+ Types = result
+ MainMethod = entryPointMethod
+ Methods = methods
+ }
+
+ let print (main : MethodDefinitionHandle) (dumped : DumpedAssembly) : unit =
+ for typ in dumped.Types do
+ printfn "\nType: %s.%s" typ.Namespace typ.Name
+
+ for method in typ.Methods do
+ if method.Handle = main then
+ printfn "Entry point!"
+
+ printfn "\nMethod: %s" method.Name
+
+ method.Instructions
+ |> List.map (fun (op, index) -> IlOp.Format op index)
+ |> List.iter Console.WriteLine
diff --git a/WoofWare.PawPrint/BitTwiddling.fs b/WoofWare.PawPrint/BitTwiddling.fs
new file mode 100644
index 0000000..4594815
--- /dev/null
+++ b/WoofWare.PawPrint/BitTwiddling.fs
@@ -0,0 +1,19 @@
+namespace WoofWare.PawPrint
+
+open System
+
+[]
+module internal BitTwiddling =
+
+ let inline toUint32 (bytes : ReadOnlySpan) : uint32 =
+ uint32 bytes.[0]
+ + uint32 bytes.[1] * 256u
+ + uint32 bytes.[2] * 256u * 256u
+ + uint32 bytes.[3] * 256u * 256u * 256u
+
+ let inline toUint16 (bytes : ReadOnlySpan) : uint16 =
+ uint16 bytes.[0] + uint16 bytes.[1] * 256us
+
+ let inline toUint64 (bytes : ReadOnlySpan) : uint64 =
+ uint64 (toUint32 (bytes.Slice (0, 4)))
+ + 0x10000UL * uint64 (toUint32 (bytes.Slice (4, 4)))
diff --git a/WoofWare.PawPrint/Executable.fs b/WoofWare.PawPrint/Executable.fs
new file mode 100644
index 0000000..a721a3a
--- /dev/null
+++ b/WoofWare.PawPrint/Executable.fs
@@ -0,0 +1,599 @@
+namespace WoofWare.PawPrint
+
+open System
+open System.Text
+
+type MsIlInstruction = | Something
+
+type Characteristics =
+ {
+ Is32BitMachine : bool
+ IsFileDll : bool
+ }
+
+ static member Parse (b : ReadOnlySpan) : Characteristics option =
+ if b.[0] &&& 0x1uy <> 0uy then
+ None
+ elif b.[0] &&& 0x2uy <> 0x2uy then
+ None
+ else
+
+ {
+ Is32BitMachine = b.[1] &&& 0x1uy = 1uy
+ IsFileDll = b.[1] &&& 0x20uy = 0x20uy
+ }
+ |> Some
+
+type PeHeaderStandardFields =
+ {
+ CodeSize : uint32
+ LMajor : byte
+ LMinor : byte
+ InitialisedDataSize : uint32
+ UninitialisedDataSize : uint32
+ EntryPointRva : uint32
+ BaseOfCode : uint32
+ BaseOfData : uint32
+ }
+
+ static member Parse (b : ReadOnlySpan) : PeHeaderStandardFields option =
+ if toUint16 (b.Slice (0, 2)) <> 0x10bus then
+ None
+ else
+
+ let lMajor = b.[2]
+ let lMinor = b.[3]
+ let codeSize = toUint32 (b.Slice (4, 4))
+ let initialisedDataSize = toUint32 (b.Slice (8, 4))
+ let uninitialisedDataSize = toUint32 (b.Slice (12, 4))
+ let entryPointRva = toUint32 (b.Slice (16, 4))
+ let baseOfCode = toUint32 (b.Slice (20, 4))
+ let baseOfData = toUint32 (b.Slice (24, 4))
+
+ {
+ CodeSize = codeSize
+ InitialisedDataSize = initialisedDataSize
+ UninitialisedDataSize = uninitialisedDataSize
+ EntryPointRva = entryPointRva
+ BaseOfCode = baseOfCode
+ BaseOfData = baseOfData
+ LMajor = lMajor
+ LMinor = lMinor
+ }
+ |> Some
+
+type WindowsSubsystem =
+ | Cui
+ | Gui
+
+ static member Parse (b : byte) : WindowsSubsystem option =
+ if b = 3uy then WindowsSubsystem.Cui |> Some
+ elif b = 2uy then WindowsSubsystem.Gui |> Some
+ else None
+
+type PeHeaderNtSpecificFields =
+ {
+ ImageBase : uint32
+ SectionAlignment : uint32
+ ImageSize : uint32
+ HeaderSize : uint32
+ WindowsSubsystem : WindowsSubsystem
+ }
+
+ static member Parse (b : ReadOnlySpan) : PeHeaderNtSpecificFields option =
+ let imageBase = toUint32 (b.Slice (0, 4))
+ let sectionAlignment = toUint32 (b.Slice (4, 4))
+ let fileAlignment = toUint32 (b.Slice (8, 4))
+
+ if sectionAlignment <= fileAlignment then
+ None
+ else if
+
+ //if toUint16 (b.Slice (12, 2)) <> 5us then
+ // None
+ toUint16 (b.Slice (14, 2)) <> 0us
+ then
+ None
+ elif toUint16 (b.Slice (16, 2)) <> 0us then
+ None
+ elif toUint16 (b.Slice (18, 2)) <> 0us then
+ None
+ //elif toUint16 (b.Slice (20, 2)) <> 5us then
+ // None
+ elif toUint16 (b.Slice (22, 2)) <> 0us then
+ None
+ elif toUint32 (b.Slice (24, 4)) <> 0u then
+ None
+ else
+
+ let imageSize = toUint32 (b.Slice (28, 4))
+
+ if imageSize % fileAlignment <> 0u then
+ None
+ else
+
+ let headerSize = toUint32 (b.Slice (32, 4))
+
+ if headerSize % fileAlignment <> 0u then
+ None
+ else if toUint32 (b.Slice (36, 4)) <> 0u then
+ None
+ else if b.[41] <> 0uy then
+ None
+ else
+
+ match WindowsSubsystem.Parse b.[40] with
+ | None -> None
+ | Some windowsSubsystem ->
+
+ //if toUint32 (b.Slice (42, 4)) <> 0x100000u then
+ // None
+ //elif toUint32 (b.Slice (46, 4)) <> 0x1000u then
+ // None
+ //elif toUint32 (b.Slice (52, 4)) <> 0x100000u then
+ // None
+ //elif toUint32 (b.Slice (56, 4)) <> 0x1000u then
+ // None
+ if toUint32 (b.Slice (60, 4)) <> 0u then
+ None
+ elif toUint32 (b.Slice (64, 4)) <> 0x10u then
+ None
+ else
+ // TODO: DLL Flags, II.25.2.3.2
+
+ {
+ ImageBase = imageBase
+ SectionAlignment = sectionAlignment
+ ImageSize = imageSize
+ HeaderSize = headerSize
+ WindowsSubsystem = windowsSubsystem
+ }
+ |> Some
+
+type SectionCharacteristics =
+ {
+ Code : bool
+ Initialised : bool
+ Uninitialised : bool
+ ExecutedAsCode : bool
+ Readable : bool
+ Writable : bool
+ }
+
+ static member Parse (b : ReadOnlySpan) : SectionCharacteristics =
+ assert (b.Length = 4)
+ let code = b[0] &&& 0x20uy = 0x20uy
+ let initialised = b[0] &&& 0x40uy = 0x40uy
+ let uninitialised = b[0] &&& 0x80uy = 0x80uy
+ let executable = b[3] &&& 0x20uy = 0x20uy
+ let readable = b[3] &&& 0x40uy = 0x40uy
+ let writable = b[3] &&& 0x80uy = 0x80uy
+
+ {
+ Code = code
+ Initialised = initialised
+ Uninitialised = uninitialised
+ ExecutedAsCode = executable
+ Readable = readable
+ Writable = writable
+ }
+
+type SectionHeader =
+ {
+ Name : string
+ VirtualSize : uint32
+ VirtualAddress : uint32
+ SizeOfRawData : uint32
+ PointerToRawData : uint32
+ Characteristics : SectionCharacteristics
+ }
+
+ static member Parse (b : ReadOnlySpan) : SectionHeader option =
+ assert (b.Length = 40)
+ let name = Encoding.ASCII.GetString (b.Slice (0, 8)) |> fun s -> s.TrimEnd (char 0)
+ let virtualSize = toUint32 (b.Slice (8, 4))
+ let virtualAddress = toUint32 (b.Slice (12, 4))
+ let sizeOfRawData = toUint32 (b.Slice (16, 4))
+ let pointerToRawData = toUint32 (b.Slice (20, 4))
+
+ if toUint32 (b.Slice (24, 4)) <> 0u then
+ None
+ elif toUint32 (b.Slice (28, 4)) <> 0u then
+ None
+ elif toUint16 (b.Slice (32, 2)) <> 0us then
+ None
+ elif toUint16 (b.Slice (34, 2)) <> 0us then
+ None
+ else
+
+ let characteristics = SectionCharacteristics.Parse (b.Slice (36, 4))
+
+ {
+ Name = name
+ VirtualSize = virtualSize
+ VirtualAddress = virtualAddress
+ SizeOfRawData = sizeOfRawData
+ PointerToRawData = pointerToRawData
+ Characteristics = characteristics
+ }
+ |> Some
+
+type RvaAndSize =
+ {
+ Rva : uint32
+ BlockSize : uint32
+ }
+
+ static member Parse (b : ReadOnlySpan) : RvaAndSize =
+ {
+ Rva = toUint32 (b.Slice (0, 4))
+ BlockSize = toUint32 (b.Slice (4, 4))
+ }
+
+type CliRuntimeFlags =
+ {
+ Requires32Bit : bool
+ HasStrongNameSig : bool
+ }
+
+ static member Parse (b : ReadOnlySpan) : CliRuntimeFlags option =
+ if b.[0] &&& 1uy <> 1uy then
+ None
+ elif b.[0] &&& 0x10uy <> 0x10uy then
+ None
+ elif b.[2] &&& 1uy <> 1uy then
+ None
+ else
+
+ {
+ Requires32Bit = b.[0] &&& 2uy = 2uy
+ HasStrongNameSig = b.[0] &&& 8uy = 8uy
+ }
+ |> Some
+
+type CliHeader =
+ {
+ SizeInBytes : uint32
+ MajorRuntimeMinVersion : uint16
+ MinorRuntimeMinVersion : uint16
+ Metadata : RvaAndSize
+ Flags : CliRuntimeFlags
+ EntryPointToken : unit
+ Resources : RvaAndSize
+ StrongNameSignature : RvaAndSize
+ VTableFixups : RvaAndSize
+ }
+
+ static member Parse (b : ReadOnlySpan) : CliHeader option =
+ let sizeInBytes = toUint32 (b.Slice (0, 2))
+ let majorVersion = toUint16 (b.Slice (4, 2))
+ let minorVersion = toUint16 (b.Slice (6, 2))
+ let metadata = RvaAndSize.Parse (b.Slice (8, 8))
+
+ match CliRuntimeFlags.Parse (b.Slice (16, 4)) with
+ | None -> None
+ | Some flags ->
+
+ let entryPointToken = () //(b.Slice (20, 4))
+ let resources = RvaAndSize.Parse (b.Slice (24, 8))
+ let strongNameSignature = RvaAndSize.Parse (b.Slice (32, 8))
+
+ if toUint64 (b.Slice (40, 8)) <> 0UL then
+ None
+ else
+
+ let vTableFixups = RvaAndSize.Parse (b.Slice (48, 8))
+
+ if toUint64 (b.Slice (56, 8)) <> 0UL then
+ None
+ elif toUint64 (b.Slice (64, 8)) <> 0UL then
+ None
+ else
+
+ {
+ SizeInBytes = sizeInBytes
+ MajorRuntimeMinVersion = majorVersion
+ MinorRuntimeMinVersion = minorVersion
+ Metadata = metadata
+ Flags = flags
+ EntryPointToken = entryPointToken
+ Resources = resources
+ StrongNameSignature = strongNameSignature
+ VTableFixups = vTableFixups
+ }
+ |> Some
+
+type DataDirectories =
+ {
+ ImportTable : RvaAndSize
+ RelocationTable : RvaAndSize option
+ ImportAddressTable : RvaAndSize
+ CliHeader : RvaAndSize
+ }
+
+ static member Parse (b : ReadOnlySpan) : DataDirectories option =
+ // Ignore the export table
+ // if toUint64 (b.Slice (0, 8)) <> 0UL then
+ // None
+ // else
+ let importTable = RvaAndSize.Parse (b.Slice (8, 8))
+ // Ignore the resource table, exception table, certificate table
+ // if toUint64 (b.Slice (16, 8)) <> 0UL then
+ // None
+ // elif toUint64 (b.Slice (24, 8)) <> 0UL then
+ // None
+ // elif toUint64 (b.Slice (32, 8)) <> 0UL then
+ // None
+ // else
+ let relocationTable =
+ if toUint64 (b.Slice (40, 8)) = 0UL then
+ None
+ else
+ Some (RvaAndSize.Parse (b.Slice (40, 8)))
+ // Ignore the debug, copyright, global ptr, tls table, laod config table, bound import
+ // if toUint64 (b.Slice (48, 8)) <> 0UL then
+ // None
+ // elif toUint64 (b.Slice (56, 8)) <> 0UL then
+ // None
+ // elif toUint64 (b.Slice (64, 8)) <> 0UL then
+ // None
+ // elif toUint64 (b.Slice (72, 8)) <> 0UL then
+ // None
+ // elif toUint64 (b.Slice (80, 8)) <> 0UL then
+ // None
+ // elif toUint64 (b.Slice (88, 8)) <> 0UL then
+ // None
+ // else
+ let iat = RvaAndSize.Parse (b.Slice (96, 8))
+ // Ignore the delay import descriptor
+ // if toUint64 (b.Slice (104, 8)) <> 0UL then
+ // None
+ // else
+ let cliHeader = RvaAndSize.Parse (b.Slice (112, 8))
+
+ if toUint64 (b.Slice (120, 8)) <> 0UL then
+ None
+ else
+
+ {
+ ImportTable = importTable
+ RelocationTable = relocationTable
+ ImportAddressTable = iat
+ CliHeader = cliHeader
+ }
+ |> Some
+
+type PeOptionalHeader =
+ {
+ StandardFields : PeHeaderStandardFields
+ NtSpecificFields : PeHeaderNtSpecificFields
+ DataDirectories : DataDirectories
+ }
+
+ static member Parse (b : ReadOnlySpan) : PeOptionalHeader option =
+ match PeHeaderStandardFields.Parse (b.Slice (0, 28)) with
+ | None -> None
+ | Some standard ->
+
+ match PeHeaderNtSpecificFields.Parse (b.Slice (28, 68)) with
+ | None -> None
+ | Some nt ->
+
+ match DataDirectories.Parse (b.Slice (96, 128)) with
+ | None -> None
+ | Some dd ->
+
+ {
+ StandardFields = standard
+ NtSpecificFields = nt
+ DataDirectories = dd
+ }
+ |> Some
+
+type MsAssembly =
+ {
+ PEOffset : uint32
+ NumberOfSections : uint16
+ CreationDate : DateTime
+ OptionalHeaderSize : uint16
+ Characteristics : Characteristics
+ OptionalHeader : PeOptionalHeader
+ }
+
+[]
+module MsAssembly =
+
+ let private msdosHeader1 : byte[] =
+ [|
+ 0x4d
+ 0x5a
+ 0x90
+ 0
+ 3
+ 0
+ 0
+ 0
+ 4
+ 0
+ 0
+ 0
+ 0xff
+ 0xff
+ 0
+ 0
+ 0xb8
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0x40
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ |]
+ |> Array.map byte
+
+ let private msdosHeader2 : byte[] =
+ [|
+ 0xe
+ 0x1f
+ 0xba
+ 0x0e
+ 0
+ 0xb4
+ 9
+ 0xcd
+ 0x21
+ 0xb8
+ 1
+ 0x4c
+ 0xcd
+ 0x21
+ 0x54
+ 0x68
+ 0x69
+ 0x73
+ 0x20
+ 0x70
+ 0x72
+ 0x6f
+ 0x67
+ 0x72
+ 0x61
+ 0x6d
+ 0x20
+ 0x63
+ 0x61
+ 0x6e
+ 0x6e
+ 0x6f
+ 0x74
+ 0x20
+ 0x62
+ 0x65
+ 0x20
+ 0x72
+ 0x75
+ 0x6e
+ 0x20
+ 0x69
+ 0x6e
+ 0x20
+ 0x44
+ 0x4f
+ 0x53
+ 0x20
+ 0x6d
+ 0x6f
+ 0x64
+ 0x65
+ 0x2e
+ 0x0d
+ 0x0d
+ 0x0a
+ 0x24
+ 0x00
+ 0x00
+ 0x00
+ 0x00
+ 0x00
+ 0x00
+ 0x00
+ |]
+ |> Array.map byte
+
+ let parse (bytes : byte[]) : MsAssembly option =
+ let bytes : ReadOnlySpan = Span.op_Implicit (bytes.AsSpan ())
+
+ if not (MemoryExtensions.SequenceEqual (bytes.Slice (0, 60), msdosHeader1)) then
+ None
+ else
+
+ let peOffset = toUint32 (bytes.Slice (60, 4))
+
+ if not (MemoryExtensions.SequenceEqual (bytes.Slice (64, 64), msdosHeader2)) then
+ None
+ else if
+
+ not (MemoryExtensions.SequenceEqual (bytes.Slice (int peOffset, 2), "PE"B))
+ then
+ None
+ else if
+
+ not (MemoryExtensions.SequenceEqual (bytes.Slice (int peOffset + 2, 2), [| 0uy ; 0uy |]))
+ then
+ None
+ else
+
+ let peOffset = peOffset + 4u
+
+ let numberOfSections = toUint16 (bytes.Slice (int (peOffset + 2u), 2))
+
+ let creationDate =
+ DateTime.UnixEpoch.AddSeconds (toUint32 (bytes.Slice (int (peOffset + 4u), 4)) |> float)
+
+ if
+ not (
+ MemoryExtensions.SequenceEqual (
+ bytes.Slice (int peOffset + 8, 8),
+ [| 0uy ; 0uy ; 0uy ; 0uy ; 0uy ; 0uy ; 0uy ; 0uy |]
+ )
+ )
+ then
+ None
+ else
+
+ let optionalHeaderSize = toUint16 (bytes.Slice (int (peOffset + 16u), 2))
+
+ match Characteristics.Parse (bytes.Slice (int (peOffset + 18u), 2)) with
+ | None -> None
+ | Some characteristics ->
+
+ match PeOptionalHeader.Parse (bytes.Slice (int (peOffset + 20u), int optionalHeaderSize)) with
+ | None -> None
+ | Some optionalHeader ->
+
+ {
+ PEOffset = peOffset - 4u
+ NumberOfSections = numberOfSections
+ CreationDate = creationDate
+ Characteristics = characteristics
+ OptionalHeaderSize = optionalHeaderSize
+ OptionalHeader = optionalHeader
+ }
+ |> Some
diff --git a/WoofWare.PawPrint/IlOp.fs b/WoofWare.PawPrint/IlOp.fs
new file mode 100644
index 0000000..b8766f4
--- /dev/null
+++ b/WoofWare.PawPrint/IlOp.fs
@@ -0,0 +1,138 @@
+namespace WoofWare.PawPrint
+
+open System.Collections.Immutable
+
+type NullaryIlOp =
+ | Nop
+ | LdArg0
+ | LdArg1
+ | LdArg2
+ | LdArg3
+ | Ldloc_0
+ | Ldloc_1
+ | Ldloc_2
+ | Ldloc_3
+ | Pop
+ | Dup
+ | Ret
+ | LdcI4_0
+ | LdcI4_1
+ | LdcI4_2
+ | LdcI4_3
+ | LdcI4_4
+ | LdcI4_5
+ | LdcI4_6
+ | LdcI4_7
+ | LdcI4_8
+ | LdcI4_m1
+ | LdNull
+ | Ceq
+ | Cgt
+ | Cgt_un
+ | Clt
+ | Clt_un
+ | Stloc_0
+ | Stloc_1
+ | Stloc_2
+ | Stloc_3
+ | Sub
+ | Sub_ovf
+ | Sub_ovf_un
+ | Add
+ | Add_ovf
+ | Add_ovf_un
+ | Mul
+ | Mul_ovf
+ | Mul_ovf_un
+ | Div
+ | Div_un
+ | Shr
+ | Shr_un
+ | Shl
+ | And
+ | Or
+ | Xor
+ | Conv_I
+ | Conv_I1
+ | Conv_I2
+ | Conv_I4
+ | Conv_I8
+ | Conv_R4
+ | Conv_R8
+ | Conv_U
+ | Conv_U1
+ | Conv_U2
+ | Conv_U4
+ | Conv_U8
+ | LdLen
+ | Endfilter
+ | Endfinally
+ | Rethrow
+ | Throw
+
+type UnaryConstIlOp =
+ | Stloc of uint16
+ | Stloc_s of int8
+ | Ldc_I8 of int64
+ | Ldc_I4 of int32
+ | Ldc_I4_s of int8
+ | Br of int32
+ | Br_s of int8
+ | Brfalse_s of int8
+ | Brtrue_s of int8
+ | Brfalse of int32
+ | Brtrue of int32
+ | Beq_s of int8
+ | Blt_s of int8
+ | Ble_s of int8
+ | Bgt_s of int8
+ | Bge_s of int8
+ | Bne_un_s of int8
+ | Bge_un_s of int8
+ | Bgt_un_s of int8
+ | Ble_un_s of int8
+ | Blt_un_s of int8
+ | Bne_un of int32
+ | Bge_un of int32
+ | Bgt_un of int32
+ | Ble_un of int32
+ | Blt_un of int32
+ | Ldloc_s of uint8
+ | Ldloca_s of uint8
+ | Ldarga of uint16
+ | Ldarg_s of uint8
+ | Ldarga_s of uint8
+ | Leave of int32
+ | Leave_s of int8
+ | Starg_s of uint8
+ | Starg of uint16
+
+type UnaryMetadataTokenIlOp =
+ | Call
+ | Callvirt
+ | Castclass
+ | Newobj
+ | Newarr
+ | Box
+ | Ldelema
+ | Isinst
+ | Stfld
+ | Stsfld
+ | Ldfld
+ | Ldflda
+ | Ldsfld
+ | Ldstr
+ | Unbox_Any
+ | Stelem
+ | Ldelem
+
+/// A four-byte metadata token.
+type MetadataToken = byte[]
+
+type IlOp =
+ | Nullary of NullaryIlOp
+ | UnaryConst of UnaryConstIlOp
+ | UnaryMetadataToken of UnaryMetadataTokenIlOp * MetadataToken
+ | Switch of int32 ImmutableArray
+
+ static member Format (opCode : IlOp) (offset : int) : string = $" IL_%04X{offset}: %-20O{opCode}"
diff --git a/WoofWare.PawPrint/TypeInfo.fs b/WoofWare.PawPrint/TypeInfo.fs
new file mode 100644
index 0000000..3f7cd52
--- /dev/null
+++ b/WoofWare.PawPrint/TypeInfo.fs
@@ -0,0 +1,529 @@
+namespace WoofWare.PawPrint
+
+#nowarn "9"
+
+open System
+open System.Collections.Immutable
+open System.Reflection.Metadata
+open System.Reflection.Metadata.Ecma335
+open System.Reflection.PortableExecutable
+open Microsoft.FSharp.Core
+
+type Parameter =
+ {
+ Name : string
+ DefaultValue : Constant
+ SequenceNumber : int
+ }
+
+type GenericParameter =
+ {
+ Name : string
+ SequenceNumber : int
+ }
+
+type TypeMethodSignature<'Types> =
+ {
+ Header : SignatureHeader
+ ParameterTypes : ImmutableArray<'Types>
+ GenericParameterCount : int
+ RequiredParameterCount : int
+ ReturnType : 'Types
+ }
+
+[]
+module TypeMethodSignature =
+ let make<'T> (p : MethodSignature<'T>) : TypeMethodSignature<'T> =
+ {
+ Header = p.Header
+ ReturnType = p.ReturnType
+ ParameterTypes = p.ParameterTypes
+ GenericParameterCount = p.GenericParameterCount
+ RequiredParameterCount = p.RequiredParameterCount
+ }
+
+type PrimitiveType =
+ | Void
+ | Boolean
+ | Char
+ | SByte
+ | Byte
+ | Int16
+ | UInt16
+ | Int32
+ | UInt32
+ | Int64
+ | UInt64
+ | Single
+ | Double
+ | String
+ | TypedReference
+ | IntPtr
+ | UIntPtr
+ | Object
+
+ static member OfEnum (ptc : PrimitiveTypeCode) : PrimitiveType =
+ match ptc with
+ | PrimitiveTypeCode.Void -> PrimitiveType.Void
+ | PrimitiveTypeCode.Boolean -> PrimitiveType.Boolean
+ | PrimitiveTypeCode.Char -> PrimitiveType.Char
+ | PrimitiveTypeCode.SByte -> PrimitiveType.SByte
+ | PrimitiveTypeCode.Byte -> PrimitiveType.Byte
+ | PrimitiveTypeCode.Int16 -> PrimitiveType.Int16
+ | PrimitiveTypeCode.UInt16 -> PrimitiveType.UInt16
+ | PrimitiveTypeCode.Int32 -> PrimitiveType.Int32
+ | PrimitiveTypeCode.UInt32 -> PrimitiveType.UInt32
+ | PrimitiveTypeCode.Int64 -> PrimitiveType.Int64
+ | PrimitiveTypeCode.UInt64 -> PrimitiveType.UInt64
+ | PrimitiveTypeCode.Single -> PrimitiveType.Single
+ | PrimitiveTypeCode.Double -> PrimitiveType.Double
+ | PrimitiveTypeCode.String -> PrimitiveType.String
+ | PrimitiveTypeCode.TypedReference -> PrimitiveType.TypedReference
+ | PrimitiveTypeCode.IntPtr -> PrimitiveType.IntPtr
+ | PrimitiveTypeCode.UIntPtr -> PrimitiveType.UIntPtr
+ | PrimitiveTypeCode.Object -> PrimitiveType.Object
+ | x -> failwithf $"Unrecognised primitive type code: %O{x}"
+
+type TypeDefn =
+ | PrimitiveType of PrimitiveType
+ | Pinned of TypeDefn
+ | Pointer of TypeDefn
+ | Byref of TypeDefn
+ | OneDimensionalArrayLowerBoundZero of elements : TypeDefn
+ | Modified of original : TypeDefn * afterMod : TypeDefn * modificationRequired : bool
+ | FromReference of SignatureTypeKind
+ | FromDefinition of SignatureTypeKind
+ | GenericInstantiation of generic : TypeDefn * args : ImmutableArray
+ | FunctionPointer of TypeMethodSignature
+ | GenericTypeParameter of index : int
+ | GenericMethodParameter of index : int
+
+
+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
+ Parameters : Parameter ImmutableArray
+ Generics : GenericParameter ImmutableArray
+ Signature : TypeMethodSignature
+ }
+
+type TypeInfo =
+ {
+ Namespace : string
+ Name : string
+ Methods : MethodInfo list
+ }
+
+[]
+module TypeInfo =
+ let private readOpCode (reader : byref) : 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) : MetadataToken =
+ [|
+ reader.ReadByte ()
+ reader.ReadByte ()
+ reader.ReadByte ()
+ reader.ReadByte ()
+ |]
+
+ let private readMethodBody (peReader : PEReader) (methodDef : MethodDefinition) : (IlOp * int) list =
+ if methodDef.RelativeVirtualAddress = 0 then
+ []
+ 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 -> failwith "todo"
+ | ILOpCode.Bge -> failwith "todo"
+ | ILOpCode.Bgt -> failwith "todo"
+ | ILOpCode.Ble -> failwith "todo"
+ | ILOpCode.Blt -> failwith "todo"
+ | 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_i1 -> failwith "todo"
+ | ILOpCode.Ldind_u1 -> failwith "todo"
+ | ILOpCode.Ldind_i2 -> failwith "todo"
+ | ILOpCode.Ldind_u2 -> failwith "todo"
+ | ILOpCode.Ldind_i4 -> failwith "todo"
+ | ILOpCode.Ldind_u4 -> failwith "todo"
+ | ILOpCode.Ldind_i8 -> failwith "todo"
+ | ILOpCode.Ldind_i -> failwith "todo"
+ | ILOpCode.Ldind_r4 -> failwith "todo"
+ | ILOpCode.Ldind_r8 -> failwith "todo"
+ | ILOpCode.Ldind_ref -> failwith "todo"
+ | ILOpCode.Stind_ref -> failwith "todo"
+ | ILOpCode.Stind_i1 -> failwith "todo"
+ | ILOpCode.Stind_i2 -> failwith "todo"
+ | ILOpCode.Stind_i4 -> failwith "todo"
+ | ILOpCode.Stind_i8 -> failwith "todo"
+ | ILOpCode.Stind_r4 -> failwith "todo"
+ | ILOpCode.Stind_r8 -> failwith "todo"
+ | 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 -> failwith "todo"
+ | ILOpCode.Rem_un -> failwith "todo"
+ | 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 -> failwith "todo"
+ | ILOpCode.Not -> failwith "todo"
+ | 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 -> failwith "todo"
+ | ILOpCode.Ldobj -> failwith "todo"
+ | ILOpCode.Ldstr ->
+ IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Ldstr, readMetadataToken &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 -> failwith "todo"
+ | ILOpCode.Stsfld ->
+ IlOp.UnaryMetadataToken (UnaryMetadataTokenIlOp.Stsfld, readMetadataToken &reader)
+ | ILOpCode.Stobj -> failwith "todo"
+ | ILOpCode.Conv_ovf_i1_un -> failwith "todo"
+ | ILOpCode.Conv_ovf_i2_un -> failwith "todo"
+ | ILOpCode.Conv_ovf_i4_un -> failwith "todo"
+ | ILOpCode.Conv_ovf_i8_un -> failwith "todo"
+ | ILOpCode.Conv_ovf_u1_un -> failwith "todo"
+ | ILOpCode.Conv_ovf_u2_un -> failwith "todo"
+ | ILOpCode.Conv_ovf_u4_un -> failwith "todo"
+ | ILOpCode.Conv_ovf_u8_un -> failwith "todo"
+ | ILOpCode.Conv_ovf_i_un -> failwith "todo"
+ | ILOpCode.Conv_ovf_u_un -> failwith "todo"
+ | 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 -> failwith "todo"
+ | ILOpCode.Ldelem_u1 -> failwith "todo"
+ | ILOpCode.Ldelem_i2 -> failwith "todo"
+ | ILOpCode.Ldelem_u2 -> failwith "todo"
+ | ILOpCode.Ldelem_i4 -> failwith "todo"
+ | ILOpCode.Ldelem_u4 -> failwith "todo"
+ | ILOpCode.Ldelem_i8 -> failwith "todo"
+ | ILOpCode.Ldelem_i -> failwith "todo"
+ | ILOpCode.Ldelem_r4 -> failwith "todo"
+ | ILOpCode.Ldelem_r8 -> failwith "todo"
+ | ILOpCode.Ldelem_ref -> failwith "todo"
+ | ILOpCode.Stelem_i -> failwith "todo"
+ | ILOpCode.Stelem_i1 -> failwith "todo"
+ | ILOpCode.Stelem_i2 -> failwith "todo"
+ | ILOpCode.Stelem_i4 -> failwith "todo"
+ | ILOpCode.Stelem_i8 -> failwith "todo"
+ | ILOpCode.Stelem_r4 -> failwith "todo"
+ | ILOpCode.Stelem_r8 -> failwith "todo"
+ | ILOpCode.Stelem_ref -> failwith "todo"
+ | 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 -> failwith "todo"
+ | 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 -> failwith "todo"
+ | ILOpCode.Conv_ovf_u -> failwith "todo"
+ | ILOpCode.Add_ovf -> failwith "todo"
+ | ILOpCode.Add_ovf_un -> failwith "todo"
+ | ILOpCode.Mul_ovf -> failwith "todo"
+ | ILOpCode.Mul_ovf_un -> failwith "todo"
+ | ILOpCode.Sub_ovf -> failwith "todo"
+ | ILOpCode.Sub_ovf_un -> failwith "todo"
+ | 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 -> failwith "todo"
+ | 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 -> failwith "todo"
+ | 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 -> failwith "todo"
+ | ILOpCode.Endfilter -> IlOp.Nullary NullaryIlOp.Endfilter
+ | ILOpCode.Unaligned -> failwith "todo"
+ | ILOpCode.Volatile -> failwith "todo"
+ | ILOpCode.Tail -> failwith "todo"
+ | ILOpCode.Initobj -> failwith "todo"
+ | ILOpCode.Constrained -> failwith "todo"
+ | 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)
+
+ readInstructions []
+
+ 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 typeProvider =
+ { new ISignatureTypeProvider with
+ member this.GetArrayType (elementType : TypeDefn, shape : ArrayShape) : TypeDefn = failwith "TODO"
+ member this.GetByReferenceType (elementType : TypeDefn) : TypeDefn = TypeDefn.Byref elementType
+
+ member this.GetSZArrayType (elementType : TypeDefn) : TypeDefn =
+ TypeDefn.OneDimensionalArrayLowerBoundZero elementType
+
+ member this.GetPrimitiveType (elementType : PrimitiveTypeCode) : TypeDefn =
+ PrimitiveType.OfEnum elementType |> TypeDefn.PrimitiveType
+
+ member this.GetGenericInstantiation
+ (generic : TypeDefn, typeArguments : ImmutableArray)
+ : TypeDefn
+ =
+ TypeDefn.GenericInstantiation (generic, typeArguments)
+
+ member this.GetTypeFromDefinition
+ (reader : MetadataReader, handle : TypeDefinitionHandle, rawTypeKind : byte)
+ : TypeDefn
+ =
+ let typeKind = reader.ResolveSignatureTypeKind (handle, rawTypeKind)
+ TypeDefn.FromDefinition typeKind
+
+ member this.GetTypeFromReference
+ (reader : MetadataReader, foo : TypeReferenceHandle, rawTypeKind : byte)
+ : TypeDefn
+ =
+ let typeKind = reader.ResolveSignatureTypeKind (foo, rawTypeKind)
+ TypeDefn.FromReference typeKind
+
+ member this.GetPointerType (typeCode : TypeDefn) : TypeDefn = TypeDefn.Pointer typeCode
+
+ member this.GetFunctionPointerType (signature) =
+ TypeDefn.FunctionPointer (TypeMethodSignature.make signature)
+
+ member this.GetGenericMethodParameter (genericContext, index) = TypeDefn.GenericMethodParameter index
+ member this.GetGenericTypeParameter (genericContext, index) = TypeDefn.GenericTypeParameter index
+
+ member this.GetModifiedType (modifier, unmodifiedType, isRequired) =
+ TypeDefn.Modified (unmodifiedType, modifier, isRequired)
+
+ member this.GetPinnedType (elementType) = TypeDefn.Pinned elementType
+ member this.GetTypeFromSpecification (reader, genericContext, handle, rawTypeKind) = failwith "todo"
+ }
+
+ let private readMethod
+ (peReader : PEReader)
+ (metadataReader : MetadataReader)
+ (methodHandle : MethodDefinitionHandle)
+ : MethodInfo
+ =
+ let methodDef = metadataReader.GetMethodDefinition methodHandle
+ let methodName = metadataReader.GetString methodDef.Name
+ let methodSig = methodDef.DecodeSignature (typeProvider, ())
+ let methodBody = readMethodBody peReader methodDef
+ let methodParams = readMethodParams metadataReader (methodDef.GetParameters ())
+
+ let methodGenericParams =
+ readGenericMethodParam metadataReader (methodDef.GetGenericParameters ())
+
+ {
+ Handle = methodHandle
+ Name = methodName
+ Instructions = methodBody
+ Locations = methodBody |> List.map (fun (a, b) -> b, a) |> Map.ofList
+ Parameters = methodParams
+ Generics = methodGenericParams
+ Signature = TypeMethodSignature.make methodSig
+ }
+
+ let internal read
+ (peReader : PEReader)
+ (metadataReader : MetadataReader)
+ (typeHandle : TypeDefinitionHandle)
+ : TypeInfo
+ =
+ let typeDef = metadataReader.GetTypeDefinition (typeHandle)
+ let methods = typeDef.GetMethods ()
+
+ {
+ Namespace = metadataReader.GetString (typeDef.Namespace)
+ Name = metadataReader.GetString (typeDef.Name)
+ Methods = methods |> Seq.map (readMethod peReader metadataReader) |> Seq.toList
+ }
diff --git a/WoofWare.PawPrint/WoofWare.PawPrint.fsproj b/WoofWare.PawPrint/WoofWare.PawPrint.fsproj
new file mode 100644
index 0000000..d0670e3
--- /dev/null
+++ b/WoofWare.PawPrint/WoofWare.PawPrint.fsproj
@@ -0,0 +1,16 @@
+
+
+
+ net8.0
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/flake.nix b/flake.nix
index 123809b..fd1a686 100644
--- a/flake.nix
+++ b/flake.nix
@@ -13,7 +13,7 @@
}:
flake-utils.lib.eachDefaultSystem (system: let
pkgs = nixpkgs.legacyPackages.${system};
- pname = "WoofWare.DotnetRuntime";
+ pname = "WoofWare.PawPrint";
dotnet-sdk = pkgs.dotnetCorePackages.sdk_9_0;
dotnet-runtime = pkgs.dotnetCorePackages.runtime_9_0;
version = "0.1";
@@ -51,10 +51,10 @@
fsharp-analyzers = dotnetTool "FSharp.Analyzers.Cli" "fsharp-analyzers" (builtins.fromJSON (builtins.readFile ./.config/dotnet-tools.json)).tools.fsharp-analyzers.version (builtins.head (builtins.filter (elem: elem.pname == "fsharp-analyzers") deps)).hash;
default = pkgs.buildDotnetModule {
inherit pname version dotnet-sdk dotnet-runtime;
- name = "WoofWare.DotnetRuntime";
+ name = "WoofWare.PawPrint";
src = ./.;
- projectFile = "./WoofWare.DotnetRuntime/WoofWare.DotnetRuntime.fsproj";
- testProjectFile = "./WoofWare.DotnetRuntime.Test/WoofWare.DotnetRuntime.Test.fsproj";
+ projectFile = "./WoofWare.PawPrint/WoofWare.PawPrint.fsproj";
+ testProjectFile = "./WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj";
nugetDeps = ./nix/deps.json; # `nix build .#default.fetch-deps && ./result nix/deps.json`
doCheck = true;
};
@@ -66,6 +66,7 @@
pkgs.alejandra
pkgs.nodePackages.markdown-link-check
pkgs.shellcheck
+ pkgs.xmlstarlet
];
};
});