1 (* ============================================================ *)
2 (* MsilUtil is the module which writes ILASM file structures *)
3 (* Copyright (c) John Gough 1999, 2000. *)
4 (* ============================================================ *)
23 (* ============================================================ *)
26 (* various ILASM-specific runtime name strings *)
30 (* Conversions from System.String to char[] *)
33 (* Runtime support for CP's MOD,DIV operations *)
46 (* various ILASM-specific runtime name strings *)
52 (* Error reporting facilities ................ *)
56 (* Conversions from char[] to System.String *)
58 (* various CPJ-specific concatenation helpers *)
65 (* ============================================================ *)
66 (* ============================================================ *)
68 TYPE Label
* = POINTER TO ABSTRACT
RECORD END;
69 LbArr
* = POINTER TO ARRAY OF Label
;
71 TYPE ProcInfo
* = POINTER TO (* EXTENSIBLE *) RECORD
72 prId
- : Sy
.Scope
; (* mth., prc. or mod. *)
73 rtLc
* : INTEGER; (* return value local # *)
74 (* ---- depth tracking ------ *)
75 dNum
- : INTEGER; (* current stack depth *)
76 dMax
- : INTEGER; (* maximum stack depth *)
77 (* ---- temp-var manager ---- *)
78 lNum
- : INTEGER; (* prog vars *)
79 tLst
- : Sy
.TypeSeq
; (* type list *)
80 fLst
- : Sy
.TypeSeq
; (* free list *)
81 (* ---- end temp manager ---- *)
82 exLb
* : Label
; (* exception exit label *)
85 (* ============================================================ *)
87 TYPE MsilFile
* = POINTER TO ABSTRACT
RECORD
88 srcS
* : Lv
.CharOpen
;(* source file name *)
93 (* ============================================================ *)
95 VAR nmArray
: Lv
.CharOpenSeq
;
98 VAR lPar
, rPar
, lBrk
, (* ( ) { *)
99 rBrk
, dotS
, rfMk
, (* } . & *)
100 atSg
, cmma
, (* @ , *)
106 ouMk
: Lv
.CharOpen
; (* "[out]" *)
108 evtAdd
, evtRem
: Lv
.CharOpen
;
109 pVarSuffix
: Lv
.CharOpen
;
112 vecPrefix
: Lv
.CharOpen
;
114 VAR boxedObj
: Lv
.CharOpen
;
115 corlibAsm
: Lv
.CharOpen
;
118 (* ============================================================ *)
120 VAR vecBlkId
: Id
.BlkId
;
122 vecTypes
: ARRAY Ty
.anyPtr
+1 OF Id
.TypId
; (* pointers *)
124 vecElms
: ARRAY Ty
.anyPtr
+1 OF Id
.FldId
;
125 vecExpnd
: ARRAY Ty
.anyPtr
+1 OF Id
.MthId
;
127 (* ============================================================ *)
129 VAR typeGetE
: ARRAY 16 OF INTEGER;
130 typePutE
: ARRAY 16 OF INTEGER;
131 typeStInd
: ARRAY 16 OF INTEGER;
132 typeLdInd
: ARRAY 16 OF INTEGER;
134 (* ============================================================ *)
136 PROCEDURE (t
: MsilFile
)fileOk
*() : BOOLEAN,NEW,ABSTRACT
;
137 (* Test if file was opened successfully *)
139 (* ============================================================ *)
140 (* EMPTY text format Procedures only overidden in IlasmUtil *)
141 (* ============================================================ *)
143 PROCEDURE (os
: MsilFile
)MkNewProcInfo
*(s
: Sy
.Scope
),NEW,ABSTRACT
;
144 PROCEDURE (os
: MsilFile
)Comment
*(IN s
: ARRAY OF CHAR),NEW,EMPTY
;
145 PROCEDURE (os
: MsilFile
)CommentT
*(IN s
: ARRAY OF CHAR),NEW,EMPTY
;
146 PROCEDURE (os
: MsilFile
)OpenBrace
*(i
: INTEGER),NEW,EMPTY
;
147 PROCEDURE (os
: MsilFile
)CloseBrace
*(i
: INTEGER),NEW,EMPTY
;
148 PROCEDURE (os
: MsilFile
)Blank
*(),NEW,EMPTY
;
150 (* ============================================================ *)
151 (* ABSTRACT Procedures overidden in both subclasses *)
152 (* ============================================================ *)
153 (* Various code emission methods *)
154 (* ============================================================ *)
156 PROCEDURE (os
: MsilFile
)Code
*(code
: INTEGER),NEW,ABSTRACT
;
158 PROCEDURE (os
: MsilFile
)CodeI
*(code
,int
: INTEGER),NEW,ABSTRACT
;
160 PROCEDURE (os
: MsilFile
)CodeT
*(code
: INTEGER; type
: Sy
.Type
),NEW,ABSTRACT
;
162 PROCEDURE (os
: MsilFile
)CodeTn
*(code
: INTEGER; type
: Sy
.Type
),NEW,ABSTRACT
;
164 PROCEDURE (os
: MsilFile
)CodeL
*(code
: INTEGER; long
: LONGINT),NEW,ABSTRACT
;
166 PROCEDURE (os
: MsilFile
)CodeR
*(code
: INTEGER; real
: REAL),NEW,ABSTRACT
;
168 PROCEDURE (os
: MsilFile
)CodeLb
*(code
: INTEGER; i2
: Label
),NEW,ABSTRACT
;
170 PROCEDURE (os
: MsilFile
)CodeS
*(code
: INTEGER;
171 str
: INTEGER),NEW,ABSTRACT
;
173 PROCEDURE (os
: MsilFile
)MkNewRecord
*(typ
: Ty
.Record
),NEW,ABSTRACT
;
174 (* emit constructor call ... *)
176 PROCEDURE (os
: MsilFile
)LoadType
*(id
: Sy
.Idnt
),NEW,ABSTRACT
;
177 (* load runtime type descriptor *)
179 PROCEDURE (os
: MsilFile
)PushStr
*(IN str
: ARRAY OF CHAR),NEW,ABSTRACT
;
180 (* load a literal string *)
182 PROCEDURE (os
: MsilFile
)NumberParams
*(pId
: Id
.Procs
;
183 pTp
: Ty
.Procedure
),NEW,ABSTRACT
;
185 PROCEDURE (os
: MsilFile
)Finish
*(),NEW,ABSTRACT
;
187 (* ============================================================ *)
189 PROCEDURE (os
: MsilFile
)MkBodyClass
*(mod
: Id
.BlkId
),NEW,ABSTRACT
;
190 PROCEDURE (os
: MsilFile
)ClassHead
*(attSet
: SET;
192 superT
: Ty
.Record
),NEW,ABSTRACT
;
193 PROCEDURE (os
: MsilFile
)StartBoxClass
*(rec
: Ty
.Record
;
195 blk
: Id
.BlkId
),NEW,ABSTRACT
;
196 PROCEDURE (os
: MsilFile
)ClassTail
*(),NEW,EMPTY
;
198 (* ============================================================ *)
200 PROCEDURE (os
: MsilFile
)StartNamespace
*(nm
: Lv
.CharOpen
),NEW,ABSTRACT
;
201 PROCEDURE (os
: MsilFile
)RefRTS
*(),NEW,ABSTRACT
;
203 PROCEDURE (os
: MsilFile
)MkBasX
*(t
: Ty
.Base
),NEW,EMPTY
;
204 PROCEDURE (os
: MsilFile
)MkArrX
*(t
: Ty
.Array
),NEW,EMPTY
;
205 PROCEDURE (os
: MsilFile
)MkPtrX
*(t
: Ty
.Pointer
),NEW,EMPTY
;
206 PROCEDURE (os
: MsilFile
)MkVecX
*(t
: Sy
.Type
; s
: Id
.BlkId
),NEW,EMPTY
;
207 PROCEDURE (os
: MsilFile
)MkEnuX
*(t
: Ty
.Enum
; s
: Sy
.Scope
),NEW,EMPTY
;
208 PROCEDURE (os
: MsilFile
)MkRecX
*(t
: Ty
.Record
; s
: Sy
.Scope
),NEW,EMPTY
;
209 PROCEDURE (os
: MsilFile
)AsmDef
*(IN pkNm
: ARRAY OF CHAR),NEW,EMPTY
;
210 PROCEDURE (os
: MsilFile
)SubSys
*(xAtt
: SET),NEW,ABSTRACT
;
212 (* ============================================================ *)
213 (* Calling a static (usually runtime helper) method *)
214 (* ============================================================ *)
216 PROCEDURE (os
: MsilFile
)StaticCall
*(s
: INTEGER;
217 d
: INTEGER),NEW,ABSTRACT
;
219 PROCEDURE (os
: MsilFile
)CopyCall
*(typ
: Ty
.Record
),NEW,ABSTRACT
;
221 (* ============================================================ *)
222 (* Calling a user defined method, constructor or delegate *)
223 (* ============================================================ *)
225 PROCEDURE (os
: MsilFile
)CallIT
*(code
: INTEGER;
227 type
: Ty
.Procedure
),NEW,ABSTRACT
;
229 PROCEDURE (os
: MsilFile
)CallCT
*(proc
: Id
.Procs
;
230 type
: Ty
.Procedure
),NEW,ABSTRACT
;
232 PROCEDURE (os
: MsilFile
)CallDelegate
*(typ
: Ty
.Procedure
),NEW,ABSTRACT
;
235 (* ============================================================ *)
236 (* Various element access abstractions *)
237 (* ============================================================ *)
239 PROCEDURE (os
: MsilFile
)PutGetS
*(code
: INTEGER;
241 fld
: Id
.VarId
),NEW,ABSTRACT
;
243 PROCEDURE (os
: MsilFile
)PutGetF
*(code
: INTEGER;
244 fld
: Id
.FldId
),NEW,ABSTRACT
;
246 PROCEDURE (os
: MsilFile
)GetValObj
*(code
: INTEGER;
247 ptrT
: Ty
.Pointer
),NEW,ABSTRACT
;
249 PROCEDURE (os
: MsilFile
)PutGetXhr
*(code
: INTEGER;
251 locD
: Id
.LocId
),NEW,ABSTRACT
;
253 (* ============================================================ *)
254 (* Line and Label handling *)
255 (* ============================================================ *)
257 PROCEDURE (os
: MsilFile
)Line
*(nm
: INTEGER),NEW,ABSTRACT
;
259 PROCEDURE (os
: MsilFile
)LinePlus
*(l
,w
: INTEGER),NEW,EMPTY
;
261 PROCEDURE (os
: MsilFile
)LineSpan
*(span
: Scn
.Span
),NEW,EMPTY
;
263 PROCEDURE (os
: MsilFile
)LstLab
*(l
: Label
),NEW,ABSTRACT
;
265 PROCEDURE (os
: MsilFile
)DefLab
*(l
: Label
),NEW,ABSTRACT
;
267 PROCEDURE (os
: MsilFile
)DefLabC
*(l
: Label
;
268 IN c
: ARRAY OF CHAR),NEW,ABSTRACT
;
270 (* ============================================================ *)
271 (* Declaration utilities *)
272 (* ============================================================ *)
274 PROCEDURE (os
: MsilFile
)EmitField
*(id
: Id
.AbVar
; att
: SET),NEW,ABSTRACT
;
276 PROCEDURE (os
: MsilFile
)ExternList
*(),NEW,ABSTRACT
;
278 PROCEDURE (os
: MsilFile
)MarkInterfaces
*(IN seq
: Sy
.TypeSeq
),NEW,ABSTRACT
;
280 (* ============================================================ *)
281 (* Start and finish various structures *)
282 (* ============================================================ *)
284 PROCEDURE (os
: MsilFile
)SwitchHead
*(num
: INTEGER),NEW,ABSTRACT
;
286 PROCEDURE (os
: MsilFile
)SwitchTail
*(),NEW,ABSTRACT
;
288 (* ------------------------------------------------------------ *)
290 PROCEDURE (os
: MsilFile
)Try
*(),NEW,ABSTRACT
;
291 PROCEDURE (os
: MsilFile
)Catch
*(proc
: Id
.Procs
),NEW,ABSTRACT
;
292 PROCEDURE (os
: MsilFile
)CloseCatch
*(),NEW,ABSTRACT
;
294 (* ------------------------------------------------------------ *)
296 PROCEDURE (os
: MsilFile
)MkNewProcVal
*(p
: Sy
.Idnt
; t
: Sy
.Type
),NEW,ABSTRACT
;
298 (* ------------------------------------------------------------ *)
300 PROCEDURE (os
: MsilFile
)InitHead
*(typ
: Ty
.Record
;
301 prc
: Id
.PrcId
),NEW,ABSTRACT
;
303 PROCEDURE (os
: MsilFile
)CallSuper
*(typ
: Ty
.Record
;
304 prc
: Id
.PrcId
),NEW,ABSTRACT
;
306 PROCEDURE (os
: MsilFile
)InitTail
*(typ
: Ty
.Record
),NEW,ABSTRACT
;
308 (* ------------------------------------------------------------ *)
310 PROCEDURE (os
: MsilFile
)CopyHead
*(typ
: Ty
.Record
),NEW,ABSTRACT
;
312 PROCEDURE (os
: MsilFile
)CopyTail
*(),NEW,ABSTRACT
;
314 (* ------------------------------------------------------------ *)
316 PROCEDURE (os
: MsilFile
)MainHead
*(xAtt
: SET),NEW,ABSTRACT
;
318 PROCEDURE (os
: MsilFile
)MainTail
*(),NEW,ABSTRACT
;
320 (* ------------------------------------------------------------ *)
322 PROCEDURE (os
: MsilFile
)ClinitHead
*(),NEW,ABSTRACT
;
324 PROCEDURE (os
: MsilFile
)ClinitTail
*(),NEW,ABSTRACT
;
326 (* ------------------------------------------------------------ *)
328 PROCEDURE (os
: MsilFile
)MethodDecl
*(attr
: SET;
329 proc
: Id
.Procs
),NEW,ABSTRACT
;
331 PROCEDURE (os
: MsilFile
)MethodTail
*(id
: Id
.Procs
),NEW,ABSTRACT
;
333 (* ============================================================ *)
334 (* Start of Procedure Variable and Event Stuff *)
335 (* ============================================================ *)
337 PROCEDURE (os
: MsilFile
)EmitEventMethods
*(id
: Id
.AbVar
),NEW,ABSTRACT
;
339 PROCEDURE (os
: MsilFile
)EmitPTypeBody
*(tId
: Id
.TypId
),NEW,ABSTRACT
;
341 PROCEDURE (os
: MsilFile
)MkAndLinkDelegate
*(dl
: Sy
.Idnt
;
344 add
: BOOLEAN),NEW,ABSTRACT
;
346 (* ============================================================ *)
347 (* End of Procedure Variable and Event Stuff *)
348 (* ============================================================ *)
350 (* ==================================================================== *
351 * A word on naming for the ILASM version. *
352 * ==================================================================== *
353 * Part one: module-level declarations, in Module Mmm. *
354 * TYPE Ttt = POINTER TO RECORD ... END; *
355 * has ilasm class name *
356 * .class <attr> Mmm.Ttt { ... } *
357 * Similarly the static procedure *
358 * PROCEDURE Ppp(); END Ppp; *
359 * has ilasm method name (inside static class Mmm) *
360 * .method <attr> void Ppp() {...} *
361 * which is referenced as *
362 * Ppp(...) within the static class, & *
363 * Mmm::Ppp(...) elswhere inside the module, & *
364 * [Mmm]Mmm::Ppp(...) from outside the module. *
365 * Likewise, methods bound to Ttt will be referenced as *
366 * Ppp(...) inside the dynamic class, & *
367 * Mmm.Ttt::Ppp(...) elsewhere inside the module, & *
368 * [Mmm]Mmm.Ttt::Ppp(...) from outside the module. *
370 * ==================================================================== *
371 * Part two: declarations nested inside procedure Outer (say). *
372 * PROCEDURE Ppp(); END Ppp; *
373 * will have ilasm name (inside Mmm) *
374 * .method <attr> void Outer@Ppp() {...} *
375 * which is referenced as *
377 * Nested type Ttt will have name *
378 * .struct(?) <attr> Mmm.Outer@Ttt {...} *
379 * and cannot have type bound procedures, or be exported. *
381 * ==================================================================== *
382 * Where are these names stored? *
383 * The principle is: every identifier has its class name stored in *
384 * in d.scopeNm, and its simple name is stored in d.xName. *
385 * Thus, for names defined in this module: *
386 * ==================================================================== *
387 * The name for BlkId Mmm is stored in desc.xName, as *
388 * desc.xName = "Mmm" *
389 * desc.scopeNm = "Mmm" *
390 * The names for PrcId Ppp are stored as *
391 * desc.xName = "Ppp" *
392 * desc.scopeNm = "Mmm" *
393 * or in the nested case... *
394 * desc.xName = "Outer@Ppp" *
395 * desc.scopeNm = "Mmm" *
396 * The names for (non-nested) MthId Ppp are stored as *
397 * desc.xName = "Ppp" *
398 * desc.scopeNm = "Mmm.Ttt" *
400 * For types, the names are stored thuswise. *
401 * The name for Record descriptor Ttt will be *
402 * recT.xName = "Mmm_Ttt" *
403 * recT.scopeNm = "Mmm_Ttt" *
404 * or in the nested case ... *
405 * recT.xName = "Mmm_Ppp@Ttt" *
406 * recT.scopeNm = "Mmm_Ppp@Ttt" *
408 * ==================================================================== *
409 * Where are these names stored? For external names: *
410 * ==================================================================== *
411 * The name for BlkId Mmm is stored in desc.xName, as *
412 * desc.xName = "Mmm" *
413 * desc.scopeNm = "[Mmm]Mmm" *
414 * The names for PrcId Ppp are stored as *
415 * desc.xName = "Ppp" *
416 * desc.scopeNm = "[Mmm]Mmm" *
417 * The names for (non-nested) MthId Ppp are stored as *
418 * desc.xName = "Ppp" *
419 * desc.scopeNm = "[Mmm]Mmm_Ttt" *
421 * For types, the names are stored thuswise. *
422 * The name for Record descriptor Ttt will be *
423 * recT.xName = "Mmm_Ttt" *
424 * recT.scopeNm = "[Mmm]Mmm_Ttt" *
425 * ==================================================================== *
426 * ==================================================================== *)
429 (* ============================================================ *)
430 (* Some static utilities *)
431 (* ============================================================ *)
433 PROCEDURE cat2
*(i
,j
: Lv
.CharOpen
) : Lv
.CharOpen
;
435 Lv
.ResetCharOpenSeq(nmArray
);
436 Lv
.AppendCharOpen(nmArray
, i
);
437 Lv
.AppendCharOpen(nmArray
, j
);
438 RETURN Lv
.arrayCat(nmArray
);
441 (* ============================================================ *)
443 PROCEDURE cat3
*(i
,j
,k
: Lv
.CharOpen
) : Lv
.CharOpen
;
445 Lv
.ResetCharOpenSeq(nmArray
);
446 Lv
.AppendCharOpen(nmArray
, i
);
447 Lv
.AppendCharOpen(nmArray
, j
);
448 Lv
.AppendCharOpen(nmArray
, k
);
449 RETURN Lv
.arrayCat(nmArray
);
452 (* ============================================================ *)
454 PROCEDURE cat4
*(i
,j
,k
,l
: Lv
.CharOpen
) : Lv
.CharOpen
;
456 Lv
.ResetCharOpenSeq(nmArray
);
457 Lv
.AppendCharOpen(nmArray
, i
);
458 Lv
.AppendCharOpen(nmArray
, j
);
459 Lv
.AppendCharOpen(nmArray
, k
);
460 Lv
.AppendCharOpen(nmArray
, l
);
461 RETURN Lv
.arrayCat(nmArray
);
464 (* ============================================================ *)
466 PROCEDURE mapVecElTp(typ
: Sy
.Type
) : INTEGER;
468 WITH typ
: Ty
.Base
DO
470 | Ty
.sChrN
: RETURN Ty
.charN
;
471 | Ty
.boolN
, Ty
.byteN
, Ty
.sIntN
, Ty
.setN
, Ty
.uBytN
: RETURN Ty
.intN
;
472 | Ty
.charN
, Ty
.intN
, Ty
.lIntN
, Ty
.sReaN
, Ty
.realN
: RETURN typ
.tpOrd
;
473 ELSE RETURN Ty
.anyPtr
;
475 ELSE RETURN Ty
.anyPtr
;
480 PROCEDURE mapOrdRepT(ord
: INTEGER) : Sy
.Type
;
483 | Ty
.charN
: RETURN Bi
.charTp
;
484 | Ty
.intN
: RETURN Bi
.intTp
;
485 | Ty
.lIntN
: RETURN Bi
.lIntTp
;
486 | Ty
.sReaN
: RETURN Bi
.sReaTp
;
487 | Ty
.realN
: RETURN Bi
.realTp
;
488 | Ty
.anyPtr
: RETURN Bi
.anyPtr
;
492 (* ============================================================ *)
494 PROCEDURE^ MkProcName
*(proc
: Id
.Procs
; os
: MsilFile
);
495 PROCEDURE^ MkAliasName
*(typ
: Ty
.Opaque
; os
: MsilFile
);
496 PROCEDURE^ MkEnumName
*(typ
: Ty
.Enum
; os
: MsilFile
);
497 PROCEDURE^ MkTypeName
*(typ
: Sy
.Type
; fil
: MsilFile
);
498 PROCEDURE^ MkRecName
*(typ
: Ty
.Record
; os
: MsilFile
);
499 PROCEDURE^ MkPtrName
*(typ
: Ty
.Pointer
; os
: MsilFile
);
500 PROCEDURE^ MkPTypeName
*(typ
: Ty
.Procedure
; os
: MsilFile
);
501 PROCEDURE^ MkIdName
*(id
: Sy
.Idnt
; os
: MsilFile
);
502 PROCEDURE^
MkBasName(typ
: Ty
.Base
; os
: MsilFile
);
503 PROCEDURE^
MkArrName(typ
: Ty
.Array
; os
: MsilFile
);
504 PROCEDURE^
MkVecName(typ
: Ty
.Vector
; os
: MsilFile
);
506 PROCEDURE^
(os
: MsilFile
)PutUplevel
*(var
: Id
.LocId
),NEW;
507 PROCEDURE^
(os
: MsilFile
)PushInt
*(num
: INTEGER),NEW;
508 PROCEDURE^
(os
: MsilFile
)GetVar
*(id
: Sy
.Idnt
),NEW;
509 PROCEDURE^
(os
: MsilFile
)GetVarA
*(id
: Sy
.Idnt
),NEW;
510 PROCEDURE^
(os
: MsilFile
)PushLocal
*(ord
: INTEGER),NEW;
511 PROCEDURE^
(os
: MsilFile
)StoreLocal
*(ord
: INTEGER),NEW;
512 PROCEDURE^
(os
: MsilFile
)FixCopies(prId
: Sy
.Idnt
),NEW;
513 PROCEDURE^
(os
: MsilFile
)DecTemp(ord
: INTEGER),NEW;
514 PROCEDURE^
(os
: MsilFile
)PutElem
*(typ
: Sy
.Type
),NEW;
515 PROCEDURE^
(os
: MsilFile
)GetElem
*(typ
: Sy
.Type
),NEW;
517 (* ------------------------------------------------------------ *)
519 PROCEDURE takeAdrs
*(i
: Id
.ParId
) : BOOLEAN;
520 (* A parameter needs to have its address taken iff *)
521 (* * Param Mode is VAL & FALSE *)
522 (* * Param Mode is VAR & type is value class or scalar *)
523 (* * Param Mode is OUT & type is value class or scalar *)
524 (* * Param Mode is IN & type is value class *)
525 (* (IN Scalars get treated as VAL on the caller side) *)
528 IF i
.parMod
= Sy
.val
THEN RETURN FALSE
END;
530 IF i
.type
IS Ty
.Opaque
THEN i
.type
:= i
.type(Ty
.Opaque
).resolved
END;
533 WITH type
: Ty
.Vector
DO RETURN i
.parMod
# Sy
.in
;
534 | type
: Ty
.Array
DO RETURN FALSE
;
535 | type
: Ty
.Record
DO RETURN ~
(Sy
.clsTp
IN type
.xAttr
);
536 ELSE (* scalar type *) RETURN i
.parMod
# Sy
.in
;
540 (* ------------------------------------------------------------ *)
542 PROCEDURE needsInit
*(type
: Sy
.Type
) : BOOLEAN;
544 WITH type
: Ty
.Vector
DO RETURN FALSE
;
545 | type
: Ty
.Array
DO RETURN type
.length
# 0;
546 | type
: Ty
.Record
DO RETURN Sy
.clsTp
IN type
.xAttr
;
547 ELSE (* scalar type *) RETURN FALSE
;
551 (* ------------------------------------------------------------ *)
553 PROCEDURE isRefSurrogate
*(type
: Sy
.Type
) : BOOLEAN;
555 WITH type
: Ty
.Array
DO RETURN type
.kind
# Ty
.vecTp
;
556 | type
: Ty
.Record
DO RETURN Sy
.clsTp
IN type
.xAttr
;
557 ELSE (* scalar type *) RETURN FALSE
;
561 (* ------------------------------------------------------------ *)
563 PROCEDURE hasValueRep
*(type
: Sy
.Type
) : BOOLEAN;
565 WITH type
: Ty
.Array
DO RETURN type
.kind
= Ty
.vecTp
;
566 | type
: Ty
.Record
DO RETURN ~
(Sy
.clsTp
IN type
.xAttr
);
567 ELSE (* scalar type *) RETURN TRUE
;
571 (* ------------------------------------------------------------ *)
573 PROCEDURE isValRecord
*(type
: Sy
.Type
) : BOOLEAN;
575 WITH type
: Ty
.Array
DO RETURN FALSE
;
576 | type
: Ty
.Record
DO RETURN ~
(Sy
.clsTp
IN type
.xAttr
);
577 ELSE (* scalar type *) RETURN FALSE
;
581 (* ------------------------------------------------------------ *)
583 PROCEDURE vecMod() : Id
.BlkId
;
585 IF vecBlkId
= NIL THEN
586 Bi
.MkDummyImport("RTS_Vectors", "[RTS]Vectors", vecBlkId
);
587 Bi
.MkDummyClass("VecBase", vecBlkId
, Ty
.noAtt
, vecBase
);
592 PROCEDURE vecClass(ord
: INTEGER) : Id
.TypId
;
593 VAR str
: ARRAY 8 OF CHAR;
597 IF vecTypes
[ord
] = NIL THEN
599 | Ty
.charN
: str
:= "VecChr";
600 | Ty
.intN
: str
:= "VecI32";
601 | Ty
.lIntN
: str
:= "VecI64";
602 | Ty
.sReaN
: str
:= "VecR32";
603 | Ty
.realN
: str
:= "VecR64";
604 | Ty
.anyPtr
: str
:= "VecRef";
606 Bi
.MkDummyClass(str
, vecMod(), Ty
.noAtt
, tId
);
607 rcT
:= tId
.type
.boundRecTp()(Ty
.Record
);
608 rcT
.baseTp
:= vecBase
.type
.boundRecTp();
609 vecTypes
[ord
] := tId
;
611 RETURN vecTypes
[ord
];
614 PROCEDURE vecRecord(ord
: INTEGER) : Ty
.Record
;
616 RETURN vecClass(ord
).type
.boundRecTp()(Ty
.Record
);
619 PROCEDURE vecArray(ord
: INTEGER) : Id
.FldId
;
622 IF vecElms
[ord
] = NIL THEN
623 fld
:= Id
.newFldId();
624 fld
.hash
:= NameHash
.enterStr("elms");
625 fld
.dfScp
:= vecMod();
626 fld
.recTyp
:= vecRecord(ord
);
627 fld
.type
:= Ty
.mkArrayOf(mapOrdRepT(ord
));
633 (* ------------------------------------------------------------ *)
635 PROCEDURE vecArrFld
*(typ
: Ty
.Vector
; os
: MsilFile
) : Id
.FldId
;
638 fld
:= vecArray(mapVecElTp(typ
.elemTp
));
639 IF fld
.recTyp
.xName
= NIL THEN MkRecName(fld
.recTyp(Ty
.Record
), os
) END;
643 PROCEDURE vecRepTyp
*(typ
: Ty
.Vector
) : Sy
.Type
;
645 RETURN vecClass(mapVecElTp(typ
.elemTp
)).type
;
648 PROCEDURE vecRepElTp
*(typ
: Ty
.Vector
) : Sy
.Type
;
650 RETURN mapOrdRepT(mapVecElTp(typ
.elemTp
));
653 PROCEDURE vecLeng
*(os
: MsilFile
) : Id
.FldId
;
655 IF vecTide
= NIL THEN
656 vecTide
:= Id
.newFldId();
657 vecTide
.hash
:= NameHash
.enterStr("tide");
658 vecTide
.dfScp
:= vecMod();
659 vecTide
.recTyp
:= vecBase
.type
.boundRecTp();
660 vecTide
.type
:= Bi
.intTp
;
661 MkRecName(vecTide
.recTyp(Ty
.Record
), os
);
666 (* ------------------------------------------------------------ *)
668 PROCEDURE (os
: MsilFile
)InvokeExpand
*(typ
: Ty
.Vector
),NEW;
669 (* Assert: vector ref is on stack *)
674 ord
:= mapVecElTp(typ
.elemTp
);
675 xpd
:= vecExpnd
[ord
];
677 xpd
:= Id
.newMthId();
678 xpd
.hash
:= Bi
.xpndBk
;
679 xpd
.dfScp
:= vecMod();
680 xpT
:= Ty
.newPrcTp();
682 xpT
.receiver
:= vecClass(ord
).type
;
683 xpd
.bndType
:= xpT
.receiver
.boundRecTp();
685 os
.NumberParams(xpd
, xpT
);
687 vecExpnd
[ord
] := xpd
;
689 os
.CallIT(Asm
.opc_callvirt
, xpd
, xpd
.type(Ty
.Procedure
));
692 (* ------------------------------------------------------------ *)
693 (* ------------------------------------------------------------ *)
695 PROCEDURE xhrCount(tgt
, ths
: Id
.Procs
) : INTEGER;
698 IF ths
.lxDepth
= 0 THEN RETURN 0 END;
700 * "ths" is the calling procedure.
701 * "tgt" is the procedure with the uplevel data.
705 ths
:= ths
.dfScp(Id
.Procs
);
706 IF Id
.hasXHR
IN ths
.pAttr
THEN INC(count
) END;
707 UNTIL (ths
.lxDepth
= 0) OR
708 ((ths
.lxDepth
<= tgt
.lxDepth
) & (Id
.hasXHR
IN ths
.pAttr
));
712 PROCEDURE newXHR() : Lv
.CharOpen
;
715 RETURN cat2(xhrDl
, Lv
.intToCharOpen(xhrIx
));
718 PROCEDURE MkXHR(scp
: Id
.Procs
);
719 VAR typId
: Id
.TypId
;
726 * Create a type descriptor for the eXplicit
727 * Heap-allocated activation Record. This is
728 * an extension of the [RTS]XHR system type.
730 Bi
.MkDummyClass(newXHR(), CSt
.thisMod
, Ty
.noAtt
, typId
);
731 typId
.SetMode(Sy
.prvMode
);
732 scp
.xhrType
:= typId
.type
;
733 recTp
:= typId
.type
.boundRecTp()(Ty
.Record
);
734 recTp
.baseTp
:= CSt
.rtsXHR
.boundRecTp();
735 INCL(recTp
.xAttr
, Sy
.noCpy
);
737 FOR index
:= 0 TO scp
.locals
.tide
-1 DO
738 locVr
:= scp
.locals
.a
[index
](Id
.LocId
);
739 IF Id
.uplevA
IN locVr
.locAtt
THEN
740 fldVr
:= Id
.newFldId();
741 fldVr
.hash
:= locVr
.hash
;
742 fldVr
.type
:= locVr
.type
;
743 fldVr
.recTyp
:= recTp
;
744 Sy
.AppendIdnt(recTp
.fields
, fldVr
);
749 (* ============================================================ *)
750 (* ProcInfo Methods *)
751 (* ============================================================ *)
753 PROCEDURE InitProcInfo
*(info
: ProcInfo
; proc
: Sy
.Scope
);
757 * Assert: the locals have already been numbered
758 * by a call to NumberLocals(), and
759 * rtsFram has been set accordingly.
762 WITH proc
: Id
.Procs
DO
763 info
.lNum
:= proc
.rtsFram
;
764 IF info
.lNum
> 0 THEN
765 Sy
.InitTypeSeq(info
.tLst
, info
.lNum
* 2); (* the (t)ypeList *)
766 Sy
.InitTypeSeq(info
.fLst
, info
.lNum
* 2); (* the (f)reeList *)
767 FOR i
:= 0 TO info
.lNum
-1 DO
768 Sy
.AppendType(info
.tLst
, NIL);
769 Sy
.AppendType(info
.fLst
, NIL);
777 info
.rtLc
:= -1; (* maybe different for IlasmUtil and PeUtil? *)
780 (* ------------------------------------------------------------ *)
782 PROCEDURE (info
: ProcInfo
)newLocal
*(typ
: Sy
.Type
) : INTEGER,NEW;
786 * We try to find a previously allocated, but
787 * currently free slot of the identical type.
789 FOR ord
:= info
.lNum
TO info
.tLst
.tide
-1 DO
790 IF typ
.equalType(info
.fLst
.a
[ord
]) THEN
791 info
.fLst
.a
[ord
] := NIL; (* mark ord as used *)
795 (* Free slot of correct type not found *)
796 ord
:= info
.tLst
.tide
;
797 Sy
.AppendType(info
.tLst
, typ
);
798 Sy
.AppendType(info
.fLst
, NIL);
802 (* ------------------------------------------------------------ *)
804 PROCEDURE (info
: ProcInfo
)ReleaseLocal
*(ord
: INTEGER),NEW;
806 info
.fLst
.a
[ord
] := info
.tLst
.a
[ord
];
809 (* ------------------------------------------------------------ *)
811 PROCEDURE (info
: ProcInfo
)numLocals
*() : INTEGER,NEW;
813 RETURN info
.tLst
.tide
;
816 (* ------------------------------------------------------------ *)
818 PROCEDURE (info
: ProcInfo
)SetDepth
*(d
: INTEGER),NEW;
823 (* ------------------------------------------------------------ *)
825 PROCEDURE (info
: ProcInfo
)getDepth
*() : INTEGER,NEW;
830 (* ============================================================ *)
831 (* Private Methods *)
832 (* ============================================================ *)
835 PROCEDURE typeName
*(typ
: Sy
.Type
; os
: MsilFile
) : Lv
.CharOpen
;
837 IF typ
.xName
= NIL THEN MkTypeName(typ
, os
) END;
838 WITH typ
: Ty
.Base
DO
844 | typ
: Ty
.Pointer
DO
850 | typ
: Ty
.Procedure
DO
855 (* ============================================================ *)
857 PROCEDURE boxedName
*(typ
: Ty
.Record
; os
: MsilFile
) : Lv
.CharOpen
;
859 IF typ
.xName
= NIL THEN MkRecName(typ
, os
) END;
860 RETURN cat3(typ
.idnt
.dfScp
.scopeNm
, boxedObj
, typ
.xName
);
863 (* ============================================================ *)
865 PROCEDURE MkTypeName
*(typ
: Sy
.Type
; fil
: MsilFile
);
867 WITH typ
: Ty
.Vector
DO MkVecName(typ
, fil
);
868 | typ
: Ty
.Array
DO MkArrName(typ
, fil
);
869 | typ
: Ty
.Base
DO MkBasName(typ
, fil
);
870 | typ
: Ty
.Record
DO MkRecName(typ
, fil
);
871 | typ
: Ty
.Pointer
DO MkPtrName(typ
, fil
);
872 | typ
: Ty
.Opaque
DO MkAliasName(typ
, fil
);
873 | typ
: Ty
.Enum
DO MkEnumName(typ
, fil
);
874 | typ
: Ty
.Procedure
DO MkPTypeName(typ
, fil
);
878 (* ============================================================ *)
879 (* Exported Methods *)
880 (* ============================================================ *)
882 PROCEDURE (os
: MsilFile
)Adjust
*(delta
: INTEGER),NEW;
884 INC(os
.proc
.dNum
, delta
);
885 IF os
.proc
.dNum
> os
.proc
.dMax
THEN os
.proc
.dMax
:= os
.proc
.dNum
END;
888 (* ============================================================ *)
890 PROCEDURE (os
: MsilFile
)newLabel
*() : Label
,NEW,ABSTRACT
;
892 (* ============================================================ *)
894 PROCEDURE (os
: MsilFile
)getLabelRange
*(num
: INTEGER) : LbArr
,NEW;
899 FOR idx
:= 0 TO num
-1 DO arr
[idx
] := os
.newLabel() END;
903 (* ============================================================ *)
905 PROCEDURE (os
: MsilFile
)EndCatch
*(),NEW,EXTENSIBLE
;
908 os
.DefLab(os
.proc
.exLb
);
909 IF os
.proc
.rtLc
# -1 THEN os
.PushLocal(os
.proc
.rtLc
) END;
910 os
.FixCopies(os
.proc
.prId
);
911 os
.Code(Asm
.opc_ret
);
914 (* ============================================================ *)
916 PROCEDURE (os
: MsilFile
)DoReturn
*(),NEW;
919 IF os
.proc
.exLb
= NIL THEN
920 os
.FixCopies(os
.proc
.prId
);
921 os
.Code(Asm
.opc_ret
);
922 pTyp
:= os
.proc
.prId
.type
;
923 IF (pTyp
# NIL) & (pTyp
.returnType() # NIL) THEN DEC(os
.proc
.dNum
) END;
925 IF os
.proc
.rtLc
# -1 THEN os
.StoreLocal(os
.proc
.rtLc
) END;
926 os
.CodeLb(Asm
.opc_leave
, os
.proc
.exLb
);
931 (* ============================================================ *)
933 PROCEDURE (os
: MsilFile
)MkFixedArray
*(arTp
: Ty
.Array
),NEW;
934 VAR cTmp
: INTEGER; (* card'ty of this dim. *)
935 aTmp
: INTEGER; (* array reference temp *)
940 ASSERT(arTp
.length
# 0);
944 (* os.CodeTn(Asm.opc_newarr, elTp); *)
945 os
.CodeT(Asm
.opc_newarr
, elTp
);
947 * Do we need an initialization loop?
949 IF ~
hasValueRep(elTp
) THEN
950 labl
:= os
.newLabel();
951 cTmp
:= os
.proc
.newLocal(Bi
.intTp
);
952 aTmp
:= os
.proc
.newLocal(arTp
);
953 os
.StoreLocal(aTmp
); (* (top)... *)
957 * Now the allocation loop
963 WITH elTp
: Ty
.Array
DO
964 os
.MkFixedArray(elTp
);
965 | elTp
: Ty
.Record
DO
966 os
.MkNewRecord(elTp
);
967 END; (* (top)elem,ix,ref,... *)
970 * Now the termination test
973 os
.CodeLb(Asm
.opc_brtrue
, labl
);
975 os
.proc
.ReleaseLocal(cTmp
);
976 os
.proc
.ReleaseLocal(aTmp
);
980 (* ============================================================ *)
982 PROCEDURE (os
: MsilFile
)MkVecRec
*(eTp
: Sy
.Type
),NEW;
985 ord
:= mapVecElTp(eTp
);
986 os
.MkNewRecord(vecRecord(ord
));
989 PROCEDURE (os
: MsilFile
)MkVecArr
*(eTp
: Sy
.Type
),NEW;
993 ord
:= mapVecElTp(eTp
);
994 (*os.CodeTn(Asm.opc_newarr, mapOrdRepT(ord)); *)
995 os
.CodeT(Asm
.opc_newarr
, mapOrdRepT(ord
));
996 os
.PutGetF(Asm
.opc_stfld
, vecArray(ord
));
999 (* ============================================================ *)
1001 PROCEDURE (os
: MsilFile
)MkOpenArray
*(arTp
: Ty
.Array
),NEW;
1002 VAR lens
: ARRAY 32 OF INTEGER;
1004 (* ----------------------------------------- *)
1005 PROCEDURE GetLengths(os
: MsilFile
;
1008 VAR lAr
: ARRAY OF INTEGER);
1012 WITH typ
: Ty
.Array
DO
1013 IF typ
.length
= 0 THEN (* another open dimension *)
1014 tmp
:= os
.proc
.newLocal(Bi
.intTp
);
1017 GetLengths(os
, dim
+1, typ
.elemTp
, lAr
);
1022 (* ----------------------------------------- *)
1023 PROCEDURE InitLoop(os
: MsilFile
;
1026 IN lAr
: ARRAY OF INTEGER);
1032 * Pre : the uninitialized array is on the stack
1035 IF ~
hasValueRep(elT
) THEN
1036 aEl
:= os
.proc
.newLocal(typ
);
1038 lab
:= os
.newLabel();
1040 * Start of initialization loop
1044 * Decrement the loop counter
1046 os
.DecTemp(lAr
[dim
]);
1048 * Assign the array element
1051 os
.PushLocal(lAr
[dim
]);
1052 WITH elT
: Ty
.Record
DO
1053 os
.MkNewRecord(elT
);
1055 IF elT
.length
> 0 THEN
1056 os
.MkFixedArray(elT
);
1058 os
.PushLocal(lAr
[dim
+1]);
1059 (*os.CodeTn(Asm.opc_newarr, elT.elemTp); *)
1060 os
.CodeT(Asm
.opc_newarr
, elT
.elemTp
);
1061 InitLoop(os
, dim
+1, elT
, lAr
);
1066 * Test and branch to loop header
1068 os
.PushLocal(lAr
[dim
]);
1069 os
.CodeLb(Asm
.opc_brtrue
, lab
);
1071 * Reload the original array
1074 os
.proc
.ReleaseLocal(aEl
);
1075 os
.proc
.ReleaseLocal(lAr
[dim
]);
1078 * Post : the initialized array is on the stack
1081 (* ----------------------------------------- *)
1083 elTp
:= arTp
.elemTp
;
1084 IF (elTp
IS Ty
.Array
) OR (elTp
IS Ty
.Record
) THEN
1085 GetLengths(os
, 0, arTp
, lens
);
1086 os
.PushLocal(lens
[0]);
1087 (*os.CodeTn(Asm.opc_newarr, elTp); *)
1088 os
.CodeT(Asm
.opc_newarr
, elTp
);
1089 InitLoop(os
, 0, arTp
, lens
);
1091 (*os.CodeTn(Asm.opc_newarr, elTp); *)
1092 os
.CodeT(Asm
.opc_newarr
, elTp
);
1096 (* ============================================================ *)
1098 PROCEDURE (os
: MsilFile
)MkArrayCopy
*(arrT
: Ty
.Array
),NEW;
1101 (* ----------------------------------- *)
1102 PROCEDURE PushLengths(os
: MsilFile
; aT
: Ty
.Array
);
1104 IF aT
.elemTp
IS Ty
.Array
THEN
1105 os
.Code(Asm
.opc_dup
);
1106 os
.Code(Asm
.opc_ldc_i4_0
);
1107 os
.GetElem(aT
.elemTp
);
1108 PushLengths(os
, aT
.elemTp(Ty
.Array
));
1110 os
.Code(Asm
.opc_ldlen
);
1112 (* ----------------------------------- *)
1115 * Assert: we must find the lengths from the runtime
1116 * descriptors. The array to copy is on the top of
1117 * stack, which reads - (top) aRef, ...
1119 PushLengths(os
, arrT
);
1120 os
.MkOpenArray(arrT
);
1123 (* ============================================================ *)
1125 PROCEDURE (os
: MsilFile
)StructInit
*(var
: Sy
.Idnt
),NEW;
1130 (* ------------------------------------------------- *)
1131 PROCEDURE Assign(os
: MsilFile
; id
: Sy
.Idnt
);
1134 WITH id
: Id
.LocId
DO
1135 IF id
.varOrd
# Id
.xMark
THEN
1136 os
.StoreLocal(id
.varOrd
);
1141 os
.PutGetF(Asm
.opc_stfld
, id
);
1143 md
:= id
.dfScp(Id
.BlkId
);
1144 os
.PutGetS(Asm
.opc_stsfld
, md
, id
);
1147 (* ------------------------------------------------- *)
1149 os
.Comment("initialize " + Sy
.getName
.ChPtr(var
)^
);
1151 * Precondition: var is of a type that needs initialization,
1154 lnk
:= (var
IS Id
.LocId
) & (var(Id
.LocId
).varOrd
= Id
.xMark
);
1155 WITH typ
: Ty
.Array
DO
1156 IF lnk
THEN os
.Code(Asm
.opc_ldloc_0
) END;
1157 os
.MkFixedArray(typ
);
1159 | typ
: Ty
.Record
DO
1160 IF Sy
.clsTp
IN typ
.xAttr
THEN
1162 * Reference record type
1164 IF lnk
THEN os
.Code(Asm
.opc_ldloc_0
) END;
1165 os
.MkNewRecord(typ
);
1172 os
.CodeTn(Asm
.opc_initobj
, typ
);
1175 IF lnk
THEN os
.Code(Asm
.opc_ldloc_0
) END;
1176 os
.Code(Asm
.opc_ldnull
);
1181 (* ============================================================ *)
1183 PROCEDURE (os
: MsilFile
)PushZero(typ
: Sy
.Type
),NEW;
1186 WITH typ
: Ty
.Base
DO
1188 | Ty
.sReaN
: os
.CodeR(Asm
.opc_ldc_r4
, 0.0);
1189 | Ty
.realN
: os
.CodeR(Asm
.opc_ldc_r8
, 0.0);
1190 | Ty
.lIntN
: os
.CodeL(Asm
.opc_ldc_i8
, 0);
1192 Ty
.sChrN
: os
.Code(Asm
.opc_ldc_i4_0
);
1193 ELSE os
.Code(Asm
.opc_ldc_i4_0
);
1196 os
.Code(Asm
.opc_ldnull
);
1200 (* ----------------------------------- *)
1202 PROCEDURE (os
: MsilFile
)ScalarInit
*(var
: Sy
.Idnt
),NEW;
1206 os
.Comment("initialize " + Sy
.getName
.ChPtr(var
)^
);
1209 * Precondition: var is of a scalar type that is referenced
1214 (* ============================================================ *)
1216 PROCEDURE (os
: MsilFile
)Throw
*(),NEW;
1218 os
.CodeS(Asm
.opc_newobj
, mkExcept
);
1219 os
.Code(Asm
.opc_throw
);
1222 (* ============================================================ *)
1224 PROCEDURE (os
: MsilFile
)Trap
*(IN str
: ARRAY OF CHAR),NEW;
1226 os
.PushStr('
"' + str + '"'
);
1230 (* ============================================================ *)
1232 PROCEDURE (os
: MsilFile
)IndexTrap
*(),NEW;
1234 os
.Comment("IndexTrap");
1235 os
.Trap("Vector index out of bounds");
1238 (* ============================================================ *)
1240 PROCEDURE (os
: MsilFile
)CaseTrap
*(i
: INTEGER),NEW;
1242 os
.Comment("CaseTrap");
1244 os
.CodeS(Asm
.opc_call
, caseMesg
);
1245 os
.CodeS(Asm
.opc_newobj
, mkExcept
);
1246 os
.Code(Asm
.opc_throw
);
1249 (* ============================================================ *)
1251 PROCEDURE (os
: MsilFile
)WithTrap
*(id
: Sy
.Idnt
),NEW;
1253 os
.Comment("WithTrap " + Sy
.getName
.ChPtr(id
)^
);
1255 os
.CodeS(Asm
.opc_call
, withMesg
);
1256 os
.CodeS(Asm
.opc_newobj
, mkExcept
);
1257 os
.Code(Asm
.opc_throw
);
1260 (* ============================================================ *)
1262 PROCEDURE EliminatePathFromSrcName(str
: Lv
.CharOpen
): Lv
.CharOpen
;
1264 i
, idx
, len
: INTEGER;
1267 FOR idx
:= LEN(str
)-1 TO 0 BY
- 1 DO
1268 IF str
[idx
] = '
\' THEN
1269 len
:= LEN(str
) - idx
- 1;
1271 FOR i
:= 0 TO len
- 2 DO rslt
[i
] := str
[idx
+i
+1]; END;
1277 END EliminatePathFromSrcName
;
1279 PROCEDURE (os
: MsilFile
)Header
*(IN str
: ARRAY OF CHAR),NEW;
1280 VAR date
: ARRAY 64 OF CHAR;
1282 os
.srcS
:= Lv
.strToCharOpen(
1283 "'" + EliminatePathFromSrcName(Lv
.strToCharOpen(str
))^
+ "'");
1284 RTS
.GetDateString(date
);
1285 os
.Comment("ILASM output produced by GPCP compiler (" +
1286 RTS
.defaultTarget
+ " version)");
1287 os
.Comment("at date: " + date
);
1288 os
.Comment("from source file <" + str
+ '
>'
);
1292 (* ============================================================ *)
1293 (* Namehandling Methods *)
1294 (* ============================================================ *)
1296 PROCEDURE MkBlkName
*(mod
: Id
.BlkId
);
1297 VAR mNm
: Lv
.CharOpen
;
1298 (* -------------------------------------------------- *)
1299 PROCEDURE scpMangle(mod
: Id
.BlkId
) : Lv
.CharOpen
;
1300 VAR outS
: Lv
.CharOpen
;
1302 IF mod
.kind
= Id
.impId
THEN
1303 outS
:= cat4(lBrk
,mod
.pkgNm
,rBrk
,mod
.xName
);
1307 IF LEN(mod
.xName$
) > 0 THEN outS
:= cat2(outS
, dotS
) END;
1310 (* -------------------------------------------------- *)
1311 PROCEDURE nmSpaceOf(mod
: Id
.BlkId
) : Lv
.CharOpen
;
1318 IF inS
[0] # '
['
THEN
1326 UNTIL (ix
= LEN(inS
)) OR (ch
= '
]'
);
1327 RETURN Lv
.subChOToChO(inS
, ix
, ln
-ix
);
1330 (* -------------------------------------------------- *)
1331 PROCEDURE pkgNameOf(mod
: Id
.BlkId
) : Lv
.CharOpen
;
1338 IF inS
[0] # '
['
THEN
1341 INCL(mod
.xAttr
, Sy
.isFn
); (* make sure this is marked foreign *)
1347 UNTIL (ix
= LEN(inS
)) OR (ch
= '
]'
);
1348 RETURN Lv
.subChOToChO(inS
, 1, ix
-2);
1351 (* -------------------------------------------------- *)
1353 IF mod
.xName
# NIL THEN RETURN END;
1354 mNm
:= Sy
.getName
.ChPtr(mod
);
1355 IF mod
.scopeNm
# NIL THEN
1356 IF mod
.clsNm
= NIL THEN
1357 mod
.clsNm
:= mNm
; (* dummy class name *)
1359 mod
.pkgNm
:= pkgNameOf(mod
); (* assembly filename *)
1360 mod
.xName
:= nmSpaceOf(mod
); (* namespace name *)
1361 mod
.scopeNm
:= scpMangle(mod
); (* class prefix name *)
1363 mod
.clsNm
:= mNm
; (* dummy class name *)
1364 mod
.pkgNm
:= mNm
; (* assembly filename *)
1365 mod
.xName
:= mNm
; (* namespace name *)
1367 * In the normal case, the assembly name is the
1368 * same as the module name. However, system
1369 * modules always have the assembly name "RTS".
1371 IF Sy
.rtsMd
IN mod
.xAttr
THEN
1372 mod
.scopeNm
:= cat3(lBrk
, rtsS
, rBrk
);
1374 mod
.scopeNm
:= scpMangle(mod
); (* class prefix name *)
1379 (* ------------------------------------------------------------ *)
1381 PROCEDURE (os
: MsilFile
)CheckNestedClass
*(typ
: Ty
.Record
;
1383 rNm
: Lv
.CharOpen
),NEW,ABSTRACT
;
1385 (* ------------------------------------------------------------ *
1387 *PROCEDURE StrSubChr(str: Lv.CharOpen;
1388 * ch1, ch2: CHAR): Lv.CharOpen;
1389 * VAR i, len: INTEGER;
1390 * rslt: Lv.CharOpen;
1393 * * copy str to rslt with all occurences of
1394 * * ch1 replaced by ch2, except at index 0
1396 * len
:= LEN(str
); NEW(rslt
, len
);
1397 * rslt
[0] := str
[0];
1398 * FOR i
:= 1 TO len
-1 DO
1399 * IF str
[i
] # ch1
THEN rslt
[i
] := str
[i
] ELSE rslt
[i
] := ch2
END;
1404 * ------------------------------------------------------------ *)
1406 PROCEDURE MkRecName
*(typ
: Ty
.Record
; os
: MsilFile
);
1407 VAR mNm
: Lv
.CharOpen
; (* prefix scope name *)
1408 rNm
: Lv
.CharOpen
; (* simple name of type *)
1411 (* ---------------------------------- *
1412 * The choice below may need revision *
1413 * depending on any decison about the *
1414 * format of foreign type-names *
1415 * extracted from the metadata. *
1416 * ---------------------------------- *)
1417 PROCEDURE unmangle(arr
: Lv
.CharOpen
) : Lv
.CharOpen
;
1421 (* ---------------------------------------------------------- *)
1423 IF typ
.xName
# NIL THEN RETURN END;
1425 IF (typ
.baseTp
IS Ty
.Record
) &
1426 (typ
.baseTp
.xName
= NIL) THEN MkRecName(typ
.baseTp(Ty
.Record
), os
) END;
1428 IF typ
.bindTp
# NIL THEN (* Synthetically named rec'd *)
1429 tId
:= typ
.bindTp
.idnt
;
1430 rNm
:= Sy
.getName
.ChPtr(tId
);
1431 ELSE (* Normal, named record type *)
1432 IF typ
.idnt
= NIL THEN (* Anonymous record type *)
1433 typ
.idnt
:= Id
.newAnonId(typ
.serial
);
1434 typ
.idnt
.type
:= typ
;
1437 rNm
:= Sy
.getName
.ChPtr(tId
);
1440 IF tId
.dfScp
= NIL THEN tId
.dfScp
:= CSt
.thisMod
END;
1443 IF typ
.extrnNm
# NIL THEN
1444 typ
.scopeNm
:= unmangle(typ
.extrnNm
);
1446 * This is an external class, so it might be a nested class!
1448 os
.CheckNestedClass(typ
, scp
, rNm
);
1450 * Console.WriteString(typ.name());
1453 * rNm := StrSubChr(rNm,'$','/');
1458 * At this program point the situation is as follows:
1459 * rNm holds the simple name of the record. The scope
1460 * in which the record is defined is scp.
1462 WITH scp
: Id
.Procs
DO
1463 IF scp
.prcNm
= NIL THEN MkProcName(scp
, os
) END;
1464 rNm
:= cat3(scp
.prcNm
, atSg
, rNm
);
1466 typ
.scopeNm
:= cat2(scp
.scopeNm
, rNm
);
1468 IF scp
.xName
= NIL THEN MkBlkName(scp
) END;
1470 typ
.scopeNm
:= cat2(scp
.scopeNm
, rNm
);
1473 * It is at this point that we link records into the
1474 * class-emission worklist.
1476 IF typ
.tgXtn
= NIL THEN os
.MkRecX(typ
, scp
) END;
1477 IF tId
.dfScp
.kind
# Id
.impId
THEN
1478 MsilBase
.emitter
.AddNewRecEmitter(typ
);
1482 (* ------------------------------------------------------------ *)
1484 PROCEDURE MkEnumName
*(typ
: Ty
.Enum
; os
: MsilFile
);
1485 VAR mNm
: Lv
.CharOpen
; (* prefix scope name *)
1486 rNm
: Lv
.CharOpen
; (* simple name of type *)
1489 (* ---------------------------------------------------------- *)
1491 (* Assert: Enums are always imported ... *)
1492 IF typ
.xName
# NIL THEN RETURN END;
1495 rNm
:= Sy
.getName
.ChPtr(tId
);
1498 * At this program point the situation is at follows:
1499 * rNm holds the simple name of the type. The scope
1500 * in which the record is defined is scp.
1502 WITH scp
: Id
.BlkId
DO
1503 IF scp
.xName
= NIL THEN MkBlkName(scp
) END;
1504 typ
.xName
:= cat2(scp
.scopeNm
, rNm
);
1506 os
.MkEnuX(typ
, scp
);
1509 (* ------------------------------------------------------------ *)
1511 PROCEDURE MkBasName(typ
: Ty
.Base
; os
: MsilFile
);
1513 ASSERT(typ
.xName
# NIL);
1517 (* ------------------------------------------------------------ *)
1519 PROCEDURE MkArrName(typ
: Ty
.Array
; os
: MsilFile
);
1521 typ
.xName
:= cat2(typeName(typ
.elemTp
, os
), brks
);
1525 (* ------------------------------------------------------------ *)
1527 PROCEDURE MkVecName(typ
: Ty
.Vector
; os
: MsilFile
);
1531 ord
:= mapVecElTp(typ
.elemTp
);
1533 | Ty
.charN
: typ
.xName
:= cat2(vecPrefix
, BOX("VecChr"));
1534 | Ty
.intN
: typ
.xName
:= cat2(vecPrefix
, BOX("VecI32"));
1535 | Ty
.lIntN
: typ
.xName
:= cat2(vecPrefix
, BOX("VecI64"));
1536 | Ty
.sReaN
: typ
.xName
:= cat2(vecPrefix
, BOX("VecR32"));
1537 | Ty
.realN
: typ
.xName
:= cat2(vecPrefix
, BOX("VecR64"));
1538 | Ty
.anyPtr
: typ
.xName
:= cat2(vecPrefix
, BOX("VecRef"));
1540 cls
:= vecClass(ord
);
1541 IF cls
.type
.tgXtn
= NIL THEN os
.MkVecX(cls
.type
, vecMod()) END;
1542 typ
.tgXtn
:= cls
.type
.tgXtn
;
1545 (* ------------------------------------------------------------ *)
1547 PROCEDURE MkPtrName
*(typ
: Ty
.Pointer
; os
: MsilFile
);
1548 VAR bndTp
: Sy
.Type
;
1549 bndNm
: Lv
.CharOpen
;
1551 bndTp
:= typ
.boundTp
;
1552 bndNm
:= typeName(bndTp
, os
); (* recurse with MkTypeName *)
1553 IF isValRecord(bndTp
) THEN
1554 typ
.xName
:= boxedName(bndTp(Ty
.Record
), os
);
1561 (* ------------------------------------------------------------ *)
1563 PROCEDURE MkPTypeName
*(typ
: Ty
.Procedure
; os
: MsilFile
);
1564 VAR tNm
: Lv
.CharOpen
;
1567 IF typ
.xName
# NIL THEN RETURN END;
1569 * Set the eName field
1571 IF typ
.idnt
= NIL THEN (* Anonymous procedure type *)
1572 typ
.idnt
:= Id
.newAnonId(typ
.serial
);
1573 typ
.idnt
.type
:= typ
;
1575 IF typ
.idnt
.dfScp
= NIL THEN typ
.idnt
.dfScp
:= CSt
.thisMod
END;
1577 MkIdName(typ
.idnt
.dfScp
, os
);
1578 os
.NumberParams(NIL, typ
);
1580 sNm
:= typ
.idnt
.dfScp
.scopeNm
;
1581 tNm
:= Sy
.getName
.ChPtr(typ
.idnt
);
1582 typ
.tName
:= cat2(sNm
, tNm
);
1584 WITH typ
: Ty
.Event
DO
1585 typ
.bndRec
.xName
:= tNm
;
1586 typ
.bndRec
.scopeNm
:= typ
.tName
1590 * os.MkTyXtn(...); // called from inside NumberParams().
1592 * It is at this point that we link events into the
1593 * class-emission worklist.
1595 IF typ
.idnt
.dfScp
.kind
# Id
.impId
THEN
1596 MsilBase
.emitter
.AddNewRecEmitter(typ
);
1600 (* ------------------------------------------------------------ *)
1602 PROCEDURE MkProcName
*(proc
: Id
.Procs
; os
: MsilFile
);
1603 VAR pNm
: Lv
.CharOpen
;
1607 (* -------------------------------------------------- *)
1608 PROCEDURE MkMthNm(mth
: Id
.MthId
; os
: MsilFile
);
1613 IF mth
.scopeNm
# NIL THEN RETURN;
1614 ELSIF mth
.kind
= Id
.fwdMth
THEN
1615 res
:= mth
.resolve(Id
.MthId
); MkMthNm(res
, os
);
1616 mth
.prcNm
:= res
.prcNm
; mth
.scopeNm
:= res
.scopeNm
;
1618 scp
:= mth
.dfScp(Id
.BlkId
);
1620 IF typ
.xName
= NIL THEN MkRecName(typ(Ty
.Record
), os
) END;
1621 IF scp
.xName
= NIL THEN MkBlkName(scp
) END;
1622 mth
.scopeNm
:= scp
.scopeNm
;
1623 IF mth
.prcNm
= NIL THEN mth
.prcNm
:= Sy
.getName
.ChPtr(mth
) END;
1624 IF ~
(Sy
.clsTp
IN typ(Ty
.Record
).xAttr
) &
1625 (mth
.rcvFrm
.type
IS Ty
.Pointer
) THEN INCL(mth
.mthAtt
, Id
.boxRcv
) END;
1628 (* -------------------------------------------------- *)
1629 PROCEDURE className(p
: Id
.Procs
) : Lv
.CharOpen
;
1631 WITH p
: Id
.PrcId
DO RETURN p
.clsNm
;
1632 | p
: Id
.MthId
DO RETURN p
.bndType
.xName
;
1635 (* -------------------------------------------------- *)
1636 PROCEDURE GetClassName(pr
: Id
.PrcId
; bl
: Id
.BlkId
; os
: MsilFile
);
1637 VAR nm
: Lv
.CharOpen
;
1639 nm
:= Sy
.getName
.ChPtr(pr
);
1640 IF pr
.bndType
= NIL THEN (* normal procedure *)
1641 pr
.clsNm
:= bl
.clsNm
;
1642 IF pr
.prcNm
= NIL THEN pr
.prcNm
:= nm
END;
1643 ELSE (* static method *)
1644 IF pr
.bndType
.xName
= NIL THEN MkRecName(pr
.bndType(Ty
.Record
), os
) END;
1645 pr
.clsNm
:= pr
.bndType
.xName
;
1646 IF pr
.prcNm
= NIL THEN
1648 ELSIF pr
.prcNm^
= initString
THEN
1649 pr
.SetKind(Id
.ctorP
);
1653 (* -------------------------------------------------- *)
1654 PROCEDURE MkPrcNm(prc
: Id
.PrcId
; os
: MsilFile
);
1660 IF prc
.scopeNm
# NIL THEN RETURN;
1661 ELSIF prc
.kind
= Id
.fwdPrc
THEN
1662 res
:= prc
.resolve(Id
.PrcId
); MkPrcNm(res
, os
);
1663 prc
.prcNm
:= res
.prcNm
;
1664 prc
.clsNm
:= res
.clsNm
;
1665 prc
.scopeNm
:= res
.scopeNm
;
1666 ELSIF prc
.kind
= Id
.conPrc
THEN
1668 WITH scp
: Id
.BlkId
DO
1669 IF scp
.xName
= NIL THEN MkBlkName(scp
) END;
1670 IF Sy
.isFn
IN scp
.xAttr
THEN
1671 GetClassName(prc
, scp
, os
);
1673 prc
.clsNm
:= scp
.clsNm
;
1674 IF prc
.prcNm
= NIL THEN prc
.prcNm
:= Sy
.getName
.ChPtr(prc
) END;
1677 MkProcName(scp
, os
);
1678 prc
.clsNm
:= className(scp
);
1679 prc
.prcNm
:= cat3(Sy
.getName
.ChPtr(prc
), atSg
, scp
.prcNm
);
1681 prc
.scopeNm
:= scp
.scopeNm
;
1682 ELSE (* prc.kind = Id.ctorP *)
1683 blk
:= prc
.dfScp(Id
.BlkId
);
1684 rTp
:= prc
.type
.returnType();
1685 IF blk
.xName
= NIL THEN MkBlkName(blk
) END;
1686 IF rTp
.xName
= NIL THEN MkTypeName(rTp
, os
) END;
1687 prc
.clsNm
:= rTp
.boundRecTp().xName
;
1688 prc
.prcNm
:= Lv
.strToCharOpen(initString
);
1689 prc
.scopeNm
:= blk
.scopeNm
;
1691 prc
.bndType
:= rTp
.boundRecTp();
1692 prc
.type(Ty
.Procedure
).retType
:= NIL;
1696 (* -------------------------------------------------- *)
1698 WITH proc
: Id
.MthId
DO MkMthNm(proc
, os
);
1699 | proc
: Id
.PrcId
DO MkPrcNm(proc
, os
);
1702 * In this case proc.tgXtn is set in NumberParams
1706 (* ------------------------------------------------------------ *)
1708 PROCEDURE MkAliasName
*(typ
: Ty
.Opaque
; os
: MsilFile
);
1709 VAR tNm
: Lv
.CharOpen
;
1712 IF typ
.xName
# NIL THEN RETURN END;
1713 MkBlkName(typ
.idnt
.dfScp(Id
.BlkId
));
1714 tNm
:= Sy
.getName
.ChPtr(typ
.idnt
);
1715 sNm
:= typ
.idnt
.dfScp
.scopeNm
;
1716 typ
.xName
:= cat2(sNm
, tNm
);
1720 (* ------------------------------------------------------------ *)
1722 PROCEDURE MkVarName
*(var
: Id
.VarId
; os
: MsilFile
);
1724 var
.varNm
:= Sy
.getName
.ChPtr(var
);
1725 IF var
.recTyp
= NIL THEN (* normal case *)
1726 var
.clsNm
:= var
.dfScp(Id
.BlkId
).clsNm
;
1727 ELSE (* static field *)
1728 IF var
.recTyp
.xName
= NIL THEN MkTypeName(var
.recTyp
, os
) END;
1729 var
.clsNm
:= var
.recTyp
.xName
;
1733 (* ------------------------------------------------------------ *)
1735 PROCEDURE MkFldName
*(id
: Id
.FldId
; os
: MsilFile
);
1737 id
.fldNm
:= Sy
.getName
.ChPtr(id
);
1740 (* ------------------------------------------------------------ *)
1742 PROCEDURE MkIdName
*(id
: Sy
.Idnt
; os
: MsilFile
);
1744 WITH id
: Id
.Procs
DO IF id
.scopeNm
= NIL THEN MkProcName(id
, os
) END;
1745 | id
: Id
.BlkId
DO IF id
.scopeNm
= NIL THEN MkBlkName(id
) END;
1746 | id
: Id
.VarId
DO IF id
.varNm
= NIL THEN MkVarName(id
, os
) END;
1747 | id
: Id
.FldId
DO IF id
.fldNm
= NIL THEN MkFldName(id
, os
) END;
1748 | id
: Id
.LocId
DO (* skip *)
1752 (* ------------------------------------------------------------ *)
1754 PROCEDURE NumberLocals(pIdn
: Id
.Procs
; IN locs
: Sy
.IdSeq
);
1755 VAR ident
: Sy
.Idnt
;
1760 (* ------------------ *)
1761 IF Id
.hasXHR
IN pIdn
.pAttr
THEN MkXHR(pIdn
); INC(count
) END;
1762 (* ------------------ *)
1763 FOR index
:= 0 TO locs
.tide
-1 DO
1764 ident
:= locs
.a
[index
];
1765 WITH ident
: Id
.ParId
DO (* skip *)
1766 | ident
: Id
.LocId
DO
1767 IF Id
.uplevA
IN ident
.locAtt
THEN
1768 ident
.varOrd
:= Id
.xMark
;
1770 ident
.varOrd
:= count
;
1775 pIdn
.rtsFram
:= count
;
1778 (* ------------------------------------------------------------ *)
1780 PROCEDURE MkCallAttr
*(pIdn
: Sy
.Idnt
; os
: MsilFile
);
1781 VAR pTyp
: Ty
.Procedure
;
1785 * This is only called for imported methods.
1786 * All local methods have been already fixed
1787 * by the call from RenumberLocals()
1789 pTyp
:= pIdn
.type(Ty
.Procedure
);
1790 WITH pIdn
: Id
.MthId
DO
1791 pTyp
.argN
:= 1; (* count one for "this" *)
1792 rcvP
:= pIdn
.rcvFrm
;
1793 MkProcName(pIdn
, os
);
1794 IF takeAdrs(rcvP
) THEN rcvP
.boxOrd
:= rcvP
.parMod
END;
1795 os
.NumberParams(pIdn
, pTyp
);
1796 | pIdn
: Id
.PrcId
DO
1798 MkProcName(pIdn
, os
);
1799 os
.NumberParams(pIdn
, pTyp
);
1803 (* ------------------------------------------------------------ *)
1805 PROCEDURE RenumberLocals
*(prcId
: Id
.Procs
; os
: MsilFile
);
1806 VAR parId
: Id
.ParId
;
1807 frmTp
: Ty
.Procedure
;
1811 * This is only called for local methods.
1812 * Imported methods do not have visible locals,
1813 * and get their signatures computed by the
1814 * call of NumberParams() in MkCallAttr()
1817 * (i) The receiver (if any) must be #0
1818 * (ii) Params are #0 .. #N for statics,
1819 * or #1 .. #N for methods.
1820 * (iii) Incoming static link is #0 if this is
1821 * a nested procedure (methods are not nested)
1822 * (iv) Locals separately number from zero.
1824 frmTp
:= prcId
.type(Ty
.Procedure
);
1825 funcT
:= (frmTp
.retType
# NIL);
1826 WITH prcId
: Id
.MthId
DO
1827 parId
:= prcId
.rcvFrm
;
1829 IF takeAdrs(parId
) THEN parId
.boxOrd
:= parId
.parMod
END;
1830 frmTp
.argN
:= 1; (* count one for "this" *)
1831 ELSE (* static procedures *)
1832 IF (prcId
.kind
= Id
.ctorP
) OR
1833 (prcId
.lxDepth
> 0) THEN frmTp
.argN
:= 1 ELSE frmTp
.argN
:= 0 END;
1836 * Assert: params do not appear in the local array.
1839 os
.NumberParams(prcId
, frmTp
); (* Make signature method defined here *)
1841 * If NumberLocals is NOT called on a procedure that
1842 * has locals but no body, then PeUtil pulls an index
1843 * exception. Such a program may be silly, but is legal. (kjg)
1845 * IF prcId.body # NIL THEN
1846 * NumberLocals(prcId, prcId.locals);
1849 NumberLocals(prcId
, prcId
.locals
);
1852 (* ------------------------------------------------------------ *)
1853 (* ------------------------------------------------------------ *)
1855 PROCEDURE (os
: MsilFile
)LoadIndirect
*(typ
: Sy
.Type
),NEW;
1858 IF (typ
# NIL) & (typ
IS Ty
.Base
) THEN
1859 os
.Code(typeLdInd
[typ(Ty
.Base
).tpOrd
]);
1860 ELSIF isValRecord(typ
) THEN
1861 os
.CodeT(Asm
.opc_ldobj
, typ
);
1863 os
.Code(Asm
.opc_ldind_ref
);
1867 (* ------------------------------------------------------------ *)
1869 PROCEDURE (os
: MsilFile
)StoreIndirect
*(typ
: Sy
.Type
),NEW;
1872 IF (typ
# NIL) & (typ
IS Ty
.Base
) THEN
1873 os
.Code(typeStInd
[typ(Ty
.Base
).tpOrd
]);
1874 ELSIF isValRecord(typ
) THEN
1875 os
.CodeT(Asm
.opc_stobj
, typ
);
1877 os
.Code(Asm
.opc_stind_ref
);
1881 (* ------------------------------------------------------------ *)
1882 (* ------------------------------------------------------------ *)
1884 PROCEDURE (os
: MsilFile
)PushArg
*(ord
: INTEGER),NEW;
1888 |
0 : os
.Code(Asm
.opc_ldarg_0
);
1889 |
1 : os
.Code(Asm
.opc_ldarg_1
);
1890 |
2 : os
.Code(Asm
.opc_ldarg_2
);
1891 |
3 : os
.Code(Asm
.opc_ldarg_3
);
1893 os
.CodeI(Asm
.opc_ldarg_s
, ord
);
1896 os
.CodeI(Asm
.opc_ldarg
, ord
);
1900 (* ------------------------------------------------------------ *)
1902 PROCEDURE (os
: MsilFile
)PushStaticLink
*(tgt
: Id
.Procs
),NEW;
1903 VAR lxDel
: INTEGER;
1906 clr
:= os
.proc
.prId(Id
.Procs
);
1907 lxDel
:= tgt
.lxDepth
- clr
.lxDepth
;
1910 |
0 : os
.Code(Asm
.opc_ldarg_0
);
1911 |
1 : IF Id
.hasXHR
IN clr
.pAttr
THEN
1912 os
.Code(Asm
.opc_ldloc_0
);
1913 ELSIF clr
.lxDepth
= 0 THEN
1914 os
.Code(Asm
.opc_ldnull
);
1916 os
.Code(Asm
.opc_ldarg_0
);
1919 os
.Code(Asm
.opc_ldarg_0
);
1921 clr
:= clr
.dfScp(Id
.Procs
);
1922 IF Id
.hasXHR
IN clr
.pAttr
THEN
1923 os
.PutGetF(Asm
.opc_ldfld
, CSt
.xhrId
);
1925 UNTIL clr
.lxDepth
= tgt
.lxDepth
;
1929 (* ---------------------------------------------------- *)
1931 PROCEDURE (os
: MsilFile
)GetXHR(var
: Id
.LocId
),NEW;
1932 VAR scp
: Id
.Procs
; (* the scope holding the datum *)
1933 clr
: Id
.Procs
; (* the scope making the call *)
1936 scp
:= var
.dfScp(Id
.Procs
);
1937 clr
:= os
.proc
.prId(Id
.Procs
);
1939 * Check if this is an own local
1942 os
.Code(Asm
.opc_ldloc_0
);
1944 del
:= xhrCount(scp
, clr
);
1946 * First, load the static link
1948 os
.Code(Asm
.opc_ldarg_0
);
1950 * Next, load the XHR pointer.
1953 os
.PutGetF(Asm
.opc_ldfld
, CSt
.xhrId
);
1957 * Finally, cast to concrete type
1959 os
.CodeT(Asm
.opc_castclass
, scp
.xhrType
);
1963 (* ------------------------------------------------------------ *)
1965 PROCEDURE (os
: MsilFile
)PushLocal
*(ord
: INTEGER),NEW;
1969 |
0 : os
.Code(Asm
.opc_ldloc_0
);
1970 |
1 : os
.Code(Asm
.opc_ldloc_1
);
1971 |
2 : os
.Code(Asm
.opc_ldloc_2
);
1972 |
3 : os
.Code(Asm
.opc_ldloc_3
);
1974 os
.CodeI(Asm
.opc_ldloc_s
, ord
);
1977 os
.CodeI(Asm
.opc_ldloc
, ord
);
1981 (* ---------------------------------------------------- *)
1983 PROCEDURE (os
: MsilFile
)PushLocalA
*(ord
: INTEGER),NEW;
1986 os
.CodeI(Asm
.opc_ldloca_s
, ord
);
1988 os
.CodeI(Asm
.opc_ldloca
, ord
);
1992 (* ---------------------------------------------------- *)
1994 PROCEDURE (os
: MsilFile
)PushArgA
*(ord
: INTEGER),NEW;
1997 os
.CodeI(Asm
.opc_ldarga_s
, ord
);
1999 os
.CodeI(Asm
.opc_ldarga
, ord
);
2003 (* ---------------------------------------------------- *)
2005 PROCEDURE (os
: MsilFile
)GetXhrField(cde
: INTEGER; var
: Id
.LocId
),NEW;
2006 VAR proc
: Id
.Procs
;
2008 proc
:= var
.dfScp(Id
.Procs
);
2009 os
.PutGetXhr(cde
, proc
, var
);
2012 (* ---------------------------------------------------- *)
2014 PROCEDURE (os
: MsilFile
)XhrHandle
*(var
: Id
.LocId
),NEW;
2017 IF var
.boxOrd
# Sy
.val
THEN os
.GetXhrField(Asm
.opc_ldfld
, var
) END;
2020 (* ---------------------------------------------------- *)
2022 PROCEDURE (os
: MsilFile
)GetUplevel(var
: Id
.LocId
),NEW;
2026 * If var is a LocId do "ldfld FT XT::'vname'"
2027 * If var is a ParId then
2028 * if not a byref then "ldfld FT XT::'vname'"
2029 * elsif is a byref then "ldfld FT& XT::'vname'; ldind.TT"
2031 os
.GetXhrField(Asm
.opc_ldfld
, var
);
2032 IF var
.boxOrd
# Sy
.val
THEN os
.LoadIndirect(var
.type
) END;
2035 (* ---------------------------------------------------- *)
2037 PROCEDURE (os
: MsilFile
)GetUplevelA(var
: Id
.LocId
),NEW;
2041 * If var is a LocId do "ldflda FT XT::'vname'"
2042 * If var is a ParId then
2043 * if not a byref then "ldflda FT XT::'vname'"
2044 * elsif is a byref then "ldfld FT& XT::'vname'"
2046 IF var
.boxOrd
# Sy
.val
THEN (* byref case ... *)
2047 os
.GetXhrField(Asm
.opc_ldfld
, var
);
2048 ELSE (* value case ... *)
2049 os
.GetXhrField(Asm
.opc_ldflda
, var
);
2053 (* ---------------------------------------------------- *)
2055 PROCEDURE (os
: MsilFile
)PutUplevel
*(var
: Id
.LocId
),NEW;
2058 * If var is a LocId do "stfld FT XT::'vname'"
2059 * If var is a ParId then
2060 * if not a byref then "stfld FT XT::'vname'"
2061 * elsif is a byref then "ldfld FT& XT::'vname'; stind.TT"
2063 IF var
.boxOrd
# Sy
.val
THEN (* byref case ... *)
2064 os
.StoreIndirect(var
.type
);
2065 ELSE (* value case ... *)
2066 os
.GetXhrField(Asm
.opc_stfld
, var
);
2070 (* ---------------------------------------------------- *)
2072 PROCEDURE (os
: MsilFile
)GetLocal
*(var
: Id
.LocId
),NEW;
2074 IF Id
.uplevA
IN var
.locAtt
THEN os
.GetUplevel(var
); RETURN END;
2075 WITH var
: Id
.ParId
DO
2076 os
.PushArg(var
.varOrd
);
2077 IF var
.boxOrd
# Sy
.val
THEN os
.LoadIndirect(var
.type
) END;
2079 os
.PushLocal(var
.varOrd
);
2083 (* ---------------------------------------------------- *)
2085 PROCEDURE (os
: MsilFile
)DecTemp
*(ord
: INTEGER),NEW;
2088 os
.Code(Asm
.opc_ldc_i4_1
);
2089 os
.Code(Asm
.opc_sub
);
2093 (* ---------------------------------------------------- *)
2095 PROCEDURE (os
: MsilFile
)GetVar
*(id
: Sy
.Idnt
),NEW;
2098 WITH id
: Id
.AbVar
DO
2099 IF id
.kind
= Id
.conId
THEN
2100 os
.GetLocal(id(Id
.LocId
));
2103 WITH scp
: Id
.BlkId
DO
2104 os
.PutGetS(Asm
.opc_ldsfld
, scp
, id(Id
.VarId
));
2106 os
.GetLocal(id(Id
.LocId
));
2112 (* ------------------------------------------------------------ *)
2113 (* ------------------------------------------------------------ *)
2115 PROCEDURE (os
: MsilFile
)GetLocalA(var
: Id
.LocId
),NEW;
2119 IF Id
.uplevA
IN var
.locAtt
THEN os
.GetUplevelA(var
); RETURN END;
2120 IF ~
(var
IS Id
.ParId
) THEN (* local var *)
2122 ELSIF var
.boxOrd
# Sy
.val
THEN (* ref param *)
2124 ELSE (* val param *)
2129 (* ---------------------------------------------------- *)
2131 PROCEDURE (os
: MsilFile
)GetVarA
*(id
: Sy
.Idnt
),NEW;
2136 * Assert: the handle is NOT pushed on the tos yet.
2138 var
:= id(Id
.AbVar
);
2140 WITH scp
: Id
.BlkId
DO
2141 os
.PutGetS(Asm
.opc_ldsflda
, scp
, var(Id
.VarId
));
2143 os
.GetLocalA(var(Id
.LocId
));
2147 (* ------------------------------------------------------------ *)
2148 (* ------------------------------------------------------------ *)
2150 PROCEDURE (os
: MsilFile
)StoreArg
*(ord
: INTEGER),NEW;
2153 os
.CodeI(Asm
.opc_starg_s
, ord
);
2155 os
.CodeI(Asm
.opc_starg
, ord
);
2159 (* ---------------------------------------------------- *)
2161 PROCEDURE (os
: MsilFile
)StoreLocal
*(ord
: INTEGER),NEW;
2165 |
0 : os
.Code(Asm
.opc_stloc_0
);
2166 |
1 : os
.Code(Asm
.opc_stloc_1
);
2167 |
2 : os
.Code(Asm
.opc_stloc_2
);
2168 |
3 : os
.Code(Asm
.opc_stloc_3
);
2170 os
.CodeI(Asm
.opc_stloc_s
, ord
);
2173 os
.CodeI(Asm
.opc_stloc
, ord
);
2177 (* ---------------------------------------------------- *)
2179 PROCEDURE (os
: MsilFile
)PutLocal
*(var
: Id
.LocId
),NEW;
2181 IF Id
.uplevA
IN var
.locAtt
THEN os
.PutUplevel(var
); RETURN END;
2182 WITH var
: Id
.ParId
DO
2183 IF var
.boxOrd
= Sy
.val
THEN
2184 os
.StoreArg(var
.varOrd
);
2187 * stack goes (top) value, reference, ... so
2188 * os.PushArg(var.varOrd);
2190 os
.StoreIndirect(var
.type
);
2193 os
.StoreLocal(var
.varOrd
);
2197 (* ---------------------------------------------------- *)
2199 PROCEDURE (os
: MsilFile
)PutVar
*(id
: Sy
.Idnt
),NEW;
2203 var
:= id(Id
.AbVar
);
2205 WITH scp
: Id
.BlkId
DO
2206 os
.PutGetS(Asm
.opc_stsfld
, scp
, var(Id
.VarId
));
2207 ELSE (* must be local *)
2208 os
.PutLocal(var(Id
.LocId
));
2212 (* ------------------------------------------------------------ *)
2214 PROCEDURE (os
: MsilFile
)PutElem
*(typ
: Sy
.Type
),NEW;
2215 (* typ is element type *)
2217 IF (typ
# NIL) & (typ
IS Ty
.Base
) THEN
2218 os
.Code(typePutE
[typ(Ty
.Base
).tpOrd
]);
2219 ELSIF isValRecord(typ
) THEN
2220 os
.CodeT(Asm
.opc_stobj
, typ
);
2221 ELSIF typ
IS Ty
.Enum
THEN
2222 os
.Code(typePutE
[Ty
.intN
]); (* assume enum <==> int32 *)
2224 os
.Code(Asm
.opc_stelem_ref
);
2228 (* ------------------------------------------------------------ *)
2230 PROCEDURE (os
: MsilFile
)GetElem
*(typ
: Sy
.Type
),NEW;
2232 IF (typ
# NIL) & (typ
IS Ty
.Base
) THEN
2233 os
.Code(typeGetE
[typ(Ty
.Base
).tpOrd
]);
2234 ELSIF isValRecord(typ
) THEN
2235 os
.CodeT(Asm
.opc_ldobj
, typ
);
2236 ELSIF typ
IS Ty
.Enum
THEN
2237 os
.Code(typeGetE
[Ty
.intN
]); (* assume enum <==> int32 *)
2239 os
.Code(Asm
.opc_ldelem_ref
);
2243 (* ------------------------------------------------------------ *)
2245 PROCEDURE (os
: MsilFile
)GetField
*(fld
: Id
.FldId
),NEW;
2247 os
.PutGetF(Asm
.opc_ldfld
, fld
);
2250 (* ------------------------------------------------------------ *)
2252 PROCEDURE (os
: MsilFile
)GetFieldAdr
*(fld
: Id
.FldId
),NEW;
2254 os
.PutGetF(Asm
.opc_ldflda
, fld
);
2257 (* ------------------------------------------------------------ *)
2259 PROCEDURE (os
: MsilFile
)PutField
*(fld
: Id
.FldId
),NEW;
2261 os
.PutGetF(Asm
.opc_stfld
, fld
);
2264 (* ------------------------------------------------------------ *)
2266 PROCEDURE (os
: MsilFile
)GetElemA
*(typ
: Sy
.Type
),NEW;
2268 os
.CodeTn(Asm
.opc_ldelema
, typ
);
2271 (* ------------------------------------------------------------ *)
2273 PROCEDURE (os
: MsilFile
)GetVal
*(typ
: Ty
.Pointer
),NEW;
2275 os
.GetValObj(Asm
.opc_ldfld
, typ
);
2278 (* ------------------------------------------------------------ *)
2280 PROCEDURE (os
: MsilFile
)GetValA
*(typ
: Ty
.Pointer
),NEW;
2282 os
.GetValObj(Asm
.opc_ldflda
, typ
);
2285 (* ------------------------------------------------------------ *)
2287 PROCEDURE (os
: MsilFile
)PushInt
*(num
: INTEGER),NEW;
2289 IF (-128 <= num
) & (num
<= 127) THEN
2291 |
-1 : os
.Code(Asm
.opc_ldc_i4_M1
);
2292 |
0 : os
.Code(Asm
.opc_ldc_i4_0
);
2293 |
1 : os
.Code(Asm
.opc_ldc_i4_1
);
2294 |
2 : os
.Code(Asm
.opc_ldc_i4_2
);
2295 |
3 : os
.Code(Asm
.opc_ldc_i4_3
);
2296 |
4 : os
.Code(Asm
.opc_ldc_i4_4
);
2297 |
5 : os
.Code(Asm
.opc_ldc_i4_5
);
2298 |
6 : os
.Code(Asm
.opc_ldc_i4_6
);
2299 |
7 : os
.Code(Asm
.opc_ldc_i4_7
);
2300 |
8 : os
.Code(Asm
.opc_ldc_i4_8
);
2302 os
.CodeI(Asm
.opc_ldc_i4_s
, num
);
2305 os
.CodeI(Asm
.opc_ldc_i4
, num
);
2309 (* ------------------------------------------------------------ *)
2311 PROCEDURE (os
: MsilFile
)PushLong
*(num
: LONGINT),NEW;
2314 * IF num is short we could do PushInt, then i2l!
2316 os
.CodeL(Asm
.opc_ldc_i8
, num
);
2319 (* ------------------------------------------------------------ *)
2321 PROCEDURE (os
: MsilFile
)PushReal
*(num
: REAL),NEW;
2323 os
.CodeR(Asm
.opc_ldc_r8
, num
);
2326 (* ------------------------------------------------------------ *)
2328 PROCEDURE (os
: MsilFile
)PushSReal
*(num
: REAL),NEW;
2330 os
.CodeR(Asm
.opc_ldc_r4
, num
);
2333 (* ------------------------------------------------------------ *)
2335 PROCEDURE (os
: MsilFile
)PushJunkAndQuit
*(prc
: Sy
.Scope
),NEW;
2336 VAR pTyp
: Ty
.Procedure
;
2338 IF (prc
# NIL) & (prc
.type
# NIL) THEN
2339 pTyp
:= prc
.type(Ty
.Procedure
);
2340 IF pTyp
.retType
# NIL THEN os
.PushZero(pTyp
.retType
) END;
2343 END PushJunkAndQuit
;
2345 (* ------------------------------------------------------------ *)
2347 PROCEDURE (os
: MsilFile
)ConvertUp
*(inT
, outT
: Sy
.Type
),NEW;
2348 (* Conversion "up" is always safe at runtime. Many are nop. *)
2349 VAR inB
, outB
, code
: INTEGER;
2351 inB
:= inT(Ty
.Base
).tpOrd
;
2352 outB
:= outT(Ty
.Base
).tpOrd
;
2353 IF inB
= outB
THEN RETURN END; (* PREMATURE RETURN! *)
2355 | Ty
.realN
: code
:= Asm
.opc_conv_r8
;
2356 | Ty
.sReaN
: code
:= Asm
.opc_conv_r4
;
2357 | Ty
.lIntN
: code
:= Asm
.opc_conv_i8
;
2358 ELSE RETURN; (* PREMATURE RETURN! *)
2363 (* ------------------------------------------------------------ *)
2365 PROCEDURE (os
: MsilFile
)ConvertDn
*(inT
, outT
: Sy
.Type
; check
: BOOLEAN),NEW;
2366 (* Conversion "down" often needs a runtime check. *)
2367 VAR inB
, outB
, code
: INTEGER;
2369 inB
:= inT(Ty
.Base
).tpOrd
;
2370 outB
:= outT(Ty
.Base
).tpOrd
;
2371 IF inB
= Ty
.setN
THEN inB
:= Ty
.intN
END;
2372 IF inB
= outB
THEN RETURN END; (* PREMATURE RETURN! *)
2373 (* IF os.proc.prId.ovfChk THEN *)
2376 | Ty
.realN
: RETURN; (* PREMATURE RETURN! *)
2377 | Ty
.sReaN
: code
:= Asm
.opc_conv_r4
; (* No check possible *)
2378 | Ty
.lIntN
: code
:= Asm
.opc_conv_ovf_i8
;
2379 | Ty
.intN
: code
:= Asm
.opc_conv_ovf_i4
;
2380 | Ty
.sIntN
: code
:= Asm
.opc_conv_ovf_i2
;
2381 | Ty
.uBytN
: code
:= Asm
.opc_conv_ovf_u1
;
2382 | Ty
.byteN
: code
:= Asm
.opc_conv_ovf_i1
;
2383 | Ty
.setN
: code
:= Asm
.opc_conv_u4
; (* no check here! *)
2384 | Ty
.charN
: code
:= Asm
.opc_conv_ovf_u2
;
2385 | Ty
.sChrN
: code
:= Asm
.opc_conv_ovf_u1
;
2389 | Ty
.realN
: RETURN; (* PREMATURE RETURN! *)
2390 | Ty
.sReaN
: code
:= Asm
.opc_conv_r4
; (* No check possible *)
2391 | Ty
.lIntN
: code
:= Asm
.opc_conv_i8
;
2392 | Ty
.intN
: code
:= Asm
.opc_conv_i4
;
2393 | Ty
.sIntN
: code
:= Asm
.opc_conv_i2
;
2394 | Ty
.byteN
: code
:= Asm
.opc_conv_i1
;
2395 | Ty
.uBytN
: code
:= Asm
.opc_conv_u1
;
2396 | Ty
.setN
: code
:= Asm
.opc_conv_u4
; (* no check here! *)
2397 | Ty
.charN
: code
:= Asm
.opc_conv_u2
;
2398 | Ty
.sChrN
: code
:= Asm
.opc_conv_u1
;
2404 (* ------------------------------------------------------------ *)
2406 PROCEDURE (os
: MsilFile
)EmitOneRange
*
2407 (var
: INTEGER; (* local variable index *)
2408 loC
: INTEGER; (* low-value of range *)
2409 hiC
: INTEGER; (* high-value of range *)
2410 ord
: INTEGER; (* case-index of range *)
2411 min
: INTEGER; (* minimun selector val *)
2412 max
: INTEGER; (* maximum selector val *)
2413 def
: LbArr
),NEW; (* default code label *)
2414 (* ---------------------------------------------------------- *
2415 * The selector value is known to be in the range min .. max *
2416 * and we wish to send values between loC and hiC to the *
2417 * code label associated with ord. All otherwise go to def. *
2418 * A range is "compact" if it is hard against min/max limits *
2419 * ---------------------------------------------------------- *)
2420 VAR target
: INTEGER;
2423 * Deal with several special cases...
2426 IF (min
= loC
) & (max
= hiC
) THEN (* fully compact: just GOTO *)
2427 os
.CodeLb(Asm
.opc_br
, def
[target
]);
2430 IF loC
= hiC
THEN (* a singleton *)
2432 os
.CodeLb(Asm
.opc_beq
, def
[target
]);
2433 ELSIF min
= loC
THEN (* compact at low end only *)
2435 os
.CodeLb(Asm
.opc_ble
, def
[target
]);
2436 ELSIF max
= hiC
THEN (* compact at high end only *)
2438 os
.CodeLb(Asm
.opc_bge
, def
[target
]);
2439 ELSE (* Shucks! The general case *)
2442 os
.Code(Asm
.opc_sub
);
2444 os
.PushInt(hiC
-loC
);
2445 os
.CodeLb(Asm
.opc_ble_un
, def
[target
]);
2447 os
.CodeLb(Asm
.opc_br
, def
[0]);
2451 (* ------------------------------------------------------------ *)
2452 (* ------------------------------------------------------------ *)
2454 PROCEDURE (os
: MsilFile
)InitVars
*(scp
: Sy
.Scope
),NEW;
2455 VAR index
: INTEGER;
2459 * Create the explicit activation record, if needed.
2461 WITH scp
: Id
.Procs
DO
2462 IF Id
.hasXHR
IN scp
.pAttr
THEN
2463 os
.Comment("create XHR record");
2464 os
.MkNewRecord(scp
.xhrType
.boundRecTp()(Ty
.Record
));
2465 IF scp
.lxDepth
> 0 THEN
2466 os
.Code(Asm
.opc_dup
);
2467 os
.Code(Asm
.opc_ldarg_0
);
2468 os
.PutGetF(Asm
.opc_stfld
, CSt
.xhrId
);
2470 os
.Code(Asm
.opc_stloc_0
);
2475 * Initialize local fields, if needed
2477 FOR index
:= 0 TO scp
.locals
.tide
-1 DO
2478 ident
:= scp
.locals
.a
[index
];
2479 WITH ident
: Id
.ParId
DO
2480 IF Id
.uplevA
IN ident
.locAtt
THEN (* copy to XHR *)
2482 os
.PushArg(ident
.varOrd
);
2483 IF Id
.cpVarP
IN ident
.locAtt
THEN os
.LoadIndirect(ident
.type
) END;
2484 os
.GetXhrField(Asm
.opc_stfld
, ident
);
2485 END; (* else skip *)
2487 IF ~ident
.type
.isScalarType() THEN
2488 os
.StructInit(ident
);
2490 WITH ident
: Id
.LocId
DO
2492 * Special code to step around deficiency in the the
2493 * verifier. Verifier does not understand OUT semantics.
2495 * IF Id.addrsd IN ident.locAtt THEN
2497 IF (Id
.addrsd
IN ident
.locAtt
) & ~
(Id
.uplevA
IN ident
.locAtt
) THEN
2498 ASSERT(~
(scp
IS Id
.BlkId
));
2499 os
.ScalarInit(ident
);
2500 os
.StoreLocal(ident
.varOrd
);
2509 (* ============================================================ *)
2511 PROCEDURE (os
: MsilFile
)FixCopies(prId
: Sy
.Idnt
),NEW;
2512 VAR index
: INTEGER;
2513 pType
: Ty
.Procedure
;
2517 WITH prId
: Id
.Procs
DO
2518 pType
:= prId
.type(Ty
.Procedure
);
2519 FOR index
:= 0 TO pType
.formals
.tide
- 1 DO
2520 formP
:= pType
.formals
.a
[index
];
2521 IF Id
.cpVarP
IN formP
.locAtt
THEN
2522 os
.PushArg(formP
.varOrd
);
2524 os
.GetXhrField(Asm
.opc_ldfld
, formP
);
2525 os
.StoreIndirect(formP
.type
);
2533 (* ============================================================ *)
2535 PROCEDURE InitVectorDescriptors();
2541 FOR idx
:= 0 TO Ty
.anyPtr
DO
2542 vecElms
[idx
] := NIL;
2543 vecTypes
[idx
] := NIL;
2544 vecExpnd
[idx
] := NIL;
2546 END InitVectorDescriptors
;
2548 (* ============================================================ *)
2550 PROCEDURE SetNativeNames
*();
2551 VAR sRec
, oRec
: Ty
.Record
;
2554 oRec
:= CSt
.ntvObj
.boundRecTp()(Ty
.Record
);
2555 sRec
:= CSt
.ntvStr
.boundRecTp()(Ty
.Record
);
2557 InitVectorDescriptors();
2559 * From release 1.2, only the RTM version is supported
2561 INCL(oRec
.xAttr
, Sy
.spshl
);
2562 INCL(sRec
.xAttr
, Sy
.spshl
);
2563 oRec
.xName
:= Lv
.strToCharOpen("object");
2564 sRec
.xName
:= Lv
.strToCharOpen("string");
2565 oRec
.scopeNm
:= oRec
.xName
;
2566 sRec
.scopeNm
:= sRec
.xName
;
2567 pVarSuffix
:= Lv
.strToCharOpen(".ctor($O, native int) ");
2569 CSt
.ntvObj
.xName
:= oRec
.scopeNm
;
2570 CSt
.ntvStr
.xName
:= sRec
.scopeNm
;
2574 (* ============================================================ *)
2575 (* ============================================================ *)
2577 Lv
.InitCharOpenSeq(nmArray
, 8);
2579 rtsS
:= Lv
.strToCharOpen("RTS");
2580 brks
:= Lv
.strToCharOpen("[]");
2581 dotS
:= Lv
.strToCharOpen(".");
2582 cmma
:= Lv
.strToCharOpen(",");
2583 lPar
:= Lv
.strToCharOpen("(");
2584 rPar
:= Lv
.strToCharOpen(")");
2585 lBrk
:= Lv
.strToCharOpen("[");
2586 rBrk
:= Lv
.strToCharOpen("]");
2587 atSg
:= Lv
.strToCharOpen("@");
2588 rfMk
:= Lv
.strToCharOpen("&");
2589 vFld
:= Lv
.strToCharOpen("v$");
2590 ouMk
:= Lv
.strToCharOpen("[out] ");
2591 prev
:= Lv
.strToCharOpen("prev");
2592 body
:= Lv
.strToCharOpen("$static");
2593 xhrDl
:= Lv
.strToCharOpen("XHR@");
2594 xhrMk
:= Lv
.strToCharOpen("class [RTS]XHR");
2595 boxedObj
:= Lv
.strToCharOpen("Boxed_");
2596 corlibAsm
:= Lv
.strToCharOpen("[mscorlib]System.");
2598 vecPrefix
:= Lv
.strToCharOpen("[RTS]Vectors.");
2599 evtAdd
:= Lv
.strToCharOpen("add_");
2600 evtRem
:= Lv
.strToCharOpen("remove_");
2602 Bi
.setTp
.xName
:= Lv
.strToCharOpen("int32");
2603 Bi
.boolTp
.xName
:= Lv
.strToCharOpen("bool");
2604 Bi
.byteTp
.xName
:= Lv
.strToCharOpen("int8");
2605 Bi
.uBytTp
.xName
:= Lv
.strToCharOpen("unsigned int8");
2606 Bi
.charTp
.xName
:= Lv
.strToCharOpen("wchar");
2607 Bi
.sChrTp
.xName
:= Lv
.strToCharOpen("char");
2608 Bi
.sIntTp
.xName
:= Lv
.strToCharOpen("int16");
2609 Bi
.lIntTp
.xName
:= Lv
.strToCharOpen("int64");
2610 Bi
.realTp
.xName
:= Lv
.strToCharOpen("float64");
2611 Bi
.sReaTp
.xName
:= Lv
.strToCharOpen("float32");
2612 Bi
.intTp
.xName
:= Bi
.setTp
.xName
;
2613 Bi
.anyRec
.xName
:= Lv
.strToCharOpen("class System.Object");
2614 Bi
.anyPtr
.xName
:= Bi
.anyRec
.xName
;
2616 typeGetE
[ Ty
.boolN
] := Asm
.opc_ldelem_i1
;
2618 * typeGetE[ Ty.sChrN] := Asm.opc_ldelem_u1;
2620 typeGetE
[ Ty
.sChrN
] := Asm
.opc_ldelem_u2
;
2621 typeGetE
[ Ty
.charN
] := Asm
.opc_ldelem_u2
;
2622 typeGetE
[ Ty
.byteN
] := Asm
.opc_ldelem_i1
;
2623 typeGetE
[ Ty
.uBytN
] := Asm
.opc_ldelem_u1
;
2624 typeGetE
[ Ty
.sIntN
] := Asm
.opc_ldelem_i2
;
2625 typeGetE
[ Ty
.intN
] := Asm
.opc_ldelem_i4
;
2626 typeGetE
[ Ty
.lIntN
] := Asm
.opc_ldelem_i8
;
2627 typeGetE
[ Ty
.sReaN
] := Asm
.opc_ldelem_r4
;
2628 typeGetE
[ Ty
.realN
] := Asm
.opc_ldelem_r8
;
2629 typeGetE
[ Ty
.setN
] := Asm
.opc_ldelem_i4
;
2630 typeGetE
[Ty
.anyPtr
] := Asm
.opc_ldelem_ref
;
2631 typeGetE
[Ty
.anyRec
] := Asm
.opc_ldelem_ref
;
2633 typePutE
[ Ty
.boolN
] := Asm
.opc_stelem_i1
;
2635 * typePutE[ Ty.sChrN] := Asm.opc_stelem_i1;
2637 typePutE
[ Ty
.sChrN
] := Asm
.opc_stelem_i2
;
2638 typePutE
[ Ty
.charN
] := Asm
.opc_stelem_i2
;
2639 typePutE
[ Ty
.byteN
] := Asm
.opc_stelem_i1
;
2640 typePutE
[ Ty
.uBytN
] := Asm
.opc_stelem_i1
;
2641 typePutE
[ Ty
.sIntN
] := Asm
.opc_stelem_i2
;
2642 typePutE
[ Ty
.intN
] := Asm
.opc_stelem_i4
;
2643 typePutE
[ Ty
.lIntN
] := Asm
.opc_stelem_i8
;
2644 typePutE
[ Ty
.sReaN
] := Asm
.opc_stelem_r4
;
2645 typePutE
[ Ty
.realN
] := Asm
.opc_stelem_r8
;
2646 typePutE
[ Ty
.setN
] := Asm
.opc_stelem_i4
;
2647 typePutE
[Ty
.anyPtr
] := Asm
.opc_stelem_ref
;
2648 typePutE
[Ty
.anyRec
] := Asm
.opc_stelem_ref
;
2650 typeLdInd
[ Ty
.boolN
] := Asm
.opc_ldind_u1
;
2651 typeLdInd
[ Ty
.sChrN
] := Asm
.opc_ldind_u2
;
2652 typeLdInd
[ Ty
.charN
] := Asm
.opc_ldind_u2
;
2653 typeLdInd
[ Ty
.byteN
] := Asm
.opc_ldind_i1
;
2654 typeLdInd
[ Ty
.uBytN
] := Asm
.opc_ldind_u1
;
2655 typeLdInd
[ Ty
.sIntN
] := Asm
.opc_ldind_i2
;
2656 typeLdInd
[ Ty
.intN
] := Asm
.opc_ldind_i4
;
2657 typeLdInd
[ Ty
.lIntN
] := Asm
.opc_ldind_i8
;
2658 typeLdInd
[ Ty
.sReaN
] := Asm
.opc_ldind_r4
;
2659 typeLdInd
[ Ty
.realN
] := Asm
.opc_ldind_r8
;
2660 typeLdInd
[ Ty
.setN
] := Asm
.opc_ldind_i4
;
2661 typeLdInd
[Ty
.anyPtr
] := Asm
.opc_ldind_ref
;
2662 typeLdInd
[Ty
.anyRec
] := Asm
.opc_ldind_ref
;
2664 typeStInd
[ Ty
.boolN
] := Asm
.opc_stind_i1
;
2665 typeStInd
[ Ty
.sChrN
] := Asm
.opc_stind_i2
;
2666 typeStInd
[ Ty
.charN
] := Asm
.opc_stind_i2
;
2667 typeStInd
[ Ty
.byteN
] := Asm
.opc_stind_i1
;
2668 typeStInd
[ Ty
.uBytN
] := Asm
.opc_stind_i1
;
2669 typeStInd
[ Ty
.sIntN
] := Asm
.opc_stind_i2
;
2670 typeStInd
[ Ty
.intN
] := Asm
.opc_stind_i4
;
2671 typeStInd
[ Ty
.lIntN
] := Asm
.opc_stind_i8
;
2672 typeStInd
[ Ty
.sReaN
] := Asm
.opc_stind_r4
;
2673 typeStInd
[ Ty
.realN
] := Asm
.opc_stind_r8
;
2674 typeStInd
[ Ty
.setN
] := Asm
.opc_stind_i4
;
2675 typeStInd
[Ty
.anyPtr
] := Asm
.opc_stind_ref
;
2676 typeStInd
[Ty
.anyRec
] := Asm
.opc_stind_ref
;
2678 (* ============================================================ *)
2680 (* ============================================================ *)