gpcp/IlasmUtil.cp

   1 (* ============================================================ *)
   2 (*  MsilUtil is the module which writes ILASM file structures   *)
   3 (*  Copyright (c) John Gough 1999, 2000.                        *)
   4 (* ============================================================ *)
   5
   6 MODULE IlasmUtil;
   7
   8   IMPORT
   9         GPCPcopyright,
  10         RTS,
  11         ASCII,
  12         Console,
  13         GPText,
  14         GPBinFiles,
  15         GPTextFiles,
  16
  17         Lv := LitValue,
  18         Cs := CompState,
  19         Sy := Symbols,
  20         Mu := MsilUtil,
  21         Bi := Builtin,
  22         Id  := IdDesc,
  23         Ty  := TypeDesc,
  24         Scn := CPascalS,
  25         Asm := IlasmCodes;
  26
  27 (* ============================================================ *)
  28
  29    CONST
  30         (* various ILASM-specific runtime name strings *)
  31         initPrefix  = "instance void ";
  32         initSuffix  = ".ctor() ";
  33         initString  = ".ctor";
  34         managedStr  = "il managed";
  35         specialStr  = "public specialname rtspecialname ";
  36         cctorStr    = "static void .cctor() ";
  37         objectInit  = "instance void $o::.ctor() ";
  38         mainString  = "public static void '.CPmain'($S[]) il managed";
  39         winString   = "public static void '.WinMain'($S[]) il managed";
  40         subSysStr   = "  .subsystem 0x00000002";
  41         copyHead    = "public void __copy__(";
  42
  43    CONST
  44         putArgStr   = "$S[] [RTS]ProgArgs::argList";
  45         catchStr    = "      catch [mscorlib]System.Exception";
  46
  47 (* ============================================================ *)
  48 (* ============================================================ *)
  49
  50   TYPE IlasmFile* = POINTER TO RECORD (Mu.MsilFile)
  51                  (* Fields inherited from MsilFile *
  52                   *   srcS* : Lv.CharOpen; (* source file name   *)
  53                   *   outN* : Lv.CharOpen;
  54                   *   proc* : ProcInfo;
  55                   *)
  56                       nxtLb : INTEGER;
  57                       clsN* : Lv.CharOpen; (* current class name *)
  58                       file* : GPBinFiles.FILE;
  59                     END;
  60
  61 (* ============================================================ *)
  62
  63   TYPE ILabel*    = POINTER TO RECORD (Mu.Label)
  64                       labl : INTEGER;
  65                     END;
  66
  67 (* ============================================================ *)
  68
  69   TYPE UByteArrayPtr* = POINTER TO ARRAY OF UBYTE;
  70
  71 (* ============================================================ *)
  72
  73   VAR   nmArray   : Lv.CharOpenSeq;
  74         rts       : ARRAY Mu.rtsLen OF Lv.CharOpen;
  75
  76   VAR   vals,                           (* "value"  *)
  77         clss,                           (* "class"  *)
  78         cln2,                           (* "::"     *)
  79         brks,                           (* "[]"     *)
  80         vStr,                           (* "void "  *)
  81         ouMk,                           (* "[out]"  *)
  82         lPar, rPar,                     (* ( )      *)
  83         rfMk,                           (* "&"      *)
  84         cmma,                           (* ","      *)
  85         brsz,                           (* "{} etc" *)
  86         vFld,                           (* "v$"     *)
  87         inVd : Lv.CharOpen;             (* "in.v "  *)
  88
  89   VAR   evtAdd, evtRem : Lv.CharOpen;
  90         pVarSuffix     : Lv.CharOpen;
  91         xhrMk          : Lv.CharOpen;
  92
  93   VAR   boxedObj       : Lv.CharOpen;
  94
  95 (* ============================================================ *)
  96 (*                 Utility Coercion Method                      *)
  97 (* ============================================================ *)
  98
  99   PROCEDURE UBytesOf(IN str : ARRAY OF CHAR) : UByteArrayPtr;
 100     VAR result : UByteArrayPtr;
 101         index  : INTEGER;
 102         length : INTEGER;
 103   BEGIN
 104     length := LEN(str$);
 105     NEW(result, length);
 106     FOR index := 0 TO length-1 DO
 107       result[index] := USHORT(ORD(str[index]) MOD 256);
 108     END;
 109     RETURN result;
 110   END UBytesOf;
 111
 112 (* ============================================================ *)
 113 (*                    Constructor Method                        *)
 114 (* ============================================================ *)
 115
 116   PROCEDURE newIlasmFile*(IN nam : ARRAY OF CHAR) : IlasmFile;
 117     VAR f : IlasmFile;
 118   BEGIN
 119     NEW(f);
 120     f.outN := BOX(nam + ".il");
 121     f.file := GPBinFiles.createFile(f.outN);
 122     RETURN f;
 123   END newIlasmFile;
 124
 125 (* ============================================================ *)
 126
 127   PROCEDURE (t : IlasmFile)fileOk*() : BOOLEAN;
 128   BEGIN
 129     RETURN t.file # NIL;
 130   END fileOk;
 131
 132 (* ============================================================ *)
 133 (*                    Some static utilities                     *)
 134 (* ============================================================ *)
 135
 136   PROCEDURE^ (os : IlasmFile)Locals(),NEW;
 137   PROCEDURE^ (os : IlasmFile)TypeName(typ : Sy.Type),NEW;
 138   PROCEDURE^ (os : IlasmFile)CallCombine(typ : Sy.Type; add : BOOLEAN),NEW;
 139   PROCEDURE^ (os : IlasmFile)Comment*(IN s : ARRAY OF CHAR);
 140   PROCEDURE^ (os : IlasmFile)CodeLb*(code : INTEGER; i2 : Mu.Label);
 141   PROCEDURE^ (os : IlasmFile)DefLabC*(l : Mu.Label; IN c : ARRAY OF CHAR);
 142
 143 (* ============================================================ *)
 144
 145   PROCEDURE (os : IlasmFile)MkNewProcInfo*(proc : Sy.Scope);
 146   BEGIN
 147     NEW(os.proc);
 148     Mu.InitProcInfo(os.proc, proc);
 149   END MkNewProcInfo;
 150
 151 (* ============================================================ *)
 152
 153   PROCEDURE (os : IlasmFile)newLabel*() : Mu.Label;
 154     VAR label : ILabel;
 155   BEGIN
 156     NEW(label);
 157     INC(os.nxtLb);
 158     label.labl := os.nxtLb;
 159     RETURN label;
 160   END newLabel;
 161
 162 (* ============================================================ *)
 163 (*   Signature handling for this version                        *)
 164 (* ============================================================ *)
 165
 166   PROCEDURE (os : IlasmFile)NumberParams*(pIdn : Id.Procs;
 167                                           pTyp : Ty.Procedure);
 168     VAR parId : Id.ParId;
 169         index : INTEGER;
 170         count : INTEGER;
 171         first : BOOLEAN;
 172         fmArray  : Lv.CharOpenSeq;
 173    (* ----------------------------------------- *)
 174     PROCEDURE AppendTypeName(VAR lst : Lv.CharOpenSeq;
 175                                  typ : Sy.Type;
 176                                  slf : IlasmFile);
 177     BEGIN
 178      (*
 179       *   We append type names, which must be lexically
 180       *   equivalent to the names used in the declaration
 181       *   in MethodDecl.
 182       *)
 183       IF typ.xName = NIL THEN Mu.MkTypeName(typ, slf) END;
 184       WITH typ : Ty.Base DO
 185           Lv.AppendCharOpen(lst, typ.xName);
 186       | typ : Ty.Vector DO
 187           Lv.AppendCharOpen(lst, clss);
 188           Lv.AppendCharOpen(lst, typ.xName);
 189       | typ : Ty.Array DO
 190           AppendTypeName(lst, typ.elemTp, slf);
 191           Lv.AppendCharOpen(lst, brks);
 192       | typ : Ty.Record DO
 193           IF ~(Sy.clsTp IN typ.xAttr) THEN Lv.AppendCharOpen(lst,vals) END;
 194           IF ~(Sy.spshl IN typ.xAttr) THEN Lv.AppendCharOpen(lst,clss) END;
 195           Lv.AppendCharOpen(lst, typ.scopeNm);
 196       | typ : Ty.Pointer DO
 197          (*
 198           *  This is a pointer to a value class, which has a
 199           *  runtime representation as a boxed-class reference.
 200           *)
 201           IF Mu.isValRecord(typ.boundTp) THEN
 202             Lv.AppendCharOpen(lst, clss);
 203             Lv.AppendCharOpen(lst, typ.xName);
 204           ELSE
 205             AppendTypeName(lst, typ.boundTp, slf);
 206           END;
 207       | typ : Ty.Opaque DO
 208           Lv.AppendCharOpen(lst, clss);
 209           Lv.AppendCharOpen(lst, typ.xName);
 210       | typ : Ty.Enum DO
 211           Lv.AppendCharOpen(lst, vals);
 212           Lv.AppendCharOpen(lst, clss);
 213           Lv.AppendCharOpen(lst, typ.xName);
 214       | typ : Ty.Procedure DO
 215           Lv.AppendCharOpen(lst, clss);
 216           Lv.AppendCharOpen(lst, typ.tName);
 217       END;
 218     END AppendTypeName;
 219    (* ----------------------------------------- *)
 220   BEGIN
 221     first := TRUE;
 222     count := pTyp.argN;
 223     Lv.InitCharOpenSeq(fmArray, 4);
 224     Lv.AppendCharOpen(fmArray, lPar);
 225     IF (pIdn # NIL) & (pIdn.lxDepth > 0) THEN
 226       Lv.AppendCharOpen(fmArray, xhrMk); first := FALSE;
 227     END;
 228     FOR index := 0 TO pTyp.formals.tide-1 DO
 229       IF ~first THEN Lv.AppendCharOpen(fmArray, cmma) END;
 230       parId := pTyp.formals.a[index];
 231       parId.varOrd := count; INC(count);
 232       AppendTypeName(fmArray, parId.type, os);
 233       IF Mu.takeAdrs(parId) THEN
 234         parId.boxOrd := parId.parMod;
 235         Lv.AppendCharOpen(fmArray, rfMk);
 236         IF Id.uplevA IN parId.locAtt THEN
 237           parId.boxOrd := Sy.val;
 238           ASSERT(Id.cpVarP IN parId.locAtt);
 239         END;
 240       END; (* just mark *)
 241       first := FALSE;
 242     END;
 243     Lv.AppendCharOpen(fmArray, rPar);
 244     pTyp.xName := Lv.arrayCat(fmArray);
 245    (*
 246     *   The current info.lNum (before the locals
 247     *   have been added) is the argsize.
 248     *)
 249     pTyp.argN := count;
 250     IF pTyp.retType # NIL THEN pTyp.retN := 1 END;
 251   END NumberParams;
 252
 253 (* ============================================================ *)
 254 (*                    Private Methods                           *)
 255 (* ============================================================ *)
 256
 257   PROCEDURE (os : IlasmFile)CatChar(chr : CHAR),NEW;
 258   BEGIN
 259     GPBinFiles.WriteByte(os.file, ORD(chr) MOD 256);
 260   END CatChar;
 261
 262 (* ============================================================ *)
 263
 264   PROCEDURE (os : IlasmFile)CatStr(IN str : ARRAY OF CHAR),NEW;
 265   BEGIN
 266     GPBinFiles.WriteNBytes(os.file, UBytesOf(str), LEN(str$));
 267   END CatStr;
 268
 269 (* ============================================================ *)
 270
 271   PROCEDURE (os : IlasmFile)CatInt(val : INTEGER),NEW;
 272     VAR arr : ARRAY 16 OF CHAR;
 273   BEGIN
 274     GPText.IntToStr(val, arr); os.CatStr(arr);
 275   END CatInt;
 276
 277 (* ============================================================ *)
 278
 279   PROCEDURE (os : IlasmFile)CatLong(val : LONGINT),NEW;
 280     VAR arr : ARRAY 32 OF CHAR;
 281   BEGIN
 282     GPText.LongToStr(val, arr); os.CatStr(arr);
 283   END CatLong;
 284
 285 (* ============================================================ *)
 286
 287   PROCEDURE (os : IlasmFile)CatEOL(),NEW;
 288   BEGIN
 289     os.CatStr(RTS.eol);
 290   END CatEOL;
 291
 292 (* ============================================================ *)
 293
 294   PROCEDURE (os : IlasmFile)WriteHex(int : INTEGER),NEW;
 295     VAR ord : INTEGER;
 296   BEGIN
 297     IF int <= 9 THEN ord := ORD('0') + int ELSE ord := (ORD('A')-10)+int END;
 298     os.CatChar(CHR(ord));
 299   END WriteHex;
 300
 301 (* ============================================================ *)
 302
 303   PROCEDURE (os : IlasmFile)WriteHexByte(int : INTEGER),NEW;
 304   BEGIN
 305     os.WriteHex(int DIV 16);
 306     os.WriteHex(int MOD 16);
 307     os.CatChar(' ');
 308   END WriteHexByte;
 309
 310 (* ============================================================ *)
 311
 312   PROCEDURE (os : IlasmFile)Tstring(IN str : ARRAY OF CHAR),NEW;
 313    (* TAB, then string *)
 314   BEGIN
 315     os.CatChar(ASCII.HT); os.CatStr(str);
 316   END Tstring;
 317
 318 (* ============================================================ *)
 319
 320   PROCEDURE (os : IlasmFile)Bstring(IN str : ARRAY OF CHAR),NEW;
 321    (* BLANK, then string *)
 322   BEGIN
 323     os.CatChar(" "); os.CatStr(str);
 324   END Bstring;
 325
 326 (* ============================================================ *)
 327
 328   PROCEDURE (os : IlasmFile)Tint(int : INTEGER),NEW;
 329    (* TAB, then int *)
 330   BEGIN
 331     os.CatChar(ASCII.HT); os.CatInt(int);
 332   END Tint;
 333
 334 (* ============================================================ *)
 335
 336   PROCEDURE (os : IlasmFile)Tlong(long : LONGINT),NEW;
 337    (* TAB, then long *)
 338   BEGIN
 339     os.CatChar(ASCII.HT); os.CatLong(long);
 340   END Tlong;
 341
 342 (* ============================================================ *)
 343
 344   PROCEDURE (os : IlasmFile)QuoteStr(IN str : ARRAY OF CHAR),NEW;
 345    (* ------------------------ *)
 346     PROCEDURE EmitQuotedString(os : IlasmFile; IN str : ARRAY OF CHAR);
 347       VAR chr : CHAR;
 348           idx : INTEGER;
 349           ord : INTEGER;
 350     BEGIN
 351       os.CatChar('"');
 352       FOR idx := 0 TO LEN(str) - 2 DO
 353         chr := str[idx];
 354         CASE chr OF
 355         | "\",'"' : os.CatChar("\");
 356                     os.CatChar(chr);
 357         | 9X      : os.CatChar("\");
 358                     os.CatChar("t");
 359         | 0AX     : os.CatChar("\");
 360                     os.CatChar("n");
 361         ELSE
 362           IF chr > 07EX THEN
 363             ord := ORD(chr);
 364             os.CatChar('\');
 365             os.CatChar(CHR(ord DIV 64 + ORD('0')));
 366             os.CatChar(CHR(ord MOD 64 DIV 8 + ORD('0')));
 367             os.CatChar(CHR(ord MOD 8 + ORD('0')));
 368           ELSE
 369             os.CatChar(chr);
 370           END
 371         END;
 372       END;
 373       os.CatChar('"');
 374     END EmitQuotedString;
 375    (* ------------------------ *)
 376     PROCEDURE EmitByteArray(os : IlasmFile; IN str : ARRAY OF CHAR);
 377       VAR idx : INTEGER;
 378           ord : INTEGER;
 379     BEGIN
 380       os.CatStr("bytearray (");
 381       FOR idx := 0 TO LEN(str) - 2 DO
 382         ord := ORD(str[idx]);
 383         os.WriteHexByte(ord MOD 256);
 384         os.WriteHexByte(ord DIV 256);
 385       END;
 386       os.CatStr(")");
 387     END EmitByteArray;
 388    (* ------------------------ *)
 389     PROCEDURE NotASCIIZ(IN str : ARRAY OF CHAR) : BOOLEAN;
 390       VAR idx : INTEGER;
 391           ord : INTEGER;
 392     BEGIN
 393       FOR idx := 0 TO LEN(str) - 2 DO
 394         ord := ORD(str[idx]);
 395         IF (ord = 0) OR (ord > 0FFH) THEN RETURN TRUE END;
 396       END;
 397       RETURN FALSE;
 398     END NotASCIIZ;
 399    (* ------------------------ *)
 400   BEGIN
 401     IF NotASCIIZ(str) THEN
 402       EmitByteArray(os, str);
 403     ELSE
 404       EmitQuotedString(os, str);
 405     END;
 406   END QuoteStr;
 407
 408 (* ============================================================ *)
 409
 410   PROCEDURE (os : IlasmFile)Prefix(code : INTEGER),NEW;
 411   BEGIN
 412     os.CatChar(ASCII.HT); os.CatStr(Asm.op[code]);
 413   END Prefix;
 414
 415 (* ============================================================ *)
 416
 417   PROCEDURE (os : IlasmFile)IAdjust*(delta : INTEGER),NEW;
 418   BEGIN
 419     os.Adjust(delta);
 420     IF Cs.verbose THEN
 421       os.CatStr(" // ");
 422       os.CatInt(os.proc.dNum);
 423       os.CatChar(",");
 424       os.CatInt(os.proc.dMax);
 425     END;
 426     os.CatEOL();
 427   END IAdjust;
 428
 429 (* ============================================================ *)
 430
 431   PROCEDURE (os : IlasmFile)Suffix(code : INTEGER),NEW;
 432   BEGIN
 433     os.Adjust(Asm.dl[code]);
 434     IF Cs.verbose THEN
 435       os.CatStr(" // ");
 436       os.CatInt(os.proc.dNum);
 437       os.CatChar(",");
 438       os.CatInt(os.proc.dMax);
 439     END;
 440     os.CatEOL();
 441   END Suffix;
 442
 443 (* ============================================================ *)
 444
 445   PROCEDURE (os : IlasmFile)Access*(acc : SET),NEW;
 446     VAR att : INTEGER;
 447   BEGIN
 448     os.CatChar(" ");
 449     FOR att := 0 TO Asm.maxAttIndex DO
 450       IF att IN acc THEN
 451         os.CatStr(Asm.access[att]);
 452         os.CatChar(' ');
 453       END;
 454     END;
 455   END Access;
 456
 457 (* ============================================================ *)
 458
 459   PROCEDURE (os : IlasmFile)RefLab*(l : Mu.Label),NEW;
 460   BEGIN
 461     os.CatChar(ASCII.HT);
 462     os.CatChar("l");
 463     os.CatChar("b");
 464     os.CatInt(l(ILabel).labl);
 465   END RefLab;
 466
 467 (* ------------------------------------ *)
 468
 469   PROCEDURE (os : IlasmFile)LstLab*(l : Mu.Label);
 470   BEGIN
 471     os.CatChar(",");
 472     os.CatEOL();
 473     os.Tstring("       lb");
 474     os.CatInt(l(ILabel).labl);
 475   END LstLab;
 476
 477 (* ============================================================ *)
 478
 479   PROCEDURE (os : IlasmFile)SwitchHead*(n : INTEGER);
 480    (* n is table length, ignored here *)
 481   BEGIN
 482     os.Prefix(Asm.opc_switch);
 483     os.Tstring("( // dispatch table: ");
 484     os.CatInt(n);
 485   END SwitchHead;
 486
 487 (* ------------------------------------ *)
 488
 489   PROCEDURE (os : IlasmFile)SwitchTail*();
 490   BEGIN
 491     os.CatChar(")");
 492     os.IAdjust(-1);
 493   END SwitchTail;
 494
 495 (* ============================================================ *)
 496
 497   PROCEDURE (os : IlasmFile)Idnt(idD : Sy.Idnt),NEW;
 498   BEGIN
 499     os.CatChar("'");
 500     os.CatStr(Sy.getName.ChPtr(idD));
 501     os.CatChar("'");
 502   END Idnt;
 503
 504 (* ------------------------------------ *)
 505
 506   PROCEDURE (os : IlasmFile)SQuote(str : Lv.CharOpen),NEW;
 507   BEGIN
 508     os.CatChar("'");
 509     os.CatStr(str);
 510     os.CatChar("'");
 511   END SQuote;
 512
 513 (* ------------------------------------ *)
 514
 515   PROCEDURE (os : IlasmFile)TsQuote(str : Lv.CharOpen),NEW;
 516   BEGIN
 517     os.CatChar(ASCII.HT); os.SQuote(str);
 518   END TsQuote;
 519
 520 (* ------------------------------------ *)
 521
 522   PROCEDURE (os : IlasmFile)Tidnt(idD : Sy.Idnt),NEW;
 523   BEGIN
 524     os.CatChar(ASCII.HT); os.Idnt(idD);
 525   END Tidnt;
 526
 527 (* ------------------------------------ *)
 528
 529   PROCEDURE (os : IlasmFile)Bidnt(idD : Sy.Idnt),NEW;
 530   BEGIN
 531     os.CatChar(" "); os.Idnt(idD);
 532   END Bidnt;
 533
 534 (* ------------------------------------ *)
 535
 536   PROCEDURE (os : IlasmFile)PIdnt(idD : Id.Procs),NEW;
 537    (* Write out procedure identifier name *)
 538     VAR fullNm : Lv.CharOpen;
 539   BEGIN
 540     IF idD.scopeNm = NIL THEN Mu.MkProcName(idD, os) END;
 541     os.CatChar(" ");
 542     WITH idD : Id.PrcId DO
 543         IF idD.bndType = NIL THEN
 544           fullNm := Mu.cat2(idD.scopeNm, idD.clsNm);
 545         ELSE (* beware of special cases for object and string! *)
 546           fullNm := idD.bndType(Ty.Record).scopeNm;
 547         END;
 548     | idD : Id.MthId DO
 549         IF Id.boxRcv IN idD.mthAtt THEN
 550           fullNm := Mu.cat3(idD.scopeNm, boxedObj, idD.bndType.xName);
 551         ELSE (* beware of special cases for object and string! *)
 552           fullNm := idD.bndType(Ty.Record).scopeNm;
 553         END;
 554     END;
 555     os.CatStr(fullNm);
 556     os.CatStr(cln2);
 557     os.SQuote(idD.prcNm);
 558   END PIdnt;
 559
 560 (* ============================================================ *)
 561
 562   PROCEDURE (os : IlasmFile)TypeTag(typ : Sy.Type),NEW;
 563   BEGIN
 564     IF typ.xName = NIL THEN Mu.MkTypeName(typ,os) END;
 565     WITH typ : Ty.Base DO
 566         os.CatStr(typ.xName);
 567     | typ : Ty.Vector DO
 568         os.CatStr(clss);
 569         os.CatStr(typ.xName);
 570     | typ : Ty.Array DO
 571         os.TypeTag(typ.elemTp);
 572         os.CatStr(brks);
 573     | typ : Ty.Record DO
 574         IF ~(Sy.clsTp IN typ.xAttr) THEN os.CatStr(vals) END;
 575         IF ~(Sy.spshl IN typ.xAttr) THEN os.CatStr(clss) END;
 576         os.CatStr(typ.scopeNm);
 577     | typ : Ty.Procedure DO (* and also Event! *)
 578         os.CatStr(clss);
 579         os.CatStr(typ.tName);
 580     | typ : Ty.Pointer DO
 581         IF Mu.isValRecord(typ.boundTp) THEN
 582          (*
 583           *  This is a pointer to a value class, which has a
 584           *  runtime representation as a boxed-class reference.
 585           *)
 586           os.CatStr(clss);
 587           os.CatStr(typ.xName);
 588         ELSE
 589           os.TypeTag(typ.boundTp);
 590         END;
 591     | typ : Ty.Opaque DO
 592         os.CatStr(clss);
 593         os.CatStr(typ.xName);
 594     | typ : Ty.Enum DO
 595         os.CatStr(vals);
 596         os.CatStr(clss);
 597         os.CatStr(typ.xName);
 598     END;
 599   END TypeTag;
 600
 601 (* ============================================================ *)
 602
 603   PROCEDURE (os : IlasmFile)Translate(IN str : ARRAY OF CHAR),NEW;
 604     VAR ix : INTEGER;
 605         ch : CHAR;
 606   BEGIN
 607     ix := 0; ch := str[0];
 608     WHILE ch # 0X DO
 609       IF ch = '$' THEN
 610         INC(ix); ch := str[ix];
 611         IF    ch = "s" THEN os.TypeName(Cs.ntvStr);
 612         ELSIF ch = "o" THEN os.TypeName(Cs.ntvObj);
 613         ELSIF ch = "S" THEN os.TypeTag(Cs.ntvStr);
 614         ELSIF ch = "O" THEN os.TypeTag(Cs.ntvObj);
 615         END;
 616       ELSE
 617         os.CatChar(ch);
 618       END;
 619       INC(ix); ch := str[ix];
 620     END;
 621   END Translate;
 622
 623   PROCEDURE (os : IlasmFile)TTranslate(IN str : ARRAY OF CHAR),NEW;
 624   BEGIN
 625     os.CatChar(ASCII.HT);
 626     os.Translate(str);
 627   END TTranslate;
 628
 629 (* ============================================================ *)
 630
 631   PROCEDURE (os : IlasmFile)TtypeTag(typ : Sy.Type),NEW;
 632   BEGIN
 633     os.CatChar(ASCII.HT);
 634     os.TypeTag(typ);
 635   END TtypeTag;
 636
 637 (* ------------------------------------ *)
 638
 639   PROCEDURE (os : IlasmFile)TtypeNam(typ : Sy.Type),NEW;
 640   BEGIN
 641     os.Tstring(Mu.typeName(typ, os));
 642   END TtypeNam;
 643
 644 (* ------------------------------------ *)
 645
 646   PROCEDURE (os : IlasmFile)TypeName(typ : Sy.Type),NEW;
 647   BEGIN
 648     os.CatStr(Mu.typeName(typ, os));
 649   END TypeName;
 650
 651 (* ============================================================ *)
 652
 653   PROCEDURE (os : IlasmFile)RetType(typ : Ty.Procedure; pId : Id.Procs),NEW;
 654   BEGIN
 655     IF typ.retType = NIL THEN
 656       os.CatStr(vStr);
 657     ELSIF (pId # NIL) & (pId IS Id.MthId) &
 658         (Id.covar IN pId(Id.MthId).mthAtt) THEN
 659      (*
 660       *  This is a method with a covariant return type. We must
 661       *  erase the declared type, substituting the non-covariant
 662       *  upper-bound. Calls will cast the result to the real type.
 663       *)
 664       os.TypeTag(pId.retTypBound());
 665     ELSE
 666       os.TypeTag(typ.retType);
 667     END;
 668   END RetType;
 669
 670 (* ============================================================ *)
 671 (*                    Exported Methods                          *)
 672 (* ============================================================ *)
 673
 674   PROCEDURE (os : IlasmFile)Blank*();
 675   BEGIN
 676     os.CatEOL();
 677   END Blank;
 678
 679 (* ============================================================ *)
 680
 681   PROCEDURE (os : IlasmFile)Separator(c : CHAR; i : INTEGER),NEW;
 682   BEGIN
 683     os.CatChar(c);
 684     os.CatEOL();
 685     WHILE i > 0 DO os.CatChar(ASCII.HT); DEC(i) END;
 686   END Separator;
 687
 688 (* ============================================================ *)
 689
 690   PROCEDURE (os : IlasmFile)OpenBrace*(i : INTEGER);
 691   BEGIN
 692     WHILE i > 0 DO os.CatChar(" "); DEC(i) END;
 693     os.CatChar("{");
 694     os.CatEOL();
 695   END OpenBrace;
 696
 697 (* ============================================================ *)
 698
 699   PROCEDURE (os : IlasmFile)CloseBrace*(i : INTEGER);
 700   BEGIN
 701     WHILE i > 0 DO os.CatChar(" "); DEC(i) END;
 702     os.CatChar("}");
 703     os.CatEOL();
 704   END CloseBrace;
 705
 706 (* ============================================================ *)
 707
 708   PROCEDURE (os : IlasmFile)Directive*(dir : INTEGER),NEW;
 709   BEGIN
 710     os.CatStr(Asm.dirStr[dir]);
 711     os.CatEOL();
 712   END Directive;
 713
 714 (* -------------------------------------------- *)
 715
 716   PROCEDURE (os : IlasmFile)DirectiveS*(dir : INTEGER;
 717                              IN str : ARRAY OF CHAR),NEW;
 718   BEGIN
 719     os.CatStr(Asm.dirStr[dir]);
 720     os.Bstring(str);
 721     os.CatEOL();
 722   END DirectiveS;
 723
 724 (* -------------------------------------------- *)
 725
 726   PROCEDURE (os : IlasmFile)DirectiveIS*(dir : INTEGER;
 727                                   att : SET;
 728                                IN str : ARRAY OF CHAR),NEW;
 729   BEGIN
 730     os.CatStr(Asm.dirStr[dir]);
 731     os.Access(att);
 732     os.CatStr(str);
 733     os.CatEOL();
 734   END DirectiveIS;
 735
 736 (* -------------------------------------------- *)
 737
 738   PROCEDURE (os : IlasmFile)DirectiveISS*(dir : INTEGER;
 739                                     att : SET;
 740                                  IN s1  : ARRAY OF CHAR;
 741                                  IN s2  : ARRAY OF CHAR),NEW;
 742   BEGIN
 743     os.CatStr(Asm.dirStr[dir]);
 744     os.Access(att);
 745     os.CatStr(s1);
 746     os.CatStr(s2);
 747     IF dir = Asm.dot_method THEN os.Bstring(managedStr) END;
 748     os.CatEOL();
 749   END DirectiveISS;
 750
 751 (* ============================================================ *)
 752
 753   PROCEDURE (os : IlasmFile)Finish*();
 754   BEGIN
 755     GPBinFiles.CloseFile(os.file);
 756   END Finish;
 757
 758 (* ------------------------------------------------- *)
 759
 760   PROCEDURE (os : IlasmFile)MkBodyClass*(mod : Id.BlkId);
 761   BEGIN
 762     os.clsN := mod.clsNm;
 763     os.DirectiveIS(Asm.dot_class, Asm.modAttr, os.clsN);
 764   END MkBodyClass;
 765
 766 (* ------------------------------------------------- *)
 767
 768   PROCEDURE (os : IlasmFile)ClassHead*(attSet : SET;
 769                                        thisRc : Ty.Record;
 770                                        superT : Ty.Record);
 771   BEGIN
 772     os.clsN := thisRc.xName;
 773     os.DirectiveIS(Asm.dot_class, attSet, os.clsN);
 774     IF superT # NIL THEN
 775       IF superT.xName = NIL THEN Mu.MkRecName(superT, os) END;
 776       os.DirectiveS(Asm.dot_super, superT.scopeNm);
 777     END;
 778   END ClassHead;
 779
 780 (* ------------------------------------------------- *)
 781
 782   PROCEDURE (os : IlasmFile)StartNamespace*(name : Lv.CharOpen);
 783   BEGIN
 784     os.DirectiveS(Asm.dot_namespace, name);
 785   END StartNamespace;
 786
 787 (* ------------------------------------------------- *)
 788
 789   PROCEDURE (os : IlasmFile)AsmDef*(IN pkNm : ARRAY OF CHAR);
 790   BEGIN
 791     os.DirectiveIS(Asm.dot_assembly, {}, "'" + pkNm + "' {}");
 792   END AsmDef;
 793
 794 (* ------------------------------------------------- *)
 795
 796   PROCEDURE (os : IlasmFile)RefRTS*();
 797   BEGIN
 798     os.DirectiveIS(Asm.dot_assembly, Asm.att_extern, "RTS {}");
 799     IF Cs.netRel = Cs.netV2_0 THEN
 800       os.DirectiveIS(Asm.dot_assembly, Asm.att_extern, "mscorlib {}");
 801     END;
 802   END RefRTS;
 803
 804 (* ============================================================ *)
 805
 806   PROCEDURE (os : IlasmFile)SignatureDecl(prcT : Ty.Procedure),NEW;
 807     VAR indx : INTEGER;
 808         parD : Id.ParId;
 809         long : BOOLEAN;
 810         nest : BOOLEAN;
 811         frst : BOOLEAN;
 812   BEGIN
 813     frst := TRUE;
 814     indx := prcT.formals.tide;
 815     nest := (prcT.idnt IS Id.Procs) & (prcT.idnt(Id.Procs).lxDepth > 0);
 816     long := (indx > 1) OR (nest & (indx > 0));
 817
 818     os.CatChar("(");
 819     IF long THEN os.Separator(' ', 2) END;
 820     IF nest THEN os.CatStr(xhrMk); frst := FALSE END;
 821     FOR indx := 0 TO prcT.formals.tide-1 DO
 822       parD := prcT.formals.a[indx];
 823       IF long THEN
 824         IF ~frst THEN os.Separator(',', 2) END;
 825         IF parD.boxOrd = Sy.out THEN os.CatStr(ouMk) END;
 826         os.TypeTag(parD.type);
 827         IF (parD.boxOrd # Sy.val) OR
 828            (Id.cpVarP IN parD.locAtt) THEN os.CatStr(rfMk) END;
 829         os.Tidnt(parD);
 830       ELSE
 831         IF ~frst THEN os.CatStr(cmma) END;
 832         IF parD.boxOrd = Sy.out THEN os.CatStr(ouMk) END;
 833         os.TypeTag(parD.type);
 834         IF (parD.boxOrd # Sy.val) OR
 835            (Id.cpVarP IN parD.locAtt) THEN os.CatStr(rfMk) END;
 836         os.Bidnt(parD);
 837       END;
 838       frst := FALSE;
 839     END;
 840     os.CatChar(")");
 841   END SignatureDecl;
 842
 843 (* -------------------------------------------- *)
 844
 845   PROCEDURE (os : IlasmFile)MethodDecl*(attr : SET; proc : Id.Procs);
 846     VAR prcT : Ty.Procedure;
 847   BEGIN
 848     prcT := proc.type(Ty.Procedure);
 849     os.CatStr(Asm.dirStr[Asm.dot_method]);
 850     os.Access(attr);
 851     os.RetType(prcT, proc);
 852     os.CatChar(" ");
 853     os.CatChar("'");
 854     os.CatStr(proc.prcNm);
 855     os.CatChar("'");
 856     os.SignatureDecl(prcT);
 857     os.Bstring(managedStr);
 858     os.CatEOL();
 859     IF Asm.att_abstract * attr # {} THEN
 860       os.Tstring(brsz); os.CatEOL();
 861     END;
 862   END MethodDecl;
 863
 864 (* ------------------------------------------------------------ *)
 865
 866   PROCEDURE (os : IlasmFile)CheckNestedClass*(typ : Ty.Record;
 867                                               scp : Sy.Scope;
 868                                               str : Lv.CharOpen);
 869     VAR i, len: INTEGER;
 870   BEGIN
 871    (*
 872     *  scan str with all occurences of
 873     *  '$' replaced by '/', except at index 0
 874     *)
 875     len := LEN(str);
 876     FOR i := 1 TO len-1 DO
 877       IF str[i] = '$' THEN str[i] := '/' END;
 878     END; (* FOR *)
 879   END CheckNestedClass;
 880
 881 (* ------------------------------------------------------------ *)
 882
 883   PROCEDURE (os : IlasmFile)ExternList*();
 884     VAR idx : INTEGER;
 885         blk : Id.BlkId;
 886    (* ----------------------------------------- *)
 887     PROCEDURE Assembly(fl : IlasmFile; bk : Id.BlkId);
 888       VAR ix : INTEGER;
 889           ch : CHAR;
 890     BEGIN
 891       IF Sy.isFn IN bk.xAttr THEN
 892         IF bk.scopeNm[0] # '[' THEN
 893                           RTS.Throw("bad extern name "+bk.scopeNm^) END;
 894         ix := 1;
 895         ch := bk.scopeNm[ix];
 896         WHILE (ch # 0X) & (ch # ']') DO
 897           fl.CatChar(ch);
 898           INC(ix);
 899           ch := bk.scopeNm[ix];
 900         END;
 901       ELSE
 902         fl.CatStr(bk.xName);
 903       END;
 904     END Assembly;
 905    (* ----------------------------------------- *)
 906     PROCEDURE WriteHex(fl : IlasmFile; int : INTEGER);
 907       VAR ord : INTEGER;
 908     BEGIN
 909       IF int <= 9 THEN ord := ORD('0') + int ELSE ord := (ORD('A')-10)+int END;
 910       fl.CatChar(CHR(ord));
 911     END WriteHex;
 912    (* ----------------------------------------- *)
 913     PROCEDURE WriteHexByte(fl : IlasmFile; int : INTEGER);
 914     BEGIN
 915       WriteHex(fl, int DIV 16);
 916       WriteHex(fl, int MOD 16);
 917       fl.CatChar(' ');
 918     END WriteHexByte;
 919    (* ----------------------------------------- *)
 920     PROCEDURE WriteBytes(fl : IlasmFile; int : INTEGER);
 921     BEGIN
 922       WriteHexByte(fl, int DIV 1000000H MOD 100H);
 923       WriteHexByte(fl, int DIV 10000H MOD 100H);
 924       WriteHexByte(fl, int DIV 100H MOD 100H);
 925       WriteHexByte(fl, int      MOD 100H);
 926     END WriteBytes;
 927    (* ----------------------------------------- *)
 928     PROCEDURE WriteVersionName(os : IlasmFile; IN nam : ARRAY OF INTEGER);
 929     BEGIN
 930       os.CatStr(" {"); os.CatEOL();
 931
 932       IF (nam[4] # 0) OR (nam[5] # 0) THEN
 933         os.CatStr("    .publickeytoken = (");
 934 (*
 935  *      IF Cs.netRel = Cs.beta2 THEN
 936  *        os.CatStr("    .publickeytoken = (");
 937  *      ELSE
 938  *        os.CatStr("    .originator = (");
 939  *      END;
 940  *)
 941         WriteBytes(os, nam[4]);
 942         WriteBytes(os, nam[5]);
 943         os.CatChar(")");
 944         os.CatEOL();
 945       END;
 946
 947       os.CatStr("    .ver ");
 948       os.CatInt(nam[0]);
 949       os.CatChar(":");
 950       os.CatInt(nam[1]);
 951       os.CatChar(":");
 952       os.CatInt(nam[2]);
 953       os.CatChar(":");
 954       os.CatInt(nam[3]);
 955       os.CatEOL();
 956       os.CatChar("}");
 957     END WriteVersionName;
 958    (* ----------------------------------------- *)
 959   BEGIN
 960    (*
 961     *   It is empirically established that all the
 962     *   .assembly extern declarations must come at
 963     *   the beginning of the ILASM file, at once.
 964     *)
 965     FOR idx := 0 TO Cs.impSeq.tide-1 DO
 966       blk := Cs.impSeq.a[idx](Id.BlkId);
 967       IF ~(Sy.rtsMd IN blk.xAttr) & (Sy.need IN blk.xAttr) THEN
 968         Mu.MkBlkName(blk);
 969         os.CatStr(Asm.dirStr[Asm.dot_assembly]);
 970         os.Access(Asm.att_extern);
 971         Assembly(os, blk);
 972         IF blk.verNm = NIL THEN
 973           os.CatStr(" {}");
 974         ELSE
 975           WriteVersionName(os, blk.verNm);
 976         END;
 977         os.CatEOL();
 978       END;
 979     END;
 980   END ExternList;
 981
 982 (* -------------------------------------------- *)
 983
 984   PROCEDURE (os : IlasmFile)Comment*(IN s : ARRAY OF CHAR);
 985   BEGIN
 986     os.CatStr("// ");
 987     os.CatStr(s);
 988     os.CatEOL();
 989   END Comment;
 990
 991 (* -------------------------------------------- *)
 992
 993   PROCEDURE (os : IlasmFile)CommentT*(IN s : ARRAY OF CHAR);
 994   BEGIN
 995     os.CatStr("//        ");
 996     os.CatStr(s);
 997     os.CatEOL();
 998   END CommentT;
 999
1000 (* ============================================================ *)
1001
1002   PROCEDURE (os : IlasmFile)DefLab*(l : Mu.Label);
1003   BEGIN
1004     os.CatChar("l");
1005     os.CatChar("b");
1006     os.CatInt(l(ILabel).labl);
1007     os.CatChar(":");
1008     os.CatEOL();
1009   END DefLab;
1010
1011 (* -------------------------------------------- *)
1012
1013   PROCEDURE (os : IlasmFile)DefLabC*(l : Mu.Label; IN c : ARRAY OF CHAR);
1014   BEGIN
1015     os.CatChar("l");
1016     os.CatChar("b");
1017     os.CatInt(l(ILabel).labl);
1018     os.CatChar(":");
1019     os.CatChar(ASCII.HT);
1020     os.Comment(c);
1021   END DefLabC;
1022
1023 (* ============================================================ *)
1024
1025   PROCEDURE (os : IlasmFile)Code*(code : INTEGER);
1026   BEGIN
1027     os.Prefix(code);
1028     os.Suffix(code);
1029   END Code;
1030
1031 (* -------------------------------------------- *)
1032
1033   PROCEDURE (os : IlasmFile)CodeI*(code,int : INTEGER);
1034   BEGIN
1035     os.Prefix(code);
1036     os.Tint(int);
1037     os.Suffix(code);
1038   END CodeI;
1039
1040 (* -------------------------------------------- *)
1041
1042   PROCEDURE (os : IlasmFile)CodeT*(code : INTEGER; type : Sy.Type);
1043   BEGIN
1044     os.Prefix(code);
1045     os.TtypeTag(type);
1046     os.Suffix(code);
1047   END CodeT;
1048
1049 (* -------------------------------------------- *)
1050
1051   PROCEDURE (os : IlasmFile)CodeTn*(code : INTEGER; type : Sy.Type);
1052   BEGIN
1053     os.Prefix(code);
1054     os.TtypeNam(type);
1055     os.Suffix(code);
1056   END CodeTn;
1057
1058 (* -------------------------------------------- *)
1059
1060   PROCEDURE (os : IlasmFile)CodeL*(code : INTEGER; long : LONGINT);
1061   BEGIN
1062     os.Prefix(code);
1063     os.Tlong(long);
1064     os.Suffix(code);
1065   END CodeL;
1066
1067 (* -------------------------------------------- *)
1068
1069   PROCEDURE (os : IlasmFile)CodeR*(code : INTEGER; real : REAL);
1070     VAR nam : ARRAY 64 OF CHAR;
1071   BEGIN
1072     os.Prefix(code);
1073     RTS.RealToStrInvar(real, nam);
1074     os.Tstring(nam$);
1075     os.Suffix(code);
1076   END CodeR;
1077
1078 (* -------------------------------------------- *)
1079
1080   PROCEDURE (os : IlasmFile)CodeLb*(code : INTEGER; i2 : Mu.Label);
1081   BEGIN
1082     os.Prefix(code);
1083     os.RefLab(i2);
1084     os.Suffix(code);
1085   END CodeLb;
1086
1087 (* -------------------------------------------- *)
1088
1089   PROCEDURE (os : IlasmFile)CodeStr(code : INTEGER;
1090                                  IN str  : ARRAY OF CHAR),NEW;
1091   BEGIN
1092     os.Prefix(code);
1093     os.TTranslate(str);
1094     os.Suffix(code);
1095   END CodeStr;
1096
1097   PROCEDURE (os : IlasmFile)CodeS*(code : INTEGER; str : INTEGER);
1098   BEGIN
1099     os.CodeStr(code, rts[str]);
1100   END CodeS;
1101
1102 (* -------------------------------------------- *)
1103
1104   PROCEDURE (os : IlasmFile)StaticCall*(s : INTEGER; d : INTEGER);
1105   BEGIN
1106     os.Prefix(Asm.opc_call);
1107     os.TTranslate(rts[s]);
1108     os.IAdjust(d);
1109   END StaticCall;
1110
1111 (* -------------------------------------------- *)
1112
1113   PROCEDURE (os : IlasmFile)Try*();
1114     VAR retT : Sy.Type;
1115   BEGIN
1116     retT := os.proc.prId.type.returnType();
1117     os.Directive(Asm.dot_try);
1118     os.OpenBrace(4);
1119     os.proc.exLb := os.newLabel();
1120     IF retT # NIL THEN os.proc.rtLc := os.proc.newLocal(retT) END;
1121   END Try;
1122
1123 (* -------------------------------------------- *)
1124
1125   PROCEDURE (os : IlasmFile)Catch*(proc : Id.Procs);
1126   BEGIN
1127     os.CloseBrace(4);
1128     os.CatStr(catchStr);
1129     os.CatEOL();
1130     os.OpenBrace(4);
1131     os.Adjust(1);       (* allow for incoming exception reference *)
1132     os.StoreLocal(proc.except.varOrd);
1133   END Catch;
1134
1135 (* -------------------------------------------- *)
1136
1137   PROCEDURE (os : IlasmFile)CloseCatch*();
1138   BEGIN
1139     os.CloseBrace(4);
1140   END CloseCatch;
1141
1142 (* -------------------------------------------- *)
1143
1144   PROCEDURE (os : IlasmFile)CopyCall*(typ : Ty.Record);
1145   BEGIN
1146     os.Prefix(Asm.opc_call);
1147     os.Tstring(initPrefix);
1148     os.Bstring(typ.scopeNm);
1149     os.CatStr("::__copy__(");
1150     os.TypeTag(typ);
1151     os.CatChar(")");
1152     os.IAdjust(-2);
1153   END CopyCall;
1154
1155 (* -------------------------------------------- *)
1156
1157   PROCEDURE (os : IlasmFile)PushStr*(IN str : ARRAY OF CHAR);
1158   (* Use target quoting conventions for the literal string *)
1159   BEGIN
1160     os.Prefix(Asm.opc_ldstr);
1161     os.CatChar(ASCII.HT);
1162     os.QuoteStr(str);
1163     os.IAdjust(1);
1164   END PushStr;
1165
1166 (* ============================================================ *)
1167
1168   PROCEDURE (os : IlasmFile)CallIT*(code : INTEGER;
1169                               proc : Id.Procs;
1170                               type : Ty.Procedure);
1171   BEGIN
1172     os.Prefix(code);
1173     os.CatChar(ASCII.HT);
1174    (*
1175     *   For static calls to procedures we want
1176     *            call  <ret-type> <idnt>(<signature>)
1177     *   for static calls to final or super methods, we need
1178     *            call  instance <ret-type> <idnt>(<signature>)
1179     *   for calls to type-bound methods that are not final
1180     *            callvirt  instance <ret-type> <idnt>(<signature>)
1181     *)
1182     IF proc IS Id.MthId THEN os.CatStr("instance ") END;
1183     os.RetType(type, proc);
1184     os.PIdnt(proc);
1185     os.CatStr(type.xName);
1186     os.IAdjust(type.retN - type.argN);
1187   END CallIT;
1188
1189 (* ============================================================ *)
1190
1191   PROCEDURE (os : IlasmFile)CallCT*(proc : Id.Procs;
1192                                     type : Ty.Procedure);
1193   BEGIN
1194     os.Prefix(Asm.opc_newobj);
1195     os.Tstring(initPrefix);
1196     os.PIdnt(proc);
1197     os.CatStr(type.xName);
1198     os.IAdjust(type.retN - type.argN);
1199   END CallCT;
1200
1201 (* ============================================================ *)
1202
1203   PROCEDURE (os : IlasmFile)CallDelegate*(typ : Ty.Procedure);
1204   BEGIN
1205     os.Prefix(Asm.opc_callvirt);
1206     os.Tstring("instance ");
1207     os.RetType(typ, NIL);
1208     os.Bstring(typ.tName);
1209     os.CatStr("::Invoke");
1210     os.CatStr(typ.xName);
1211     os.IAdjust(typ.retN - typ.argN);
1212   END CallDelegate;
1213
1214 (* ============================================================ *)
1215
1216   PROCEDURE (os : IlasmFile)PutGetS*(code : INTEGER;
1217                                      blk  : Id.BlkId;
1218                                      fld  : Id.VarId);
1219     VAR size : INTEGER;
1220   (* Emit putstatic and getstatic for static field *)
1221   BEGIN
1222     os.Prefix(code);
1223     os.TtypeTag(fld.type);
1224     os.CatChar(ASCII.HT);
1225     IF blk.xName = NIL THEN Mu.MkBlkName(blk) END;
1226     IF fld.varNm = NIL THEN Mu.MkVarName(fld, os) END;
1227     os.CatStr(blk.scopeNm);
1228     os.CatStr(fld.clsNm);
1229     os.CatStr(cln2);
1230     os.SQuote(fld.varNm);
1231     os.Suffix(code);
1232   END PutGetS;
1233
1234 (* -------------------------------------------- *)
1235
1236   PROCEDURE (os : IlasmFile)PutGetFld(code : INTEGER;
1237                                       fTyp : Sy.Type;
1238                                       rTyp : Sy.Type;
1239                                       name : Lv.CharOpen),NEW;
1240   BEGIN
1241     os.Prefix(code);
1242     os.TtypeTag(fTyp);
1243     os.TtypeNam(rTyp);
1244     os.CatStr(cln2);
1245     os.SQuote(name);
1246     os.Suffix(code);
1247   END PutGetFld;
1248
1249 (* -------------------------------------------- *)
1250
1251   PROCEDURE (os : IlasmFile)GetValObj*(code : INTEGER;
1252                                        ptrT : Ty.Pointer);
1253   BEGIN
1254     os.PutGetFld(code, ptrT.boundTp, ptrT, vFld);
1255   END GetValObj;
1256
1257 (* -------------------------------------------- *)
1258
1259   PROCEDURE (os : IlasmFile)PutGetXhr*(code : INTEGER;
1260                                        proc : Id.Procs;
1261                                        locD : Id.LocId);
1262     VAR name : Lv.CharOpen;
1263   BEGIN
1264     name := Sy.getName.ChPtr(locD);
1265     os.PutGetFld(code, locD.type, proc.xhrType, name);
1266   END PutGetXhr;
1267
1268 (* -------------------------------------------- *)
1269
1270   PROCEDURE (os : IlasmFile)PutGetF*(code : INTEGER;
1271                                      fld  : Id.FldId);
1272     VAR recT : Ty.Record;
1273   (* Emit putfield and getfield for record field *)
1274   BEGIN
1275     recT := fld.recTyp(Ty.Record);
1276     os.Prefix(code);
1277     os.TtypeTag(fld.type);
1278     os.CatChar(ASCII.HT);
1279     IF fld.fldNm = NIL THEN fld.fldNm := Sy.getName.ChPtr(fld) END;
1280    (*
1281     *  Note the difference here. JVM needs the
1282     *  static type of the variable, VOS wants
1283     *  the name of the record with the field.
1284     *)
1285     os.CatStr(recT.scopeNm);
1286     os.CatStr(cln2);
1287     os.SQuote(fld.fldNm);
1288     os.Suffix(code);
1289   END PutGetF;
1290
1291 (* ============================================================ *)
1292 (* ============================================================ *)
1293
1294   PROCEDURE (os : IlasmFile)MkNewRecord*(typ : Ty.Record);
1295     VAR name : Lv.CharOpen;
1296   BEGIN
1297    (*
1298     *  We need "newobj instance void <name>::.ctor()"
1299     *)
1300     IF typ.xName = NIL THEN Mu.MkRecName(typ, os) END;
1301     IF Sy.clsTp IN typ.xAttr THEN
1302       name := typ.scopeNm;
1303     ELSE
1304       name := Mu.boxedName(typ, os);
1305     END;
1306     os.Prefix(Asm.opc_newobj);
1307     os.Tstring(initPrefix);
1308     os.Bstring(name);
1309     os.CatStr(cln2);
1310     os.CatStr(initSuffix);
1311     os.IAdjust(1);
1312   END MkNewRecord;
1313
1314 (* ============================================================ *)
1315 (* ============================================================ *)
1316
1317   PROCEDURE (os : IlasmFile)MkNewProcVal*(p : Sy.Idnt; t : Sy.Type);
1318     VAR name : Lv.CharOpen;
1319         proc : Id.Procs;
1320         type : Ty.Procedure;
1321         code : INTEGER;
1322   BEGIN
1323     proc := p(Id.Procs);
1324     type := t(Ty.Procedure);
1325    (*
1326     *  We need "ldftn [instance] <retType> <procName>
1327     *)
1328     IF type.xName = NIL THEN Mu.MkPTypeName(type, os) END;
1329     WITH p : Id.MthId DO
1330       IF p.bndType.isInterfaceType() THEN
1331         code := Asm.opc_ldvirtftn;
1332       ELSIF p.mthAtt * Id.mask = Id.final THEN
1333         code := Asm.opc_ldftn;
1334       ELSE
1335         code := Asm.opc_ldvirtftn;
1336       END;
1337     ELSE
1338       code := Asm.opc_ldftn;
1339     END;
1340    (*
1341     *   If this will be a virtual method call, then we
1342     *   must duplicate the receiver, since the call of
1343     *   ldvirtftn uses up one copy.
1344     *)
1345     IF code = Asm.opc_ldvirtftn THEN os.Code(Asm.opc_dup) END;
1346     os.Prefix(code);
1347     os.CatChar(ASCII.HT);
1348     IF p IS Id.MthId THEN os.CatStr("instance ") END;
1349     os.RetType(type, NIL);
1350     os.PIdnt(proc);
1351     os.CatStr(type.xName);
1352     os.IAdjust(1);
1353    (*
1354     *  We need "newobj instance void <name>::.ctor(...)"
1355     *)
1356     os.Prefix(Asm.opc_newobj);
1357     os.Tstring(initPrefix);
1358     os.Bstring(type.tName);
1359     os.CatStr(cln2);
1360     os.Translate(pVarSuffix);
1361     os.IAdjust(-2);
1362   END MkNewProcVal;
1363
1364 (* ============================================================ *)
1365
1366   PROCEDURE (os : IlasmFile)InitHead*(typ : Ty.Record;
1367                                       prc : Id.PrcId);
1368     VAR pTp : Ty.Procedure;
1369   BEGIN
1370    (*
1371     *  Get the procedure type, if any ...
1372     *)
1373     IF prc # NIL THEN
1374       pTp := prc.type(Ty.Procedure);
1375     ELSE
1376       pTp := NIL;
1377     END;
1378
1379     os.CatStr(Asm.dirStr[Asm.dot_method]);
1380     os.Bstring(specialStr);
1381     os.Bstring(initPrefix);
1382     IF prc = NIL THEN
1383       os.Bstring(initSuffix);
1384     ELSE
1385       os.Bstring(initString);
1386       os.SignatureDecl(pTp);
1387     END;
1388     os.CatStr(managedStr);
1389     os.CatEOL();
1390     os.CatStr("    {");
1391     os.CatEOL();
1392    (*
1393     *   Now we begin to initialize the supertype;
1394     *)
1395     os.CommentT("Call supertype constructor");
1396     os.Code(Asm.opc_ldarg_0);
1397   END InitHead;
1398
1399 (* ============================================================ *)
1400
1401   PROCEDURE (os : IlasmFile)CallSuper*(typ : Ty.Record;
1402                                        prc : Id.PrcId);
1403     VAR pTp : Ty.Procedure;
1404         pNm : INTEGER;
1405   BEGIN
1406    (*
1407     *  Get the procedure type, if any ...
1408     *)
1409     IF prc # NIL THEN
1410       pTp := prc.type(Ty.Procedure);
1411       pNm := pTp.formals.tide;
1412     ELSE
1413       pTp := NIL;
1414       pNm := 0;
1415     END;
1416     os.Prefix(Asm.opc_call);
1417     IF  (typ # NIL) &
1418         (typ.baseTp # NIL) &
1419         (typ.baseTp # Bi.anyRec) THEN
1420       os.Tstring(initPrefix);
1421       os.Bstring(typ.baseTp(Ty.Record).scopeNm);
1422       os.CatStr(cln2);
1423       IF pTp # NIL THEN
1424         os.Bstring(initString);
1425         os.CatStr(pTp.xName);
1426       ELSE
1427         os.CatStr(initSuffix);
1428       END;
1429     ELSE
1430       os.TTranslate(objectInit);
1431     END;
1432     os.IAdjust(-(pNm+1));
1433   END CallSuper;
1434
1435 (* ============================================================ *)
1436
1437   PROCEDURE (os : IlasmFile)InitTail*(typ : Ty.Record);
1438   BEGIN
1439     os.Locals();
1440     os.CatStr("    } // end of method '");
1441     IF typ # NIL THEN
1442       os.CatStr(typ.xName);
1443     END;
1444     os.CatStr("::.ctor'");
1445     os.CatEOL();
1446   END InitTail;
1447
1448 (* ============================================================ *)
1449
1450   PROCEDURE (os : IlasmFile)CopyHead*(typ : Ty.Record);
1451   BEGIN
1452     os.Comment("standard record copy method");
1453     os.CatStr(Asm.dirStr[Asm.dot_method]);
1454     os.Tstring(copyHead);
1455 (* FIX FOR BOXED CLASS COPY *)
1456     IF ~(Sy.clsTp IN typ.xAttr) THEN os.CatStr(vals) END;
1457     os.CatStr(clss);
1458     os.CatStr(typ.scopeNm);
1459     IF ~(Sy.clsTp IN typ.xAttr) THEN os.CatStr(rfMk) END;
1460     os.CatStr(") ");
1461     os.CatStr(managedStr);
1462     os.CatEOL();
1463     os.CatStr("    {");
1464     os.CatEOL();
1465   END CopyHead;
1466
1467 (* ============================================================ *)
1468
1469   PROCEDURE (os : IlasmFile)CopyTail*();
1470   BEGIN
1471     os.Locals();
1472     os.CatStr("    } // end of __copy__ method '");
1473     os.CatEOL();
1474   END CopyTail;
1475
1476 (* ============================================================ *)
1477
1478   PROCEDURE (os : IlasmFile)MarkInterfaces*(IN seq : Sy.TypeSeq);
1479     VAR index  : INTEGER;
1480         tideX  : INTEGER;
1481         implT  : Ty.Record;
1482   BEGIN
1483     tideX := seq.tide-1;
1484     ASSERT(tideX >= 0);
1485     os.CatStr(Asm.dirStr[Asm.dot_implements]);
1486     FOR index := 0 TO tideX DO
1487       implT := seq.a[index].boundRecTp()(Ty.Record);
1488       IF implT.xName = NIL THEN Mu.MkRecName(implT, os) END;
1489       os.Bstring(implT.scopeNm);
1490       IF index < tideX THEN os.CatChar(",") END;
1491       os.CatEOL();
1492       IF index < tideX THEN os.CatStr("                 ") END;
1493     END;
1494   END MarkInterfaces;
1495
1496 (* ============================================================ *)
1497
1498   PROCEDURE (os : IlasmFile)MainHead*(xAtt : SET);
1499   BEGIN
1500     os.Comment("Main entry point");
1501     os.CatStr(Asm.dirStr[Asm.dot_method]);
1502     IF Sy.wMain IN xAtt THEN
1503       os.TTranslate(winString);
1504     ELSE
1505       os.TTranslate(mainString);
1506     END;
1507     os.CatEOL();
1508     os.OpenBrace(4);
1509     os.Directive(Asm.dot_entrypoint);
1510     IF Cs.debug & ~(Sy.sta IN xAtt) THEN
1511       os.LineSpan(Scn.mkSpanT(Cs.thisMod.begTok));
1512     END;
1513    (*
1514     *  Save the command-line arguments to the RTS.
1515     *)
1516     os.Code(Asm.opc_ldarg_0);
1517     os.CodeStr(Asm.opc_stsfld, putArgStr);
1518   END MainHead;
1519
1520 (* ============================================================ *)
1521
1522   PROCEDURE (os : IlasmFile)SubSys*(xAtt : SET);
1523   BEGIN
1524     IF Sy.wMain IN xAtt THEN
1525       os.TTranslate(subSysStr);
1526       os.Comment("WinMain entry");
1527       os.CatEOL();
1528     ELSIF Sy.cMain IN xAtt THEN
1529       os.Comment("CPmain entry");
1530     END;
1531   END SubSys;
1532
1533 (* ============================================================ *)
1534
1535   PROCEDURE (os : IlasmFile)StartBoxClass*(rec : Ty.Record;
1536                                    att : SET;
1537                                    blk : Id.BlkId);
1538     VAR name : Lv.CharOpen;
1539         bNam : Lv.CharOpen;
1540   BEGIN
1541     os.CatEOL();
1542     name := Mu.cat2(boxedObj, os.clsN);
1543     os.DirectiveIS(Asm.dot_class, att, name);
1544     os.OpenBrace(2);
1545     os.CatStr(Asm.dirStr[Asm.dot_field]);
1546     os.Access(Asm.att_public);
1547     os.TtypeTag(rec);
1548     os.Bstring(vFld);
1549     os.CatEOL();
1550    (*
1551     *   Emit the no-arg constructor
1552     *)
1553     os.CatEOL();
1554     os.MkNewProcInfo(blk);
1555     os.InitHead(rec, NIL);
1556     os.CallSuper(rec, NIL);
1557     os.Code(Asm.opc_ret);
1558     os.InitTail(rec);
1559    (*
1560     *   Copies of value classes are always done inline.
1561     *)
1562   END StartBoxClass;
1563
1564 (* ============================================================ *)
1565
1566   PROCEDURE (os : IlasmFile)Tail(IN s : ARRAY OF CHAR),NEW;
1567   BEGIN
1568     os.Locals();
1569     os.CatStr(s);
1570     os.CatEOL();
1571   END Tail;
1572
1573 (* ------------------------------------------------------------ *)
1574
1575   PROCEDURE (os : IlasmFile)MainTail*();
1576   BEGIN os.Tail("    } // end of method .CPmain") END MainTail;
1577
1578 (* ------------------------------------------------------------ *)
1579
1580   PROCEDURE (os : IlasmFile)ClinitTail*();
1581   BEGIN os.Tail("    } // end of .cctor method") END ClinitTail;
1582
1583 (* ------------------------------------------------------------ *)
1584
1585   PROCEDURE (os : IlasmFile)MethodTail*(id : Id.Procs);
1586   BEGIN os.Tail("    } // end of method " + id.prcNm^) END MethodTail;
1587
1588 (* ============================================================ *)
1589
1590   PROCEDURE (os : IlasmFile)ClinitHead*();
1591   BEGIN
1592     os.CatStr(Asm.dirStr[Asm.dot_method]);
1593     os.Tstring(specialStr);
1594     os.CatStr(cctorStr);
1595     os.CatStr(managedStr);
1596     os.CatEOL();
1597     os.CatStr("    {");
1598     os.CatEOL();
1599   END ClinitHead;
1600
1601 (* ============================================================ *)
1602
1603   PROCEDURE (os : IlasmFile)EmitField*(id : Id.AbVar; att : SET);
1604     VAR nm : Lv.CharOpen;
1605   BEGIN
1606     WITH id : Id.FldId DO
1607          IF id.fldNm = NIL THEN Mu.MkFldName(id, os) END;
1608          nm := id.fldNm;
1609     | id : Id.VarId DO
1610          IF id.varNm = NIL THEN Mu.MkVarName(id, os) END;
1611          nm := id.varNm;
1612     END;
1613     os.CatStr(Asm.dirStr[Asm.dot_field]);
1614     os.Access(att);
1615     os.TtypeTag(id.type);
1616     os.TsQuote(nm);
1617     os.CatEOL();
1618   END EmitField;
1619
1620 (* ============================================================ *)
1621 (*           Start of Procedure Variable and Event Stuff        *)
1622 (* ============================================================ *)
1623
1624   PROCEDURE (os : IlasmFile)EmitEventMethods*(id : Id.AbVar);
1625     VAR eTp  : Ty.Event;
1626    (* ------------------------------------------------- *)
1627     PROCEDURE Head(os : IlasmFile; fn, tn : Lv.CharOpen; add : BOOLEAN);
1628     BEGIN
1629       os.CatEOL();
1630       os.CatChar(ASCII.HT);
1631       IF add THEN os.CatStr(evtAdd) ELSE os.CatStr(evtRem) END;
1632       os.CatStr(fn); os.CatStr("(class "); os.CatStr(tn);
1633       os.CatStr(") il managed synchronized {");
1634       os.CatEOL();
1635     END Head;
1636    (* ------------------------------------------------- *)
1637     PROCEDURE EmitEvtMth(os : IlasmFile; add : BOOLEAN; fld : Id.AbVar);
1638     BEGIN
1639       os.MkNewProcInfo(NIL);
1640       WITH fld : Id.FldId DO
1641           os.CatStr(".method public specialname instance void");
1642           Head(os, fld.fldNm, fld.type(Ty.Event).tName, add);
1643           os.Code(Asm.opc_ldarg_0);
1644           os.Code(Asm.opc_ldarg_0);
1645           os.PutGetF(Asm.opc_ldfld, fld);
1646           os.Code(Asm.opc_ldarg_1);
1647           os.CallCombine(fld.type, add);
1648           os.PutGetF(Asm.opc_stfld, fld);
1649       | fld : Id.VarId DO
1650           os.CatStr(".method public specialname static void");
1651           Head(os, fld.varNm, fld.type(Ty.Event).tName, add);
1652           os.PutGetS(Asm.opc_ldsfld, fld.dfScp(Id.BlkId), fld);
1653           os.Code(Asm.opc_ldarg_0);
1654           os.CallCombine(fld.type, add);
1655           os.PutGetS(Asm.opc_stsfld, fld.dfScp(Id.BlkId), fld);
1656       END;
1657       os.Code(Asm.opc_ret);
1658       os.CloseBrace(4);
1659       os.CatEOL();
1660     END EmitEvtMth;
1661    (* ------------------------------------------------- *)
1662     PROCEDURE Decl(os : IlasmFile; cv, cl, fn, tn : Lv.CharOpen);
1663     BEGIN
1664       os.CatStr(".event ");
1665       os.Tstring(tn);
1666       os.CatChar(' ');
1667       os.SQuote(fn);        (* field name *)
1668       os.CatEOL(); os.OpenBrace(4);
1669
1670       os.Tstring(".addon "); os.CatStr(cv); os.CatStr(cl); os.CatStr(cln2);
1671       os.CatStr(evtAdd); os.CatStr(fn); os.CatStr("(class ");
1672       os.CatStr(tn); os.CatChar(')');
1673       os.CatEOL();
1674
1675       os.Tstring(".removeon "); os.CatStr(cv); os.CatStr(cl); os.CatStr(cln2);
1676       os.CatStr(evtRem); os.CatStr(fn); os.CatStr("(class ");
1677       os.CatStr(tn); os.CatChar(')');
1678       os.CatEOL();
1679     END Decl;
1680    (* ------------------------------------------------- *)
1681   BEGIN
1682     eTp := id.type(Ty.Event);
1683     os.CatEOL();
1684    (*
1685     *  Emit the "add_*" method
1686     *)
1687     EmitEvtMth(os, TRUE, id);
1688    (*
1689     *  Emit the "remove_*" method
1690     *)
1691     EmitEvtMth(os, FALSE, id);
1692    (*
1693     *  Emit the .event declaration"
1694     *)
1695     WITH id : Id.FldId DO
1696         Decl(os, inVd, id.recTyp(Ty.Record).scopeNm, id.fldNm, eTp.tName);
1697     | id : Id.VarId DO
1698         Decl(os, vStr,
1699               Mu.cat2(id.dfScp(Id.BlkId).scopeNm, id.clsNm),
1700               id.varNm, eTp.tName);
1701     END;
1702     os.CloseBrace(4);
1703     os.CatEOL();
1704   END EmitEventMethods;
1705
1706 (* ============================================================ *)
1707
1708   PROCEDURE (os : IlasmFile)CallCombine(typ : Sy.Type;
1709                                         add : BOOLEAN),NEW;
1710   BEGIN
1711     os.CatStr("        call        class [mscorlib]System.Delegate ");
1712     os.CatEOL();
1713     os.CatStr("                       [mscorlib]System.Delegate::");
1714     IF add THEN os.CatStr("Combine(") ELSE os.CatStr("Remove(") END;
1715     os.CatEOL();
1716     os.CatStr(
1717 "                               class [mscorlib]System.Delegate,");
1718     os.CatEOL();
1719     os.CatStr(
1720 "                               class [mscorlib]System.Delegate)");
1721     os.CatEOL();
1722     os.CodeT(Asm.opc_castclass, typ);
1723   END CallCombine;
1724
1725 (* ============================================================ *)
1726 (* ============================================================ *)
1727
1728   PROCEDURE (os : IlasmFile)MkAndLinkDelegate*(dl  : Sy.Idnt;
1729                                                id  : Sy.Idnt;
1730                                                ty  : Sy.Type;
1731                                                add : BOOLEAN);
1732     VAR rcv : INTEGER;
1733    (* --------------------------------------------------------- *)
1734     PROCEDURE Head(os : IlasmFile;
1735                    id : Sy.Idnt;
1736                    cc : Lv.CharOpen);
1737     BEGIN
1738       Mu.MkIdName(id, os);
1739       os.Prefix(Asm.opc_call);
1740       os.Tstring(cc);
1741     END Head;
1742    (* --------------------------------------------------------- *)
1743     PROCEDURE Tail(os  : IlasmFile;
1744                    ty  : Sy.Type;
1745                  nm  : Lv.CharOpen;
1746                    add : BOOLEAN);
1747     BEGIN
1748       os.CatStr(cln2);
1749       IF add THEN os.CatStr(evtAdd) ELSE os.CatStr(evtRem) END;
1750       os.CatStr(nm);  os.CatChar("(");
1751       os.TypeTag(ty); os.CatChar(")");
1752       os.Suffix(Asm.opc_call);
1753     END Tail;
1754    (* --------------------------------------------------------- *)
1755   BEGIN
1756     WITH id : Id.FldId DO
1757        (*
1758         *      <push handle>                 // ... already done
1759         *      <push receiver (or nil)>      // ... already done
1760         *      <make new proc value>         // ... still to do
1761         *      call      instance void A.B::add_fld(class tyName)
1762         *)
1763         os.MkNewProcVal(dl, ty);
1764         Head(os, id, inVd);
1765         os.CatStr(id.recTyp(Ty.Record).scopeNm);
1766         Tail(os, ty, id.fldNm, add);
1767     | id : Id.VarId DO
1768        (*
1769         *      <push receiver (or nil)>      // ... already done
1770         *      <make new proc value>         // ... still to do
1771         *      call      void A.B::add_fld(class tyName)
1772         *)
1773         os.MkNewProcVal(dl, ty);
1774         Head(os, id, vStr);
1775         Mu.MkBlkName(id.dfScp(Id.BlkId));
1776         os.CatStr(id.dfScp.scopeNm);
1777         os.CatStr(id.clsNm);
1778         Tail(os, ty, id.varNm, add);
1779     | id : Id.LocId DO
1780        (*
1781         *      <save receiver>
1782         *      ldloc      'local'
1783         *      <restore receiver>
1784         *      <make new proc value>            // ... still to do
1785         *      call      class D D::Combine(class D, class D)
1786         *)
1787         rcv := os.proc.newLocal(Cs.ntvObj);
1788         os.StoreLocal(rcv);
1789         os.GetLocal(id);
1790         os.PushLocal(rcv);
1791         os.MkNewProcVal(dl, ty);
1792         os.CallCombine(ty, add);
1793         os.PutLocal(id);
1794     END;
1795   END MkAndLinkDelegate;
1796
1797 (* ============================================================ *)
1798 (* ============================================================ *)
1799
1800   PROCEDURE (os : IlasmFile)EmitPTypeBody*(tId : Id.TypId);
1801     VAR pTp : Ty.Procedure;
1802   BEGIN
1803     pTp := tId.type(Ty.Procedure);
1804     os.CatEOL();
1805     os.CatStr(".class public auto sealed "); os.CatStr(tId.type.name());
1806     os.CatEOL();
1807    (*
1808     *  From Beta-2, all delegates derive from MulticastDelegate
1809     *)
1810     os.Tstring("extends [mscorlib]System.MulticastDelegate {");
1811     os.CatEOL();
1812     os.CatStr(".method public specialname rtspecialname instance void");
1813     os.CatEOL();
1814     os.Translate(pVarSuffix);
1815     os.CatStr(" runtime managed { }");
1816     os.CatEOL();
1817     os.CatStr(".method public virtual instance ");
1818     os.RetType(pTp, NIL);
1819     os.CatEOL();
1820     os.Tstring("Invoke");
1821
1822     os.SignatureDecl(pTp);
1823
1824     os.CatStr(" runtime managed { }"); os.CatEOL();
1825     os.CloseBrace(2);
1826     os.CatEOL();
1827   END EmitPTypeBody;
1828
1829 (* ============================================================ *)
1830 (*            End of Procedure Variable and Event Stuff         *)
1831 (* ============================================================ *)
1832
1833   PROCEDURE (os : IlasmFile)Line*(nm : INTEGER);
1834   BEGIN
1835     os.CatStr(Asm.dirStr[Asm.dot_line]);
1836     os.Tint(nm);
1837     os.Tstring(os.srcS);
1838     os.CatEOL();
1839   END Line;
1840
1841 (* ============================================================ *)
1842
1843   PROCEDURE (os : IlasmFile)LinePlus*(l,w : INTEGER);
1844   BEGIN
1845     os.CatStr(Asm.dirStr[Asm.dot_line]);
1846     os.Tint(l);
1847     os.CatChar(":");
1848     os.CatInt(w);
1849     os.Tstring(os.srcS);
1850     os.CatEOL();
1851   END LinePlus;
1852
1853 (* ============================================================ *)
1854
1855   PROCEDURE (os : IlasmFile)LineSpan*(s : Scn.Span);
1856   BEGIN
1857     IF s = NIL THEN RETURN END;
1858     os.CatStr(Asm.dirStr[Asm.dot_line]);
1859     os.Tint(s.sLin);
1860     os.CatChar(",");
1861     os.CatInt(s.eLin);
1862     os.CatChar(":");
1863     os.CatInt(s.sCol);
1864     os.CatChar(",");
1865     os.CatInt(s.eCol);
1866     os.Bstring(os.srcS);
1867     os.CatEOL();
1868   END LineSpan;
1869
1870 (* ============================================================ *)
1871
1872   PROCEDURE (os : IlasmFile)Locals(),NEW;
1873   (** Declare the local of this method. *)
1874     VAR count : INTEGER;
1875         index : INTEGER;
1876         prcId : Sy.Scope;
1877         locId : Id.LocId;
1878   BEGIN
1879     count := 0;
1880    (* if dMax < 8, leave maxstack as default *)
1881     IF os.proc.dMax < 8 THEN os.CatStr("//") END;
1882     os.CatChar(ASCII.HT);
1883     os.CatStr(Asm.dirStr[Asm.dot_maxstack]);
1884     os.Tint(os.proc.dMax);
1885     os.CatEOL();
1886
1887     os.CatChar(ASCII.HT);
1888     os.CatStr(Asm.dirStr[Asm.dot_locals]);
1889     IF os.proc.tLst.tide > 0 THEN os.CatStr(" init ") END;
1890     IF os.proc.tLst.tide > 1 THEN
1891       os.Separator("(",2);
1892     ELSE
1893       os.CatChar("(");
1894     END;
1895     IF os.proc.prId # NIL THEN
1896       prcId := os.proc.prId;
1897       WITH prcId : Id.Procs DO
1898         IF Id.hasXHR IN prcId.pAttr THEN
1899           os.TypeTag(prcId.xhrType);
1900           INC(count);
1901         END;
1902         FOR index := 0 TO prcId.locals.tide-1 DO
1903           locId := prcId.locals.a[index](Id.LocId);
1904           IF ~(locId IS Id.ParId) & (locId.varOrd # Id.xMark) THEN
1905             IF count > 0 THEN os.Separator(',', 2) END;
1906             os.TypeTag(locId.type);
1907             os.Tidnt(locId);
1908             INC(count);
1909           END;
1910         END;
1911       ELSE (* nothing for module blocks *)
1912       END;
1913     END;
1914     WHILE count < os.proc.tLst.tide DO
1915       IF count > 0 THEN os.Separator(',', 2) END;
1916       os.TypeTag(os.proc.tLst.a[count]);
1917       INC(count);
1918     END;
1919     os.CatChar(")");
1920     os.CatEOL();
1921   END Locals;
1922
1923 (* ============================================================ *)
1924
1925   PROCEDURE (os : IlasmFile)LoadType*(id : Sy.Idnt);
1926   BEGIN
1927    (*
1928     *    ldtoken <Type>
1929     *    call class [mscorlib]System.Type
1930     *           [mscorlib]System.Type::GetTypeFromHandle(
1931     *                     value class [mscorlib]System.RuntimeTypeHandle)
1932     *)
1933     os.CodeT(Asm.opc_ldtoken, id.type);
1934     os.CatStr("        call    class [mscorlib]System.Type");
1935             os.CatEOL();
1936     os.CatStr("            [mscorlib]System.Type::GetTypeFromHandle(");
1937             os.CatEOL();
1938     os.CatStr("            value class [mscorlib]System.RuntimeTypeHandle)");
1939             os.CatEOL();
1940   END LoadType;
1941
1942 (* ============================================================ *)
1943 (* ============================================================ *)
1944 BEGIN
1945   rts[Mu.vStr2ChO] := BOX("wchar[] [RTS]CP_rts::strToChO($S)");
1946   rts[Mu.vStr2ChF] := BOX("void [RTS]CP_rts::StrToChF(wchar[], $S)");
1947   rts[Mu.sysExit]  := BOX("void    [mscorlib]System.Environment::Exit(int32)");
1948   rts[Mu.toUpper]  := BOX("wchar   [mscorlib]System.Char::ToUpper(wchar) ");
1949   rts[Mu.dFloor]   := BOX("float64 [mscorlib]System.Math::Floor(float64) ");
1950   rts[Mu.dAbs]     := BOX("float64 [mscorlib]System.Math::Abs(float64) ");
1951   rts[Mu.fAbs]     := BOX("float32 [mscorlib]System.Math::Abs(float32) ");
1952   rts[Mu.iAbs]     := BOX("int32   [mscorlib]System.Math::Abs(int32) ");
1953   rts[Mu.lAbs]     := BOX("int64   [mscorlib]System.Math::Abs(int64) ");
1954   rts[Mu.getTpM]   := BOX("instance class [mscorlib]System.Type $o::GetType()");
1955   rts[Mu.CpModI]   := BOX("int32 [RTS]CP_rts::CpModI(int32, int32)");
1956   rts[Mu.CpDivI]   := BOX("int32 [RTS]CP_rts::CpDivI(int32, int32)");
1957   rts[Mu.CpModL]   := BOX("int64 [RTS]CP_rts::CpModL(int64, int64)");
1958   rts[Mu.CpDivL]   := BOX("int64 [RTS]CP_rts::CpDivL(int64, int64)");
1959   rts[Mu.aStrLen]  := BOX("int32 [RTS]CP_rts::chrArrLength(wchar[])");
1960   rts[Mu.aStrChk]  := BOX("void  [RTS]CP_rts::ChrArrCheck(wchar[])");
1961   rts[Mu.aStrLp1]  := BOX("int32 [RTS]CP_rts::chrArrLplus1(wchar[])");
1962   rts[Mu.aaStrCmp] := BOX("int32 [RTS]CP_rts::strCmp(wchar[],wchar[])");
1963   rts[Mu.aaStrCopy]:= BOX("void  [RTS]CP_rts::Stringify(wchar[],wchar[])");
1964   rts[Mu.caseMesg] := BOX("$S [RTS]CP_rts::caseMesg(int32)");
1965   rts[Mu.withMesg] := BOX("$S [RTS]CP_rts::withMesg($O)");
1966   rts[Mu.chs2Str]  :=  BOX("$S [RTS]CP_rts::mkStr(wchar[])");
1967   rts[Mu.CPJstrCatAA] := BOX("$S [RTS]CP_rts::aaToStr(wchar[],wchar[])");
1968   rts[Mu.CPJstrCatSA] := BOX("$S [RTS]CP_rts::saToStr($S, wchar[])");
1969   rts[Mu.CPJstrCatAS] := BOX("$S [RTS]CP_rts::asToStr(wchar[], $S)");
1970   rts[Mu.CPJstrCatSS] := BOX("$S [RTS]CP_rts::ssToStr($S, $S)");
1971   rts[Mu.mkExcept]    := BOX(
1972             "instance void [mscorlib]System.Exception::.ctor($S)");
1973
1974 (* ============================================================ *)
1975
1976   Lv.InitCharOpenSeq(nmArray, 8);
1977
1978   evtAdd := Lv.strToCharOpen("add_");
1979   evtRem := Lv.strToCharOpen("remove_");
1980
1981   cln2 := Lv.strToCharOpen("::");
1982   brks := Lv.strToCharOpen("[]");
1983   cmma := Lv.strToCharOpen(",");
1984   lPar := Lv.strToCharOpen("(");
1985   rPar := Lv.strToCharOpen(")");
1986   rfMk := Lv.strToCharOpen("&");
1987   vFld := Lv.strToCharOpen("v$");
1988   ouMk := Lv.strToCharOpen("[out] ");
1989   clss := Lv.strToCharOpen("class ");
1990   vals := Lv.strToCharOpen("value ");
1991   vStr := Lv.strToCharOpen("void ");
1992   inVd := Lv.strToCharOpen("instance void ");
1993   brsz := Lv.strToCharOpen("    {} // abstract method");
1994   xhrMk := Lv.strToCharOpen("class [RTS]XHR");
1995   boxedObj := Lv.strToCharOpen("Boxed_");
1996   pVarSuffix := Lv.strToCharOpen(".ctor($O, native int) ");
1997 END IlasmUtil.
1998 (* ============================================================ *)
1999 (* ============================================================ *)
2000