Permalink
Switch branches/tags
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
4113 lines (3630 sloc) 200 KB
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
//---------------------------------------------------------------------
// The big binary reader
//
//---------------------------------------------------------------------
module Microsoft.FSharp.Compiler.AbstractIL.ILBinaryReader
#nowarn "42" // This construct is deprecated: it is only for use in the F# library
open System
open System.Collections.Generic
open System.Diagnostics
open System.IO
open System.Runtime.InteropServices
open System.Text
open Internal.Utilities
open Internal.Utilities.Collections
open Microsoft.FSharp.Compiler.AbstractIL
open Microsoft.FSharp.Compiler.AbstractIL.Internal
#if !FX_NO_PDB_READER
open Microsoft.FSharp.Compiler.AbstractIL.Internal.Support
#endif
open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics
open Microsoft.FSharp.Compiler.AbstractIL.Internal.BinaryConstants
open Microsoft.FSharp.Compiler.AbstractIL.IL
open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library
open Microsoft.FSharp.Compiler.ErrorLogger
open Microsoft.FSharp.Compiler.Range
open Microsoft.FSharp.NativeInterop
open System.Reflection
let checking = false
let logging = false
let _ = if checking then dprintn "warning : ILBinaryReader.checking is on"
let noStableFileHeuristic = try (System.Environment.GetEnvironmentVariable("FSharp_NoStableFileHeuristic") <> null) with _ -> false
let alwaysMemoryMapFSC = try (System.Environment.GetEnvironmentVariable("FSharp_AlwaysMemoryMapCommandLineCompiler") <> null) with _ -> false
let stronglyHeldReaderCacheSizeDefault = 30
let stronglyHeldReaderCacheSize = try (match System.Environment.GetEnvironmentVariable("FSharp_StronglyHeldBinaryReaderCacheSize") with null -> stronglyHeldReaderCacheSizeDefault | s -> int32 s) with _ -> stronglyHeldReaderCacheSizeDefault
let singleOfBits (x:int32) = System.BitConverter.ToSingle(System.BitConverter.GetBytes(x), 0)
let doubleOfBits (x:int64) = System.BitConverter.Int64BitsToDouble(x)
//---------------------------------------------------------------------
// Utilities.
//---------------------------------------------------------------------
let align alignment n = ((n + alignment - 0x1) / alignment) * alignment
let uncodedToken (tab:TableName) idx = ((tab.Index <<< 24) ||| idx)
let i32ToUncodedToken tok =
let idx = tok &&& 0xffffff
let tab = tok >>>& 24
(TableName.FromIndex tab, idx)
[<Struct>]
type TaggedIndex<'T> =
val tag: 'T
val index : int32
new(tag, index) = { tag=tag; index=index }
let uncodedTokenToTypeDefOrRefOrSpec (tab, tok) =
let tag =
if tab = TableNames.TypeDef then tdor_TypeDef
elif tab = TableNames.TypeRef then tdor_TypeRef
elif tab = TableNames.TypeSpec then tdor_TypeSpec
else failwith "bad table in uncodedTokenToTypeDefOrRefOrSpec"
TaggedIndex(tag, tok)
let uncodedTokenToMethodDefOrRef (tab, tok) =
let tag =
if tab = TableNames.Method then mdor_MethodDef
elif tab = TableNames.MemberRef then mdor_MemberRef
else failwith "bad table in uncodedTokenToMethodDefOrRef"
TaggedIndex(tag, tok)
let (|TaggedIndex|) (x:TaggedIndex<'T>) = x.tag, x.index
let tokToTaggedIdx f nbits tok =
let tagmask =
if nbits = 1 then 1
elif nbits = 2 then 3
elif nbits = 3 then 7
elif nbits = 4 then 15
elif nbits = 5 then 31
else failwith "too many nbits"
let tag = tok &&& tagmask
let idx = tok >>>& nbits
TaggedIndex(f tag, idx)
type Statistics =
{ mutable rawMemoryFileCount : int
mutable memoryMapFileOpenedCount : int
mutable memoryMapFileClosedCount : int
mutable weakByteFileCount : int
mutable byteFileCount : int }
let stats =
{ rawMemoryFileCount = 0
memoryMapFileOpenedCount = 0
memoryMapFileClosedCount = 0
weakByteFileCount = 0
byteFileCount = 0 }
let GetStatistics() = stats
[<AbstractClass>]
/// An abstraction over how we access the contents of .NET binaries. May be backed by managed or unmanaged memory,
/// memory mapped file or by on-disk resources. These objects should never need explicit disposal - they must either
/// not hold resources of clean up after themselves when collected.
type BinaryView() =
/// Read a byte from the file
abstract ReadByte : addr:int -> byte
/// Read a chunk of bytes from the file
abstract ReadBytes : addr:int -> int -> byte[]
/// Read an Int32 from the file
abstract ReadInt32 : addr:int -> int
/// Read a UInt16 from the file
abstract ReadUInt16 : addr:int -> uint16
/// Read a length of a UTF8 string from the file
abstract CountUtf8String : addr:int -> int
/// Read a UTF8 string from the file
abstract ReadUTF8String : addr: int -> string
/// An abstraction over how we access the contents of .NET binaries. May be backed by managed or unmanaged memory,
/// memory mapped file or by on-disk resources.
type BinaryFile =
/// Return a BinaryView for temporary use which eagerly holds any necessary memory resources for the duration of its lifetime,
/// and is faster to access byte-by-byte. The returned BinaryView should _not_ be captured in a closure that outlives the
/// desired lifetime.
abstract GetView : unit -> BinaryView
/// A view over a raw pointer to memory
type RawMemoryView(obj: obj, start:nativeint, len: int) =
inherit BinaryView()
override m.ReadByte i =
if nativeint i + 1n > nativeint len then failwithf "RawMemoryView overrun, i = %d, obj = %A" i obj
Marshal.ReadByte(start + nativeint i)
override m.ReadBytes i n =
if nativeint i + nativeint n > nativeint len then failwithf "RawMemoryView overrun, i = %d, n = %d, obj = %A" i n obj
let res = Bytes.zeroCreate n
Marshal.Copy(start + nativeint i, res, 0, n)
res
override m.ReadInt32 i =
if nativeint i + 4n > nativeint len then failwithf "RawMemoryView overrun, i = %d, obj = %A" i obj
Marshal.ReadInt32(start + nativeint i)
override m.ReadUInt16 i =
if nativeint i + 2n > nativeint len then failwithf "RawMemoryView overrun, i = %d, obj = %A" i obj
uint16(Marshal.ReadInt16(start + nativeint i))
override m.CountUtf8String i =
if nativeint i > nativeint len then failwithf "RawMemoryView overrun, i = %d, obj = %A" i obj
let pStart = start + nativeint i
let mutable p = start
while Marshal.ReadByte(p) <> 0uy do
p <- p + 1n
int (p - pStart)
override m.ReadUTF8String i =
let n = m.CountUtf8String i
if nativeint i + nativeint n > nativeint len then failwithf "RawMemoryView overrun, i = %d, n = %d, obj = %A" i n obj
System.Runtime.InteropServices.Marshal.PtrToStringAnsi(start + nativeint i, n)
member __.HoldObj() = obj
/// Gives views over a raw chunk of memory, for example those returned to us by the memory manager in Roslyn's
/// Visual Studio integration. 'obj' must keep the memory alive. The object will capture it and thus also keep the memory alive for
/// the lifetime of this object.
type RawMemoryFile(fileName: string, obj: obj, addr: nativeint, length: int) =
do stats.rawMemoryFileCount <- stats.rawMemoryFileCount + 1
let view = RawMemoryView(obj, addr, length)
member __.HoldObj() = obj // make sure we capture 'obj'
member __.FileName = fileName
interface BinaryFile with
override __.GetView() = view :>_
/// Read from memory mapped files.
module MemoryMapping =
type HANDLE = nativeint
type ADDR = nativeint
type SIZE_T = nativeint
[<DllImport("kernel32", SetLastError=true)>]
extern bool CloseHandle (HANDLE _handler)
[<DllImport("kernel32", SetLastError=true, CharSet=CharSet.Unicode)>]
extern HANDLE CreateFile (string _lpFileName,
int _dwDesiredAccess,
int _dwShareMode,
HANDLE _lpSecurityAttributes,
int _dwCreationDisposition,
int _dwFlagsAndAttributes,
HANDLE _hTemplateFile)
[<DllImport("kernel32", SetLastError=true, CharSet=CharSet.Unicode)>]
extern HANDLE CreateFileMapping (HANDLE _hFile,
HANDLE _lpAttributes,
int _flProtect,
int _dwMaximumSizeLow,
int _dwMaximumSizeHigh,
string _lpName)
[<DllImport("kernel32", SetLastError=true)>]
extern ADDR MapViewOfFile (HANDLE _hFileMappingObject,
int _dwDesiredAccess,
int _dwFileOffsetHigh,
int _dwFileOffsetLow,
SIZE_T _dwNumBytesToMap)
[<DllImport("kernel32", SetLastError=true)>]
extern bool UnmapViewOfFile (ADDR _lpBaseAddress)
let INVALID_HANDLE = new IntPtr(-1)
let MAP_READ = 0x0004
let GENERIC_READ = 0x80000000
let NULL_HANDLE = IntPtr.Zero
let FILE_SHARE_NONE = 0x0000
let FILE_SHARE_READ = 0x0001
let FILE_SHARE_WRITE = 0x0002
let FILE_SHARE_READ_WRITE = 0x0003
let CREATE_ALWAYS = 0x0002
let OPEN_EXISTING = 0x0003
let OPEN_ALWAYS = 0x0004
/// A view over a raw pointer to memory given by a memory mapped file.
/// NOTE: we should do more checking of validity here.
type MemoryMapView(start:nativeint) =
inherit BinaryView()
override m.ReadByte i =
Marshal.ReadByte(start + nativeint i)
override m.ReadBytes i n =
let res = Bytes.zeroCreate n
Marshal.Copy(start + nativeint i, res, 0, n)
res
override m.ReadInt32 i =
Marshal.ReadInt32(start + nativeint i)
override m.ReadUInt16 i =
uint16(Marshal.ReadInt16(start + nativeint i))
override m.CountUtf8String i =
let pStart = start + nativeint i
let mutable p = start
while Marshal.ReadByte(p) <> 0uy do
p <- p + 1n
int (p - pStart)
override m.ReadUTF8String i =
let n = m.CountUtf8String i
System.Runtime.InteropServices.Marshal.PtrToStringAnsi(start + nativeint i, n)
/// Memory maps a file and creates a single view over the entirety of its contents. The
/// lock on the file is only released when the object is disposed.
/// For memory mapping we currently take one view and never release it.
[<DebuggerDisplay("{FileName}")>]
type MemoryMapFile(fileName: string, view: MemoryMapView, hMap: MemoryMapping.HANDLE, hView:nativeint) =
do stats.memoryMapFileOpenedCount <- stats.memoryMapFileOpenedCount + 1
let mutable closed = false
static member Create fileName =
let hFile = MemoryMapping.CreateFile (fileName, MemoryMapping.GENERIC_READ, MemoryMapping.FILE_SHARE_READ_WRITE, IntPtr.Zero, MemoryMapping.OPEN_EXISTING, 0, IntPtr.Zero )
if hFile.Equals(MemoryMapping.INVALID_HANDLE) then
failwithf "CreateFile(0x%08x)" (Marshal.GetHRForLastWin32Error())
let protection = 0x00000002
let hMap = MemoryMapping.CreateFileMapping (hFile, IntPtr.Zero, protection, 0, 0, null )
ignore(MemoryMapping.CloseHandle(hFile))
if hMap.Equals(MemoryMapping.NULL_HANDLE) then
failwithf "CreateFileMapping(0x%08x)" (Marshal.GetHRForLastWin32Error())
let hView = MemoryMapping.MapViewOfFile (hMap, MemoryMapping.MAP_READ, 0, 0, 0n)
if hView.Equals(IntPtr.Zero) then
failwithf "MapViewOfFile(0x%08x)" (Marshal.GetHRForLastWin32Error())
let view = MemoryMapView(hView)
MemoryMapFile(fileName, view, hMap, hView)
member __.FileName = fileName
member __.Close() =
stats.memoryMapFileClosedCount <- stats.memoryMapFileClosedCount + 1
if not closed then
closed <- true
MemoryMapping.UnmapViewOfFile hView |> ignore
MemoryMapping.CloseHandle hMap |> ignore
interface BinaryFile with
override __.GetView() = (view :> BinaryView)
/// Read file from memory blocks
type ByteView(bytes:byte[]) =
inherit BinaryView()
override __.ReadByte addr = bytes.[addr]
override __.ReadBytes addr len = Array.sub bytes addr len
override __.CountUtf8String addr =
let mutable p = addr
while bytes.[p] <> 0uy do
p <- p + 1
p - addr
override bfv.ReadUTF8String addr =
let n = bfv.CountUtf8String addr
System.Text.Encoding.UTF8.GetString (bytes, addr, n)
override bfv.ReadInt32 addr =
let b0 = bfv.ReadByte addr
let b1 = bfv.ReadByte (addr+1)
let b2 = bfv.ReadByte (addr+2)
let b3 = bfv.ReadByte (addr+3)
int b0 ||| (int b1 <<< 8) ||| (int b2 <<< 16) ||| (int b3 <<< 24)
override bfv.ReadUInt16 addr =
let b0 = bfv.ReadByte addr
let b1 = bfv.ReadByte (addr+1)
uint16 b0 ||| (uint16 b1 <<< 8)
/// A BinaryFile backed by an array of bytes held strongly as managed memory
[<DebuggerDisplay("{FileName}")>]
type ByteFile(fileName: string, bytes:byte[]) =
let view = ByteView(bytes)
do stats.byteFileCount <- stats.byteFileCount + 1
member __.FileName = fileName
interface BinaryFile with
override bf.GetView() = view :> BinaryView
/// Same as ByteFile but holds the bytes weakly. The bytes will be re-read from the backing file when a view is requested.
/// This is the default implementation used by F# Compiler Services when accessing "stable" binaries. It is not used
/// by Visual Studio, where tryGetMetadataSnapshot provides a RawMemoryFile backed by Roslyn data.
[<DebuggerDisplay("{FileName}")>]
type WeakByteFile(fileName: string, chunk: (int * int) option) =
do stats.weakByteFileCount <- stats.weakByteFileCount + 1
/// Used to check that the file hasn't changed
let fileStamp = FileSystem.GetLastWriteTimeShim(fileName)
/// The weak handle to the bytes for the file
let weakBytes = new WeakReference<byte[]> (null)
member __.FileName = fileName
/// Get the bytes for the file
interface BinaryFile with
override this.GetView() =
let strongBytes =
let mutable tg = null
if not (weakBytes.TryGetTarget(&tg)) then
if FileSystem.GetLastWriteTimeShim(fileName) <> fileStamp then
error (Error (FSComp.SR.ilreadFileChanged fileName, range0))
let bytes =
match chunk with
| None -> FileSystem.ReadAllBytesShim fileName
| Some(start, length) -> File.ReadBinaryChunk (fileName, start, length)
tg <- bytes
weakBytes.SetTarget bytes
tg
(ByteView(strongBytes) :> BinaryView)
let seekReadByte (mdv:BinaryView) addr = mdv.ReadByte addr
let seekReadBytes (mdv:BinaryView) addr len = mdv.ReadBytes addr len
let seekReadInt32 (mdv:BinaryView) addr = mdv.ReadInt32 addr
let seekReadUInt16 (mdv:BinaryView) addr = mdv.ReadUInt16 addr
let seekReadByteAsInt32 mdv addr = int32 (seekReadByte mdv addr)
let seekReadInt64 mdv addr =
let b0 = seekReadByte mdv addr
let b1 = seekReadByte mdv (addr+1)
let b2 = seekReadByte mdv (addr+2)
let b3 = seekReadByte mdv (addr+3)
let b4 = seekReadByte mdv (addr+4)
let b5 = seekReadByte mdv (addr+5)
let b6 = seekReadByte mdv (addr+6)
let b7 = seekReadByte mdv (addr+7)
int64 b0 ||| (int64 b1 <<< 8) ||| (int64 b2 <<< 16) ||| (int64 b3 <<< 24) |||
(int64 b4 <<< 32) ||| (int64 b5 <<< 40) ||| (int64 b6 <<< 48) ||| (int64 b7 <<< 56)
let seekReadUInt16AsInt32 mdv addr = int32 (seekReadUInt16 mdv addr)
let seekReadCompressedUInt32 mdv addr =
let b0 = seekReadByte mdv addr
if b0 <= 0x7Fuy then int b0, addr+1
elif b0 <= 0xBFuy then
let b0 = b0 &&& 0x7Fuy
let b1 = seekReadByteAsInt32 mdv (addr+1)
(int b0 <<< 8) ||| int b1, addr+2
else
let b0 = b0 &&& 0x3Fuy
let b1 = seekReadByteAsInt32 mdv (addr+1)
let b2 = seekReadByteAsInt32 mdv (addr+2)
let b3 = seekReadByteAsInt32 mdv (addr+3)
(int b0 <<< 24) ||| (int b1 <<< 16) ||| (int b2 <<< 8) ||| int b3, addr+4
let seekReadSByte mdv addr = sbyte (seekReadByte mdv addr)
let seekReadSingle mdv addr = singleOfBits (seekReadInt32 mdv addr)
let seekReadDouble mdv addr = doubleOfBits (seekReadInt64 mdv addr)
let rec seekCountUtf8String mdv addr n =
let c = seekReadByteAsInt32 mdv addr
if c = 0 then n
else seekCountUtf8String mdv (addr+1) (n+1)
let seekReadUTF8String mdv addr =
let n = seekCountUtf8String mdv addr 0
let bytes = seekReadBytes mdv addr n
System.Text.Encoding.UTF8.GetString (bytes, 0, bytes.Length)
let seekReadBlob mdv addr =
let len, addr = seekReadCompressedUInt32 mdv addr
seekReadBytes mdv addr len
let seekReadUserString mdv addr =
let len, addr = seekReadCompressedUInt32 mdv addr
let bytes = seekReadBytes mdv addr (len - 1)
Encoding.Unicode.GetString(bytes, 0, bytes.Length)
let seekReadGuid mdv addr = seekReadBytes mdv addr 0x10
let seekReadUncodedToken mdv addr =
i32ToUncodedToken (seekReadInt32 mdv addr)
//---------------------------------------------------------------------
// Primitives to help read signatures. These do not use the file cursor
//---------------------------------------------------------------------
let sigptrCheck (bytes:byte[]) sigptr =
if checking && sigptr >= bytes.Length then failwith "read past end of sig. "
// All this code should be moved to use a mutable index into the signature
//
//type SigPtr(bytes:byte[], sigptr:int) =
// let mutable curr = sigptr
// member x.GetByte() = let res = bytes.[curr] in curr <- curr + 1; res
let sigptrGetByte (bytes:byte[]) sigptr =
sigptrCheck bytes sigptr
bytes.[sigptr], sigptr + 1
let sigptrGetBool bytes sigptr =
let b0, sigptr = sigptrGetByte bytes sigptr
(b0 = 0x01uy) , sigptr
let sigptrGetSByte bytes sigptr =
let i, sigptr = sigptrGetByte bytes sigptr
sbyte i, sigptr
let sigptrGetUInt16 bytes sigptr =
let b0, sigptr = sigptrGetByte bytes sigptr
let b1, sigptr = sigptrGetByte bytes sigptr
uint16 (int b0 ||| (int b1 <<< 8)), sigptr
let sigptrGetInt16 bytes sigptr =
let u, sigptr = sigptrGetUInt16 bytes sigptr
int16 u, sigptr
let sigptrGetInt32 bytes sigptr =
sigptrCheck bytes sigptr
let b0 = bytes.[sigptr]
let b1 = bytes.[sigptr+1]
let b2 = bytes.[sigptr+2]
let b3 = bytes.[sigptr+3]
let res = int b0 ||| (int b1 <<< 8) ||| (int b2 <<< 16) ||| (int b3 <<< 24)
res, sigptr + 4
let sigptrGetUInt32 bytes sigptr =
let u, sigptr = sigptrGetInt32 bytes sigptr
uint32 u, sigptr
let sigptrGetUInt64 bytes sigptr =
let u0, sigptr = sigptrGetUInt32 bytes sigptr
let u1, sigptr = sigptrGetUInt32 bytes sigptr
(uint64 u0 ||| (uint64 u1 <<< 32)), sigptr
let sigptrGetInt64 bytes sigptr =
let u, sigptr = sigptrGetUInt64 bytes sigptr
int64 u, sigptr
let sigptrGetSingle bytes sigptr =
let u, sigptr = sigptrGetInt32 bytes sigptr
singleOfBits u, sigptr
let sigptrGetDouble bytes sigptr =
let u, sigptr = sigptrGetInt64 bytes sigptr
doubleOfBits u, sigptr
let sigptrGetZInt32 bytes sigptr =
let b0, sigptr = sigptrGetByte bytes sigptr
if b0 <= 0x7Fuy then int b0, sigptr
elif b0 <= 0xBFuy then
let b0 = b0 &&& 0x7Fuy
let b1, sigptr = sigptrGetByte bytes sigptr
(int b0 <<< 8) ||| int b1, sigptr
else
let b0 = b0 &&& 0x3Fuy
let b1, sigptr = sigptrGetByte bytes sigptr
let b2, sigptr = sigptrGetByte bytes sigptr
let b3, sigptr = sigptrGetByte bytes sigptr
(int b0 <<< 24) ||| (int b1 <<< 16) ||| (int b2 <<< 8) ||| int b3, sigptr
let rec sigptrFoldAcc f n (bytes:byte[]) (sigptr:int) i acc =
if i < n then
let x, sp = f bytes sigptr
sigptrFoldAcc f n bytes sp (i+1) (x::acc)
else
List.rev acc, sigptr
let sigptrFold f n (bytes:byte[]) (sigptr:int) =
sigptrFoldAcc f n bytes sigptr 0 []
let sigptrGetBytes n (bytes:byte[]) sigptr =
if checking && sigptr + n >= bytes.Length then
dprintn "read past end of sig. in sigptrGetString"
Bytes.zeroCreate 0, sigptr
else
let res = Bytes.zeroCreate n
for i = 0 to (n - 1) do
res.[i] <- bytes.[sigptr + i]
res, sigptr + n
let sigptrGetString n bytes sigptr =
let bytearray, sigptr = sigptrGetBytes n bytes sigptr
(System.Text.Encoding.UTF8.GetString(bytearray, 0, bytearray.Length)), sigptr
// --------------------------------------------------------------------
// Now the tables of instructions
// --------------------------------------------------------------------
[<NoEquality; NoComparison>]
type ILInstrPrefixesRegister =
{ mutable al: ILAlignment
mutable tl: ILTailcall
mutable vol: ILVolatility
mutable ro: ILReadonly
mutable constrained: ILType option}
let noPrefixes mk prefixes =
if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here"
if prefixes.vol <> Nonvolatile then failwith "a volatile prefix is not allowed here"
if prefixes.tl <> Normalcall then failwith "a tailcall prefix is not allowed here"
if prefixes.ro <> NormalAddress then failwith "a readonly prefix is not allowed here"
if prefixes.constrained <> None then failwith "a constrained prefix is not allowed here"
mk
let volatileOrUnalignedPrefix mk prefixes =
if prefixes.tl <> Normalcall then failwith "a tailcall prefix is not allowed here"
if prefixes.constrained <> None then failwith "a constrained prefix is not allowed here"
if prefixes.ro <> NormalAddress then failwith "a readonly prefix is not allowed here"
mk (prefixes.al, prefixes.vol)
let volatilePrefix mk prefixes =
if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here"
if prefixes.tl <> Normalcall then failwith "a tailcall prefix is not allowed here"
if prefixes.constrained <> None then failwith "a constrained prefix is not allowed here"
if prefixes.ro <> NormalAddress then failwith "a readonly prefix is not allowed here"
mk prefixes.vol
let tailPrefix mk prefixes =
if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here"
if prefixes.vol <> Nonvolatile then failwith "a volatile prefix is not allowed here"
if prefixes.constrained <> None then failwith "a constrained prefix is not allowed here"
if prefixes.ro <> NormalAddress then failwith "a readonly prefix is not allowed here"
mk prefixes.tl
let constraintOrTailPrefix mk prefixes =
if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here"
if prefixes.vol <> Nonvolatile then failwith "a volatile prefix is not allowed here"
if prefixes.ro <> NormalAddress then failwith "a readonly prefix is not allowed here"
mk (prefixes.constrained, prefixes.tl )
let readonlyPrefix mk prefixes =
if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here"
if prefixes.vol <> Nonvolatile then failwith "a volatile prefix is not allowed here"
if prefixes.tl <> Normalcall then failwith "a tailcall prefix is not allowed here"
if prefixes.constrained <> None then failwith "a constrained prefix is not allowed here"
mk prefixes.ro
[<NoEquality; NoComparison>]
type ILInstrDecoder =
| I_u16_u8_instr of (ILInstrPrefixesRegister -> uint16 -> ILInstr)
| I_u16_u16_instr of (ILInstrPrefixesRegister -> uint16 -> ILInstr)
| I_none_instr of (ILInstrPrefixesRegister -> ILInstr)
| I_i64_instr of (ILInstrPrefixesRegister -> int64 -> ILInstr)
| I_i32_i32_instr of (ILInstrPrefixesRegister -> int32 -> ILInstr)
| I_i32_i8_instr of (ILInstrPrefixesRegister -> int32 -> ILInstr)
| I_r4_instr of (ILInstrPrefixesRegister -> single -> ILInstr)
| I_r8_instr of (ILInstrPrefixesRegister -> double -> ILInstr)
| I_field_instr of (ILInstrPrefixesRegister -> ILFieldSpec -> ILInstr)
| I_method_instr of (ILInstrPrefixesRegister -> ILMethodSpec * ILVarArgs -> ILInstr)
| I_unconditional_i32_instr of (ILInstrPrefixesRegister -> ILCodeLabel -> ILInstr)
| I_unconditional_i8_instr of (ILInstrPrefixesRegister -> ILCodeLabel -> ILInstr)
| I_conditional_i32_instr of (ILInstrPrefixesRegister -> ILCodeLabel -> ILInstr)
| I_conditional_i8_instr of (ILInstrPrefixesRegister -> ILCodeLabel -> ILInstr)
| I_string_instr of (ILInstrPrefixesRegister -> string -> ILInstr)
| I_switch_instr of (ILInstrPrefixesRegister -> ILCodeLabel list -> ILInstr)
| I_tok_instr of (ILInstrPrefixesRegister -> ILToken -> ILInstr)
| I_sig_instr of (ILInstrPrefixesRegister -> ILCallingSignature * ILVarArgs -> ILInstr)
| I_type_instr of (ILInstrPrefixesRegister -> ILType -> ILInstr)
| I_invalid_instr
let mkStind dt = volatileOrUnalignedPrefix (fun (x, y) -> I_stind(x, y, dt))
let mkLdind dt = volatileOrUnalignedPrefix (fun (x, y) -> I_ldind(x, y, dt))
let instrs () =
[ i_ldarg_s, I_u16_u8_instr (noPrefixes mkLdarg)
i_starg_s, I_u16_u8_instr (noPrefixes I_starg)
i_ldarga_s, I_u16_u8_instr (noPrefixes I_ldarga)
i_stloc_s, I_u16_u8_instr (noPrefixes mkStloc)
i_ldloc_s, I_u16_u8_instr (noPrefixes mkLdloc)
i_ldloca_s, I_u16_u8_instr (noPrefixes I_ldloca)
i_ldarg, I_u16_u16_instr (noPrefixes mkLdarg)
i_starg, I_u16_u16_instr (noPrefixes I_starg)
i_ldarga, I_u16_u16_instr (noPrefixes I_ldarga)
i_stloc, I_u16_u16_instr (noPrefixes mkStloc)
i_ldloc, I_u16_u16_instr (noPrefixes mkLdloc)
i_ldloca, I_u16_u16_instr (noPrefixes I_ldloca)
i_stind_i, I_none_instr (mkStind DT_I)
i_stind_i1, I_none_instr (mkStind DT_I1)
i_stind_i2, I_none_instr (mkStind DT_I2)
i_stind_i4, I_none_instr (mkStind DT_I4)
i_stind_i8, I_none_instr (mkStind DT_I8)
i_stind_r4, I_none_instr (mkStind DT_R4)
i_stind_r8, I_none_instr (mkStind DT_R8)
i_stind_ref, I_none_instr (mkStind DT_REF)
i_ldind_i, I_none_instr (mkLdind DT_I)
i_ldind_i1, I_none_instr (mkLdind DT_I1)
i_ldind_i2, I_none_instr (mkLdind DT_I2)
i_ldind_i4, I_none_instr (mkLdind DT_I4)
i_ldind_i8, I_none_instr (mkLdind DT_I8)
i_ldind_u1, I_none_instr (mkLdind DT_U1)
i_ldind_u2, I_none_instr (mkLdind DT_U2)
i_ldind_u4, I_none_instr (mkLdind DT_U4)
i_ldind_r4, I_none_instr (mkLdind DT_R4)
i_ldind_r8, I_none_instr (mkLdind DT_R8)
i_ldind_ref, I_none_instr (mkLdind DT_REF)
i_cpblk, I_none_instr (volatileOrUnalignedPrefix I_cpblk)
i_initblk, I_none_instr (volatileOrUnalignedPrefix I_initblk)
i_ldc_i8, I_i64_instr (noPrefixes (fun x ->(AI_ldc (DT_I8, ILConst.I8 x))))
i_ldc_i4, I_i32_i32_instr (noPrefixes mkLdcInt32)
i_ldc_i4_s, I_i32_i8_instr (noPrefixes mkLdcInt32)
i_ldc_r4, I_r4_instr (noPrefixes (fun x -> (AI_ldc (DT_R4, ILConst.R4 x))))
i_ldc_r8, I_r8_instr (noPrefixes (fun x -> (AI_ldc (DT_R8, ILConst.R8 x))))
i_ldfld, I_field_instr (volatileOrUnalignedPrefix(fun (x, y) fspec -> I_ldfld(x, y, fspec)))
i_stfld, I_field_instr (volatileOrUnalignedPrefix(fun (x, y) fspec -> I_stfld(x, y, fspec)))
i_ldsfld, I_field_instr (volatilePrefix (fun x fspec -> I_ldsfld (x, fspec)))
i_stsfld, I_field_instr (volatilePrefix (fun x fspec -> I_stsfld (x, fspec)))
i_ldflda, I_field_instr (noPrefixes I_ldflda)
i_ldsflda, I_field_instr (noPrefixes I_ldsflda)
i_call, I_method_instr (tailPrefix (fun tl (mspec, y) -> I_call (tl, mspec, y)))
i_ldftn, I_method_instr (noPrefixes (fun (mspec, _y) -> I_ldftn mspec))
i_ldvirtftn, I_method_instr (noPrefixes (fun (mspec, _y) -> I_ldvirtftn mspec))
i_newobj, I_method_instr (noPrefixes I_newobj)
i_callvirt, I_method_instr (constraintOrTailPrefix (fun (c, tl) (mspec, y) -> match c with Some ty -> I_callconstraint(tl, ty, mspec, y) | None -> I_callvirt (tl, mspec, y)))
i_leave_s, I_unconditional_i8_instr (noPrefixes (fun x -> I_leave x))
i_br_s, I_unconditional_i8_instr (noPrefixes I_br)
i_leave, I_unconditional_i32_instr (noPrefixes (fun x -> I_leave x))
i_br, I_unconditional_i32_instr (noPrefixes I_br)
i_brtrue_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_brtrue, x)))
i_brfalse_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_brfalse, x)))
i_beq_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_beq, x)))
i_blt_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_blt, x)))
i_blt_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_blt_un, x)))
i_ble_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_ble, x)))
i_ble_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_ble_un, x)))
i_bgt_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bgt, x)))
i_bgt_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bgt_un, x)))
i_bge_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bge, x)))
i_bge_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bge_un, x)))
i_bne_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bne_un, x)))
i_brtrue, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_brtrue, x)))
i_brfalse, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_brfalse, x)))
i_beq, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_beq, x)))
i_blt, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_blt, x)))
i_blt_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_blt_un, x)))
i_ble, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_ble, x)))
i_ble_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_ble_un, x)))
i_bgt, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bgt, x)))
i_bgt_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bgt_un, x)))
i_bge, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bge, x)))
i_bge_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bge_un, x)))
i_bne_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bne_un, x)))
i_ldstr, I_string_instr (noPrefixes I_ldstr)
i_switch, I_switch_instr (noPrefixes I_switch)
i_ldtoken, I_tok_instr (noPrefixes I_ldtoken)
i_calli, I_sig_instr (tailPrefix (fun tl (x, y) -> I_calli (tl, x, y)))
i_mkrefany, I_type_instr (noPrefixes I_mkrefany)
i_refanyval, I_type_instr (noPrefixes I_refanyval)
i_ldelema, I_type_instr (readonlyPrefix (fun ro x -> I_ldelema (ro, false, ILArrayShape.SingleDimensional, x)))
i_ldelem_any, I_type_instr (noPrefixes (fun x -> I_ldelem_any (ILArrayShape.SingleDimensional, x)))
i_stelem_any, I_type_instr (noPrefixes (fun x -> I_stelem_any (ILArrayShape.SingleDimensional, x)))
i_newarr, I_type_instr (noPrefixes (fun x -> I_newarr (ILArrayShape.SingleDimensional, x)))
i_castclass, I_type_instr (noPrefixes I_castclass)
i_isinst, I_type_instr (noPrefixes I_isinst)
i_unbox_any, I_type_instr (noPrefixes I_unbox_any)
i_cpobj, I_type_instr (noPrefixes I_cpobj)
i_initobj, I_type_instr (noPrefixes I_initobj)
i_ldobj, I_type_instr (volatileOrUnalignedPrefix (fun (x, y) z -> I_ldobj (x, y, z)))
i_stobj, I_type_instr (volatileOrUnalignedPrefix (fun (x, y) z -> I_stobj (x, y, z)))
i_sizeof, I_type_instr (noPrefixes I_sizeof)
i_box, I_type_instr (noPrefixes I_box)
i_unbox, I_type_instr (noPrefixes I_unbox) ]
// The tables are delayed to avoid building them unnecessarily at startup
// Many applications of AbsIL (e.g. a compiler) don't need to read instructions.
let oneByteInstrs = ref None
let twoByteInstrs = ref None
let fillInstrs () =
let oneByteInstrTable = Array.create 256 I_invalid_instr
let twoByteInstrTable = Array.create 256 I_invalid_instr
let addInstr (i, f) =
if i > 0xff then
assert (i >>>& 8 = 0xfe)
let i = (i &&& 0xff)
match twoByteInstrTable.[i] with
| I_invalid_instr -> ()
| _ -> dprintn ("warning: duplicate decode entries for "+string i)
twoByteInstrTable.[i] <- f
else
match oneByteInstrTable.[i] with
| I_invalid_instr -> ()
| _ -> dprintn ("warning: duplicate decode entries for "+string i)
oneByteInstrTable.[i] <- f
List.iter addInstr (instrs())
List.iter (fun (x, mk) -> addInstr (x, I_none_instr (noPrefixes mk))) (noArgInstrs.Force())
oneByteInstrs := Some oneByteInstrTable
twoByteInstrs := Some twoByteInstrTable
let rec getOneByteInstr i =
match !oneByteInstrs with
| None -> fillInstrs(); getOneByteInstr i
| Some t -> t.[i]
let rec getTwoByteInstr i =
match !twoByteInstrs with
| None -> fillInstrs(); getTwoByteInstr i
| Some t -> t.[i]
//---------------------------------------------------------------------
//
//---------------------------------------------------------------------
type ImageChunk = { size: int32; addr: int32 }
let chunk sz next = ({addr=next; size=sz}, next + sz)
let nochunk next = ({addr= 0x0;size= 0x0; } , next)
type RowElementKind =
| UShort
| ULong
| Byte
| Data
| GGuid
| Blob
| SString
| SimpleIndex of TableName
| TypeDefOrRefOrSpec
| TypeOrMethodDef
| HasConstant
| HasCustomAttribute
| HasFieldMarshal
| HasDeclSecurity
| MemberRefParent
| HasSemantics
| MethodDefOrRef
| MemberForwarded
| Implementation
| CustomAttributeType
| ResolutionScope
type RowKind = RowKind of RowElementKind list
let kindAssemblyRef = RowKind [ UShort; UShort; UShort; UShort; ULong; Blob; SString; SString; Blob; ]
let kindModuleRef = RowKind [ SString ]
let kindFileRef = RowKind [ ULong; SString; Blob ]
let kindTypeRef = RowKind [ ResolutionScope; SString; SString ]
let kindTypeSpec = RowKind [ Blob ]
let kindTypeDef = RowKind [ ULong; SString; SString; TypeDefOrRefOrSpec; SimpleIndex TableNames.Field; SimpleIndex TableNames.Method ]
let kindPropertyMap = RowKind [ SimpleIndex TableNames.TypeDef; SimpleIndex TableNames.Property ]
let kindEventMap = RowKind [ SimpleIndex TableNames.TypeDef; SimpleIndex TableNames.Event ]
let kindInterfaceImpl = RowKind [ SimpleIndex TableNames.TypeDef; TypeDefOrRefOrSpec ]
let kindNested = RowKind [ SimpleIndex TableNames.TypeDef; SimpleIndex TableNames.TypeDef ]
let kindCustomAttribute = RowKind [ HasCustomAttribute; CustomAttributeType; Blob ]
let kindDeclSecurity = RowKind [ UShort; HasDeclSecurity; Blob ]
let kindMemberRef = RowKind [ MemberRefParent; SString; Blob ]
let kindStandAloneSig = RowKind [ Blob ]
let kindFieldDef = RowKind [ UShort; SString; Blob ]
let kindFieldRVA = RowKind [ Data; SimpleIndex TableNames.Field ]
let kindFieldMarshal = RowKind [ HasFieldMarshal; Blob ]
let kindConstant = RowKind [ UShort;HasConstant; Blob ]
let kindFieldLayout = RowKind [ ULong; SimpleIndex TableNames.Field ]
let kindParam = RowKind [ UShort; UShort; SString ]
let kindMethodDef = RowKind [ ULong; UShort; UShort; SString; Blob; SimpleIndex TableNames.Param ]
let kindMethodImpl = RowKind [ SimpleIndex TableNames.TypeDef; MethodDefOrRef; MethodDefOrRef ]
let kindImplMap = RowKind [ UShort; MemberForwarded; SString; SimpleIndex TableNames.ModuleRef ]
let kindMethodSemantics = RowKind [ UShort; SimpleIndex TableNames.Method; HasSemantics ]
let kindProperty = RowKind [ UShort; SString; Blob ]
let kindEvent = RowKind [ UShort; SString; TypeDefOrRefOrSpec ]
let kindManifestResource = RowKind [ ULong; ULong; SString; Implementation ]
let kindClassLayout = RowKind [ UShort; ULong; SimpleIndex TableNames.TypeDef ]
let kindExportedType = RowKind [ ULong; ULong; SString; SString; Implementation ]
let kindAssembly = RowKind [ ULong; UShort; UShort; UShort; UShort; ULong; Blob; SString; SString ]
let kindGenericParam_v1_1 = RowKind [ UShort; UShort; TypeOrMethodDef; SString; TypeDefOrRefOrSpec ]
let kindGenericParam_v2_0 = RowKind [ UShort; UShort; TypeOrMethodDef; SString ]
let kindMethodSpec = RowKind [ MethodDefOrRef; Blob ]
let kindGenericParamConstraint = RowKind [ SimpleIndex TableNames.GenericParam; TypeDefOrRefOrSpec ]
let kindModule = RowKind [ UShort; SString; GGuid; GGuid; GGuid ]
let kindIllegal = RowKind [ ]
//---------------------------------------------------------------------
// Used for binary searches of sorted tables. Each function that reads
// a table row returns a tuple that contains the elements of the row.
// One of these elements may be a key for a sorted table. These
// keys can be compared using the functions below depending on the
// kind of element in that column.
//---------------------------------------------------------------------
let hcCompare (TaggedIndex((t1: HasConstantTag), (idx1:int))) (TaggedIndex((t2: HasConstantTag), idx2)) =
if idx1 < idx2 then -1 elif idx1 > idx2 then 1 else compare t1.Tag t2.Tag
let hsCompare (TaggedIndex((t1:HasSemanticsTag), (idx1:int))) (TaggedIndex((t2:HasSemanticsTag), idx2)) =
if idx1 < idx2 then -1 elif idx1 > idx2 then 1 else compare t1.Tag t2.Tag
let hcaCompare (TaggedIndex((t1:HasCustomAttributeTag), (idx1:int))) (TaggedIndex((t2:HasCustomAttributeTag), idx2)) =
if idx1 < idx2 then -1 elif idx1 > idx2 then 1 else compare t1.Tag t2.Tag
let mfCompare (TaggedIndex((t1:MemberForwardedTag), (idx1:int))) (TaggedIndex((t2:MemberForwardedTag), idx2)) =
if idx1 < idx2 then -1 elif idx1 > idx2 then 1 else compare t1.Tag t2.Tag
let hdsCompare (TaggedIndex((t1:HasDeclSecurityTag), (idx1:int))) (TaggedIndex((t2:HasDeclSecurityTag), idx2)) =
if idx1 < idx2 then -1 elif idx1 > idx2 then 1 else compare t1.Tag t2.Tag
let hfmCompare (TaggedIndex((t1:HasFieldMarshalTag), idx1)) (TaggedIndex((t2:HasFieldMarshalTag), idx2)) =
if idx1 < idx2 then -1 elif idx1 > idx2 then 1 else compare t1.Tag t2.Tag
let tomdCompare (TaggedIndex((t1:TypeOrMethodDefTag), idx1)) (TaggedIndex((t2:TypeOrMethodDefTag), idx2)) =
if idx1 < idx2 then -1 elif idx1 > idx2 then 1 else compare t1.Tag t2.Tag
let simpleIndexCompare (idx1:int) (idx2:int) =
compare idx1 idx2
//---------------------------------------------------------------------
// The various keys for the various caches.
//---------------------------------------------------------------------
type TypeDefAsTypIdx = TypeDefAsTypIdx of ILBoxity * ILGenericArgs * int
type TypeRefAsTypIdx = TypeRefAsTypIdx of ILBoxity * ILGenericArgs * int
type BlobAsMethodSigIdx = BlobAsMethodSigIdx of int * int32
type BlobAsFieldSigIdx = BlobAsFieldSigIdx of int * int32
type BlobAsPropSigIdx = BlobAsPropSigIdx of int * int32
type BlobAsLocalSigIdx = BlobAsLocalSigIdx of int * int32
type MemberRefAsMspecIdx = MemberRefAsMspecIdx of int * int
type MethodSpecAsMspecIdx = MethodSpecAsMspecIdx of int * int
type MemberRefAsFspecIdx = MemberRefAsFspecIdx of int * int
type CustomAttrIdx = CustomAttrIdx of CustomAttributeTypeTag * int * int32
type GenericParamsIdx = GenericParamsIdx of int * TypeOrMethodDefTag * int
//---------------------------------------------------------------------
// Polymorphic caches for row and heap readers
//---------------------------------------------------------------------
let mkCacheInt32 lowMem _inbase _nm _sz =
if lowMem then (fun f x -> f x) else
let cache = ref null
let count = ref 0
#if STATISTICS
addReport (fun oc -> if !count <> 0 then oc.WriteLine ((_inbase + string !count + " "+ _nm + " cache hits") : string))
#endif
fun f (idx:int32) ->
let cache =
match !cache with
| null -> cache := new Dictionary<int32, _>(11)
| _ -> ()
!cache
let mutable res = Unchecked.defaultof<_>
let ok = cache.TryGetValue(idx, &res)
if ok then
incr count
res
else
let res = f idx
cache.[idx] <- res
res
let mkCacheGeneric lowMem _inbase _nm _sz =
if lowMem then (fun f x -> f x) else
let cache = ref null
let count = ref 0
#if STATISTICS
addReport (fun oc -> if !count <> 0 then oc.WriteLine ((_inbase + string !count + " " + _nm + " cache hits") : string))
#endif
fun f (idx :'T) ->
let cache =
match !cache with
| null -> cache := new Dictionary<_, _>(11 (* sz:int *) )
| _ -> ()
!cache
match cache.TryGetValue(idx) with
| true, v ->
incr count
v
| _ ->
let res = f idx
cache.[idx] <- res
res
//-----------------------------------------------------------------------
// Polymorphic general helpers for searching for particular rows.
// ----------------------------------------------------------------------
let seekFindRow numRows rowChooser =
let mutable i = 1
while (i <= numRows && not (rowChooser i)) do
i <- i + 1
if i > numRows then dprintn "warning: seekFindRow: row not found"
i
// search for rows satisfying predicate
let seekReadIndexedRows (numRows, rowReader, keyFunc, keyComparer, binaryChop, rowConverter) =
if binaryChop then
let mutable low = 0
let mutable high = numRows + 1
begin
let mutable fin = false
while not fin do
if high - low <= 1 then
fin <- true
else
let mid = (low + high) / 2
let midrow = rowReader mid
let c = keyComparer (keyFunc midrow)
if c > 0 then
low <- mid
elif c < 0 then
high <- mid
else
fin <- true
end
let mutable res = []
if high - low > 1 then
// now read off rows, forward and backwards
let mid = (low + high) / 2
// read forward
begin
let mutable fin = false
let mutable curr = mid
while not fin do
if curr > numRows then
fin <- true
else
let currrow = rowReader curr
if keyComparer (keyFunc currrow) = 0 then
res <- rowConverter currrow :: res
else
fin <- true
curr <- curr + 1
done
end
res <- List.rev res
// read backwards
begin
let mutable fin = false
let mutable curr = mid - 1
while not fin do
if curr = 0 then
fin <- true
else
let currrow = rowReader curr
if keyComparer (keyFunc currrow) = 0 then
res <- rowConverter currrow :: res
else
fin <- true
curr <- curr - 1
end
// sanity check
#if CHECKING
if checking then
let res2 =
[ for i = 1 to numRows do
let rowinfo = rowReader i
if keyComparer (keyFunc rowinfo) = 0 then
yield rowConverter rowinfo ]
if (res2 <> res) then
failwith ("results of binary search did not match results of linear search: linear search produced "+string res2.Length+", binary search produced "+string res.Length)
#endif
res
else
let res = ref []
for i = 1 to numRows do
let rowinfo = rowReader i
if keyComparer (keyFunc rowinfo) = 0 then
res := rowConverter rowinfo :: !res
List.rev !res
let seekReadOptionalIndexedRow info =
match seekReadIndexedRows info with
| [k] -> Some k
| [] -> None
| h::_ ->
dprintn ("multiple rows found when indexing table")
Some h
let seekReadIndexedRow info =
match seekReadOptionalIndexedRow info with
| Some row -> row
| None -> failwith ("no row found for key when indexing table")
//---------------------------------------------------------------------
// The big fat reader.
//---------------------------------------------------------------------
type MethodData = MethodData of ILType * ILCallingConv * string * ILTypes * ILType * ILTypes
type VarArgMethodData = VarArgMethodData of ILType * ILCallingConv * string * ILTypes * ILVarArgs * ILType * ILTypes
[<NoEquality; NoComparison; RequireQualifiedAccess>]
type PEReader =
{ fileName: string
#if FX_NO_PDB_READER
pdb: obj option
#else
pdb: (PdbReader * (string -> ILSourceDocument)) option
#endif
entryPointToken: TableName * int
pefile: BinaryFile
textSegmentPhysicalLoc : int32
textSegmentPhysicalSize : int32
dataSegmentPhysicalLoc : int32
dataSegmentPhysicalSize : int32
anyV2P : (string * int32) -> int32
metadataAddr: int32
sectionHeaders : (int32 * int32 * int32) list
nativeResourcesAddr:int32
nativeResourcesSize:int32
resourcesAddr:int32
strongnameAddr:int32
vtableFixupsAddr:int32
noFileOnDisk:bool
}
[<NoEquality; NoComparison; RequireQualifiedAccess>]
type ILMetadataReader =
{ ilg: ILGlobals
sorted: int64
mdfile: BinaryFile
pectxtCaptured: PEReader option // only set when reading full PE including code etc. for static linking
entryPointToken: TableName * int
dataEndPoints: Lazy<int32 list>
fileName:string
getNumRows: TableName -> int
userStringsStreamPhysicalLoc: int32
stringsStreamPhysicalLoc: int32
blobsStreamPhysicalLoc: int32
blobsStreamSize: int32
readUserStringHeap: (int32 -> string)
memoizeString: string -> string
readStringHeap: (int32 -> string)
readBlobHeap: (int32 -> byte[])
guidsStreamPhysicalLoc : int32
rowAddr : (TableName -> int -> int32)
tableBigness : bool array
rsBigness : bool
tdorBigness : bool
tomdBigness : bool
hcBigness : bool
hcaBigness : bool
hfmBigness : bool
hdsBigness : bool
mrpBigness : bool
hsBigness : bool
mdorBigness : bool
mfBigness : bool
iBigness : bool
catBigness : bool
stringsBigness: bool
guidsBigness: bool
blobsBigness: bool
seekReadNestedRow : int -> int * int
seekReadConstantRow : int -> uint16 * TaggedIndex<HasConstantTag> * int32
seekReadMethodSemanticsRow : int -> int32 * int * TaggedIndex<HasSemanticsTag>
seekReadTypeDefRow : int -> int32 * int32 * int32 * TaggedIndex<TypeDefOrRefTag> * int * int
seekReadAssemblyRef : int -> ILAssemblyRef
seekReadMethodSpecAsMethodData : MethodSpecAsMspecIdx -> VarArgMethodData
seekReadMemberRefAsMethodData : MemberRefAsMspecIdx -> VarArgMethodData
seekReadMemberRefAsFieldSpec : MemberRefAsFspecIdx -> ILFieldSpec
seekReadCustomAttr : CustomAttrIdx -> ILAttribute
seekReadTypeRef : int ->ILTypeRef
seekReadTypeRefAsType : TypeRefAsTypIdx -> ILType
readBlobHeapAsPropertySig : BlobAsPropSigIdx -> ILThisConvention * ILType * ILTypes
readBlobHeapAsFieldSig : BlobAsFieldSigIdx -> ILType
readBlobHeapAsMethodSig : BlobAsMethodSigIdx -> bool * int32 * ILCallingConv * ILType * ILTypes * ILVarArgs
readBlobHeapAsLocalsSig : BlobAsLocalSigIdx -> ILLocal list
seekReadTypeDefAsType : TypeDefAsTypIdx -> ILType
seekReadMethodDefAsMethodData : int -> MethodData
seekReadGenericParams : GenericParamsIdx -> ILGenericParameterDef list
seekReadFieldDefAsFieldSpec : int -> ILFieldSpec
customAttrsReader_Module : ILAttributesStored
customAttrsReader_Assembly : ILAttributesStored
customAttrsReader_TypeDef : ILAttributesStored
customAttrsReader_GenericParam: ILAttributesStored
customAttrsReader_FieldDef: ILAttributesStored
customAttrsReader_MethodDef: ILAttributesStored
customAttrsReader_ParamDef: ILAttributesStored
customAttrsReader_Event: ILAttributesStored
customAttrsReader_Property: ILAttributesStored
customAttrsReader_ManifestResource: ILAttributesStored
customAttrsReader_ExportedType: ILAttributesStored
securityDeclsReader_TypeDef : ILSecurityDeclsStored
securityDeclsReader_MethodDef : ILSecurityDeclsStored
securityDeclsReader_Assembly : ILSecurityDeclsStored
typeDefReader : ILTypeDefStored }
let seekReadUInt16Adv mdv (addr: byref<int>) =
let res = seekReadUInt16 mdv addr
addr <- addr + 2
res
let seekReadInt32Adv mdv (addr: byref<int>) =
let res = seekReadInt32 mdv addr
addr <- addr+4
res
let seekReadUInt16AsInt32Adv mdv (addr: byref<int>) =
let res = seekReadUInt16AsInt32 mdv addr
addr <- addr+2
res
let seekReadTaggedIdx f nbits big mdv (addr: byref<int>) =
let tok = if big then seekReadInt32Adv mdv &addr else seekReadUInt16AsInt32Adv mdv &addr
tokToTaggedIdx f nbits tok
let seekReadIdx big mdv (addr: byref<int>) =
if big then seekReadInt32Adv mdv &addr else seekReadUInt16AsInt32Adv mdv &addr
let seekReadUntaggedIdx (tab:TableName) (ctxt: ILMetadataReader) mdv (addr: byref<int>) =
seekReadIdx ctxt.tableBigness.[tab.Index] mdv &addr
let seekReadResolutionScopeIdx (ctxt: ILMetadataReader) mdv (addr: byref<int>) = seekReadTaggedIdx mkResolutionScopeTag 2 ctxt.rsBigness mdv &addr
let seekReadTypeDefOrRefOrSpecIdx (ctxt: ILMetadataReader) mdv (addr: byref<int>) = seekReadTaggedIdx mkTypeDefOrRefOrSpecTag 2 ctxt.tdorBigness mdv &addr
let seekReadTypeOrMethodDefIdx (ctxt: ILMetadataReader) mdv (addr: byref<int>) = seekReadTaggedIdx mkTypeOrMethodDefTag 1 ctxt.tomdBigness mdv &addr
let seekReadHasConstantIdx (ctxt: ILMetadataReader) mdv (addr: byref<int>) = seekReadTaggedIdx mkHasConstantTag 2 ctxt.hcBigness mdv &addr
let seekReadHasCustomAttributeIdx (ctxt: ILMetadataReader) mdv (addr: byref<int>) = seekReadTaggedIdx mkHasCustomAttributeTag 5 ctxt.hcaBigness mdv &addr
let seekReadHasFieldMarshalIdx (ctxt: ILMetadataReader) mdv (addr: byref<int>) = seekReadTaggedIdx mkHasFieldMarshalTag 1 ctxt.hfmBigness mdv &addr
let seekReadHasDeclSecurityIdx (ctxt: ILMetadataReader) mdv (addr: byref<int>) = seekReadTaggedIdx mkHasDeclSecurityTag 2 ctxt.hdsBigness mdv &addr
let seekReadMemberRefParentIdx (ctxt: ILMetadataReader) mdv (addr: byref<int>) = seekReadTaggedIdx mkMemberRefParentTag 3 ctxt.mrpBigness mdv &addr
let seekReadHasSemanticsIdx (ctxt: ILMetadataReader) mdv (addr: byref<int>) = seekReadTaggedIdx mkHasSemanticsTag 1 ctxt.hsBigness mdv &addr
let seekReadMethodDefOrRefIdx (ctxt: ILMetadataReader) mdv (addr: byref<int>) = seekReadTaggedIdx mkMethodDefOrRefTag 1 ctxt.mdorBigness mdv &addr
let seekReadMemberForwardedIdx (ctxt: ILMetadataReader) mdv (addr: byref<int>) = seekReadTaggedIdx mkMemberForwardedTag 1 ctxt.mfBigness mdv &addr
let seekReadImplementationIdx (ctxt: ILMetadataReader) mdv (addr: byref<int>) = seekReadTaggedIdx mkImplementationTag 2 ctxt.iBigness mdv &addr
let seekReadCustomAttributeTypeIdx (ctxt: ILMetadataReader) mdv (addr: byref<int>) = seekReadTaggedIdx mkILCustomAttributeTypeTag 3 ctxt.catBigness mdv &addr
let seekReadStringIdx (ctxt: ILMetadataReader) mdv (addr: byref<int>) = seekReadIdx ctxt.stringsBigness mdv &addr
let seekReadGuidIdx (ctxt: ILMetadataReader) mdv (addr: byref<int>) = seekReadIdx ctxt.guidsBigness mdv &addr
let seekReadBlobIdx (ctxt: ILMetadataReader) mdv (addr: byref<int>) = seekReadIdx ctxt.blobsBigness mdv &addr
let seekReadModuleRow (ctxt: ILMetadataReader) mdv idx =
if idx = 0 then failwith "cannot read Module table row 0"
let mutable addr = ctxt.rowAddr TableNames.Module idx
let generation = seekReadUInt16Adv mdv &addr
let nameIdx = seekReadStringIdx ctxt mdv &addr
let mvidIdx = seekReadGuidIdx ctxt mdv &addr
let encidIdx = seekReadGuidIdx ctxt mdv &addr
let encbaseidIdx = seekReadGuidIdx ctxt mdv &addr
(generation, nameIdx, mvidIdx, encidIdx, encbaseidIdx)
/// Read Table ILTypeRef.
let seekReadTypeRefRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.TypeRef idx
let scopeIdx = seekReadResolutionScopeIdx ctxt mdv &addr
let nameIdx = seekReadStringIdx ctxt mdv &addr
let namespaceIdx = seekReadStringIdx ctxt mdv &addr
(scopeIdx, nameIdx, namespaceIdx)
/// Read Table ILTypeDef.
let seekReadTypeDefRow (ctxt: ILMetadataReader) idx = ctxt.seekReadTypeDefRow idx
let seekReadTypeDefRowUncached ctxtH idx =
let (ctxt : ILMetadataReader) = getHole ctxtH
let mdv = ctxt.mdfile.GetView()
let mutable addr = ctxt.rowAddr TableNames.TypeDef idx
let flags = seekReadInt32Adv mdv &addr
let nameIdx = seekReadStringIdx ctxt mdv &addr
let namespaceIdx = seekReadStringIdx ctxt mdv &addr
let extendsIdx = seekReadTypeDefOrRefOrSpecIdx ctxt mdv &addr
let fieldsIdx = seekReadUntaggedIdx TableNames.Field ctxt mdv &addr
let methodsIdx = seekReadUntaggedIdx TableNames.Method ctxt mdv &addr
(flags, nameIdx, namespaceIdx, extendsIdx, fieldsIdx, methodsIdx)
/// Read Table Field.
let seekReadFieldRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.Field idx
let flags = seekReadUInt16AsInt32Adv mdv &addr
let nameIdx = seekReadStringIdx ctxt mdv &addr
let typeIdx = seekReadBlobIdx ctxt mdv &addr
(flags, nameIdx, typeIdx)
/// Read Table Method.
let seekReadMethodRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.Method idx
let codeRVA = seekReadInt32Adv mdv &addr
let implflags = seekReadUInt16AsInt32Adv mdv &addr
let flags = seekReadUInt16AsInt32Adv mdv &addr
let nameIdx = seekReadStringIdx ctxt mdv &addr
let typeIdx = seekReadBlobIdx ctxt mdv &addr
let paramIdx = seekReadUntaggedIdx TableNames.Param ctxt mdv &addr
(codeRVA, implflags, flags, nameIdx, typeIdx, paramIdx)
/// Read Table Param.
let seekReadParamRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.Param idx
let flags = seekReadUInt16AsInt32Adv mdv &addr
let seq = seekReadUInt16AsInt32Adv mdv &addr
let nameIdx = seekReadStringIdx ctxt mdv &addr
(flags, seq, nameIdx)
/// Read Table InterfaceImpl.
let seekReadInterfaceImplRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.InterfaceImpl idx
let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr
let intfIdx = seekReadTypeDefOrRefOrSpecIdx ctxt mdv &addr
(tidx, intfIdx)
/// Read Table MemberRef.
let seekReadMemberRefRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.MemberRef idx
let mrpIdx = seekReadMemberRefParentIdx ctxt mdv &addr
let nameIdx = seekReadStringIdx ctxt mdv &addr
let typeIdx = seekReadBlobIdx ctxt mdv &addr
(mrpIdx, nameIdx, typeIdx)
/// Read Table Constant.
let seekReadConstantRow (ctxt: ILMetadataReader) idx = ctxt.seekReadConstantRow idx
let seekReadConstantRowUncached ctxtH idx =
let (ctxt: ILMetadataReader) = getHole ctxtH
let mdv = ctxt.mdfile.GetView()
let mutable addr = ctxt.rowAddr TableNames.Constant idx
let kind = seekReadUInt16Adv mdv &addr
let parentIdx = seekReadHasConstantIdx ctxt mdv &addr
let valIdx = seekReadBlobIdx ctxt mdv &addr
(kind, parentIdx, valIdx)
/// Read Table CustomAttribute.
let seekReadCustomAttributeRow (ctxt: ILMetadataReader) idx =
let mdv = ctxt.mdfile.GetView()
let mutable addr = ctxt.rowAddr TableNames.CustomAttribute idx
let parentIdx = seekReadHasCustomAttributeIdx ctxt mdv &addr
let typeIdx = seekReadCustomAttributeTypeIdx ctxt mdv &addr
let valIdx = seekReadBlobIdx ctxt mdv &addr
(parentIdx, typeIdx, valIdx)
/// Read Table FieldMarshal.
let seekReadFieldMarshalRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.FieldMarshal idx
let parentIdx = seekReadHasFieldMarshalIdx ctxt mdv &addr
let typeIdx = seekReadBlobIdx ctxt mdv &addr
(parentIdx, typeIdx)
/// Read Table Permission.
let seekReadPermissionRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.Permission idx
let action = seekReadUInt16Adv mdv &addr
let parentIdx = seekReadHasDeclSecurityIdx ctxt mdv &addr
let typeIdx = seekReadBlobIdx ctxt mdv &addr
(action, parentIdx, typeIdx)
/// Read Table ClassLayout.
let seekReadClassLayoutRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.ClassLayout idx
let pack = seekReadUInt16Adv mdv &addr
let size = seekReadInt32Adv mdv &addr
let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr
(pack, size, tidx)
/// Read Table FieldLayout.
let seekReadFieldLayoutRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.FieldLayout idx
let offset = seekReadInt32Adv mdv &addr
let fidx = seekReadUntaggedIdx TableNames.Field ctxt mdv &addr
(offset, fidx)
//// Read Table StandAloneSig.
let seekReadStandAloneSigRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.StandAloneSig idx
let sigIdx = seekReadBlobIdx ctxt mdv &addr
sigIdx
/// Read Table EventMap.
let seekReadEventMapRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.EventMap idx
let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr
let eventsIdx = seekReadUntaggedIdx TableNames.Event ctxt mdv &addr
(tidx, eventsIdx)
/// Read Table Event.
let seekReadEventRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.Event idx
let flags = seekReadUInt16AsInt32Adv mdv &addr
let nameIdx = seekReadStringIdx ctxt mdv &addr
let typIdx = seekReadTypeDefOrRefOrSpecIdx ctxt mdv &addr
(flags, nameIdx, typIdx)
/// Read Table PropertyMap.
let seekReadPropertyMapRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.PropertyMap idx
let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr
let propsIdx = seekReadUntaggedIdx TableNames.Property ctxt mdv &addr
(tidx, propsIdx)
/// Read Table Property.
let seekReadPropertyRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.Property idx
let flags = seekReadUInt16AsInt32Adv mdv &addr
let nameIdx = seekReadStringIdx ctxt mdv &addr
let typIdx = seekReadBlobIdx ctxt mdv &addr
(flags, nameIdx, typIdx)
/// Read Table MethodSemantics.
let seekReadMethodSemanticsRow (ctxt: ILMetadataReader) idx = ctxt.seekReadMethodSemanticsRow idx
let seekReadMethodSemanticsRowUncached ctxtH idx =
let (ctxt: ILMetadataReader) = getHole ctxtH
let mdv = ctxt.mdfile.GetView()
let mutable addr = ctxt.rowAddr TableNames.MethodSemantics idx
let flags = seekReadUInt16AsInt32Adv mdv &addr
let midx = seekReadUntaggedIdx TableNames.Method ctxt mdv &addr
let assocIdx = seekReadHasSemanticsIdx ctxt mdv &addr
(flags, midx, assocIdx)
/// Read Table MethodImpl.
let seekReadMethodImplRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.MethodImpl idx
let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr
let mbodyIdx = seekReadMethodDefOrRefIdx ctxt mdv &addr
let mdeclIdx = seekReadMethodDefOrRefIdx ctxt mdv &addr
(tidx, mbodyIdx, mdeclIdx)
/// Read Table ILModuleRef.
let seekReadModuleRefRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.ModuleRef idx
let nameIdx = seekReadStringIdx ctxt mdv &addr
nameIdx
/// Read Table ILTypeSpec.
let seekReadTypeSpecRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.TypeSpec idx
let blobIdx = seekReadBlobIdx ctxt mdv &addr
blobIdx
/// Read Table ImplMap.
let seekReadImplMapRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.ImplMap idx
let flags = seekReadUInt16AsInt32Adv mdv &addr
let forwrdedIdx = seekReadMemberForwardedIdx ctxt mdv &addr
let nameIdx = seekReadStringIdx ctxt mdv &addr
let scopeIdx = seekReadUntaggedIdx TableNames.ModuleRef ctxt mdv &addr
(flags, forwrdedIdx, nameIdx, scopeIdx)
/// Read Table FieldRVA.
let seekReadFieldRVARow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.FieldRVA idx
let rva = seekReadInt32Adv mdv &addr
let fidx = seekReadUntaggedIdx TableNames.Field ctxt mdv &addr
(rva, fidx)
/// Read Table Assembly.
let seekReadAssemblyRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.Assembly idx
let hash = seekReadInt32Adv mdv &addr
let v1 = seekReadUInt16Adv mdv &addr
let v2 = seekReadUInt16Adv mdv &addr
let v3 = seekReadUInt16Adv mdv &addr
let v4 = seekReadUInt16Adv mdv &addr
let flags = seekReadInt32Adv mdv &addr
let publicKeyIdx = seekReadBlobIdx ctxt mdv &addr
let nameIdx = seekReadStringIdx ctxt mdv &addr
let localeIdx = seekReadStringIdx ctxt mdv &addr
(hash, v1, v2, v3, v4, flags, publicKeyIdx, nameIdx, localeIdx)
/// Read Table ILAssemblyRef.
let seekReadAssemblyRefRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.AssemblyRef idx
let v1 = seekReadUInt16Adv mdv &addr
let v2 = seekReadUInt16Adv mdv &addr
let v3 = seekReadUInt16Adv mdv &addr
let v4 = seekReadUInt16Adv mdv &addr
let flags = seekReadInt32Adv mdv &addr
let publicKeyOrTokenIdx = seekReadBlobIdx ctxt mdv &addr
let nameIdx = seekReadStringIdx ctxt mdv &addr
let localeIdx = seekReadStringIdx ctxt mdv &addr
let hashValueIdx = seekReadBlobIdx ctxt mdv &addr
(v1, v2, v3, v4, flags, publicKeyOrTokenIdx, nameIdx, localeIdx, hashValueIdx)
/// Read Table File.
let seekReadFileRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.File idx
let flags = seekReadInt32Adv mdv &addr
let nameIdx = seekReadStringIdx ctxt mdv &addr
let hashValueIdx = seekReadBlobIdx ctxt mdv &addr
(flags, nameIdx, hashValueIdx)
/// Read Table ILExportedTypeOrForwarder.
let seekReadExportedTypeRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.ExportedType idx
let flags = seekReadInt32Adv mdv &addr
let tok = seekReadInt32Adv mdv &addr
let nameIdx = seekReadStringIdx ctxt mdv &addr
let namespaceIdx = seekReadStringIdx ctxt mdv &addr
let implIdx = seekReadImplementationIdx ctxt mdv &addr
(flags, tok, nameIdx, namespaceIdx, implIdx)
/// Read Table ManifestResource.
let seekReadManifestResourceRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.ManifestResource idx
let offset = seekReadInt32Adv mdv &addr
let flags = seekReadInt32Adv mdv &addr
let nameIdx = seekReadStringIdx ctxt mdv &addr
let implIdx = seekReadImplementationIdx ctxt mdv &addr
(offset, flags, nameIdx, implIdx)
/// Read Table Nested.
let seekReadNestedRow (ctxt: ILMetadataReader) idx = ctxt.seekReadNestedRow idx
let seekReadNestedRowUncached ctxtH idx =
let (ctxt: ILMetadataReader) = getHole ctxtH
let mdv = ctxt.mdfile.GetView()
let mutable addr = ctxt.rowAddr TableNames.Nested idx
let nestedIdx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr
let enclIdx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr
(nestedIdx, enclIdx)
/// Read Table GenericParam.
let seekReadGenericParamRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.GenericParam idx
let seq = seekReadUInt16Adv mdv &addr
let flags = seekReadUInt16Adv mdv &addr
let ownerIdx = seekReadTypeOrMethodDefIdx ctxt mdv &addr
let nameIdx = seekReadStringIdx ctxt mdv &addr
(idx, seq, flags, ownerIdx, nameIdx)
// Read Table GenericParamConstraint.
let seekReadGenericParamConstraintRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.GenericParamConstraint idx
let pidx = seekReadUntaggedIdx TableNames.GenericParam ctxt mdv &addr
let constraintIdx = seekReadTypeDefOrRefOrSpecIdx ctxt mdv &addr
(pidx, constraintIdx)
/// Read Table ILMethodSpec.
let seekReadMethodSpecRow (ctxt: ILMetadataReader) mdv idx =
let mutable addr = ctxt.rowAddr TableNames.MethodSpec idx
let mdorIdx = seekReadMethodDefOrRefIdx ctxt mdv &addr
let instIdx = seekReadBlobIdx ctxt mdv &addr
(mdorIdx, instIdx)
let readUserStringHeapUncached ctxtH idx =
let (ctxt: ILMetadataReader) = getHole ctxtH
let mdv = ctxt.mdfile.GetView()
seekReadUserString mdv (ctxt.userStringsStreamPhysicalLoc + idx)
let readUserStringHeap (ctxt: ILMetadataReader) idx = ctxt.readUserStringHeap idx
let readStringHeapUncached ctxtH idx =
let (ctxt: ILMetadataReader) = getHole ctxtH
let mdv = ctxt.mdfile.GetView()
seekReadUTF8String mdv (ctxt.stringsStreamPhysicalLoc + idx)
let readStringHeap (ctxt: ILMetadataReader) idx = ctxt.readStringHeap idx
let readStringHeapOption (ctxt: ILMetadataReader) idx = if idx = 0 then None else Some (readStringHeap ctxt idx)
let emptyByteArray: byte[] = [||]
let readBlobHeapUncached ctxtH idx =
let (ctxt: ILMetadataReader) = getHole ctxtH
let mdv = ctxt.mdfile.GetView()
// valid index lies in range [1..streamSize)
// NOTE: idx cannot be 0 - Blob\String heap has first empty element that mdv one byte 0
if idx <= 0 || idx >= ctxt.blobsStreamSize then emptyByteArray
else seekReadBlob mdv (ctxt.blobsStreamPhysicalLoc + idx)
let readBlobHeap (ctxt: ILMetadataReader) idx = ctxt.readBlobHeap idx
let readBlobHeapOption ctxt idx = if idx = 0 then None else Some (readBlobHeap ctxt idx)
//let readGuidHeap ctxt idx = seekReadGuid ctxt.mdv (ctxt.guidsStreamPhysicalLoc + idx)
// read a single value out of a blob heap using the given function
let readBlobHeapAsBool ctxt vidx = fst (sigptrGetBool (readBlobHeap ctxt vidx) 0)
let readBlobHeapAsSByte ctxt vidx = fst (sigptrGetSByte (readBlobHeap ctxt vidx) 0)
let readBlobHeapAsInt16 ctxt vidx = fst (sigptrGetInt16 (readBlobHeap ctxt vidx) 0)
let readBlobHeapAsInt32 ctxt vidx = fst (sigptrGetInt32 (readBlobHeap ctxt vidx) 0)
let readBlobHeapAsInt64 ctxt vidx = fst (sigptrGetInt64 (readBlobHeap ctxt vidx) 0)
let readBlobHeapAsByte ctxt vidx = fst (sigptrGetByte (readBlobHeap ctxt vidx) 0)
let readBlobHeapAsUInt16 ctxt vidx = fst (sigptrGetUInt16 (readBlobHeap ctxt vidx) 0)
let readBlobHeapAsUInt32 ctxt vidx = fst (sigptrGetUInt32 (readBlobHeap ctxt vidx) 0)
let readBlobHeapAsUInt64 ctxt vidx = fst (sigptrGetUInt64 (readBlobHeap ctxt vidx) 0)
let readBlobHeapAsSingle ctxt vidx = fst (sigptrGetSingle (readBlobHeap ctxt vidx) 0)
let readBlobHeapAsDouble ctxt vidx = fst (sigptrGetDouble (readBlobHeap ctxt vidx) 0)
//-----------------------------------------------------------------------
// Some binaries have raw data embedded their text sections, e.g. mscorlib, for
// field inits. And there is no information that definitively tells us the extent of
// the text section that may be interesting data. But we certainly don't want to duplicate
// the entire text section as data!
//
// So, we assume:
// 1. no part of the metadata is double-used for raw data
// 2. the data bits are all the bits of the text section
// that stretch from a Field or Resource RVA to one of
// (a) the next Field or resource RVA
// (b) a MethodRVA
// (c) the start of the metadata
// (d) the end of a section
// (e) the start of the native resources attached to the binary if any
// ----------------------------------------------------------------------*)
// noFileOnDisk indicates that the PE file was read from Memory using OpenILModuleReaderFromBytes
// For example the assembly came from a type provider
// In this case we eagerly read the native resources into memory
let readNativeResources (pectxt: PEReader) =
[ if pectxt.nativeResourcesSize <> 0x0 && pectxt.nativeResourcesAddr <> 0x0 then
let start = pectxt.anyV2P (pectxt.fileName + ": native resources", pectxt.nativeResourcesAddr)
if pectxt.noFileOnDisk then
#if !FX_NO_LINKEDRESOURCES
let unlinkedResource =
let linkedResource = seekReadBytes (pectxt.pefile.GetView()) start pectxt.nativeResourcesSize
unlinkResource pectxt.nativeResourcesAddr linkedResource
yield ILNativeResource.Out unlinkedResource
#else
()
#endif
else
yield ILNativeResource.In (pectxt.fileName, pectxt.nativeResourcesAddr, start, pectxt.nativeResourcesSize ) ]
let getDataEndPointsDelayed (pectxt: PEReader) ctxtH =
lazy
let (ctxt: ILMetadataReader) = getHole ctxtH
let mdv = ctxt.mdfile.GetView()
let dataStartPoints =
let res = ref []
for i = 1 to ctxt.getNumRows (TableNames.FieldRVA) do
let rva, _fidx = seekReadFieldRVARow ctxt mdv i
res := ("field", rva) :: !res
for i = 1 to ctxt.getNumRows TableNames.ManifestResource do
let (offset, _, _, TaggedIndex(_tag, idx)) = seekReadManifestResourceRow ctxt mdv i
if idx = 0 then
let rva = pectxt.resourcesAddr + offset
res := ("manifest resource", rva) :: !res
!res
if isNil dataStartPoints then []
else
let methodRVAs =
let res = ref []
for i = 1 to ctxt.getNumRows TableNames.Method do
let (rva, _, _, nameIdx, _, _) = seekReadMethodRow ctxt mdv i
if rva <> 0 then
let nm = readStringHeap ctxt nameIdx
res := (nm, rva) :: !res
!res
([ pectxt.textSegmentPhysicalLoc + pectxt.textSegmentPhysicalSize ;
pectxt.dataSegmentPhysicalLoc + pectxt.dataSegmentPhysicalSize ]
@
(List.map pectxt.anyV2P
(dataStartPoints
@ [for (virtAddr, _virtSize, _physLoc) in pectxt.sectionHeaders do yield ("section start", virtAddr) done]
@ [("md", pectxt.metadataAddr)]
@ (if pectxt.nativeResourcesAddr = 0x0 then [] else [("native resources", pectxt.nativeResourcesAddr) ])
@ (if pectxt.resourcesAddr = 0x0 then [] else [("managed resources", pectxt.resourcesAddr) ])
@ (if pectxt.strongnameAddr = 0x0 then [] else [("managed strongname", pectxt.strongnameAddr) ])
@ (if pectxt.vtableFixupsAddr = 0x0 then [] else [("managed vtable_fixups", pectxt.vtableFixupsAddr) ])
@ methodRVAs)))
|> List.distinct
|> List.sort
let rvaToData (ctxt: ILMetadataReader) (pectxt: PEReader) nm rva =
if rva = 0x0 then failwith "rva is zero"
let start = pectxt.anyV2P (nm, rva)
let endPoints = (Lazy.force ctxt.dataEndPoints)
let rec look l =
match l with
| [] ->
failwithf "find_text_data_extent: none found for fileName=%s, name=%s, rva=0x%08x, start=0x%08x" ctxt.fileName nm rva start
| e::t ->
if start < e then
let pev = pectxt.pefile.GetView()
seekReadBytes pev start (e - start)
else look t
look endPoints
//-----------------------------------------------------------------------
// Read the AbsIL structure (lazily) by reading off the relevant rows.
// ----------------------------------------------------------------------
let isSorted (ctxt: ILMetadataReader) (tab:TableName) = ((ctxt.sorted &&& (int64 1 <<< tab.Index)) <> int64 0x0)
// Note, pectxtEager and pevEager must not be captured by the results of this function
let rec seekReadModule (ctxt: ILMetadataReader) (pectxtEager: PEReader) pevEager peinfo ilMetadataVersion idx =
let (subsys, subsysversion, useHighEntropyVA, ilOnly, only32, is32bitpreferred, only64, platform, isDll, alignVirt, alignPhys, imageBaseReal) = peinfo
let mdv = ctxt.mdfile.GetView()
let (_generation, nameIdx, _mvidIdx, _encidIdx, _encbaseidIdx) = seekReadModuleRow ctxt mdv idx
let ilModuleName = readStringHeap ctxt nameIdx
let nativeResources = readNativeResources pectxtEager
{ Manifest =
if ctxt.getNumRows (TableNames.Assembly) > 0 then Some (seekReadAssemblyManifest ctxt pectxtEager 1)
else None
CustomAttrsStored = ctxt.customAttrsReader_Module
MetadataIndex = idx
Name = ilModuleName
NativeResources=nativeResources
TypeDefs = mkILTypeDefsComputed (fun () -> seekReadTopTypeDefs ctxt)
SubSystemFlags = int32 subsys
IsILOnly = ilOnly
SubsystemVersion = subsysversion
UseHighEntropyVA = useHighEntropyVA
Platform = platform
StackReserveSize = None // TODO
Is32Bit = only32
Is32BitPreferred = is32bitpreferred
Is64Bit = only64
IsDLL=isDll
VirtualAlignment = alignVirt
PhysicalAlignment = alignPhys
ImageBase = imageBaseReal
MetadataVersion = ilMetadataVersion
Resources = seekReadManifestResources ctxt mdv pectxtEager pevEager }
and seekReadAssemblyManifest (ctxt: ILMetadataReader) pectxt idx =
let mdview = ctxt.mdfile.GetView()
let (hash, v1, v2, v3, v4, flags, publicKeyIdx, nameIdx, localeIdx) = seekReadAssemblyRow ctxt mdview idx
let name = readStringHeap ctxt nameIdx
let pubkey = readBlobHeapOption ctxt publicKeyIdx
{ Name= name
AuxModuleHashAlgorithm=hash
SecurityDeclsStored= ctxt.securityDeclsReader_Assembly
PublicKey= pubkey
Version= Some (v1, v2, v3, v4)
Locale= readStringHeapOption ctxt localeIdx
CustomAttrsStored = ctxt.customAttrsReader_Assembly
MetadataIndex = idx
AssemblyLongevity=
let masked = flags &&& 0x000e
if masked = 0x0000 then ILAssemblyLongevity.Unspecified
elif masked = 0x0002 then ILAssemblyLongevity.Library
elif masked = 0x0004 then ILAssemblyLongevity.PlatformAppDomain
elif masked = 0x0006 then ILAssemblyLongevity.PlatformProcess
elif masked = 0x0008 then ILAssemblyLongevity.PlatformSystem
else ILAssemblyLongevity.Unspecified
ExportedTypes= seekReadTopExportedTypes ctxt
EntrypointElsewhere=
let (tab, tok) = pectxt.entryPointToken
if tab = TableNames.File then Some (seekReadFile ctxt mdview tok) else None
Retargetable = 0 <> (flags &&& 0x100)
DisableJitOptimizations = 0 <> (flags &&& 0x4000)
JitTracking = 0 <> (flags &&& 0x8000)
IgnoreSymbolStoreSequencePoints = 0 <> (flags &&& 0x2000) }
and seekReadAssemblyRef (ctxt: ILMetadataReader) idx = ctxt.seekReadAssemblyRef idx
and seekReadAssemblyRefUncached ctxtH idx =
let (ctxt: ILMetadataReader) = getHole ctxtH
let mdv = ctxt.mdfile.GetView()
let (v1, v2, v3, v4, flags, publicKeyOrTokenIdx, nameIdx, localeIdx, hashValueIdx) = seekReadAssemblyRefRow ctxt mdv idx
let nm = readStringHeap ctxt nameIdx
let publicKey =
match readBlobHeapOption ctxt publicKeyOrTokenIdx with
| None -> None
| Some blob -> Some (if (flags &&& 0x0001) <> 0x0 then PublicKey blob else PublicKeyToken blob)
ILAssemblyRef.Create
(name=nm,
hash=readBlobHeapOption ctxt hashValueIdx,
publicKey=publicKey,
retargetable=((flags &&& 0x0100) <> 0x0),
version=Some(v1, v2, v3, v4),
locale=readStringHeapOption ctxt localeIdx)
and seekReadModuleRef (ctxt: ILMetadataReader) mdv idx =
let (nameIdx) = seekReadModuleRefRow ctxt mdv idx
ILModuleRef.Create(name = readStringHeap ctxt nameIdx, hasMetadata=true, hash=None)
and seekReadFile (ctxt: ILMetadataReader) mdv idx =
let (flags, nameIdx, hashValueIdx) = seekReadFileRow ctxt mdv idx
ILModuleRef.Create(name = readStringHeap ctxt nameIdx, hasMetadata= ((flags &&& 0x0001) = 0x0), hash= readBlobHeapOption ctxt hashValueIdx)
and seekReadClassLayout (ctxt: ILMetadataReader) mdv idx =
match seekReadOptionalIndexedRow (ctxt.getNumRows TableNames.ClassLayout, seekReadClassLayoutRow ctxt mdv, (fun (_, _, tidx) -> tidx), simpleIndexCompare idx, isSorted ctxt TableNames.ClassLayout, (fun (pack, size, _) -> pack, size)) with
| None -> { Size = None; Pack = None }
| Some (pack, size) -> { Size = Some size; Pack = Some pack }
and typeAccessOfFlags flags =
let f = (flags &&& 0x00000007)
if f = 0x00000001 then ILTypeDefAccess.Public
elif f = 0x00000002 then ILTypeDefAccess.Nested ILMemberAccess.Public
elif f = 0x00000003 then ILTypeDefAccess.Nested ILMemberAccess.Private
elif f = 0x00000004 then ILTypeDefAccess.Nested ILMemberAccess.Family
elif f = 0x00000006 then ILTypeDefAccess.Nested ILMemberAccess.FamilyAndAssembly
elif f = 0x00000007 then ILTypeDefAccess.Nested ILMemberAccess.FamilyOrAssembly
elif f = 0x00000005 then ILTypeDefAccess.Nested ILMemberAccess.Assembly
else ILTypeDefAccess.Private
and typeLayoutOfFlags (ctxt: ILMetadataReader) mdv flags tidx =
let f = (flags &&& 0x00000018)
if f = 0x00000008 then ILTypeDefLayout.Sequential (seekReadClassLayout ctxt mdv tidx)
elif f = 0x00000010 then ILTypeDefLayout.Explicit (seekReadClassLayout ctxt mdv tidx)
else ILTypeDefLayout.Auto
and isTopTypeDef flags =
(typeAccessOfFlags flags = ILTypeDefAccess.Private) ||
typeAccessOfFlags flags = ILTypeDefAccess.Public
and seekIsTopTypeDefOfIdx ctxt idx =
let (flags, _, _, _, _, _) = seekReadTypeDefRow ctxt idx
isTopTypeDef flags
and readBlobHeapAsSplitTypeName ctxt (nameIdx, namespaceIdx) =
let name = readStringHeap ctxt nameIdx
let nspace = readStringHeapOption ctxt namespaceIdx
match nspace with
| Some nspace -> splitNamespace nspace, name
| None -> [], name
and readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) =
let name = readStringHeap ctxt nameIdx
let nspace = readStringHeapOption ctxt namespaceIdx
match nspace with
| None -> name
| Some ns -> ctxt.memoizeString (ns+"."+name)
and seekReadTypeDefRowExtents (ctxt: ILMetadataReader) _info (idx:int) =
if idx >= ctxt.getNumRows TableNames.TypeDef then
ctxt.getNumRows TableNames.Field + 1,
ctxt.getNumRows TableNames.Method + 1
else
let (_, _, _, _, fieldsIdx, methodsIdx) = seekReadTypeDefRow ctxt (idx + 1)
fieldsIdx, methodsIdx
and seekReadTypeDefRowWithExtents ctxt (idx:int) =
let info= seekReadTypeDefRow ctxt idx
info, seekReadTypeDefRowExtents ctxt info idx
and seekReadPreTypeDef ctxt toponly (idx:int) =
let (flags, nameIdx, namespaceIdx, _, _, _) = seekReadTypeDefRow ctxt idx
if toponly && not (isTopTypeDef flags) then None
else
let ns, n = readBlobHeapAsSplitTypeName ctxt (nameIdx, namespaceIdx)
// Return the ILPreTypeDef
Some (mkILPreTypeDefRead (ns, n, idx, ctxt.typeDefReader))
and typeDefReader ctxtH : ILTypeDefStored =
mkILTypeDefReader
(fun idx ->
let (ctxt: ILMetadataReader) = getHole ctxtH
let mdv = ctxt.mdfile.GetView()
// Re-read so as not to save all these in the lazy closure - this suspension ctxt.is the largest
// heavily allocated one in all of AbsIL
let ((flags, nameIdx, namespaceIdx, extendsIdx, fieldsIdx, methodsIdx) as info) = seekReadTypeDefRow ctxt idx
let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx)
let (endFieldsIdx, endMethodsIdx) = seekReadTypeDefRowExtents ctxt info idx
let typars = seekReadGenericParams ctxt 0 (tomd_TypeDef, idx)
let numtypars = typars.Length
let super = seekReadOptionalTypeDefOrRef ctxt numtypars AsObject extendsIdx
let layout = typeLayoutOfFlags ctxt mdv flags idx
let hasLayout = (match layout with ILTypeDefLayout.Explicit _ -> true | _ -> false)
let mdefs = seekReadMethods ctxt numtypars methodsIdx endMethodsIdx
let fdefs = seekReadFields ctxt (numtypars, hasLayout) fieldsIdx endFieldsIdx
let nested = seekReadNestedTypeDefs ctxt idx
let impls = seekReadInterfaceImpls ctxt mdv numtypars idx
let mimpls = seekReadMethodImpls ctxt numtypars idx
let props = seekReadProperties ctxt numtypars idx
let events = seekReadEvents ctxt numtypars idx
ILTypeDef(name=nm,
genericParams=typars ,
attributes= enum<TypeAttributes>(flags),
layout = layout,
nestedTypes= nested,
implements = impls,
extends = super,
methods = mdefs,
securityDeclsStored = ctxt.securityDeclsReader_TypeDef,
fields=fdefs,
methodImpls=mimpls,
events= events,
properties=props,
customAttrsStored=ctxt.customAttrsReader_TypeDef,
metadataIndex=idx)
)
and seekReadTopTypeDefs (ctxt: ILMetadataReader) =
[| for i = 1 to ctxt.getNumRows TableNames.TypeDef do
match seekReadPreTypeDef ctxt true i with
| None -> ()
| Some td -> yield td |]
and seekReadNestedTypeDefs (ctxt: ILMetadataReader) tidx =
mkILTypeDefsComputed (fun () ->
let nestedIdxs = seekReadIndexedRows (ctxt.getNumRows TableNames.Nested, seekReadNestedRow ctxt, snd, simpleIndexCompare tidx, false, fst)
[| for i in nestedIdxs do
match seekReadPreTypeDef ctxt false i with
| None -> ()
| Some td -> yield td |])
and seekReadInterfaceImpls (ctxt: ILMetadataReader) mdv numtypars tidx =
seekReadIndexedRows (ctxt.getNumRows TableNames.InterfaceImpl,
seekReadInterfaceImplRow ctxt mdv,
fst,
simpleIndexCompare tidx,
isSorted ctxt TableNames.InterfaceImpl,
(snd >> seekReadTypeDefOrRef ctxt numtypars AsObject (*ok*) List.empty))
and seekReadGenericParams ctxt numtypars (a, b) : ILGenericParameterDefs =
ctxt.seekReadGenericParams (GenericParamsIdx(numtypars, a, b))
and seekReadGenericParamsUncached ctxtH (GenericParamsIdx(numtypars, a, b)) =
let (ctxt: ILMetadataReader) = getHole ctxtH
let mdv = ctxt.mdfile.GetView()
let pars =
seekReadIndexedRows
(ctxt.getNumRows TableNames.GenericParam, seekReadGenericParamRow ctxt mdv,
(fun (_, _, _, tomd, _) -> tomd),
tomdCompare (TaggedIndex(a, b)),
isSorted ctxt TableNames.GenericParam,
(fun (gpidx, seq, flags, _, nameIdx) ->
let flags = int32 flags
let variance_flags = flags &&& 0x0003
let variance =
if variance_flags = 0x0000 then NonVariant
elif variance_flags = 0x0001 then CoVariant
elif variance_flags = 0x0002 then ContraVariant
else NonVariant
let constraints = seekReadGenericParamConstraints ctxt mdv numtypars gpidx
seq, {Name=readStringHeap ctxt nameIdx
Constraints = constraints
Variance=variance
CustomAttrsStored = ctxt.customAttrsReader_GenericParam
MetadataIndex=gpidx
HasReferenceTypeConstraint= (flags &&& 0x0004) <> 0
HasNotNullableValueTypeConstraint= (flags &&& 0x0008) <> 0
HasDefaultConstructorConstraint=(flags &&& 0x0010) <> 0 }))
pars |> List.sortBy fst |> List.map snd
and seekReadGenericParamConstraints (ctxt: ILMetadataReader) mdv numtypars gpidx =
seekReadIndexedRows
(ctxt.getNumRows TableNames.GenericParamConstraint,
seekReadGenericParamConstraintRow ctxt mdv,
fst,
simpleIndexCompare gpidx,
isSorted ctxt TableNames.GenericParamConstraint,
(snd >> seekReadTypeDefOrRef ctxt numtypars AsObject (*ok*) List.empty))
and seekReadTypeDefAsType (ctxt: ILMetadataReader) boxity (ginst:ILTypes) idx =
ctxt.seekReadTypeDefAsType (TypeDefAsTypIdx (boxity, ginst, idx))
and seekReadTypeDefAsTypeUncached ctxtH (TypeDefAsTypIdx (boxity, ginst, idx)) =
let ctxt = getHole ctxtH
mkILTy boxity (ILTypeSpec.Create(seekReadTypeDefAsTypeRef ctxt idx, ginst))
and seekReadTypeDefAsTypeRef (ctxt: ILMetadataReader) idx =
let enc =
if seekIsTopTypeDefOfIdx ctxt idx then []
else
let enclIdx = seekReadIndexedRow (ctxt.getNumRows TableNames.Nested, seekReadNestedRow ctxt, fst, simpleIndexCompare idx, isSorted ctxt TableNames.Nested, snd)
let tref = seekReadTypeDefAsTypeRef ctxt enclIdx
tref.Enclosing@[tref.Name]
let (_, nameIdx, namespaceIdx, _, _, _) = seekReadTypeDefRow ctxt idx
let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx)
ILTypeRef.Create(scope=ILScopeRef.Local, enclosing=enc, name = nm )
and seekReadTypeRef (ctxt: ILMetadataReader) idx = ctxt.seekReadTypeRef idx
and seekReadTypeRefUncached ctxtH idx =
let (ctxt: ILMetadataReader) = getHole ctxtH
let mdv = ctxt.mdfile.GetView()
let scopeIdx, nameIdx, namespaceIdx = seekReadTypeRefRow ctxt mdv idx
let scope, enc = seekReadTypeRefScope ctxt mdv scopeIdx
let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx)
ILTypeRef.Create(scope=scope, enclosing=enc, name = nm)
and seekReadTypeRefAsType (ctxt: ILMetadataReader) boxity ginst idx = ctxt.seekReadTypeRefAsType (TypeRefAsTypIdx (boxity, ginst, idx))
and seekReadTypeRefAsTypeUncached ctxtH (TypeRefAsTypIdx (boxity, ginst, idx)) =
let ctxt = getHole ctxtH
mkILTy boxity (ILTypeSpec.Create(seekReadTypeRef ctxt idx, ginst))
and seekReadTypeDefOrRef (ctxt: ILMetadataReader) numtypars boxity (ginst:ILTypes) (TaggedIndex(tag, idx) ) =
let mdv = ctxt.mdfile.GetView()
match tag with
| tag when tag = tdor_TypeDef -> seekReadTypeDefAsType ctxt boxity ginst idx
| tag when tag = tdor_TypeRef -> seekReadTypeRefAsType ctxt boxity ginst idx
| tag when tag = tdor_TypeSpec ->
if not (List.isEmpty ginst) then dprintn ("type spec used as type constructor for a generic instantiation: ignoring instantiation")
readBlobHeapAsType ctxt numtypars (seekReadTypeSpecRow ctxt mdv idx)
| _ -> failwith "seekReadTypeDefOrRef ctxt"
and seekReadTypeDefOrRefAsTypeRef (ctxt: ILMetadataReader) (TaggedIndex(tag, idx) ) =
match tag with
| tag when tag = tdor_TypeDef -> seekReadTypeDefAsTypeRef ctxt idx
| tag when tag = tdor_TypeRef -> seekReadTypeRef ctxt idx
| tag when tag = tdor_TypeSpec ->
dprintn ("type spec used where a type ref or def is required")
ctxt.ilg.typ_Object.TypeRef
| _ -> failwith "seekReadTypeDefOrRefAsTypeRef_readTypeDefOrRefOrSpec"
and seekReadMethodRefParent (ctxt: ILMetadataReader) mdv numtypars (TaggedIndex(tag, idx)) =
match tag with
| tag when tag = mrp_TypeRef -> seekReadTypeRefAsType ctxt AsObject (* not ok - no way to tell if a member ref parent is a value type or not *) List.empty idx
| tag when tag = mrp_ModuleRef -> mkILTypeForGlobalFunctions (ILScopeRef.Module (seekReadModuleRef ctxt mdv idx))
| tag when tag = mrp_MethodDef ->
let (MethodData(enclTy, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData ctxt idx
let mspec = mkILMethSpecInTy (enclTy, cc, nm, argtys, retty, minst)
mspec.DeclaringType
| tag when tag = mrp_TypeSpec -> readBlobHeapAsType ctxt numtypars (seekReadTypeSpecRow ctxt mdv idx)
| _ -> failwith "seekReadMethodRefParent"
and seekReadMethodDefOrRef (ctxt: ILMetadataReader) numtypars (TaggedIndex(tag, idx)) =
match tag with
| tag when tag = mdor_MethodDef ->
let (MethodData(enclTy, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData ctxt idx
VarArgMethodData(enclTy, cc, nm, argtys, None, retty, minst)
| tag when tag = mdor_MemberRef ->
seekReadMemberRefAsMethodData ctxt numtypars idx
| _ -> failwith "seekReadMethodDefOrRef"
and seekReadMethodDefOrRefNoVarargs (ctxt: ILMetadataReader) numtypars x =
let (VarArgMethodData(enclTy, cc, nm, argtys, varargs, retty, minst)) = seekReadMethodDefOrRef ctxt numtypars x
if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef token signature"
MethodData(enclTy, cc, nm, argtys, retty, minst)
and seekReadCustomAttrType (ctxt: ILMetadataReader) (TaggedIndex(tag, idx) ) =
match tag with
| tag when tag = cat_MethodDef ->
let (MethodData(enclTy, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData ctxt idx
mkILMethSpecInTy (enclTy, cc, nm, argtys, retty, minst)
| tag when tag = cat_MemberRef ->
let (MethodData(enclTy, cc, nm, argtys, retty, minst)) = seekReadMemberRefAsMethDataNoVarArgs ctxt 0 idx
mkILMethSpecInTy (enclTy, cc, nm, argtys, retty, minst)
| _ -> failwith "seekReadCustomAttrType ctxt"
and seekReadImplAsScopeRef (ctxt: ILMetadataReader) mdv (TaggedIndex(tag, idx) ) =
if idx = 0 then ILScopeRef.Local
else
match tag with
| tag when tag = i_File -> ILScopeRef.Module (seekReadFile ctxt mdv idx)
| tag when tag = i_AssemblyRef -> ILScopeRef.Assembly (seekReadAssemblyRef ctxt idx)
| tag when tag = i_ExportedType -> failwith "seekReadImplAsScopeRef"
| _ -> failwith "seekReadImplAsScopeRef"
and seekReadTypeRefScope (ctxt: ILMetadataReader) mdv (TaggedIndex(tag, idx) ) =
match tag with
| tag when tag = rs_Module -> ILScopeRef.Local, []
| tag when tag = rs_ModuleRef -> ILScopeRef.Module (seekReadModuleRef ctxt mdv idx), []
| tag when tag = rs_AssemblyRef -> ILScopeRef.Assembly (seekReadAssemblyRef ctxt idx), []
| tag when tag = rs_TypeRef ->
let tref = seekReadTypeRef ctxt idx
tref.Scope, (tref.Enclosing@[tref.Name])
| _ -> failwith "seekReadTypeRefScope"
and seekReadOptionalTypeDefOrRef (ctxt: ILMetadataReader) numtypars boxity idx =
if idx = TaggedIndex(tdor_TypeDef, 0) then None
else Some (seekReadTypeDefOrRef ctxt numtypars boxity List.empty idx)
and seekReadField ctxt mdv (numtypars, hasLayout) (idx:int) =
let (flags, nameIdx, typeIdx) = seekReadFieldRow ctxt mdv idx
let nm = readStringHeap ctxt nameIdx
let isStatic = (flags &&& 0x0010) <> 0
ILFieldDef(name = nm,
fieldType= readBlobHeapAsFieldSig ctxt numtypars typeIdx,
attributes = enum<FieldAttributes>(flags),
literalValue = (if (flags &&& 0x8000) = 0 then None else Some (seekReadConstant ctxt (TaggedIndex(hc_FieldDef, idx)))),
marshal =
(if (flags &&& 0x1000) = 0 then
None
else
Some (seekReadIndexedRow (ctxt.getNumRows TableNames.FieldMarshal, seekReadFieldMarshalRow ctxt mdv,
fst, hfmCompare (TaggedIndex(hfm_FieldDef, idx)),
isSorted ctxt TableNames.FieldMarshal,
(snd >> readBlobHeapAsNativeType ctxt)))),
data =
(if (flags &&& 0x0100) = 0 then
None
else
match ctxt.pectxtCaptured with
| None -> None // indicates metadata only, where Data is not available
| Some pectxt ->
let rva = seekReadIndexedRow (ctxt.getNumRows TableNames.FieldRVA, seekReadFieldRVARow ctxt mdv,
snd, simpleIndexCompare idx, isSorted ctxt TableNames.FieldRVA, fst)
Some (rvaToData ctxt pectxt "field" rva)),
offset =
(if hasLayout && not isStatic then
Some (seekReadIndexedRow (ctxt.getNumRows TableNames.FieldLayout, seekReadFieldLayoutRow ctxt mdv,
snd, simpleIndexCompare idx, isSorted ctxt TableNames.FieldLayout, fst)) else None),
customAttrsStored=ctxt.customAttrsReader_FieldDef,
metadataIndex = idx)
and seekReadFields (ctxt: ILMetadataReader) (numtypars, hasLayout) fidx1 fidx2 =
mkILFieldsLazy
(lazy
let mdv = ctxt.mdfile.GetView()
[ for i = fidx1 to fidx2 - 1 do
yield seekReadField ctxt mdv (numtypars, hasLayout) i ])
and seekReadMethods (ctxt: ILMetadataReader) numtypars midx1 midx2 =
mkILMethodsComputed (fun () ->
let mdv = ctxt.mdfile.GetView()
[| for i = midx1 to midx2 - 1 do
yield seekReadMethod ctxt mdv numtypars i |])
and sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr =
let n, sigptr = sigptrGetZInt32 bytes sigptr
if (n &&& 0x01) = 0x0 then (* Type Def *)
TaggedIndex(tdor_TypeDef, (n >>>& 2)), sigptr
else (* Type Ref *)
TaggedIndex(tdor_TypeRef, (n >>>& 2)), sigptr
and sigptrGetTy (ctxt: ILMetadataReader) numtypars bytes sigptr =
let b0, sigptr = sigptrGetByte bytes sigptr
if b0 = et_OBJECT then ctxt.ilg.typ_Object , sigptr
elif b0 = et_STRING then ctxt.ilg.typ_String, sigptr
elif b0 = et_I1 then ctxt.ilg.typ_SByte, sigptr
elif b0 = et_I2 then ctxt.ilg.typ_Int16, sigptr
elif b0 = et_I4 then ctxt.ilg.typ_Int32, sigptr
elif b0 = et_I8 then ctxt.ilg.typ_Int64, sigptr
elif b0 = et_I then ctxt.ilg.typ_IntPtr, sigptr
elif b0 = et_U1 then ctxt.ilg.typ_Byte, sigptr
elif b0 = et_U2 then ctxt.ilg.typ_UInt16, sigptr
elif b0 = et_U4 then ctxt.ilg.typ_UInt32, sigptr
elif b0 = et_U8 then ctxt.ilg.typ_UInt64, sigptr
elif b0 = et_U then ctxt.ilg.typ_UIntPtr, sigptr
elif b0 = et_R4 then ctxt.ilg.typ_Single, sigptr
elif b0 = et_R8 then ctxt.ilg.typ_Double, sigptr
elif b0 = et_CHAR then ctxt.ilg.typ_Char, sigptr
elif b0 = et_BOOLEAN then ctxt.ilg.typ_Bool, sigptr
elif b0 = et_WITH then
let b0, sigptr = sigptrGetByte bytes sigptr
let tdorIdx, sigptr = sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr
let n, sigptr = sigptrGetZInt32 bytes sigptr
let argtys, sigptr = sigptrFold (sigptrGetTy ctxt numtypars) n bytes sigptr
seekReadTypeDefOrRef ctxt numtypars (if b0 = et_CLASS then AsObject else AsValue) argtys tdorIdx,
sigptr
elif b0 = et_CLASS then
let tdorIdx, sigptr = sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr
seekReadTypeDefOrRef ctxt numtypars AsObject List.empty tdorIdx, sigptr
elif b0 = et_VALUETYPE then
let tdorIdx, sigptr = sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr
seekReadTypeDefOrRef ctxt numtypars AsValue List.empty tdorIdx, sigptr
elif b0 = et_VAR then
let n, sigptr = sigptrGetZInt32 bytes sigptr
ILType.TypeVar (uint16 n), sigptr
elif b0 = et_MVAR then
let n, sigptr = sigptrGetZInt32 bytes sigptr
ILType.TypeVar (uint16 (n + numtypars)), sigptr
elif b0 = et_BYREF then
let ty, sigptr = sigptrGetTy ctxt numtypars bytes sigptr
ILType.Byref ty, sigptr
elif b0 = et_PTR then
let ty, sigptr = sigptrGetTy ctxt numtypars bytes sigptr
ILType.Ptr ty, sigptr
elif b0 = et_SZARRAY then
let ty, sigptr = sigptrGetTy ctxt numtypars bytes sigptr
mkILArr1DTy ty, sigptr
elif b0 = et_ARRAY then
let ty, sigptr = sigptrGetTy ctxt numtypars bytes sigptr
let rank, sigptr = sigptrGetZInt32 bytes sigptr
let numSized, sigptr = sigptrGetZInt32 bytes sigptr
let sizes, sigptr = sigptrFold sigptrGetZInt32 numSized bytes sigptr
let numLoBounded, sigptr = sigptrGetZInt32 bytes sigptr
let lobounds, sigptr = sigptrFold sigptrGetZInt32 numLoBounded bytes sigptr
let shape =
let dim i =
(if i < numLoBounded then Some (List.item i lobounds) else None),
(if i < numSized then Some (List.item i sizes) else None)
ILArrayShape (Array.toList (Array.init rank dim))
mkILArrTy (ty, shape), sigptr
elif b0 = et_VOID then ILType.Void, sigptr
elif b0 = et_TYPEDBYREF then
let t = mkILNonGenericValueTy(mkILTyRef(ctxt.ilg.primaryAssemblyScopeRef, "System.TypedReference"))
t, sigptr
elif b0 = et_CMOD_REQD || b0 = et_CMOD_OPT then
let tdorIdx, sigptr = sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr
let ty, sigptr = sigptrGetTy ctxt numtypars bytes sigptr
ILType.Modified((b0 = et_CMOD_REQD), seekReadTypeDefOrRefAsTypeRef ctxt tdorIdx, ty), sigptr
elif b0 = et_FNPTR then
let ccByte, sigptr = sigptrGetByte bytes sigptr
let generic, cc = byteAsCallConv ccByte
if generic then failwith "fptr sig may not be generic"
let numparams, sigptr = sigptrGetZInt32 bytes sigptr
let retty, sigptr = sigptrGetTy ctxt numtypars bytes sigptr
let argtys, sigptr = sigptrFold (sigptrGetTy ctxt numtypars) ( numparams) bytes sigptr
ILType.FunctionPointer
{ CallingConv=cc
ArgTypes = argtys
ReturnType=retty }
, sigptr
elif b0 = et_SENTINEL then failwith "varargs NYI"
else ILType.Void , sigptr
and sigptrGetVarArgTys (ctxt: ILMetadataReader) n numtypars bytes sigptr =
sigptrFold (sigptrGetTy ctxt numtypars) n bytes sigptr
and sigptrGetArgTys (ctxt: ILMetadataReader) n numtypars bytes sigptr acc =
if n <= 0 then (List.rev acc, None), sigptr
else
let b0, sigptr2 = sigptrGetByte bytes sigptr
if b0 = et_SENTINEL then
let varargs, sigptr = sigptrGetVarArgTys ctxt n numtypars bytes sigptr2
(List.rev acc, Some(varargs)), sigptr
else
let x, sigptr = sigptrGetTy ctxt numtypars bytes sigptr
sigptrGetArgTys ctxt (n-1) numtypars bytes sigptr (x::acc)
and sigptrGetLocal (ctxt: ILMetadataReader) numtypars bytes sigptr =
let pinned, sigptr =
let b0, sigptr' = sigptrGetByte bytes sigptr
if b0 = et_PINNED then
true, sigptr'
else
false, sigptr
let ty, sigptr = sigptrGetTy ctxt numtypars bytes sigptr
let loc : ILLocal = { IsPinned = pinned; Type = ty; DebugInfo = None }
loc, sigptr
and readBlobHeapAsMethodSig (ctxt: ILMetadataReader) numtypars blobIdx =
ctxt.readBlobHeapAsMethodSig (BlobAsMethodSigIdx (numtypars, blobIdx))
and readBlobHeapAsMethodSigUncached ctxtH (BlobAsMethodSigIdx (numtypars, blobIdx)) =
let (ctxt: ILMetadataReader) = getHole ctxtH
let bytes = readBlobHeap ctxt blobIdx
let sigptr = 0
let ccByte, sigptr = sigptrGetByte bytes sigptr
let generic, cc = byteAsCallConv ccByte
let genarity, sigptr = if generic then sigptrGetZInt32 bytes sigptr else 0x0, sigptr
let numparams, sigptr = sigptrGetZInt32 bytes sigptr
let retty, sigptr = sigptrGetTy ctxt numtypars bytes sigptr
let (argtys, varargs), _sigptr = sigptrGetArgTys ctxt numparams numtypars bytes sigptr []
generic, genarity, cc, retty, argtys, varargs
and readBlobHeapAsType ctxt numtypars blobIdx =
let bytes = readBlobHeap ctxt blobIdx
let ty, _sigptr = sigptrGetTy ctxt numtypars bytes 0
ty
and readBlobHeapAsFieldSig ctxt numtypars blobIdx =
ctxt.readBlobHeapAsFieldSig (BlobAsFieldSigIdx (numtypars, blobIdx))
and readBlobHeapAsFieldSigUncached ctxtH (BlobAsFieldSigIdx (numtypars, blobIdx)) =
let ctxt = getHole ctxtH
let bytes = readBlobHeap ctxt blobIdx
let sigptr = 0
let ccByte, sigptr = sigptrGetByte bytes sigptr
if ccByte <> e_IMAGE_CEE_CS_CALLCONV_FIELD then dprintn "warning: field sig was not CC_FIELD"
let retty, _sigptr = sigptrGetTy ctxt numtypars bytes sigptr
retty
and readBlobHeapAsPropertySig (ctxt: ILMetadataReader) numtypars blobIdx =
ctxt.readBlobHeapAsPropertySig (BlobAsPropSigIdx (numtypars, blobIdx))
and readBlobHeapAsPropertySigUncached ctxtH (BlobAsPropSigIdx (numtypars, blobIdx)) =
let ctxt = getHole ctxtH
let bytes = readBlobHeap ctxt blobIdx
let sigptr = 0
let ccByte, sigptr = sigptrGetByte bytes sigptr
let hasthis = byteAsHasThis ccByte
let ccMaxked = (ccByte &&& 0x0Fuy)
if ccMaxked <> e_IMAGE_CEE_CS_CALLCONV_PROPERTY then dprintn ("warning: property sig was "+string ccMaxked+" instead of CC_PROPERTY")
let numparams, sigptr = sigptrGetZInt32 bytes sigptr
let retty, sigptr = sigptrGetTy ctxt numtypars bytes sigptr
let argtys, _sigptr = sigptrFold (sigptrGetTy ctxt numtypars) ( numparams) bytes sigptr
hasthis, retty, argtys
and readBlobHeapAsLocalsSig (ctxt: ILMetadataReader) numtypars blobIdx =
ctxt.readBlobHeapAsLocalsSig (BlobAsLocalSigIdx (numtypars, blobIdx))
and readBlobHeapAsLocalsSigUncached ctxtH (BlobAsLocalSigIdx (numtypars, blobIdx)) =
let ctxt = getHole ctxtH
let bytes = readBlobHeap ctxt blobIdx
let sigptr = 0
let ccByte, sigptr = sigptrGetByte bytes sigptr
if ccByte <> e_IMAGE_CEE_CS_CALLCONV_LOCAL_SIG then dprintn "warning: local sig was not CC_LOCAL"
let numlocals, sigptr = sigptrGetZInt32 bytes sigptr
let localtys, _sigptr = sigptrFold (sigptrGetLocal ctxt numtypars) ( numlocals) bytes sigptr
localtys
and byteAsHasThis b =
let hasthis_masked = b &&& 0x60uy
if hasthis_masked = e_IMAGE_CEE_CS_CALLCONV_INSTANCE then ILThisConvention.Instance
elif hasthis_masked = e_IMAGE_CEE_CS_CALLCONV_INSTANCE_EXPLICIT then ILThisConvention.InstanceExplicit
else ILThisConvention.Static
and byteAsCallConv b =
let cc =
let ccMaxked = b &&& 0x0Fuy
if ccMaxked = e_IMAGE_CEE_CS_CALLCONV_FASTCALL then ILArgConvention.FastCall
elif ccMaxked = e_IMAGE_CEE_CS_CALLCONV_STDCALL then ILArgConvention.StdCall
elif ccMaxked = e_IMAGE_CEE_CS_CALLCONV_THISCALL then ILArgConvention.ThisCall
elif ccMaxked = e_IMAGE_CEE_CS_CALLCONV_CDECL then ILArgConvention.CDecl
elif ccMaxked = e_IMAGE_CEE_CS_CALLCONV_VARARG then ILArgConvention.VarArg
else ILArgConvention.Default
let generic = (b &&& e_IMAGE_CEE_CS_CALLCONV_GENERIC) <> 0x0uy
generic, Callconv (byteAsHasThis b, cc)
and seekReadMemberRefAsMethodData ctxt numtypars idx : VarArgMethodData =
ctxt.seekReadMemberRefAsMethodData (MemberRefAsMspecIdx (numtypars, idx))
and seekReadMemberRefAsMethodDataUncached ctxtH (MemberRefAsMspecIdx (numtypars, idx)) =
let (ctxt: ILMetadataReader) = getHole ctxtH
let mdv = ctxt.mdfile.GetView()
let (mrpIdx, nameIdx, typeIdx) = seekReadMemberRefRow ctxt mdv idx
let nm = readStringHeap ctxt nameIdx
let enclTy = seekReadMethodRefParent ctxt mdv numtypars mrpIdx
let _generic, genarity, cc, retty, argtys, varargs = readBlobHeapAsMethodSig ctxt enclTy.GenericArgs.Length typeIdx
let minst = List.init genarity (fun n -> mkILTyvarTy (uint16 (numtypars+n)))
(VarArgMethodData(enclTy, cc, nm, argtys, varargs, retty, minst))
and seekReadMemberRefAsMethDataNoVarArgs ctxt numtypars idx : MethodData =
let (VarArgMethodData(enclTy, cc, nm, argtys, varargs, retty, minst)) = seekReadMemberRefAsMethodData ctxt numtypars idx
if Option.isSome varargs then dprintf "ignoring sentinel and varargs in ILMethodDef token signature"
(MethodData(enclTy, cc, nm, argtys, retty, minst))
and seekReadMethodSpecAsMethodData (ctxt: ILMetadataReader) numtypars idx =
ctxt.seekReadMethodSpecAsMethodData (MethodSpecAsMspecIdx (numtypars, idx))
and seekReadMethodSpecAsMethodDataUncached ctxtH (MethodSpecAsMspecIdx (numtypars, idx)) =
let (ctxt: ILMetadataReader) = getHole ctxtH
let mdv = ctxt.mdfile.GetView()
let (mdorIdx, instIdx) = seekReadMethodSpecRow ctxt mdv idx
let (VarArgMethodData(enclTy, cc, nm, argtys, varargs, retty, _)) = seekReadMethodDefOrRef ctxt numtypars mdorIdx
let minst =
let bytes = readBlobHeap ctxt instIdx
let sigptr = 0
let ccByte, sigptr = sigptrGetByte bytes sigptr
if ccByte <> e_IMAGE_CEE_CS_CALLCONV_GENERICINST then dprintn ("warning: method inst ILCallingConv was "+string ccByte+" instead of CC_GENERICINST")
let numgpars, sigptr = sigptrGetZInt32 bytes sigptr
let argtys, _sigptr = sigptrFold (sigptrGetTy ctxt numtypars) numgpars bytes sigptr
argtys
VarArgMethodData(enclTy, cc, nm, argtys, varargs, retty, minst)
and seekReadMemberRefAsFieldSpec (ctxt: ILMetadataReader) numtypars idx =
ctxt.seekReadMemberRefAsFieldSpec (MemberRefAsFspecIdx (numtypars, idx))
and seekReadMemberRefAsFieldSpecUncached ctxtH (MemberRefAsFspecIdx (numtypars, idx)) =
let (ctxt: ILMetadataReader) = getHole ctxtH
let mdv = ctxt.mdfile.GetView()
let (mrpIdx, nameIdx, typeIdx) = seekReadMemberRefRow ctxt mdv idx
let nm = readStringHeap ctxt nameIdx
let enclTy = seekReadMethodRefParent ctxt mdv numtypars mrpIdx
let retty = readBlobHeapAsFieldSig ctxt numtypars typeIdx
mkILFieldSpecInTy(enclTy, nm, retty)
// One extremely annoying aspect of the MD format is that given a
// ILMethodDef token it is non-trivial to find which ILTypeDef it belongs
// to. So we do a binary chop through the ILTypeDef table
// looking for which ILTypeDef has the ILMethodDef within its range.
// Although the ILTypeDef table is not "sorted", it is effectively sorted by
// method-range and field-range start/finish indexes
and seekReadMethodDefAsMethodData ctxt idx =
ctxt.seekReadMethodDefAsMethodData idx
and seekReadMethodDefAsMethodDataUncached ctxtH idx =
let (ctxt: ILMetadataReader) = getHole ctxtH
let mdv = ctxt.mdfile.GetView()
// Look for the method def parent.
let tidx =
seekReadIndexedRow (ctxt.getNumRows TableNames.TypeDef,
(fun i -> i, seekReadTypeDefRowWithExtents ctxt i),
(fun r -> r),
(fun (_, ((_, _, _, _, _, methodsIdx),
(_, endMethodsIdx))) ->
if endMethodsIdx <= idx then 1
elif methodsIdx <= idx && idx < endMethodsIdx then 0
else -1),
true, fst)
// Create a formal instantiation if needed
let typeGenericArgs = seekReadGenericParams ctxt 0 (tomd_TypeDef, tidx)
let typeGenericArgsCount = typeGenericArgs.Length
let methodGenericArgs = seekReadGenericParams ctxt typeGenericArgsCount (tomd_MethodDef, idx)
let finst = mkILFormalGenericArgs 0 typeGenericArgs
let minst = mkILFormalGenericArgs typeGenericArgsCount methodGenericArgs
// Read the method def parent.
let enclTy = seekReadTypeDefAsType ctxt AsObject (* not ok: see note *) finst tidx
// Return the constituent parts: put it together at the place where this is called.
let (_code_rva, _implflags, _flags, nameIdx, typeIdx, _paramIdx) = seekReadMethodRow ctxt mdv idx
let nm = readStringHeap ctxt nameIdx
// Read the method def signature.
let _generic, _genarity, cc, retty, argtys, varargs = readBlobHeapAsMethodSig ctxt typeGenericArgsCount typeIdx
if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef token signature"
MethodData(enclTy, cc, nm, argtys, retty, minst)
and seekReadFieldDefAsFieldSpec (ctxt: ILMetadataReader) idx =
ctxt.seekReadFieldDefAsFieldSpec idx
and seekReadFieldDefAsFieldSpecUncached ctxtH idx =
let (ctxt: ILMetadataReader) = getHole ctxtH
let mdv = ctxt.mdfile.GetView()
let (_flags, nameIdx, typeIdx) = seekReadFieldRow ctxt mdv idx
let nm = readStringHeap ctxt nameIdx
(* Look for the field def parent. *)
let tidx =
seekReadIndexedRow (ctxt.getNumRows TableNames.TypeDef,
(fun i -> i, seekReadTypeDefRowWithExtents ctxt i),
(fun r -> r),
(fun (_, ((_, _, _, _, fieldsIdx, _), (endFieldsIdx, _))) ->
if endFieldsIdx <= idx then 1
elif fieldsIdx <= idx && idx < endFieldsIdx then 0
else -1),
true, fst)
// Read the field signature.
let retty = readBlobHeapAsFieldSig ctxt 0 typeIdx
// Create a formal instantiation if needed
let finst = mkILFormalGenericArgs 0 (seekReadGenericParams ctxt 0 (tomd_TypeDef, tidx))
// Read the field def parent.
let enclTy = seekReadTypeDefAsType ctxt AsObject (* not ok: see note *) finst tidx
// Put it together.
mkILFieldSpecInTy(enclTy, nm, retty)
and seekReadMethod (ctxt: ILMetadataReader) mdv numtypars (idx:int) =
let (codeRVA, implflags, flags, nameIdx, typeIdx, paramIdx) = seekReadMethodRow ctxt mdv idx
let nm = readStringHeap ctxt nameIdx
let abstr = (flags &&& 0x0400) <> 0x0
let pinvoke = (flags &&& 0x2000) <> 0x0
let codetype = implflags &&& 0x0003
let unmanaged = (implflags &&& 0x0004) <> 0x0
let internalcall = (implflags &&& 0x1000) <> 0x0
let noinline = (implflags &&& 0x0008) <> 0x0
let aggressiveinline = (implflags &&& 0x0100) <> 0x0
let _generic, _genarity, cc, retty, argtys, varargs = readBlobHeapAsMethodSig ctxt numtypars typeIdx
if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef signature"
let endParamIdx =
if idx >= ctxt.getNumRows TableNames.Method then
ctxt.getNumRows TableNames.Param + 1
else
let (_, _, _, _, _, paramIdx) = seekReadMethodRow ctxt mdv (idx + 1)
paramIdx
let ret, ilParams = seekReadParams ctxt mdv (retty, argtys) paramIdx endParamIdx
let isEntryPoint =
let (tab, tok) = ctxt.entryPointToken
(tab = TableNames.Method && tok = idx)
let body =
if (codetype = 0x01) && pinvoke then
methBodyNative
elif pinvoke then
seekReadImplMap ctxt nm idx
elif internalcall || abstr || unmanaged || (codetype <> 0x00) then
methBodyAbstract
else
match ctxt.pectxtCaptured with
| None -> methBodyNotAvailable
| Some pectxt -> seekReadMethodRVA pectxt ctxt (idx, nm, internalcall, noinline, aggressiveinline, numtypars) codeRVA
ILMethodDef(name=nm,
attributes = enum<MethodAttributes>(flags),
implAttributes= enum<MethodImplAttributes>(implflags),
securityDeclsStored=ctxt.securityDeclsReader_MethodDef,
isEntryPoint=isEntryPoint,
genericParams=seekReadGenericParams ctxt numtypars (tomd_MethodDef, idx),
parameters= ilParams,
callingConv=cc,
ret=ret,
body=body,
customAttrsStored=ctxt.customAttrsReader_MethodDef,
metadataIndex=idx)
and seekReadParams (ctxt: ILMetadataReader) mdv (retty, argtys) pidx1 pidx2 =
let retRes = ref (mkILReturn retty)
let paramsRes = argtys |> List.toArray |> Array.map mkILParamAnon
for i = pidx1 to pidx2 - 1 do
seekReadParamExtras ctxt mdv (retRes, paramsRes) i
!retRes, List.ofArray paramsRes
and seekReadParamExtras (ctxt: ILMetadataReader) mdv (retRes, paramsRes) (idx:int) =
let (flags, seq, nameIdx) = seekReadParamRow ctxt mdv idx
let inOutMasked = (flags &&& 0x00FF)
let hasMarshal = (flags &&& 0x2000) <> 0x0
let hasDefault = (flags &&& 0x1000) <> 0x0
let fmReader idx = seekReadIndexedRow (ctxt.getNumRows TableNames.FieldMarshal, seekReadFieldMarshalRow ctxt mdv, fst, hfmCompare idx, isSorted ctxt TableNames.FieldMarshal, (snd >> readBlobHeapAsNativeType ctxt))
if seq = 0 then
retRes := { !retRes with
Marshal=(if hasMarshal then Some (fmReader (TaggedIndex(hfm_ParamDef, idx))) else None)
CustomAttrsStored = ctxt.customAttrsReader_ParamDef
MetadataIndex = idx}
elif seq > Array.length paramsRes then dprintn "bad seq num. for param"
else
paramsRes.[seq - 1] <-
{ paramsRes.[seq - 1] with
Marshal=(if hasMarshal then Some (fmReader (TaggedIndex(hfm_ParamDef, idx))) else None)
Default = (if hasDefault then Some (seekReadConstant ctxt (TaggedIndex(hc_ParamDef, idx))) else None)
Name = readStringHeapOption ctxt nameIdx
IsIn = ((inOutMasked &&& 0x0001) <> 0x0)
IsOut = ((inOutMasked &&& 0x0002) <> 0x0)
IsOptional = ((inOutMasked &&& 0x0010) <> 0x0)
CustomAttrsStored = ctxt.customAttrsReader_ParamDef
MetadataIndex = idx }
and seekReadMethodImpls (ctxt: ILMetadataReader) numtypars tidx =
mkILMethodImplsLazy
(lazy
let mdv = ctxt.mdfile.GetView()
let mimpls = seekReadIndexedRows (ctxt.getNumRows TableNames.MethodImpl, seekReadMethodImplRow ctxt mdv, (fun (a, _, _) -> a), simpleIndexCompare tidx, isSorted ctxt TableNames.MethodImpl, (fun (_, b, c) -> b, c))
mimpls |> List.map (fun (b, c) ->
{ OverrideBy=
let (MethodData(enclTy, cc, nm, argtys, retty, minst)) = seekReadMethodDefOrRefNoVarargs ctxt numtypars b
mkILMethSpecInTy (enclTy, cc, nm, argtys, retty, minst)
Overrides=
let (MethodData(enclTy, cc, nm, argtys, retty, minst)) = seekReadMethodDefOrRefNoVarargs ctxt numtypars c
let mspec = mkILMethSpecInTy (enclTy, cc, nm, argtys, retty, minst)
OverridesSpec(mspec.MethodRef, mspec.DeclaringType) }))
and seekReadMultipleMethodSemantics (ctxt: ILMetadataReader) (flags, id) =
seekReadIndexedRows
(ctxt.getNumRows TableNames.MethodSemantics ,
seekReadMethodSemanticsRow ctxt,
(fun (_flags, _, c) -> c),
hsCompare id,
isSorted ctxt TableNames.MethodSemantics,
(fun (a, b, _c) ->
let (MethodData(enclTy, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData ctxt b
a, (mkILMethSpecInTy (enclTy, cc, nm, argtys, retty, minst)).MethodRef))
|> List.filter (fun (flags2, _) -> flags = flags2)
|> List.map snd
and seekReadoptional_MethodSemantics ctxt id =
match seekReadMultipleMethodSemantics ctxt id with
| [] -> None
| [h] -> Some h
| h::_ -> dprintn "multiple method semantics found"; Some h
and seekReadMethodSemantics ctxt id =
match seekReadoptional_MethodSemantics ctxt id with
| None -> failwith "seekReadMethodSemantics ctxt: no method found"
| Some x -> x
and seekReadEvent ctxt mdv numtypars idx =
let (flags, nameIdx, typIdx) = seekReadEventRow ctxt mdv idx
ILEventDef(eventType = seekReadOptionalTypeDefOrRef ctxt numtypars AsObject typIdx,
name = readStringHeap ctxt nameIdx,
attributes = enum<EventAttributes>(flags),
addMethod= seekReadMethodSemantics ctxt (0x0008, TaggedIndex(hs_Event, idx)),
removeMethod=seekReadMethodSemantics ctxt (0x0010, TaggedIndex(hs_Event, idx)),
fireMethod=seekReadoptional_MethodSemantics ctxt (0x0020, TaggedIndex(hs_Event, idx)),
otherMethods = seekReadMultipleMethodSemantics ctxt (0x0004, TaggedIndex(hs_Event, idx)),
customAttrsStored=ctxt.customAttrsReader_Event,
metadataIndex = idx )
(* REVIEW: can substantially reduce numbers of EventMap and PropertyMap reads by first checking if the whole table mdv sorted according to ILTypeDef tokens and then doing a binary chop *)
and seekReadEvents (ctxt: ILMetadataReader) numtypars tidx =
mkILEventsLazy
(lazy
let mdv = ctxt.mdfile.GetView()
match seekReadOptionalIndexedRow (ctxt.getNumRows TableNames.EventMap, (fun i -> i, seekReadEventMapRow ctxt mdv i), (fun (_, row) -> fst row), compare tidx, false, (fun (i, row) -> (i, snd row))) with
| None -> []
| Some (rowNum, beginEventIdx) ->
let endEventIdx =
if rowNum >= ctxt.getNumRows TableNames.EventMap then
ctxt.getNumRows TableNames.Event + 1
else
let (_, endEventIdx) = seekReadEventMapRow ctxt mdv (rowNum + 1)
endEventIdx
[ for i in beginEventIdx .. endEventIdx - 1 do
yield seekReadEvent ctxt mdv numtypars i ])
and seekReadProperty ctxt mdv numtypars idx =
let (flags, nameIdx, typIdx) = seekReadPropertyRow ctxt mdv idx
let cc, retty, argtys = readBlobHeapAsPropertySig ctxt numtypars typIdx
let setter= seekReadoptional_MethodSemantics ctxt (0x0001, TaggedIndex(hs_Property, idx))
let getter = seekReadoptional_MethodSemantics ctxt (0x0002, TaggedIndex(hs_Property, idx))
(* NOTE: the "ThisConv" value on the property is not reliable: better to look on the getter/setter *)
(* NOTE: e.g. tlbimp on Office msword.olb seems to set this incorrectly *)
let cc2 =
match getter with
| Some mref -> mref.CallingConv.ThisConv
| None ->
match setter with
| Some mref -> mref.CallingConv .ThisConv
| None -> cc
ILPropertyDef(name=readStringHeap ctxt nameIdx,
callingConv = cc2,
attributes = enum<PropertyAttributes>(flags),
setMethod=setter,
getMethod=getter,
propertyType=retty,
init= (if (flags &&& 0x1000) = 0 then None else Some (seekReadConstant ctxt (TaggedIndex(hc_Property, idx)))),
args=argtys,
customAttrsStored=ctxt.customAttrsReader_Property,
metadataIndex = idx )
and seekReadProperties (ctxt: ILMetadataReader) numtypars tidx =
mkILPropertiesLazy
(lazy
let mdv = ctxt.mdfile.GetView()
match seekReadOptionalIndexedRow (ctxt.getNumRows TableNames.PropertyMap, (fun i -> i, seekReadPropertyMapRow ctxt mdv i), (fun (_, row) -> fst row), compare tidx, false, (fun (i, row) -> (i, snd row))) with
| None -> []
| Some (rowNum, beginPropIdx) ->
let endPropIdx =
if rowNum >= ctxt.getNumRows TableNames.PropertyMap then
ctxt.getNumRows TableNames.Property + 1
else
let (_, endPropIdx) = seekReadPropertyMapRow ctxt mdv (rowNum + 1)
endPropIdx
[ for i in beginPropIdx .. endPropIdx - 1 do
yield seekReadProperty ctxt mdv numtypars i ])
and customAttrsReader ctxtH tag : ILAttributesStored =
mkILCustomAttrsReader
(fun idx ->
let (ctxt: ILMetadataReader) = getHole ctxtH
seekReadIndexedRows (ctxt.getNumRows TableNames.CustomAttribute,
seekReadCustomAttributeRow ctxt, (fun (a, _, _) -> a),
hcaCompare (TaggedIndex(tag,idx)),
isSorted ctxt TableNames.CustomAttribute,
(fun (_, b, c) -> seekReadCustomAttr ctxt (b, c)))
|> List.toArray)
and seekReadCustomAttr ctxt (TaggedIndex(cat, idx), b) =
ctxt.seekReadCustomAttr (CustomAttrIdx (cat, idx, b))
and seekReadCustomAttrUncached ctxtH (CustomAttrIdx (cat, idx, valIdx)) =
let ctxt = getHole ctxtH
{ Method=seekReadCustomAttrType ctxt (TaggedIndex(cat, idx))
Data=
match readBlobHeapOption ctxt valIdx with
| Some bytes -> bytes
| None -> Bytes.ofInt32Array [| |]
Elements = [] }
and securityDeclsReader ctxtH tag =
mkILSecurityDeclsReader
(fun idx ->
let (ctxt: ILMetadataReader) = getHole ctxtH
let mdv = ctxt.mdfile.GetView()
seekReadIndexedRows (ctxt.getNumRows TableNames.Permission,
seekReadPermissionRow ctxt mdv,
(fun (_, par, _) -> par),
hdsCompare (TaggedIndex(tag,idx)),
isSorted ctxt TableNames.Permission,
(fun (act, _, ty) -> seekReadSecurityDecl ctxt (act, ty)))
|> List.toArray)
and seekReadSecurityDecl ctxt (act, ty) =
ILSecurityDecl ((if List.memAssoc (int act) (Lazy.force ILSecurityActionRevMap) then List.assoc (int act) (Lazy.force ILSecurityActionRevMap) else failwith "unknown security action"),
readBlobHeap ctxt ty)
and seekReadConstant (ctxt: ILMetadataReader) idx =
let kind, vidx = seekReadIndexedRow (ctxt.getNumRows TableNames.Constant,
seekReadConstantRow ctxt,
(fun (_, key, _) -> key),
hcCompare idx, isSorted ctxt TableNames.Constant, (fun (kind, _, v) -> kind, v))
match kind with
| x when x = uint16 et_STRING ->
let blobHeap = readBlobHeap ctxt vidx
let s = System.Text.Encoding.Unicode.GetString(blobHeap, 0, blobHeap.Length)
ILFieldInit.String (s)
| x when x = uint16 et_BOOLEAN -> ILFieldInit.Bool (readBlobHeapAsBool ctxt vidx)
| x when x = uint16 et_CHAR -> ILFieldInit.Char (readBlobHeapAsUInt16 ctxt vidx)
| x when x = uint16 et_I1 -> ILFieldInit.Int8 (readBlobHeapAsSByte ctxt vidx)
| x when x = uint16 et_I2 -> ILFieldInit.Int16 (readBlobHeapAsInt16 ctxt vidx)
| x when x = uint16 et_I4 -> ILFieldInit.Int32 (readBlobHeapAsInt32 ctxt vidx)
| x when x = uint16 et_I8 -> ILFieldInit.Int64 (readBlobHeapAsInt64 ctxt vidx)
| x when x = uint16 et_U1 -> ILFieldInit.UInt8 (readBlobHeapAsByte ctxt vidx)
| x when x = uint16 et_U2 -> ILFieldInit.UInt16 (readBlobHeapAsUInt16 ctxt vidx)
| x when x = uint16 et_U4 -> ILFieldInit.UInt32 (readBlobHeapAsUInt32 ctxt vidx)
| x when x = uint16 et_U8 -> ILFieldInit.UInt64 (readBlobHeapAsUInt64 ctxt vidx)
| x when x = uint16 et_R4 -> ILFieldInit.Single (readBlobHeapAsSingle ctxt vidx)
| x when x = uint16 et_R8 -> ILFieldInit.Double (readBlobHeapAsDouble ctxt vidx)
| x when x = uint16 et_CLASS || x = uint16 et_OBJECT -> ILFieldInit.Null
| _ -> ILFieldInit.Null
and seekReadImplMap (ctxt: ILMetadataReader) nm midx =
mkMethBodyLazyAux
(lazy
let mdv = ctxt.mdfile.GetView()
let (flags, nameIdx, scopeIdx) = seekReadIndexedRow (ctxt.getNumRows TableNames.ImplMap,
seekReadImplMapRow ctxt mdv,
(fun (_, m, _, _) -> m),
mfCompare (TaggedIndex(mf_MethodDef, midx)),
isSorted ctxt TableNames.ImplMap,
(fun (a, _, c, d) -> a, c, d))
let cc =
let masked = flags &&& 0x0700
if masked = 0x0000 then PInvokeCallingConvention.None
elif masked = 0x0200 then PInvokeCallingConvention.Cdecl
elif masked = 0x0300 then PInvokeCallingConvention.Stdcall
elif masked = 0x0400 then PInvokeCallingConvention.Thiscall
elif masked = 0x0500 then PInvokeCallingConvention.Fastcall
elif masked = 0x0100 then PInvokeCallingConvention.WinApi
else (dprintn "strange CallingConv"; PInvokeCallingConvention.None)
let enc =
let masked = flags &&& 0x0006
if masked = 0x0000 then PInvokeCharEncoding.None
elif masked = 0x0002 then PInvokeCharEncoding.Ansi
elif masked = 0x0004 then PInvokeCharEncoding.Unicode
elif masked = 0x0006 then PInvokeCharEncoding.Auto
else (dprintn "strange CharEncoding"; PInvokeCharEncoding.None)
let bestfit =
let masked = flags &&& 0x0030
if masked = 0x0000 then PInvokeCharBestFit.UseAssembly
elif masked = 0x0010 then PInvokeCharBestFit.Enabled
elif masked = 0x0020 then PInvokeCharBestFit.Disabled
else (dprintn "strange CharBestFit"; PInvokeCharBestFit.UseAssembly)
let unmap =
let masked = flags &&& 0x3000
if masked = 0x0000 then PInvokeThrowOnUnmappableChar.UseAssembly
elif masked = 0x1000 then PInvokeThrowOnUnmappableChar.Enabled
elif masked = 0x2000 then PInvokeThrowOnUnmappableChar.Disabled
else (dprintn "strange ThrowOnUnmappableChar"; PInvokeThrowOnUnmappableChar.UseAssembly)
MethodBody.PInvoke { CallingConv = cc
CharEncoding = enc
CharBestFit=bestfit
ThrowOnUnmappableChar=unmap
NoMangle = (flags &&& 0x0001) <> 0x0
LastError = (flags &&& 0x0040) <> 0x0
Name =
(match readStringHeapOption ctxt nameIdx with
| None -> nm
| Some nm2 -> nm2)
Where = seekReadModuleRef ctxt mdv scopeIdx })
and seekReadTopCode (ctxt: ILMetadataReader) pev mdv numtypars (sz:int) start seqpoints =
let labelsOfRawOffsets = new Dictionary<_, _>(sz/2)
let ilOffsetsOfLabels = new Dictionary<_, _>(sz/2)
let tryRawToLabel rawOffset =
match labelsOfRawOffsets.TryGetValue(rawOffset) with
| true, v -> Some v
| _ -> None
let rawToLabel rawOffset =
match tryRawToLabel rawOffset with
| Some l -> l
| None ->
let lab = generateCodeLabel()
labelsOfRawOffsets.[rawOffset] <- lab
lab
let markAsInstructionStart rawOffset ilOffset =
let lab = rawToLabel rawOffset
ilOffsetsOfLabels.[lab] <- ilOffset
let ibuf = new ResizeArray<_>(sz/2)
let curr = ref 0
let prefixes = { al=Aligned; tl= Normalcall; vol= Nonvolatile;ro=NormalAddress;constrained=None }
let lastb = ref 0x0
let lastb2 = ref 0x0
let b = ref 0x0
let get () =
lastb := seekReadByteAsInt32 pev (start + (!curr))
incr curr
b :=
if !lastb = 0xfe && !curr < sz then
lastb2 := seekReadByteAsInt32 pev (start + (!curr))
incr curr
!lastb2
else
!lastb
let seqPointsRemaining = ref seqpoints
while !curr < sz do
// registering "+string !curr+" as start of an instruction")
markAsInstructionStart !curr ibuf.Count
// Insert any sequence points into the instruction sequence
while
(match !seqPointsRemaining with
| (i, _tag) :: _rest when i <= !curr -> true
| _ -> false)
do
// Emitting one sequence point
let (_, tag) = List.head !seqPointsRemaining
seqPointsRemaining := List.tail !seqPointsRemaining
ibuf.Add (I_seqpoint tag)
// Read the prefixes. Leave lastb and lastb2 holding the instruction byte(s)
begin
prefixes.al <- Aligned
prefixes.tl <- Normalcall
prefixes.vol <- Nonvolatile
prefixes.ro<-NormalAddress
prefixes.constrained<-None
get ()
while !curr < sz &&
!lastb = 0xfe &&
(!b = (i_constrained &&& 0xff) ||
!b = (i_readonly &&& 0xff) ||
!b = (i_unaligned &&& 0xff) ||
!b = (i_volatile &&& 0xff) ||
!b = (i_tail &&& 0xff)) do
begin
if !b = (i_unaligned &&& 0xff) then
let unal = seekReadByteAsInt32 pev (start + (!curr))
incr curr
prefixes.al <-
if unal = 0x1 then Unaligned1
elif unal = 0x2 then Unaligned2
elif unal = 0x4 then Unaligned4
else (dprintn "bad alignment for unaligned"; Aligned)
elif !b = (i_volatile &&& 0xff) then prefixes.vol <- Volatile
elif !b = (i_readonly &&& 0xff) then prefixes.ro <- ReadonlyAddress
elif !b = (i_constrained &&& 0xff) then
let uncoded = seekReadUncodedToken pev (start + (!curr))
curr := !curr + 4
let ty = seekReadTypeDefOrRef ctxt numtypars AsObject [] (uncodedTokenToTypeDefOrRefOrSpec uncoded)
prefixes.constrained <- Some ty
else prefixes.tl <- Tailcall
end
get ()
end
// data for instruction begins at "+string !curr
// Read and decode the instruction
if (!curr <= sz) then
let idecoder =
if !lastb = 0xfe then getTwoByteInstr ( !lastb2)
else getOneByteInstr ( !lastb)
let instr =
match idecoder with
| I_u16_u8_instr f ->
let x = seekReadByte pev (start + (!curr)) |> uint16
curr := !curr + 1
f prefixes x
| I_u16_u16_instr f ->
let x = seekReadUInt16 pev (start + (!curr))
curr := !curr + 2
f prefixes x
| I_none_instr f ->
f prefixes
| I_i64_instr f ->
let x = seekReadInt64 pev (start + (!curr))
curr := !curr + 8
f prefixes x
| I_i32_i8_instr f ->
let x = seekReadSByte pev (start + (!curr)) |> int32
curr := !curr + 1
f prefixes x
| I_i32_i32_instr f ->
let x = seekReadInt32 pev (start + (!curr))
curr := !curr + 4
f prefixes x
| I_r4_instr f ->
let x = seekReadSingle pev (start + (!curr))
curr := !curr + 4
f prefixes x
| I_r8_instr f ->
let x = seekReadDouble pev (start + (!curr))
curr := !curr + 8
f prefixes x
| I_field_instr f ->
let (tab, tok) = seekReadUncodedToken pev (start + (!curr))
curr := !curr + 4
let fspec =
if tab = TableNames.Field then
seekReadFieldDefAsFieldSpec ctxt tok
elif tab = TableNames.MemberRef then
seekReadMemberRefAsFieldSpec ctxt numtypars tok
else failwith "bad table in FieldDefOrRef"
f prefixes fspec
| I_method_instr f ->
// method instruction, curr = "+string !curr
let (tab, idx) = seekReadUncodedToken pev (start + (!curr))
curr := !curr + 4
let (VarArgMethodData(enclTy, cc, nm, argtys, varargs, retty, minst)) =
if tab = TableNames.Method then
seekReadMethodDefOrRef ctxt numtypars (TaggedIndex(mdor_MethodDef, idx))
elif tab = TableNames.MemberRef then
seekReadMethodDefOrRef ctxt numtypars (TaggedIndex(mdor_MemberRef, idx))
elif tab = TableNames.MethodSpec then
seekReadMethodSpecAsMethodData ctxt numtypars idx
else failwith "bad table in MethodDefOrRefOrSpec"
match enclTy with
| ILType.Array (shape, ty) ->
match nm with
| "Get" -> I_ldelem_any(shape, ty)
| "Set" -> I_stelem_any(shape, ty)
| "Address" -> I_ldelema(prefixes.ro, false, shape, ty)
| ".ctor" -> I_newarr(shape, ty)
| _ -> failwith "bad method on array type"
| _ ->
let mspec = mkILMethSpecInTy (enclTy, cc, nm, argtys, retty, minst)
f prefixes (mspec, varargs)
| I_type_instr f ->
let uncoded = seekReadUncodedToken pev (start + (!curr))
curr := !curr + 4
let ty = seekReadTypeDefOrRef ctxt numtypars AsObject [] (uncodedTokenToTypeDefOrRefOrSpec uncoded)
f prefixes ty
| I_string_instr f ->
let (tab, idx) = seekReadUncodedToken pev (start + (!curr))
curr := !curr + 4
if tab <> TableNames.UserStrings then dprintn "warning: bad table in user string for ldstr"
f prefixes (readUserStringHeap ctxt (idx))
| I_conditional_i32_instr f ->
let offsDest = (seekReadInt32 pev (start + (!curr)))
curr := !curr + 4
let dest = !curr + offsDest
f prefixes (rawToLabel dest)
| I_conditional_i8_instr f ->
let offsDest = int (seekReadSByte pev (start + (!curr)))
curr := !curr + 1
let dest = !curr + offsDest
f prefixes (rawToLabel dest)
| I_unconditional_i32_instr f ->
let offsDest = (seekReadInt32 pev (start + (!curr)))
curr := !curr + 4
let dest = !curr + offsDest
f prefixes (rawToLabel dest)
| I_unconditional_i8_instr f ->
let offsDest = int (seekReadSByte pev (start + (!curr)))
curr := !curr + 1
let dest = !curr + offsDest
f prefixes (rawToLabel dest)
| I_invalid_instr ->
dprintn ("invalid instruction: "+string !lastb+ (if !lastb = 0xfe then ", "+string !lastb2 else ""))
I_ret
| I_tok_instr f ->
let (tab, idx) = seekReadUncodedToken pev (start + (!curr))
curr := !curr + 4
(* REVIEW: this incorrectly labels all MemberRef tokens as ILMethod's: we should go look at the MemberRef sig to determine if it is a field or method *)
let token_info =
if tab = TableNames.Method || tab = TableNames.MemberRef (* REVIEW:generics or tab = TableNames.MethodSpec *) then
let (MethodData(enclTy, cc, nm, argtys, retty, minst)) = seekReadMethodDefOrRefNoVarargs ctxt numtypars (uncodedTokenToMethodDefOrRef (tab, idx))
ILToken.ILMethod (mkILMethSpecInTy (enclTy, cc, nm, argtys, retty, minst))
elif tab = TableNames.Field then
ILToken.ILField (seekReadFieldDefAsFieldSpec ctxt idx)
elif tab = TableNames.TypeDef || tab = TableNames.TypeRef || tab = TableNames.TypeSpec then
ILToken.ILType (seekReadTypeDefOrRef ctxt numtypars AsObject [] (uncodedTokenToTypeDefOrRefOrSpec (tab, idx)))
else failwith "bad token for ldtoken"
f prefixes token_info
| I_sig_instr f ->
let (tab, idx) = seekReadUncodedToken pev (start + (!curr))
curr := !curr + 4
if tab <> TableNames.StandAloneSig then dprintn "strange table for callsig token"
let generic, _genarity, cc, retty, argtys, varargs = readBlobHeapAsMethodSig ctxt numtypars (seekReadStandAloneSigRow ctxt mdv idx)
if generic then failwith "bad image: a generic method signature is begin used at a calli instruction"
f prefixes (mkILCallSig (cc, argtys, retty), varargs)
| I_switch_instr f ->
let n = (seekReadInt32 pev (start + (!curr)))
curr := !curr + 4
let offsets =
List.init n (fun _ ->
let i = (seekReadInt32 pev (start + (!curr)))
curr := !curr + 4
i)
let dests = List.map (fun offs -> rawToLabel (!curr + offs)) offsets
f prefixes dests
ibuf.Add instr
done
// Finished reading instructions - mark the end of the instruction stream in case the PDB information refers to it.
markAsInstructionStart !curr ibuf.Count
// Build the function that maps from raw labels (offsets into the bytecode stream) to indexes in the AbsIL instruction stream
let lab2pc = ilOffsetsOfLabels
// Some offsets used in debug info refer to the end of an instruction, rather than the
// start of the subsequent instruction. But all labels refer to instruction starts,
// apart from a final label which refers to the end of the method. This function finds
// the start of the next instruction referred to by the raw offset.
let raw2nextLab rawOffset =
let isInstrStart x =
match tryRawToLabel x with
| None -> false
| Some lab -> ilOffsetsOfLabels.ContainsKey lab
if isInstrStart rawOffset then rawToLabel rawOffset
elif isInstrStart (rawOffset+1) then rawToLabel (rawOffset+1)
else failwith ("the bytecode raw offset "+string rawOffset+" did not refer either to the start or end of an instruction")
let instrs = ibuf.ToArray()
instrs, rawToLabel, lab2pc, raw2nextLab
#if FX_NO_PDB_READER
and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (_idx, nm, _internalcall, noinline, aggressiveinline, numtypars) rva =
#else
and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (idx, nm, _internalcall, noinline, aggressiveinline, numtypars) rva =
#endif
mkMethBodyLazyAux
(lazy
let pev = pectxt.pefile.GetView()
let mdv = ctxt.mdfile.GetView()
// Read any debug information for this method into temporary data structures
// -- a list of locals, marked with the raw offsets (actually closures which accept the resolution function that maps raw offsets to labels)
// -- an overall range for the method
// -- the sequence points for the method
let localPdbInfos, methRangePdbInfo, seqpoints =
#if FX_NO_PDB_READER
[], None, []
#else
match pectxt.pdb with
| None ->
[], None, []
| Some (pdbr, get_doc) ->
try
let pdbm = pdbReaderGetMethod pdbr (uncodedToken TableNames.Method idx)
let sps = pdbMethodGetSequencePoints pdbm
(*dprintf "#sps for 0x%x = %d\n" (uncodedToken TableNames.Method idx) (Array.length sps) *)
(* let roota, rootb = pdbScopeGetOffsets rootScope in *)
let seqpoints =
let arr =
sps |> Array.map (fun sp ->
(* It is VERY annoying to have to call GetURL for the document for each sequence point. This appears to be a short coming of the PDB reader API. They should return an index into the array of documents for the reader *)
let sourcedoc = get_doc (pdbDocumentGetURL sp.pdbSeqPointDocument)
let source =
ILSourceMarker.Create(document = sourcedoc,
line = sp.pdbSeqPointLine,
column = sp.pdbSeqPointColumn,
endLine = sp.pdbSeqPointEndLine,
endColumn = sp.pdbSeqPointEndColumn)
(sp.pdbSeqPointOffset, source))
Array.sortInPlaceBy fst arr
Array.toList arr
let rec scopes scp =
let a, b = pdbScopeGetOffsets scp
let lvs = pdbScopeGetLocals scp
let ilvs =
lvs
|> Array.toList
|> List.filter (fun l ->
let k, _idx = pdbVariableGetAddressAttributes l
k = 1 (* ADDR_IL_OFFSET *))
let ilinfos : ILLocalDebugMapping list =
ilvs |> List.map (fun ilv ->
let _k, idx = pdbVariableGetAddressAttributes ilv
let n = pdbVariableGetName ilv
{ LocalIndex= idx
LocalName=n})
let thisOne =
(fun raw2nextLab ->
{ Range= (raw2nextLab a, raw2nextLab b)
DebugMappings = ilinfos } : ILLocalDebugInfo )
let others = List.foldBack (scopes >> (@)) (Array.toList (pdbScopeGetChildren scp)) []
thisOne :: others
let localPdbInfos = [] (* <REVIEW> scopes fail for mscorlib </REVIEW> scopes rootScope *)
// REVIEW: look through sps to get ranges? Use GetRanges?? Change AbsIL??
(localPdbInfos, None, seqpoints)
with e ->
// "* Warning: PDB info for method "+nm+" could not be read and will be ignored: "+e.Message
[], None, []
#endif
let baseRVA = pectxt.anyV2P("method rva", rva)
// ": reading body of method "+nm+" at rva "+string rva+", phys "+string baseRVA
let b = seekReadByte pev baseRVA
if (b &&& e_CorILMethod_FormatMask) = e_CorILMethod_TinyFormat then
let codeBase = baseRVA + 1
let codeSize = (int32 b >>>& 2)
// tiny format for "+nm+", code size = " + string codeSize)
let instrs, _, lab2pc, raw2nextLab = seekReadTopCode ctxt pev mdv numtypars codeSize codeBase seqpoints
(* Convert the linear code format to the nested code format *)
let localPdbInfos2 = List.map (fun f -> f raw2nextLab) localPdbInfos
let code = buildILCode nm lab2pc instrs [] localPdbInfos2
MethodBody.IL
{ IsZeroInit=false
MaxStack= 8
NoInlining=noinline
AggressiveInlining=aggressiveinline
Locals=List.empty
SourceMarker=methRangePdbInfo
Code=code }
elif (b &&& e_CorILMethod_FormatMask) = e_CorILMethod_FatFormat then
let hasMoreSections = (b &&& e_CorILMethod_MoreSects) <> 0x0uy
let initlocals = (b &&& e_CorILMethod_InitLocals) <> 0x0uy
let maxstack = seekReadUInt16AsInt32 pev (baseRVA + 2)
let codeSize = seekReadInt32 pev (baseRVA + 4)
let localsTab, localToken = seekReadUncodedToken pev (baseRVA + 8)
let codeBase = baseRVA + 12
let locals =
if localToken = 0x0 then []
else
if localsTab <> TableNames.StandAloneSig then dprintn "strange table for locals token"
readBlobHeapAsLocalsSig ctxt numtypars (seekReadStandAloneSigRow ctxt pev localToken)
// fat format for "+nm+", code size = " + string codeSize+", hasMoreSections = "+(if hasMoreSections then "true" else "false")+", b = "+string b)
// Read the method body
let instrs, rawToLabel, lab2pc, raw2nextLab = seekReadTopCode ctxt pev mdv numtypars ( codeSize) codeBase seqpoints
// Read all the sections that follow the method body.
// These contain the exception clauses.
let nextSectionBase = ref (align 4 (codeBase + codeSize))
let moreSections = ref hasMoreSections
let seh = ref []
while !moreSections do
let sectionBase = !nextSectionBase
let sectionFlag = seekReadByte pev sectionBase
// fat format for "+nm+", sectionFlag = " + string sectionFlag)
let sectionSize, clauses =
if (sectionFlag &&& e_CorILMethod_Sect_FatFormat) <> 0x0uy then
let bigSize = (seekReadInt32 pev sectionBase) >>>& 8
// bigSize = "+string bigSize)
let clauses =
if (sectionFlag &&& e_CorILMethod_Sect_EHTable) <> 0x0uy then
// WORKAROUND: The ECMA spec says this should be
// let numClauses = ((bigSize - 4) / 24) in
// but the CCI IL generator generates multiples of 24
let numClauses = (bigSize / 24)
List.init numClauses (fun i ->
let clauseBase = sectionBase + 4 + (i * 24)
let kind = seekReadInt32 pev (clauseBase + 0)
let st1 = seekReadInt32 pev (clauseBase + 4)
let sz1 = seekReadInt32 pev (clauseBase + 8)
let st2 = seekReadInt32 pev (clauseBase + 12)
let sz2 = seekReadInt32 pev (clauseBase + 16)
let extra = seekReadInt32 pev (clauseBase + 20)
(kind, st1, sz1, st2, sz2, extra))
else []
bigSize, clauses
else
let smallSize = seekReadByteAsInt32 pev (sectionBase + 0x01)
let clauses =
if (sectionFlag &&& e_CorILMethod_Sect_EHTable) <> 0x0uy then
// WORKAROUND: The ECMA spec says this should be
// let numClauses = ((smallSize - 4) / 12) in
// but the C# compiler (or some IL generator) generates multiples of 12
let numClauses = (smallSize / 12)
// dprintn (nm+" has " + string numClauses + " tiny seh clauses")
List.init numClauses (fun i ->
let clauseBase = sectionBase + 4 + (i * 12)
let kind = seekReadUInt16AsInt32 pev (clauseBase + 0)
if logging then dprintn ("One tiny SEH clause, kind = "+string kind)
let st1 = seekReadUInt16AsInt32 pev (clauseBase + 2)
let sz1 = seekReadByteAsInt32 pev (clauseBase + 4)
let st2 = seekReadUInt16AsInt32 pev (clauseBase + 5)
let sz2 = seekReadByteAsInt32 pev (clauseBase + 7)
let extra = seekReadInt32 pev (clauseBase + 8)
(kind, st1, sz1, st2, sz2, extra))
else
[]
smallSize, clauses
// Morph together clauses that cover the same range
let sehClauses =
let sehMap = Dictionary<_, _>(clauses.Length, HashIdentity.Structural)
List.iter
(fun (kind, st1, sz1, st2, sz2, extra) ->
let tryStart = rawToLabel st1
let tryFinish = rawToLabel (st1 + sz1)
let handlerStart = rawToLabel st2
let handlerFinish = rawToLabel (st2 + sz2)
let clause =
if kind = e_COR_ILEXCEPTION_CLAUSE_EXCEPTION then
ILExceptionClause.TypeCatch(seekReadTypeDefOrRef ctxt numtypars AsObject List.empty (uncodedTokenToTypeDefOrRefOrSpec (i32ToUncodedToken extra)), (handlerStart, handlerFinish) )
elif kind = e_COR_ILEXCEPTION_CLAUSE_FILTER then
let filterStart = rawToLabel extra
let filterFinish = handlerStart
ILExceptionClause.FilterCatch((filterStart, filterFinish), (handlerStart, handlerFinish))
elif kind = e_COR_ILEXCEPTION_CLAUSE_FINALLY then
ILExceptionClause.Finally(handlerStart, handlerFinish)
elif kind = e_COR_ILEXCEPTION_CLAUSE_FAULT then
ILExceptionClause.Fault(handlerStart, handlerFinish)
else begin
dprintn (ctxt.fileName + ": unknown exception handler kind: "+string kind)
ILExceptionClause.Finally(handlerStart, handlerFinish)
end
let key = (tryStart, tryFinish)
match sehMap.TryGetValue(key) with
| true, prev -> sehMap.[key] <- prev @ [clause]
| _ -> sehMap.[key] <- [clause])
clauses
([], sehMap) ||> Seq.fold (fun acc (KeyValue(key, bs)) -> [ for b in bs -> {Range=key; Clause=b} : ILExceptionSpec ] @ acc)
seh := sehClauses
moreSections := (sectionFlag &&& e_CorILMethod_Sect_MoreSects) <> 0x0uy
nextSectionBase := sectionBase + sectionSize
done (* while *)
(* Convert the linear code format to the nested code format *)
if logging then dprintn ("doing localPdbInfos2")
let localPdbInfos2 = List.map (fun f -> f raw2nextLab) localPdbInfos
if logging then dprintn ("done localPdbInfos2, checking code...")
let code = buildILCode nm lab2pc instrs !seh localPdbInfos2
if logging then dprintn ("done checking code.")
MethodBody.IL