Split out more code and implement generic methods (#22)

WoofWare.PawPrint.Test/TestCases.fs

@@ -15,6 +15,11 @@ module TestCases =
 
     let unimplemented =
         [
+            {
+                FileName = "Threads.cs"
+                ExpectedReturnCode = 3
+                NativeImpls = MockEnv.make ()
+            }
             {
                 FileName = "BasicException.cs"
                 ExpectedReturnCode = 10

WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj

@@ -23,6 +23,7 @@
     <EmbeddedResource Include="sources\TriangleNumber.cs" />
     <EmbeddedResource Include="sources\WriteLine.cs" />
     <EmbeddedResource Include="sources\InstaQuit.cs" />
+    <EmbeddedResource Include="sources\Threads.cs" />
   </ItemGroup>
 
   <ItemGroup>

WoofWare.PawPrint.Test/sources/Threads.cs

@@ -0,0 +1,13 @@
+using System.Threading.Tasks;
+
+namespace HelloWorldApp
+{
+    class Program
+    {
+        static async System.Threading.Tasks.Task<int> Main(string[] args)
+        {
+            var result = await Task.Run(() => 3);
+            return result;
+        }
+    }
+}

WoofWare.PawPrint/AssemblyReference.fs

@@ -0,0 +1,22 @@
+namespace WoofWare.PawPrint
+
+open System
+open System.Reflection
+
+type AssemblyReference =
+    {
+        Culture : StringToken
+        Flags : AssemblyFlags
+        Name : AssemblyName
+        Version : Version
+    }
+
+[<RequireQualifiedAccess>]
+module AssemblyReference =
+    let make (ref : System.Reflection.Metadata.AssemblyReference) : AssemblyReference =
+        {
+            Culture = StringToken.String ref.Culture
+            Flags = ref.Flags
+            Name = ref.GetAssemblyName ()
+            Version = ref.Version
+        }

WoofWare.PawPrint/BasicCliType.fs

@@ -120,17 +120,24 @@ module CliType =
         | TypeDefn.Byref _ -> CliType.ObjectRef None
         | TypeDefn.OneDimensionalArrayLowerBoundZero _ -> CliType.ObjectRef None
         | TypeDefn.Modified (original, afterMod, modificationRequired) -> failwith "todo"
-        | TypeDefn.FromReference (typeReferenceHandle, signatureTypeKind) -> failwith "todo"
+        | TypeDefn.FromReference (typeRef, signatureTypeKind) ->
+            match signatureTypeKind with
+            | SignatureTypeKind.Unknown -> failwith "todo"
+            | SignatureTypeKind.ValueType -> failwith "todo"
+            | SignatureTypeKind.Class -> CliType.ObjectRef None
+            | _ -> raise (ArgumentOutOfRangeException ())
         | TypeDefn.FromDefinition (typeDefinitionHandle, signatureTypeKind) ->
             match signatureTypeKind with
             | SignatureTypeKind.Unknown -> failwith "todo"
             | SignatureTypeKind.ValueType -> failwith "todo"
             | SignatureTypeKind.Class -> CliType.ObjectRef None
             | _ -> raise (ArgumentOutOfRangeException ())
-        | TypeDefn.GenericInstantiation (generic, args) -> zeroOf args generic
+        | TypeDefn.GenericInstantiation (generic, args) ->
+            // TODO: this is rather concerning and probably incorrect
+            zeroOf args generic
         | TypeDefn.FunctionPointer typeMethodSignature -> failwith "todo"
         | TypeDefn.GenericTypeParameter index ->
             // TODO: can generics depend on other generics? presumably, so we pass the array down again
             zeroOf generics generics.[index]
-        | TypeDefn.GenericMethodParameter index -> failwith "todo"
+        | TypeDefn.GenericMethodParameter index -> zeroOf generics generics.[index]
         | TypeDefn.Void -> failwith "should never construct an element of type Void"

WoofWare.PawPrint/BitTwiddling.fs

@@ -1,25 +0,0 @@
-namespace WoofWare.PawPrint
-
-open System
-
-[<AutoOpen>]
-module internal BitTwiddling =
-
-    let inline toUint32 (bytes : ReadOnlySpan<byte>) : uint32 =
-        uint32 bytes.[0]
-        + uint32 bytes.[1] * 256u
-        + uint32 bytes.[2] * 256u * 256u
-        + uint32 bytes.[3] * 256u * 256u * 256u
-
-    let inline toUint16 (bytes : ReadOnlySpan<byte>) : uint16 =
-        uint16 bytes.[0] + uint16 bytes.[1] * 256us
-
-    let inline toUint64 (bytes : ReadOnlySpan<byte>) : uint64 =
-        uint64 (toUint32 (bytes.Slice (0, 4)))
-        + 0x10000UL * uint64 (toUint32 (bytes.Slice (4, 4)))
-
-    let inline toInt32 (bytes : ReadOnlySpan<byte>) : int32 =
-        int32 bytes.[0]
-        + int32 bytes.[1] * 256
-        + int32 bytes.[2] * 256 * 256
-        + int32 bytes.[3] * 256 * 256 * 256

WoofWare.PawPrint/EventDefn.fs

@@ -0,0 +1,21 @@
+namespace WoofWare.PawPrint
+
+open System.Reflection
+open System.Reflection.Metadata
+
+type EventDefn =
+    {
+        Name : string
+        Attrs : EventAttributes
+    }
+
+[<RequireQualifiedAccess>]
+module EventDefn =
+
+    let make (mr : MetadataReader) (event : EventDefinition) : EventDefn =
+        let name = mr.GetString event.Name
+
+        {
+            Name = name
+            Attrs = event.Attributes
+        }

WoofWare.PawPrint/Executable.fs

@@ -1,599 +0,0 @@
-namespace WoofWare.PawPrint
-
-open System
-open System.Text
-
-type MsIlInstruction = | Something
-
-type Characteristics =
-    {
-        Is32BitMachine : bool
-        IsFileDll : bool
-    }
-
-    static member Parse (b : ReadOnlySpan<byte>) : 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<byte>) : 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<byte>) : 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<byte>) : 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<byte>) : 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<byte>) : RvaAndSize =
-        {
-            Rva = toUint32 (b.Slice (0, 4))
-            BlockSize = toUint32 (b.Slice (4, 4))
-        }
-
-type CliRuntimeFlags =
-    {
-        Requires32Bit : bool
-        HasStrongNameSig : bool
-    }
-
-    static member Parse (b : ReadOnlySpan<byte>) : 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<byte>) : 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<byte>) : 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<byte>) : 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
-    }
-
-[<RequireQualifiedAccess>]
-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<byte> = 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

WoofWare.PawPrint/IlMachineState.fs

@@ -226,7 +226,7 @@ module IlMachineState =
         : IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo<TypeDefn>
         =
         match target.ResolutionScope with
-        | AssemblyReference r ->
+        | TypeRefResolutionScope.Assembly r ->
             let state, assy, newAssyName =
                 loadAssembly loggerFactory referencedInAssembly r state
 
@@ -319,6 +319,7 @@ module IlMachineState =
         (wasInitialising : (TypeDefinitionHandle * AssemblyName) option)
         (wasConstructing : ManagedHeapAddress option)
         (wasClassConstructor : bool)
+        (generics : ImmutableArray<TypeDefn> option)
         (methodToCall : WoofWare.PawPrint.MethodInfo)
         (thread : ThreadId)
         (threadState : ThreadState)
@@ -334,9 +335,11 @@ module IlMachineState =
 
                 for i = 0 to methodToCall.Parameters.Length - 1 do
                     let poppedArg, afterPop' = afterPop |> MethodState.popFromStack
-                    // TODO: generics
+
                     let zeroArg =
-                        CliType.zeroOf ImmutableArray.Empty methodToCall.Signature.ParameterTypes.[i]
+                        CliType.zeroOf
+                            (generics |> Option.defaultValue ImmutableArray.Empty)
+                            methodToCall.Signature.ParameterTypes.[i]
 
                     let poppedArg = EvalStackValue.toCliTypeCoerced zeroArg poppedArg
                     afterPop <- afterPop'
@@ -520,6 +523,8 @@ module IlMachineState =
                     (Some (typeDefHandle, assemblyName))
                     None
                     true
+                    // constructor is surely not generic
+                    None
                     ctorMethod
                     currentThread
                     currentThreadState
@@ -538,6 +543,7 @@ module IlMachineState =
     let callMethodInActiveAssembly
         (loggerFactory : ILoggerFactory)
         (thread : ThreadId)
+        (generics : TypeDefn ImmutableArray option)
         (methodToCall : WoofWare.PawPrint.MethodInfo)
         (weAreConstructingObj : ManagedHeapAddress option)
         (state : IlMachineState)
@@ -551,14 +557,17 @@ module IlMachineState =
                 loadClass loggerFactory (fst methodToCall.DeclaringType) (snd methodToCall.DeclaringType) thread state
             with
             | NothingToDo state ->
-                callMethod None weAreConstructingObj false methodToCall thread threadState state, WhatWeDid.Executed
+                callMethod None weAreConstructingObj false generics methodToCall thread threadState state,
+                WhatWeDid.Executed
             | FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
         | Some TypeInitState.Initialized ->
-            callMethod None weAreConstructingObj false methodToCall thread threadState state, WhatWeDid.Executed
+            callMethod None weAreConstructingObj false generics methodToCall thread threadState state,
+            WhatWeDid.Executed
         | Some (InProgress threadId) ->
             if threadId = thread then
                 // II.10.5.3.2: avoid the deadlock by simply proceeding.
-                callMethod None weAreConstructingObj false methodToCall thread threadState state, WhatWeDid.Executed
+                callMethod None weAreConstructingObj false generics methodToCall thread threadState state,
+                WhatWeDid.Executed
             else
                 state, WhatWeDid.BlockedOnClassInit threadId
 

WoofWare.PawPrint/IlOp.fs

@@ -1,102 +1,6 @@
 namespace WoofWare.PawPrint
 
-open System
 open System.Collections.Immutable
-open System.Reflection
-open System.Reflection.Metadata
-open System.Reflection.Metadata.Ecma335
-
-type StringToken =
-    | UserString of UserStringHandle
-    | String of StringHandle
-
-[<RequireQualifiedAccess>]
-module StringToken =
-    let ofInt (value : int) : StringToken =
-        match LanguagePrimitives.EnumOfValue<byte, HandleKind> (byte (value &&& 0xFF000000 >>> 24)) with
-        | HandleKind.UserString -> StringToken.UserString (MetadataTokens.UserStringHandle value)
-        | HandleKind.String -> StringToken.String (MetadataTokens.StringHandle value)
-        | v -> failwith $"Unrecognised string handle kind: {v}"
-
-type MemberSignature =
-    | Field of TypeDefn
-    | Method of TypeMethodSignature<TypeDefn>
-
-type MemberReference<'parent> =
-    {
-        Name : StringToken
-        PrettyName : string
-        Parent : 'parent
-        Signature : MemberSignature
-    }
-
-type MemberRefSigSwitch =
-    | Default
-    | Field
-    | VarArg
-    | Generic
-
-    static member Identify (b : byte) =
-        match b &&& 0xFuy with
-        | 0uy -> MemberRefSigSwitch.Default
-        | 5uy -> MemberRefSigSwitch.VarArg
-        | 6uy -> MemberRefSigSwitch.Field
-        | 0x10uy -> MemberRefSigSwitch.Generic
-        | n -> failwith $"Bad member ref sig: %i{n}"
-
-[<RequireQualifiedAccess>]
-module MemberReference =
-    let make<'parent>
-        (blobReader : BlobHandle -> BlobReader)
-        (getString : StringHandle -> string)
-        (makeParent : EntityHandle -> 'parent)
-        (mr : System.Reflection.Metadata.MemberReference)
-        : MemberReference<'parent>
-        =
-        let name = StringToken.String mr.Name
-
-        let br = blobReader mr.Signature
-        let header = br.ReadSignatureHeader ()
-
-        let signature =
-            match header.Kind with
-            | SignatureKind.Method -> mr.DecodeMethodSignature (TypeDefn.typeProvider, ()) |> Choice1Of2
-            | SignatureKind.Field -> mr.DecodeFieldSignature (TypeDefn.typeProvider, ()) |> Choice2Of2
-            | SignatureKind.LocalVariables -> failwith "TODO: LocalVariables"
-            | SignatureKind.Property -> failwith "TODO: Property"
-            | SignatureKind.MethodSpecification -> failwith "TODO: MethodSpec"
-            | i -> raise (ArgumentOutOfRangeException $"{i}")
-
-        let signature =
-            match signature with
-            | Choice1Of2 methodSignature -> TypeMethodSignature.make methodSignature |> MemberSignature.Method
-            | Choice2Of2 typeDefn -> MemberSignature.Field typeDefn
-
-        {
-            Name = name
-            PrettyName = getString mr.Name
-            // Horrible abuse to get this as an int
-            Parent = makeParent mr.Parent
-            Signature = signature
-        }
-
-type AssemblyReference =
-    {
-        Culture : StringToken
-        Flags : AssemblyFlags
-        Name : AssemblyName
-        Version : Version
-    }
-
-[<RequireQualifiedAccess>]
-module AssemblyReference =
-    let make (ref : System.Reflection.Metadata.AssemblyReference) : AssemblyReference =
-        {
-            Culture = StringToken.String ref.Culture
-            Flags = ref.Flags
-            Name = ref.GetAssemblyName ()
-            Version = ref.Version
-        }
 
 type NullaryIlOp =
     | Nop

WoofWare.PawPrint/MemberReference.fs

@@ -0,0 +1,66 @@
+namespace WoofWare.PawPrint
+
+open System
+open System.Reflection.Metadata
+
+type MemberSignature =
+    | Field of TypeDefn
+    | Method of TypeMethodSignature<TypeDefn>
+
+type MemberReference<'parent> =
+    {
+        Name : StringToken
+        PrettyName : string
+        Parent : 'parent
+        Signature : MemberSignature
+    }
+
+type MemberRefSigSwitch =
+    | Default
+    | Field
+    | VarArg
+    | Generic
+
+    static member Identify (b : byte) =
+        match b &&& 0xFuy with
+        | 0uy -> MemberRefSigSwitch.Default
+        | 5uy -> MemberRefSigSwitch.VarArg
+        | 6uy -> MemberRefSigSwitch.Field
+        | 0x10uy -> MemberRefSigSwitch.Generic
+        | n -> failwith $"Bad member ref sig: %i{n}"
+
+[<RequireQualifiedAccess>]
+module MemberReference =
+    let make<'parent>
+        (blobReader : BlobHandle -> BlobReader)
+        (getString : StringHandle -> string)
+        (makeParent : EntityHandle -> 'parent)
+        (mr : System.Reflection.Metadata.MemberReference)
+        : MemberReference<'parent>
+        =
+        let name = StringToken.String mr.Name
+
+        let br = blobReader mr.Signature
+        let header = br.ReadSignatureHeader ()
+
+        let signature =
+            match header.Kind with
+            | SignatureKind.Method -> mr.DecodeMethodSignature (TypeDefn.typeProvider, ()) |> Choice1Of2
+            | SignatureKind.Field -> mr.DecodeFieldSignature (TypeDefn.typeProvider, ()) |> Choice2Of2
+            | SignatureKind.LocalVariables -> failwith "TODO: LocalVariables"
+            | SignatureKind.Property -> failwith "TODO: Property"
+            | SignatureKind.MethodSpecification -> failwith "TODO: MethodSpec"
+            | i -> raise (ArgumentOutOfRangeException $"{i}")
+
+        let signature =
+            match signature with
+            | Choice1Of2 methodSignature -> TypeMethodSignature.make methodSignature |> MemberSignature.Method
+            | Choice2Of2 typeDefn -> MemberSignature.Field typeDefn
+
+        {
+            Name = name
+            PrettyName = getString mr.Name
+            // Horrible abuse to get this as an int
+            Parent = makeParent mr.Parent
+            Signature = signature
+        }

WoofWare.PawPrint/MethodSpec.fs

@@ -0,0 +1,29 @@
+namespace WoofWare.PawPrint
+
+open System.Collections.Immutable
+open System.Reflection.Metadata
+
+/// <summary>
+/// Represents a method specification, which provides information about a method,
+/// particularly for generic method instantiations.
+/// </summary>
+type MethodSpec =
+    {
+        /// <summary>
+        /// The token that identifies the method being specialized.
+        /// </summary>
+        Method : MetadataToken
+
+        Signature : TypeDefn ImmutableArray
+    }
+
+[<RequireQualifiedAccess>]
+module MethodSpec =
+    let make (p : MethodSpecification) : MethodSpec =
+        let signature = p.DecodeSignature (TypeDefn.typeProvider, ())
+
+        {
+            // Horrible abuse to get this as an int
+            Method = MetadataToken.ofInt (p.Method.GetHashCode ())
+            Signature = signature
+        }

WoofWare.PawPrint/StringToken.fs

@@ -0,0 +1,16 @@
+namespace WoofWare.PawPrint
+
+open System.Reflection.Metadata
+open System.Reflection.Metadata.Ecma335
+
+type StringToken =
+    | UserString of UserStringHandle
+    | String of StringHandle
+
+[<RequireQualifiedAccess>]
+module StringToken =
+    let ofInt (value : int) : StringToken =
+        match LanguagePrimitives.EnumOfValue<byte, HandleKind> (byte (value &&& 0xFF000000 >>> 24)) with
+        | HandleKind.UserString -> StringToken.UserString (MetadataTokens.UserStringHandle value)
+        | HandleKind.String -> StringToken.String (MetadataTokens.StringHandle value)
+        | v -> failwith $"Unrecognised string handle kind: {v}"

WoofWare.PawPrint/TypeDefn.fs

@@ -97,7 +97,7 @@ type TypeDefn =
     | Byref of TypeDefn
     | OneDimensionalArrayLowerBoundZero of elements : TypeDefn
     | Modified of original : TypeDefn * afterMod : TypeDefn * modificationRequired : bool
-    | FromReference of TypeReferenceHandle * SignatureTypeKind
+    | FromReference of TypeRef * SignatureTypeKind
     | FromDefinition of TypeDefinitionHandle * SignatureTypeKind
     | GenericInstantiation of generic : TypeDefn * args : ImmutableArray<TypeDefn>
     | FunctionPointer of TypeMethodSignature<TypeDefn>
@@ -201,12 +201,13 @@ module TypeDefn =
                 : TypeDefn
                 =
                 let handle' : EntityHandle = TypeReferenceHandle.op_Implicit handle
+                let ref = handle |> TypeRef.make reader
                 let typeKind = reader.ResolveSignatureTypeKind (handle', rawTypeKind)
-                TypeDefn.FromReference (handle, typeKind)
+                TypeDefn.FromReference (ref, typeKind)
 
             member this.GetPointerType (typeCode : TypeDefn) : TypeDefn = TypeDefn.Pointer typeCode
 
-            member this.GetFunctionPointerType (signature) =
+            member this.GetFunctionPointerType signature =
                 TypeDefn.FunctionPointer (TypeMethodSignature.make signature)
 
             member this.GetGenericMethodParameter (genericContext, index) = TypeDefn.GenericMethodParameter index
@@ -215,6 +216,6 @@ module TypeDefn =
             member this.GetModifiedType (modifier, unmodifiedType, isRequired) =
                 TypeDefn.Modified (unmodifiedType, modifier, isRequired)
 
-            member this.GetPinnedType (elementType) = TypeDefn.Pinned elementType
+            member this.GetPinnedType elementType = TypeDefn.Pinned elementType
             member this.GetTypeFromSpecification (reader, genericContext, handle, rawTypeKind) = failwith "todo"
         }

WoofWare.PawPrint/TypeInfo.fs

@@ -8,26 +8,6 @@ open System.Reflection.PortableExecutable
 open Microsoft.Extensions.Logging
 open Microsoft.FSharp.Core
 
-/// <summary>
-/// Represents a method specification, which provides information about a method,
-/// particularly for generic method instantiations.
-/// </summary>
-type MethodSpec =
-    {
-        /// <summary>
-        /// The token that identifies the method being specialized.
-        /// </summary>
-        Method : MetadataToken
-    }
-
-[<RequireQualifiedAccess>]
-module MethodSpec =
-    let make (p : MethodSpecification) : MethodSpec =
-        {
-            // Horrible abuse to get this as an int
-            Method = MetadataToken.ofInt (p.Method.GetHashCode ())
-        }
-
 type BaseTypeInfo =
     | TypeDef of TypeDefinitionHandle
     | TypeRef of TypeReferenceHandle
@@ -100,6 +80,8 @@ type TypeInfo<'generic> =
         Assembly : AssemblyName
 
         Generics : 'generic ImmutableArray
+
+        Events : EventDefn ImmutableArray
     }
 
 type TypeInfoEval<'ret> =
@@ -140,6 +122,7 @@ module TypeInfo =
             TypeDefHandle = t.TypeDefHandle
             Assembly = t.Assembly
             Generics = gen
+            Events = t.Events
         }
 
     let mapGeneric<'a, 'b> (f : 'a -> 'b) (t : TypeInfo<'a>) : TypeInfo<'b> =
@@ -210,6 +193,16 @@ module TypeInfo =
             | TypeSpecification typeSpecHandle -> Some (BaseTypeInfo.TypeSpec typeSpecHandle)
             | t -> failwith $"Unrecognised base-type entity identifier: %O{t}"
 
+        let events =
+            let result = ImmutableArray.CreateBuilder ()
+
+            for evt in typeDef.GetEvents () do
+                metadataReader.GetEventDefinition evt
+                |> EventDefn.make metadataReader
+                |> result.Add
+
+            result.ToImmutable ()
+
         {
             Namespace = ns
             Name = name
@@ -222,6 +215,7 @@ module TypeInfo =
             TypeDefHandle = typeHandle
             Assembly = thisAssembly
             Generics = genericParams
+            Events = events
         }
 
     let rec resolveBaseType<'corelib, 'generic>

WoofWare.PawPrint/TypeRef.fs

@@ -2,6 +2,11 @@ namespace WoofWare.PawPrint
 
 open System.Reflection.Metadata
 
+type TypeRefResolutionScope =
+    | Assembly of AssemblyReferenceHandle
+    | ModuleRef of ModuleReferenceHandle
+    | TypeRef of TypeReferenceHandle
+
 /// <summary>
 /// Represents a type reference in a .NET assembly metadata.
 /// This corresponds to a TypeReferenceHandle in System.Reflection.Metadata.
@@ -15,13 +20,9 @@ type TypeRef =
         Namespace : string
 
         /// <summary>
-        /// The scope of the type reference. This can be:
+        /// The scope of the type reference: where to find the type.
-        /// - AssemblyReference token: When the type is defined in another assembly
-        /// - ModuleReference token: When the type is defined in another module of the same assembly
-        /// - TypeReference token: When the type is a nested type
-        /// - ModuleDefinition token: When the type is defined in the current module
         /// </summary>
-        ResolutionScope : WoofWare.PawPrint.MetadataToken
+        ResolutionScope : TypeRefResolutionScope
     }
 
 [<RequireQualifiedAccess>]
@@ -30,7 +31,13 @@ module TypeRef =
         let typeRef = metadataReader.GetTypeReference ty
         let prettyName = metadataReader.GetString typeRef.Name
         let prettyNamespace = metadataReader.GetString typeRef.Namespace
-        let resolutionScope = MetadataToken.ofEntityHandle typeRef.ResolutionScope
+
+        let resolutionScope =
+            match MetadataToken.ofEntityHandle typeRef.ResolutionScope with
+            | MetadataToken.AssemblyReference ref -> TypeRefResolutionScope.Assembly ref
+            | MetadataToken.ModuleReference ref -> TypeRefResolutionScope.ModuleRef ref
+            | MetadataToken.TypeReference ref -> TypeRefResolutionScope.TypeRef ref
+            | handle -> failwith $"Unexpected TypeRef resolution scope: {handle}"
 
         {
             Name = prettyName

WoofWare.PawPrint/UnaryMetadataIlOp.fs

@@ -17,20 +17,21 @@ module internal UnaryMetadataIlOp =
         =
         match op with
         | Call ->
-            let state, methodToCall =
+            let state, methodToCall, generics =
                 match metadataToken with
                 | MetadataToken.MethodSpecification h ->
                     let spec = (state.ActiveAssembly thread).MethodSpecs.[h]
 
                     match spec.Method with
-                    | MetadataToken.MethodDef token -> state, (state.ActiveAssembly thread).Methods.[token]
+                    | MetadataToken.MethodDef token ->
+                        state, (state.ActiveAssembly thread).Methods.[token], Some spec.Signature
                     | MetadataToken.MemberReference ref ->
                         let state, _, method =
                             IlMachineState.resolveMember loggerFactory (state.ActiveAssembly thread) ref state
 
                         match method with
                         | Choice2Of2 _field -> failwith "tried to Call a field"
-                        | Choice1Of2 method -> state, method
+                        | Choice1Of2 method -> state, method, Some spec.Signature
                     | k -> failwith $"Unrecognised kind: %O{k}"
                 | MetadataToken.MemberReference h ->
                     let state, _, method =
@@ -38,13 +39,13 @@ module internal UnaryMetadataIlOp =
 
                     match method with
                     | Choice2Of2 _field -> failwith "tried to Call a field"
-                    | Choice1Of2 method -> state, method
+                    | Choice1Of2 method -> state, method, None
 
                 | MetadataToken.MethodDef defn ->
                     let activeAssy = state.ActiveAssembly thread
 
                     match activeAssy.Methods.TryGetValue defn with
-                    | true, method -> state, method
+                    | true, method -> state, method, None
                     | false, _ -> failwith $"could not find method in {activeAssy.Name}"
                 | k -> failwith $"Unrecognised kind: %O{k}"
 
@@ -59,17 +60,17 @@ module internal UnaryMetadataIlOp =
             | NothingToDo state ->
                 state.WithThreadSwitchedToAssembly (snd methodToCall.DeclaringType) thread
                 |> fst
-                |> IlMachineState.callMethodInActiveAssembly loggerFactory thread methodToCall None
+                |> IlMachineState.callMethodInActiveAssembly loggerFactory thread generics methodToCall None
             | FirstLoadThis state -> state, WhatWeDid.SuspendedForClassInit
 
         | Callvirt ->
-            let method =
+            let method, generics =
                 match metadataToken with
                 | MetadataToken.MethodDef defn ->
                     let activeAssy = state.ActiveAssembly thread
 
                     match activeAssy.Methods.TryGetValue defn with
-                    | true, method -> method
+                    | true, method -> method, None
                     | false, _ -> failwith $"could not find method in {activeAssy.Name}"
                 | _ -> failwith $"TODO (Callvirt): %O{metadataToken}"
 
@@ -109,7 +110,7 @@ module internal UnaryMetadataIlOp =
 
             state.WithThreadSwitchedToAssembly (snd methodToCall.DeclaringType) thread
             |> fst
-            |> IlMachineState.callMethodInActiveAssembly loggerFactory thread methodToCall None
+            |> IlMachineState.callMethodInActiveAssembly loggerFactory thread generics methodToCall None
         | Castclass -> failwith "TODO: Castclass unimplemented"
         | Newobj ->
             let state, assy, ctor =
@@ -151,7 +152,7 @@ module internal UnaryMetadataIlOp =
             let state, whatWeDid =
                 state.WithThreadSwitchedToAssembly assy thread
                 |> fst
-                |> IlMachineState.callMethodInActiveAssembly loggerFactory thread ctor (Some allocatedAddr)
+                |> IlMachineState.callMethodInActiveAssembly loggerFactory thread None ctor (Some allocatedAddr)
 
             match whatWeDid with
             | SuspendedForClassInit -> failwith "unexpectedly suspended while initialising constructor"

WoofWare.PawPrint/WoofWare.PawPrint.fsproj

@@ -6,20 +6,23 @@
   </PropertyGroup>
 
   <ItemGroup>
-    <Compile Include="BitTwiddling.fs" />
     <Compile Include="Tuple.fs" />
-    <None Include="Executable.fs" />
+    <Compile Include="StringToken.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="TypeSpec.fs" />
-    <Compile Include="FieldInfo.fs" />
     <Compile Include="IlOp.fs" />
+    <Compile Include="CustomAttribute.fs" />
+    <Compile Include="AssemblyReference.fs" />
+    <Compile Include="EventDefn.fs" />
+    <Compile Include="TypeDefn.fs" />
+    <Compile Include="FieldInfo.fs" />
     <Compile Include="MethodInfo.fs" />
     <Compile Include="TypeInfo.fs" />
+    <Compile Include="MethodSpec.fs" />
+    <Compile Include="MemberReference.fs" />
+    <Compile Include="Namespace.fs" />
+    <Compile Include="ExportedType.fs" />
+    <Compile Include="TypeSpec.fs" />
     <Compile Include="Assembly.fs" />
     <Compile Include="Corelib.fs" />
     <Compile Include="AbstractMachineDomain.fs" />