ilread.fs 198.5 KB
Newer Older
1
// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
L
latkin 已提交
2 3 4 5 6 7

//---------------------------------------------------------------------
// The big binary reader
//
//---------------------------------------------------------------------

8
module Microsoft.FSharp.Compiler.AbstractIL.ILBinaryReader 
L
latkin 已提交
9 10 11 12

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

open System
13 14
open System.Collections.Generic
open System.Diagnostics
L
latkin 已提交
15 16
open System.IO
open System.Runtime.InteropServices
17
open System.Text
L
latkin 已提交
18
open Internal.Utilities
19
open Internal.Utilities.Collections
L
latkin 已提交
20 21
open Microsoft.FSharp.Compiler.AbstractIL 
open Microsoft.FSharp.Compiler.AbstractIL.Internal 
D
Don Syme 已提交
22
#if !FX_NO_PDB_READER
L
latkin 已提交
23 24 25 26 27 28 29 30 31
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
A
Avi Avni 已提交
32
open System.Reflection
L
latkin 已提交
33 34 35

let checking = false  
let logging = false
36
let _ = if checking then dprintn "warning : ILBinaryReader.checking is on"
37 38
let noStableFileHeuristic = try (System.Environment.GetEnvironmentVariable("FSharp_NoStableFileHeuristic") <> null) with _ -> false
let alwaysMemoryMapFSC = try (System.Environment.GetEnvironmentVariable("FSharp_AlwaysMemoryMapCommandLineCompiler") <> null) with _ -> false
39 40
let stronglyHeldReaderCacheSizeDefault = 30
let stronglyHeldReaderCacheSize = try (match System.Environment.GetEnvironmentVariable("FSharp_StronglyHeldBinaryReaderCacheSize") with null -> stronglyHeldReaderCacheSizeDefault | s -> int32 s) with _ -> stronglyHeldReaderCacheSizeDefault
L
latkin 已提交
41

D
Don Syme 已提交
42
let singleOfBits (x:int32) = System.BitConverter.ToSingle(System.BitConverter.GetBytes(x), 0)
D
Don Syme 已提交
43
let doubleOfBits (x:int64) = System.BitConverter.Int64BitsToDouble(x)
L
latkin 已提交
44

D
Don Syme 已提交
45 46 47
//---------------------------------------------------------------------
// Utilities.  
//---------------------------------------------------------------------
L
latkin 已提交
48

D
Don Syme 已提交
49
let align alignment n = ((n + alignment - 0x1) / alignment) * alignment
L
latkin 已提交
50

D
Don Syme 已提交
51
let uncodedToken (tab:TableName) idx = ((tab.Index <<< 24) ||| idx)
L
latkin 已提交
52

D
Don Syme 已提交
53 54 55
let i32ToUncodedToken tok  = 
    let idx = tok &&& 0xffffff
    let tab = tok >>>& 24
D
Don Syme 已提交
56
    (TableName.FromIndex tab, idx)
L
latkin 已提交
57

D
Don Syme 已提交
58 59 60 61 62

[<Struct>]
type TaggedIndex<'T> = 
    val tag: 'T
    val index : int32
D
Don Syme 已提交
63
    new(tag, index) = { tag=tag; index=index }
L
latkin 已提交
64

D
Don Syme 已提交
65
let uncodedTokenToTypeDefOrRefOrSpec (tab, tok) = 
D
Don Syme 已提交
66 67 68 69 70
    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" 
D
Don Syme 已提交
71
    TaggedIndex(tag, tok)
L
latkin 已提交
72

D
Don Syme 已提交
73
let uncodedTokenToMethodDefOrRef (tab, tok) = 
D
Don Syme 已提交
74 75 76 77
    let tag =
        if tab = TableNames.Method then mdor_MethodDef 
        elif tab = TableNames.MemberRef then mdor_MemberRef
        else failwith "bad table in uncodedTokenToMethodDefOrRef" 
D
Don Syme 已提交
78
    TaggedIndex(tag, tok)
D
Don Syme 已提交
79 80 81 82 83 84 85 86 87 88 89 90 91 92

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) 
       
93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
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
D
Don Syme 已提交
108 109

[<AbstractClass>]
110 111 112 113 114 115
/// 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
D
Don Syme 已提交
116
    abstract ReadByte : addr:int -> byte
117 118

    /// Read a chunk of bytes from the file
D
Don Syme 已提交
119
    abstract ReadBytes : addr:int -> int -> byte[]
120 121

    /// Read an Int32 from the file
D
Don Syme 已提交
122
    abstract ReadInt32 : addr:int -> int
123 124

    /// Read a UInt16 from the file
D
Don Syme 已提交
125
    abstract ReadUInt16 : addr:int -> uint16
126 127

    /// Read a length of a UTF8 string from the file
D
Don Syme 已提交
128
    abstract CountUtf8String : addr:int -> int
129 130

    /// Read a UTF8 string from the file
D
Don Syme 已提交
131
    abstract ReadUTF8String : addr: int -> string
L
latkin 已提交
132

133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189
/// 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 :>_

W
WilliamBerryiii 已提交
190
/// Read from memory mapped files.
L
latkin 已提交
191 192 193 194 195 196 197 198 199 200 201 202
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, 
D
Don Syme 已提交
203
                              int _dwShareMode, 
L
latkin 已提交
204
                              HANDLE _lpSecurityAttributes, 
D
Don Syme 已提交
205
                              int _dwCreationDisposition, 
L
latkin 已提交
206 207 208 209 210 211 212 213
                              int _dwFlagsAndAttributes, 
                              HANDLE _hTemplateFile)
             
    [<DllImport("kernel32", SetLastError=true, CharSet=CharSet.Unicode)>]
    extern HANDLE CreateFileMapping (HANDLE _hFile, 
                                     HANDLE _lpAttributes, 
                                     int _flProtect, 
                                     int _dwMaximumSizeLow, 
D
Don Syme 已提交
214
                                     int _dwMaximumSizeHigh, 
L
latkin 已提交
215 216 217 218 219
                                     string _lpName) 

    [<DllImport("kernel32", SetLastError=true)>]
    extern ADDR MapViewOfFile (HANDLE _hFileMappingObject, 
                               int    _dwDesiredAccess, 
D
Don Syme 已提交
220
                               int    _dwFileOffsetHigh, 
L
latkin 已提交
221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238
                               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

239 240 241 242
/// 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()
L
latkin 已提交
243

D
Don Syme 已提交
244
    override m.ReadByte i = 
245
        Marshal.ReadByte(start + nativeint i)
L
latkin 已提交
246

247 248 249
    override m.ReadBytes i n = 
        let res = Bytes.zeroCreate n
        Marshal.Copy(start + nativeint i, res, 0, n)
L
latkin 已提交
250 251
        res
      
D
Don Syme 已提交
252
    override m.ReadInt32 i = 
253
        Marshal.ReadInt32(start + nativeint i)
L
latkin 已提交
254

D
Don Syme 已提交
255
    override m.ReadUInt16 i = 
256
        uint16(Marshal.ReadInt16(start + nativeint i))
L
latkin 已提交
257

D
Don Syme 已提交
258
    override m.CountUtf8String i = 
259
        let pStart = start + nativeint i
L
latkin 已提交
260
        let mutable p = start 
K
store  
Kevin Ransom (msft) 已提交
261
        while Marshal.ReadByte(p) <> 0uy do
L
latkin 已提交
262
            p <- p + 1n
263
        int (p - pStart) 
L
latkin 已提交
264

D
Don Syme 已提交
265
    override m.ReadUTF8String i = 
L
latkin 已提交
266
        let n = m.CountUtf8String i
267
        System.Runtime.InteropServices.Marshal.PtrToStringAnsi(start + nativeint i, n)
L
latkin 已提交
268

269 270 271 272 273
/// 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) =
L
latkin 已提交
274

275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296
    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
L
latkin 已提交
297

298 299 300 301 302 303
    member __.Close() = 
        stats.memoryMapFileClosedCount <- stats.memoryMapFileClosedCount + 1
        if not closed then 
            closed <- true
            MemoryMapping.UnmapViewOfFile hView |> ignore
            MemoryMapping.CloseHandle hMap |> ignore
L
latkin 已提交
304

305 306
    interface BinaryFile with
        override __.GetView() = (view :> BinaryView)
L
latkin 已提交
307

308 309 310 311 312 313 314 315 316
/// 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 = 
D
Don Syme 已提交
317 318 319 320
        let mutable p = addr
        while bytes.[p] <> 0uy do
            p <- p + 1
        p - addr
L
latkin 已提交
321

322 323
    override bfv.ReadUTF8String addr = 
        let n = bfv.CountUtf8String addr 
D
Don Syme 已提交
324
        System.Text.Encoding.UTF8.GetString (bytes, addr, n)
L
latkin 已提交
325

326 327 328 329 330
    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)
D
Don Syme 已提交
331
        int b0 ||| (int b1 <<< 8) ||| (int b2 <<< 16) ||| (int b3 <<< 24)
L
latkin 已提交
332

333 334 335
    override bfv.ReadUInt16 addr = 
        let b0 = bfv.ReadByte addr
        let b1 = bfv.ReadByte (addr+1)
L
latkin 已提交
336
        uint16 b0 ||| (uint16 b1 <<< 8) 
337 338 339 340 341 342 343 344 345 346 347 348 349 350

/// 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}")>]
351
type WeakByteFile(fileName: string, chunk: (int * int) option) = 
352 353 354 355 356 357 358 359 360 361 362

    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

363
    /// Get the bytes for the file
364
    interface BinaryFile with
365 366

        override this.GetView() = 
367
            let strongBytes = 
368
                let mutable tg = null
369 370
                if not (weakBytes.TryGetTarget(&tg)) then 
                    if FileSystem.GetLastWriteTimeShim(fileName) <> fileStamp then 
371 372 373 374 375 376 377 378 379 380
                        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
381 382 383

                tg

384
            (ByteView(strongBytes) :> BinaryView)
385

L
latkin 已提交
386
    
387 388 389 390
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
L
latkin 已提交
391
    
392
let seekReadByteAsInt32 mdv addr = int32 (seekReadByte mdv addr)
L
latkin 已提交
393
  
394 395 396 397 398 399 400 401 402
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)
L
latkin 已提交
403 404 405
    int64 b0 ||| (int64 b1 <<< 8) ||| (int64 b2 <<< 16) ||| (int64 b3 <<< 24) |||
    (int64 b4 <<< 32) ||| (int64 b5 <<< 40) ||| (int64 b6 <<< 48) ||| (int64 b7 <<< 56)

406
let seekReadUInt16AsInt32 mdv addr = int32 (seekReadUInt16 mdv addr)
L
latkin 已提交
407
    
408 409
let seekReadCompressedUInt32 mdv addr = 
    let b0 = seekReadByte mdv addr
D
Don Syme 已提交
410
    if b0 <= 0x7Fuy then int b0, addr+1
L
latkin 已提交
411 412
    elif b0 <= 0xBFuy then 
        let b0 = b0 &&& 0x7Fuy
413
        let b1 = seekReadByteAsInt32 mdv (addr+1) 
D
Don Syme 已提交
414
        (int b0 <<< 8) ||| int b1, addr+2
L
latkin 已提交
415 416
    else 
        let b0 = b0 &&& 0x3Fuy
417 418 419
        let b1 = seekReadByteAsInt32 mdv (addr+1) 
        let b2 = seekReadByteAsInt32 mdv (addr+2) 
        let b3 = seekReadByteAsInt32 mdv (addr+3) 
D
Don Syme 已提交
420 421
        (int b0 <<< 24) ||| (int b1 <<< 16) ||| (int b2 <<< 8) ||| int b3, addr+4

422 423 424
let seekReadSByte mdv addr = sbyte (seekReadByte mdv addr)
let seekReadSingle mdv addr = singleOfBits (seekReadInt32 mdv addr)
let seekReadDouble mdv addr = doubleOfBits (seekReadInt64 mdv addr)
L
latkin 已提交
425
    
426 427
let rec seekCountUtf8String mdv addr n = 
    let c = seekReadByteAsInt32 mdv addr
L
latkin 已提交
428
    if c = 0 then n 
429
    else seekCountUtf8String mdv (addr+1) (n+1)
L
latkin 已提交
430

431 432 433
let seekReadUTF8String mdv addr = 
    let n = seekCountUtf8String mdv addr 0
    let bytes = seekReadBytes mdv addr n
L
latkin 已提交
434 435
    System.Text.Encoding.UTF8.GetString (bytes, 0, bytes.Length)

436 437 438
let seekReadBlob mdv addr = 
    let len, addr = seekReadCompressedUInt32 mdv addr
    seekReadBytes mdv addr len
L
latkin 已提交
439
    
440 441 442 443
let seekReadUserString mdv addr = 
    let len, addr = seekReadCompressedUInt32 mdv addr
    let bytes = seekReadBytes mdv addr (len - 1)
    Encoding.Unicode.GetString(bytes, 0, bytes.Length)
L
latkin 已提交
444

445
let seekReadGuid mdv addr =  seekReadBytes mdv addr 0x10
L
latkin 已提交
446

447 448
let seekReadUncodedToken mdv addr  = 
    i32ToUncodedToken (seekReadInt32 mdv addr)
L
latkin 已提交
449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464

       
//---------------------------------------------------------------------
// 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 = 
D
Don Syme 已提交
465
    sigptrCheck bytes sigptr
L
latkin 已提交
466 467 468
    bytes.[sigptr], sigptr + 1

let sigptrGetBool bytes sigptr = 
D
Don Syme 已提交
469 470
    let b0, sigptr = sigptrGetByte bytes sigptr
    (b0 = 0x01uy) , sigptr
L
latkin 已提交
471 472

let sigptrGetSByte bytes sigptr = 
D
Don Syme 已提交
473 474
    let i, sigptr = sigptrGetByte bytes sigptr
    sbyte i, sigptr
L
latkin 已提交
475 476

let sigptrGetUInt16 bytes sigptr = 
D
Don Syme 已提交
477 478 479
    let b0, sigptr = sigptrGetByte bytes sigptr
    let b1, sigptr = sigptrGetByte bytes sigptr
    uint16 (int b0 ||| (int b1 <<< 8)), sigptr
L
latkin 已提交
480 481

let sigptrGetInt16 bytes sigptr = 
D
Don Syme 已提交
482 483
    let u, sigptr = sigptrGetUInt16 bytes sigptr
    int16 u, sigptr
L
latkin 已提交
484 485

let sigptrGetInt32 bytes sigptr = 
D
Don Syme 已提交
486
    sigptrCheck bytes sigptr
L
latkin 已提交
487 488 489 490 491 492 493 494
    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 = 
D
Don Syme 已提交
495 496
    let u, sigptr = sigptrGetInt32 bytes sigptr
    uint32 u, sigptr
L
latkin 已提交
497 498

let sigptrGetUInt64 bytes sigptr = 
D
Don Syme 已提交
499 500 501
    let u0, sigptr = sigptrGetUInt32 bytes sigptr
    let u1, sigptr = sigptrGetUInt32 bytes sigptr
    (uint64 u0 ||| (uint64 u1 <<< 32)), sigptr
L
latkin 已提交
502 503

let sigptrGetInt64 bytes sigptr = 
D
Don Syme 已提交
504 505
    let u, sigptr = sigptrGetUInt64 bytes sigptr
    int64 u, sigptr
L
latkin 已提交
506 507

let sigptrGetSingle bytes sigptr = 
D
Don Syme 已提交
508 509
    let u, sigptr = sigptrGetInt32 bytes sigptr
    singleOfBits u, sigptr
L
latkin 已提交
510 511

let sigptrGetDouble bytes sigptr = 
D
Don Syme 已提交
512 513
    let u, sigptr = sigptrGetInt64 bytes sigptr
    doubleOfBits u, sigptr
L
latkin 已提交
514 515

let sigptrGetZInt32 bytes sigptr = 
D
Don Syme 已提交
516
    let b0, sigptr = sigptrGetByte bytes sigptr
L
latkin 已提交
517 518 519
    if b0 <= 0x7Fuy then int b0, sigptr
    elif b0 <= 0xBFuy then 
        let b0 = b0 &&& 0x7Fuy
D
Don Syme 已提交
520
        let b1, sigptr = sigptrGetByte bytes sigptr
L
latkin 已提交
521 522 523
        (int b0 <<< 8) ||| int b1, sigptr
    else 
        let b0 = b0 &&& 0x3Fuy
D
Don Syme 已提交
524 525 526
        let b1, sigptr = sigptrGetByte bytes sigptr
        let b2, sigptr = sigptrGetByte bytes sigptr
        let b3, sigptr = sigptrGetByte bytes sigptr
L
latkin 已提交
527 528 529 530
        (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 
D
Don Syme 已提交
531
        let x, sp = f bytes sigptr
L
latkin 已提交
532 533 534 535 536 537 538 539 540 541
        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 
D
Don Syme 已提交
542
        dprintn "read past end of sig. in sigptrGetString" 
L
latkin 已提交
543 544 545 546 547 548 549 550
        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 = 
D
Don Syme 已提交
551 552
    let bytearray, sigptr = sigptrGetBytes n bytes sigptr
    (System.Text.Encoding.UTF8.GetString(bytearray, 0, bytearray.Length)), sigptr
L
latkin 已提交
553 554 555 556 557 558 559 560
   

// -------------------------------------------------------------------- 
// Now the tables of instructions
// -------------------------------------------------------------------- 

[<NoEquality; NoComparison>]
type ILInstrPrefixesRegister = 
D
Don Syme 已提交
561 562 563 564
   { mutable al: ILAlignment 
     mutable tl: ILTailcall
     mutable vol: ILVolatility
     mutable ro: ILReadonly
L
latkin 已提交
565 566 567
     mutable constrained: ILType option}
 
let noPrefixes mk prefixes = 
D
Don Syme 已提交
568 569 570 571 572
    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"
L
latkin 已提交
573 574 575
    mk 

let volatileOrUnalignedPrefix mk prefixes = 
D
Don Syme 已提交
576 577 578
    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"
D
Don Syme 已提交
579
    mk (prefixes.al, prefixes.vol) 
L
latkin 已提交
580 581

let volatilePrefix mk prefixes = 
D
Don Syme 已提交
582 583 584 585
    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"
L
latkin 已提交
586 587 588
    mk prefixes.vol

let tailPrefix mk prefixes = 
D
Don Syme 已提交
589 590 591 592
    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"
L
latkin 已提交
593 594 595
    mk prefixes.tl 

let constraintOrTailPrefix mk prefixes = 
D
Don Syme 已提交
596 597 598
    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"
D
Don Syme 已提交
599
    mk (prefixes.constrained, prefixes.tl )
L
latkin 已提交
600 601

let readonlyPrefix mk prefixes = 
D
Don Syme 已提交
602 603 604 605
    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"
L
latkin 已提交
606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622
    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)
D
Don Syme 已提交
623 624
    | I_conditional_i32_instr of (ILInstrPrefixesRegister -> ILCodeLabel -> ILInstr)
    | I_conditional_i8_instr of (ILInstrPrefixesRegister -> ILCodeLabel -> ILInstr)
L
latkin 已提交
625
    | I_string_instr of (ILInstrPrefixesRegister -> string -> ILInstr)
D
Don Syme 已提交
626
    | I_switch_instr of (ILInstrPrefixesRegister -> ILCodeLabel list -> ILInstr)
L
latkin 已提交
627 628 629 630 631
    | 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

D
Don Syme 已提交
632 633
let mkStind dt = volatileOrUnalignedPrefix (fun (x, y) -> I_stind(x, y, dt))
let mkLdind dt = volatileOrUnalignedPrefix (fun (x, y) -> I_ldind(x, y, dt))
L
latkin 已提交
634 635

let instrs () = 
D
Don Syme 已提交
636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654
 [ 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)
D
Don Syme 已提交
655
   i_stind_ref, I_none_instr (mkStind DT_REF)
D
Don Syme 已提交
656 657 658 659 660 661 662 663 664 665
   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)
D
Don Syme 已提交
666 667 668 669 670 671 672 673
   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))))
D
Don Syme 已提交
674 675
   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)))
D
Don Syme 已提交
676 677 678 679
   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) 
D
Don Syme 已提交
680 681 682
   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))
D
Don Syme 已提交
683
   i_newobj, I_method_instr (noPrefixes I_newobj)
D
Don Syme 已提交
684
   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))) 
D
Don Syme 已提交
685 686 687 688
   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) 
D
Don Syme 已提交
689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712
   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))) 
D
Don Syme 已提交
713 714 715
   i_ldstr, I_string_instr (noPrefixes I_ldstr) 
   i_switch, I_switch_instr (noPrefixes I_switch)
   i_ldtoken, I_tok_instr (noPrefixes I_ldtoken)
D
Don Syme 已提交
716
   i_calli, I_sig_instr (tailPrefix (fun tl (x, y) -> I_calli (tl, x, y)))
D
Don Syme 已提交
717 718
   i_mkrefany, I_type_instr (noPrefixes I_mkrefany)
   i_refanyval, I_type_instr (noPrefixes I_refanyval)
D
Don Syme 已提交
719 720 721 722
   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)))  
D
Don Syme 已提交
723 724 725 726 727
   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)
D
Don Syme 已提交
728 729
   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)))
D
Don Syme 已提交
730 731 732
   i_sizeof, I_type_instr (noPrefixes I_sizeof)
   i_box, I_type_instr (noPrefixes I_box)
   i_unbox, I_type_instr (noPrefixes I_unbox) ] 
L
latkin 已提交
733 734 735 736 737 738 739 740

// 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
D
Don Syme 已提交
741
    let addInstr (i, f) =  
L
latkin 已提交
742
        if i > 0xff then 
D
Don Syme 已提交
743
            assert (i >>>& 8 = 0xfe) 
L
latkin 已提交
744 745 746
            let i =  (i &&& 0xff)
            match twoByteInstrTable.[i] with
            | I_invalid_instr -> ()
D
Don Syme 已提交
747
            | _ -> dprintn ("warning: duplicate decode entries for "+string i)
L
latkin 已提交
748 749 750 751
            twoByteInstrTable.[i] <- f
        else 
            match oneByteInstrTable.[i] with
            | I_invalid_instr -> ()
D
Don Syme 已提交
752
            | _ -> dprintn ("warning: duplicate decode entries for "+string i)
L
latkin 已提交
753
            oneByteInstrTable.[i] <- f 
D
Don Syme 已提交
754
    List.iter addInstr (instrs())
D
Don Syme 已提交
755
    List.iter (fun (x, mk) -> addInstr (x, I_none_instr (noPrefixes mk))) (noArgInstrs.Force())
D
Don Syme 已提交
756
    oneByteInstrs := Some oneByteInstrTable
L
latkin 已提交
757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774
    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 }

D
Don Syme 已提交
775 776
let chunk sz next = ({addr=next; size=sz}, next + sz) 
let nochunk next = ({addr= 0x0;size= 0x0; } , next)
L
latkin 已提交
777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896

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
D
Don Syme 已提交
897
    addReport (fun oc -> if !count <> 0 then oc.WriteLine ((_inbase + string !count + " "+ _nm + " cache hits")  : string))
L
latkin 已提交
898 899 900 901
#endif
    fun f (idx:int32) ->
        let cache = 
            match !cache with
D
Don Syme 已提交
902
            | null -> cache :=  new Dictionary<int32, _>(11)
L
latkin 已提交
903 904 905 906 907
            | _ -> ()
            !cache
        let mutable res = Unchecked.defaultof<_>
        let ok = cache.TryGetValue(idx, &res)
        if ok then 
D
Don Syme 已提交
908
            incr count 
L
latkin 已提交
909 910 911
            res
        else 
            let res = f idx 
D
Don Syme 已提交
912
            cache.[idx] <- res 
L
latkin 已提交
913 914 915 916 917 918 919
            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
D
Don Syme 已提交
920
    addReport (fun oc -> if !count <> 0 then oc.WriteLine ((_inbase + string !count + " " + _nm + " cache hits") : string))
L
latkin 已提交
921 922 923 924
#endif
    fun f (idx :'T) ->
        let cache = 
            match !cache with
D
Don Syme 已提交
925
            | null -> cache := new Dictionary<_, _>(11 (* sz:int *) ) 
L
latkin 已提交
926 927
            | _ -> ()
            !cache
928 929 930 931 932 933 934 935
        match cache.TryGetValue(idx) with
        | true, v ->
            incr count
            v
        | _ ->
            let res = f idx
            cache.[idx] <- res
            res
L
latkin 已提交
936 937 938 939 940 941 942 943

//-----------------------------------------------------------------------
// Polymorphic general helpers for searching for particular rows.
// ----------------------------------------------------------------------

let seekFindRow numRows rowChooser =
    let mutable i = 1
    while (i <= numRows &&  not (rowChooser i)) do 
D
Don Syme 已提交
944 945
        i <- i + 1
    if i > numRows then dprintn "warning: seekFindRow: row not found"
L
latkin 已提交
946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967
    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
D
Don Syme 已提交
968
        end
L
latkin 已提交
969 970 971 972 973 974 975 976 977 978
        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 
D
Don Syme 已提交
979
                      fin <- true
L
latkin 已提交
980 981 982
                  else 
                      let currrow = rowReader curr
                      if keyComparer (keyFunc currrow) = 0 then 
D
Don Syme 已提交
983
                          res <- rowConverter currrow :: res
L
latkin 已提交
984
                      else 
D
Don Syme 已提交
985 986 987 988 989
                          fin <- true
                      curr <- curr + 1
                done
            end
            res <- List.rev res
L
latkin 已提交
990 991 992 993 994 995 996 997 998 999
            // 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 
D
Don Syme 已提交
1000
                        res <- rowConverter currrow :: res
L
latkin 已提交
1001
                    else 
D
Don Syme 已提交
1002 1003 1004
                        fin <- true
                    curr <- curr - 1
            end
L
latkin 已提交
1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022
        // 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 
D
Don Syme 已提交
1023
              res := rowConverter rowinfo :: !res
L
latkin 已提交
1024 1025 1026
        List.rev !res  


1027
let seekReadOptionalIndexedRow info =
L
latkin 已提交
1028 1029 1030 1031
    match seekReadIndexedRows info with 
    | [k] -> Some k
    | [] -> None
    | h::_ -> 
D
Don Syme 已提交
1032
        dprintn ("multiple rows found when indexing table") 
L
latkin 已提交
1033 1034
        Some h 
        
1035
let seekReadIndexedRow info =
L
latkin 已提交
1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046
    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

1047 1048 1049
[<NoEquality; NoComparison; RequireQualifiedAccess>]
type PEReader = 
  { fileName: string
1050
#if FX_NO_PDB_READER
D
Don Syme 已提交
1051
    pdb: obj option
L
latkin 已提交
1052
#else
D
Don Syme 已提交
1053
    pdb: (PdbReader * (string -> ILSourceDocument)) option
L
latkin 已提交
1054
#endif
D
Don Syme 已提交
1055
    entryPointToken: TableName * int
1056
    pefile: BinaryFile
D
Don Syme 已提交
1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068
    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
1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080
}

[<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 
D
Don Syme 已提交
1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125
    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
1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141
    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 }
L
latkin 已提交
1142
   
D
Don Syme 已提交
1143

1144 1145
let seekReadUInt16Adv mdv (addr: byref<int>) =  
    let res = seekReadUInt16 mdv addr
D
Don Syme 已提交
1146 1147 1148
    addr <- addr + 2
    res

1149 1150
let seekReadInt32Adv mdv (addr: byref<int>) = 
    let res = seekReadInt32 mdv addr
D
Don Syme 已提交
1151 1152 1153
    addr <- addr+4
    res

1154 1155
let seekReadUInt16AsInt32Adv mdv (addr: byref<int>) = 
    let res = seekReadUInt16AsInt32 mdv addr
D
Don Syme 已提交
1156 1157 1158
    addr <- addr+2
    res

1159 1160
let seekReadTaggedIdx f nbits big mdv (addr: byref<int>) =  
    let tok = if big then seekReadInt32Adv mdv &addr else seekReadUInt16AsInt32Adv mdv &addr 
D
Don Syme 已提交
1161 1162 1163
    tokToTaggedIdx f nbits tok


1164 1165
let seekReadIdx big mdv (addr: byref<int>) =  
    if big then seekReadInt32Adv mdv &addr else seekReadUInt16AsInt32Adv mdv &addr
D
Don Syme 已提交
1166

1167 1168
let seekReadUntaggedIdx (tab:TableName) (ctxt: ILMetadataReader) mdv (addr: byref<int>) =  
    seekReadIdx ctxt.tableBigness.[tab.Index] mdv &addr
D
Don Syme 已提交
1169 1170


1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186
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 
D
Don Syme 已提交
1187

1188
let seekReadModuleRow (ctxt: ILMetadataReader) mdv idx =
D
Don Syme 已提交
1189
    if idx = 0 then failwith "cannot read Module table row 0"
D
Don Syme 已提交
1190
    let mutable addr = ctxt.rowAddr TableNames.Module idx
1191 1192 1193 1194 1195
    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
L
latkin 已提交
1196 1197
    (generation, nameIdx, mvidIdx, encidIdx, encbaseidIdx) 

W
WilliamBerryiii 已提交
1198
/// Read Table ILTypeRef.
1199
let seekReadTypeRefRow (ctxt: ILMetadataReader) mdv idx =
D
Don Syme 已提交
1200
    let mutable addr = ctxt.rowAddr TableNames.TypeRef idx
1201 1202 1203
    let scopeIdx = seekReadResolutionScopeIdx ctxt mdv &addr
    let nameIdx = seekReadStringIdx ctxt mdv &addr
    let namespaceIdx = seekReadStringIdx ctxt mdv &addr
D
Don Syme 已提交
1204
    (scopeIdx, nameIdx, namespaceIdx) 
L
latkin 已提交
1205

W
WilliamBerryiii 已提交
1206
/// Read Table ILTypeDef.
1207
let seekReadTypeDefRow (ctxt: ILMetadataReader)  idx = ctxt.seekReadTypeDefRow idx
L
latkin 已提交
1208
let seekReadTypeDefRowUncached ctxtH idx =
1209 1210
    let (ctxt : ILMetadataReader) = getHole ctxtH
    let mdv = ctxt.mdfile.GetView()
D
Don Syme 已提交
1211
    let mutable addr = ctxt.rowAddr TableNames.TypeDef idx
1212 1213 1214 1215 1216 1217
    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
L
latkin 已提交
1218 1219
    (flags, nameIdx, namespaceIdx, extendsIdx, fieldsIdx, methodsIdx) 

W
WilliamBerryiii 已提交
1220
/// Read Table Field.
1221
let seekReadFieldRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1222
    let mutable addr = ctxt.rowAddr TableNames.Field idx
1223 1224 1225
    let flags = seekReadUInt16AsInt32Adv mdv &addr
    let nameIdx = seekReadStringIdx ctxt mdv &addr
    let typeIdx = seekReadBlobIdx ctxt mdv &addr
D
Don Syme 已提交
1226
    (flags, nameIdx, typeIdx)  
L
latkin 已提交
1227

W
WilliamBerryiii 已提交
1228
/// Read Table Method.
1229
let seekReadMethodRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1230
    let mutable addr = ctxt.rowAddr TableNames.Method idx
1231 1232 1233 1234 1235 1236
    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
L
latkin 已提交
1237 1238
    (codeRVA, implflags, flags, nameIdx, typeIdx, paramIdx) 

W
WilliamBerryiii 已提交
1239
/// Read Table Param.
1240
let seekReadParamRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1241
    let mutable addr = ctxt.rowAddr TableNames.Param idx
1242 1243 1244
    let flags = seekReadUInt16AsInt32Adv mdv &addr
    let seq =  seekReadUInt16AsInt32Adv mdv &addr
    let nameIdx = seekReadStringIdx ctxt mdv &addr
D
Don Syme 已提交
1245
    (flags, seq, nameIdx) 
L
latkin 已提交
1246

W
WilliamBerryiii 已提交
1247
/// Read Table InterfaceImpl.
1248
let seekReadInterfaceImplRow (ctxt: ILMetadataReader)  mdv idx = 
D
Don Syme 已提交
1249
    let mutable addr = ctxt.rowAddr TableNames.InterfaceImpl idx
1250 1251
    let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr
    let intfIdx = seekReadTypeDefOrRefOrSpecIdx ctxt mdv &addr
D
Don Syme 已提交
1252
    (tidx, intfIdx)
L
latkin 已提交
1253

W
WilliamBerryiii 已提交
1254
/// Read Table MemberRef.
1255
let seekReadMemberRefRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1256
    let mutable addr = ctxt.rowAddr TableNames.MemberRef idx
1257 1258 1259
    let mrpIdx = seekReadMemberRefParentIdx ctxt mdv &addr
    let nameIdx = seekReadStringIdx ctxt mdv &addr
    let typeIdx = seekReadBlobIdx ctxt mdv &addr
D
Don Syme 已提交
1260
    (mrpIdx, nameIdx, typeIdx) 
L
latkin 已提交
1261

W
WilliamBerryiii 已提交
1262
/// Read Table Constant.
1263
let seekReadConstantRow (ctxt: ILMetadataReader)  idx = ctxt.seekReadConstantRow idx
L
latkin 已提交
1264
let seekReadConstantRowUncached ctxtH idx =
1265 1266
    let (ctxt: ILMetadataReader)  = getHole ctxtH
    let mdv = ctxt.mdfile.GetView()
D
Don Syme 已提交
1267
    let mutable addr = ctxt.rowAddr TableNames.Constant idx
1268 1269 1270
    let kind = seekReadUInt16Adv mdv &addr
    let parentIdx = seekReadHasConstantIdx ctxt mdv &addr
    let valIdx = seekReadBlobIdx ctxt mdv &addr
L
latkin 已提交
1271 1272
    (kind, parentIdx, valIdx)

W
WilliamBerryiii 已提交
1273
/// Read Table CustomAttribute.
1274 1275
let seekReadCustomAttributeRow (ctxt: ILMetadataReader)  idx =
    let mdv = ctxt.mdfile.GetView()
D
Don Syme 已提交
1276
    let mutable addr = ctxt.rowAddr TableNames.CustomAttribute idx
1277 1278 1279
    let parentIdx = seekReadHasCustomAttributeIdx ctxt mdv &addr
    let typeIdx = seekReadCustomAttributeTypeIdx ctxt mdv &addr
    let valIdx = seekReadBlobIdx ctxt mdv &addr
L
latkin 已提交
1280 1281
    (parentIdx, typeIdx, valIdx)  

W
WilliamBerryiii 已提交
1282
/// Read Table FieldMarshal.
1283
let seekReadFieldMarshalRow (ctxt: ILMetadataReader)  mdv idx = 
D
Don Syme 已提交
1284
    let mutable addr = ctxt.rowAddr TableNames.FieldMarshal idx
1285 1286
    let parentIdx = seekReadHasFieldMarshalIdx ctxt mdv &addr
    let typeIdx = seekReadBlobIdx ctxt mdv &addr
L
latkin 已提交
1287 1288
    (parentIdx, typeIdx)

W
WilliamBerryiii 已提交
1289
/// Read Table Permission.
1290
let seekReadPermissionRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1291
    let mutable addr = ctxt.rowAddr TableNames.Permission idx
1292 1293 1294
    let action = seekReadUInt16Adv mdv &addr
    let parentIdx = seekReadHasDeclSecurityIdx ctxt mdv &addr
    let typeIdx = seekReadBlobIdx ctxt mdv &addr
D
Don Syme 已提交
1295
    (action, parentIdx, typeIdx) 
L
latkin 已提交
1296

W
WilliamBerryiii 已提交
1297
/// Read Table ClassLayout. 
1298
let seekReadClassLayoutRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1299
    let mutable addr = ctxt.rowAddr TableNames.ClassLayout idx
1300 1301 1302
    let pack = seekReadUInt16Adv mdv &addr
    let size = seekReadInt32Adv mdv &addr
    let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr
D
Don Syme 已提交
1303
    (pack, size, tidx)  
L
latkin 已提交
1304

W
WilliamBerryiii 已提交
1305
/// Read Table FieldLayout. 
1306
let seekReadFieldLayoutRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1307
    let mutable addr = ctxt.rowAddr TableNames.FieldLayout idx
1308 1309
    let offset = seekReadInt32Adv mdv &addr
    let fidx = seekReadUntaggedIdx TableNames.Field ctxt mdv &addr
D
Don Syme 已提交
1310
    (offset, fidx)  
L
latkin 已提交
1311

W
WilliamBerryiii 已提交
1312
//// Read Table StandAloneSig. 
1313
let seekReadStandAloneSigRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1314
    let mutable addr = ctxt.rowAddr TableNames.StandAloneSig idx
1315
    let sigIdx = seekReadBlobIdx ctxt mdv &addr
L
latkin 已提交
1316 1317
    sigIdx

W
WilliamBerryiii 已提交
1318
/// Read Table EventMap. 
1319
let seekReadEventMapRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1320
    let mutable addr = ctxt.rowAddr TableNames.EventMap idx
1321 1322
    let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr
    let eventsIdx = seekReadUntaggedIdx TableNames.Event ctxt mdv &addr
D
Don Syme 已提交
1323
    (tidx, eventsIdx) 
L
latkin 已提交
1324

W
WilliamBerryiii 已提交
1325
/// Read Table Event. 
1326
let seekReadEventRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1327
    let mutable addr = ctxt.rowAddr TableNames.Event idx
1328 1329 1330
    let flags = seekReadUInt16AsInt32Adv mdv &addr
    let nameIdx = seekReadStringIdx ctxt mdv &addr
    let typIdx = seekReadTypeDefOrRefOrSpecIdx ctxt mdv &addr
D
Don Syme 已提交
1331
    (flags, nameIdx, typIdx) 
L
latkin 已提交
1332
   
W
WilliamBerryiii 已提交
1333
/// Read Table PropertyMap. 
1334
let seekReadPropertyMapRow (ctxt: ILMetadataReader)  mdv idx = 
D
Don Syme 已提交
1335
    let mutable addr = ctxt.rowAddr TableNames.PropertyMap idx
1336 1337
    let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr
    let propsIdx = seekReadUntaggedIdx TableNames.Property ctxt mdv &addr
D
Don Syme 已提交
1338
    (tidx, propsIdx)
L
latkin 已提交
1339

W
WilliamBerryiii 已提交
1340
/// Read Table Property. 
1341
let seekReadPropertyRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1342
    let mutable addr = ctxt.rowAddr TableNames.Property idx
1343 1344 1345
    let flags = seekReadUInt16AsInt32Adv mdv &addr
    let nameIdx = seekReadStringIdx ctxt mdv &addr
    let typIdx = seekReadBlobIdx ctxt mdv &addr
D
Don Syme 已提交
1346
    (flags, nameIdx, typIdx) 
L
latkin 已提交
1347

W
WilliamBerryiii 已提交
1348
/// Read Table MethodSemantics.
1349
let seekReadMethodSemanticsRow (ctxt: ILMetadataReader)  idx = ctxt.seekReadMethodSemanticsRow idx
L
latkin 已提交
1350
let seekReadMethodSemanticsRowUncached ctxtH idx =
1351 1352
    let (ctxt: ILMetadataReader)  = getHole ctxtH
    let mdv = ctxt.mdfile.GetView()
D
Don Syme 已提交
1353
    let mutable addr = ctxt.rowAddr TableNames.MethodSemantics idx
1354 1355 1356
    let flags = seekReadUInt16AsInt32Adv mdv &addr
    let midx = seekReadUntaggedIdx TableNames.Method ctxt mdv &addr
    let assocIdx = seekReadHasSemanticsIdx ctxt mdv &addr
D
Don Syme 已提交
1357
    (flags, midx, assocIdx)
L
latkin 已提交
1358

W
WilliamBerryiii 已提交
1359
/// Read Table MethodImpl.
1360
let seekReadMethodImplRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1361
    let mutable addr = ctxt.rowAddr TableNames.MethodImpl idx
1362 1363 1364
    let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr
    let mbodyIdx = seekReadMethodDefOrRefIdx ctxt mdv &addr
    let mdeclIdx = seekReadMethodDefOrRefIdx ctxt mdv &addr
D
Don Syme 已提交
1365
    (tidx, mbodyIdx, mdeclIdx) 
L
latkin 已提交
1366

W
WilliamBerryiii 已提交
1367
/// Read Table ILModuleRef.
1368
let seekReadModuleRefRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1369
    let mutable addr = ctxt.rowAddr TableNames.ModuleRef idx
1370
    let nameIdx = seekReadStringIdx ctxt mdv &addr
L
latkin 已提交
1371 1372
    nameIdx  

W
WilliamBerryiii 已提交
1373
/// Read Table ILTypeSpec.
1374
let seekReadTypeSpecRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1375
    let mutable addr = ctxt.rowAddr TableNames.TypeSpec idx
1376
    let blobIdx = seekReadBlobIdx ctxt mdv &addr
L
latkin 已提交
1377 1378
    blobIdx  

W
WilliamBerryiii 已提交
1379
/// Read Table ImplMap.
1380
let seekReadImplMapRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1381
    let mutable addr = ctxt.rowAddr TableNames.ImplMap idx
1382 1383 1384 1385
    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
L
latkin 已提交
1386 1387
    (flags, forwrdedIdx, nameIdx, scopeIdx) 

W
WilliamBerryiii 已提交
1388
/// Read Table FieldRVA.
1389
let seekReadFieldRVARow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1390
    let mutable addr = ctxt.rowAddr TableNames.FieldRVA idx
1391 1392
    let rva = seekReadInt32Adv mdv &addr
    let fidx = seekReadUntaggedIdx TableNames.Field ctxt mdv &addr
D
Don Syme 已提交
1393
    (rva, fidx) 
L
latkin 已提交
1394

W
WilliamBerryiii 已提交
1395
/// Read Table Assembly.
1396
let seekReadAssemblyRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1397
    let mutable addr = ctxt.rowAddr TableNames.Assembly idx
1398 1399 1400 1401 1402 1403 1404 1405 1406
    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
D
Don Syme 已提交
1407
    (hash, v1, v2, v3, v4, flags, publicKeyIdx, nameIdx, localeIdx)
L
latkin 已提交
1408

W
WilliamBerryiii 已提交
1409
/// Read Table ILAssemblyRef.
1410
let seekReadAssemblyRefRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1411
    let mutable addr = ctxt.rowAddr TableNames.AssemblyRef idx
1412 1413 1414 1415 1416 1417 1418 1419 1420
    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
D
Don Syme 已提交
1421
    (v1, v2, v3, v4, flags, publicKeyOrTokenIdx, nameIdx, localeIdx, hashValueIdx) 
L
latkin 已提交
1422

W
WilliamBerryiii 已提交
1423
/// Read Table File.
1424
let seekReadFileRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1425
    let mutable addr = ctxt.rowAddr TableNames.File idx
1426 1427 1428
    let flags = seekReadInt32Adv mdv &addr
    let nameIdx = seekReadStringIdx ctxt mdv &addr
    let hashValueIdx = seekReadBlobIdx ctxt mdv &addr
L
latkin 已提交
1429 1430
    (flags, nameIdx, hashValueIdx) 

W
WilliamBerryiii 已提交
1431
/// Read Table ILExportedTypeOrForwarder.
1432
let seekReadExportedTypeRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1433
    let mutable addr = ctxt.rowAddr TableNames.ExportedType idx
1434 1435 1436 1437 1438
    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
D
Don Syme 已提交
1439
    (flags, tok, nameIdx, namespaceIdx, implIdx) 
L
latkin 已提交
1440

W
WilliamBerryiii 已提交
1441
/// Read Table ManifestResource.
1442
let seekReadManifestResourceRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1443
    let mutable addr = ctxt.rowAddr TableNames.ManifestResource idx
1444 1445 1446 1447
    let offset = seekReadInt32Adv mdv &addr
    let flags = seekReadInt32Adv mdv &addr
    let nameIdx = seekReadStringIdx ctxt mdv &addr
    let implIdx = seekReadImplementationIdx ctxt mdv &addr
D
Don Syme 已提交
1448
    (offset, flags, nameIdx, implIdx) 
L
latkin 已提交
1449

W
WilliamBerryiii 已提交
1450
/// Read Table Nested.
1451
let seekReadNestedRow (ctxt: ILMetadataReader)  idx = ctxt.seekReadNestedRow idx
L
latkin 已提交
1452
let seekReadNestedRowUncached ctxtH idx =
1453 1454
    let (ctxt: ILMetadataReader)  = getHole ctxtH
    let mdv = ctxt.mdfile.GetView()
D
Don Syme 已提交
1455
    let mutable addr = ctxt.rowAddr TableNames.Nested idx
1456 1457
    let nestedIdx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr
    let enclIdx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr
D
Don Syme 已提交
1458
    (nestedIdx, enclIdx)
L
latkin 已提交
1459

W
WilliamBerryiii 已提交
1460
/// Read Table GenericParam.
1461
let seekReadGenericParamRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1462
    let mutable addr = ctxt.rowAddr TableNames.GenericParam idx
1463 1464 1465 1466
    let seq = seekReadUInt16Adv mdv &addr
    let flags = seekReadUInt16Adv mdv &addr
    let ownerIdx = seekReadTypeOrMethodDefIdx ctxt mdv &addr
    let nameIdx = seekReadStringIdx ctxt mdv &addr
D
Don Syme 已提交
1467
    (idx, seq, flags, ownerIdx, nameIdx) 
L
latkin 已提交
1468

W
WilliamBerryiii 已提交
1469
// Read Table GenericParamConstraint.
1470
let seekReadGenericParamConstraintRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1471
    let mutable addr = ctxt.rowAddr TableNames.GenericParamConstraint idx
1472 1473
    let pidx = seekReadUntaggedIdx TableNames.GenericParam ctxt mdv &addr
    let constraintIdx = seekReadTypeDefOrRefOrSpecIdx ctxt mdv &addr
D
Don Syme 已提交
1474
    (pidx, constraintIdx) 
L
latkin 已提交
1475

W
WilliamBerryiii 已提交
1476
/// Read Table ILMethodSpec.
1477
let seekReadMethodSpecRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1478
    let mutable addr = ctxt.rowAddr TableNames.MethodSpec idx
1479 1480
    let mdorIdx = seekReadMethodDefOrRefIdx ctxt mdv &addr
    let instIdx = seekReadBlobIdx ctxt mdv &addr
D
Don Syme 已提交
1481
    (mdorIdx, instIdx) 
L
latkin 已提交
1482

D
Don Syme 已提交
1483

L
latkin 已提交
1484
let readUserStringHeapUncached ctxtH idx = 
1485 1486 1487
    let (ctxt: ILMetadataReader)  = getHole ctxtH
    let mdv = ctxt.mdfile.GetView()
    seekReadUserString mdv (ctxt.userStringsStreamPhysicalLoc + idx)
L
latkin 已提交
1488

1489
let readUserStringHeap (ctxt: ILMetadataReader)  idx = ctxt.readUserStringHeap  idx 
L
latkin 已提交
1490 1491

let readStringHeapUncached ctxtH idx = 
1492 1493 1494 1495 1496 1497 1498
    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) 
L
latkin 已提交
1499

1500
let emptyByteArray: byte[] = [||]
1501

L
latkin 已提交
1502
let readBlobHeapUncached ctxtH idx = 
1503 1504
    let (ctxt: ILMetadataReader)  = getHole ctxtH
    let mdv = ctxt.mdfile.GetView()
1505
    // valid index lies in range [1..streamSize)
1506
    // NOTE: idx cannot be 0 - Blob\String heap has first empty element that mdv one byte 0
1507
    if idx <= 0 || idx >= ctxt.blobsStreamSize then emptyByteArray
1508 1509 1510 1511
    else seekReadBlob mdv (ctxt.blobsStreamPhysicalLoc + idx) 

let readBlobHeap        (ctxt: ILMetadataReader)  idx = ctxt.readBlobHeap idx 

L
latkin 已提交
1512 1513
let readBlobHeapOption ctxt idx = if idx = 0 then None else Some (readBlobHeap ctxt idx) 

1514
//let readGuidHeap ctxt idx = seekReadGuid ctxt.mdv (ctxt.guidsStreamPhysicalLoc + idx) 
L
latkin 已提交
1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545

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

1546 1547 1548 1549
let readNativeResources (pectxt: PEReader)  = 
    [ if pectxt.nativeResourcesSize <> 0x0  && pectxt.nativeResourcesAddr <> 0x0 then 
           let start = pectxt.anyV2P (pectxt.fileName + ": native resources", pectxt.nativeResourcesAddr)
           yield ILNativeResource.In (pectxt.fileName, pectxt.nativeResourcesAddr, start, pectxt.nativeResourcesSize ) ]
L
latkin 已提交
1550
   
1551
let getDataEndPointsDelayed (pectxt: PEReader) ctxtH = 
L
latkin 已提交
1552
    lazy
1553 1554
        let (ctxt: ILMetadataReader)  = getHole ctxtH
        let mdv = ctxt.mdfile.GetView()
L
latkin 已提交
1555 1556 1557
        let dataStartPoints = 
            let res = ref []
            for i = 1 to ctxt.getNumRows (TableNames.FieldRVA) do
1558
                let rva, _fidx = seekReadFieldRVARow ctxt mdv i
D
Don Syme 已提交
1559
                res := ("field", rva) :: !res
L
latkin 已提交
1560
            for i = 1 to ctxt.getNumRows TableNames.ManifestResource do
1561
                let (offset, _, _, TaggedIndex(_tag, idx)) = seekReadManifestResourceRow ctxt mdv i
L
latkin 已提交
1562
                if idx = 0 then 
1563
                  let rva = pectxt.resourcesAddr + offset
D
Don Syme 已提交
1564
                  res := ("manifest resource", rva) :: !res
L
latkin 已提交
1565
            !res
D
Don Syme 已提交
1566
        if isNil dataStartPoints then [] 
L
latkin 已提交
1567 1568 1569 1570
        else
          let methodRVAs = 
              let res = ref []
              for i = 1 to ctxt.getNumRows TableNames.Method do
1571
                  let (rva, _, _, nameIdx, _, _) = seekReadMethodRow ctxt mdv i
L
latkin 已提交
1572 1573
                  if rva <> 0 then 
                     let nm = readStringHeap ctxt nameIdx
D
Don Syme 已提交
1574
                     res := (nm, rva) :: !res
L
latkin 已提交
1575
              !res
1576 1577
          ([ pectxt.textSegmentPhysicalLoc + pectxt.textSegmentPhysicalSize ; 
             pectxt.dataSegmentPhysicalLoc + pectxt.dataSegmentPhysicalSize ] 
L
latkin 已提交
1578
           @ 
1579
           (List.map pectxt.anyV2P 
L
latkin 已提交
1580
              (dataStartPoints 
1581 1582 1583 1584 1585 1586
                @ [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) ])
L
latkin 已提交
1587
                @ methodRVAs)))
S
Steffen Forkmann 已提交
1588
           |> List.distinct
L
latkin 已提交
1589 1590 1591
           |> List.sort 
      

1592
let rvaToData (ctxt: ILMetadataReader) (pectxt: PEReader) nm rva = 
D
Don Syme 已提交
1593
    if rva = 0x0 then failwith "rva is zero"
1594
    let start = pectxt.anyV2P (nm, rva)
L
latkin 已提交
1595 1596 1597 1598
    let endPoints = (Lazy.force ctxt.dataEndPoints)
    let rec look l = 
        match l with 
        | [] -> 
1599
            failwithf "find_text_data_extent: none found for fileName=%s, name=%s, rva=0x%08x, start=0x%08x" ctxt.fileName nm rva start 
L
latkin 已提交
1600 1601
        | e::t -> 
           if start < e then 
1602 1603
             let pev = pectxt.pefile.GetView()
             seekReadBytes pev start (e - start)
L
latkin 已提交
1604 1605 1606 1607 1608 1609 1610 1611
           else look t
    look endPoints

  
//-----------------------------------------------------------------------
// Read the AbsIL structure (lazily) by reading off the relevant rows.
// ----------------------------------------------------------------------

1612
let isSorted (ctxt: ILMetadataReader) (tab:TableName) = ((ctxt.sorted &&& (int64 1 <<< tab.Index)) <> int64 0x0) 
L
latkin 已提交
1613

1614 1615 1616 1617 1618
// 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
L
latkin 已提交
1619
    let ilModuleName = readStringHeap ctxt nameIdx
1620
    let nativeResources = readNativeResources pectxtEager
L
latkin 已提交
1621

K
KevinRansom 已提交
1622
    { Manifest =
1623
         if ctxt.getNumRows (TableNames.Assembly) > 0 then Some (seekReadAssemblyManifest ctxt pectxtEager 1) 
D
Don Syme 已提交
1624
         else None
1625 1626
      CustomAttrsStored = ctxt.customAttrsReader_Module
      MetadataIndex = idx
D
Don Syme 已提交
1627 1628
      Name = ilModuleName
      NativeResources=nativeResources
1629
      TypeDefs = mkILTypeDefsComputed (fun () -> seekReadTopTypeDefs ctxt)
D
Don Syme 已提交
1630 1631
      SubSystemFlags = int32 subsys
      IsILOnly = ilOnly
L
latkin 已提交
1632 1633
      SubsystemVersion = subsysversion
      UseHighEntropyVA = useHighEntropyVA
D
Don Syme 已提交
1634 1635 1636 1637 1638 1639 1640 1641 1642 1643
      Platform = platform
      StackReserveSize = None  // TODO
      Is32Bit = only32
      Is32BitPreferred = is32bitpreferred
      Is64Bit = only64
      IsDLL=isDll
      VirtualAlignment = alignVirt
      PhysicalAlignment = alignPhys
      ImageBase = imageBaseReal
      MetadataVersion = ilMetadataVersion
1644
      Resources = seekReadManifestResources ctxt mdv pectxtEager pevEager }  
L
latkin 已提交
1645

1646 1647 1648
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
L
latkin 已提交
1649 1650
    let name = readStringHeap ctxt nameIdx
    let pubkey = readBlobHeapOption ctxt publicKeyIdx
D
Don Syme 已提交
1651 1652
    { Name= name 
      AuxModuleHashAlgorithm=hash
1653
      SecurityDeclsStored= ctxt.securityDeclsReader_Assembly
D
Don Syme 已提交
1654
      PublicKey= pubkey  
D
Don Syme 已提交
1655
      Version= Some (v1, v2, v3, v4)
D
Don Syme 已提交
1656
      Locale= readStringHeapOption ctxt localeIdx
1657 1658
      CustomAttrsStored = ctxt.customAttrsReader_Assembly
      MetadataIndex = idx
L
latkin 已提交
1659
      AssemblyLongevity= 
1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670
        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
D
Don Syme 已提交
1671 1672
      Retargetable = 0 <> (flags &&& 0x100)
      DisableJitOptimizations = 0 <> (flags &&& 0x4000)
1673 1674 1675
      JitTracking = 0 <> (flags &&& 0x8000) 
      IgnoreSymbolStoreSequencePoints = 0 <> (flags &&& 0x2000) } 

1676
and seekReadAssemblyRef (ctxt: ILMetadataReader)  idx = ctxt.seekReadAssemblyRef idx
L
latkin 已提交
1677
and seekReadAssemblyRefUncached ctxtH idx = 
1678 1679 1680
    let (ctxt: ILMetadataReader)  = getHole ctxtH
    let mdv = ctxt.mdfile.GetView()
    let (v1, v2, v3, v4, flags, publicKeyOrTokenIdx, nameIdx, localeIdx, hashValueIdx) = seekReadAssemblyRefRow ctxt mdv idx
L
latkin 已提交
1681 1682 1683 1684 1685 1686 1687 1688 1689
    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, 
D
Don Syme 已提交
1690
         publicKey=publicKey, 
L
latkin 已提交
1691
         retargetable=((flags &&& 0x0100) <> 0x0), 
D
Don Syme 已提交
1692
         version=Some(v1, v2, v3, v4), 
D
Don Syme 已提交
1693
         locale=readStringHeapOption ctxt localeIdx)
L
latkin 已提交
1694

1695 1696 1697
and seekReadModuleRef (ctxt: ILMetadataReader)  mdv idx =
    let (nameIdx) = seekReadModuleRefRow ctxt mdv idx
    ILModuleRef.Create(name =  readStringHeap ctxt nameIdx, hasMetadata=true, hash=None)
L
latkin 已提交
1698

1699 1700 1701
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)
L
latkin 已提交
1702

1703 1704
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 
L
latkin 已提交
1705
    | None -> { Size = None; Pack = None }
D
Don Syme 已提交
1706
    | Some (pack, size) -> { Size = Some size; Pack = Some pack }
L
latkin 已提交
1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718

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

1719
and typeLayoutOfFlags (ctxt: ILMetadataReader)  mdv flags tidx = 
L
latkin 已提交
1720
    let f = (flags &&& 0x00000018)
1721 1722
    if f = 0x00000008 then ILTypeDefLayout.Sequential (seekReadClassLayout ctxt mdv tidx)
    elif f = 0x00000010 then  ILTypeDefLayout.Explicit (seekReadClassLayout ctxt mdv tidx)
L
latkin 已提交
1723 1724 1725 1726 1727 1728 1729
    else ILTypeDefLayout.Auto

and isTopTypeDef flags =
    (typeAccessOfFlags flags =  ILTypeDefAccess.Private) ||
     typeAccessOfFlags flags =  ILTypeDefAccess.Public
       
and seekIsTopTypeDefOfIdx ctxt idx =
D
Don Syme 已提交
1730
    let (flags, _, _, _, _, _) = seekReadTypeDefRow ctxt idx
L
latkin 已提交
1731 1732
    isTopTypeDef flags
       
D
Don Syme 已提交
1733
and readBlobHeapAsSplitTypeName ctxt (nameIdx, namespaceIdx) = 
L
latkin 已提交
1734 1735 1736
    let name = readStringHeap ctxt nameIdx
    let nspace = readStringHeapOption ctxt namespaceIdx
    match nspace with 
D
Don Syme 已提交
1737 1738
    | Some nspace -> splitNamespace nspace, name  
    | None -> [], name
L
latkin 已提交
1739

D
Don Syme 已提交
1740
and readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) = 
L
latkin 已提交
1741 1742 1743 1744 1745 1746
    let name = readStringHeap ctxt nameIdx
    let nspace = readStringHeapOption ctxt namespaceIdx
    match nspace with 
    | None -> name  
    | Some ns -> ctxt.memoizeString (ns+"."+name)

1747
and seekReadTypeDefRowExtents (ctxt: ILMetadataReader)  _info (idx:int) =
L
latkin 已提交
1748
    if idx >= ctxt.getNumRows TableNames.TypeDef then 
D
Don Syme 已提交
1749
        ctxt.getNumRows TableNames.Field + 1, 
L
latkin 已提交
1750 1751 1752 1753 1754 1755 1756
        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
D
Don Syme 已提交
1757
    info, seekReadTypeDefRowExtents ctxt info idx
L
latkin 已提交
1758

1759
and seekReadPreTypeDef ctxt toponly (idx:int) =
D
Don Syme 已提交
1760
    let (flags, nameIdx, namespaceIdx, _, _, _) = seekReadTypeDefRow ctxt idx
L
latkin 已提交
1761 1762
    if toponly && not (isTopTypeDef flags) then None
    else
D
Don Syme 已提交
1763
     let ns, n = readBlobHeapAsSplitTypeName ctxt (nameIdx, namespaceIdx)
1764 1765
     // Return the ILPreTypeDef
     Some (mkILPreTypeDefRead (ns, n, idx, ctxt.typeDefReader))
L
latkin 已提交
1766

1767 1768 1769 1770
and typeDefReader ctxtH : ILTypeDefStored =
  mkILTypeDefReader
    (fun idx -> 
           let (ctxt: ILMetadataReader) = getHole ctxtH
1771
           let mdv = ctxt.mdfile.GetView()
1772
           // Re-read so as not to save all these in the lazy closure - this suspension ctxt.is the largest 
L
latkin 已提交
1773
           // heavily allocated one in all of AbsIL
1774

D
Don Syme 已提交
1775 1776
           let ((flags, nameIdx, namespaceIdx, extendsIdx, fieldsIdx, methodsIdx) as info) = seekReadTypeDefRow ctxt idx
           let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx)
L
latkin 已提交
1777
           let (endFieldsIdx, endMethodsIdx) = seekReadTypeDefRowExtents ctxt info idx
D
Don Syme 已提交
1778
           let typars = seekReadGenericParams ctxt 0 (tomd_TypeDef, idx)
L
latkin 已提交
1779 1780
           let numtypars = typars.Length
           let super = seekReadOptionalTypeDefOrRef ctxt numtypars AsObject extendsIdx
1781
           let layout = typeLayoutOfFlags ctxt mdv flags idx
L
latkin 已提交
1782 1783
           let hasLayout = (match layout with ILTypeDefLayout.Explicit _ -> true | _ -> false)
           let mdefs = seekReadMethods ctxt numtypars methodsIdx endMethodsIdx
D
Don Syme 已提交
1784
           let fdefs = seekReadFields ctxt (numtypars, hasLayout) fieldsIdx endFieldsIdx
L
latkin 已提交
1785
           let nested = seekReadNestedTypeDefs ctxt idx 
1786
           let impls  = seekReadInterfaceImpls ctxt mdv numtypars idx
L
latkin 已提交
1787 1788 1789
           let mimpls = seekReadMethodImpls ctxt numtypars idx
           let props  = seekReadProperties ctxt numtypars idx
           let events = seekReadEvents ctxt numtypars idx
D
Don Syme 已提交
1790 1791 1792 1793 1794 1795 1796 1797
           ILTypeDef(name=nm,
                     genericParams=typars ,
                     attributes= enum<TypeAttributes>(flags),
                     layout = layout,
                     nestedTypes= nested,
                     implements = impls,
                     extends = super,
                     methods = mdefs,
1798
                     securityDeclsStored = ctxt.securityDeclsReader_TypeDef,
D
Don Syme 已提交
1799 1800 1801 1802
                     fields=fdefs,
                     methodImpls=mimpls,
                     events= events,
                     properties=props,
1803 1804 1805
                     customAttrsStored=ctxt.customAttrsReader_TypeDef,
                     metadataIndex=idx)
    )
L
latkin 已提交
1806

1807
and seekReadTopTypeDefs (ctxt: ILMetadataReader)  =
1808
    [| for i = 1 to ctxt.getNumRows TableNames.TypeDef do
1809
          match seekReadPreTypeDef ctxt true i  with 
L
latkin 已提交
1810
          | None -> ()
1811
          | Some td -> yield td |]
L
latkin 已提交
1812

1813
and seekReadNestedTypeDefs (ctxt: ILMetadataReader)  tidx =
1814
    mkILTypeDefsComputed (fun () -> 
D
Don Syme 已提交
1815
           let nestedIdxs = seekReadIndexedRows (ctxt.getNumRows TableNames.Nested, seekReadNestedRow ctxt, snd, simpleIndexCompare tidx, false, fst)
1816
           [| for i in nestedIdxs do 
1817
                 match seekReadPreTypeDef ctxt false i with 
L
latkin 已提交
1818
                 | None -> ()
1819
                 | Some td -> yield td |])
L
latkin 已提交
1820

1821
and seekReadInterfaceImpls (ctxt: ILMetadataReader)  mdv numtypars tidx =
D
Don Syme 已提交
1822
    seekReadIndexedRows (ctxt.getNumRows TableNames.InterfaceImpl, 
1823 1824 1825 1826 1827
                         seekReadInterfaceImplRow ctxt mdv, 
                         fst, 
                         simpleIndexCompare tidx, 
                         isSorted ctxt TableNames.InterfaceImpl, 
                         (snd >> seekReadTypeDefOrRef ctxt numtypars AsObject (*ok*) List.empty)) 
L
latkin 已提交
1828

D
Don Syme 已提交
1829 1830
and seekReadGenericParams ctxt numtypars (a, b) : ILGenericParameterDefs = 
    ctxt.seekReadGenericParams (GenericParamsIdx(numtypars, a, b))
L
latkin 已提交
1831

D
Don Syme 已提交
1832
and seekReadGenericParamsUncached ctxtH (GenericParamsIdx(numtypars, a, b)) =
1833 1834
    let (ctxt: ILMetadataReader)  = getHole ctxtH
    let mdv = ctxt.mdfile.GetView()
L
latkin 已提交
1835 1836
    let pars =
        seekReadIndexedRows
1837
            (ctxt.getNumRows TableNames.GenericParam, seekReadGenericParamRow ctxt mdv, 
D
Don Syme 已提交
1838 1839 1840 1841
             (fun (_, _, _, tomd, _) -> tomd), 
             tomdCompare (TaggedIndex(a, b)), 
             isSorted ctxt TableNames.GenericParam, 
             (fun (gpidx, seq, flags, _, nameIdx) -> 
L
latkin 已提交
1842 1843 1844 1845 1846 1847 1848
                 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
1849
                 let constraints = seekReadGenericParamConstraints ctxt mdv numtypars gpidx
D
Don Syme 已提交
1850
                 seq, {Name=readStringHeap ctxt nameIdx
1851
                       Constraints = constraints
D
Don Syme 已提交
1852
                       Variance=variance  
1853 1854
                       CustomAttrsStored = ctxt.customAttrsReader_GenericParam
                       MetadataIndex=gpidx
D
Don Syme 已提交
1855 1856 1857
                       HasReferenceTypeConstraint= (flags &&& 0x0004) <> 0
                       HasNotNullableValueTypeConstraint= (flags &&& 0x0008) <> 0
                       HasDefaultConstructorConstraint=(flags &&& 0x0010) <> 0 }))
L
latkin 已提交
1858 1859
    pars |> List.sortBy fst |> List.map snd 

1860
and seekReadGenericParamConstraints (ctxt: ILMetadataReader)  mdv numtypars gpidx =
L
latkin 已提交
1861
    seekReadIndexedRows 
D
Don Syme 已提交
1862
        (ctxt.getNumRows TableNames.GenericParamConstraint, 
1863
         seekReadGenericParamConstraintRow ctxt mdv, 
D
Don Syme 已提交
1864 1865 1866
         fst, 
         simpleIndexCompare gpidx, 
         isSorted ctxt TableNames.GenericParamConstraint, 
1867
         (snd >>  seekReadTypeDefOrRef ctxt numtypars AsObject (*ok*) List.empty))
L
latkin 已提交
1868

1869
and seekReadTypeDefAsType (ctxt: ILMetadataReader)  boxity (ginst:ILTypes) idx =
D
Don Syme 已提交
1870
      ctxt.seekReadTypeDefAsType (TypeDefAsTypIdx (boxity, ginst, idx))
L
latkin 已提交
1871

D
Don Syme 已提交
1872
and seekReadTypeDefAsTypeUncached ctxtH (TypeDefAsTypIdx (boxity, ginst, idx)) =
L
latkin 已提交
1873 1874 1875
    let ctxt = getHole ctxtH
    mkILTy boxity (ILTypeSpec.Create(seekReadTypeDefAsTypeRef ctxt idx, ginst))

1876
and seekReadTypeDefAsTypeRef (ctxt: ILMetadataReader)  idx =
L
latkin 已提交
1877 1878 1879
     let enc = 
       if seekIsTopTypeDefOfIdx ctxt idx then [] 
       else 
D
Don Syme 已提交
1880
         let enclIdx = seekReadIndexedRow (ctxt.getNumRows TableNames.Nested, seekReadNestedRow ctxt, fst, simpleIndexCompare idx, isSorted ctxt TableNames.Nested, snd)
L
latkin 已提交
1881 1882 1883
         let tref = seekReadTypeDefAsTypeRef ctxt enclIdx
         tref.Enclosing@[tref.Name]
     let (_, nameIdx, namespaceIdx, _, _, _) = seekReadTypeDefRow ctxt idx
D
Don Syme 已提交
1884
     let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx)
L
latkin 已提交
1885 1886
     ILTypeRef.Create(scope=ILScopeRef.Local, enclosing=enc, name = nm )

1887
and seekReadTypeRef (ctxt: ILMetadataReader)  idx = ctxt.seekReadTypeRef idx
L
latkin 已提交
1888
and seekReadTypeRefUncached ctxtH idx =
1889 1890 1891 1892
     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
D
Don Syme 已提交
1893
     let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx)
L
latkin 已提交
1894 1895
     ILTypeRef.Create(scope=scope, enclosing=enc, name = nm) 

1896
and seekReadTypeRefAsType (ctxt: ILMetadataReader)  boxity ginst idx = ctxt.seekReadTypeRefAsType (TypeRefAsTypIdx (boxity, ginst, idx))
D
Don Syme 已提交
1897
and seekReadTypeRefAsTypeUncached ctxtH (TypeRefAsTypIdx (boxity, ginst, idx)) =
L
latkin 已提交
1898 1899 1900
     let ctxt = getHole ctxtH
     mkILTy boxity (ILTypeSpec.Create(seekReadTypeRef ctxt idx, ginst))

1901 1902
and seekReadTypeDefOrRef (ctxt: ILMetadataReader)  numtypars boxity (ginst:ILTypes) (TaggedIndex(tag, idx) ) =
    let mdv = ctxt.mdfile.GetView()
L
latkin 已提交
1903 1904 1905 1906
    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 -> 
1907
        if not (List.isEmpty ginst) then dprintn ("type spec used as type constructor for a generic instantiation: ignoring instantiation")
1908
        readBlobHeapAsType ctxt numtypars (seekReadTypeSpecRow ctxt mdv idx)
L
latkin 已提交
1909 1910
    | _ -> failwith "seekReadTypeDefOrRef ctxt"

1911
and seekReadTypeDefOrRefAsTypeRef (ctxt: ILMetadataReader)  (TaggedIndex(tag, idx) ) =
L
latkin 已提交
1912 1913 1914 1915
    match tag with 
    | tag when tag = tdor_TypeDef -> seekReadTypeDefAsTypeRef ctxt idx
    | tag when tag = tdor_TypeRef -> seekReadTypeRef ctxt idx
    | tag when tag = tdor_TypeSpec -> 
1916
        dprintn ("type spec used where a type ref or def is required")
1917
        ctxt.ilg.typ_Object.TypeRef
L
latkin 已提交
1918 1919
    | _ -> failwith "seekReadTypeDefOrRefAsTypeRef_readTypeDefOrRefOrSpec"

1920
and seekReadMethodRefParent (ctxt: ILMetadataReader)  mdv numtypars (TaggedIndex(tag, idx)) =
L
latkin 已提交
1921
    match tag with 
1922 1923
    | 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))
L
latkin 已提交
1924 1925
    | tag when tag = mrp_MethodDef -> 
        let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData ctxt idx
1926
        let mspec = mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty, minst)
1927
        mspec.DeclaringType
1928 1929
    | tag when tag = mrp_TypeSpec -> readBlobHeapAsType ctxt numtypars (seekReadTypeSpecRow ctxt mdv idx)
    | _ -> failwith "seekReadMethodRefParent"
L
latkin 已提交
1930

1931
and seekReadMethodDefOrRef (ctxt: ILMetadataReader)  numtypars (TaggedIndex(tag, idx)) =
L
latkin 已提交
1932 1933
    match tag with 
    | tag when tag = mdor_MethodDef -> 
D
Don Syme 已提交
1934 1935
        let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData ctxt idx
        VarArgMethodData(enclTyp, cc, nm, argtys, None, retty, minst)
L
latkin 已提交
1936 1937
    | tag when tag = mdor_MemberRef -> 
        seekReadMemberRefAsMethodData ctxt numtypars idx
1938
    | _ -> failwith "seekReadMethodDefOrRef"
L
latkin 已提交
1939

1940
and seekReadMethodDefOrRefNoVarargs (ctxt: ILMetadataReader)  numtypars x =
L
latkin 已提交
1941
     let (VarArgMethodData(enclTyp, cc, nm, argtys, varargs, retty, minst)) =     seekReadMethodDefOrRef ctxt numtypars x 
D
Don Syme 已提交
1942
     if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef token signature"
D
Don Syme 已提交
1943
     MethodData(enclTyp, cc, nm, argtys, retty, minst)
L
latkin 已提交
1944

1945
and seekReadCustomAttrType (ctxt: ILMetadataReader)  (TaggedIndex(tag, idx) ) =
L
latkin 已提交
1946 1947 1948
    match tag with 
    | tag when tag = cat_MethodDef -> 
        let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData ctxt idx
1949
        mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty, minst)
L
latkin 已提交
1950 1951
    | tag when tag = cat_MemberRef -> 
        let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMemberRefAsMethDataNoVarArgs ctxt 0 idx
1952
        mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty, minst)
L
latkin 已提交
1953 1954
    | _ -> failwith "seekReadCustomAttrType ctxt"
    
1955
and seekReadImplAsScopeRef (ctxt: ILMetadataReader)  mdv (TaggedIndex(tag, idx) ) =
L
latkin 已提交
1956 1957 1958
     if idx = 0 then ILScopeRef.Local
     else 
       match tag with 
1959
       | tag when tag = i_File -> ILScopeRef.Module (seekReadFile ctxt mdv idx)
L
latkin 已提交
1960
       | tag when tag = i_AssemblyRef -> ILScopeRef.Assembly (seekReadAssemblyRef ctxt idx)
1961 1962
       | tag when tag = i_ExportedType -> failwith "seekReadImplAsScopeRef"
       | _ -> failwith "seekReadImplAsScopeRef"
L
latkin 已提交
1963

1964
and seekReadTypeRefScope (ctxt: ILMetadataReader)  mdv (TaggedIndex(tag, idx) ) =
L
latkin 已提交
1965
    match tag with 
D
Don Syme 已提交
1966
    | tag when tag = rs_Module -> ILScopeRef.Local, []
1967
    | tag when tag = rs_ModuleRef -> ILScopeRef.Module (seekReadModuleRef ctxt mdv idx), []
D
Don Syme 已提交
1968
    | tag when tag = rs_AssemblyRef -> ILScopeRef.Assembly (seekReadAssemblyRef ctxt idx), []
L
latkin 已提交
1969 1970
    | tag when tag = rs_TypeRef -> 
        let tref = seekReadTypeRef ctxt idx
D
Don Syme 已提交
1971
        tref.Scope, (tref.Enclosing@[tref.Name])
1972
    | _ -> failwith "seekReadTypeRefScope"
L
latkin 已提交
1973

1974
and seekReadOptionalTypeDefOrRef (ctxt: ILMetadataReader)  numtypars boxity idx = 
L
latkin 已提交
1975
    if idx = TaggedIndex(tdor_TypeDef, 0) then None
1976
    else Some (seekReadTypeDefOrRef ctxt numtypars boxity List.empty idx)
L
latkin 已提交
1977

1978 1979
and seekReadField ctxt mdv (numtypars, hasLayout) (idx:int) =
    let (flags, nameIdx, typeIdx) = seekReadFieldRow ctxt mdv idx
D
Don Syme 已提交
1980 1981 1982 1983 1984 1985 1986 1987 1988 1989
    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 
1990
                       Some (seekReadIndexedRow (ctxt.getNumRows TableNames.FieldMarshal, seekReadFieldMarshalRow ctxt mdv, 
D
Don Syme 已提交
1991 1992 1993 1994 1995 1996 1997
                                                 fst, hfmCompare (TaggedIndex(hfm_FieldDef, idx)), 
                                                 isSorted ctxt TableNames.FieldMarshal, 
                                                 (snd >> readBlobHeapAsNativeType ctxt)))),
               data = 
                   (if (flags &&& 0x0100) = 0 then 
                       None 
                    else 
1998 1999 2000 2001 2002 2003
                        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)),
D
Don Syme 已提交
2004 2005
               offset = 
                   (if hasLayout && not isStatic then 
2006
                       Some (seekReadIndexedRow (ctxt.getNumRows TableNames.FieldLayout, seekReadFieldLayoutRow ctxt mdv, 
D
Don Syme 已提交
2007
                                               snd, simpleIndexCompare idx, isSorted ctxt TableNames.FieldLayout, fst)) else None), 
2008 2009 2010
               customAttrsStored=ctxt.customAttrsReader_FieldDef,
               metadataIndex = idx)
     
2011
and seekReadFields (ctxt: ILMetadataReader)  (numtypars, hasLayout) fidx1 fidx2 =
L
latkin 已提交
2012 2013
    mkILFieldsLazy 
       (lazy
2014
           let mdv = ctxt.mdfile.GetView()
L
latkin 已提交
2015
           [ for i = fidx1 to fidx2 - 1 do
2016
               yield seekReadField ctxt mdv (numtypars, hasLayout) i ])
L
latkin 已提交
2017

2018
and seekReadMethods (ctxt: ILMetadataReader)  numtypars midx1 midx2 =
2019
    mkILMethodsComputed (fun () -> 
2020
           let mdv = ctxt.mdfile.GetView()
2021
           [| for i = midx1 to midx2 - 1 do
2022
                 yield seekReadMethod ctxt mdv numtypars i |])
L
latkin 已提交
2023 2024 2025 2026

and sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr = 
    let n, sigptr = sigptrGetZInt32 bytes sigptr
    if (n &&& 0x01) = 0x0 then (* Type Def *)
D
Don Syme 已提交
2027
        TaggedIndex(tdor_TypeDef, (n >>>& 2)), sigptr
L
latkin 已提交
2028
    else (* Type Ref *)
D
Don Syme 已提交
2029
        TaggedIndex(tdor_TypeRef, (n >>>& 2)), sigptr         
L
latkin 已提交
2030

2031
and sigptrGetTy (ctxt: ILMetadataReader)  numtypars bytes sigptr = 
D
Don Syme 已提交
2032
    let b0, sigptr = sigptrGetByte bytes sigptr
L
latkin 已提交
2033 2034
    if b0 = et_OBJECT then ctxt.ilg.typ_Object , sigptr
    elif b0 = et_STRING then ctxt.ilg.typ_String, sigptr
2035 2036 2037 2038
    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
L
latkin 已提交
2039
    elif b0 = et_I then ctxt.ilg.typ_IntPtr, sigptr
2040 2041 2042 2043
    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
L
latkin 已提交
2044
    elif b0 = et_U then ctxt.ilg.typ_UIntPtr, sigptr
2045 2046 2047 2048
    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
L
latkin 已提交
2049
    elif b0 = et_WITH then 
D
Don Syme 已提交
2050
        let b0, sigptr = sigptrGetByte bytes sigptr
L
latkin 已提交
2051 2052
        let tdorIdx, sigptr = sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr
        let n, sigptr = sigptrGetZInt32 bytes sigptr
D
Don Syme 已提交
2053 2054
        let argtys, sigptr = sigptrFold (sigptrGetTy ctxt numtypars) n bytes sigptr
        seekReadTypeDefOrRef ctxt numtypars (if b0 = et_CLASS then AsObject else AsValue) argtys tdorIdx, 
L
latkin 已提交
2055 2056 2057 2058
        sigptr
        
    elif b0 = et_CLASS then 
        let tdorIdx, sigptr = sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr
2059
        seekReadTypeDefOrRef ctxt numtypars AsObject List.empty tdorIdx, sigptr
L
latkin 已提交
2060 2061
    elif b0 = et_VALUETYPE then 
        let tdorIdx, sigptr = sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr
2062
        seekReadTypeDefOrRef ctxt numtypars AsValue List.empty tdorIdx, sigptr
L
latkin 已提交
2063 2064
    elif b0 = et_VAR then 
        let n, sigptr = sigptrGetZInt32 bytes sigptr
D
Don Syme 已提交
2065
        ILType.TypeVar (uint16 n), sigptr
L
latkin 已提交
2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086
    elif b0 = et_MVAR then 
        let n, sigptr = sigptrGetZInt32 bytes sigptr
        ILType.TypeVar (uint16 (n + numtypars)), sigptr
    elif b0 = et_BYREF then 
        let typ, sigptr = sigptrGetTy ctxt numtypars bytes sigptr
        ILType.Byref typ, sigptr
    elif b0 = et_PTR then 
        let typ, sigptr = sigptrGetTy ctxt numtypars bytes sigptr
        ILType.Ptr typ, sigptr
    elif b0 = et_SZARRAY then 
        let typ, sigptr = sigptrGetTy ctxt numtypars bytes sigptr
        mkILArr1DTy typ, sigptr
    elif b0 = et_ARRAY then
        let typ, 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 =
D
Don Syme 已提交
2087
              (if i <  numLoBounded then Some (List.item i lobounds) else None), 
2088
              (if i <  numSized then Some (List.item i sizes) else None)
L
latkin 已提交
2089 2090 2091 2092 2093
            ILArrayShape (Array.toList (Array.init rank dim))
        mkILArrTy (typ, shape), sigptr
        
    elif b0 = et_VOID then ILType.Void, sigptr
    elif b0 = et_TYPEDBYREF then 
D
Don Syme 已提交
2094
        let t = mkILNonGenericValueTy(mkILTyRef(ctxt.ilg.primaryAssemblyScopeRef, "System.TypedReference"))
2095
        t, sigptr
L
latkin 已提交
2096 2097 2098 2099 2100
    elif b0 = et_CMOD_REQD || b0 = et_CMOD_OPT  then 
        let tdorIdx, sigptr = sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr
        let typ, sigptr = sigptrGetTy ctxt numtypars bytes sigptr
        ILType.Modified((b0 = et_CMOD_REQD), seekReadTypeDefOrRefAsTypeRef ctxt tdorIdx, typ), sigptr
    elif b0 = et_FNPTR then
D
Don Syme 已提交
2101 2102
        let ccByte, sigptr = sigptrGetByte bytes sigptr
        let generic, cc = byteAsCallConv ccByte
D
Don Syme 已提交
2103
        if generic then failwith "fptr sig may not be generic"
D
Don Syme 已提交
2104 2105 2106
        let numparams, sigptr = sigptrGetZInt32 bytes sigptr
        let retty, sigptr = sigptrGetTy ctxt numtypars bytes sigptr
        let argtys, sigptr = sigptrFold (sigptrGetTy ctxt numtypars) ( numparams) bytes sigptr
L
latkin 已提交
2107
        ILType.FunctionPointer
D
Don Syme 已提交
2108
          { CallingConv=cc
2109
            ArgTypes = argtys
L
latkin 已提交
2110
            ReturnType=retty }
D
Don Syme 已提交
2111
          , sigptr
L
latkin 已提交
2112 2113 2114
    elif b0 = et_SENTINEL then failwith "varargs NYI"
    else ILType.Void , sigptr
        
2115
and sigptrGetVarArgTys (ctxt: ILMetadataReader)  n numtypars bytes sigptr = 
L
latkin 已提交
2116 2117
    sigptrFold (sigptrGetTy ctxt numtypars) n bytes sigptr 

2118
and sigptrGetArgTys (ctxt: ILMetadataReader)  n numtypars bytes sigptr acc = 
D
Don Syme 已提交
2119
    if n <= 0 then (List.rev acc, None), sigptr 
L
latkin 已提交
2120
    else
D
Don Syme 已提交
2121
      let b0, sigptr2 = sigptrGetByte bytes sigptr
L
latkin 已提交
2122
      if b0 = et_SENTINEL then 
D
Don Syme 已提交
2123 2124
        let varargs, sigptr = sigptrGetVarArgTys ctxt n numtypars bytes sigptr2
        (List.rev acc, Some(varargs)), sigptr
L
latkin 已提交
2125
      else
D
Don Syme 已提交
2126
        let x, sigptr = sigptrGetTy ctxt numtypars bytes sigptr
L
latkin 已提交
2127 2128
        sigptrGetArgTys ctxt (n-1) numtypars bytes sigptr (x::acc)
         
2129
and sigptrGetLocal (ctxt: ILMetadataReader)  numtypars bytes sigptr = 
D
Don Syme 已提交
2130
    let pinned, sigptr = 
L
latkin 已提交
2131 2132 2133 2134 2135 2136
        let b0, sigptr' = sigptrGetByte bytes sigptr
        if b0 = et_PINNED then 
            true, sigptr'
        else 
            false, sigptr
    let typ, sigptr = sigptrGetTy ctxt numtypars bytes sigptr
D
Don Syme 已提交
2137 2138
    let loc : ILLocal = { IsPinned = pinned; Type = typ; DebugInfo = None }
    loc, sigptr
L
latkin 已提交
2139
         
2140
and readBlobHeapAsMethodSig (ctxt: ILMetadataReader)  numtypars blobIdx  =
D
Don Syme 已提交
2141
    ctxt.readBlobHeapAsMethodSig (BlobAsMethodSigIdx (numtypars, blobIdx))
L
latkin 已提交
2142

D
Don Syme 已提交
2143
and readBlobHeapAsMethodSigUncached ctxtH (BlobAsMethodSigIdx (numtypars, blobIdx)) =
2144
    let (ctxt: ILMetadataReader)  = getHole ctxtH
L
latkin 已提交
2145 2146
    let bytes = readBlobHeap ctxt blobIdx
    let sigptr = 0
D
Don Syme 已提交
2147 2148 2149 2150 2151
    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
2152
    let (argtys, varargs), _sigptr = sigptrGetArgTys ctxt numparams numtypars bytes sigptr []
D
Don Syme 已提交
2153
    generic, genarity, cc, retty, argtys, varargs
L
latkin 已提交
2154 2155 2156
      
and readBlobHeapAsType ctxt numtypars blobIdx = 
    let bytes = readBlobHeap ctxt blobIdx
D
Don Syme 已提交
2157
    let ty, _sigptr = sigptrGetTy ctxt numtypars bytes 0
L
latkin 已提交
2158 2159 2160
    ty

and readBlobHeapAsFieldSig ctxt numtypars blobIdx  =
D
Don Syme 已提交
2161
    ctxt.readBlobHeapAsFieldSig (BlobAsFieldSigIdx (numtypars, blobIdx))
L
latkin 已提交
2162

D
Don Syme 已提交
2163
and readBlobHeapAsFieldSigUncached ctxtH (BlobAsFieldSigIdx (numtypars, blobIdx)) =
L
latkin 已提交
2164 2165 2166
    let ctxt = getHole ctxtH
    let bytes = readBlobHeap ctxt blobIdx
    let sigptr = 0
D
Don Syme 已提交
2167
    let ccByte, sigptr = sigptrGetByte bytes sigptr
D
Don Syme 已提交
2168
    if ccByte <> e_IMAGE_CEE_CS_CALLCONV_FIELD then dprintn "warning: field sig was not CC_FIELD"
D
Don Syme 已提交
2169
    let retty, _sigptr = sigptrGetTy ctxt numtypars bytes sigptr
L
latkin 已提交
2170 2171 2172
    retty

      
2173
and readBlobHeapAsPropertySig (ctxt: ILMetadataReader)  numtypars blobIdx  =
D
Don Syme 已提交
2174
    ctxt.readBlobHeapAsPropertySig (BlobAsPropSigIdx (numtypars, blobIdx))
2175

D
Don Syme 已提交
2176
and readBlobHeapAsPropertySigUncached ctxtH (BlobAsPropSigIdx (numtypars, blobIdx))  =
L
latkin 已提交
2177 2178 2179
    let ctxt = getHole ctxtH
    let bytes = readBlobHeap ctxt blobIdx
    let sigptr = 0
D
Don Syme 已提交
2180
    let ccByte, sigptr = sigptrGetByte bytes sigptr
L
latkin 已提交
2181 2182
    let hasthis = byteAsHasThis ccByte
    let ccMaxked = (ccByte &&& 0x0Fuy)
D
Don Syme 已提交
2183
    if ccMaxked <> e_IMAGE_CEE_CS_CALLCONV_PROPERTY then dprintn ("warning: property sig was "+string ccMaxked+" instead of CC_PROPERTY")
D
Don Syme 已提交
2184 2185 2186 2187
    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
L
latkin 已提交
2188
      
2189
and readBlobHeapAsLocalsSig (ctxt: ILMetadataReader)  numtypars blobIdx  =
D
Don Syme 已提交
2190
    ctxt.readBlobHeapAsLocalsSig (BlobAsLocalSigIdx (numtypars, blobIdx))
L
latkin 已提交
2191

D
Don Syme 已提交
2192
and readBlobHeapAsLocalsSigUncached ctxtH (BlobAsLocalSigIdx (numtypars, blobIdx)) =
L
latkin 已提交
2193 2194 2195
    let ctxt = getHole ctxtH
    let bytes = readBlobHeap ctxt blobIdx
    let sigptr = 0
D
Don Syme 已提交
2196
    let ccByte, sigptr = sigptrGetByte bytes sigptr
D
Don Syme 已提交
2197
    if ccByte <> e_IMAGE_CEE_CS_CALLCONV_LOCAL_SIG then dprintn "warning: local sig was not CC_LOCAL"
D
Don Syme 已提交
2198 2199
    let numlocals, sigptr = sigptrGetZInt32 bytes sigptr
    let localtys, _sigptr = sigptrFold (sigptrGetLocal ctxt numtypars) ( numlocals) bytes sigptr
L
latkin 已提交
2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217
    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
D
Don Syme 已提交
2218
    generic, Callconv (byteAsHasThis b, cc) 
L
latkin 已提交
2219 2220
      
and seekReadMemberRefAsMethodData ctxt numtypars idx : VarArgMethodData = 
D
Don Syme 已提交
2221
    ctxt.seekReadMemberRefAsMethodData (MemberRefAsMspecIdx (numtypars, idx))
2222

D
Don Syme 已提交
2223
and seekReadMemberRefAsMethodDataUncached ctxtH (MemberRefAsMspecIdx (numtypars, idx)) = 
2224 2225 2226
    let (ctxt: ILMetadataReader)  = getHole ctxtH
    let mdv = ctxt.mdfile.GetView()
    let (mrpIdx, nameIdx, typeIdx) = seekReadMemberRefRow ctxt mdv idx
L
latkin 已提交
2227
    let nm = readStringHeap ctxt nameIdx
2228
    let enclTyp = seekReadMethodRefParent ctxt mdv numtypars mrpIdx
D
Don Syme 已提交
2229
    let _generic, genarity, cc, retty, argtys, varargs = readBlobHeapAsMethodSig ctxt enclTyp.GenericArgs.Length typeIdx
2230
    let minst =  List.init genarity (fun n -> mkILTyvarTy (uint16 (numtypars+n))) 
D
Don Syme 已提交
2231
    (VarArgMethodData(enclTyp, cc, nm, argtys, varargs, retty, minst))
L
latkin 已提交
2232 2233

and seekReadMemberRefAsMethDataNoVarArgs ctxt numtypars idx : MethodData =
D
Don Syme 已提交
2234
   let (VarArgMethodData(enclTyp, cc, nm, argtys, varargs, retty, minst)) =  seekReadMemberRefAsMethodData ctxt numtypars idx
2235
   if Option.isSome varargs then dprintf "ignoring sentinel and varargs in ILMethodDef token signature"
D
Don Syme 已提交
2236
   (MethodData(enclTyp, cc, nm, argtys, retty, minst))
L
latkin 已提交
2237

2238
and seekReadMethodSpecAsMethodData (ctxt: ILMetadataReader) numtypars idx =  
D
Don Syme 已提交
2239
    ctxt.seekReadMethodSpecAsMethodData (MethodSpecAsMspecIdx (numtypars, idx))
2240

D
Don Syme 已提交
2241
and seekReadMethodSpecAsMethodDataUncached ctxtH (MethodSpecAsMspecIdx (numtypars, idx)) = 
2242 2243 2244
    let (ctxt: ILMetadataReader)  = getHole ctxtH
    let mdv = ctxt.mdfile.GetView()
    let (mdorIdx, instIdx) = seekReadMethodSpecRow ctxt mdv idx
D
Don Syme 已提交
2245
    let (VarArgMethodData(enclTyp, cc, nm, argtys, varargs, retty, _)) = seekReadMethodDefOrRef ctxt numtypars mdorIdx
L
latkin 已提交
2246 2247 2248
    let minst = 
        let bytes = readBlobHeap ctxt instIdx
        let sigptr = 0
D
Don Syme 已提交
2249
        let ccByte, sigptr = sigptrGetByte bytes sigptr
D
Don Syme 已提交
2250
        if ccByte <> e_IMAGE_CEE_CS_CALLCONV_GENERICINST then dprintn ("warning: method inst ILCallingConv was "+string ccByte+" instead of CC_GENERICINST")
D
Don Syme 已提交
2251 2252
        let numgpars, sigptr = sigptrGetZInt32 bytes sigptr
        let argtys, _sigptr = sigptrFold (sigptrGetTy ctxt numtypars) numgpars bytes sigptr
2253
        argtys
D
Don Syme 已提交
2254
    VarArgMethodData(enclTyp, cc, nm, argtys, varargs, retty, minst)
L
latkin 已提交
2255

2256
and seekReadMemberRefAsFieldSpec (ctxt: ILMetadataReader)  numtypars idx = 
D
Don Syme 已提交
2257
   ctxt.seekReadMemberRefAsFieldSpec (MemberRefAsFspecIdx (numtypars, idx))
2258

D
Don Syme 已提交
2259
and seekReadMemberRefAsFieldSpecUncached ctxtH (MemberRefAsFspecIdx (numtypars, idx)) = 
2260 2261 2262
   let (ctxt: ILMetadataReader)  = getHole ctxtH
   let mdv = ctxt.mdfile.GetView()
   let (mrpIdx, nameIdx, typeIdx) = seekReadMemberRefRow ctxt mdv idx
L
latkin 已提交
2263
   let nm = readStringHeap ctxt nameIdx
2264
   let enclTyp = seekReadMethodRefParent ctxt mdv numtypars mrpIdx
L
latkin 已提交
2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275
   let retty = readBlobHeapAsFieldSig ctxt numtypars typeIdx
   mkILFieldSpecInTy(enclTyp, 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
2276

L
latkin 已提交
2277
and seekReadMethodDefAsMethodDataUncached ctxtH idx =
2278 2279
   let (ctxt: ILMetadataReader)  = getHole ctxtH
   let mdv = ctxt.mdfile.GetView()
L
latkin 已提交
2280 2281
   // Look for the method def parent. 
   let tidx = 
D
Don Syme 已提交
2282 2283 2284 2285
     seekReadIndexedRow (ctxt.getNumRows TableNames.TypeDef, 
                            (fun i -> i, seekReadTypeDefRowWithExtents ctxt i), 
                            (fun r -> r), 
                            (fun (_, ((_, _, _, _, _, methodsIdx), 
L
latkin 已提交
2286 2287 2288
                                      (_, endMethodsIdx)))  -> 
                                        if endMethodsIdx <= idx then 1 
                                        elif methodsIdx <= idx && idx < endMethodsIdx then 0 
D
Don Syme 已提交
2289 2290
                                        else -1), 
                            true, fst)
2291 2292 2293 2294 2295 2296 2297 2298
   // 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
2299

L
latkin 已提交
2300 2301
   // Read the method def parent. 
   let enclTyp = seekReadTypeDefAsType ctxt AsObject (* not ok: see note *) finst tidx
2302

2303 2304
   // 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
2305 2306 2307
   let nm = readStringHeap ctxt nameIdx

   // Read the method def signature. 
D
Don Syme 已提交
2308
   let _generic, _genarity, cc, retty, argtys, varargs = readBlobHeapAsMethodSig ctxt typeGenericArgsCount typeIdx
2309 2310
   if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef token signature"

L
latkin 已提交
2311 2312 2313
   MethodData(enclTyp, cc, nm, argtys, retty, minst)


2314
and seekReadFieldDefAsFieldSpec (ctxt: ILMetadataReader)  idx =
L
latkin 已提交
2315
   ctxt.seekReadFieldDefAsFieldSpec idx
2316

L
latkin 已提交
2317
and seekReadFieldDefAsFieldSpecUncached ctxtH idx =
2318 2319 2320
   let (ctxt: ILMetadataReader)  = getHole ctxtH
   let mdv = ctxt.mdfile.GetView()
   let (_flags, nameIdx, typeIdx) = seekReadFieldRow ctxt mdv idx
L
latkin 已提交
2321 2322 2323
   let nm = readStringHeap ctxt nameIdx
   (* Look for the field def parent. *)
   let tidx = 
D
Don Syme 已提交
2324 2325 2326 2327
     seekReadIndexedRow (ctxt.getNumRows TableNames.TypeDef, 
                            (fun i -> i, seekReadTypeDefRowWithExtents ctxt i), 
                            (fun r -> r), 
                            (fun (_, ((_, _, _, _, fieldsIdx, _), (endFieldsIdx, _)))  -> 
L
latkin 已提交
2328 2329
                                if endFieldsIdx <= idx then 1 
                                elif fieldsIdx <= idx && idx < endFieldsIdx then 0 
D
Don Syme 已提交
2330 2331
                                else -1), 
                            true, fst)
L
latkin 已提交
2332 2333
   // Read the field signature. 
   let retty = readBlobHeapAsFieldSig ctxt 0 typeIdx
2334

L
latkin 已提交
2335
   // Create a formal instantiation if needed 
D
Don Syme 已提交
2336
   let finst = mkILFormalGenericArgs 0 (seekReadGenericParams ctxt 0 (tomd_TypeDef, tidx))
2337

L
latkin 已提交
2338 2339
   // Read the field def parent. 
   let enclTyp = seekReadTypeDefAsType ctxt AsObject (* not ok: see note *) finst tidx
2340

L
latkin 已提交
2341 2342 2343
   // Put it together. 
   mkILFieldSpecInTy(enclTyp, nm, retty)

2344 2345
and seekReadMethod (ctxt: ILMetadataReader)  mdv numtypars (idx:int) =
     let (codeRVA, implflags, flags, nameIdx, typeIdx, paramIdx) = seekReadMethodRow ctxt mdv idx
L
latkin 已提交
2346 2347 2348 2349 2350 2351 2352
     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
2353
     let aggressiveinline = (implflags &&& 0x0100) <> 0x0
D
Don Syme 已提交
2354
     let _generic, _genarity, cc, retty, argtys, varargs = readBlobHeapAsMethodSig ctxt numtypars typeIdx
D
Don Syme 已提交
2355
     if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef signature"
L
latkin 已提交
2356 2357 2358 2359 2360
     
     let endParamIdx =
       if idx >= ctxt.getNumRows TableNames.Method then 
         ctxt.getNumRows TableNames.Param + 1
       else
2361
         let (_, _, _, _, _, paramIdx) = seekReadMethodRow ctxt mdv (idx + 1)
L
latkin 已提交
2362 2363
         paramIdx
     
2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380
     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
L
latkin 已提交
2381

D
Don Syme 已提交
2382 2383 2384
     ILMethodDef(name=nm,
                 attributes = enum<MethodAttributes>(flags),
                 implAttributes= enum<MethodImplAttributes>(implflags),
2385
                 securityDeclsStored=ctxt.securityDeclsReader_MethodDef,
2386
                 isEntryPoint=isEntryPoint,
D
Don Syme 已提交
2387 2388 2389 2390
                 genericParams=seekReadGenericParams ctxt numtypars (tomd_MethodDef, idx),
                 parameters= ilParams,
                 callingConv=cc,
                 ret=ret,
2391 2392 2393
                 body=body,
                 customAttrsStored=ctxt.customAttrsReader_MethodDef,
                 metadataIndex=idx)
L
latkin 已提交
2394 2395
     
     
2396
and seekReadParams (ctxt: ILMetadataReader)  mdv (retty, argtys) pidx1 pidx2 =
2397 2398
    let retRes = ref (mkILReturn retty)
    let paramsRes = argtys |> List.toArray |> Array.map mkILParamAnon
L
latkin 已提交
2399
    for i = pidx1 to pidx2 - 1 do
2400
        seekReadParamExtras ctxt mdv (retRes, paramsRes) i
2401
    !retRes, List.ofArray paramsRes
L
latkin 已提交
2402

2403 2404
and seekReadParamExtras (ctxt: ILMetadataReader)  mdv (retRes, paramsRes) (idx:int) =
   let (flags, seq, nameIdx) = seekReadParamRow ctxt mdv idx
L
latkin 已提交
2405 2406 2407
   let inOutMasked = (flags &&& 0x00FF)
   let hasMarshal = (flags &&& 0x2000) <> 0x0
   let hasDefault = (flags &&& 0x1000) <> 0x0
2408
   let fmReader idx = seekReadIndexedRow (ctxt.getNumRows TableNames.FieldMarshal, seekReadFieldMarshalRow ctxt mdv, fst, hfmCompare idx, isSorted ctxt TableNames.FieldMarshal, (snd >> readBlobHeapAsNativeType ctxt))
L
latkin 已提交
2409 2410
   if seq = 0 then
       retRes := { !retRes with 
D
Don Syme 已提交
2411
                        Marshal=(if hasMarshal then Some (fmReader (TaggedIndex(hfm_ParamDef, idx))) else None)
2412 2413
                        CustomAttrsStored = ctxt.customAttrsReader_ParamDef
                        MetadataIndex = idx}
L
latkin 已提交
2414 2415 2416 2417
   elif seq > Array.length paramsRes then dprintn "bad seq num. for param"
   else 
       paramsRes.[seq - 1] <- 
          { paramsRes.[seq - 1] with 
D
Don Syme 已提交
2418 2419
               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)
D
Don Syme 已提交
2420 2421 2422 2423
               Name = readStringHeapOption ctxt nameIdx
               IsIn = ((inOutMasked &&& 0x0001) <> 0x0)
               IsOut = ((inOutMasked &&& 0x0002) <> 0x0)
               IsOptional = ((inOutMasked &&& 0x0010) <> 0x0)
2424 2425
               CustomAttrsStored = ctxt.customAttrsReader_ParamDef
               MetadataIndex = idx }
L
latkin 已提交
2426
          
2427
and seekReadMethodImpls (ctxt: ILMetadataReader)  numtypars tidx =
L
latkin 已提交
2428 2429
   mkILMethodImplsLazy 
      (lazy 
2430 2431
          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))
D
Don Syme 已提交
2432
          mimpls |> List.map (fun (b, c) -> 
L
latkin 已提交
2433
              { OverrideBy=
D
Don Syme 已提交
2434 2435
                  let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefOrRefNoVarargs ctxt numtypars b
                  mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty, minst)
L
latkin 已提交
2436
                Overrides=
D
Don Syme 已提交
2437 2438
                  let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefOrRefNoVarargs ctxt numtypars c
                  let mspec = mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty, minst)
2439
                  OverridesSpec(mspec.MethodRef, mspec.DeclaringType) }))
L
latkin 已提交
2440

2441
and seekReadMultipleMethodSemantics (ctxt: ILMetadataReader)  (flags, id) =
L
latkin 已提交
2442
    seekReadIndexedRows 
D
Don Syme 已提交
2443 2444 2445 2446 2447 2448
      (ctxt.getNumRows TableNames.MethodSemantics , 
       seekReadMethodSemanticsRow ctxt, 
       (fun (_flags, _, c) -> c), 
       hsCompare id, 
       isSorted ctxt TableNames.MethodSemantics, 
       (fun (a, b, _c) -> 
L
latkin 已提交
2449
           let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData ctxt b
2450
           a, (mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty, minst)).MethodRef))
D
Don Syme 已提交
2451
    |> List.filter (fun (flags2, _) -> flags = flags2) 
L
latkin 已提交
2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465
    |> 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

2466 2467
and seekReadEvent ctxt mdv numtypars idx =
   let (flags, nameIdx, typIdx) = seekReadEventRow ctxt mdv idx
D
Don Syme 已提交
2468 2469 2470 2471 2472 2473 2474
   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)),
2475 2476
              customAttrsStored=ctxt.customAttrsReader_Event,
              metadataIndex = idx )
L
latkin 已提交
2477
   
2478 2479
  (* 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 =
L
latkin 已提交
2480 2481
   mkILEventsLazy 
      (lazy 
2482 2483
           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 
L
latkin 已提交
2484
           | None -> []
D
Don Syme 已提交
2485
           | Some (rowNum, beginEventIdx) ->
L
latkin 已提交
2486 2487 2488 2489
               let endEventIdx =
                   if rowNum >= ctxt.getNumRows TableNames.EventMap then 
                       ctxt.getNumRows TableNames.Event + 1
                   else
2490
                       let (_, endEventIdx) = seekReadEventMapRow ctxt mdv (rowNum + 1)
L
latkin 已提交
2491 2492 2493
                       endEventIdx

               [ for i in beginEventIdx .. endEventIdx - 1 do
2494
                   yield seekReadEvent ctxt mdv numtypars i ])
L
latkin 已提交
2495

2496 2497
and seekReadProperty ctxt mdv numtypars idx =
   let (flags, nameIdx, typIdx) = seekReadPropertyRow ctxt mdv idx
D
Don Syme 已提交
2498 2499 2500
   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))
L
latkin 已提交
2501 2502 2503 2504 2505 2506 2507 2508 2509
(* 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
2510

D
Don Syme 已提交
2511 2512 2513 2514 2515 2516 2517 2518
   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,
2519 2520
                 customAttrsStored=ctxt.customAttrsReader_Property,
                 metadataIndex = idx )
L
latkin 已提交
2521
   
2522
and seekReadProperties (ctxt: ILMetadataReader)  numtypars tidx =
L
latkin 已提交
2523 2524
   mkILPropertiesLazy
      (lazy 
2525 2526
           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 
L
latkin 已提交
2527
           | None -> []
D
Don Syme 已提交
2528
           | Some (rowNum, beginPropIdx) ->
L
latkin 已提交
2529 2530 2531 2532
               let endPropIdx =
                   if rowNum >= ctxt.getNumRows TableNames.PropertyMap then 
                       ctxt.getNumRows TableNames.Property + 1
                   else
2533
                       let (_, endPropIdx) = seekReadPropertyMapRow ctxt mdv (rowNum + 1)
L
latkin 已提交
2534 2535
                       endPropIdx
               [ for i in beginPropIdx .. endPropIdx - 1 do
2536
                   yield seekReadProperty ctxt mdv numtypars i ])
L
latkin 已提交
2537 2538


2539 2540 2541 2542
and customAttrsReader ctxtH tag : ILAttributesStored = 
    mkILCustomAttrsReader
      (fun idx -> 
          let (ctxt: ILMetadataReader) = getHole ctxtH
D
Don Syme 已提交
2543 2544
          seekReadIndexedRows (ctxt.getNumRows TableNames.CustomAttribute, 
                                  seekReadCustomAttributeRow ctxt, (fun (a, _, _) -> a), 
2545
                                  hcaCompare (TaggedIndex(tag,idx)), 
D
Don Syme 已提交
2546 2547
                                  isSorted ctxt TableNames.CustomAttribute, 
                                  (fun (_, b, c) -> seekReadCustomAttr ctxt (b, c)))
2548
          |> List.toArray)
L
latkin 已提交
2549

D
Don Syme 已提交
2550 2551
and seekReadCustomAttr ctxt (TaggedIndex(cat, idx), b) = 
    ctxt.seekReadCustomAttr (CustomAttrIdx (cat, idx, b))
L
latkin 已提交
2552

D
Don Syme 已提交
2553
and seekReadCustomAttrUncached ctxtH (CustomAttrIdx (cat, idx, valIdx)) = 
L
latkin 已提交
2554
    let ctxt = getHole ctxtH
D
Don Syme 已提交
2555
    { Method=seekReadCustomAttrType ctxt (TaggedIndex(cat, idx))
L
latkin 已提交
2556 2557 2558
      Data=
        match readBlobHeapOption ctxt valIdx with
        | Some bytes -> bytes
2559 2560
        | None -> Bytes.ofInt32Array [| |] 
      Elements = [] }
L
latkin 已提交
2561

2562 2563 2564 2565
and securityDeclsReader ctxtH tag = 
    mkILSecurityDeclsReader
      (fun idx -> 
         let (ctxt: ILMetadataReader) = getHole ctxtH
2566
         let mdv = ctxt.mdfile.GetView()
D
Don Syme 已提交
2567
         seekReadIndexedRows (ctxt.getNumRows TableNames.Permission, 
2568
                                 seekReadPermissionRow ctxt mdv, 
D
Don Syme 已提交
2569
                                 (fun (_, par, _) -> par), 
2570
                                 hdsCompare (TaggedIndex(tag,idx)), 
D
Don Syme 已提交
2571
                                 isSorted ctxt TableNames.Permission, 
2572 2573
                                 (fun (act, _, ty) -> seekReadSecurityDecl ctxt (act, ty)))
          |> List.toArray)
L
latkin 已提交
2574

2575
and seekReadSecurityDecl ctxt (act, ty) = 
D
Don Syme 已提交
2576
    ILSecurityDecl ((if List.memAssoc (int act) (Lazy.force ILSecurityActionRevMap) then List.assoc (int act) (Lazy.force ILSecurityActionRevMap) else failwith "unknown security action"), 
2577
                    readBlobHeap ctxt ty)
L
latkin 已提交
2578

2579
and seekReadConstant (ctxt: ILMetadataReader)  idx =
D
Don Syme 已提交
2580 2581 2582 2583
  let kind, vidx = seekReadIndexedRow (ctxt.getNumRows TableNames.Constant, 
                                      seekReadConstantRow ctxt, 
                                      (fun (_, key, _) -> key), 
                                      hcCompare idx, isSorted ctxt TableNames.Constant, (fun (kind, _, v) -> kind, v))
L
latkin 已提交
2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603
  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

2604
and seekReadImplMap (ctxt: ILMetadataReader)  nm midx = 
L
latkin 已提交
2605 2606
   mkMethBodyLazyAux 
      (lazy 
2607
            let mdv = ctxt.mdfile.GetView()
D
Don Syme 已提交
2608
            let (flags, nameIdx, scopeIdx) = seekReadIndexedRow (ctxt.getNumRows TableNames.ImplMap, 
2609
                                                                seekReadImplMapRow ctxt mdv, 
D
Don Syme 已提交
2610 2611 2612 2613
                                                                (fun (_, m, _, _) -> m), 
                                                                mfCompare (TaggedIndex(mf_MethodDef, midx)), 
                                                                isSorted ctxt TableNames.ImplMap, 
                                                                (fun (a, _, c, d) -> a, c, d))
L
latkin 已提交
2614 2615 2616 2617 2618 2619 2620 2621 2622
            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)
2623

L
latkin 已提交
2624 2625 2626 2627 2628 2629 2630
            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)
2631

L
latkin 已提交
2632 2633 2634 2635 2636 2637
            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)
2638

L
latkin 已提交
2639 2640 2641 2642 2643 2644 2645
            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)

D
Don Syme 已提交
2646 2647 2648 2649 2650 2651
            MethodBody.PInvoke { CallingConv = cc 
                                 CharEncoding = enc
                                 CharBestFit=bestfit
                                 ThrowOnUnmappableChar=unmap
                                 NoMangle = (flags &&& 0x0001) <> 0x0
                                 LastError = (flags &&& 0x0040) <> 0x0
L
latkin 已提交
2652 2653 2654
                                 Name = 
                                     (match readStringHeapOption ctxt nameIdx with 
                                      | None -> nm
D
Don Syme 已提交
2655
                                      | Some nm2 -> nm2)
2656
                                 Where = seekReadModuleRef ctxt mdv scopeIdx })
L
latkin 已提交
2657

2658
and seekReadTopCode (ctxt: ILMetadataReader)  pev mdv numtypars (sz:int) start seqpoints = 
D
Don Syme 已提交
2659 2660
   let labelsOfRawOffsets = new Dictionary<_, _>(sz/2)
   let ilOffsetsOfLabels = new Dictionary<_, _>(sz/2)
2661 2662 2663 2664
   let tryRawToLabel rawOffset =
       match labelsOfRawOffsets.TryGetValue(rawOffset) with
       | true, v -> Some v
       | _ -> None
L
latkin 已提交
2665 2666 2667 2668 2669 2670

   let rawToLabel rawOffset = 
       match tryRawToLabel rawOffset with 
       | Some l -> l
       | None -> 
           let lab = generateCodeLabel()
D
Don Syme 已提交
2671
           labelsOfRawOffsets.[rawOffset] <- lab
L
latkin 已提交
2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684
           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 () = 
2685
       lastb := seekReadByteAsInt32 pev (start + (!curr))
D
Don Syme 已提交
2686
       incr curr
L
latkin 已提交
2687 2688
       b := 
         if !lastb = 0xfe && !curr < sz then 
2689
           lastb2 := seekReadByteAsInt32 pev (start + (!curr))
D
Don Syme 已提交
2690
           incr curr
L
latkin 已提交
2691 2692 2693 2694 2695 2696 2697 2698
           !lastb2
         else 
           !lastb

   let seqPointsRemaining = ref seqpoints

   while !curr < sz do
     // registering "+string !curr+" as start of an instruction")
D
Don Syme 已提交
2699
     markAsInstructionStart !curr ibuf.Count
L
latkin 已提交
2700 2701 2702 2703

     // Insert any sequence points into the instruction sequence 
     while 
         (match !seqPointsRemaining with 
D
Don Syme 已提交
2704
          |  (i, _tag) :: _rest when i <= !curr -> true
L
latkin 已提交
2705 2706 2707
          | _ -> false) 
        do
         // Emitting one sequence point 
D
Don Syme 已提交
2708
         let (_, tag) = List.head !seqPointsRemaining
D
Don Syme 已提交
2709
         seqPointsRemaining := List.tail !seqPointsRemaining
L
latkin 已提交
2710 2711 2712 2713
         ibuf.Add (I_seqpoint tag)

     // Read the prefixes.  Leave lastb and lastb2 holding the instruction byte(s) 
     begin 
D
Don Syme 已提交
2714 2715 2716 2717 2718 2719
       prefixes.al <- Aligned
       prefixes.tl <- Normalcall
       prefixes.vol <- Nonvolatile
       prefixes.ro<-NormalAddress
       prefixes.constrained<-None
       get ()
L
latkin 已提交
2720 2721 2722 2723 2724 2725 2726
       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
D
Don Syme 已提交
2727
         begin
L
latkin 已提交
2728
             if !b = (i_unaligned &&& 0xff) then
2729
               let unal = seekReadByteAsInt32 pev (start + (!curr))
D
Don Syme 已提交
2730
               incr curr
L
latkin 已提交
2731 2732 2733 2734 2735 2736 2737 2738
               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 
2739
                 let uncoded = seekReadUncodedToken pev (start + (!curr))
D
Don Syme 已提交
2740
                 curr := !curr + 4
2741
                 let typ = seekReadTypeDefOrRef ctxt numtypars AsObject [] (uncodedTokenToTypeDefOrRefOrSpec uncoded)
L
latkin 已提交
2742
                 prefixes.constrained <- Some typ
D
Don Syme 已提交
2743
             else prefixes.tl <- Tailcall
D
Don Syme 已提交
2744
         end
D
Don Syme 已提交
2745 2746
         get ()
     end
L
latkin 已提交
2747 2748

     // data for instruction begins at "+string !curr
D
Don Syme 已提交
2749
     // Read and decode the instruction 
L
latkin 已提交
2750 2751 2752 2753 2754 2755 2756
     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 -> 
2757
             let x = seekReadByte pev (start + (!curr)) |> uint16
D
Don Syme 已提交
2758
             curr := !curr + 1
L
latkin 已提交
2759 2760
             f prefixes x
         | I_u16_u16_instr f -> 
2761
             let x = seekReadUInt16 pev (start + (!curr))
D
Don Syme 已提交
2762
             curr := !curr + 2
L
latkin 已提交
2763 2764 2765 2766
             f prefixes x
         | I_none_instr f -> 
             f prefixes 
         | I_i64_instr f ->
2767
             let x = seekReadInt64 pev (start + (!curr))
D
Don Syme 已提交
2768
             curr := !curr + 8
L
latkin 已提交
2769 2770
             f prefixes x
         | I_i32_i8_instr f ->
2771
             let x = seekReadSByte pev (start + (!curr)) |> int32
D
Don Syme 已提交
2772
             curr := !curr + 1
L
latkin 已提交
2773 2774
             f prefixes x
         | I_i32_i32_instr f ->
2775
             let x = seekReadInt32 pev (start + (!curr))
D
Don Syme 已提交
2776
             curr := !curr + 4
L
latkin 已提交
2777 2778
             f prefixes x
         | I_r4_instr f ->
2779
             let x = seekReadSingle pev (start + (!curr))
D
Don Syme 已提交
2780
             curr := !curr + 4
L
latkin 已提交
2781 2782
             f prefixes x
         | I_r8_instr f ->
2783
             let x = seekReadDouble pev (start + (!curr))
D
Don Syme 已提交
2784
             curr := !curr + 8
L
latkin 已提交
2785 2786
             f prefixes x
         | I_field_instr f ->
2787
             let (tab, tok) = seekReadUncodedToken pev (start + (!curr))
D
Don Syme 已提交
2788
             curr := !curr + 4
L
latkin 已提交
2789 2790 2791 2792 2793 2794 2795 2796 2797 2798
             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
       
2799
             let (tab, idx) = seekReadUncodedToken pev (start + (!curr))
D
Don Syme 已提交
2800
             curr := !curr + 4
L
latkin 已提交
2801 2802 2803 2804 2805 2806 2807 2808 2809
             let  (VarArgMethodData(enclTyp, 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 enclTyp with
D
Don Syme 已提交
2810
             | ILType.Array (shape, ty) ->
L
latkin 已提交
2811
               match nm with
D
Don Syme 已提交
2812 2813 2814 2815
               | "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)
L
latkin 已提交
2816 2817
               | _ -> failwith "bad method on array type"
             | _ ->
2818
               let mspec = mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty, minst)
D
Don Syme 已提交
2819
               f prefixes (mspec, varargs)
L
latkin 已提交
2820
         | I_type_instr f ->
2821
             let uncoded = seekReadUncodedToken pev (start + (!curr))
D
Don Syme 已提交
2822
             curr := !curr + 4
2823
             let typ = seekReadTypeDefOrRef ctxt numtypars AsObject [] (uncodedTokenToTypeDefOrRefOrSpec uncoded)
L
latkin 已提交
2824 2825
             f prefixes typ
         | I_string_instr f ->
2826
             let (tab, idx) = seekReadUncodedToken pev (start + (!curr))
D
Don Syme 已提交
2827 2828
             curr := !curr + 4
             if tab <> TableNames.UserStrings then dprintn "warning: bad table in user string for ldstr"
L
latkin 已提交
2829 2830 2831
             f prefixes (readUserStringHeap ctxt (idx))

         | I_conditional_i32_instr f ->
2832
             let offsDest =  (seekReadInt32 pev (start + (!curr)))
D
Don Syme 已提交
2833
             curr := !curr + 4
L
latkin 已提交
2834
             let dest = !curr + offsDest
D
Don Syme 已提交
2835
             f prefixes (rawToLabel dest)
L
latkin 已提交
2836
         | I_conditional_i8_instr f ->
2837
             let offsDest = int (seekReadSByte pev (start + (!curr)))
D
Don Syme 已提交
2838
             curr := !curr + 1
L
latkin 已提交
2839
             let dest = !curr + offsDest
D
Don Syme 已提交
2840
             f prefixes (rawToLabel dest)
L
latkin 已提交
2841
         | I_unconditional_i32_instr f ->
2842
             let offsDest =  (seekReadInt32 pev (start + (!curr)))
D
Don Syme 已提交
2843
             curr := !curr + 4
L
latkin 已提交
2844 2845 2846
             let dest = !curr + offsDest
             f prefixes (rawToLabel dest)
         | I_unconditional_i8_instr f ->
2847
             let offsDest = int (seekReadSByte pev (start + (!curr)))
D
Don Syme 已提交
2848
             curr := !curr + 1
L
latkin 已提交
2849 2850
             let dest = !curr + offsDest
             f prefixes (rawToLabel dest)
D
Don Syme 已提交
2851
         | I_invalid_instr -> 
D
Don Syme 已提交
2852
             dprintn ("invalid instruction: "+string !lastb+ (if !lastb = 0xfe then ", "+string !lastb2 else "")) 
D
Don Syme 已提交
2853
             I_ret
L
latkin 已提交
2854
         | I_tok_instr f ->  
2855
             let (tab, idx) = seekReadUncodedToken pev (start + (!curr))
D
Don Syme 已提交
2856
             curr := !curr + 4
L
latkin 已提交
2857 2858 2859
             (* 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 
D
Don Syme 已提交
2860
                 let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefOrRefNoVarargs ctxt numtypars (uncodedTokenToMethodDefOrRef (tab, idx))
2861
                 ILToken.ILMethod (mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty, minst))
L
latkin 已提交
2862 2863 2864
               elif tab = TableNames.Field then 
                 ILToken.ILField (seekReadFieldDefAsFieldSpec ctxt idx)
               elif tab = TableNames.TypeDef || tab = TableNames.TypeRef || tab = TableNames.TypeSpec  then 
D
Don Syme 已提交
2865
                 ILToken.ILType (seekReadTypeDefOrRef ctxt numtypars AsObject [] (uncodedTokenToTypeDefOrRefOrSpec (tab, idx))) 
L
latkin 已提交
2866 2867 2868
               else failwith "bad token for ldtoken" 
             f prefixes token_info
         | I_sig_instr f ->  
2869
             let (tab, idx) = seekReadUncodedToken pev (start + (!curr))
D
Don Syme 已提交
2870 2871
             curr := !curr + 4
             if tab <> TableNames.StandAloneSig then dprintn "strange table for callsig token"
2872 2873
             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"
D
Don Syme 已提交
2874
             f prefixes (mkILCallSig (cc, argtys, retty), varargs)
L
latkin 已提交
2875
         | I_switch_instr f ->  
2876
             let n =  (seekReadInt32 pev (start + (!curr)))
D
Don Syme 已提交
2877
             curr := !curr + 4
L
latkin 已提交
2878 2879
             let offsets = 
               List.init n (fun _ -> 
2880
                   let i =  (seekReadInt32 pev (start + (!curr)))
D
Don Syme 已提交
2881
                   curr := !curr + 4 
L
latkin 已提交
2882 2883
                   i) 
             let dests = List.map (fun offs -> rawToLabel (!curr + offs)) offsets
D
Don Syme 已提交
2884
             f prefixes dests
L
latkin 已提交
2885
       ibuf.Add instr
D
Don Syme 已提交
2886
   done
L
latkin 已提交
2887
   // Finished reading instructions - mark the end of the instruction stream in case the PDB information refers to it. 
D
Don Syme 已提交
2888
   markAsInstructionStart !curr ibuf.Count
L
latkin 已提交
2889
   // Build the function that maps from raw labels (offsets into the bytecode stream) to indexes in the AbsIL instruction stream 
D
Don Syme 已提交
2890
   let lab2pc = ilOffsetsOfLabels
L
latkin 已提交
2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904

   // 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()
D
Don Syme 已提交
2905
   instrs, rawToLabel, lab2pc, raw2nextLab
L
latkin 已提交
2906

2907
#if FX_NO_PDB_READER
2908
and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (_idx, nm, _internalcall, noinline, aggressiveinline, numtypars) rva = 
L
latkin 已提交
2909
#else
2910
and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (idx, nm, _internalcall, noinline, aggressiveinline, numtypars) rva = 
L
latkin 已提交
2911 2912 2913
#endif
  mkMethBodyLazyAux 
   (lazy
2914 2915
       let pev = pectxt.pefile.GetView()
       let mdv = ctxt.mdfile.GetView()
L
latkin 已提交
2916 2917 2918 2919 2920 2921

       // 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 = 
2922
#if FX_NO_PDB_READER
L
latkin 已提交
2923 2924
           [], None, []
#else
2925
           match pectxt.pdb with 
L
latkin 已提交
2926 2927 2928 2929 2930 2931 2932
           | None -> 
               [], None, []
           | Some (pdbr, get_doc) -> 
               try 

                 let pdbm = pdbReaderGetMethod pdbr (uncodedToken TableNames.Method idx)
                 let sps = pdbMethodGetSequencePoints pdbm
D
Don Syme 已提交
2933
                 (*dprintf "#sps for 0x%x = %d\n" (uncodedToken TableNames.Method idx) (Array.length sps)  *)
D
Don Syme 已提交
2934
                 (* let roota, rootb = pdbScopeGetOffsets rootScope in  *)
L
latkin 已提交
2935 2936 2937 2938 2939 2940
                 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 = 
D
Don Syme 已提交
2941 2942 2943 2944
                             ILSourceMarker.Create(document = sourcedoc, 
                                                 line = sp.pdbSeqPointLine, 
                                                 column = sp.pdbSeqPointColumn, 
                                                 endLine = sp.pdbSeqPointEndLine, 
L
latkin 已提交
2945
                                                 endColumn = sp.pdbSeqPointEndColumn)
D
Don Syme 已提交
2946
                           (sp.pdbSeqPointOffset, source))
L
latkin 已提交
2947
                         
D
Don Syme 已提交
2948
                    Array.sortInPlaceBy fst arr
L
latkin 已提交
2949 2950 2951
                    
                    Array.toList arr
                 let rec scopes scp = 
D
Don Syme 已提交
2952
                       let a, b = pdbScopeGetOffsets scp
L
latkin 已提交
2953 2954 2955 2956 2957
                       let lvs =  pdbScopeGetLocals scp
                       let ilvs = 
                         lvs 
                         |> Array.toList 
                         |> List.filter (fun l -> 
D
Don Syme 已提交
2958
                             let k, _idx = pdbVariableGetAddressAttributes l
L
latkin 已提交
2959
                             k = 1 (* ADDR_IL_OFFSET *)) 
D
Don Syme 已提交
2960
                       let ilinfos : ILLocalDebugMapping list =
L
latkin 已提交
2961
                         ilvs |> List.map (fun ilv -> 
D
Don Syme 已提交
2962
                             let _k, idx = pdbVariableGetAddressAttributes ilv
L
latkin 已提交
2963
                             let n = pdbVariableGetName ilv
D
Don Syme 已提交
2964
                             { LocalIndex=  idx 
L
latkin 已提交
2965 2966 2967 2968
                               LocalName=n})
                           
                       let thisOne = 
                         (fun raw2nextLab ->
D
Don Syme 已提交
2969
                           { Range= (raw2nextLab a, raw2nextLab b) 
D
Don Syme 已提交
2970
                             DebugMappings = ilinfos } : ILLocalDebugInfo )
L
latkin 已提交
2971 2972 2973 2974
                       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?? 
D
Don Syme 已提交
2975
                 (localPdbInfos, None, seqpoints)
L
latkin 已提交
2976 2977
               with e -> 
                   // "* Warning: PDB info for method "+nm+" could not be read and will be ignored: "+e.Message
D
Don Syme 已提交
2978
                   [], None, []
2979
#endif
L
latkin 已提交
2980
       
2981
       let baseRVA = pectxt.anyV2P("method rva", rva)
L
latkin 已提交
2982
       // ": reading body of method "+nm+" at rva "+string rva+", phys "+string baseRVA
2983
       let b = seekReadByte pev baseRVA
L
latkin 已提交
2984 2985 2986
       if (b &&& e_CorILMethod_FormatMask) = e_CorILMethod_TinyFormat then 
           let codeBase = baseRVA + 1
           let codeSize =  (int32 b >>>& 2)
D
Don Syme 已提交
2987
           // tiny format for "+nm+", code size = " + string codeSize)
2988
           let instrs, _, lab2pc, raw2nextLab = seekReadTopCode ctxt pev mdv numtypars codeSize codeBase seqpoints
L
latkin 已提交
2989 2990
           (* Convert the linear code format to the nested code format *)
           let localPdbInfos2 = List.map (fun f -> f raw2nextLab) localPdbInfos
D
Don Syme 已提交
2991
           let code = buildILCode nm lab2pc instrs [] localPdbInfos2
L
latkin 已提交
2992
           MethodBody.IL
D
Don Syme 已提交
2993 2994 2995
             { IsZeroInit=false
               MaxStack= 8
               NoInlining=noinline
2996
               AggressiveInlining=aggressiveinline
2997
               Locals=List.empty
D
Don Syme 已提交
2998
               SourceMarker=methRangePdbInfo 
L
latkin 已提交
2999 3000 3001 3002 3003
               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
3004 3005 3006
           let maxstack = seekReadUInt16AsInt32 pev (baseRVA + 2)
           let codeSize = seekReadInt32 pev (baseRVA + 4)
           let localsTab, localToken = seekReadUncodedToken pev (baseRVA + 8)
L
latkin 已提交
3007 3008 3009 3010
           let codeBase = baseRVA + 12
           let locals = 
             if localToken = 0x0 then [] 
             else 
D
Don Syme 已提交
3011
               if localsTab <> TableNames.StandAloneSig then dprintn "strange table for locals token"
3012
               readBlobHeapAsLocalsSig ctxt numtypars (seekReadStandAloneSigRow ctxt pev localToken) 
L
latkin 已提交
3013
             
D
Don Syme 已提交
3014
           // fat format for "+nm+", code size = " + string codeSize+", hasMoreSections = "+(if hasMoreSections then "true" else "false")+", b = "+string b)
L
latkin 已提交
3015 3016
           
           // Read the method body 
3017
           let instrs, rawToLabel, lab2pc, raw2nextLab = seekReadTopCode ctxt pev mdv numtypars ( codeSize) codeBase seqpoints
L
latkin 已提交
3018 3019 3020 3021 3022 3023 3024 3025

           // 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
3026
             let sectionFlag = seekReadByte pev sectionBase
D
Don Syme 已提交
3027
             // fat format for "+nm+", sectionFlag = " + string sectionFlag)
L
latkin 已提交
3028 3029
             let sectionSize, clauses = 
               if (sectionFlag &&& e_CorILMethod_Sect_FatFormat) <> 0x0uy then 
3030
                   let bigSize = (seekReadInt32 pev sectionBase) >>>& 8
D
Don Syme 已提交
3031
                   // bigSize = "+string bigSize)
L
latkin 已提交
3032 3033 3034 3035 3036 3037 3038 3039 3040
                   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)
3041 3042 3043 3044 3045 3046
                               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)
D
Don Syme 已提交
3047
                               (kind, st1, sz1, st2, sz2, extra))
L
latkin 已提交
3048 3049 3050
                       else []
                   bigSize, clauses
               else 
3051
                 let smallSize = seekReadByteAsInt32 pev (sectionBase + 0x01)
L
latkin 已提交
3052 3053 3054 3055 3056 3057
                 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)
D
Don Syme 已提交
3058
                       // dprintn (nm+" has " + string numClauses + " tiny seh clauses")
L
latkin 已提交
3059 3060
                       List.init numClauses (fun i -> 
                           let clauseBase = sectionBase + 4 + (i * 12)
3061
                           let kind = seekReadUInt16AsInt32 pev (clauseBase + 0)
D
Don Syme 已提交
3062
                           if logging then dprintn ("One tiny SEH clause, kind = "+string kind)
3063 3064 3065 3066 3067
                           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)
D
Don Syme 已提交
3068
                           (kind, st1, sz1, st2, sz2, extra))
L
latkin 已提交
3069 3070 3071 3072 3073 3074
                   else 
                       []
                 smallSize, clauses

             // Morph together clauses that cover the same range 
             let sehClauses = 
D
Don Syme 已提交
3075
                let sehMap = Dictionary<_, _>(clauses.Length, HashIdentity.Structural) 
L
latkin 已提交
3076 3077
        
                List.iter
D
Don Syme 已提交
3078
                  (fun (kind, st1, sz1, st2, sz2, extra) ->
L
latkin 已提交
3079 3080 3081 3082 3083 3084
                    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 
3085
                        ILExceptionClause.TypeCatch(seekReadTypeDefOrRef ctxt numtypars AsObject List.empty (uncodedTokenToTypeDefOrRefOrSpec (i32ToUncodedToken extra)), (handlerStart, handlerFinish) )
L
latkin 已提交
3086 3087 3088 3089 3090 3091 3092 3093 3094
                      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
3095
                        dprintn (ctxt.fileName + ": unknown exception handler kind: "+string kind)
L
latkin 已提交
3096 3097 3098 3099
                        ILExceptionClause.Finally(handlerStart, handlerFinish)
                      end
                   
                    let key =  (tryStart, tryFinish)
3100 3101 3102
                    match sehMap.TryGetValue(key) with
                    | true, prev -> sehMap.[key] <- prev @ [clause]
                    | _ -> sehMap.[key] <- [clause])
D
Don Syme 已提交
3103
                  clauses
D
Don Syme 已提交
3104
                ([], sehMap) ||> Seq.fold  (fun acc (KeyValue(key, bs)) -> [ for b in bs -> {Range=key; Clause=b} : ILExceptionSpec ] @ acc)  
D
Don Syme 已提交
3105 3106 3107 3108
             seh := sehClauses
             moreSections := (sectionFlag &&& e_CorILMethod_Sect_MoreSects) <> 0x0uy
             nextSectionBase := sectionBase + sectionSize
           done (* while *)
L
latkin 已提交
3109 3110

           (* Convert the linear code format to the nested code format *)
D
Don Syme 已提交
3111
           if logging then dprintn ("doing localPdbInfos2") 
L
latkin 已提交
3112
           let localPdbInfos2 = List.map (fun f -> f raw2nextLab) localPdbInfos
D
Don Syme 已提交
3113
           if logging then dprintn ("done localPdbInfos2, checking code...") 
D
Don Syme 已提交
3114
           let code = buildILCode nm lab2pc instrs !seh localPdbInfos2
D
Don Syme 已提交
3115
           if logging then dprintn ("done checking code.") 
L
latkin 已提交
3116
           MethodBody.IL
D
Don Syme 已提交
3117 3118 3119
             { IsZeroInit=initlocals
               MaxStack= maxstack
               NoInlining=noinline
3120
               AggressiveInlining=aggressiveinline
3121
               Locals = locals
D
Don Syme 已提交
3122
               Code=code
L
latkin 已提交
3123 3124
               SourceMarker=methRangePdbInfo}
       else 
D
Don Syme 已提交
3125
           if logging then failwith "unknown format"
3126
           MethodBody.Abstract)
L
latkin 已提交
3127

3128
and int32AsILVariantType (ctxt: ILMetadataReader)  (n:int32) = 
L
latkin 已提交
3129 3130 3131 3132 3133
    if List.memAssoc n (Lazy.force ILVariantTypeRevMap) then 
      List.assoc n (Lazy.force ILVariantTypeRevMap)
    elif (n &&& vt_ARRAY) <> 0x0 then ILNativeVariant.Array (int32AsILVariantType ctxt (n &&& (~~~ vt_ARRAY)))
    elif (n &&& vt_VECTOR) <> 0x0 then ILNativeVariant.Vector (int32AsILVariantType ctxt (n &&& (~~~ vt_VECTOR)))
    elif (n &&& vt_BYREF) <> 0x0 then ILNativeVariant.Byref (int32AsILVariantType ctxt (n &&& (~~~ vt_BYREF)))
3134
    else (dprintn (ctxt.fileName + ": int32AsILVariantType ctxt: unexpected variant type, n = "+string n) ; ILNativeVariant.Empty)
L
latkin 已提交
3135 3136

and readBlobHeapAsNativeType ctxt blobIdx = 
D
Don Syme 已提交
3137
    // reading native type blob "+string blobIdx) 
L
latkin 已提交
3138
    let bytes = readBlobHeap ctxt blobIdx
D
Don Syme 已提交
3139
    let res, _ = sigptrGetILNativeType ctxt bytes 0
L
latkin 已提交
3140 3141 3142
    res

and sigptrGetILNativeType ctxt bytes sigptr = 
D
Don Syme 已提交
3143
    // reading native type blob, sigptr= "+string sigptr) 
D
Don Syme 已提交
3144
    let ntbyte, sigptr = sigptrGetByte bytes sigptr
L
latkin 已提交
3145 3146 3147 3148
    if List.memAssoc ntbyte (Lazy.force ILNativeTypeMap) then 
        List.assoc ntbyte (Lazy.force ILNativeTypeMap), sigptr
    elif ntbyte = 0x0uy then ILNativeType.Empty, sigptr
    elif ntbyte = nt_CUSTOMMARSHALER then  
D
Don Syme 已提交
3149
        // reading native type blob (CM1) , sigptr= "+string sigptr+ ", bytes.Length = "+string bytes.Length) 
D
Don Syme 已提交
3150
        let guidLen, sigptr = sigptrGetZInt32 bytes sigptr
D
Don Syme 已提交
3151
        // reading native type blob (CM2) , sigptr= "+string sigptr+", guidLen = "+string ( guidLen)) 
D
Don Syme 已提交
3152
        let guid, sigptr = sigptrGetBytes ( guidLen) bytes sigptr
D
Don Syme 已提交
3153
        // reading native type blob (CM3) , sigptr= "+string sigptr) 
D
Don Syme 已提交
3154
        let nativeTypeNameLen, sigptr = sigptrGetZInt32 bytes sigptr
D
Don Syme 已提交
3155
        // reading native type blob (CM4) , sigptr= "+string sigptr+", nativeTypeNameLen = "+string ( nativeTypeNameLen)) 
D
Don Syme 已提交
3156
        let nativeTypeName, sigptr = sigptrGetString ( nativeTypeNameLen) bytes sigptr
D
Don Syme 已提交
3157 3158
        // reading native type blob (CM4) , sigptr= "+string sigptr+", nativeTypeName = "+nativeTypeName) 
        // reading native type blob (CM5) , sigptr= "+string sigptr) 
D
Don Syme 已提交
3159
        let custMarshallerNameLen, sigptr = sigptrGetZInt32 bytes sigptr
D
Don Syme 已提交
3160
        // reading native type blob (CM6) , sigptr= "+string sigptr+", custMarshallerNameLen = "+string ( custMarshallerNameLen)) 
D
Don Syme 已提交
3161
        let custMarshallerName, sigptr = sigptrGetString ( custMarshallerNameLen) bytes sigptr
D
Don Syme 已提交
3162
        // reading native type blob (CM7) , sigptr= "+string sigptr+", custMarshallerName = "+custMarshallerName) 
D
Don Syme 已提交
3163
        let cookieStringLen, sigptr = sigptrGetZInt32 bytes sigptr
D
Don Syme 已提交
3164
        // reading native type blob (CM8) , sigptr= "+string sigptr+", cookieStringLen = "+string ( cookieStringLen)) 
D
Don Syme 已提交
3165
        let cookieString, sigptr = sigptrGetBytes ( cookieStringLen) bytes sigptr
D
Don Syme 已提交
3166
        // reading native type blob (CM9) , sigptr= "+string sigptr) 
D
Don Syme 已提交
3167
        ILNativeType.Custom (guid, nativeTypeName, custMarshallerName, cookieString), sigptr
L
latkin 已提交
3168
    elif ntbyte = nt_FIXEDSYSSTRING then 
D
Don Syme 已提交
3169
      let i, sigptr = sigptrGetZInt32 bytes sigptr
L
latkin 已提交
3170 3171
      ILNativeType.FixedSysString i, sigptr
    elif ntbyte = nt_FIXEDARRAY then 
D
Don Syme 已提交
3172
      let i, sigptr = sigptrGetZInt32 bytes sigptr
L
latkin 已提交
3173 3174 3175
      ILNativeType.FixedArray i, sigptr
    elif ntbyte = nt_SAFEARRAY then 
      (if sigptr >= bytes.Length then
D
Don Syme 已提交
3176
         ILNativeType.SafeArray(ILNativeVariant.Empty, None), sigptr
L
latkin 已提交
3177
       else 
D
Don Syme 已提交
3178
         let i, sigptr = sigptrGetZInt32 bytes sigptr
L
latkin 已提交
3179 3180 3181
         if sigptr >= bytes.Length then
           ILNativeType.SafeArray (int32AsILVariantType ctxt i, None), sigptr
         else 
D
Don Syme 已提交
3182 3183
           let len, sigptr = sigptrGetZInt32 bytes sigptr
           let s, sigptr = sigptrGetString ( len) bytes sigptr
L
latkin 已提交
3184 3185 3186
           ILNativeType.SafeArray (int32AsILVariantType ctxt i, Some s), sigptr)
    elif ntbyte = nt_ARRAY then 
       if sigptr >= bytes.Length then
D
Don Syme 已提交
3187
         ILNativeType.Array(None, None), sigptr
L
latkin 已提交
3188
       else 
D
Don Syme 已提交
3189 3190
         let nt, sigptr = 
           let u, sigptr' = sigptrGetZInt32 bytes sigptr
L
latkin 已提交
3191 3192 3193
           if (u = int nt_MAX) then 
             ILNativeType.Empty, sigptr'
           else
W
WilliamBerryiii 已提交
3194
             // NOTE: go back to start and read native type
L
latkin 已提交
3195 3196
             sigptrGetILNativeType ctxt bytes sigptr
         if sigptr >= bytes.Length then
D
Don Syme 已提交
3197
           ILNativeType.Array (Some nt, None), sigptr
L
latkin 已提交
3198
         else
D
Don Syme 已提交
3199
           let pnum, sigptr = sigptrGetZInt32 bytes sigptr
L
latkin 已提交
3200
           if sigptr >= bytes.Length then
D
Don Syme 已提交
3201
             ILNativeType.Array (Some nt, Some(pnum, None)), sigptr
L
latkin 已提交
3202
           else 
D
Don Syme 已提交
3203
             let additive, sigptr = 
L
latkin 已提交
3204 3205
               if sigptr >= bytes.Length then 0, sigptr
               else sigptrGetZInt32 bytes sigptr
D
Don Syme 已提交
3206
             ILNativeType.Array (Some nt, Some(pnum, Some(additive))), sigptr
D
Don Syme 已提交
3207
    else (ILNativeType.Empty, sigptr)
L
latkin 已提交
3208
      
3209 3210 3211 3212 3213 3214 3215 3216 3217 3218
// Note, pectxtEager and pevEager must not be captured by the results of this function
// As a result, reading the resource offsets in the physical file is done eagerly to avoid holding on to any resources
and seekReadManifestResources (ctxt: ILMetadataReader) (mdv: BinaryView) (pectxtEager: PEReader) (pevEager: BinaryView) = 
    mkILResources
        [ for i = 1 to ctxt.getNumRows TableNames.ManifestResource do
             let (offset, flags, nameIdx, implIdx) = seekReadManifestResourceRow ctxt mdv i

             let scoref = seekReadImplAsScopeRef ctxt mdv implIdx

             let location = 
L
latkin 已提交
3219 3220
               match scoref with
               | ILScopeRef.Local -> 
3221 3222 3223 3224
                  let start = pectxtEager.anyV2P ("resource", offset + pectxtEager.resourcesAddr)
                  let resourceLength = seekReadInt32 pevEager start
                  let offsetOfBytesFromStartOfPhysicalPEFile = start + 4
                  ILResourceLocation.LocalIn (ctxt.fileName, offsetOfBytesFromStartOfPhysicalPEFile, resourceLength)
D
Don Syme 已提交
3225
               | ILScopeRef.Module mref -> ILResourceLocation.File (mref, offset)
L
latkin 已提交
3226 3227 3228
               | ILScopeRef.Assembly aref -> ILResourceLocation.Assembly aref

             let r = 
D
Don Syme 已提交
3229
               { Name= readStringHeap ctxt nameIdx
3230
                 Location = location
D
Don Syme 已提交
3231
                 Access = (if (flags &&& 0x01) <> 0x0 then ILResourceAccess.Public else ILResourceAccess.Private)
3232 3233
                 CustomAttrsStored = ctxt.customAttrsReader_ManifestResource
                 MetadataIndex = i }
3234
             yield r ]
L
latkin 已提交
3235

N
ncave 已提交
3236
and seekReadNestedExportedTypes ctxt (exported: _ array) (nested: Lazy<_ array>) parentIdx = 
L
latkin 已提交
3237 3238
    mkILNestedExportedTypesLazy
      (lazy
N
ncave 已提交
3239 3240 3241 3242 3243 3244 3245 3246
            nested.Force().[parentIdx-1]
            |> List.map (fun i ->
                let (flags, _tok, nameIdx, namespaceIdx, _implIdx) = exported.[i-1]
                { Name = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx)
                  Access = (match typeAccessOfFlags flags with
                            | ILTypeDefAccess.Nested n -> n
                            | _ -> failwith "non-nested access for a nested type described as being in an auxiliary module")
                  Nested = seekReadNestedExportedTypes ctxt exported nested i
3247 3248
                  CustomAttrsStored = ctxt.customAttrsReader_ExportedType
                  MetadataIndex = i  }
N
ncave 已提交
3249 3250
            ))

3251
and seekReadTopExportedTypes (ctxt: ILMetadataReader)  = 
L
latkin 已提交
3252 3253
    mkILExportedTypesLazy 
      (lazy
3254
            let mdv = ctxt.mdfile.GetView()
N
ncave 已提交
3255
            let numRows = ctxt.getNumRows TableNames.ExportedType
3256
            let exported = [| for i in 1..numRows -> seekReadExportedTypeRow ctxt mdv i |]
N
ncave 已提交
3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274

            // add each nested type id to their parent's children list
            let nested = lazy (
                let nested = [| for _i in 1..numRows -> [] |]
                for i = 1 to numRows do
                    let (flags,_,_,_,TaggedIndex(tag, idx)) = exported.[i-1]
                    if not (isTopTypeDef flags) && (tag = i_ExportedType) then
                        nested.[idx-1] <- i :: nested.[idx-1]
                nested)

            // return top exported types
            [ for i = 1 to numRows do
                let (flags, _tok, nameIdx, namespaceIdx, implIdx) = exported.[i-1]
                let (TaggedIndex(tag, _idx)) = implIdx

                // if not a nested type
                if (isTopTypeDef flags) && (tag <> i_ExportedType) then
                    yield
3275
                      { ScopeRef = seekReadImplAsScopeRef ctxt mdv implIdx
N
ncave 已提交
3276
                        Name = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx)
A
Avi Avni 已提交
3277
                        Attributes = enum<TypeAttributes>(flags)
N
ncave 已提交
3278
                        Nested = seekReadNestedExportedTypes ctxt exported nested i
3279 3280
                        CustomAttrsStored = ctxt.customAttrsReader_ExportedType
                        MetadataIndex = i }
N
ncave 已提交
3281
            ])
L
latkin 已提交
3282

D
Don Syme 已提交
3283
#if !FX_NO_PDB_READER
3284 3285
let getPdbReader pdbDirPath fileName =  
    match pdbDirPath with 
L
latkin 已提交
3286 3287 3288
    | None -> None
    | Some pdbpath ->
         try 
3289
              let pdbr = pdbReadOpen fileName pdbpath
L
latkin 已提交
3290 3291
              let pdbdocs = pdbReaderGetDocuments pdbr
  
D
Don Syme 已提交
3292
              let tab = new Dictionary<_, _>(Array.length pdbdocs)
L
latkin 已提交
3293 3294 3295
              pdbdocs |> Array.iter  (fun pdbdoc -> 
                  let url = pdbDocumentGetURL pdbdoc
                  tab.[url] <-
D
Don Syme 已提交
3296 3297 3298
                      ILSourceDocument.Create(language=Some (pdbDocumentGetLanguage pdbdoc), 
                                            vendor = Some (pdbDocumentGetLanguageVendor pdbdoc), 
                                            documentType = Some (pdbDocumentGetType pdbdoc), 
D
Don Syme 已提交
3299
                                            file = url))
L
latkin 已提交
3300

3301 3302 3303 3304
              let docfun url =
                  match tab.TryGetValue(url) with
                  | true, doc -> doc
                  | _ -> failwith ("Document with URL " + url + " not found in list of documents in the PDB file")
L
latkin 已提交
3305 3306 3307 3308
              Some (pdbr, docfun)
          with e -> dprintn ("* Warning: PDB file could not be read and will be ignored: "+e.Message); None         
#endif
      
3309 3310 3311 3312 3313 3314
// Note, pectxtEager and pevEager must not be captured by the results of this function
let openMetadataReader (fileName, mdfile: BinaryFile, metadataPhysLoc, peinfo, pectxtEager: PEReader, pevEager: BinaryView, pectxtCaptured, reduceMemoryUsage, ilGlobals) = 
    let mdv = mdfile.GetView()
    let magic = seekReadUInt16AsInt32 mdv metadataPhysLoc
    if magic <> 0x5342 then failwith (fileName + ": bad metadata magic number: " + string magic)
    let magic2 = seekReadUInt16AsInt32 mdv (metadataPhysLoc + 2)
D
Don Syme 已提交
3315
    if magic2 <> 0x424a then failwith "bad metadata magic number"
3316 3317
    let _majorMetadataVersion = seekReadUInt16 mdv (metadataPhysLoc + 4)
    let _minorMetadataVersion = seekReadUInt16 mdv (metadataPhysLoc + 6)
L
latkin 已提交
3318

3319 3320
    let versionLength = seekReadInt32 mdv (metadataPhysLoc + 12)
    let ilMetadataVersion = seekReadBytes mdv (metadataPhysLoc + 16) versionLength |> Array.filter (fun b -> b <> 0uy)
L
latkin 已提交
3321
    let x = align 0x04 (16 + versionLength)
3322
    let numStreams = seekReadUInt16AsInt32 mdv (metadataPhysLoc + x + 2)
L
latkin 已提交
3323 3324 3325 3326 3327 3328
    let streamHeadersStart = (metadataPhysLoc + x + 4)

    let tryFindStream name = 
      let rec look i pos = 
        if i >= numStreams then None
        else
3329 3330
          let offset = seekReadInt32 mdv (pos + 0)
          let length = seekReadInt32 mdv (pos + 4)
L
latkin 已提交
3331 3332 3333 3334 3335
          let res = ref true
          let fin = ref false
          let n = ref 0
          // read and compare the stream name byte by byte 
          while (not !fin) do 
3336
              let c= seekReadByteAsInt32 mdv (pos + 8 + (!n))
L
latkin 已提交
3337 3338 3339
              if c = 0 then 
                  fin := true
              elif !n >= Array.length name || c <> name.[!n] then 
D
Don Syme 已提交
3340
                  res := false
L
latkin 已提交
3341
              incr n
D
Don Syme 已提交
3342
          if !res then Some(offset + metadataPhysLoc, length) 
L
latkin 已提交
3343 3344 3345 3346 3347 3348 3349 3350
          else look (i+1) (align 0x04 (pos + 8 + (!n)))
      look 0 streamHeadersStart

    let findStream name = 
        match tryFindStream name with
        | None -> (0x0, 0x0)
        | Some positions ->  positions

D
Don Syme 已提交
3351
    let (tablesStreamPhysLoc, _tablesStreamSize) = 
L
latkin 已提交
3352 3353 3354 3355 3356 3357
      match tryFindStream [| 0x23; 0x7e |] (* #~ *) with
      | Some res -> res
      | None -> 
        match tryFindStream [| 0x23; 0x2d |] (* #-: at least one DLL I've seen uses this! *)   with
        | Some res -> res
        | None -> 
3358 3359
         let firstStreamOffset = seekReadInt32 mdv (streamHeadersStart + 0)
         let firstStreamLength = seekReadInt32 mdv (streamHeadersStart + 4)
D
Don Syme 已提交
3360
         firstStreamOffset, firstStreamLength
L
latkin 已提交
3361 3362 3363 3364 3365 3366 3367

    let (stringsStreamPhysicalLoc, stringsStreamSize) = findStream [| 0x23; 0x53; 0x74; 0x72; 0x69; 0x6e; 0x67; 0x73; |] (* #Strings *)
    let (userStringsStreamPhysicalLoc, userStringsStreamSize) = findStream [| 0x23; 0x55; 0x53; |] (* #US *)
    let (guidsStreamPhysicalLoc, _guidsStreamSize) = findStream [| 0x23; 0x47; 0x55; 0x49; 0x44; |] (* #GUID *)
    let (blobsStreamPhysicalLoc, blobsStreamSize) = findStream [| 0x23; 0x42; 0x6c; 0x6f; 0x62; |] (* #Blob *)

    let tableKinds = 
D
Don Syme 已提交
3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431
        [|kindModule               (* Table 0  *) 
          kindTypeRef              (* Table 1  *)
          kindTypeDef              (* Table 2  *)
          kindIllegal (* kindFieldPtr *)             (* Table 3  *)
          kindFieldDef                (* Table 4  *)
          kindIllegal (* kindMethodPtr *)            (* Table 5  *)
          kindMethodDef               (* Table 6  *)
          kindIllegal (* kindParamPtr *)             (* Table 7  *)
          kindParam                (* Table 8  *)
          kindInterfaceImpl        (* Table 9  *)
          kindMemberRef            (* Table 10 *)
          kindConstant             (* Table 11 *)
          kindCustomAttribute      (* Table 12 *)
          kindFieldMarshal         (* Table 13 *)
          kindDeclSecurity         (* Table 14 *)
          kindClassLayout          (* Table 15 *)
          kindFieldLayout          (* Table 16 *)
          kindStandAloneSig        (* Table 17 *)
          kindEventMap             (* Table 18 *)
          kindIllegal (* kindEventPtr *)             (* Table 19 *)
          kindEvent                (* Table 20 *)
          kindPropertyMap          (* Table 21 *)
          kindIllegal (* kindPropertyPtr *)          (* Table 22 *)
          kindProperty             (* Table 23 *)
          kindMethodSemantics      (* Table 24 *)
          kindMethodImpl           (* Table 25 *)
          kindModuleRef            (* Table 26 *)
          kindTypeSpec             (* Table 27 *)
          kindImplMap              (* Table 28 *)
          kindFieldRVA             (* Table 29 *)
          kindIllegal (* kindENCLog *)               (* Table 30 *)
          kindIllegal (* kindENCMap *)               (* Table 31 *)
          kindAssembly             (* Table 32 *)
          kindIllegal (* kindAssemblyProcessor *)    (* Table 33 *)
          kindIllegal (* kindAssemblyOS *)           (* Table 34 *)
          kindAssemblyRef          (* Table 35 *)
          kindIllegal (* kindAssemblyRefProcessor *) (* Table 36 *)
          kindIllegal (* kindAssemblyRefOS *)        (* Table 37 *)
          kindFileRef                 (* Table 38 *)
          kindExportedType         (* Table 39 *)
          kindManifestResource     (* Table 40 *)
          kindNested               (* Table 41 *)
          kindGenericParam_v2_0        (* Table 42 *)
          kindMethodSpec         (* Table 43 *)
          kindGenericParamConstraint         (* Table 44 *)
          kindIllegal         (* Table 45 *)
          kindIllegal         (* Table 46 *)
          kindIllegal         (* Table 47 *)
          kindIllegal         (* Table 48 *)
          kindIllegal         (* Table 49 *)
          kindIllegal         (* Table 50 *)
          kindIllegal         (* Table 51 *)
          kindIllegal         (* Table 52 *)
          kindIllegal         (* Table 53 *)
          kindIllegal         (* Table 54 *)
          kindIllegal         (* Table 55 *)
          kindIllegal         (* Table 56 *)
          kindIllegal         (* Table 57 *)
          kindIllegal         (* Table 58 *)
          kindIllegal         (* Table 59 *)
          kindIllegal         (* Table 60 *)
          kindIllegal         (* Table 61 *)
          kindIllegal         (* Table 62 *)
          kindIllegal         (* Table 63 *)
L
latkin 已提交
3432 3433
        |]

3434 3435 3436
    let heapSizes = seekReadByteAsInt32 mdv (tablesStreamPhysLoc + 6)
    let valid = seekReadInt64 mdv (tablesStreamPhysLoc + 8)
    let sorted = seekReadInt64 mdv (tablesStreamPhysLoc + 16)
L
latkin 已提交
3437 3438 3439 3440 3441 3442
    let tablesPresent, tableRowCount, startOfTables = 
        let present = ref []
        let numRows = Array.create 64 0
        let prevNumRowIdx = ref (tablesStreamPhysLoc + 24)
        for i = 0 to 63 do 
            if (valid &&& (int64 1 <<< i)) <> int64  0 then 
D
Don Syme 已提交
3443
                present := i :: !present
3444
                numRows.[i] <-  (seekReadInt32 mdv !prevNumRowIdx)
L
latkin 已提交
3445 3446 3447 3448 3449 3450 3451 3452 3453
                prevNumRowIdx := !prevNumRowIdx + 4
        List.rev !present, numRows, !prevNumRowIdx

    let getNumRows (tab:TableName) = tableRowCount.[tab.Index]
    let numTables = tablesPresent.Length
    let stringsBigness = (heapSizes &&& 1) <> 0
    let guidsBigness = (heapSizes &&& 2) <> 0
    let blobsBigness = (heapSizes &&& 4) <> 0

3454 3455 3456
    if logging then dprintn (fileName + ": numTables = "+string numTables)
    if logging && stringsBigness then dprintn (fileName + ": strings are big")
    if logging && blobsBigness then dprintn (fileName + ": blobs are big")
L
latkin 已提交
3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573

    let tableBigness = Array.map (fun n -> n >= 0x10000) tableRowCount
      
    let codedBigness nbits tab =
      let rows = getNumRows tab
      rows >= (0x10000 >>>& nbits)
    
    let tdorBigness = 
      codedBigness 2 TableNames.TypeDef || 
      codedBigness 2 TableNames.TypeRef || 
      codedBigness 2 TableNames.TypeSpec
    
    let tomdBigness = 
      codedBigness 1 TableNames.TypeDef || 
      codedBigness 1 TableNames.Method
    
    let hcBigness = 
      codedBigness 2 TableNames.Field ||
      codedBigness 2 TableNames.Param ||
      codedBigness 2 TableNames.Property
    
    let hcaBigness = 
      codedBigness 5 TableNames.Method ||
      codedBigness 5 TableNames.Field ||
      codedBigness 5 TableNames.TypeRef  ||
      codedBigness 5 TableNames.TypeDef ||
      codedBigness 5 TableNames.Param ||
      codedBigness 5 TableNames.InterfaceImpl ||
      codedBigness 5 TableNames.MemberRef ||
      codedBigness 5 TableNames.Module ||
      codedBigness 5 TableNames.Permission ||
      codedBigness 5 TableNames.Property ||
      codedBigness 5 TableNames.Event ||
      codedBigness 5 TableNames.StandAloneSig ||
      codedBigness 5 TableNames.ModuleRef ||
      codedBigness 5 TableNames.TypeSpec ||
      codedBigness 5 TableNames.Assembly ||
      codedBigness 5 TableNames.AssemblyRef ||
      codedBigness 5 TableNames.File ||
      codedBigness 5 TableNames.ExportedType ||
      codedBigness 5 TableNames.ManifestResource ||
      codedBigness 5 TableNames.GenericParam ||
      codedBigness 5 TableNames.GenericParamConstraint ||
      codedBigness 5 TableNames.MethodSpec

    
    let hfmBigness = 
      codedBigness 1 TableNames.Field || 
      codedBigness 1 TableNames.Param
    
    let hdsBigness = 
      codedBigness 2 TableNames.TypeDef || 
      codedBigness 2 TableNames.Method ||
      codedBigness 2 TableNames.Assembly
    
    let mrpBigness = 
      codedBigness 3 TableNames.TypeRef ||
      codedBigness 3 TableNames.ModuleRef ||
      codedBigness 3 TableNames.Method ||
      codedBigness 3 TableNames.TypeSpec
    
    let hsBigness = 
      codedBigness 1 TableNames.Event || 
      codedBigness 1 TableNames.Property 
    
    let mdorBigness =
      codedBigness 1 TableNames.Method ||    
      codedBigness 1 TableNames.MemberRef 
    
    let mfBigness =
      codedBigness 1 TableNames.Field ||
      codedBigness 1 TableNames.Method 
    
    let iBigness =
      codedBigness 2 TableNames.File || 
      codedBigness 2 TableNames.AssemblyRef ||    
      codedBigness 2 TableNames.ExportedType 
    
    let catBigness =  
      codedBigness 3 TableNames.Method ||    
      codedBigness 3 TableNames.MemberRef 
    
    let rsBigness = 
      codedBigness 2 TableNames.Module ||    
      codedBigness 2 TableNames.ModuleRef || 
      codedBigness 2 TableNames.AssemblyRef  ||
      codedBigness 2 TableNames.TypeRef
      
    let rowKindSize (RowKind kinds) = 
      kinds |> List.sumBy (fun x -> 
            match x with 
            | UShort -> 2
            | ULong -> 4
            | Byte -> 1
            | Data -> 4
            | GGuid -> (if guidsBigness then 4 else 2)
            | Blob  -> (if blobsBigness then 4 else 2)
            | SString  -> (if stringsBigness then 4 else 2)
            | SimpleIndex tab -> (if tableBigness.[tab.Index] then 4 else 2)
            | TypeDefOrRefOrSpec -> (if tdorBigness then 4 else 2)
            | TypeOrMethodDef -> (if tomdBigness then 4 else 2)
            | HasConstant  -> (if hcBigness then 4 else 2)
            | HasCustomAttribute -> (if hcaBigness then 4 else 2)
            | HasFieldMarshal  -> (if hfmBigness then 4 else 2)
            | HasDeclSecurity  -> (if hdsBigness then 4 else 2)
            | MemberRefParent  -> (if mrpBigness then 4 else 2)
            | HasSemantics  -> (if hsBigness then 4 else 2)
            | MethodDefOrRef -> (if mdorBigness then 4 else 2)
            | MemberForwarded -> (if mfBigness then 4 else 2)
            | Implementation  -> (if iBigness then 4 else 2)
            | CustomAttributeType -> (if catBigness then 4 else 2)
            | ResolutionScope -> (if rsBigness then 4 else 2)) 

    let tableRowSizes = tableKinds |> Array.map rowKindSize 

    let tablePhysLocations = 
         let res = Array.create 64 0x0
3574
         let mutable prevTablePhysLoc = startOfTables
L
latkin 已提交
3575
         for i = 0 to 63 do 
3576 3577
             res.[i] <- prevTablePhysLoc
             prevTablePhysLoc <- prevTablePhysLoc + (tableRowCount.[i] * tableRowSizes.[i])
L
latkin 已提交
3578 3579
         res
    
3580
    let inbase = Filename.fileNameOfPath fileName + ": "
L
latkin 已提交
3581 3582

    // All the caches.  The sizes are guesstimates for the rough sharing-density of the assembly 
3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596
    let cacheAssemblyRef               = mkCacheInt32 reduceMemoryUsage inbase "ILAssemblyRef"  (getNumRows TableNames.AssemblyRef)
    let cacheMethodSpecAsMethodData    = mkCacheGeneric reduceMemoryUsage inbase "MethodSpecAsMethodData" (getNumRows TableNames.MethodSpec / 20 + 1)
    let cacheMemberRefAsMemberData     = mkCacheGeneric reduceMemoryUsage inbase "MemberRefAsMemberData" (getNumRows TableNames.MemberRef / 20 + 1)
    let cacheCustomAttr                = mkCacheGeneric reduceMemoryUsage inbase "CustomAttr" (getNumRows TableNames.CustomAttribute / 50 + 1)
    let cacheTypeRef                   = mkCacheInt32 reduceMemoryUsage inbase "ILTypeRef" (getNumRows TableNames.TypeRef / 20 + 1)
    let cacheTypeRefAsType             = mkCacheGeneric reduceMemoryUsage inbase "TypeRefAsType" (getNumRows TableNames.TypeRef / 20 + 1)
    let cacheBlobHeapAsPropertySig     = mkCacheGeneric reduceMemoryUsage inbase "BlobHeapAsPropertySig" (getNumRows TableNames.Property / 20 + 1)
    let cacheBlobHeapAsFieldSig        = mkCacheGeneric reduceMemoryUsage inbase "BlobHeapAsFieldSig" (getNumRows TableNames.Field / 20 + 1)
    let cacheBlobHeapAsMethodSig       = mkCacheGeneric reduceMemoryUsage inbase "BlobHeapAsMethodSig" (getNumRows TableNames.Method / 20 + 1)
    let cacheTypeDefAsType             = mkCacheGeneric reduceMemoryUsage inbase "TypeDefAsType" (getNumRows TableNames.TypeDef / 20 + 1)
    let cacheMethodDefAsMethodData     = mkCacheInt32 reduceMemoryUsage inbase "MethodDefAsMethodData" (getNumRows TableNames.Method / 20 + 1)
    let cacheGenericParams             = mkCacheGeneric reduceMemoryUsage inbase "GenericParams" (getNumRows TableNames.GenericParam / 20 + 1)
    let cacheFieldDefAsFieldSpec       = mkCacheInt32 reduceMemoryUsage inbase "FieldDefAsFieldSpec" (getNumRows TableNames.Field / 20 + 1)
    let cacheUserStringHeap            = mkCacheInt32 reduceMemoryUsage inbase "UserStringHeap" ( userStringsStreamSize / 20 + 1)
L
latkin 已提交
3597 3598
    // nb. Lots and lots of cache hits on this cache, hence never optimize cache away 
    let cacheStringHeap                = mkCacheInt32 false inbase "string heap" ( stringsStreamSize / 50 + 1)
3599
    let cacheBlobHeap                  = mkCacheInt32 reduceMemoryUsage inbase "blob heap" ( blobsStreamSize / 50 + 1) 
L
latkin 已提交
3600 3601 3602 3603 3604

     // These tables are not required to enforce sharing fo the final data 
     // structure, but are very useful as searching these tables gives rise to many reads 
     // in standard applications.  
     
3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650
    let cacheNestedRow          = mkCacheInt32 reduceMemoryUsage inbase "Nested Table Rows" (getNumRows TableNames.Nested / 20 + 1)
    let cacheConstantRow        = mkCacheInt32 reduceMemoryUsage inbase "Constant Rows" (getNumRows TableNames.Constant / 20 + 1)
    let cacheMethodSemanticsRow = mkCacheInt32 reduceMemoryUsage inbase "MethodSemantics Rows" (getNumRows TableNames.MethodSemantics / 20 + 1)
    let cacheTypeDefRow         = mkCacheInt32 reduceMemoryUsage inbase "ILTypeDef Rows" (getNumRows TableNames.TypeDef / 20 + 1)

    let rowAddr (tab:TableName) idx = tablePhysLocations.[tab.Index] + (idx - 1) * tableRowSizes.[tab.Index]

    // Build the reader context
    // Use an initialization hole 
    let ctxtH = ref None
    let ctxt : ILMetadataReader = 
        { ilg=ilGlobals 
          sorted=sorted
          getNumRows=getNumRows 
          mdfile=mdfile
          dataEndPoints = match pectxtCaptured with None -> notlazy [] | Some pectxt -> getDataEndPointsDelayed pectxt ctxtH
          pectxtCaptured=pectxtCaptured
          entryPointToken=pectxtEager.entryPointToken
          fileName=fileName
          userStringsStreamPhysicalLoc   = userStringsStreamPhysicalLoc
          stringsStreamPhysicalLoc       = stringsStreamPhysicalLoc
          blobsStreamPhysicalLoc         = blobsStreamPhysicalLoc
          blobsStreamSize                = blobsStreamSize
          memoizeString                  = Tables.memoize id
          readUserStringHeap             = cacheUserStringHeap (readUserStringHeapUncached ctxtH)
          readStringHeap                 = cacheStringHeap (readStringHeapUncached ctxtH)
          readBlobHeap                   = cacheBlobHeap (readBlobHeapUncached ctxtH)
          seekReadNestedRow              = cacheNestedRow  (seekReadNestedRowUncached ctxtH)
          seekReadConstantRow            = cacheConstantRow  (seekReadConstantRowUncached ctxtH)
          seekReadMethodSemanticsRow     = cacheMethodSemanticsRow  (seekReadMethodSemanticsRowUncached ctxtH)
          seekReadTypeDefRow             = cacheTypeDefRow  (seekReadTypeDefRowUncached ctxtH)
          seekReadAssemblyRef            = cacheAssemblyRef  (seekReadAssemblyRefUncached ctxtH)
          seekReadMethodSpecAsMethodData = cacheMethodSpecAsMethodData  (seekReadMethodSpecAsMethodDataUncached ctxtH)
          seekReadMemberRefAsMethodData  = cacheMemberRefAsMemberData  (seekReadMemberRefAsMethodDataUncached ctxtH)
          seekReadMemberRefAsFieldSpec   = seekReadMemberRefAsFieldSpecUncached ctxtH
          seekReadCustomAttr             = cacheCustomAttr  (seekReadCustomAttrUncached ctxtH)
          seekReadTypeRef                = cacheTypeRef (seekReadTypeRefUncached ctxtH)
          readBlobHeapAsPropertySig      = cacheBlobHeapAsPropertySig (readBlobHeapAsPropertySigUncached ctxtH)
          readBlobHeapAsFieldSig         = cacheBlobHeapAsFieldSig (readBlobHeapAsFieldSigUncached ctxtH)
          readBlobHeapAsMethodSig        = cacheBlobHeapAsMethodSig (readBlobHeapAsMethodSigUncached ctxtH)
          readBlobHeapAsLocalsSig        = readBlobHeapAsLocalsSigUncached ctxtH
          seekReadTypeDefAsType          = cacheTypeDefAsType (seekReadTypeDefAsTypeUncached ctxtH)
          seekReadTypeRefAsType          = cacheTypeRefAsType (seekReadTypeRefAsTypeUncached ctxtH)
          seekReadMethodDefAsMethodData  = cacheMethodDefAsMethodData (seekReadMethodDefAsMethodDataUncached ctxtH)
          seekReadGenericParams          = cacheGenericParams (seekReadGenericParamsUncached ctxtH)
          seekReadFieldDefAsFieldSpec    = cacheFieldDefAsFieldSpec (seekReadFieldDefAsFieldSpecUncached ctxtH)
3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665
          customAttrsReader_Module = customAttrsReader ctxtH hca_Module
          customAttrsReader_Assembly = customAttrsReader ctxtH hca_Assembly
          customAttrsReader_TypeDef = customAttrsReader ctxtH hca_TypeDef
          customAttrsReader_GenericParam= customAttrsReader ctxtH hca_GenericParam
          customAttrsReader_FieldDef= customAttrsReader ctxtH hca_FieldDef
          customAttrsReader_MethodDef= customAttrsReader ctxtH hca_MethodDef
          customAttrsReader_ParamDef= customAttrsReader ctxtH hca_ParamDef
          customAttrsReader_Event= customAttrsReader ctxtH hca_Event
          customAttrsReader_Property= customAttrsReader ctxtH hca_Property
          customAttrsReader_ManifestResource= customAttrsReader ctxtH hca_ManifestResource
          customAttrsReader_ExportedType= customAttrsReader ctxtH hca_ExportedType
          securityDeclsReader_TypeDef = securityDeclsReader ctxtH hds_TypeDef
          securityDeclsReader_MethodDef = securityDeclsReader ctxtH hds_MethodDef
          securityDeclsReader_Assembly = securityDeclsReader ctxtH hds_Assembly
          typeDefReader = typeDefReader ctxtH 
3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696
          guidsStreamPhysicalLoc = guidsStreamPhysicalLoc
          rowAddr=rowAddr
          rsBigness=rsBigness
          tdorBigness=tdorBigness
          tomdBigness=tomdBigness   
          hcBigness=hcBigness   
          hcaBigness=hcaBigness   
          hfmBigness=hfmBigness   
          hdsBigness=hdsBigness
          mrpBigness=mrpBigness
          hsBigness=hsBigness
          mdorBigness=mdorBigness
          mfBigness=mfBigness
          iBigness=iBigness
          catBigness=catBigness 
          stringsBigness=stringsBigness
          guidsBigness=guidsBigness
          blobsBigness=blobsBigness
          tableBigness=tableBigness } 
    ctxtH := Some ctxt
     
    let ilModule = seekReadModule ctxt pectxtEager pevEager peinfo (System.Text.Encoding.UTF8.GetString (ilMetadataVersion, 0, ilMetadataVersion.Length)) 1
    let ilAssemblyRefs = lazy [ for i in 1 .. getNumRows TableNames.AssemblyRef do yield seekReadAssemblyRef ctxt i ]

    ilModule, ilAssemblyRefs

//-----------------------------------------------------------------------
// Crack the binary headers, build a reader context and return the lazy
// read of the AbsIL module.
// ----------------------------------------------------------------------

3697
let openPEFileReader (fileName, pefile: BinaryFile, pdbDirPath) = 
3698 3699 3700
    let pev = pefile.GetView()
    (* MSDOS HEADER *)
    let peSignaturePhysLoc = seekReadInt32 pev 0x3c
L
latkin 已提交
3701

3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751
    (* PE HEADER *)
    let peFileHeaderPhysLoc = peSignaturePhysLoc + 0x04
    let peOptionalHeaderPhysLoc = peFileHeaderPhysLoc + 0x14
    let peSignature = seekReadInt32 pev (peSignaturePhysLoc + 0)
    if peSignature <>  0x4550 then failwithf "not a PE file - bad magic PE number 0x%08x, is = %A" peSignature pev


    (* PE SIGNATURE *)
    let machine = seekReadUInt16AsInt32 pev (peFileHeaderPhysLoc + 0)
    let numSections = seekReadUInt16AsInt32 pev (peFileHeaderPhysLoc + 2)
    let optHeaderSize = seekReadUInt16AsInt32 pev (peFileHeaderPhysLoc + 16)
    if optHeaderSize <>  0xe0 &&
       optHeaderSize <> 0xf0 then failwith "not a PE file - bad optional header size"
    let x64adjust = optHeaderSize - 0xe0
    let only64 = (optHeaderSize = 0xf0)    (* May want to read in the optional header Magic number and check that as well... *)
    let platform = match machine with | 0x8664 -> Some(AMD64) | 0x200 -> Some(IA64) | _ -> Some(X86) 
    let sectionHeadersStartPhysLoc = peOptionalHeaderPhysLoc + optHeaderSize

    let flags = seekReadUInt16AsInt32 pev (peFileHeaderPhysLoc + 18)
    let isDll = (flags &&& 0x2000) <> 0x0

   (* OPTIONAL PE HEADER *)
    let _textPhysSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 4)  (* Size of the code (text) section, or the sum of all code sections if there are multiple sections. *)
     (* x86: 000000a0 *) 
    let _initdataPhysSize   = seekReadInt32 pev (peOptionalHeaderPhysLoc + 8) (* Size of the initialized data section, or the sum of all such sections if there are multiple data sections. *)
    let _uninitdataPhysSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 12) (* Size of the uninitialized data section, or the sum of all such sections if there are multiple data sections. *)
    let _entrypointAddr      = seekReadInt32 pev (peOptionalHeaderPhysLoc + 16) (* RVA of entry point , needs to point to bytes 0xFF 0x25 followed by the RVA+!0x4000000 in a section marked execute/read for EXEs or 0 for DLLs e.g. 0x0000b57e *)
    let _textAddr            = seekReadInt32 pev (peOptionalHeaderPhysLoc + 20) (* e.g. 0x0002000 *)
     (* x86: 000000b0 *) 
    let dataSegmentAddr       = seekReadInt32 pev (peOptionalHeaderPhysLoc + 24) (* e.g. 0x0000c000 *)
    (*  REVIEW: For now, we'll use the DWORD at offset 24 for x64.  This currently ok since fsc doesn't support true 64-bit image bases, 
        but we'll have to fix this up when such support is added. *)    
    let imageBaseReal = if only64 then dataSegmentAddr else seekReadInt32 pev (peOptionalHeaderPhysLoc + 28)  (* Image Base Always 0x400000 (see Section 23.1). - QUERY : no it's not always 0x400000, e.g. 0x034f0000 *)
    let alignVirt      = seekReadInt32 pev (peOptionalHeaderPhysLoc + 32)   (*  Section Alignment Always 0x2000 (see Section 23.1). *)
    let alignPhys      = seekReadInt32 pev (peOptionalHeaderPhysLoc + 36)  (* File Alignment Either 0x200 or 0x1000. *)
     (* x86: 000000c0 *) 
    let _osMajor     = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 40)   (*  OS Major Always 4 (see Section 23.1). *)
    let _osMinor     = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 42)   (* OS Minor Always 0 (see Section 23.1). *)
    let _userMajor   = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 44)   (* User Major Always 0 (see Section 23.1). *)
    let _userMinor   = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 46)   (* User Minor Always 0 (see Section 23.1). *)
    let subsysMajor = seekReadUInt16AsInt32 pev (peOptionalHeaderPhysLoc + 48)   (* SubSys Major Always 4 (see Section 23.1). *)
    let subsysMinor = seekReadUInt16AsInt32 pev (peOptionalHeaderPhysLoc + 50)   (* SubSys Minor Always 0 (see Section 23.1). *)
     (* x86: 000000d0 *) 
    let _imageEndAddr   = seekReadInt32 pev (peOptionalHeaderPhysLoc + 56)  (* Image Size: Size, in bytes, of image, including all headers and padding; shall be a multiple of Section Alignment. e.g. 0x0000e000 *)
    let _headerPhysSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 60)  (* Header Size Combined size of MS-DOS Header, PE Header, PE Optional Header and padding; shall be a multiple of the file alignment. *)
    let subsys           = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 68)   (* SubSystem Subsystem required to run this image. Shall be either IMAGE_SUBSYSTEM_WINDOWS_CE_GUI (!0x3) or IMAGE_SUBSYSTEM_WINDOWS_GUI (!0x2). QUERY: Why is this 3 on the images ILASM produces??? *)
    let useHighEnthropyVA = 
        let n = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 70)
        let highEnthropyVA = 0x20us
        (n &&& highEnthropyVA) = highEnthropyVA
L
latkin 已提交
3752

3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859
     (* x86: 000000e0 *) 

    (* WARNING: THESE ARE 64 bit ON x64/ia64 *)
    (*  REVIEW: If we ever decide that we need these values for x64, we'll have to read them in as 64bit and fix up the rest of the offsets.
        Then again, it should suffice to just use the defaults, and still not bother... *)
    (*  let stackReserve = seekReadInt32 is (peOptionalHeaderPhysLoc + 72) in *)  (* Stack Reserve Size Always 0x100000 (1Mb) (see Section 23.1). *)
    (*   let stackCommit = seekReadInt32 is (peOptionalHeaderPhysLoc + 76) in  *) (* Stack Commit Size Always 0x1000 (4Kb) (see Section 23.1). *)
    (*   let heapReserve = seekReadInt32 is (peOptionalHeaderPhysLoc + 80) in *)  (* Heap Reserve Size Always 0x100000 (1Mb) (see Section 23.1). *)
    (*   let heapCommit = seekReadInt32 is (peOptionalHeaderPhysLoc + 84) in *)  (* Heap Commit Size Always 0x1000 (4Kb) (see Section 23.1). *)

     (* x86: 000000f0, x64: 00000100 *) 
    let _numDataDirectories = seekReadInt32 pev (peOptionalHeaderPhysLoc + 92 + x64adjust)   (* Number of Data Directories: Always 0x10 (see Section 23.1). *)
     (* 00000100 - these addresses are for x86 - for the x64 location, add x64adjust (0x10) *) 
    let _importTableAddr = seekReadInt32 pev (peOptionalHeaderPhysLoc + 104 + x64adjust)   (* Import Table RVA of Import Table, (see clause 24.3.1). e.g. 0000b530 *) 
    let _importTableSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 108 + x64adjust)  (* Size of Import Table, (see clause 24.3.1).  *)
    let nativeResourcesAddr = seekReadInt32 pev (peOptionalHeaderPhysLoc + 112 + x64adjust)
    let nativeResourcesSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 116 + x64adjust)
     (* 00000110 *) 
     (* 00000120 *) 
  (*   let base_relocTableNames.addr = seekReadInt32 is (peOptionalHeaderPhysLoc + 136)
    let base_relocTableNames.size = seekReadInt32 is (peOptionalHeaderPhysLoc + 140) in  *)
     (* 00000130 *) 
     (* 00000140 *) 
     (* 00000150 *) 
    let _importAddrTableAddr = seekReadInt32 pev (peOptionalHeaderPhysLoc + 192 + x64adjust)   (* RVA of Import Addr Table, (see clause 24.3.1). e.g. 0x00002000 *) 
    let _importAddrTableSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 196 + x64adjust)  (* Size of Import Addr Table, (see clause 24.3.1). e.g. 0x00002000 *) 
     (* 00000160 *) 
    let cliHeaderAddr = seekReadInt32 pev (peOptionalHeaderPhysLoc + 208 + x64adjust)
    let _cliHeaderSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 212 + x64adjust)
     (* 00000170 *) 


    (* Crack section headers *)

    let sectionHeaders = 
      [ for i in 0 .. numSections-1 do
          let pos = sectionHeadersStartPhysLoc + i * 0x28
          let virtSize = seekReadInt32 pev (pos + 8)
          let virtAddr = seekReadInt32 pev (pos + 12)
          let physLoc = seekReadInt32 pev (pos + 20)
          yield (virtAddr, virtSize, physLoc) ]

    let findSectionHeader addr = 
      let rec look i pos = 
        if i >= numSections then 0x0 
        else
          let virtSize = seekReadInt32 pev (pos + 8)
          let virtAddr = seekReadInt32 pev (pos + 12)
          if (addr >= virtAddr && addr < virtAddr + virtSize) then pos 
          else look (i+1) (pos + 0x28)
      look 0 sectionHeadersStartPhysLoc
    
    let textHeaderStart = findSectionHeader cliHeaderAddr
    let dataHeaderStart = findSectionHeader dataSegmentAddr
  (*  let relocHeaderStart = findSectionHeader base_relocTableNames.addr in  *)

    let _textSize = if textHeaderStart = 0x0 then 0x0 else seekReadInt32 pev (textHeaderStart + 8)
    let _textAddr = if textHeaderStart = 0x0 then 0x0 else seekReadInt32 pev (textHeaderStart + 12)
    let textSegmentPhysicalSize = if textHeaderStart = 0x0 then 0x0 else seekReadInt32 pev (textHeaderStart + 16)
    let textSegmentPhysicalLoc = if textHeaderStart = 0x0 then 0x0 else seekReadInt32 pev (textHeaderStart + 20)

    //let dataSegmentSize = if dataHeaderStart = 0x0 then 0x0 else seekReadInt32 pev (dataHeaderStart + 8)
    //let dataSegmentAddr = if dataHeaderStart = 0x0 then 0x0 else seekReadInt32 pev (dataHeaderStart + 12)
    let dataSegmentPhysicalSize = if dataHeaderStart = 0x0 then 0x0 else seekReadInt32 pev (dataHeaderStart + 16)
    let dataSegmentPhysicalLoc = if dataHeaderStart = 0x0 then 0x0 else seekReadInt32 pev (dataHeaderStart + 20)

    let anyV2P (n, v) = 
      let pev = pefile.GetView()
      let rec look i pos = 
        if i >= numSections then (failwith (fileName + ": bad "+n+", rva "+string v); 0x0)
        else
          let virtSize = seekReadInt32 pev (pos + 8)
          let virtAddr = seekReadInt32 pev (pos + 12)
          let physLoc = seekReadInt32 pev (pos + 20)
          if (v >= virtAddr && (v < virtAddr + virtSize)) then (v - virtAddr) + physLoc 
          else look (i+1) (pos + 0x28)
      look 0 sectionHeadersStartPhysLoc

    let cliHeaderPhysLoc = anyV2P ("cli header", cliHeaderAddr)

    let _majorRuntimeVersion = seekReadUInt16 pev (cliHeaderPhysLoc + 4)
    let _minorRuntimeVersion = seekReadUInt16 pev (cliHeaderPhysLoc + 6)
    let metadataAddr         = seekReadInt32 pev (cliHeaderPhysLoc + 8)
    let metadataSize         = seekReadInt32 pev (cliHeaderPhysLoc + 12)
    let cliFlags             = seekReadInt32 pev (cliHeaderPhysLoc + 16)
    
    let ilOnly             = (cliFlags &&& 0x01) <> 0x00
    let only32             = (cliFlags &&& 0x02) <> 0x00
    let is32bitpreferred   = (cliFlags &&& 0x00020003) <> 0x00
    let _strongnameSigned  = (cliFlags &&& 0x08) <> 0x00
    let _trackdebugdata     = (cliFlags &&& 0x010000) <> 0x00
    
    let entryPointToken = seekReadUncodedToken pev (cliHeaderPhysLoc + 20)
    let resourcesAddr     = seekReadInt32 pev (cliHeaderPhysLoc + 24)
    let resourcesSize     = seekReadInt32 pev (cliHeaderPhysLoc + 28)
    let strongnameAddr    = seekReadInt32 pev (cliHeaderPhysLoc + 32)
    let _strongnameSize    = seekReadInt32 pev (cliHeaderPhysLoc + 36)
    let vtableFixupsAddr = seekReadInt32 pev (cliHeaderPhysLoc + 40)
    let _vtableFixupsSize = seekReadInt32 pev (cliHeaderPhysLoc + 44)

    if logging then dprintn (fileName + ": metadataAddr = "+string metadataAddr) 
    if logging then dprintn (fileName + ": resourcesAddr = "+string resourcesAddr) 
    if logging then dprintn (fileName + ": resourcesSize = "+string resourcesSize) 
    if logging then dprintn (fileName + ": nativeResourcesAddr = "+string nativeResourcesAddr) 
    if logging then dprintn (fileName + ": nativeResourcesSize = "+string nativeResourcesSize) 

    let metadataPhysLoc = anyV2P ("metadata", metadataAddr)
L
latkin 已提交
3860 3861 3862
   //-----------------------------------------------------------------------
   // Set up the PDB reader so we can read debug info for methods.
   // ----------------------------------------------------------------------
3863
#if FX_NO_PDB_READER
3864
    let pdb = ignore pdbDirPath; None
L
latkin 已提交
3865
#else
3866 3867 3868 3869
    let pdb = 
        if runningOnMono then 
            None 
        else 
3870
            getPdbReader pdbDirPath fileName
L
latkin 已提交
3871 3872
#endif

3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893
    let pectxt : PEReader = 
        { pdb=pdb
          textSegmentPhysicalLoc=textSegmentPhysicalLoc 
          textSegmentPhysicalSize=textSegmentPhysicalSize
          dataSegmentPhysicalLoc=dataSegmentPhysicalLoc
          dataSegmentPhysicalSize=dataSegmentPhysicalSize
          anyV2P=anyV2P
          metadataAddr=metadataAddr
          sectionHeaders=sectionHeaders
          nativeResourcesAddr=nativeResourcesAddr
          nativeResourcesSize=nativeResourcesSize
          resourcesAddr=resourcesAddr
          strongnameAddr=strongnameAddr
          vtableFixupsAddr=vtableFixupsAddr
          pefile=pefile
          fileName=fileName
          entryPointToken=entryPointToken
        }
    let peinfo = (subsys, (subsysMajor, subsysMinor), useHighEnthropyVA, ilOnly, only32, is32bitpreferred, only64, platform, isDll, alignVirt, alignPhys, imageBaseReal)
    (metadataPhysLoc, metadataSize, peinfo, pectxt, pev, pdb)

3894 3895
let openPE (fileName, pefile, pdbDirPath, reduceMemoryUsage, ilGlobals) = 
    let (metadataPhysLoc, _metadataSize, peinfo, pectxt, pev, pdb) = openPEFileReader (fileName, pefile, pdbDirPath) 
3896
    let ilModule, ilAssemblyRefs = openMetadataReader (fileName, pefile, metadataPhysLoc, peinfo, pectxt, pev, Some pectxt, reduceMemoryUsage, ilGlobals)
D
Don Syme 已提交
3897
    ilModule, ilAssemblyRefs, pdb
L
latkin 已提交
3898

3899 3900 3901
let openPEMetadataOnly (fileName, peinfo, pectxtEager, pev, mdfile: BinaryFile, reduceMemoryUsage, ilGlobals) = 
    openMetadataReader (fileName, mdfile, 0, peinfo, pectxtEager, pev, None, reduceMemoryUsage, ilGlobals)
  
3902
let ClosePdbReader pdb =  
3903
#if FX_NO_PDB_READER
3904 3905
    ignore pdb
    ()
L
latkin 已提交
3906 3907
#else
    match pdb with 
D
Don Syme 已提交
3908
    | Some (pdbr, _) -> pdbReadClose pdbr
L
latkin 已提交
3909 3910 3911
    | None -> ()
#endif

3912 3913
type ILReaderMetadataSnapshot = (obj * nativeint * int) 
type ILReaderTryGetMetadataSnapshot = (* path: *) string * (* snapshotTimeStamp: *) System.DateTime -> ILReaderMetadataSnapshot option
L
latkin 已提交
3914

3915 3916 3917 3918 3919 3920 3921
[<RequireQualifiedAccess>]
type MetadataOnlyFlag = Yes | No

[<RequireQualifiedAccess>]
type ReduceMemoryFlag = Yes | No

type ILReaderOptions =
3922
    { pdbDirPath: string option
3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934
      ilGlobals: ILGlobals
      reduceMemoryUsage: ReduceMemoryFlag
      metadataOnly: MetadataOnlyFlag
      tryGetMetadataSnapshot: ILReaderTryGetMetadataSnapshot }

[<Sealed>]
type ILModuleReader(ilModule: ILModuleDef, ilAssemblyRefs: Lazy<ILAssemblyRef list>, dispose: unit -> unit) =
    member x.ILModuleDef = ilModule
    member x.ILAssemblyRefs = ilAssemblyRefs.Force()
    interface IDisposable with
        member x.Dispose() = dispose()
    
3935 3936
// ++GLOBAL MUTABLE STATE (concurrency safe via locking)
type ILModuleReaderCacheLockToken() = interface LockToken
3937 3938
type ILModuleReaderCacheKey = ILModuleReaderCacheKey of string * DateTime * ILScopeRef * bool * ReduceMemoryFlag * MetadataOnlyFlag
let ilModuleReaderCache = new AgedLookup<ILModuleReaderCacheLockToken, ILModuleReaderCacheKey, ILModuleReader>(stronglyHeldReaderCacheSize, areSimilar=(fun (x, y) -> x = y))
3939
let ilModuleReaderCacheLock = Lock()
L
latkin 已提交
3940

3941 3942 3943
let stableFileHeuristicApplies fileName = 
    not noStableFileHeuristic && try FileSystem.IsStableFileHeuristic fileName with _ -> false

3944
let createByteFileChunk opts fileName chunk = 
3945 3946 3947
    // If we're trying to reduce memory usage then we are willing to go back and re-read the binary, so we can use
    // a weakly-held handle to an array of bytes.
    if opts.reduceMemoryUsage = ReduceMemoryFlag.Yes && stableFileHeuristicApplies fileName then 
3948
        WeakByteFile(fileName, chunk) :> BinaryFile 
3949
    else 
3950 3951 3952 3953
        let bytes = 
            match chunk with 
            | None -> FileSystem.ReadAllBytesShim fileName
            | Some (start, length) -> File.ReadBinaryChunk(fileName, start, length)
3954 3955
        ByteFile(fileName, bytes) :> BinaryFile

3956
let tryMemoryMapWholeFile opts fileName = 
3957 3958 3959 3960
    let file = 
        try 
            MemoryMapFile.Create fileName :> BinaryFile
        with _ ->
3961
            createByteFileChunk opts fileName None
3962 3963 3964 3965 3966 3967 3968 3969 3970 3971
    let disposer = 
        { new IDisposable with 
           member __.Dispose() = 
            match file with 
            | :? MemoryMapFile as m -> m.Close() // Note that the PE file reader is not required after this point for metadata-only reading
            | _ -> () }
    disposer, file

let OpenILModuleReaderFromBytes fileName bytes opts = 
    let pefile = ByteFile(fileName, bytes) :> BinaryFile
3972
    let ilModule, ilAssemblyRefs, pdb = openPE (fileName, pefile, opts.pdbDirPath, (opts.reduceMemoryUsage = ReduceMemoryFlag.Yes), opts.ilGlobals)
3973 3974 3975
    new ILModuleReader(ilModule, ilAssemblyRefs, (fun () -> ClosePdbReader pdb))

let OpenILModuleReader fileName opts = 
L
latkin 已提交
3976
    // Pseudo-normalize the paths.
3977
    let (ILModuleReaderCacheKey (fullPath,writeStamp,_,_,_,_) as key), keyOk = 
D
Don Syme 已提交
3978
        try 
3979 3980
           let fullPath = FileSystem.GetFullPathShim(fileName)
           let writeTime = FileSystem.GetLastWriteTimeShim(fileName)
3981
           let key = ILModuleReaderCacheKey (fullPath, writeTime, opts.ilGlobals.primaryAssemblyScopeRef, opts.pdbDirPath.IsSome, opts.reduceMemoryUsage, opts.metadataOnly)
3982 3983 3984 3985 3986
           key, true
        with exn -> 
            System.Diagnostics.Debug.Assert(false, sprintf "Failed to compute key in OpenILModuleReader cache for '%s'. Falling back to uncached. Error = %s" fileName (exn.ToString())) 
            let fakeKey = ILModuleReaderCacheKey(fileName, System.DateTime.UtcNow, ILScopeRef.Local, false, ReduceMemoryFlag.Yes, MetadataOnlyFlag.Yes)
            fakeKey, false
D
Don Syme 已提交
3987

L
latkin 已提交
3988
    let cacheResult = 
3989
        if keyOk then 
3990
            if opts.pdbDirPath.IsSome then None // can't used a cached entry when reading PDBs, since it makes the returned object IDisposable
3991 3992 3993
            else ilModuleReaderCacheLock.AcquireLock (fun ltok -> ilModuleReaderCache.TryGet(ltok, key))
        else 
            None
D
Don Syme 已提交
3994

L
latkin 已提交
3995
    match cacheResult with 
3996
    | Some ilModuleReader -> ilModuleReader
L
latkin 已提交
3997
    | None -> 
3998 3999 4000 4001

    let reduceMemoryUsage = (opts.reduceMemoryUsage = ReduceMemoryFlag.Yes)
    let metadataOnly = (opts.metadataOnly = MetadataOnlyFlag.Yes) 

4002
    if reduceMemoryUsage && opts.pdbDirPath.IsNone then 
4003 4004 4005

        // This case is used in FCS applications, devenv.exe and fsi.exe
        //
L
latkin 已提交
4006
        let ilModuleReader = 
4007 4008 4009 4010 4011
            // Check if we are doing metadataOnly reading (the most common case in both the compiler and IDE)
            if metadataOnly then 

                // See if tryGetMetadata gives us a BinaryFile for the metadata section alone.
                let mdfileOpt = 
4012 4013
                    match opts.tryGetMetadataSnapshot (fullPath, writeStamp) with 
                    | Some (obj, start, len) -> Some (RawMemoryFile(fullPath, obj, start, len) :> BinaryFile)
4014 4015 4016 4017
                    | None  -> None

                // For metadata-only, always use a temporary, short-lived PE file reader, preferably over a memory mapped file.
                // Then use the metadata blob as the long-lived memory resource.
4018
                let disposer, pefileEager = tryMemoryMapWholeFile opts fullPath
4019
                use _disposer = disposer
4020
                let (metadataPhysLoc, metadataSize, peinfo, pectxtEager, pevEager, _pdb) = openPEFileReader (fullPath, pefileEager, None) 
4021 4022 4023 4024 4025
                let mdfile = 
                    match mdfileOpt with 
                    | Some mdfile -> mdfile
                    | None -> 
                        // If tryGetMetadata doesn't give anything, then just read the metadata chunk out of the binary
4026
                        createByteFileChunk opts fullPath (Some (metadataPhysLoc, metadataSize))
4027

4028
                let ilModule, ilAssemblyRefs = openPEMetadataOnly (fullPath, peinfo, pectxtEager, pevEager, mdfile, reduceMemoryUsage, opts.ilGlobals) 
4029 4030 4031 4032
                new ILModuleReader(ilModule, ilAssemblyRefs, ignore)
            else
                // If we are not doing metadata-only, then just go ahead and read all the bytes and hold them either strongly or weakly
                // depending on the heuristic
4033 4034
                let pefile = createByteFileChunk opts fullPath None
                let ilModule, ilAssemblyRefs, _pdb = openPE (fullPath, pefile, None, reduceMemoryUsage, opts.ilGlobals) 
4035 4036 4037
                new ILModuleReader(ilModule, ilAssemblyRefs, ignore)

        if keyOk then 
4038
            ilModuleReaderCacheLock.AcquireLock (fun ltok -> ilModuleReaderCache.Put(ltok, key, ilModuleReader))
L
latkin 已提交
4039 4040

        ilModuleReader
4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053
                
    else
        // This case is primarily used in fsc.exe. 
        //
        // In fsc.exe, we're not trying to reduce memory usage, nor do we really care if we leak memory.  
        //
        // Note we ignore the "metadata only" flag as it's generally OK to read in the
        // whole binary for the command-line compiler: address space is rarely an issue.
        //
        // We do however care about avoiding locks on files that prevent their deletion during a 
        // multi-proc build. So use memory mapping, but only for stable files.  Other files
        // fill use an in-memory ByteFile
        let _disposer, pefile = 
4054 4055
            if alwaysMemoryMapFSC || stableFileHeuristicApplies fullPath then 
                tryMemoryMapWholeFile opts fullPath
4056
            else
4057
                let pefile = createByteFileChunk opts fullPath None
4058 4059 4060
                let disposer = { new IDisposable with member __.Dispose() = () }
                disposer, pefile

4061
        let ilModule, ilAssemblyRefs, pdb = openPE (fullPath, pefile, opts.pdbDirPath, reduceMemoryUsage, opts.ilGlobals)
4062 4063 4064
        let ilModuleReader = new ILModuleReader(ilModule, ilAssemblyRefs, (fun () -> ClosePdbReader pdb))

        // Readers with PDB reader disposal logic don't go in the cache.  Note the PDB reader is only used in static linking.
4065
        if keyOk && opts.pdbDirPath.IsNone then 
4066
            ilModuleReaderCacheLock.AcquireLock (fun ltok -> ilModuleReaderCache.Put(ltok, key, ilModuleReader))
L
latkin 已提交
4067

4068
        ilModuleReader
L
latkin 已提交
4069 4070 4071