#nowarn "42" // This construct is deprecated: it is only for use in the F# library

open System

open System.IO

open System.Runtime.InteropServices

open System.Collections.Generic

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

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

type ILReaderOptions =

{ pdbPath: string option

ilGlobals: ILGlobals

optimizeForMemory: bool }

#if STATISTICS

let reportRef = ref (fun _oc -> ())

let addReport f = let old = !reportRef in reportRef := (fun oc -> old oc; f oc)

let report (oc:TextWriter) = !reportRef oc ; reportRef := ref (fun _oc -> ())

let checking = false

let logging = false

let _ = if checking then dprintn "warning : Ilread.checking is on"

let singleOfBits (x:int32) = System.BitConverter.ToSingle(System.BitConverter.GetBytes(x),0)

let doubleOfBits (x:int64) = System.BitConverter.Int64BitsToDouble(x)

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)

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 BinaryFile() =

abstract ReadByte : addr:int -> byte

abstract ReadBytes : addr:int -> int -> byte[]

abstract ReadInt32 : addr:int -> int

abstract ReadUInt16 : addr:int -> uint16

abstract CountUtf8String : addr:int -> int

abstract ReadUTF8String : addr: int -> string

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

type MemoryMappedFile(hMap: MemoryMapping.HANDLE, start:nativeint) =

inherit BinaryFile()

static member Create fileName =

//printf "fileName = %s\n" fileName

let hFile = MemoryMapping.CreateFile (fileName, MemoryMapping.GENERIC_READ, MemoryMapping.FILE_SHARE_READ_WRITE, IntPtr.Zero, MemoryMapping.OPEN_EXISTING, 0, IntPtr.Zero )

//printf "hFile = %Lx\n" (hFile.ToInt64())

if ( hFile.Equals(MemoryMapping.INVALID_HANDLE) ) then

failwithf "CreateFile(0x%08x)" ( Marshal.GetHRForLastWin32Error() )

let protection = 0x00000002 (* ReadOnly *)

//printf "OK! hFile = %Lx\n" (hFile.ToInt64())

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 start = MemoryMapping.MapViewOfFile (hMap, MemoryMapping.MAP_READ,0,0,0n)

if start.Equals(IntPtr.Zero) then

failwithf "MapViewOfFile(0x%08x)" ( Marshal.GetHRForLastWin32Error() )

MemoryMappedFile(hMap, start)

member m.Addr (i:int) : nativeint =

start + nativeint i

override m.ReadByte i =

Marshal.ReadByte(m.Addr i)

override m.ReadBytes i len =

let res = Bytes.zeroCreate len

Marshal.Copy(m.Addr i, res, 0,len)

res

override m.ReadInt32 i =

Marshal.ReadInt32(m.Addr i)

override m.ReadUInt16 i =

uint16(Marshal.ReadInt16(m.Addr i))

member m.Close() =

ignore(MemoryMapping.UnmapViewOfFile start)

ignore(MemoryMapping.CloseHandle hMap)

override m.CountUtf8String i =

let start = m.Addr i

let mutable p = start

while Marshal.ReadByte(p) <> 0uy do

p <- p + 1n

int (p - start)

override m.ReadUTF8String i =

let n = m.CountUtf8String i

System.Runtime.InteropServices.Marshal.PtrToStringAnsi((m.Addr i), n)

type ByteFile(bytes:byte[]) =

inherit BinaryFile()

override mc.ReadByte addr = bytes.[addr]

override mc.ReadBytes addr len = Array.sub bytes addr len

override m.CountUtf8String addr =

let mutable p = addr

while bytes.[p] <> 0uy do

p <- p + 1

p - addr

override m.ReadUTF8String addr =

let n = m.CountUtf8String addr

System.Text.Encoding.UTF8.GetString (bytes, addr, n)

override is.ReadInt32 addr =

let b0 = is.ReadByte addr

let b1 = is.ReadByte (addr+1)

let b2 = is.ReadByte (addr+2)

let b3 = is.ReadByte (addr+3)

int b0 ||| (int b1 <<< 8) ||| (int b2 <<< 16) ||| (int b3 <<< 24)

override is.ReadUInt16 addr =

let b0 = is.ReadByte addr

let b1 = is.ReadByte (addr+1)

uint16 b0 ||| (uint16 b1 <<< 8)

let seekReadByte (is:BinaryFile) addr = is.ReadByte addr

let seekReadBytes (is:BinaryFile) addr len = is.ReadBytes addr len

let seekReadInt32 (is:BinaryFile) addr = is.ReadInt32 addr

let seekReadUInt16 (is:BinaryFile) addr = is.ReadUInt16 addr

let seekReadByteAsInt32 is addr = int32 (seekReadByte is addr)

let seekReadInt64 is addr =

let b0 = seekReadByte is addr

let b1 = seekReadByte is (addr+1)

let b2 = seekReadByte is (addr+2)

let b3 = seekReadByte is (addr+3)

let b4 = seekReadByte is (addr+4)

let b5 = seekReadByte is (addr+5)

let b6 = seekReadByte is (addr+6)

let b7 = seekReadByte is (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 is addr = int32 (seekReadUInt16 is addr)

let seekReadCompressedUInt32 is addr =

let b0 = seekReadByte is addr

if b0 <= 0x7Fuy then int b0, addr+1

elif b0 <= 0xBFuy then

let b0 = b0 &&& 0x7Fuy

let b1 = seekReadByteAsInt32 is (addr+1)

(int b0 <<< 8) ||| int b1, addr+2

else

let b0 = b0 &&& 0x3Fuy

let b1 = seekReadByteAsInt32 is (addr+1)

let b2 = seekReadByteAsInt32 is (addr+2)

let b3 = seekReadByteAsInt32 is (addr+3)

(int b0 <<< 24) ||| (int b1 <<< 16) ||| (int b2 <<< 8) ||| int b3, addr+4

let seekReadSByte is addr = sbyte (seekReadByte is addr)

let seekReadSingle is addr = singleOfBits (seekReadInt32 is addr)

let seekReadDouble is addr = doubleOfBits (seekReadInt64 is addr)

let rec seekCountUtf8String is addr n =

let c = seekReadByteAsInt32 is addr

if c = 0 then n

else seekCountUtf8String is (addr+1) (n+1)

let seekReadUTF8String is addr =

let n = seekCountUtf8String is addr 0

let bytes = seekReadBytes is addr n

System.Text.Encoding.UTF8.GetString (bytes, 0, bytes.Length)

let seekReadBlob is addr =

let len, addr = seekReadCompressedUInt32 is addr

seekReadBytes is addr len

let seekReadUserString is addr =

let len, addr = seekReadCompressedUInt32 is addr

let bytes = seekReadBytes is addr (len - 1)

System.Text.Encoding.Unicode.GetString(bytes, 0, bytes.Length)

let seekReadGuid is addr = seekReadBytes is addr 0x10

let seekReadUncodedToken is addr =

i32ToUncodedToken (seekReadInt32 is addr)

let sigptrCheck (bytes:byte[]) sigptr =

if checking && sigptr >= bytes.Length then failwith "read past end of sig. "

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

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

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) ]

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 [ ]

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

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 SecurityDeclIdx = SecurityDeclIdx of uint16 * int32

type GenericParamsIdx = GenericParamsIdx of int * TypeOrMethodDefTag * int

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))

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))

fun f (idx :'T) ->

let cache =

match !cache with

| null -> cache := new Dictionary<_,_>(11 (* sz:int *) )

| _ -> ()

!cache

if cache.ContainsKey idx then (incr count; cache.[idx])

else let res = f idx in cache.[idx] <- res; res

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

let seekReadIndexedRows (numRows, rowReader, keyFunc, keyComparer, binaryChop, rowConverter) =

if binaryChop then