-
Notifications
You must be signed in to change notification settings - Fork 789
/
ilwrite.fs
4628 lines (3880 loc) · 210 KB
/
ilwrite.fs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
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
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
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
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
module internal FSharp.Compiler.AbstractIL.ILBinaryWriter
open System
open System.Collections.Generic
open System.IO
open Internal.Utilities
open FSharp.Compiler.AbstractIL.IL
open FSharp.Compiler.AbstractIL.Diagnostics
open FSharp.Compiler.AbstractIL.BinaryConstants
open FSharp.Compiler.AbstractIL.Support
open Internal.Utilities.Library
open FSharp.Compiler.AbstractIL.StrongNameSign
open FSharp.Compiler.AbstractIL.ILPdbWriter
open FSharp.Compiler.DiagnosticsLogger
open FSharp.Compiler.IO
open FSharp.Compiler.Text.Range
//---------------------------------------------------------------------
// Byte, byte array fragments and other concrete representations
// manipulations.
//---------------------------------------------------------------------
// Little-endian encoding of int32
let b0 n = byte (n &&& 0xFF)
let b1 n = byte ((n >>> 8) &&& 0xFF)
let b2 n = byte ((n >>> 16) &&& 0xFF)
let b3 n = byte ((n >>> 24) &&& 0xFF)
// Little-endian encoding of int64
let dw7 n = byte ((n >>> 56) &&& 0xFFL)
let dw6 n = byte ((n >>> 48) &&& 0xFFL)
let dw5 n = byte ((n >>> 40) &&& 0xFFL)
let dw4 n = byte ((n >>> 32) &&& 0xFFL)
let dw3 n = byte ((n >>> 24) &&& 0xFFL)
let dw2 n = byte ((n >>> 16) &&& 0xFFL)
let dw1 n = byte ((n >>> 8) &&& 0xFFL)
let dw0 n = byte (n &&& 0xFFL)
let bitsOfSingle (x: float32) = BitConverter.ToInt32(BitConverter.GetBytes x, 0)
let bitsOfDouble (x: float) = BitConverter.DoubleToInt64Bits x
/// Arbitrary value
[<Literal>]
let EmitBytesViaBufferCapacity = 10
let emitBytesViaBuffer f = use bb = ByteBuffer.Create EmitBytesViaBufferCapacity in f bb; bb.AsMemory().ToArray()
/// Alignment and padding
let align alignment n = ((n + alignment - 1) / alignment) * alignment
/// Maximum number of methods in a dotnet type
/// This differs from the spec and file formats slightly which suggests 0xfffe is the maximum
/// this value was identified empirically.
[<Literal>]
let maximumMethodsPerDotNetType = 0xfff0
//---------------------------------------------------------------------
// Concrete token representations etc. used in PE files
//---------------------------------------------------------------------
type ByteBuffer with
/// Z32 = compressed unsigned integer
static member Z32Size n =
if n <= 0x7F then 1
elif n <= 0x3FFF then 2
else 4
/// Emit int32 as compressed unsigned integer
member buf.EmitZ32 n =
if n >= 0 && n <= 0x7F then
buf.EmitIntAsByte n
elif n >= 0x80 && n <= 0x3FFF then
buf.EmitIntAsByte (0x80 ||| (n >>> 8))
buf.EmitIntAsByte (n &&& 0xFF)
else
buf.EmitIntAsByte (0xC0 ||| ((n >>> 24) &&& 0xFF))
buf.EmitIntAsByte ((n >>> 16) &&& 0xFF)
buf.EmitIntAsByte ((n >>> 8) &&& 0xFF)
buf.EmitIntAsByte (n &&& 0xFF)
member buf.EmitPadding n =
for i = 0 to n-1 do
buf.EmitByte 0x0uy
// Emit compressed untagged integer
member buf.EmitZUntaggedIndex big idx =
if big then buf.EmitInt32 idx
else
// Note, we can have idx=0x10000 generated for method table idx + 1 for just beyond last index of method table.
// This indicates that a MethodList, FieldList, PropertyList or EventList has zero entries
// For this case, the EmitInt32AsUInt16 writes a 0 (null) into the field. Binary readers respect this as an empty
// list of methods/fields/properties/events.
if idx > 0x10000 then
System.Diagnostics.Debug.Assert (false, "EmitZUntaggedIndex: too big for small address or simple index")
buf.EmitInt32AsUInt16 idx
// Emit compressed tagged integer
member buf.EmitZTaggedIndex tag nbits big idx =
let idx2 = (idx <<< nbits) ||| tag
if big then buf.EmitInt32 idx2
else buf.EmitInt32AsUInt16 idx2
let getUncodedToken (tab: TableName) idx = ((tab.Index <<< 24) ||| idx)
// From ECMA for UserStrings:
// This final byte holds the value 1 if and only if any UTF16 character within the string has any bit set in its top byte, or its low byte is any of the following:
// 0x01-0x08, 0x0E-0x1F, 0x27, 0x2D,
// 0x7F. Otherwise, it holds 0. The 1 signifies Unicode characters that require handling beyond that normally provided for 8-bit encoding sets.
// HOWEVER, there is a discrepancy here between the ECMA spec and the Microsoft C# implementation.
// The code below follows the latter. We've raised the issue with both teams. See Dev10 bug 850073 for details.
let markerForUnicodeBytes (b: byte[]) =
let len = b.Length
let rec scan i =
i < len/2 &&
(let b1 = Bytes.get b (i*2)
let b2 = Bytes.get b (i*2+1)
(b2 <> 0)
|| (b1 >= 0x01 && b1 <= 0x08) // as per ECMA and C#
|| (b1 >= 0xE && b1 <= 0x1F) // as per ECMA and C#
|| (b1 = 0x27) // as per ECMA and C#
|| (b1 = 0x2D) // as per ECMA and C#
|| (b1 > 0x7F) // as per C# (but ECMA omits this)
|| scan (i+1))
let marker = if scan 0 then 0x01 else 0x00
marker
// --------------------------------------------------------------------
// Fixups
// --------------------------------------------------------------------
/// Check that the data held at a fixup is some special magic value, as a sanity check
/// to ensure the fixup is being placed at a ood location.
let checkFixup32 (data: byte[]) offset exp =
if data[offset + 3] <> b3 exp then failwith "fixup sanity check failed"
if data[offset + 2] <> b2 exp then failwith "fixup sanity check failed"
if data[offset + 1] <> b1 exp then failwith "fixup sanity check failed"
if data[offset] <> b0 exp then failwith "fixup sanity check failed"
let applyFixup32 (data: byte[]) offset v =
data[offset] <- b0 v
data[offset+1] <- b1 v
data[offset+2] <- b2 v
data[offset+3] <- b3 v
//---------------------------------------------------------------------
// TYPES FOR TABLES
//---------------------------------------------------------------------
module RowElementTags =
let [<Literal>] UShort = 0
let [<Literal>] ULong = 1
let [<Literal>] Data = 2
let [<Literal>] DataResources = 3
let [<Literal>] Guid = 4
let [<Literal>] Blob = 5
let [<Literal>] String = 6
let [<Literal>] SimpleIndexMin = 7
let SimpleIndex (t : TableName) = assert (t.Index <= 112); SimpleIndexMin + t.Index
let [<Literal>] SimpleIndexMax = 119
let [<Literal>] TypeDefOrRefOrSpecMin = 120
let TypeDefOrRefOrSpec (t: TypeDefOrRefTag) = assert (t.Tag <= 2); TypeDefOrRefOrSpecMin + t.Tag (* + 111 + 1 = 0x70 + 1 = max TableName.Tndex + 1 *)
let [<Literal>] TypeDefOrRefOrSpecMax = 122
let [<Literal>] TypeOrMethodDefMin = 123
let TypeOrMethodDef (t: TypeOrMethodDefTag) = assert (t.Tag <= 1); TypeOrMethodDefMin + t.Tag (* + 2 + 1 = max TypeDefOrRefOrSpec.Tag + 1 *)
let [<Literal>] TypeOrMethodDefMax = 124
let [<Literal>] HasConstantMin = 125
let HasConstant (t: HasConstantTag) = assert (t.Tag <= 2); HasConstantMin + t.Tag (* + 1 + 1 = max TypeOrMethodDef.Tag + 1 *)
let [<Literal>] HasConstantMax = 127
let [<Literal>] HasCustomAttributeMin = 128
let HasCustomAttribute (t: HasCustomAttributeTag) = assert (t.Tag <= 21); HasCustomAttributeMin + t.Tag (* + 2 + 1 = max HasConstant.Tag + 1 *)
let [<Literal>] HasCustomAttributeMax = 149
let [<Literal>] HasFieldMarshalMin = 150
let HasFieldMarshal (t: HasFieldMarshalTag) = assert (t.Tag <= 1); HasFieldMarshalMin + t.Tag (* + 21 + 1 = max HasCustomAttribute.Tag + 1 *)
let [<Literal>] HasFieldMarshalMax = 151
let [<Literal>] HasDeclSecurityMin = 152
let HasDeclSecurity (t: HasDeclSecurityTag) = assert (t.Tag <= 2); HasDeclSecurityMin + t.Tag (* + 1 + 1 = max HasFieldMarshal.Tag + 1 *)
let [<Literal>] HasDeclSecurityMax = 154
let [<Literal>] MemberRefParentMin = 155
let MemberRefParent (t: MemberRefParentTag) = assert (t.Tag <= 4); MemberRefParentMin + t.Tag (* + 2 + 1 = max HasDeclSecurity.Tag + 1 *)
let [<Literal>] MemberRefParentMax = 159
let [<Literal>] HasSemanticsMin = 160
let HasSemantics (t: HasSemanticsTag) = assert (t.Tag <= 1); HasSemanticsMin + t.Tag (* + 4 + 1 = max MemberRefParent.Tag + 1 *)
let [<Literal>] HasSemanticsMax = 161
let [<Literal>] MethodDefOrRefMin = 162
let MethodDefOrRef (t: MethodDefOrRefTag) = assert (t.Tag <= 2); MethodDefOrRefMin + t.Tag (* + 1 + 1 = max HasSemantics.Tag + 1 *)
let [<Literal>] MethodDefOrRefMax = 164
let [<Literal>] MemberForwardedMin = 165
let MemberForwarded (t: MemberForwardedTag) = assert (t.Tag <= 1); MemberForwardedMin + t.Tag (* + 2 + 1 = max MethodDefOrRef.Tag + 1 *)
let [<Literal>] MemberForwardedMax = 166
let [<Literal>] ImplementationMin = 167
let Implementation (t: ImplementationTag) = assert (t.Tag <= 2); ImplementationMin + t.Tag (* + 1 + 1 = max MemberForwarded.Tag + 1 *)
let [<Literal>] ImplementationMax = 169
let [<Literal>] CustomAttributeTypeMin = 170
let CustomAttributeType (t: CustomAttributeTypeTag) = assert (t.Tag <= 3); CustomAttributeTypeMin + t.Tag (* + 2 + 1 = max Implementation.Tag + 1 *)
let [<Literal>] CustomAttributeTypeMax = 173
let [<Literal>] ResolutionScopeMin = 174
let ResolutionScope (t: ResolutionScopeTag) = assert (t.Tag <= 4); ResolutionScopeMin + t.Tag (* + 3 + 1 = max CustomAttributeType.Tag + 1 *)
let [<Literal>] ResolutionScopeMax = 178
[<Struct>]
type RowElement(tag: int32, idx: int32) =
member x.Tag = tag
member x.Val = idx
// These create RowElements
let UShort (x: uint16) = RowElement(RowElementTags.UShort, int32 x)
let ULong (x: int32) = RowElement(RowElementTags.ULong, x)
/// Index into cenv.data or cenv.resources. Gets fixed up later once we known an overall
/// location for the data section. flag indicates if offset is relative to cenv.resources.
let Data (x: int, k: bool) = RowElement((if k then RowElementTags.DataResources else RowElementTags.Data ), x)
/// pos. in guid array
let Guid (x: int) = RowElement(RowElementTags.Guid, x)
/// pos. in blob array
let Blob (x: int) = RowElement(RowElementTags.Blob, x)
/// pos. in string array
let StringE (x: int) = RowElement(RowElementTags.String, x)
/// pos. in some table
let SimpleIndex (t, x: int) = RowElement(RowElementTags.SimpleIndex t, x)
let TypeDefOrRefOrSpec (t, x: int) = RowElement(RowElementTags.TypeDefOrRefOrSpec t, x)
let TypeOrMethodDef (t, x: int) = RowElement(RowElementTags.TypeOrMethodDef t, x)
let HasConstant (t, x: int) = RowElement(RowElementTags.HasConstant t, x)
let HasCustomAttribute (t, x: int) = RowElement(RowElementTags.HasCustomAttribute t, x)
let HasFieldMarshal (t, x: int) = RowElement(RowElementTags.HasFieldMarshal t, x)
let HasDeclSecurity (t, x: int) = RowElement(RowElementTags.HasDeclSecurity t, x)
let MemberRefParent (t, x: int) = RowElement(RowElementTags.MemberRefParent t, x)
let HasSemantics (t, x: int) = RowElement(RowElementTags.HasSemantics t, x)
let MethodDefOrRef (t, x: int) = RowElement(RowElementTags.MethodDefOrRef t, x)
let MemberForwarded (t, x: int) = RowElement(RowElementTags.MemberForwarded t, x)
let Implementation (t, x: int) = RowElement(RowElementTags.Implementation t, x)
let CustomAttributeType (t, x: int) = RowElement(RowElementTags.CustomAttributeType t, x)
let ResolutionScope (t, x: int) = RowElement(RowElementTags.ResolutionScope t, x)
type BlobIndex = int
type StringIndex = int
let BlobIndex (x: BlobIndex) : int = x
let StringIndex (x: StringIndex) : int = x
let inline combineHash x2 acc = 37 * acc + x2 // (acc <<< 6 + acc >>> 2 + x2 + 0x9e3779b9)
let hashRow (elems: RowElement[]) =
let mutable acc = 0
for i in 0 .. elems.Length - 1 do
acc <- (acc <<< 1) + elems[i].Tag + elems[i].Val + 631
acc
let equalRows (elems: RowElement[]) (elems2: RowElement[]) =
if elems.Length <> elems2.Length then false else
let mutable ok = true
let n = elems.Length
let mutable i = 0
while ok && i < n do
if elems[i].Tag <> elems2[i].Tag || elems[i].Val <> elems2[i].Val then ok <- false
i <- i + 1
ok
type GenericRow = RowElement[]
/// This is the representation of shared rows is used for most shared row types.
/// Rows ILAssemblyRef and ILMethodRef are very common and are given their own
/// representations.
[<Struct; CustomEquality; NoComparison>]
type SharedRow(elems: RowElement[], hashCode: int) =
member x.GenericRow = elems
override x.GetHashCode() = hashCode
override x.Equals(obj: obj) =
match obj with
| :? SharedRow as y -> equalRows elems y.GenericRow
| _ -> false
let SharedRow(elems: RowElement[]) = SharedRow(elems, hashRow elems)
/// Special representation : Note, only hashing by name
let AssemblyRefRow(s1, s2, s3, s4, l1, b1, nameIdx, str2, b2) =
let hashCode = hash nameIdx
let genericRow = [| UShort s1; UShort s2; UShort s3; UShort s4; ULong l1; Blob b1; StringE nameIdx; StringE str2; Blob b2 |]
new SharedRow(genericRow, hashCode)
/// Special representation the computes the hash more efficiently
let MemberRefRow(mrp: RowElement, nmIdx: StringIndex, blobIdx: BlobIndex) =
let hashCode = combineHash (hash blobIdx) (combineHash (hash nmIdx) (hash mrp))
let genericRow = [| mrp; StringE nmIdx; Blob blobIdx |]
new SharedRow(genericRow, hashCode)
/// Unshared rows are used for definitional tables where elements do not need to be made unique
/// e.g. ILMethodDef and ILTypeDef. Most tables are like this. We don't precompute a
/// hash code for these rows, and indeed the GetHashCode and Equals should not be needed.
[<Struct; CustomEquality; NoComparison>]
type UnsharedRow(elems: RowElement[]) =
member x.GenericRow = elems
override x.GetHashCode() = hashRow elems
override x.Equals(obj: obj) =
match obj with
| :? UnsharedRow as y -> equalRows elems y.GenericRow
| _ -> false
//=====================================================================
//=====================================================================
// IL --> TABLES+CODE
//=====================================================================
//=====================================================================
// This environment keeps track of how many generic parameters are in scope.
// This lets us translate AbsIL type variable number to IL type variable numbering
type ILTypeWriterEnv = { EnclosingTyparCount: int }
let envForTypeDef (tdef: ILTypeDef) = { EnclosingTyparCount=tdef.GenericParams.Length }
let envForMethodRef env (ty: ILType) = { EnclosingTyparCount=(match ty with ILType.Array _ -> env.EnclosingTyparCount | _ -> ty.GenericArgs.Length) }
let envForNonGenericMethodRef _mref = { EnclosingTyparCount=Int32.MaxValue }
let envForFieldSpec (fspec: ILFieldSpec) = { EnclosingTyparCount=fspec.DeclaringType.GenericArgs.Length }
let envForOverrideSpec (ospec: ILOverridesSpec) = { EnclosingTyparCount=ospec.DeclaringType.GenericArgs.Length }
//---------------------------------------------------------------------
// TABLES
//---------------------------------------------------------------------
[<NoEquality; NoComparison>]
type MetadataTable<'T
#if !NO_CHECKNULLS
when 'T:not null
#endif
> =
{ name: string
dict: Dictionary<'T, int> // given a row, find its entry number
mutable rows: ResizeArray<'T> }
member x.Count = x.rows.Count
static member New(nm, hashEq) =
{ name=nm
dict = Dictionary<_, _>(100, hashEq)
rows= ResizeArray<_>() }
member tbl.EntriesAsArray =
tbl.rows |> ResizeArray.toArray
member tbl.Entries =
tbl.rows |> ResizeArray.toList
member tbl.AddSharedEntry x =
let n = tbl.rows.Count + 1
tbl.dict[x] <- n
tbl.rows.Add x
n
member tbl.AddUnsharedEntry x =
let n = tbl.rows.Count + 1
tbl.rows.Add x
n
member tbl.FindOrAddSharedEntry x =
match tbl.dict.TryGetValue x with
| true, res -> res
| _ -> tbl.AddSharedEntry x
member tbl.Contains x = tbl.dict.ContainsKey x
/// This is only used in one special place - see further below.
member tbl.SetRowsOfTable t =
tbl.rows <- ResizeArray.ofArray t
let h = tbl.dict
h.Clear()
t |> Array.iteri (fun i x -> h[x] <- (i+1))
member tbl.AddUniqueEntry nm getter x =
if tbl.dict.ContainsKey x then failwith ("duplicate entry '"+getter x+"' in "+nm+" table")
else tbl.AddSharedEntry x
member tbl.GetTableEntry x = tbl.dict[x]
override x.ToString() = "table " + x.name
//---------------------------------------------------------------------
// Keys into some of the tables
//---------------------------------------------------------------------
/// We use this key type to help find ILMethodDefs for MethodRefs
type MethodDefKey(ilg:ILGlobals, tidx: int, garity: int, nm: string, retTy: ILType, argTys: ILTypes, isStatic: bool) =
// Precompute the hash. The hash doesn't include the return type or
// argument types (only argument type count). This is very important, since
// hashing these is way too expensive
let hashCode =
hash tidx
|> combineHash (hash garity)
|> combineHash (hash nm)
|> combineHash (hash argTys.Length)
|> combineHash (hash isStatic)
member _.TypeIdx = tidx
member _.GenericArity = garity
member _.Name = nm
member _.ReturnType = retTy
member _.ArgTypes = argTys
member _.IsStatic = isStatic
override _.GetHashCode() = hashCode
override _.Equals(obj: obj) =
match obj with
| :? MethodDefKey as y ->
let compareILTypes o1 o2 =
match o1, o2 with
| ILType.Value v1, ILType.Value v2 -> v1.EqualsWithPrimaryScopeRef(ilg.primaryAssemblyScopeRef, v2 :> obj )
| _ -> o1 = o2
tidx = y.TypeIdx &&
garity = y.GenericArity &&
nm = y.Name &&
// note: these next two use structural equality on AbstractIL ILType values
retTy = y.ReturnType && List.lengthsEqAndForall2 compareILTypes argTys y.ArgTypes &&
isStatic = y.IsStatic
| _ -> false
override x.ToString() = nm
/// We use this key type to help find ILFieldDefs for FieldRefs
type FieldDefKey(tidx: int, nm: string, ty: ILType) =
// precompute the hash. hash doesn't include the type
let hashCode = hash tidx |> combineHash (hash nm)
member _.TypeIdx = tidx
member _.Name = nm
member _.Type = ty
override _.GetHashCode() = hashCode
override _.Equals(obj: obj) =
match obj with
| :? FieldDefKey as y ->
tidx = y.TypeIdx &&
nm = y.Name &&
ty = y.Type
| _ -> false
type PropertyTableKey = PropKey of int (* type. def. idx. *) * string * ILType * ILTypes
type EventTableKey = EventKey of int (* type. def. idx. *) * string
type TypeDefTableKey = TdKey of string list (* enclosing *) * string (* type name *)
//---------------------------------------------------------------------
// The Writer Context
//---------------------------------------------------------------------
[<NoComparison; NoEquality; RequireQualifiedAccess>]
type MetadataTable =
| Shared of MetadataTable<SharedRow>
| Unshared of MetadataTable<UnsharedRow>
member t.FindOrAddSharedEntry x = match t with Shared u -> u.FindOrAddSharedEntry x | Unshared u -> failwithf "FindOrAddSharedEntry: incorrect table kind, u.name = %s" u.name
member t.AddSharedEntry x = match t with | Shared u -> u.AddSharedEntry x | Unshared u -> failwithf "AddSharedEntry: incorrect table kind, u.name = %s" u.name
member t.AddUnsharedEntry x = match t with Unshared u -> u.AddUnsharedEntry x | Shared u -> failwithf "AddUnsharedEntry: incorrect table kind, u.name = %s" u.name
member t.GenericRowsOfTable = match t with Unshared u -> u.EntriesAsArray |> Array.map (fun x -> x.GenericRow) | Shared u -> u.EntriesAsArray |> Array.map (fun x -> x.GenericRow)
member t.SetRowsOfSharedTable rows = match t with Shared u -> u.SetRowsOfTable (Array.map SharedRow rows) | Unshared u -> failwithf "SetRowsOfSharedTable: incorrect table kind, u.name = %s" u.name
member t.Count = match t with Unshared u -> u.Count | Shared u -> u.Count
[<NoEquality; NoComparison>]
type cenv =
{ ilg: ILGlobals
emitTailcalls: bool
deterministic: bool
desiredMetadataVersion: ILVersionInfo
requiredDataFixups: (int32 * (int * bool)) list ref
/// References to strings in codestreams: offset of code and a (fixup-location, string token) list)
mutable requiredStringFixups: (int32 * (int * int) list) list
codeChunks: ByteBuffer
mutable nextCodeAddr: int32
/// Collected debug information
mutable moduleGuid: byte[]
generatePdb: bool
pdbinfo: ResizeArray<PdbMethodData>
documents: MetadataTable<PdbDocumentData>
/// Raw data, to go into the data section
data: ByteBuffer
/// Raw resource data, to go into the data section
resources: ByteBuffer
mutable entrypoint: (bool * int) option
/// Caches
trefCache: Dictionary<ILTypeRef, int>
/// The following are all used to generate unique items in the output
tables: MetadataTable[]
AssemblyRefs: MetadataTable<SharedRow>
fieldDefs: MetadataTable<FieldDefKey>
methodDefIdxsByKey: MetadataTable<MethodDefKey>
methodDefIdxs: Dictionary<ILMethodDef, int>
implementsIdxs: Dictionary<int,int list>
propertyDefs: MetadataTable<PropertyTableKey>
eventDefs: MetadataTable<EventTableKey>
typeDefs: MetadataTable<TypeDefTableKey>
guids: MetadataTable<byte[]>
blobs: MetadataTable<byte[]>
strings: MetadataTable<string>
userStrings: MetadataTable<string>
normalizeAssemblyRefs: ILAssemblyRef -> ILAssemblyRef
/// Indicates that the writing assembly will have an assembly-level attribute, System.Runtime.CompilerServices.InternalsVisibleToAttribute.
hasInternalsVisibleToAttrib: bool
/// Indicates that the writing assembly will be a reference assembly. Method bodies will be replaced with a `throw null` if there are any.
referenceAssemblyOnly: bool
pdbImports: Dictionary<ILDebugImports, PdbImports>
}
member cenv.GetTable (tab: TableName) = cenv.tables[tab.Index]
member cenv.AddCode ((reqdStringFixupsOffset, requiredStringFixups), code) =
if align 4 cenv.nextCodeAddr <> cenv.nextCodeAddr then dprintn "warning: code not 4-byte aligned"
cenv.requiredStringFixups <- (cenv.nextCodeAddr + reqdStringFixupsOffset, requiredStringFixups) :: cenv.requiredStringFixups
cenv.codeChunks.EmitBytes code
cenv.nextCodeAddr <- cenv.nextCodeAddr + code.Length
member cenv.GetCode() = cenv.codeChunks.AsMemory().ToArray()
member cenv.EmitDebugDocument (doc: ILSourceDocument) =
if cenv.generatePdb then
cenv.documents.FindOrAddSharedEntry doc |> ignore
override x.ToString() = "<cenv>"
interface IDisposable with
member this.Dispose() =
(this.codeChunks :> IDisposable).Dispose()
(this.data :> IDisposable).Dispose()
(this.resources :> IDisposable).Dispose()
let FindOrAddSharedRow (cenv: cenv) tbl x = cenv.GetTable(tbl).FindOrAddSharedEntry x
// Shared rows must be hash-cons'd to be made unique (no duplicates according to contents)
let AddSharedRow (cenv: cenv) tbl x = cenv.GetTable(tbl).AddSharedEntry x
// Unshared rows correspond to definition elements (e.g. a ILTypeDef or a ILMethodDef)
let AddUnsharedRow (cenv: cenv) tbl (x: UnsharedRow) = cenv.GetTable(tbl).AddUnsharedEntry x
let metadataSchemaVersionSupportedByCLRVersion v =
// Whidbey Beta 1 version numbers are between 2.0.40520.0 and 2.0.40607.0
// Later Whidbey versions are post 2.0.40607.0.. However we assume
// internal builds such as 2.0.x86chk are Whidbey Beta 2 or later
if compareILVersions v (parseILVersion "2.0.40520.0") >= 0 &&
compareILVersions v (parseILVersion "2.0.40608.0") < 0 then 1, 1
elif compareILVersions v (parseILVersion "2.0.0.0") >= 0 then 2, 0
else 1, 0
let headerVersionSupportedByCLRVersion v =
// The COM20HEADER version number
// Whidbey version numbers are 2.5
// Earlier are 2.0
// From an email from jeffschw: "Be built with a compiler that marks the COM20HEADER with Major >=2 and Minor >= 5. The V2.0 compilers produce images with 2.5, V1.x produces images with 2.0."
if compareILVersions v (parseILVersion "2.0.0.0") >= 0 then 2, 5
else 2, 0
let peOptionalHeaderByteByCLRVersion v =
// A flag in the PE file optional header seems to depend on CLI version
// Whidbey version numbers are 8
// Earlier are 6
// Tools are meant to ignore this, but the VS Profiler wants it to have the right value
if compareILVersions v (parseILVersion "2.0.0.0") >= 0 then 8
else 6
// returned by writeBinary
[<NoEquality; NoComparison>]
type ILTokenMappings =
{ TypeDefTokenMap: ILTypeDef list * ILTypeDef -> int32
FieldDefTokenMap: ILTypeDef list * ILTypeDef -> ILFieldDef -> int32
MethodDefTokenMap: ILTypeDef list * ILTypeDef -> ILMethodDef -> int32
PropertyTokenMap: ILTypeDef list * ILTypeDef -> ILPropertyDef -> int32
EventTokenMap: ILTypeDef list * ILTypeDef -> ILEventDef -> int32 }
let recordRequiredDataFixup (requiredDataFixups: ('T * 'U) list ref) (buf: ByteBuffer) pos lab =
requiredDataFixups.Value <- (pos, lab) :: requiredDataFixups.Value
// Write a special value in that we check later when applying the fixup
buf.EmitInt32 0xdeaddddd
//---------------------------------------------------------------------
// The UserString, BlobHeap, GuidHeap tables
//---------------------------------------------------------------------
let GetUserStringHeapIdx cenv s =
cenv.userStrings.FindOrAddSharedEntry s
let GetBytesAsBlobIdx cenv (bytes: byte[]) =
if bytes.Length = 0 then 0
else cenv.blobs.FindOrAddSharedEntry bytes
let GetStringHeapIdx cenv s =
if String.IsNullOrEmpty(s) then 0
else cenv.strings.FindOrAddSharedEntry s
let GetGuidIdx cenv info = cenv.guids.FindOrAddSharedEntry info
let GetStringHeapIdxOption cenv sopt =
match sopt with
| Some ns -> GetStringHeapIdx cenv ns
| None -> 0
let GetTypeNameAsElemPair cenv n =
let n1, n2 = splitTypeNameRight n
StringE (GetStringHeapIdxOption cenv n1),
StringE (GetStringHeapIdx cenv n2)
//=====================================================================
// Pass 1 - allocate indexes for types
//=====================================================================
let rec GenTypeDefPass1 enc cenv (tdef: ILTypeDef) =
ignore (cenv.typeDefs.AddUniqueEntry "type index" (fun (TdKey (_, n)) -> n) (TdKey (enc, tdef.Name)))
// Verify that the typedef contains fewer than maximumMethodsPerDotNetType
let count = tdef.Methods.AsArray().Length
if count > maximumMethodsPerDotNetType then
errorR(Error(FSComp.SR.tooManyMethodsInDotNetTypeWritingAssembly (tdef.Name, count, maximumMethodsPerDotNetType), rangeStartup))
GenTypeDefsPass1 (enc@[tdef.Name]) cenv (tdef.NestedTypes.AsList())
and GenTypeDefsPass1 enc cenv tdefs = List.iter (GenTypeDefPass1 enc cenv) tdefs
//=====================================================================
// Pass 2 - allocate indexes for methods and fields and write rows for types
//=====================================================================
let rec GetIdxForTypeDef cenv key =
try
cenv.typeDefs.GetTableEntry key
with
:? KeyNotFoundException ->
let (TdKey (enc, n) ) = key
errorR(InternalError("One of your modules expects the type '"+String.concat "." (enc@[n])+"' to be defined within the module being emitted. You may be missing an input file", range0))
0
// --------------------------------------------------------------------
// Assembly and module references
// --------------------------------------------------------------------
let rec GetAssemblyRefAsRow cenv (aref: ILAssemblyRef) =
AssemblyRefRow
((match aref.Version with None -> 0us | Some version -> version.Major),
(match aref.Version with None -> 0us | Some version -> version.Minor),
(match aref.Version with None -> 0us | Some version -> version.Build),
(match aref.Version with None -> 0us | Some version -> version.Revision),
((match aref.PublicKey with Some (PublicKey _) -> 0x0001 | _ -> 0x0000)
||| (if aref.Retargetable then 0x0100 else 0x0000)),
BlobIndex (match aref.PublicKey with
| None -> 0
| Some (PublicKey b | PublicKeyToken b) -> GetBytesAsBlobIdx cenv b),
StringIndex (GetStringHeapIdx cenv aref.Name),
StringIndex (match aref.Locale with None -> 0 | Some s -> GetStringHeapIdx cenv s),
BlobIndex (match aref.Hash with None -> 0 | Some s -> GetBytesAsBlobIdx cenv s))
and GetAssemblyRefAsIdx cenv aref =
FindOrAddSharedRow cenv TableNames.AssemblyRef (GetAssemblyRefAsRow cenv (cenv.normalizeAssemblyRefs aref))
and GetModuleRefAsRow cenv (mref: ILModuleRef) =
SharedRow
[| StringE (GetStringHeapIdx cenv mref.Name) |]
and GetModuleRefAsFileRow cenv (mref: ILModuleRef) =
SharedRow
[| ULong (if mref.HasMetadata then 0x0000 else 0x0001)
StringE (GetStringHeapIdx cenv mref.Name)
(match mref.Hash with None -> Blob 0 | Some s -> Blob (GetBytesAsBlobIdx cenv s)) |]
and GetModuleRefAsIdx cenv mref =
FindOrAddSharedRow cenv TableNames.ModuleRef (GetModuleRefAsRow cenv mref)
and GetModuleRefAsFileIdx cenv mref =
FindOrAddSharedRow cenv TableNames.File (GetModuleRefAsFileRow cenv mref)
// --------------------------------------------------------------------
// Does a ILScopeRef point to this module?
// --------------------------------------------------------------------
let isScopeRefLocal scoref = (scoref = ILScopeRef.Local)
let isTypeRefLocal (tref: ILTypeRef) = isScopeRefLocal tref.Scope
let isTypeLocal (ty: ILType) = ty.IsNominal && isNil ty.GenericArgs && isTypeRefLocal ty.TypeRef
// --------------------------------------------------------------------
// Scopes to Implementation elements.
// --------------------------------------------------------------------
let GetScopeRefAsImplementationElem cenv scoref =
match scoref with
| ILScopeRef.Local -> (i_AssemblyRef, 0)
| ILScopeRef.Assembly aref -> (i_AssemblyRef, GetAssemblyRefAsIdx cenv aref)
| ILScopeRef.Module mref -> (i_File, GetModuleRefAsFileIdx cenv mref)
| ILScopeRef.PrimaryAssembly -> (i_AssemblyRef, GetAssemblyRefAsIdx cenv cenv.ilg.primaryAssemblyRef)
// --------------------------------------------------------------------
// Type references, types etc.
// --------------------------------------------------------------------
let rec GetTypeRefAsTypeRefRow cenv (tref: ILTypeRef) =
let nselem, nelem = GetTypeNameAsElemPair cenv tref.Name
let rs1, rs2 = GetResolutionScopeAsElem cenv (tref.Scope, tref.Enclosing)
SharedRow [| ResolutionScope (rs1, rs2); nelem; nselem |]
and GetTypeRefAsTypeRefIdx cenv tref =
match cenv.trefCache.TryGetValue tref with
| true, res -> res
| _ ->
let res = FindOrAddSharedRow cenv TableNames.TypeRef (GetTypeRefAsTypeRefRow cenv tref)
cenv.trefCache[tref] <- res
res
and GetTypeDescAsTypeRefIdx cenv (scoref, enc, n) =
GetTypeRefAsTypeRefIdx cenv (mkILNestedTyRef (scoref, enc, n))
and GetResolutionScopeAsElem cenv (scoref, enc) =
match List.tryFrontAndBack enc with
| None ->
match scoref with
| ILScopeRef.Local -> (rs_Module, 1)
| ILScopeRef.Assembly aref -> (rs_AssemblyRef, GetAssemblyRefAsIdx cenv aref)
| ILScopeRef.Module mref -> (rs_ModuleRef, GetModuleRefAsIdx cenv mref)
| ILScopeRef.PrimaryAssembly -> (rs_AssemblyRef, GetAssemblyRefAsIdx cenv cenv.ilg.primaryAssemblyRef)
| Some (enc2, n2) ->
(rs_TypeRef, GetTypeDescAsTypeRefIdx cenv (scoref, enc2, n2))
let getTypeInfoAsTypeDefOrRefEncoded cenv (scoref, enc, nm) =
if isScopeRefLocal scoref then
let idx = GetIdxForTypeDef cenv (TdKey(enc, nm))
idx <<< 2 // ECMA 22.2.8 TypeDefOrRefEncoded - ILTypeDef
else
let idx = GetTypeDescAsTypeRefIdx cenv (scoref, enc, nm)
((idx <<< 2) ||| 0x01) // ECMA 22.2.8 TypeDefOrRefEncoded - ILTypeRef
let emitTypeInfoAsTypeDefOrRefEncoded cenv (bb: ByteBuffer) (scoref, enc, nm) =
let tok = getTypeInfoAsTypeDefOrRefEncoded cenv (scoref, enc, nm)
bb.EmitZ32 tok
let getTypeDefOrRefAsUncodedToken (tag, idx) =
let tab =
if tag = tdor_TypeDef then TableNames.TypeDef
elif tag = tdor_TypeRef then TableNames.TypeRef
elif tag = tdor_TypeSpec then TableNames.TypeSpec
else failwith "getTypeDefOrRefAsUncodedToken"
getUncodedToken tab idx
// REVIEW: write into an accumulating buffer
let EmitArrayShape (bb: ByteBuffer) (ILArrayShape shape) =
let sized = List.filter (function _, Some _ -> true | _ -> false) shape
let lobounded = List.filter (function Some _, _ -> true | _ -> false) shape
bb.EmitZ32 shape.Length
bb.EmitZ32 sized.Length
sized |> List.iter (function _, Some sz -> bb.EmitZ32 sz | _ -> failwith "?")
bb.EmitZ32 lobounded.Length
lobounded |> List.iter (function Some low, _ -> bb.EmitZ32 low | _ -> failwith "?")
let hasthisToByte hasthis =
match hasthis with
| ILThisConvention.Instance -> e_IMAGE_CEE_CS_CALLCONV_INSTANCE
| ILThisConvention.InstanceExplicit -> e_IMAGE_CEE_CS_CALLCONV_INSTANCE_EXPLICIT
| ILThisConvention.Static -> 0x00uy
let callconvToByte ntypars (Callconv (hasthis, bcc)) =
hasthisToByte hasthis |||
(if ntypars > 0 then e_IMAGE_CEE_CS_CALLCONV_GENERIC else 0x00uy) |||
(match bcc with
| ILArgConvention.FastCall -> e_IMAGE_CEE_CS_CALLCONV_FASTCALL
| ILArgConvention.StdCall -> e_IMAGE_CEE_CS_CALLCONV_STDCALL
| ILArgConvention.ThisCall -> e_IMAGE_CEE_CS_CALLCONV_THISCALL
| ILArgConvention.CDecl -> e_IMAGE_CEE_CS_CALLCONV_CDECL
| ILArgConvention.Default -> 0x00uy
| ILArgConvention.VarArg -> e_IMAGE_CEE_CS_CALLCONV_VARARG)
// REVIEW: write into an accumulating buffer
let rec EmitTypeSpec cenv env (bb: ByteBuffer) (et, tspec: ILTypeSpec) =
if isNil tspec.GenericArgs then
bb.EmitByte et
emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tspec.Scope, tspec.Enclosing, tspec.Name)
else
bb.EmitByte et_WITH
bb.EmitByte et
emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tspec.Scope, tspec.Enclosing, tspec.Name)
bb.EmitZ32 tspec.GenericArgs.Length
EmitTypes cenv env bb tspec.GenericArgs
and GetTypeAsTypeDefOrRef cenv env (ty: ILType) =
if isTypeLocal ty then
let tref = ty.TypeRef
(tdor_TypeDef, GetIdxForTypeDef cenv (TdKey(tref.Enclosing, tref.Name)))
elif ty.IsNominal && isNil ty.GenericArgs then
(tdor_TypeRef, GetTypeRefAsTypeRefIdx cenv ty.TypeRef)
else
(tdor_TypeSpec, GetTypeAsTypeSpecIdx cenv env ty)
and GetTypeAsBytes cenv env ty = emitBytesViaBuffer (fun bb -> EmitType cenv env bb ty)
and GetTypeOfLocalAsBytes cenv env (l: ILLocal) =
emitBytesViaBuffer (fun bb -> EmitLocalInfo cenv env bb l)
and GetTypeAsBlobIdx cenv env (ty: ILType) =
GetBytesAsBlobIdx cenv (GetTypeAsBytes cenv env ty)
and GetTypeAsTypeSpecRow cenv env (ty: ILType) =
SharedRow [| Blob (GetTypeAsBlobIdx cenv env ty) |]
and GetTypeAsTypeSpecIdx cenv env ty =
FindOrAddSharedRow cenv TableNames.TypeSpec (GetTypeAsTypeSpecRow cenv env ty)
and EmitType cenv env bb ty =
let ilg = cenv.ilg
match ty with
| ty when isILSByteTy ilg ty -> bb.EmitByte et_I1
| ty when isILInt16Ty ilg ty -> bb.EmitByte et_I2
| ty when isILInt32Ty ilg ty -> bb.EmitByte et_I4
| ty when isILInt64Ty ilg ty -> bb.EmitByte et_I8
| ty when isILByteTy ilg ty -> bb.EmitByte et_U1
| ty when isILUInt16Ty ilg ty -> bb.EmitByte et_U2
| ty when isILUInt32Ty ilg ty -> bb.EmitByte et_U4
| ty when isILUInt64Ty ilg ty -> bb.EmitByte et_U8
| ty when isILDoubleTy ilg ty -> bb.EmitByte et_R8
| ty when isILSingleTy ilg ty -> bb.EmitByte et_R4
| ty when isILBoolTy ilg ty -> bb.EmitByte et_BOOLEAN
| ty when isILCharTy ilg ty -> bb.EmitByte et_CHAR
| ty when isILStringTy ilg ty -> bb.EmitByte et_STRING
| ty when isILObjectTy ilg ty -> bb.EmitByte et_OBJECT
| ty when isILIntPtrTy ilg ty -> bb.EmitByte et_I
| ty when isILUIntPtrTy ilg ty -> bb.EmitByte et_U
| ty when isILTypedReferenceTy ilg ty -> bb.EmitByte et_TYPEDBYREF
| ILType.Boxed tspec -> EmitTypeSpec cenv env bb (et_CLASS, tspec)
| ILType.Value tspec -> EmitTypeSpec cenv env bb (et_VALUETYPE, tspec)
| ILType.Array (shape, ty) ->
if shape = ILArrayShape.SingleDimensional then (bb.EmitByte et_SZARRAY ; EmitType cenv env bb ty)
else (bb.EmitByte et_ARRAY; EmitType cenv env bb ty; EmitArrayShape bb shape)
| ILType.TypeVar tv ->
let cgparams = env.EnclosingTyparCount
if int32 tv < cgparams then
bb.EmitByte et_VAR
bb.EmitZ32 (int32 tv)
else
bb.EmitByte et_MVAR
bb.EmitZ32 (int32 tv - cgparams)
| ILType.Byref ty ->
bb.EmitByte et_BYREF
EmitType cenv env bb ty
| ILType.Ptr ty ->
bb.EmitByte et_PTR
EmitType cenv env bb ty
| ILType.Void ->
bb.EmitByte et_VOID
| ILType.FunctionPointer x ->
bb.EmitByte et_FNPTR
EmitCallsig cenv env bb (x.CallingConv, x.ArgTypes, x.ReturnType, None, 0)
| ILType.Modified (req, tref, ty) ->
bb.EmitByte (if req then et_CMOD_REQD else et_CMOD_OPT)
emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tref.Scope, tref.Enclosing, tref.Name)
EmitType cenv env bb ty
and EmitLocalInfo cenv env (bb: ByteBuffer) (l: ILLocal) =
if l.IsPinned then
bb.EmitByte et_PINNED
EmitType cenv env bb l.Type
and EmitCallsig cenv env bb (callconv, args: ILTypes, ret, varargs: ILVarArgs, genarity) =
bb.EmitByte (callconvToByte genarity callconv)
if genarity > 0 then bb.EmitZ32 genarity
bb.EmitZ32 (args.Length + (match varargs with None -> 0 | Some l -> l.Length))
EmitType cenv env bb ret
args |> List.iter (EmitType cenv env bb)
match varargs with
| None -> ()// no extra arg = no sentinel
| Some tys ->
if isNil tys then () // no extra arg = no sentinel
else
bb.EmitByte et_SENTINEL
List.iter (EmitType cenv env bb) tys
and GetCallsigAsBytes cenv env x = emitBytesViaBuffer (fun bb -> EmitCallsig cenv env bb x)
// REVIEW: write into an accumulating buffer
and EmitTypes cenv env bb (inst: ILTypes) =
inst |> List.iter (EmitType cenv env bb)
let GetTypeAsMemberRefParent cenv env ty =
match GetTypeAsTypeDefOrRef cenv env ty with
| tag, _ when tag = tdor_TypeDef -> dprintn "GetTypeAsMemberRefParent: mspec should have been encoded as mdtMethodDef?"; MemberRefParent (mrp_TypeRef, 1)
| tag, tok when tag = tdor_TypeRef -> MemberRefParent (mrp_TypeRef, tok)
| tag, tok when tag = tdor_TypeSpec -> MemberRefParent (mrp_TypeSpec, tok)
| _ -> failwith "GetTypeAsMemberRefParent"
// --------------------------------------------------------------------
// Native types
// --------------------------------------------------------------------
let rec GetVariantTypeAsInt32 ty =
if List.memAssoc ty (Lazy.force ILVariantTypeMap) then
(List.assoc ty (Lazy.force ILVariantTypeMap ))
else
match ty with
| ILNativeVariant.Array vt -> vt_ARRAY ||| GetVariantTypeAsInt32 vt
| ILNativeVariant.Vector vt -> vt_VECTOR ||| GetVariantTypeAsInt32 vt
| ILNativeVariant.Byref vt -> vt_BYREF ||| GetVariantTypeAsInt32 vt
| _ -> failwith "Unexpected variant type"
// based on information in ECMA and asmparse.y in the CLR codebase
let rec GetNativeTypeAsBlobIdx cenv (ty: ILNativeType) =
GetBytesAsBlobIdx cenv (GetNativeTypeAsBytes ty)
and GetNativeTypeAsBytes ty = emitBytesViaBuffer (fun bb -> EmitNativeType bb ty)
// REVIEW: write into an accumulating buffer
and EmitNativeType bb ty =
if List.memAssoc ty (Lazy.force ILNativeTypeRevMap) then
bb.EmitByte (List.assoc ty (Lazy.force ILNativeTypeRevMap))
else
match ty with
| ILNativeType.Empty -> ()
| ILNativeType.Custom (guid, nativeTypeName, custMarshallerName, cookieString) ->
let u1 = System.Text.Encoding.UTF8.GetBytes nativeTypeName
let u2 = System.Text.Encoding.UTF8.GetBytes custMarshallerName
let u3 = cookieString
bb.EmitByte nt_CUSTOMMARSHALER
bb.EmitZ32 guid.Length
bb.EmitBytes guid