From 23ccf5d2a2b8f5c7ea65115ac223bf7b7c45c3db Mon Sep 17 00:00:00 2001 From: Patrick Stevens <3138005+Smaug123@users.noreply.github.com> Date: Tue, 27 May 2025 21:55:19 +0100 Subject: [PATCH] Split out more code and implement generic methods (#22) --- WoofWare.PawPrint.Test/TestCases.fs | 5 + .../WoofWare.PawPrint.Test.fsproj | 1 + WoofWare.PawPrint.Test/sources/Threads.cs | 13 + WoofWare.PawPrint/AssemblyReference.fs | 22 + WoofWare.PawPrint/BasicCliType.fs | 13 +- WoofWare.PawPrint/BitTwiddling.fs | 25 - WoofWare.PawPrint/EventDefn.fs | 21 + WoofWare.PawPrint/Executable.fs | 599 ------------------ WoofWare.PawPrint/IlMachineState.fs | 21 +- WoofWare.PawPrint/IlOp.fs | 96 --- WoofWare.PawPrint/MemberReference.fs | 66 ++ WoofWare.PawPrint/MethodSpec.fs | 29 + WoofWare.PawPrint/StringToken.fs | 16 + WoofWare.PawPrint/TypeDefn.fs | 9 +- WoofWare.PawPrint/TypeInfo.fs | 34 +- WoofWare.PawPrint/TypeRef.fs | 21 +- WoofWare.PawPrint/UnaryMetadataIlOp.fs | 21 +- WoofWare.PawPrint/WoofWare.PawPrint.fsproj | 19 +- 18 files changed, 253 insertions(+), 778 deletions(-) create mode 100644 WoofWare.PawPrint.Test/sources/Threads.cs create mode 100644 WoofWare.PawPrint/AssemblyReference.fs delete mode 100644 WoofWare.PawPrint/BitTwiddling.fs create mode 100644 WoofWare.PawPrint/EventDefn.fs delete mode 100644 WoofWare.PawPrint/Executable.fs create mode 100644 WoofWare.PawPrint/MemberReference.fs create mode 100644 WoofWare.PawPrint/MethodSpec.fs create mode 100644 WoofWare.PawPrint/StringToken.fs diff --git a/WoofWare.PawPrint.Test/TestCases.fs b/WoofWare.PawPrint.Test/TestCases.fs index 451eac9..24e214e 100644 --- a/WoofWare.PawPrint.Test/TestCases.fs +++ b/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 diff --git a/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj b/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj index 4881930..a93067a 100644 --- a/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj +++ b/WoofWare.PawPrint.Test/WoofWare.PawPrint.Test.fsproj @@ -23,6 +23,7 @@ + diff --git a/WoofWare.PawPrint.Test/sources/Threads.cs b/WoofWare.PawPrint.Test/sources/Threads.cs new file mode 100644 index 0000000..eb8d507 --- /dev/null +++ b/WoofWare.PawPrint.Test/sources/Threads.cs @@ -0,0 +1,13 @@ +using System.Threading.Tasks; + +namespace HelloWorldApp +{ + class Program + { + static async System.Threading.Tasks.Task Main(string[] args) + { + var result = await Task.Run(() => 3); + return result; + } + } +} diff --git a/WoofWare.PawPrint/AssemblyReference.fs b/WoofWare.PawPrint/AssemblyReference.fs new file mode 100644 index 0000000..0be8a15 --- /dev/null +++ b/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 + } + +[] +module AssemblyReference = + let make (ref : System.Reflection.Metadata.AssemblyReference) : AssemblyReference = + { + Culture = StringToken.String ref.Culture + Flags = ref.Flags + Name = ref.GetAssemblyName () + Version = ref.Version + } diff --git a/WoofWare.PawPrint/BasicCliType.fs b/WoofWare.PawPrint/BasicCliType.fs index b89b134..09b4945 100644 --- a/WoofWare.PawPrint/BasicCliType.fs +++ b/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" diff --git a/WoofWare.PawPrint/BitTwiddling.fs b/WoofWare.PawPrint/BitTwiddling.fs deleted file mode 100644 index dcbb2c6..0000000 --- a/WoofWare.PawPrint/BitTwiddling.fs +++ /dev/null @@ -1,25 +0,0 @@ -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))) - - let inline toInt32 (bytes : ReadOnlySpan) : int32 = - int32 bytes.[0] - + int32 bytes.[1] * 256 - + int32 bytes.[2] * 256 * 256 - + int32 bytes.[3] * 256 * 256 * 256 diff --git a/WoofWare.PawPrint/EventDefn.fs b/WoofWare.PawPrint/EventDefn.fs new file mode 100644 index 0000000..9eacf52 --- /dev/null +++ b/WoofWare.PawPrint/EventDefn.fs @@ -0,0 +1,21 @@ +namespace WoofWare.PawPrint + +open System.Reflection +open System.Reflection.Metadata + +type EventDefn = + { + Name : string + Attrs : EventAttributes + } + +[] +module EventDefn = + + let make (mr : MetadataReader) (event : EventDefinition) : EventDefn = + let name = mr.GetString event.Name + + { + Name = name + Attrs = event.Attributes + } diff --git a/WoofWare.PawPrint/Executable.fs b/WoofWare.PawPrint/Executable.fs deleted file mode 100644 index a721a3a..0000000 --- a/WoofWare.PawPrint/Executable.fs +++ /dev/null @@ -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) : 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/IlMachineState.fs b/WoofWare.PawPrint/IlMachineState.fs index afa993a..4bc755f 100644 --- a/WoofWare.PawPrint/IlMachineState.fs +++ b/WoofWare.PawPrint/IlMachineState.fs @@ -226,7 +226,7 @@ module IlMachineState = : IlMachineState * DumpedAssembly * WoofWare.PawPrint.TypeInfo = 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 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 diff --git a/WoofWare.PawPrint/IlOp.fs b/WoofWare.PawPrint/IlOp.fs index 6890d63..5e35e17 100644 --- a/WoofWare.PawPrint/IlOp.fs +++ b/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 - -[] -module StringToken = - let ofInt (value : int) : StringToken = - match LanguagePrimitives.EnumOfValue (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 - -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}" - -[] -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 - } - -[] -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 diff --git a/WoofWare.PawPrint/MemberReference.fs b/WoofWare.PawPrint/MemberReference.fs new file mode 100644 index 0000000..1297d45 --- /dev/null +++ b/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 + +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}" + +[] +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 + } diff --git a/WoofWare.PawPrint/MethodSpec.fs b/WoofWare.PawPrint/MethodSpec.fs new file mode 100644 index 0000000..1b0c754 --- /dev/null +++ b/WoofWare.PawPrint/MethodSpec.fs @@ -0,0 +1,29 @@ +namespace WoofWare.PawPrint + +open System.Collections.Immutable +open System.Reflection.Metadata + +/// +/// Represents a method specification, which provides information about a method, +/// particularly for generic method instantiations. +/// +type MethodSpec = + { + /// + /// The token that identifies the method being specialized. + /// + Method : MetadataToken + + Signature : TypeDefn ImmutableArray + } + +[] +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 + } diff --git a/WoofWare.PawPrint/StringToken.fs b/WoofWare.PawPrint/StringToken.fs new file mode 100644 index 0000000..36de734 --- /dev/null +++ b/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 + +[] +module StringToken = + let ofInt (value : int) : StringToken = + match LanguagePrimitives.EnumOfValue (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}" diff --git a/WoofWare.PawPrint/TypeDefn.fs b/WoofWare.PawPrint/TypeDefn.fs index 51628d9..ff45dfe 100644 --- a/WoofWare.PawPrint/TypeDefn.fs +++ b/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 | FunctionPointer of TypeMethodSignature @@ -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" } diff --git a/WoofWare.PawPrint/TypeInfo.fs b/WoofWare.PawPrint/TypeInfo.fs index abc0881..6518331 100644 --- a/WoofWare.PawPrint/TypeInfo.fs +++ b/WoofWare.PawPrint/TypeInfo.fs @@ -8,26 +8,6 @@ open System.Reflection.PortableExecutable open Microsoft.Extensions.Logging open Microsoft.FSharp.Core -/// -/// Represents a method specification, which provides information about a method, -/// particularly for generic method instantiations. -/// -type MethodSpec = - { - /// - /// The token that identifies the method being specialized. - /// - Method : MetadataToken - } - -[] -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> diff --git a/WoofWare.PawPrint/TypeRef.fs b/WoofWare.PawPrint/TypeRef.fs index a518637..f573dff 100644 --- a/WoofWare.PawPrint/TypeRef.fs +++ b/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 + /// /// 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 /// - /// The scope of the type reference. This can be: - /// - 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 + /// The scope of the type reference: where to find the type. /// - ResolutionScope : WoofWare.PawPrint.MetadataToken + ResolutionScope : TypeRefResolutionScope } [] @@ -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 diff --git a/WoofWare.PawPrint/UnaryMetadataIlOp.fs b/WoofWare.PawPrint/UnaryMetadataIlOp.fs index b126cb7..1eb68d0 100644 --- a/WoofWare.PawPrint/UnaryMetadataIlOp.fs +++ b/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" diff --git a/WoofWare.PawPrint/WoofWare.PawPrint.fsproj b/WoofWare.PawPrint/WoofWare.PawPrint.fsproj index 397ea82..00ab028 100644 --- a/WoofWare.PawPrint/WoofWare.PawPrint.fsproj +++ b/WoofWare.PawPrint/WoofWare.PawPrint.fsproj @@ -6,20 +6,23 @@ - - + - - - - - - + + + + + + + + + +