ilread.fs 199.9 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
//
//---------------------------------------------------------------------

D
Don Syme 已提交
8
module 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
D
Don Syme 已提交
20 21
open FSharp.Compiler.AbstractIL 
open FSharp.Compiler.AbstractIL.Internal 
D
Don Syme 已提交
22
#if !FX_NO_PDB_READER
D
Don Syme 已提交
23
open FSharp.Compiler.AbstractIL.Internal.Support 
L
latkin 已提交
24
#endif
D
Don Syme 已提交
25 26 27 28 29 30
open FSharp.Compiler.AbstractIL.Diagnostics 
open FSharp.Compiler.AbstractIL.Internal.BinaryConstants 
open FSharp.Compiler.AbstractIL.IL  
open FSharp.Compiler.AbstractIL.Internal.Library
open FSharp.Compiler.ErrorLogger
open FSharp.Compiler.Range
L
latkin 已提交
31
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
    noFileOnDisk:bool
1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081
}

[<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 已提交
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 1126
    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
1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142
    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 已提交
1143
   
D
Don Syme 已提交
1144

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

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

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

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


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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

W
WilliamBerryiii 已提交
1442
/// Read Table ManifestResource.
1443
let seekReadManifestResourceRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1444
    let mutable addr = ctxt.rowAddr TableNames.ManifestResource idx
1445 1446 1447 1448
    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 已提交
1449
    (offset, flags, nameIdx, implIdx) 
L
latkin 已提交
1450

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

W
WilliamBerryiii 已提交
1461
/// Read Table GenericParam.
1462
let seekReadGenericParamRow (ctxt: ILMetadataReader)  mdv idx =
D
Don Syme 已提交
1463
    let mutable addr = ctxt.rowAddr TableNames.GenericParam idx
1464 1465 1466 1467
    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 已提交
1468
    (idx, seq, flags, ownerIdx, nameIdx) 
L
latkin 已提交
1469

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

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

D
Don Syme 已提交
1484

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

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

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

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

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

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

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

1515
//let readGuidHeap ctxt idx = seekReadGuid ctxt.mdv (ctxt.guidsStreamPhysicalLoc + idx) 
L
latkin 已提交
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 1546

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

1547 1548 1549 1550
// noFileOnDisk indicates that the PE file was read from Memory using OpenILModuleReaderFromBytes
// For example the assembly came from a type provider
// In this case we eagerly read the native resources into memory
let readNativeResources (pectxt: PEReader) = 
1551
    [ if pectxt.nativeResourcesSize <> 0x0  && pectxt.nativeResourcesAddr <> 0x0 then 
1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565
        let start = pectxt.anyV2P (pectxt.fileName + ": native resources", pectxt.nativeResourcesAddr)
        if pectxt.noFileOnDisk then
#if !FX_NO_LINKEDRESOURCES
            let unlinkedResource =
                let linkedResource = seekReadBytes (pectxt.pefile.GetView()) start pectxt.nativeResourcesSize
                unlinkResource pectxt.nativeResourcesAddr linkedResource
            yield ILNativeResource.Out unlinkedResource
#else
            ()
#endif
        else
            yield ILNativeResource.In (pectxt.fileName, pectxt.nativeResourcesAddr, start, pectxt.nativeResourcesSize ) ]


1566
let getDataEndPointsDelayed (pectxt: PEReader) ctxtH = 
L
latkin 已提交
1567
    lazy
1568 1569
        let (ctxt: ILMetadataReader)  = getHole ctxtH
        let mdv = ctxt.mdfile.GetView()
L
latkin 已提交
1570 1571 1572
        let dataStartPoints = 
            let res = ref []
            for i = 1 to ctxt.getNumRows (TableNames.FieldRVA) do
1573
                let rva, _fidx = seekReadFieldRVARow ctxt mdv i
D
Don Syme 已提交
1574
                res := ("field", rva) :: !res
L
latkin 已提交
1575
            for i = 1 to ctxt.getNumRows TableNames.ManifestResource do
1576
                let (offset, _, _, TaggedIndex(_tag, idx)) = seekReadManifestResourceRow ctxt mdv i
L
latkin 已提交
1577
                if idx = 0 then 
1578
                  let rva = pectxt.resourcesAddr + offset
D
Don Syme 已提交
1579
                  res := ("manifest resource", rva) :: !res
L
latkin 已提交
1580
            !res
D
Don Syme 已提交
1581
        if isNil dataStartPoints then [] 
L
latkin 已提交
1582 1583 1584 1585
        else
          let methodRVAs = 
              let res = ref []
              for i = 1 to ctxt.getNumRows TableNames.Method do
1586
                  let (rva, _, _, nameIdx, _, _) = seekReadMethodRow ctxt mdv i
L
latkin 已提交
1587 1588
                  if rva <> 0 then 
                     let nm = readStringHeap ctxt nameIdx
D
Don Syme 已提交
1589
                     res := (nm, rva) :: !res
L
latkin 已提交
1590
              !res
1591 1592
          ([ pectxt.textSegmentPhysicalLoc + pectxt.textSegmentPhysicalSize ; 
             pectxt.dataSegmentPhysicalLoc + pectxt.dataSegmentPhysicalSize ] 
L
latkin 已提交
1593
           @ 
1594
           (List.map pectxt.anyV2P 
L
latkin 已提交
1595
              (dataStartPoints 
1596 1597 1598 1599 1600 1601
                @ [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 已提交
1602
                @ methodRVAs)))
S
Steffen Forkmann 已提交
1603
           |> List.distinct
L
latkin 已提交
1604 1605 1606
           |> List.sort 
      

1607
let rvaToData (ctxt: ILMetadataReader) (pectxt: PEReader) nm rva = 
D
Don Syme 已提交
1608
    if rva = 0x0 then failwith "rva is zero"
1609
    let start = pectxt.anyV2P (nm, rva)
L
latkin 已提交
1610 1611 1612 1613
    let endPoints = (Lazy.force ctxt.dataEndPoints)
    let rec look l = 
        match l with 
        | [] -> 
1614
            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 已提交
1615 1616
        | e::t -> 
           if start < e then 
1617 1618
             let pev = pectxt.pefile.GetView()
             seekReadBytes pev start (e - start)
L
latkin 已提交
1619 1620 1621 1622 1623 1624 1625 1626
           else look t
    look endPoints

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

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

1629 1630 1631 1632 1633
// 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 已提交
1634
    let ilModuleName = readStringHeap ctxt nameIdx
1635
    let nativeResources = readNativeResources pectxtEager
L
latkin 已提交
1636

K
KevinRansom 已提交
1637
    { Manifest =
1638
         if ctxt.getNumRows (TableNames.Assembly) > 0 then Some (seekReadAssemblyManifest ctxt pectxtEager 1) 
D
Don Syme 已提交
1639
         else None
1640 1641
      CustomAttrsStored = ctxt.customAttrsReader_Module
      MetadataIndex = idx
D
Don Syme 已提交
1642 1643
      Name = ilModuleName
      NativeResources=nativeResources
1644
      TypeDefs = mkILTypeDefsComputed (fun () -> seekReadTopTypeDefs ctxt)
D
Don Syme 已提交
1645 1646
      SubSystemFlags = int32 subsys
      IsILOnly = ilOnly
L
latkin 已提交
1647 1648
      SubsystemVersion = subsysversion
      UseHighEntropyVA = useHighEntropyVA
D
Don Syme 已提交
1649 1650 1651 1652 1653 1654 1655 1656 1657 1658
      Platform = platform
      StackReserveSize = None  // TODO
      Is32Bit = only32
      Is32BitPreferred = is32bitpreferred
      Is64Bit = only64
      IsDLL=isDll
      VirtualAlignment = alignVirt
      PhysicalAlignment = alignPhys
      ImageBase = imageBaseReal
      MetadataVersion = ilMetadataVersion
1659
      Resources = seekReadManifestResources ctxt mdv pectxtEager pevEager }  
L
latkin 已提交
1660

1661 1662 1663
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 已提交
1664 1665
    let name = readStringHeap ctxt nameIdx
    let pubkey = readBlobHeapOption ctxt publicKeyIdx
D
Don Syme 已提交
1666 1667
    { Name= name 
      AuxModuleHashAlgorithm=hash
1668
      SecurityDeclsStored= ctxt.securityDeclsReader_Assembly
D
Don Syme 已提交
1669
      PublicKey= pubkey  
D
Don Syme 已提交
1670
      Version= Some (v1, v2, v3, v4)
D
Don Syme 已提交
1671
      Locale= readStringHeapOption ctxt localeIdx
1672 1673
      CustomAttrsStored = ctxt.customAttrsReader_Assembly
      MetadataIndex = idx
1674
      AssemblyLongevity = 
1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685
        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 已提交
1686 1687
      Retargetable = 0 <> (flags &&& 0x100)
      DisableJitOptimizations = 0 <> (flags &&& 0x4000)
1688 1689 1690
      JitTracking = 0 <> (flags &&& 0x8000) 
      IgnoreSymbolStoreSequencePoints = 0 <> (flags &&& 0x2000) } 

1691
and seekReadAssemblyRef (ctxt: ILMetadataReader)  idx = ctxt.seekReadAssemblyRef idx
L
latkin 已提交
1692
and seekReadAssemblyRefUncached ctxtH idx = 
1693 1694 1695
    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 已提交
1696 1697 1698 1699 1700 1701 1702 1703 1704
    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 已提交
1705
         publicKey=publicKey, 
L
latkin 已提交
1706
         retargetable=((flags &&& 0x0100) <> 0x0), 
D
Don Syme 已提交
1707
         version=Some(v1, v2, v3, v4), 
D
Don Syme 已提交
1708
         locale=readStringHeapOption ctxt localeIdx)
L
latkin 已提交
1709

1710 1711 1712
and seekReadModuleRef (ctxt: ILMetadataReader)  mdv idx =
    let (nameIdx) = seekReadModuleRefRow ctxt mdv idx
    ILModuleRef.Create(name =  readStringHeap ctxt nameIdx, hasMetadata=true, hash=None)
L
latkin 已提交
1713

1714 1715 1716
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 已提交
1717

1718 1719
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 已提交
1720
    | None -> { Size = None; Pack = None }
D
Don Syme 已提交
1721
    | Some (pack, size) -> { Size = Some size; Pack = Some pack }
L
latkin 已提交
1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733

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

1734
and typeLayoutOfFlags (ctxt: ILMetadataReader)  mdv flags tidx = 
L
latkin 已提交
1735
    let f = (flags &&& 0x00000018)
1736 1737
    if f = 0x00000008 then ILTypeDefLayout.Sequential (seekReadClassLayout ctxt mdv tidx)
    elif f = 0x00000010 then  ILTypeDefLayout.Explicit (seekReadClassLayout ctxt mdv tidx)
L
latkin 已提交
1738 1739 1740 1741 1742 1743 1744
    else ILTypeDefLayout.Auto

and isTopTypeDef flags =
    (typeAccessOfFlags flags =  ILTypeDefAccess.Private) ||
     typeAccessOfFlags flags =  ILTypeDefAccess.Public
       
and seekIsTopTypeDefOfIdx ctxt idx =
D
Don Syme 已提交
1745
    let (flags, _, _, _, _, _) = seekReadTypeDefRow ctxt idx
L
latkin 已提交
1746 1747
    isTopTypeDef flags
       
D
Don Syme 已提交
1748
and readBlobHeapAsSplitTypeName ctxt (nameIdx, namespaceIdx) = 
L
latkin 已提交
1749 1750 1751
    let name = readStringHeap ctxt nameIdx
    let nspace = readStringHeapOption ctxt namespaceIdx
    match nspace with 
D
Don Syme 已提交
1752 1753
    | Some nspace -> splitNamespace nspace, name  
    | None -> [], name
L
latkin 已提交
1754

D
Don Syme 已提交
1755
and readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) = 
L
latkin 已提交
1756 1757 1758 1759 1760 1761
    let name = readStringHeap ctxt nameIdx
    let nspace = readStringHeapOption ctxt namespaceIdx
    match nspace with 
    | None -> name  
    | Some ns -> ctxt.memoizeString (ns+"."+name)

1762
and seekReadTypeDefRowExtents (ctxt: ILMetadataReader)  _info (idx:int) =
L
latkin 已提交
1763
    if idx >= ctxt.getNumRows TableNames.TypeDef then 
D
Don Syme 已提交
1764
        ctxt.getNumRows TableNames.Field + 1, 
L
latkin 已提交
1765 1766 1767 1768 1769 1770 1771
        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 已提交
1772
    info, seekReadTypeDefRowExtents ctxt info idx
L
latkin 已提交
1773

1774
and seekReadPreTypeDef ctxt toponly (idx:int) =
D
Don Syme 已提交
1775
    let (flags, nameIdx, namespaceIdx, _, _, _) = seekReadTypeDefRow ctxt idx
L
latkin 已提交
1776 1777
    if toponly && not (isTopTypeDef flags) then None
    else
D
Don Syme 已提交
1778
     let ns, n = readBlobHeapAsSplitTypeName ctxt (nameIdx, namespaceIdx)
1779 1780
     // Return the ILPreTypeDef
     Some (mkILPreTypeDefRead (ns, n, idx, ctxt.typeDefReader))
L
latkin 已提交
1781

1782 1783 1784 1785
and typeDefReader ctxtH : ILTypeDefStored =
  mkILTypeDefReader
    (fun idx -> 
           let (ctxt: ILMetadataReader) = getHole ctxtH
1786
           let mdv = ctxt.mdfile.GetView()
1787
           // Re-read so as not to save all these in the lazy closure - this suspension ctxt.is the largest 
L
latkin 已提交
1788
           // heavily allocated one in all of AbsIL
1789

D
Don Syme 已提交
1790 1791
           let ((flags, nameIdx, namespaceIdx, extendsIdx, fieldsIdx, methodsIdx) as info) = seekReadTypeDefRow ctxt idx
           let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx)
L
latkin 已提交
1792
           let (endFieldsIdx, endMethodsIdx) = seekReadTypeDefRowExtents ctxt info idx
D
Don Syme 已提交
1793
           let typars = seekReadGenericParams ctxt 0 (tomd_TypeDef, idx)
L
latkin 已提交
1794 1795
           let numtypars = typars.Length
           let super = seekReadOptionalTypeDefOrRef ctxt numtypars AsObject extendsIdx
1796
           let layout = typeLayoutOfFlags ctxt mdv flags idx
L
latkin 已提交
1797 1798
           let hasLayout = (match layout with ILTypeDefLayout.Explicit _ -> true | _ -> false)
           let mdefs = seekReadMethods ctxt numtypars methodsIdx endMethodsIdx
D
Don Syme 已提交
1799
           let fdefs = seekReadFields ctxt (numtypars, hasLayout) fieldsIdx endFieldsIdx
L
latkin 已提交
1800
           let nested = seekReadNestedTypeDefs ctxt idx 
1801
           let impls  = seekReadInterfaceImpls ctxt mdv numtypars idx
L
latkin 已提交
1802 1803 1804
           let mimpls = seekReadMethodImpls ctxt numtypars idx
           let props  = seekReadProperties ctxt numtypars idx
           let events = seekReadEvents ctxt numtypars idx
D
Don Syme 已提交
1805 1806 1807 1808 1809 1810 1811 1812
           ILTypeDef(name=nm,
                     genericParams=typars ,
                     attributes= enum<TypeAttributes>(flags),
                     layout = layout,
                     nestedTypes= nested,
                     implements = impls,
                     extends = super,
                     methods = mdefs,
1813
                     securityDeclsStored = ctxt.securityDeclsReader_TypeDef,
D
Don Syme 已提交
1814 1815 1816 1817
                     fields=fdefs,
                     methodImpls=mimpls,
                     events= events,
                     properties=props,
1818 1819 1820
                     customAttrsStored=ctxt.customAttrsReader_TypeDef,
                     metadataIndex=idx)
    )
L
latkin 已提交
1821

1822
and seekReadTopTypeDefs (ctxt: ILMetadataReader)  =
1823
    [| for i = 1 to ctxt.getNumRows TableNames.TypeDef do
1824
          match seekReadPreTypeDef ctxt true i  with 
L
latkin 已提交
1825
          | None -> ()
1826
          | Some td -> yield td |]
L
latkin 已提交
1827

1828
and seekReadNestedTypeDefs (ctxt: ILMetadataReader)  tidx =
1829
    mkILTypeDefsComputed (fun () -> 
D
Don Syme 已提交
1830
           let nestedIdxs = seekReadIndexedRows (ctxt.getNumRows TableNames.Nested, seekReadNestedRow ctxt, snd, simpleIndexCompare tidx, false, fst)
1831
           [| for i in nestedIdxs do 
1832
                 match seekReadPreTypeDef ctxt false i with 
L
latkin 已提交
1833
                 | None -> ()
1834
                 | Some td -> yield td |])
L
latkin 已提交
1835

1836
and seekReadInterfaceImpls (ctxt: ILMetadataReader)  mdv numtypars tidx =
D
Don Syme 已提交
1837
    seekReadIndexedRows (ctxt.getNumRows TableNames.InterfaceImpl, 
1838 1839 1840 1841 1842
                         seekReadInterfaceImplRow ctxt mdv, 
                         fst, 
                         simpleIndexCompare tidx, 
                         isSorted ctxt TableNames.InterfaceImpl, 
                         (snd >> seekReadTypeDefOrRef ctxt numtypars AsObject (*ok*) List.empty)) 
L
latkin 已提交
1843

D
Don Syme 已提交
1844 1845
and seekReadGenericParams ctxt numtypars (a, b) : ILGenericParameterDefs = 
    ctxt.seekReadGenericParams (GenericParamsIdx(numtypars, a, b))
L
latkin 已提交
1846

D
Don Syme 已提交
1847
and seekReadGenericParamsUncached ctxtH (GenericParamsIdx(numtypars, a, b)) =
1848 1849
    let (ctxt: ILMetadataReader)  = getHole ctxtH
    let mdv = ctxt.mdfile.GetView()
L
latkin 已提交
1850 1851
    let pars =
        seekReadIndexedRows
1852
            (ctxt.getNumRows TableNames.GenericParam, seekReadGenericParamRow ctxt mdv, 
D
Don Syme 已提交
1853 1854 1855 1856
             (fun (_, _, _, tomd, _) -> tomd), 
             tomdCompare (TaggedIndex(a, b)), 
             isSorted ctxt TableNames.GenericParam, 
             (fun (gpidx, seq, flags, _, nameIdx) -> 
L
latkin 已提交
1857 1858 1859 1860 1861 1862 1863
                 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
1864
                 let constraints = seekReadGenericParamConstraints ctxt mdv numtypars gpidx
D
Don Syme 已提交
1865
                 seq, {Name=readStringHeap ctxt nameIdx
1866
                       Constraints = constraints
D
Don Syme 已提交
1867
                       Variance=variance  
1868 1869
                       CustomAttrsStored = ctxt.customAttrsReader_GenericParam
                       MetadataIndex=gpidx
D
Don Syme 已提交
1870 1871 1872
                       HasReferenceTypeConstraint= (flags &&& 0x0004) <> 0
                       HasNotNullableValueTypeConstraint= (flags &&& 0x0008) <> 0
                       HasDefaultConstructorConstraint=(flags &&& 0x0010) <> 0 }))
L
latkin 已提交
1873 1874
    pars |> List.sortBy fst |> List.map snd 

1875
and seekReadGenericParamConstraints (ctxt: ILMetadataReader)  mdv numtypars gpidx =
L
latkin 已提交
1876
    seekReadIndexedRows 
D
Don Syme 已提交
1877
        (ctxt.getNumRows TableNames.GenericParamConstraint, 
1878
         seekReadGenericParamConstraintRow ctxt mdv, 
D
Don Syme 已提交
1879 1880 1881
         fst, 
         simpleIndexCompare gpidx, 
         isSorted ctxt TableNames.GenericParamConstraint, 
1882
         (snd >>  seekReadTypeDefOrRef ctxt numtypars AsObject (*ok*) List.empty))
L
latkin 已提交
1883

1884
and seekReadTypeDefAsType (ctxt: ILMetadataReader)  boxity (ginst:ILTypes) idx =
D
Don Syme 已提交
1885
      ctxt.seekReadTypeDefAsType (TypeDefAsTypIdx (boxity, ginst, idx))
L
latkin 已提交
1886

D
Don Syme 已提交
1887
and seekReadTypeDefAsTypeUncached ctxtH (TypeDefAsTypIdx (boxity, ginst, idx)) =
L
latkin 已提交
1888 1889 1890
    let ctxt = getHole ctxtH
    mkILTy boxity (ILTypeSpec.Create(seekReadTypeDefAsTypeRef ctxt idx, ginst))

1891
and seekReadTypeDefAsTypeRef (ctxt: ILMetadataReader)  idx =
L
latkin 已提交
1892 1893 1894
     let enc = 
       if seekIsTopTypeDefOfIdx ctxt idx then [] 
       else 
D
Don Syme 已提交
1895
         let enclIdx = seekReadIndexedRow (ctxt.getNumRows TableNames.Nested, seekReadNestedRow ctxt, fst, simpleIndexCompare idx, isSorted ctxt TableNames.Nested, snd)
L
latkin 已提交
1896 1897 1898
         let tref = seekReadTypeDefAsTypeRef ctxt enclIdx
         tref.Enclosing@[tref.Name]
     let (_, nameIdx, namespaceIdx, _, _, _) = seekReadTypeDefRow ctxt idx
D
Don Syme 已提交
1899
     let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx)
L
latkin 已提交
1900 1901
     ILTypeRef.Create(scope=ILScopeRef.Local, enclosing=enc, name = nm )

1902
and seekReadTypeRef (ctxt: ILMetadataReader)  idx = ctxt.seekReadTypeRef idx
L
latkin 已提交
1903
and seekReadTypeRefUncached ctxtH idx =
1904 1905 1906 1907
     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 已提交
1908
     let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx)
L
latkin 已提交
1909 1910
     ILTypeRef.Create(scope=scope, enclosing=enc, name = nm) 

1911
and seekReadTypeRefAsType (ctxt: ILMetadataReader)  boxity ginst idx = ctxt.seekReadTypeRefAsType (TypeRefAsTypIdx (boxity, ginst, idx))
D
Don Syme 已提交
1912
and seekReadTypeRefAsTypeUncached ctxtH (TypeRefAsTypIdx (boxity, ginst, idx)) =
L
latkin 已提交
1913 1914 1915
     let ctxt = getHole ctxtH
     mkILTy boxity (ILTypeSpec.Create(seekReadTypeRef ctxt idx, ginst))

1916 1917
and seekReadTypeDefOrRef (ctxt: ILMetadataReader)  numtypars boxity (ginst:ILTypes) (TaggedIndex(tag, idx) ) =
    let mdv = ctxt.mdfile.GetView()
L
latkin 已提交
1918 1919 1920 1921
    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 -> 
1922
        if not (List.isEmpty ginst) then dprintn ("type spec used as type constructor for a generic instantiation: ignoring instantiation")
1923
        readBlobHeapAsType ctxt numtypars (seekReadTypeSpecRow ctxt mdv idx)
L
latkin 已提交
1924 1925
    | _ -> failwith "seekReadTypeDefOrRef ctxt"

1926
and seekReadTypeDefOrRefAsTypeRef (ctxt: ILMetadataReader)  (TaggedIndex(tag, idx) ) =
L
latkin 已提交
1927 1928 1929 1930
    match tag with 
    | tag when tag = tdor_TypeDef -> seekReadTypeDefAsTypeRef ctxt idx
    | tag when tag = tdor_TypeRef -> seekReadTypeRef ctxt idx
    | tag when tag = tdor_TypeSpec -> 
1931
        dprintn ("type spec used where a type ref or def is required")
1932
        ctxt.ilg.typ_Object.TypeRef
L
latkin 已提交
1933 1934
    | _ -> failwith "seekReadTypeDefOrRefAsTypeRef_readTypeDefOrRefOrSpec"

1935
and seekReadMethodRefParent (ctxt: ILMetadataReader)  mdv numtypars (TaggedIndex(tag, idx)) =
L
latkin 已提交
1936
    match tag with 
1937 1938
    | 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 已提交
1939
    | tag when tag = mrp_MethodDef -> 
1940 1941
        let (MethodData(enclTy, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData ctxt idx
        let mspec = mkILMethSpecInTy (enclTy, cc, nm, argtys, retty, minst)
1942
        mspec.DeclaringType
1943 1944
    | tag when tag = mrp_TypeSpec -> readBlobHeapAsType ctxt numtypars (seekReadTypeSpecRow ctxt mdv idx)
    | _ -> failwith "seekReadMethodRefParent"
L
latkin 已提交
1945

1946
and seekReadMethodDefOrRef (ctxt: ILMetadataReader)  numtypars (TaggedIndex(tag, idx)) =
L
latkin 已提交
1947 1948
    match tag with 
    | tag when tag = mdor_MethodDef -> 
1949 1950
        let (MethodData(enclTy, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData ctxt idx
        VarArgMethodData(enclTy, cc, nm, argtys, None, retty, minst)
L
latkin 已提交
1951 1952
    | tag when tag = mdor_MemberRef -> 
        seekReadMemberRefAsMethodData ctxt numtypars idx
1953
    | _ -> failwith "seekReadMethodDefOrRef"
L
latkin 已提交
1954

1955
and seekReadMethodDefOrRefNoVarargs (ctxt: ILMetadataReader)  numtypars x =
1956
     let (VarArgMethodData(enclTy, cc, nm, argtys, varargs, retty, minst)) =     seekReadMethodDefOrRef ctxt numtypars x 
D
Don Syme 已提交
1957
     if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef token signature"
1958
     MethodData(enclTy, cc, nm, argtys, retty, minst)
L
latkin 已提交
1959

1960
and seekReadCustomAttrType (ctxt: ILMetadataReader)  (TaggedIndex(tag, idx) ) =
L
latkin 已提交
1961 1962
    match tag with 
    | tag when tag = cat_MethodDef -> 
1963 1964
        let (MethodData(enclTy, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData ctxt idx
        mkILMethSpecInTy (enclTy, cc, nm, argtys, retty, minst)
L
latkin 已提交
1965
    | tag when tag = cat_MemberRef -> 
1966 1967
        let (MethodData(enclTy, cc, nm, argtys, retty, minst)) = seekReadMemberRefAsMethDataNoVarArgs ctxt 0 idx
        mkILMethSpecInTy (enclTy, cc, nm, argtys, retty, minst)
L
latkin 已提交
1968 1969
    | _ -> failwith "seekReadCustomAttrType ctxt"
    
1970
and seekReadImplAsScopeRef (ctxt: ILMetadataReader)  mdv (TaggedIndex(tag, idx) ) =
L
latkin 已提交
1971 1972 1973
     if idx = 0 then ILScopeRef.Local
     else 
       match tag with 
1974
       | tag when tag = i_File -> ILScopeRef.Module (seekReadFile ctxt mdv idx)
L
latkin 已提交
1975
       | tag when tag = i_AssemblyRef -> ILScopeRef.Assembly (seekReadAssemblyRef ctxt idx)
1976 1977
       | tag when tag = i_ExportedType -> failwith "seekReadImplAsScopeRef"
       | _ -> failwith "seekReadImplAsScopeRef"
L
latkin 已提交
1978

1979
and seekReadTypeRefScope (ctxt: ILMetadataReader)  mdv (TaggedIndex(tag, idx) ) =
L
latkin 已提交
1980
    match tag with 
D
Don Syme 已提交
1981
    | tag when tag = rs_Module -> ILScopeRef.Local, []
1982
    | tag when tag = rs_ModuleRef -> ILScopeRef.Module (seekReadModuleRef ctxt mdv idx), []
D
Don Syme 已提交
1983
    | tag when tag = rs_AssemblyRef -> ILScopeRef.Assembly (seekReadAssemblyRef ctxt idx), []
L
latkin 已提交
1984 1985
    | tag when tag = rs_TypeRef -> 
        let tref = seekReadTypeRef ctxt idx
D
Don Syme 已提交
1986
        tref.Scope, (tref.Enclosing@[tref.Name])
1987
    | _ -> failwith "seekReadTypeRefScope"
L
latkin 已提交
1988

1989
and seekReadOptionalTypeDefOrRef (ctxt: ILMetadataReader)  numtypars boxity idx = 
L
latkin 已提交
1990
    if idx = TaggedIndex(tdor_TypeDef, 0) then None
1991
    else Some (seekReadTypeDefOrRef ctxt numtypars boxity List.empty idx)
L
latkin 已提交
1992

1993 1994
and seekReadField ctxt mdv (numtypars, hasLayout) (idx:int) =
    let (flags, nameIdx, typeIdx) = seekReadFieldRow ctxt mdv idx
D
Don Syme 已提交
1995 1996 1997 1998 1999 2000 2001 2002 2003 2004
    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 
2005
                       Some (seekReadIndexedRow (ctxt.getNumRows TableNames.FieldMarshal, seekReadFieldMarshalRow ctxt mdv, 
D
Don Syme 已提交
2006 2007 2008 2009 2010 2011 2012
                                                 fst, hfmCompare (TaggedIndex(hfm_FieldDef, idx)), 
                                                 isSorted ctxt TableNames.FieldMarshal, 
                                                 (snd >> readBlobHeapAsNativeType ctxt)))),
               data = 
                   (if (flags &&& 0x0100) = 0 then 
                       None 
                    else 
2013 2014 2015 2016 2017 2018
                        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 已提交
2019 2020
               offset = 
                   (if hasLayout && not isStatic then 
2021
                       Some (seekReadIndexedRow (ctxt.getNumRows TableNames.FieldLayout, seekReadFieldLayoutRow ctxt mdv, 
D
Don Syme 已提交
2022
                                               snd, simpleIndexCompare idx, isSorted ctxt TableNames.FieldLayout, fst)) else None), 
2023 2024 2025
               customAttrsStored=ctxt.customAttrsReader_FieldDef,
               metadataIndex = idx)
     
2026
and seekReadFields (ctxt: ILMetadataReader)  (numtypars, hasLayout) fidx1 fidx2 =
L
latkin 已提交
2027 2028
    mkILFieldsLazy 
       (lazy
2029
           let mdv = ctxt.mdfile.GetView()
L
latkin 已提交
2030
           [ for i = fidx1 to fidx2 - 1 do
2031
               yield seekReadField ctxt mdv (numtypars, hasLayout) i ])
L
latkin 已提交
2032

2033
and seekReadMethods (ctxt: ILMetadataReader)  numtypars midx1 midx2 =
2034
    mkILMethodsComputed (fun () -> 
2035
           let mdv = ctxt.mdfile.GetView()
2036
           [| for i = midx1 to midx2 - 1 do
2037
                 yield seekReadMethod ctxt mdv numtypars i |])
L
latkin 已提交
2038 2039 2040 2041

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

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

2133
and sigptrGetArgTys (ctxt: ILMetadataReader)  n numtypars bytes sigptr acc = 
D
Don Syme 已提交
2134
    if n <= 0 then (List.rev acc, None), sigptr 
L
latkin 已提交
2135
    else
D
Don Syme 已提交
2136
      let b0, sigptr2 = sigptrGetByte bytes sigptr
L
latkin 已提交
2137
      if b0 = et_SENTINEL then 
D
Don Syme 已提交
2138 2139
        let varargs, sigptr = sigptrGetVarArgTys ctxt n numtypars bytes sigptr2
        (List.rev acc, Some(varargs)), sigptr
L
latkin 已提交
2140
      else
D
Don Syme 已提交
2141
        let x, sigptr = sigptrGetTy ctxt numtypars bytes sigptr
L
latkin 已提交
2142 2143
        sigptrGetArgTys ctxt (n-1) numtypars bytes sigptr (x::acc)
         
2144
and sigptrGetLocal (ctxt: ILMetadataReader)  numtypars bytes sigptr = 
D
Don Syme 已提交
2145
    let pinned, sigptr = 
L
latkin 已提交
2146 2147 2148 2149 2150
        let b0, sigptr' = sigptrGetByte bytes sigptr
        if b0 = et_PINNED then 
            true, sigptr'
        else 
            false, sigptr
2151 2152
    let ty, sigptr = sigptrGetTy ctxt numtypars bytes sigptr
    let loc : ILLocal = { IsPinned = pinned; Type = ty; DebugInfo = None }
D
Don Syme 已提交
2153
    loc, sigptr
L
latkin 已提交
2154
         
2155
and readBlobHeapAsMethodSig (ctxt: ILMetadataReader)  numtypars blobIdx  =
D
Don Syme 已提交
2156
    ctxt.readBlobHeapAsMethodSig (BlobAsMethodSigIdx (numtypars, blobIdx))
L
latkin 已提交
2157

D
Don Syme 已提交
2158
and readBlobHeapAsMethodSigUncached ctxtH (BlobAsMethodSigIdx (numtypars, blobIdx)) =
2159
    let (ctxt: ILMetadataReader)  = getHole ctxtH
L
latkin 已提交
2160 2161
    let bytes = readBlobHeap ctxt blobIdx
    let sigptr = 0
D
Don Syme 已提交
2162 2163 2164 2165 2166
    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
2167
    let (argtys, varargs), _sigptr = sigptrGetArgTys ctxt numparams numtypars bytes sigptr []
D
Don Syme 已提交
2168
    generic, genarity, cc, retty, argtys, varargs
L
latkin 已提交
2169 2170 2171
      
and readBlobHeapAsType ctxt numtypars blobIdx = 
    let bytes = readBlobHeap ctxt blobIdx
D
Don Syme 已提交
2172
    let ty, _sigptr = sigptrGetTy ctxt numtypars bytes 0
L
latkin 已提交
2173 2174 2175
    ty

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

D
Don Syme 已提交
2178
and readBlobHeapAsFieldSigUncached ctxtH (BlobAsFieldSigIdx (numtypars, blobIdx)) =
L
latkin 已提交
2179 2180 2181
    let ctxt = getHole ctxtH
    let bytes = readBlobHeap ctxt blobIdx
    let sigptr = 0
D
Don Syme 已提交
2182
    let ccByte, sigptr = sigptrGetByte bytes sigptr
D
Don Syme 已提交
2183
    if ccByte <> e_IMAGE_CEE_CS_CALLCONV_FIELD then dprintn "warning: field sig was not CC_FIELD"
D
Don Syme 已提交
2184
    let retty, _sigptr = sigptrGetTy ctxt numtypars bytes sigptr
L
latkin 已提交
2185 2186 2187
    retty

      
2188
and readBlobHeapAsPropertySig (ctxt: ILMetadataReader)  numtypars blobIdx  =
D
Don Syme 已提交
2189
    ctxt.readBlobHeapAsPropertySig (BlobAsPropSigIdx (numtypars, blobIdx))
2190

D
Don Syme 已提交
2191
and readBlobHeapAsPropertySigUncached ctxtH (BlobAsPropSigIdx (numtypars, blobIdx))  =
L
latkin 已提交
2192 2193 2194
    let ctxt = getHole ctxtH
    let bytes = readBlobHeap ctxt blobIdx
    let sigptr = 0
D
Don Syme 已提交
2195
    let ccByte, sigptr = sigptrGetByte bytes sigptr
L
latkin 已提交
2196 2197
    let hasthis = byteAsHasThis ccByte
    let ccMaxked = (ccByte &&& 0x0Fuy)
D
Don Syme 已提交
2198
    if ccMaxked <> e_IMAGE_CEE_CS_CALLCONV_PROPERTY then dprintn ("warning: property sig was "+string ccMaxked+" instead of CC_PROPERTY")
D
Don Syme 已提交
2199 2200 2201 2202
    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 已提交
2203
      
2204
and readBlobHeapAsLocalsSig (ctxt: ILMetadataReader)  numtypars blobIdx  =
D
Don Syme 已提交
2205
    ctxt.readBlobHeapAsLocalsSig (BlobAsLocalSigIdx (numtypars, blobIdx))
L
latkin 已提交
2206

D
Don Syme 已提交
2207
and readBlobHeapAsLocalsSigUncached ctxtH (BlobAsLocalSigIdx (numtypars, blobIdx)) =
L
latkin 已提交
2208 2209 2210
    let ctxt = getHole ctxtH
    let bytes = readBlobHeap ctxt blobIdx
    let sigptr = 0
D
Don Syme 已提交
2211
    let ccByte, sigptr = sigptrGetByte bytes sigptr
D
Don Syme 已提交
2212
    if ccByte <> e_IMAGE_CEE_CS_CALLCONV_LOCAL_SIG then dprintn "warning: local sig was not CC_LOCAL"
D
Don Syme 已提交
2213 2214
    let numlocals, sigptr = sigptrGetZInt32 bytes sigptr
    let localtys, _sigptr = sigptrFold (sigptrGetLocal ctxt numtypars) ( numlocals) bytes sigptr
L
latkin 已提交
2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232
    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 已提交
2233
    generic, Callconv (byteAsHasThis b, cc) 
L
latkin 已提交
2234 2235
      
and seekReadMemberRefAsMethodData ctxt numtypars idx : VarArgMethodData = 
D
Don Syme 已提交
2236
    ctxt.seekReadMemberRefAsMethodData (MemberRefAsMspecIdx (numtypars, idx))
2237

D
Don Syme 已提交
2238
and seekReadMemberRefAsMethodDataUncached ctxtH (MemberRefAsMspecIdx (numtypars, idx)) = 
2239 2240 2241
    let (ctxt: ILMetadataReader)  = getHole ctxtH
    let mdv = ctxt.mdfile.GetView()
    let (mrpIdx, nameIdx, typeIdx) = seekReadMemberRefRow ctxt mdv idx
L
latkin 已提交
2242
    let nm = readStringHeap ctxt nameIdx
2243 2244
    let enclTy = seekReadMethodRefParent ctxt mdv numtypars mrpIdx
    let _generic, genarity, cc, retty, argtys, varargs = readBlobHeapAsMethodSig ctxt enclTy.GenericArgs.Length typeIdx
2245
    let minst =  List.init genarity (fun n -> mkILTyvarTy (uint16 (numtypars+n))) 
2246
    (VarArgMethodData(enclTy, cc, nm, argtys, varargs, retty, minst))
L
latkin 已提交
2247 2248

and seekReadMemberRefAsMethDataNoVarArgs ctxt numtypars idx : MethodData =
2249
   let (VarArgMethodData(enclTy, cc, nm, argtys, varargs, retty, minst)) =  seekReadMemberRefAsMethodData ctxt numtypars idx
2250
   if Option.isSome varargs then dprintf "ignoring sentinel and varargs in ILMethodDef token signature"
2251
   (MethodData(enclTy, cc, nm, argtys, retty, minst))
L
latkin 已提交
2252

2253
and seekReadMethodSpecAsMethodData (ctxt: ILMetadataReader) numtypars idx =  
D
Don Syme 已提交
2254
    ctxt.seekReadMethodSpecAsMethodData (MethodSpecAsMspecIdx (numtypars, idx))
2255

D
Don Syme 已提交
2256
and seekReadMethodSpecAsMethodDataUncached ctxtH (MethodSpecAsMspecIdx (numtypars, idx)) = 
2257 2258 2259
    let (ctxt: ILMetadataReader)  = getHole ctxtH
    let mdv = ctxt.mdfile.GetView()
    let (mdorIdx, instIdx) = seekReadMethodSpecRow ctxt mdv idx
2260
    let (VarArgMethodData(enclTy, cc, nm, argtys, varargs, retty, _)) = seekReadMethodDefOrRef ctxt numtypars mdorIdx
L
latkin 已提交
2261 2262 2263
    let minst = 
        let bytes = readBlobHeap ctxt instIdx
        let sigptr = 0
D
Don Syme 已提交
2264
        let ccByte, sigptr = sigptrGetByte bytes sigptr
D
Don Syme 已提交
2265
        if ccByte <> e_IMAGE_CEE_CS_CALLCONV_GENERICINST then dprintn ("warning: method inst ILCallingConv was "+string ccByte+" instead of CC_GENERICINST")
D
Don Syme 已提交
2266 2267
        let numgpars, sigptr = sigptrGetZInt32 bytes sigptr
        let argtys, _sigptr = sigptrFold (sigptrGetTy ctxt numtypars) numgpars bytes sigptr
2268
        argtys
2269
    VarArgMethodData(enclTy, cc, nm, argtys, varargs, retty, minst)
L
latkin 已提交
2270

2271
and seekReadMemberRefAsFieldSpec (ctxt: ILMetadataReader)  numtypars idx = 
D
Don Syme 已提交
2272
   ctxt.seekReadMemberRefAsFieldSpec (MemberRefAsFspecIdx (numtypars, idx))
2273

D
Don Syme 已提交
2274
and seekReadMemberRefAsFieldSpecUncached ctxtH (MemberRefAsFspecIdx (numtypars, idx)) = 
2275 2276 2277
   let (ctxt: ILMetadataReader)  = getHole ctxtH
   let mdv = ctxt.mdfile.GetView()
   let (mrpIdx, nameIdx, typeIdx) = seekReadMemberRefRow ctxt mdv idx
L
latkin 已提交
2278
   let nm = readStringHeap ctxt nameIdx
2279
   let enclTy = seekReadMethodRefParent ctxt mdv numtypars mrpIdx
L
latkin 已提交
2280
   let retty = readBlobHeapAsFieldSig ctxt numtypars typeIdx
2281
   mkILFieldSpecInTy(enclTy, nm, retty)
L
latkin 已提交
2282 2283 2284 2285 2286 2287 2288 2289 2290

// 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
2291

L
latkin 已提交
2292
and seekReadMethodDefAsMethodDataUncached ctxtH idx =
2293 2294
   let (ctxt: ILMetadataReader)  = getHole ctxtH
   let mdv = ctxt.mdfile.GetView()
L
latkin 已提交
2295 2296
   // Look for the method def parent. 
   let tidx = 
D
Don Syme 已提交
2297 2298 2299 2300
     seekReadIndexedRow (ctxt.getNumRows TableNames.TypeDef, 
                            (fun i -> i, seekReadTypeDefRowWithExtents ctxt i), 
                            (fun r -> r), 
                            (fun (_, ((_, _, _, _, _, methodsIdx), 
L
latkin 已提交
2301 2302 2303
                                      (_, endMethodsIdx)))  -> 
                                        if endMethodsIdx <= idx then 1 
                                        elif methodsIdx <= idx && idx < endMethodsIdx then 0 
D
Don Syme 已提交
2304 2305
                                        else -1), 
                            true, fst)
2306 2307 2308 2309 2310 2311 2312 2313
   // 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
2314

L
latkin 已提交
2315
   // Read the method def parent. 
2316
   let enclTy = seekReadTypeDefAsType ctxt AsObject (* not ok: see note *) finst tidx
2317

2318 2319
   // 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
2320 2321 2322
   let nm = readStringHeap ctxt nameIdx

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

2326
   MethodData(enclTy, cc, nm, argtys, retty, minst)
L
latkin 已提交
2327 2328


2329
and seekReadFieldDefAsFieldSpec (ctxt: ILMetadataReader)  idx =
L
latkin 已提交
2330
   ctxt.seekReadFieldDefAsFieldSpec idx
2331

L
latkin 已提交
2332
and seekReadFieldDefAsFieldSpecUncached ctxtH idx =
2333 2334 2335
   let (ctxt: ILMetadataReader)  = getHole ctxtH
   let mdv = ctxt.mdfile.GetView()
   let (_flags, nameIdx, typeIdx) = seekReadFieldRow ctxt mdv idx
L
latkin 已提交
2336 2337 2338
   let nm = readStringHeap ctxt nameIdx
   (* Look for the field def parent. *)
   let tidx = 
D
Don Syme 已提交
2339 2340 2341 2342
     seekReadIndexedRow (ctxt.getNumRows TableNames.TypeDef, 
                            (fun i -> i, seekReadTypeDefRowWithExtents ctxt i), 
                            (fun r -> r), 
                            (fun (_, ((_, _, _, _, fieldsIdx, _), (endFieldsIdx, _)))  -> 
L
latkin 已提交
2343 2344
                                if endFieldsIdx <= idx then 1 
                                elif fieldsIdx <= idx && idx < endFieldsIdx then 0 
D
Don Syme 已提交
2345 2346
                                else -1), 
                            true, fst)
L
latkin 已提交
2347 2348
   // Read the field signature. 
   let retty = readBlobHeapAsFieldSig ctxt 0 typeIdx
2349

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

L
latkin 已提交
2353
   // Read the field def parent. 
2354
   let enclTy = seekReadTypeDefAsType ctxt AsObject (* not ok: see note *) finst tidx
2355

L
latkin 已提交
2356
   // Put it together. 
2357
   mkILFieldSpecInTy(enclTy, nm, retty)
L
latkin 已提交
2358

2359 2360
and seekReadMethod (ctxt: ILMetadataReader)  mdv numtypars (idx:int) =
     let (codeRVA, implflags, flags, nameIdx, typeIdx, paramIdx) = seekReadMethodRow ctxt mdv idx
L
latkin 已提交
2361 2362 2363 2364 2365 2366 2367
     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
2368
     let aggressiveinline = (implflags &&& 0x0100) <> 0x0
D
Don Syme 已提交
2369
     let _generic, _genarity, cc, retty, argtys, varargs = readBlobHeapAsMethodSig ctxt numtypars typeIdx
D
Don Syme 已提交
2370
     if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef signature"
L
latkin 已提交
2371 2372 2373 2374 2375
     
     let endParamIdx =
       if idx >= ctxt.getNumRows TableNames.Method then 
         ctxt.getNumRows TableNames.Param + 1
       else
2376
         let (_, _, _, _, _, paramIdx) = seekReadMethodRow ctxt mdv (idx + 1)
L
latkin 已提交
2377 2378
         paramIdx
     
2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395
     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 已提交
2396

D
Don Syme 已提交
2397 2398 2399
     ILMethodDef(name=nm,
                 attributes = enum<MethodAttributes>(flags),
                 implAttributes= enum<MethodImplAttributes>(implflags),
2400
                 securityDeclsStored=ctxt.securityDeclsReader_MethodDef,
2401
                 isEntryPoint=isEntryPoint,
D
Don Syme 已提交
2402 2403 2404 2405
                 genericParams=seekReadGenericParams ctxt numtypars (tomd_MethodDef, idx),
                 parameters= ilParams,
                 callingConv=cc,
                 ret=ret,
2406 2407 2408
                 body=body,
                 customAttrsStored=ctxt.customAttrsReader_MethodDef,
                 metadataIndex=idx)
L
latkin 已提交
2409 2410
     
     
2411
and seekReadParams (ctxt: ILMetadataReader)  mdv (retty, argtys) pidx1 pidx2 =
2412 2413
    let retRes = ref (mkILReturn retty)
    let paramsRes = argtys |> List.toArray |> Array.map mkILParamAnon
L
latkin 已提交
2414
    for i = pidx1 to pidx2 - 1 do
2415
        seekReadParamExtras ctxt mdv (retRes, paramsRes) i
2416
    !retRes, List.ofArray paramsRes
L
latkin 已提交
2417

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

2456
and seekReadMultipleMethodSemantics (ctxt: ILMetadataReader)  (flags, id) =
L
latkin 已提交
2457
    seekReadIndexedRows 
D
Don Syme 已提交
2458 2459 2460 2461 2462 2463
      (ctxt.getNumRows TableNames.MethodSemantics , 
       seekReadMethodSemanticsRow ctxt, 
       (fun (_flags, _, c) -> c), 
       hsCompare id, 
       isSorted ctxt TableNames.MethodSemantics, 
       (fun (a, b, _c) -> 
2464 2465
           let (MethodData(enclTy, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData ctxt b
           a, (mkILMethSpecInTy (enclTy, cc, nm, argtys, retty, minst)).MethodRef))
D
Don Syme 已提交
2466
    |> List.filter (fun (flags2, _) -> flags = flags2) 
L
latkin 已提交
2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480
    |> 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

2481 2482
and seekReadEvent ctxt mdv numtypars idx =
   let (flags, nameIdx, typIdx) = seekReadEventRow ctxt mdv idx
D
Don Syme 已提交
2483 2484 2485 2486 2487 2488 2489
   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)),
2490 2491
              customAttrsStored=ctxt.customAttrsReader_Event,
              metadataIndex = idx )
L
latkin 已提交
2492
   
2493 2494
  (* 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 已提交
2495 2496
   mkILEventsLazy 
      (lazy 
2497 2498
           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 已提交
2499
           | None -> []
D
Don Syme 已提交
2500
           | Some (rowNum, beginEventIdx) ->
L
latkin 已提交
2501 2502 2503 2504
               let endEventIdx =
                   if rowNum >= ctxt.getNumRows TableNames.EventMap then 
                       ctxt.getNumRows TableNames.Event + 1
                   else
2505
                       let (_, endEventIdx) = seekReadEventMapRow ctxt mdv (rowNum + 1)
L
latkin 已提交
2506 2507 2508
                       endEventIdx

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

2511 2512
and seekReadProperty ctxt mdv numtypars idx =
   let (flags, nameIdx, typIdx) = seekReadPropertyRow ctxt mdv idx
D
Don Syme 已提交
2513 2514 2515
   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 已提交
2516 2517 2518 2519 2520 2521 2522 2523 2524
(* 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
2525

D
Don Syme 已提交
2526 2527 2528 2529 2530 2531 2532 2533
   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,
2534 2535
                 customAttrsStored=ctxt.customAttrsReader_Property,
                 metadataIndex = idx )
L
latkin 已提交
2536
   
2537
and seekReadProperties (ctxt: ILMetadataReader)  numtypars tidx =
L
latkin 已提交
2538 2539
   mkILPropertiesLazy
      (lazy 
2540 2541
           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 已提交
2542
           | None -> []
D
Don Syme 已提交
2543
           | Some (rowNum, beginPropIdx) ->
L
latkin 已提交
2544 2545 2546 2547
               let endPropIdx =
                   if rowNum >= ctxt.getNumRows TableNames.PropertyMap then 
                       ctxt.getNumRows TableNames.Property + 1
                   else
2548
                       let (_, endPropIdx) = seekReadPropertyMapRow ctxt mdv (rowNum + 1)
L
latkin 已提交
2549 2550
                       endPropIdx
               [ for i in beginPropIdx .. endPropIdx - 1 do
2551
                   yield seekReadProperty ctxt mdv numtypars i ])
L
latkin 已提交
2552 2553


2554 2555 2556 2557
and customAttrsReader ctxtH tag : ILAttributesStored = 
    mkILCustomAttrsReader
      (fun idx -> 
          let (ctxt: ILMetadataReader) = getHole ctxtH
D
Don Syme 已提交
2558 2559
          seekReadIndexedRows (ctxt.getNumRows TableNames.CustomAttribute, 
                                  seekReadCustomAttributeRow ctxt, (fun (a, _, _) -> a), 
2560
                                  hcaCompare (TaggedIndex(tag,idx)), 
D
Don Syme 已提交
2561 2562
                                  isSorted ctxt TableNames.CustomAttribute, 
                                  (fun (_, b, c) -> seekReadCustomAttr ctxt (b, c)))
2563
          |> List.toArray)
L
latkin 已提交
2564

D
Don Syme 已提交
2565 2566
and seekReadCustomAttr ctxt (TaggedIndex(cat, idx), b) = 
    ctxt.seekReadCustomAttr (CustomAttrIdx (cat, idx, b))
L
latkin 已提交
2567

D
Don Syme 已提交
2568
and seekReadCustomAttrUncached ctxtH (CustomAttrIdx (cat, idx, valIdx)) = 
L
latkin 已提交
2569
    let ctxt = getHole ctxtH
2570 2571
    let method = seekReadCustomAttrType ctxt (TaggedIndex(cat, idx))
    let data =
L
latkin 已提交
2572 2573
        match readBlobHeapOption ctxt valIdx with
        | Some bytes -> bytes
2574 2575 2576
        | None -> Bytes.ofInt32Array [| |]
    let elements = []
    ILAttribute.Encoded (method, data, elements)
L
latkin 已提交
2577

2578 2579 2580 2581
and securityDeclsReader ctxtH tag = 
    mkILSecurityDeclsReader
      (fun idx -> 
         let (ctxt: ILMetadataReader) = getHole ctxtH
2582
         let mdv = ctxt.mdfile.GetView()
D
Don Syme 已提交
2583
         seekReadIndexedRows (ctxt.getNumRows TableNames.Permission, 
2584
                                 seekReadPermissionRow ctxt mdv, 
D
Don Syme 已提交
2585
                                 (fun (_, par, _) -> par), 
2586
                                 hdsCompare (TaggedIndex(tag,idx)), 
D
Don Syme 已提交
2587
                                 isSorted ctxt TableNames.Permission, 
2588 2589
                                 (fun (act, _, ty) -> seekReadSecurityDecl ctxt (act, ty)))
          |> List.toArray)
L
latkin 已提交
2590

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

2595
and seekReadConstant (ctxt: ILMetadataReader)  idx =
D
Don Syme 已提交
2596 2597 2598 2599
  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 已提交
2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619
  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

2620
and seekReadImplMap (ctxt: ILMetadataReader)  nm midx = 
L
latkin 已提交
2621 2622
   mkMethBodyLazyAux 
      (lazy 
2623
            let mdv = ctxt.mdfile.GetView()
D
Don Syme 已提交
2624
            let (flags, nameIdx, scopeIdx) = seekReadIndexedRow (ctxt.getNumRows TableNames.ImplMap, 
2625
                                                                seekReadImplMapRow ctxt mdv, 
D
Don Syme 已提交
2626 2627 2628 2629
                                                                (fun (_, m, _, _) -> m), 
                                                                mfCompare (TaggedIndex(mf_MethodDef, midx)), 
                                                                isSorted ctxt TableNames.ImplMap, 
                                                                (fun (a, _, c, d) -> a, c, d))
L
latkin 已提交
2630 2631 2632 2633 2634 2635 2636 2637 2638
            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)
2639

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

L
latkin 已提交
2648 2649 2650 2651 2652 2653
            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)
2654

L
latkin 已提交
2655 2656 2657 2658 2659 2660 2661
            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 已提交
2662 2663 2664 2665 2666 2667
            MethodBody.PInvoke { CallingConv = cc 
                                 CharEncoding = enc
                                 CharBestFit=bestfit
                                 ThrowOnUnmappableChar=unmap
                                 NoMangle = (flags &&& 0x0001) <> 0x0
                                 LastError = (flags &&& 0x0040) <> 0x0
L
latkin 已提交
2668 2669 2670
                                 Name = 
                                     (match readStringHeapOption ctxt nameIdx with 
                                      | None -> nm
D
Don Syme 已提交
2671
                                      | Some nm2 -> nm2)
2672
                                 Where = seekReadModuleRef ctxt mdv scopeIdx })
L
latkin 已提交
2673

2674
and seekReadTopCode (ctxt: ILMetadataReader)  pev mdv numtypars (sz:int) start seqpoints = 
D
Don Syme 已提交
2675 2676
   let labelsOfRawOffsets = new Dictionary<_, _>(sz/2)
   let ilOffsetsOfLabels = new Dictionary<_, _>(sz/2)
2677 2678 2679 2680
   let tryRawToLabel rawOffset =
       match labelsOfRawOffsets.TryGetValue(rawOffset) with
       | true, v -> Some v
       | _ -> None
L
latkin 已提交
2681 2682 2683 2684 2685 2686

   let rawToLabel rawOffset = 
       match tryRawToLabel rawOffset with 
       | Some l -> l
       | None -> 
           let lab = generateCodeLabel()
D
Don Syme 已提交
2687
           labelsOfRawOffsets.[rawOffset] <- lab
L
latkin 已提交
2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700
           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 () = 
2701
       lastb := seekReadByteAsInt32 pev (start + (!curr))
D
Don Syme 已提交
2702
       incr curr
L
latkin 已提交
2703 2704
       b := 
         if !lastb = 0xfe && !curr < sz then 
2705
           lastb2 := seekReadByteAsInt32 pev (start + (!curr))
D
Don Syme 已提交
2706
           incr curr
L
latkin 已提交
2707 2708 2709 2710 2711 2712 2713 2714
           !lastb2
         else 
           !lastb

   let seqPointsRemaining = ref seqpoints

   while !curr < sz do
     // registering "+string !curr+" as start of an instruction")
D
Don Syme 已提交
2715
     markAsInstructionStart !curr ibuf.Count
L
latkin 已提交
2716 2717 2718 2719

     // Insert any sequence points into the instruction sequence 
     while 
         (match !seqPointsRemaining with 
D
Don Syme 已提交
2720
          |  (i, _tag) :: _rest when i <= !curr -> true
L
latkin 已提交
2721 2722 2723
          | _ -> false) 
        do
         // Emitting one sequence point 
D
Don Syme 已提交
2724
         let (_, tag) = List.head !seqPointsRemaining
D
Don Syme 已提交
2725
         seqPointsRemaining := List.tail !seqPointsRemaining
L
latkin 已提交
2726 2727 2728 2729
         ibuf.Add (I_seqpoint tag)

     // Read the prefixes.  Leave lastb and lastb2 holding the instruction byte(s) 
     begin 
D
Don Syme 已提交
2730 2731 2732 2733 2734 2735
       prefixes.al <- Aligned
       prefixes.tl <- Normalcall
       prefixes.vol <- Nonvolatile
       prefixes.ro<-NormalAddress
       prefixes.constrained<-None
       get ()
L
latkin 已提交
2736 2737 2738 2739 2740 2741 2742
       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 已提交
2743
         begin
L
latkin 已提交
2744
             if !b = (i_unaligned &&& 0xff) then
2745
               let unal = seekReadByteAsInt32 pev (start + (!curr))
D
Don Syme 已提交
2746
               incr curr
L
latkin 已提交
2747 2748 2749 2750 2751 2752 2753 2754
               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 
2755
                 let uncoded = seekReadUncodedToken pev (start + (!curr))
D
Don Syme 已提交
2756
                 curr := !curr + 4
2757 2758
                 let ty = seekReadTypeDefOrRef ctxt numtypars AsObject [] (uncodedTokenToTypeDefOrRefOrSpec uncoded)
                 prefixes.constrained <- Some ty
D
Don Syme 已提交
2759
             else prefixes.tl <- Tailcall
D
Don Syme 已提交
2760
         end
D
Don Syme 已提交
2761 2762
         get ()
     end
L
latkin 已提交
2763 2764

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

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

   // 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 已提交
2921
   instrs, rawToLabel, lab2pc, raw2nextLab
L
latkin 已提交
2922

2923
#if FX_NO_PDB_READER
2924
and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (_idx, nm, _internalcall, noinline, aggressiveinline, numtypars) rva = 
L
latkin 已提交
2925
#else
2926
and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (idx, nm, _internalcall, noinline, aggressiveinline, numtypars) rva = 
L
latkin 已提交
2927 2928 2929
#endif
  mkMethBodyLazyAux 
   (lazy
2930 2931
       let pev = pectxt.pefile.GetView()
       let mdv = ctxt.mdfile.GetView()
L
latkin 已提交
2932 2933 2934 2935 2936 2937

       // 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 = 
2938
#if FX_NO_PDB_READER
L
latkin 已提交
2939 2940
           [], None, []
#else
2941
           match pectxt.pdb with 
L
latkin 已提交
2942 2943 2944 2945 2946 2947 2948
           | None -> 
               [], None, []
           | Some (pdbr, get_doc) -> 
               try 

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

           // 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
3042
             let sectionFlag = seekReadByte pev sectionBase
D
Don Syme 已提交
3043
             // fat format for "+nm+", sectionFlag = " + string sectionFlag)
L
latkin 已提交
3044 3045
             let sectionSize, clauses = 
               if (sectionFlag &&& e_CorILMethod_Sect_FatFormat) <> 0x0uy then 
3046
                   let bigSize = (seekReadInt32 pev sectionBase) >>>& 8
D
Don Syme 已提交
3047
                   // bigSize = "+string bigSize)
L
latkin 已提交
3048 3049 3050 3051 3052 3053 3054 3055 3056
                   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)
3057 3058 3059 3060 3061 3062
                               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 已提交
3063
                               (kind, st1, sz1, st2, sz2, extra))
L
latkin 已提交
3064 3065 3066
                       else []
                   bigSize, clauses
               else 
3067
                 let smallSize = seekReadByteAsInt32 pev (sectionBase + 0x01)
L
latkin 已提交
3068 3069 3070 3071 3072 3073
                 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 已提交
3074
                       // dprintn (nm+" has " + string numClauses + " tiny seh clauses")
L
latkin 已提交
3075 3076
                       List.init numClauses (fun i -> 
                           let clauseBase = sectionBase + 4 + (i * 12)
3077
                           let kind = seekReadUInt16AsInt32 pev (clauseBase + 0)
D
Don Syme 已提交
3078
                           if logging then dprintn ("One tiny SEH clause, kind = "+string kind)
3079 3080 3081 3082 3083
                           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 已提交
3084
                           (kind, st1, sz1, st2, sz2, extra))
L
latkin 已提交
3085 3086 3087 3088 3089 3090
                   else 
                       []
                 smallSize, clauses

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

           (* Convert the linear code format to the nested code format *)
D
Don Syme 已提交
3127
           if logging then dprintn ("doing localPdbInfos2") 
L
latkin 已提交
3128
           let localPdbInfos2 = List.map (fun f -> f raw2nextLab) localPdbInfos
D
Don Syme 已提交
3129
           if logging then dprintn ("done localPdbInfos2, checking code...") 
D
Don Syme 已提交
3130
           let code = buildILCode nm lab2pc instrs !seh localPdbInfos2
D
Don Syme 已提交
3131
           if logging then dprintn ("done checking code.") 
L
latkin 已提交
3132
           MethodBody.IL
D
Don Syme 已提交
3133 3134 3135
             { IsZeroInit=initlocals
               MaxStack= maxstack
               NoInlining=noinline
3136
               AggressiveInlining=aggressiveinline
3137
               Locals = locals
D
Don Syme 已提交
3138
               Code=code
L
latkin 已提交
3139 3140
               SourceMarker=methRangePdbInfo}
       else 
D
Don Syme 已提交
3141
           if logging then failwith "unknown format"
3142
           MethodBody.Abstract)
L
latkin 已提交
3143

3144
and int32AsILVariantType (ctxt: ILMetadataReader)  (n:int32) = 
L
latkin 已提交
3145 3146 3147 3148 3149
    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)))
3150
    else (dprintn (ctxt.fileName + ": int32AsILVariantType ctxt: unexpected variant type, n = "+string n) ; ILNativeVariant.Empty)
L
latkin 已提交
3151 3152

and readBlobHeapAsNativeType ctxt blobIdx = 
D
Don Syme 已提交
3153
    // reading native type blob "+string blobIdx) 
L
latkin 已提交
3154
    let bytes = readBlobHeap ctxt blobIdx
D
Don Syme 已提交
3155
    let res, _ = sigptrGetILNativeType ctxt bytes 0
L
latkin 已提交
3156 3157 3158
    res

and sigptrGetILNativeType ctxt bytes sigptr = 
D
Don Syme 已提交
3159
    // reading native type blob, sigptr= "+string sigptr) 
D
Don Syme 已提交
3160
    let ntbyte, sigptr = sigptrGetByte bytes sigptr
L
latkin 已提交
3161 3162 3163 3164
    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 已提交
3165
        // reading native type blob (CM1) , sigptr= "+string sigptr+ ", bytes.Length = "+string bytes.Length) 
D
Don Syme 已提交
3166
        let guidLen, sigptr = sigptrGetZInt32 bytes sigptr
D
Don Syme 已提交
3167
        // reading native type blob (CM2) , sigptr= "+string sigptr+", guidLen = "+string ( guidLen)) 
D
Don Syme 已提交
3168
        let guid, sigptr = sigptrGetBytes ( guidLen) bytes sigptr
D
Don Syme 已提交
3169
        // reading native type blob (CM3) , sigptr= "+string sigptr) 
D
Don Syme 已提交
3170
        let nativeTypeNameLen, sigptr = sigptrGetZInt32 bytes sigptr
D
Don Syme 已提交
3171
        // reading native type blob (CM4) , sigptr= "+string sigptr+", nativeTypeNameLen = "+string ( nativeTypeNameLen)) 
D
Don Syme 已提交
3172
        let nativeTypeName, sigptr = sigptrGetString ( nativeTypeNameLen) bytes sigptr
D
Don Syme 已提交
3173 3174
        // reading native type blob (CM4) , sigptr= "+string sigptr+", nativeTypeName = "+nativeTypeName) 
        // reading native type blob (CM5) , sigptr= "+string sigptr) 
D
Don Syme 已提交
3175
        let custMarshallerNameLen, sigptr = sigptrGetZInt32 bytes sigptr
D
Don Syme 已提交
3176
        // reading native type blob (CM6) , sigptr= "+string sigptr+", custMarshallerNameLen = "+string ( custMarshallerNameLen)) 
D
Don Syme 已提交
3177
        let custMarshallerName, sigptr = sigptrGetString ( custMarshallerNameLen) bytes sigptr
D
Don Syme 已提交
3178
        // reading native type blob (CM7) , sigptr= "+string sigptr+", custMarshallerName = "+custMarshallerName) 
D
Don Syme 已提交
3179
        let cookieStringLen, sigptr = sigptrGetZInt32 bytes sigptr
D
Don Syme 已提交
3180
        // reading native type blob (CM8) , sigptr= "+string sigptr+", cookieStringLen = "+string ( cookieStringLen)) 
D
Don Syme 已提交
3181
        let cookieString, sigptr = sigptrGetBytes ( cookieStringLen) bytes sigptr
D
Don Syme 已提交
3182
        // reading native type blob (CM9) , sigptr= "+string sigptr) 
D
Don Syme 已提交
3183
        ILNativeType.Custom (guid, nativeTypeName, custMarshallerName, cookieString), sigptr
L
latkin 已提交
3184
    elif ntbyte = nt_FIXEDSYSSTRING then 
D
Don Syme 已提交
3185
      let i, sigptr = sigptrGetZInt32 bytes sigptr
L
latkin 已提交
3186 3187
      ILNativeType.FixedSysString i, sigptr
    elif ntbyte = nt_FIXEDARRAY then 
D
Don Syme 已提交
3188
      let i, sigptr = sigptrGetZInt32 bytes sigptr
L
latkin 已提交
3189 3190 3191
      ILNativeType.FixedArray i, sigptr
    elif ntbyte = nt_SAFEARRAY then 
      (if sigptr >= bytes.Length then
D
Don Syme 已提交
3192
         ILNativeType.SafeArray(ILNativeVariant.Empty, None), sigptr
L
latkin 已提交
3193
       else 
D
Don Syme 已提交
3194
         let i, sigptr = sigptrGetZInt32 bytes sigptr
L
latkin 已提交
3195 3196 3197
         if sigptr >= bytes.Length then
           ILNativeType.SafeArray (int32AsILVariantType ctxt i, None), sigptr
         else 
D
Don Syme 已提交
3198 3199
           let len, sigptr = sigptrGetZInt32 bytes sigptr
           let s, sigptr = sigptrGetString ( len) bytes sigptr
L
latkin 已提交
3200 3201 3202
           ILNativeType.SafeArray (int32AsILVariantType ctxt i, Some s), sigptr)
    elif ntbyte = nt_ARRAY then 
       if sigptr >= bytes.Length then
D
Don Syme 已提交
3203
         ILNativeType.Array(None, None), sigptr
L
latkin 已提交
3204
       else 
D
Don Syme 已提交
3205 3206
         let nt, sigptr = 
           let u, sigptr' = sigptrGetZInt32 bytes sigptr
L
latkin 已提交
3207 3208 3209
           if (u = int nt_MAX) then 
             ILNativeType.Empty, sigptr'
           else
W
WilliamBerryiii 已提交
3210
             // NOTE: go back to start and read native type
L
latkin 已提交
3211 3212
             sigptrGetILNativeType ctxt bytes sigptr
         if sigptr >= bytes.Length then
D
Don Syme 已提交
3213
           ILNativeType.Array (Some nt, None), sigptr
L
latkin 已提交
3214
         else
D
Don Syme 已提交
3215
           let pnum, sigptr = sigptrGetZInt32 bytes sigptr
L
latkin 已提交
3216
           if sigptr >= bytes.Length then
D
Don Syme 已提交
3217
             ILNativeType.Array (Some nt, Some(pnum, None)), sigptr
L
latkin 已提交
3218
           else 
D
Don Syme 已提交
3219
             let additive, sigptr = 
L
latkin 已提交
3220 3221
               if sigptr >= bytes.Length then 0, sigptr
               else sigptrGetZInt32 bytes sigptr
D
Don Syme 已提交
3222
             ILNativeType.Array (Some nt, Some(pnum, Some(additive))), sigptr
D
Don Syme 已提交
3223
    else (ILNativeType.Empty, sigptr)
L
latkin 已提交
3224
      
3225 3226 3227 3228 3229 3230 3231 3232 3233 3234
// 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 = 
3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246
                match scoref with
                | ILScopeRef.Local ->
                    let start = pectxtEager.anyV2P ("resource", offset + pectxtEager.resourcesAddr)
                    let resourceLength = seekReadInt32 pevEager start
                    let offsetOfBytesFromStartOfPhysicalPEFile = start + 4
                    if pectxtEager.noFileOnDisk then
                        ILResourceLocation.LocalOut (seekReadBytes pevEager offsetOfBytesFromStartOfPhysicalPEFile resourceLength)                     
                    else
                        ILResourceLocation.LocalIn (ctxt.fileName, offsetOfBytesFromStartOfPhysicalPEFile, resourceLength)

                | ILScopeRef.Module mref -> ILResourceLocation.File (mref, offset)
                | ILScopeRef.Assembly aref -> ILResourceLocation.Assembly aref
L
latkin 已提交
3247 3248

             let r = 
D
Don Syme 已提交
3249
               { Name= readStringHeap ctxt nameIdx
3250
                 Location = location
D
Don Syme 已提交
3251
                 Access = (if (flags &&& 0x01) <> 0x0 then ILResourceAccess.Public else ILResourceAccess.Private)
3252 3253
                 CustomAttrsStored = ctxt.customAttrsReader_ManifestResource
                 MetadataIndex = i }
3254
             yield r ]
L
latkin 已提交
3255

N
ncave 已提交
3256
and seekReadNestedExportedTypes ctxt (exported: _ array) (nested: Lazy<_ array>) parentIdx = 
L
latkin 已提交
3257 3258
    mkILNestedExportedTypesLazy
      (lazy
N
ncave 已提交
3259 3260 3261 3262 3263 3264 3265 3266
            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
3267 3268
                  CustomAttrsStored = ctxt.customAttrsReader_ExportedType
                  MetadataIndex = i  }
N
ncave 已提交
3269 3270
            ))

3271
and seekReadTopExportedTypes (ctxt: ILMetadataReader)  = 
L
latkin 已提交
3272 3273
    mkILExportedTypesLazy 
      (lazy
3274
            let mdv = ctxt.mdfile.GetView()
N
ncave 已提交
3275
            let numRows = ctxt.getNumRows TableNames.ExportedType
3276
            let exported = [| for i in 1..numRows -> seekReadExportedTypeRow ctxt mdv i |]
N
ncave 已提交
3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294

            // 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
3295
                      { ScopeRef = seekReadImplAsScopeRef ctxt mdv implIdx
N
ncave 已提交
3296
                        Name = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx)
A
Avi Avni 已提交
3297
                        Attributes = enum<TypeAttributes>(flags)
N
ncave 已提交
3298
                        Nested = seekReadNestedExportedTypes ctxt exported nested i
3299 3300
                        CustomAttrsStored = ctxt.customAttrsReader_ExportedType
                        MetadataIndex = i }
N
ncave 已提交
3301
            ])
L
latkin 已提交
3302

D
Don Syme 已提交
3303
#if !FX_NO_PDB_READER
3304 3305
let getPdbReader pdbDirPath fileName =  
    match pdbDirPath with 
L
latkin 已提交
3306 3307 3308
    | None -> None
    | Some pdbpath ->
         try 
3309
              let pdbr = pdbReadOpen fileName pdbpath
L
latkin 已提交
3310 3311
              let pdbdocs = pdbReaderGetDocuments pdbr
  
D
Don Syme 已提交
3312
              let tab = new Dictionary<_, _>(Array.length pdbdocs)
L
latkin 已提交
3313 3314 3315
              pdbdocs |> Array.iter  (fun pdbdoc -> 
                  let url = pdbDocumentGetURL pdbdoc
                  tab.[url] <-
D
Don Syme 已提交
3316 3317 3318
                      ILSourceDocument.Create(language=Some (pdbDocumentGetLanguage pdbdoc), 
                                            vendor = Some (pdbDocumentGetLanguageVendor pdbdoc), 
                                            documentType = Some (pdbDocumentGetType pdbdoc), 
D
Don Syme 已提交
3319
                                            file = url))
L
latkin 已提交
3320

3321 3322 3323 3324
              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 已提交
3325 3326 3327 3328
              Some (pdbr, docfun)
          with e -> dprintn ("* Warning: PDB file could not be read and will be ignored: "+e.Message); None         
#endif
      
3329 3330 3331 3332 3333 3334
// 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 已提交
3335
    if magic2 <> 0x424a then failwith "bad metadata magic number"
3336 3337
    let _majorMetadataVersion = seekReadUInt16 mdv (metadataPhysLoc + 4)
    let _minorMetadataVersion = seekReadUInt16 mdv (metadataPhysLoc + 6)
L
latkin 已提交
3338

3339 3340
    let versionLength = seekReadInt32 mdv (metadataPhysLoc + 12)
    let ilMetadataVersion = seekReadBytes mdv (metadataPhysLoc + 16) versionLength |> Array.filter (fun b -> b <> 0uy)
L
latkin 已提交
3341
    let x = align 0x04 (16 + versionLength)
3342
    let numStreams = seekReadUInt16AsInt32 mdv (metadataPhysLoc + x + 2)
L
latkin 已提交
3343 3344 3345 3346 3347 3348
    let streamHeadersStart = (metadataPhysLoc + x + 4)

    let tryFindStream name = 
      let rec look i pos = 
        if i >= numStreams then None
        else
3349 3350
          let offset = seekReadInt32 mdv (pos + 0)
          let length = seekReadInt32 mdv (pos + 4)
L
latkin 已提交
3351 3352 3353 3354 3355
          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 
3356
              let c= seekReadByteAsInt32 mdv (pos + 8 + (!n))
L
latkin 已提交
3357 3358 3359
              if c = 0 then 
                  fin := true
              elif !n >= Array.length name || c <> name.[!n] then 
D
Don Syme 已提交
3360
                  res := false
L
latkin 已提交
3361
              incr n
D
Don Syme 已提交
3362
          if !res then Some(offset + metadataPhysLoc, length) 
L
latkin 已提交
3363 3364 3365 3366 3367 3368 3369 3370
          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 已提交
3371
    let (tablesStreamPhysLoc, _tablesStreamSize) = 
L
latkin 已提交
3372 3373 3374 3375 3376 3377
      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 -> 
3378 3379
         let firstStreamOffset = seekReadInt32 mdv (streamHeadersStart + 0)
         let firstStreamLength = seekReadInt32 mdv (streamHeadersStart + 4)
D
Don Syme 已提交
3380
         firstStreamOffset, firstStreamLength
L
latkin 已提交
3381 3382 3383 3384 3385 3386 3387

    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 已提交
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 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451
        [|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 已提交
3452 3453
        |]

3454 3455 3456
    let heapSizes = seekReadByteAsInt32 mdv (tablesStreamPhysLoc + 6)
    let valid = seekReadInt64 mdv (tablesStreamPhysLoc + 8)
    let sorted = seekReadInt64 mdv (tablesStreamPhysLoc + 16)
L
latkin 已提交
3457 3458 3459 3460 3461 3462
    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 已提交
3463
                present := i :: !present
3464
                numRows.[i] <-  (seekReadInt32 mdv !prevNumRowIdx)
L
latkin 已提交
3465 3466 3467 3468 3469 3470 3471 3472 3473
                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

3474 3475 3476
    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 已提交
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 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593

    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
3594
         let mutable prevTablePhysLoc = startOfTables
L
latkin 已提交
3595
         for i = 0 to 63 do 
3596 3597
             res.[i] <- prevTablePhysLoc
             prevTablePhysLoc <- prevTablePhysLoc + (tableRowCount.[i] * tableRowSizes.[i])
L
latkin 已提交
3598 3599
         res
    
3600
    let inbase = Filename.fileNameOfPath fileName + ": "
L
latkin 已提交
3601 3602

    // All the caches.  The sizes are guesstimates for the rough sharing-density of the assembly 
3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616
    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 已提交
3617 3618
    // 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)
3619
    let cacheBlobHeap                  = mkCacheInt32 reduceMemoryUsage inbase "blob heap" ( blobsStreamSize / 50 + 1) 
L
latkin 已提交
3620 3621 3622 3623 3624

     // 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.  
     
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 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670
    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)
3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685
          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 
3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716
          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.
// ----------------------------------------------------------------------

3717
let openPEFileReader (fileName, pefile: BinaryFile, pdbDirPath, noFileOnDisk) = 
3718 3719 3720
    let pev = pefile.GetView()
    (* MSDOS HEADER *)
    let peSignaturePhysLoc = seekReadInt32 pev 0x3c
L
latkin 已提交
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 3752 3753
    (* 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. *)    
D
Don Syme 已提交
3754 3755 3756
    let imageBaseReal = if only64 then dataSegmentAddr else seekReadInt32 pev (peOptionalHeaderPhysLoc + 28)  // Image Base Always 0x400000 (see Section 23.1).
    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. 
3757
     (* x86: 000000c0 *) 
D
Don Syme 已提交
3758 3759 3760 3761 3762 3763
    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). 
3764
     (* x86: 000000d0 *) 
D
Don Syme 已提交
3765 3766 3767
    let _imageEndAddr   = seekReadInt32 pev (peOptionalHeaderPhysLoc + 56)  // Image Size: Size, in bytes, of image, including all headers and padding; 
    let _headerPhysSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 60)  // Header Size Combined size of MS-DOS Header, PE Header, PE Optional Header and padding; 
    let subsys           = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 68)   // SubSystem Subsystem required to run this image. 
3768 3769 3770 3771
    let useHighEnthropyVA = 
        let n = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 70)
        let highEnthropyVA = 0x20us
        (n &&& highEnthropyVA) = highEnthropyVA
L
latkin 已提交
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 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879
     (* 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 已提交
3880 3881 3882
   //-----------------------------------------------------------------------
   // Set up the PDB reader so we can read debug info for methods.
   // ----------------------------------------------------------------------
3883
#if FX_NO_PDB_READER
3884
    let pdb = ignore pdbDirPath; None
L
latkin 已提交
3885
#else
3886 3887 3888 3889
    let pdb = 
        if runningOnMono then 
            None 
        else 
3890
            getPdbReader pdbDirPath fileName
L
latkin 已提交
3891 3892
#endif

3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909
    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
3910
          noFileOnDisk=noFileOnDisk
3911 3912 3913 3914
        }
    let peinfo = (subsys, (subsysMajor, subsysMinor), useHighEnthropyVA, ilOnly, only32, is32bitpreferred, only64, platform, isDll, alignVirt, alignPhys, imageBaseReal)
    (metadataPhysLoc, metadataSize, peinfo, pectxt, pev, pdb)

3915 3916
let openPE (fileName, pefile, pdbDirPath, reduceMemoryUsage, ilGlobals, noFileOnDisk) = 
    let (metadataPhysLoc, _metadataSize, peinfo, pectxt, pev, pdb) = openPEFileReader (fileName, pefile, pdbDirPath, noFileOnDisk) 
3917
    let ilModule, ilAssemblyRefs = openMetadataReader (fileName, pefile, metadataPhysLoc, peinfo, pectxt, pev, Some pectxt, reduceMemoryUsage, ilGlobals)
D
Don Syme 已提交
3918
    ilModule, ilAssemblyRefs, pdb
L
latkin 已提交
3919

3920 3921 3922
let openPEMetadataOnly (fileName, peinfo, pectxtEager, pev, mdfile: BinaryFile, reduceMemoryUsage, ilGlobals) = 
    openMetadataReader (fileName, mdfile, 0, peinfo, pectxtEager, pev, None, reduceMemoryUsage, ilGlobals)
  
3923
let ClosePdbReader pdb =  
3924
#if FX_NO_PDB_READER
3925 3926
    ignore pdb
    ()
L
latkin 已提交
3927 3928
#else
    match pdb with 
D
Don Syme 已提交
3929
    | Some (pdbr, _) -> pdbReadClose pdbr
L
latkin 已提交
3930 3931 3932
    | None -> ()
#endif

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

3936 3937 3938 3939 3940 3941 3942
[<RequireQualifiedAccess>]
type MetadataOnlyFlag = Yes | No

[<RequireQualifiedAccess>]
type ReduceMemoryFlag = Yes | No

type ILReaderOptions =
3943
    { pdbDirPath: string option
3944 3945 3946 3947 3948
      ilGlobals: ILGlobals
      reduceMemoryUsage: ReduceMemoryFlag
      metadataOnly: MetadataOnlyFlag
      tryGetMetadataSnapshot: ILReaderTryGetMetadataSnapshot }

E
Eugene Auduchinok 已提交
3949 3950 3951 3952 3953 3954 3955 3956 3957

type ILModuleReader =
    abstract ILModuleDef : ILModuleDef
    abstract ILAssemblyRefs : ILAssemblyRef list
    
    /// ILModuleReader objects only need to be explicitly disposed if memory mapping is used, i.e. reduceMemoryUsage = false
    inherit  System.IDisposable


3958
[<Sealed>]
E
Eugene Auduchinok 已提交
3959 3960 3961 3962
type ILModuleReaderImpl(ilModule: ILModuleDef, ilAssemblyRefs: Lazy<ILAssemblyRef list>, dispose: unit -> unit) =
    interface ILModuleReader with
        member x.ILModuleDef = ilModule
        member x.ILAssemblyRefs = ilAssemblyRefs.Force()
3963 3964
        member x.Dispose() = dispose()
    
3965 3966
// ++GLOBAL MUTABLE STATE (concurrency safe via locking)
type ILModuleReaderCacheLockToken() = interface LockToken
3967 3968
type ILModuleReaderCacheKey = ILModuleReaderCacheKey of string * DateTime * ILScopeRef * bool * ReduceMemoryFlag * MetadataOnlyFlag
let ilModuleReaderCache = new AgedLookup<ILModuleReaderCacheLockToken, ILModuleReaderCacheKey, ILModuleReader>(stronglyHeldReaderCacheSize, areSimilar=(fun (x, y) -> x = y))
3969
let ilModuleReaderCacheLock = Lock()
L
latkin 已提交
3970

3971 3972 3973
let stableFileHeuristicApplies fileName = 
    not noStableFileHeuristic && try FileSystem.IsStableFileHeuristic fileName with _ -> false

3974
let createByteFileChunk opts fileName chunk = 
3975 3976 3977
    // 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 
3978
        WeakByteFile(fileName, chunk) :> BinaryFile 
3979
    else 
3980 3981 3982 3983
        let bytes = 
            match chunk with 
            | None -> FileSystem.ReadAllBytesShim fileName
            | Some (start, length) -> File.ReadBinaryChunk(fileName, start, length)
3984 3985
        ByteFile(fileName, bytes) :> BinaryFile

3986
let tryMemoryMapWholeFile opts fileName = 
3987 3988 3989 3990
    let file = 
        try 
            MemoryMapFile.Create fileName :> BinaryFile
        with _ ->
3991
            createByteFileChunk opts fileName None
3992 3993 3994 3995 3996 3997 3998 3999 4000 4001
    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
4002
    let ilModule, ilAssemblyRefs, pdb = openPE (fileName, pefile, opts.pdbDirPath, (opts.reduceMemoryUsage = ReduceMemoryFlag.Yes), opts.ilGlobals, true)
E
Eugene Auduchinok 已提交
4003
    new ILModuleReaderImpl(ilModule, ilAssemblyRefs, (fun () -> ClosePdbReader pdb)) :> ILModuleReader
4004

W
Will Smith 已提交
4005 4006
let ClearAllILModuleReaderCache() = ilModuleReaderCache.Clear(ILModuleReaderCacheLockToken())

4007
let OpenILModuleReader fileName opts = 
L
latkin 已提交
4008
    // Pseudo-normalize the paths.
4009
    let (ILModuleReaderCacheKey (fullPath,writeStamp,_,_,_,_) as key), keyOk = 
D
Don Syme 已提交
4010
        try 
4011 4012
           let fullPath = FileSystem.GetFullPathShim(fileName)
           let writeTime = FileSystem.GetLastWriteTimeShim(fileName)
4013
           let key = ILModuleReaderCacheKey (fullPath, writeTime, opts.ilGlobals.primaryAssemblyScopeRef, opts.pdbDirPath.IsSome, opts.reduceMemoryUsage, opts.metadataOnly)
4014 4015 4016 4017 4018
           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 已提交
4019

L
latkin 已提交
4020
    let cacheResult = 
4021
        if keyOk then 
4022
            if opts.pdbDirPath.IsSome then None // can't used a cached entry when reading PDBs, since it makes the returned object IDisposable
4023 4024 4025
            else ilModuleReaderCacheLock.AcquireLock (fun ltok -> ilModuleReaderCache.TryGet(ltok, key))
        else 
            None
D
Don Syme 已提交
4026

L
latkin 已提交
4027
    match cacheResult with 
4028
    | Some ilModuleReader -> ilModuleReader
L
latkin 已提交
4029
    | None -> 
4030 4031 4032 4033

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

4034
    if reduceMemoryUsage && opts.pdbDirPath.IsNone then 
4035 4036 4037

        // This case is used in FCS applications, devenv.exe and fsi.exe
        //
L
latkin 已提交
4038
        let ilModuleReader = 
4039 4040 4041 4042 4043
            // 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 = 
4044 4045
                    match opts.tryGetMetadataSnapshot (fullPath, writeStamp) with 
                    | Some (obj, start, len) -> Some (RawMemoryFile(fullPath, obj, start, len) :> BinaryFile)
4046 4047 4048 4049
                    | 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.
4050
                let disposer, pefileEager = tryMemoryMapWholeFile opts fullPath
4051
                use _disposer = disposer
4052
                let (metadataPhysLoc, metadataSize, peinfo, pectxtEager, pevEager, _pdb) = openPEFileReader (fullPath, pefileEager, None, false) 
4053 4054 4055 4056 4057
                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
4058
                        createByteFileChunk opts fullPath (Some (metadataPhysLoc, metadataSize))
4059

4060
                let ilModule, ilAssemblyRefs = openPEMetadataOnly (fullPath, peinfo, pectxtEager, pevEager, mdfile, reduceMemoryUsage, opts.ilGlobals) 
E
Eugene Auduchinok 已提交
4061
                new ILModuleReaderImpl(ilModule, ilAssemblyRefs, ignore)
4062 4063 4064
            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
4065
                let pefile = createByteFileChunk opts fullPath None
4066
                let ilModule, ilAssemblyRefs, _pdb = openPE (fullPath, pefile, None, reduceMemoryUsage, opts.ilGlobals, false) 
E
Eugene Auduchinok 已提交
4067
                new ILModuleReaderImpl(ilModule, ilAssemblyRefs, ignore)
4068 4069

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

E
Eugene Auduchinok 已提交
4072
        ilModuleReader :> ILModuleReader
4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083
                
    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
4084
        // still use an in-memory ByteFile
4085
        let _disposer, pefile = 
4086 4087
            if alwaysMemoryMapFSC || stableFileHeuristicApplies fullPath then 
                tryMemoryMapWholeFile opts fullPath
4088
            else
4089
                let pefile = createByteFileChunk opts fullPath None
4090 4091 4092
                let disposer = { new IDisposable with member __.Dispose() = () }
                disposer, pefile

4093
        let ilModule, ilAssemblyRefs, pdb = openPE (fullPath, pefile, opts.pdbDirPath, reduceMemoryUsage, opts.ilGlobals, false)
E
Eugene Auduchinok 已提交
4094
        let ilModuleReader = new ILModuleReaderImpl(ilModule, ilAssemblyRefs, (fun () -> ClosePdbReader pdb))
4095 4096

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

E
Eugene Auduchinok 已提交
4100 4101 4102 4103
        ilModuleReader :> ILModuleReader

[<AutoOpen>]
module Shim =
D
Don Syme 已提交
4104
    open FSharp.Compiler.Lib
L
latkin 已提交
4105

E
Eugene Auduchinok 已提交
4106 4107
    type IAssemblyReader =
        abstract GetILModuleReader: filename: string * readerOptions: ILReaderOptions -> ILModuleReader
L
latkin 已提交
4108

E
Eugene Auduchinok 已提交
4109 4110 4111 4112 4113
    [<Sealed>]
    type DefaultAssemblyReader() =
        interface IAssemblyReader with
            member __.GetILModuleReader(filename, readerOptions) =
                OpenILModuleReader filename readerOptions
L
latkin 已提交
4114

E
Eugene Auduchinok 已提交
4115
    let mutable AssemblyReader = DefaultAssemblyReader() :> IAssemblyReader