gpcp/JsmnUtil.cp

   1 (* ============================================================ *)
   2 (*  JsmnUtil is the module which writes jasmin file structures  *)
   3 (*  Copyright (c) John Gough 1999, 2000.                        *)
   4 (* ============================================================ *)
   5
   6 MODULE JsmnUtil;
   7
   8   IMPORT
   9         GPCPcopyright,
  10         RTS, ASCII,
  11         Console,
  12         GPText,
  13         LitValue,
  14         FileNames,
  15         GPTextFiles,
  16         CompState,
  17         J := JavaUtil,
  18         D := Symbols,
  19         G := Builtin,
  20         Id := IdDesc,
  21         Ty := TypeDesc,
  22         Jvm := JVMcodes;
  23
  24 (* ============================================================ *)
  25
  26    CONST
  27         classPrefix = "CP";
  28         pubStat     = Jvm.att_public + Jvm.att_static;
  29         modAttrib   = Jvm.att_public + Jvm.att_final;
  30
  31    CONST
  32         (* various Java-specific runtime name strings *)
  33         initStr     = "<init>";
  34         initSuffix* = "/<init>()V";
  35         object*     = "java/lang/Object";
  36         objectInit* = "java/lang/Object/<init>()V";
  37         mainStr*    = "main([Ljava/lang/String;)V";
  38         jlExcept*   = "java/lang/Exception";
  39 (*
  40  *      jlError*    = "java/lang/Error";
  41  *)
  42         jlError*    = jlExcept;
  43         mkExcept*   = "java/lang/Exception/<init>(Ljava/lang/String;)V";
  44 (*
  45  *      mkError*    = "java/lang/Error/<init>(Ljava/lang/String;)V";
  46  *)
  47         mkError*    = mkExcept;
  48         putArgStr*  = "CP/CPmain/CPmain/PutArgs([Ljava/lang/String;)V";
  49
  50 (* ============================================================ *)
  51 (* ============================================================ *)
  52
  53   TYPE ProcInfo*  = POINTER TO RECORD
  54                       prId- : D.Scope;  (* mth., prc. or mod.   *)
  55                       lMax  : INTEGER;  (* max locals for proc  *)
  56                       lNum  : INTEGER;  (* current locals proc  *)
  57                       dMax  : INTEGER;  (* max depth for proc.  *)
  58                       dNum  : INTEGER;  (* current depth proc.  *)
  59                       attr  : SET;      (* access attributes    *)
  60                       exLb  : J.Label;
  61                       hnLb  : J.Label;
  62                     END;
  63
  64 (* ============================================================ *)
  65
  66   TYPE JsmnFile*  = POINTER TO RECORD (J.JavaFile)
  67                       file* : GPTextFiles.FILE;
  68                       proc* : ProcInfo;
  69                       nxtLb : INTEGER;
  70                     END;
  71
  72 (* ============================================================ *)
  73
  74   TYPE  TypeNameString = ARRAY 12 OF CHAR;
  75         ProcNameString = ARRAY 90 OF CHAR;
  76
  77 (* ============================================================ *)
  78
  79   VAR   typeName  : ARRAY 15 OF TypeNameString; (* base type names *)
  80         typeChar  : ARRAY 15 OF CHAR;           (* base type chars *)
  81         rtsProcs  : ARRAY 24 OF ProcNameString;
  82
  83 (* ============================================================ *)
  84 (*                      Constructor Method                      *)
  85 (* ============================================================ *)
  86
  87   PROCEDURE newJsmnFile*(fileName : ARRAY OF CHAR) : JsmnFile;
  88     VAR f : JsmnFile;
  89   BEGIN
  90     NEW(f);
  91     f.file := GPTextFiles.createFile(fileName);
  92     IF f.file = NIL THEN RETURN NIL; END;
  93     RETURN f;
  94   END newJsmnFile;
  95
  96 (* ============================================================ *)
  97
  98   PROCEDURE^ (os : JsmnFile)Directive(dir : INTEGER),NEW;
  99   PROCEDURE^ (os : JsmnFile)DirectiveS(dir : INTEGER;
 100                                    IN str : ARRAY OF CHAR),NEW;
 101   PROCEDURE^ (os : JsmnFile)DirectiveIS(dir : INTEGER; att : SET;
 102                                      IN str : ARRAY OF CHAR),NEW;
 103   PROCEDURE^ (os : JsmnFile)DirectiveISS(dir : INTEGER; att : SET;
 104                                       IN s1  : ARRAY OF CHAR;
 105                                       IN s2  : ARRAY OF CHAR),NEW;
 106   PROCEDURE^ (os : JsmnFile)Call2*(code : INTEGER;
 107                                 IN st1 : ARRAY OF CHAR;
 108                                 IN st2 : ARRAY OF CHAR;
 109                                 argL,retL : INTEGER),NEW;
 110
 111 (* ============================================================ *)
 112 (* ============================================================ *)
 113 (*                      ProcInfo Methods                        *)
 114 (* ============================================================ *)
 115
 116   PROCEDURE newProcInfo*(proc : D.Scope) : ProcInfo;
 117     VAR p : ProcInfo;
 118   BEGIN
 119     NEW(p);
 120     p.prId := proc;
 121     WITH proc : Id.Procs DO
 122       p.lNum := proc.rtsFram;
 123       p.lMax := MAX(proc.rtsFram, 1);
 124     ELSE        (* Id.BlkId *)
 125       p.lNum := 0;
 126       p.lMax := 1;
 127     END;
 128     p.dNum := 0;
 129     p.dMax := 0;
 130     p.attr := {};
 131     RETURN p;
 132   END newProcInfo;
 133
 134 (* ------------------------------------------------------------ *)
 135
 136   PROCEDURE (os : JsmnFile)StartProc* (proc : Id.Procs);
 137   VAR
 138     attr : SET;
 139     method : Id.MthId;
 140     procName : FileNames.NameString;
 141   BEGIN
 142     os.proc := newProcInfo(proc);
 143     os.Comment("PROCEDURE " + D.getName.ChPtr(proc)^);
 144    (*
 145     *  Compute the method attributes
 146     *)
 147     IF proc.kind = Id.conMth THEN
 148       method := proc(Id.MthId);
 149       attr := {};
 150       IF method.mthAtt * Id.mask = {} THEN attr := Jvm.att_final END;
 151       IF method.mthAtt * Id.mask = Id.isAbs THEN
 152         attr := attr + Jvm.att_abstract;
 153       END;
 154       IF Id.widen IN method.mthAtt THEN attr := attr + Jvm.att_public END;
 155     ELSE
 156       attr := Jvm.att_static;
 157     END;
 158 (*
 159  *  The following code fails for "implement-only" methods
 160  *  since the JVM places the "override method" in a different
 161  *  slot! We must thus live with the insecurity of public mode.
 162  *
 163  *  IF proc.vMod = D.pubMode THEN       (* explicitly public *)
 164  *)
 165     IF (proc.vMod = D.pubMode) OR       (* explicitly public *)
 166        (proc.vMod = D.rdoMode) THEN     (* "implement only"  *)
 167       attr := attr + Jvm.att_public;
 168     ELSIF proc.dfScp IS Id.PrcId THEN   (* nested procedure  *)
 169       attr := attr + Jvm.att_private;
 170     END;
 171     FileNames.StripUpToLast("/", proc.prcNm, procName);
 172     os.DirectiveISS(Jvm.dot_method, attr, procName$, proc.type.xName);
 173     os.proc.attr := attr
 174   END StartProc;
 175
 176 (* ------------------------------------------------------------ *)
 177
 178   PROCEDURE^ (os : JsmnFile)Locals(),NEW;
 179   PROCEDURE^ (os : JsmnFile)Stack(),NEW;
 180   PROCEDURE^ (os : JsmnFile)Blank(),NEW;
 181
 182   PROCEDURE (os : JsmnFile)EndProc*();
 183   BEGIN
 184     IF (os.proc.attr * Jvm.att_abstract # {}) THEN
 185       os.Comment("Abstract method");
 186     ELSE
 187       os.Locals();
 188       os.Stack();
 189     END;
 190     os.Directive(Jvm.dot_end);
 191     os.Blank();
 192   END EndProc;
 193
 194   PROCEDURE (os : JsmnFile)isAbstract*() : BOOLEAN;
 195   BEGIN
 196     RETURN (os.proc.attr * Jvm.att_abstract # {});
 197   END isAbstract;
 198
 199 (* ------------------------------------------------------------ *)
 200
 201   PROCEDURE (os : JsmnFile)getScope*() : D.Scope;
 202   BEGIN
 203     RETURN os.proc.prId;
 204   END getScope;
 205
 206 (* ------------------------------------------------------------ *)
 207
 208   PROCEDURE (os : JsmnFile)newLocal*() : INTEGER;
 209     VAR ord : INTEGER;
 210         info : ProcInfo;
 211   BEGIN
 212     info := os.proc;
 213     ord := info.lNum;
 214     INC(info.lNum);
 215     IF info.lNum > info.lMax THEN info.lMax := info.lNum END;
 216     RETURN ord;
 217   END newLocal;
 218
 219 (* ------------------------------------------------------------ *)
 220
 221   PROCEDURE (os : JsmnFile)ReleaseLocal*(i : INTEGER);
 222   BEGIN
 223    (*
 224     *  If you try to release not in LIFO order, the
 225     *  location will not be made free again. This is safe!
 226     *)
 227     IF i+1 = os.proc.lNum THEN DEC(os.proc.lNum) END;
 228   END ReleaseLocal;
 229
 230 (* ------------------------------------------------------------ *)
 231
 232   PROCEDURE (info : ProcInfo)numLocals*() : INTEGER,NEW;
 233   BEGIN
 234     IF info.lNum = 0 THEN RETURN 1 ELSE RETURN info.lNum END;
 235   END numLocals;
 236
 237 (* ------------------------------------------------------------ *)
 238
 239   PROCEDURE (os : JsmnFile)markTop*() : INTEGER;
 240   BEGIN
 241     RETURN os.proc.lNum;
 242   END markTop;
 243
 244 (* ------------------------------------------------------------ *)
 245
 246   PROCEDURE (os : JsmnFile)ReleaseAll*(m : INTEGER);
 247   BEGIN
 248     os.proc.lNum := m;
 249   END ReleaseAll;
 250
 251 (* ------------------------------------------------------------ *)
 252
 253   PROCEDURE (os : JsmnFile)getDepth*() : INTEGER;
 254   BEGIN RETURN os.proc.dNum END getDepth;
 255
 256   (* ------------------------------------------ *)
 257
 258   PROCEDURE (os : JsmnFile)setDepth*(i : INTEGER);
 259   BEGIN os.proc.dNum := i END setDepth;
 260
 261 (* ============================================================ *)
 262 (*                      Init Methods                            *)
 263 (* ============================================================ *)
 264
 265   PROCEDURE (os : JsmnFile) ClinitHead*();
 266   BEGIN
 267     os.proc := newProcInfo(NIL);
 268     os.Comment("Class initializer");
 269     os.DirectiveIS(Jvm.dot_method, pubStat, "<clinit>()V");
 270   END ClinitHead;
 271
 272 (* ============================================================ *)
 273
 274   PROCEDURE (os: JsmnFile)VoidTail*();
 275   BEGIN
 276     os.Code(Jvm.opc_return);
 277     os.Locals();
 278     os.Stack();
 279     os.Directive(Jvm.dot_end);
 280     os.Blank();
 281   END VoidTail;
 282
 283 (* ============================================================ *)
 284
 285   PROCEDURE^ (os : JsmnFile)CallS*(code : INTEGER; IN str : ARRAY OF CHAR;
 286                                    argL,retL : INTEGER),NEW;
 287
 288   PROCEDURE (os : JsmnFile)MainHead*();
 289   BEGIN
 290     os.proc := newProcInfo(NIL);
 291     os.Comment("Main entry point");
 292     os.DirectiveIS(Jvm.dot_method, pubStat, mainStr);
 293    (*
 294     *  Save the command-line arguments to the RTS.
 295     *)
 296     os.Code(Jvm.opc_aload_0);
 297     os.CallS(Jvm.opc_invokestatic, putArgStr, 1, 0);
 298   END MainHead;
 299
 300 (* ============================================================ *)
 301
 302   PROCEDURE (os : JsmnFile)ModNoArgInit*();
 303   BEGIN
 304     os.Blank();
 305     os.proc := newProcInfo(NIL);
 306     os.Comment("Standard no-arg constructor");
 307     os.DirectiveIS(Jvm.dot_method, Jvm.att_public, "<init>()V");
 308     os.Code(Jvm.opc_aload_0);
 309     os.CallS(Jvm.opc_invokespecial, objectInit, 1, 0);
 310     os.Code(Jvm.opc_return);
 311     os.Stack();
 312     os.Directive(Jvm.dot_end);
 313     os.Blank();
 314   END ModNoArgInit;
 315
 316 (* ---------------------------------------------------- *)
 317
 318   PROCEDURE (os : JsmnFile)RecMakeInit*(rec : Ty.Record;
 319                                         prc : Id.PrcId);
 320     VAR pTp : Ty.Procedure;
 321   BEGIN
 322     os.Blank();
 323     IF prc = NIL THEN
 324       IF D.noNew IN rec.xAttr THEN
 325         os.Comment("There is no no-arg constructor for this class");
 326         os.Blank();
 327         RETURN;                                 (* PREMATURE RETURN HERE *)
 328       ELSIF D.xCtor IN rec.xAttr THEN
 329         os.Comment("There is an explicit no-arg constructor for this class");
 330         os.Blank();
 331         RETURN;                                 (* PREMATURE RETURN HERE *)
 332       END;
 333     END;
 334     os.proc := newProcInfo(prc);
 335    (*
 336     *  Get the procedure type, if any.
 337     *)
 338     IF prc # NIL THEN
 339       pTp := prc.type(Ty.Procedure);
 340       J.MkCallAttr(prc, pTp);
 341       os.DirectiveISS(Jvm.dot_method, Jvm.att_public, initStr, pTp.xName);
 342     ELSE
 343       os.Comment("Standard no-arg constructor");
 344       pTp := NIL;
 345       os.DirectiveIS(Jvm.dot_method, Jvm.att_public, "<init>()V");
 346     END;
 347     os.Code(Jvm.opc_aload_0);
 348   END RecMakeInit;
 349
 350 (*
 351     IF pTp # NIL THEN
 352      (*
 353       *  Copy the args to the super-constructor
 354       *)
 355       FOR idx := 0 TO pNm-1 DO os.GetLocal(pTp.formals.a[idx]) END;
 356
 357     END;
 358  *)
 359
 360   PROCEDURE (os : JsmnFile)CallSuperCtor*(rec : Ty.Record;
 361                                           pTy : Ty.Procedure);
 362     VAR idx : INTEGER;
 363         fld : D.Idnt;
 364         pNm : INTEGER;
 365         string2 : LitValue.CharOpen;
 366   BEGIN
 367    (*
 368     *    Initialize the embedded superclass object.
 369     *)
 370     IF (rec.baseTp # NIL) & (rec.baseTp # G.anyRec) THEN
 371       IF pTy # NIL THEN
 372         string2 := LitValue.strToCharOpen("/" + initStr + pTy.xName^);
 373         pNm := pTy.formals.tide;
 374       ELSE
 375         string2 := LitValue.strToCharOpen(initSuffix);
 376         pNm := 0;
 377       END;
 378       os.Call2(Jvm.opc_invokespecial,
 379                  rec.baseTp(Ty.Record).xName, string2, pNm+1, 0);
 380     ELSE
 381       os.CallS(Jvm.opc_invokespecial, objectInit, 1, 0);
 382     END;
 383    (*
 384     *    Initialize fields, as necessary.
 385     *)
 386     FOR idx := 0 TO rec.fields.tide-1 DO
 387       fld := rec.fields.a[idx];
 388       IF (fld.type IS Ty.Record) OR (fld.type IS Ty.Array) THEN
 389         os.Comment("Initialize embedded object");
 390         os.Code(Jvm.opc_aload_0);
 391         os.VarInit(fld);
 392         os.PutGetF(Jvm.opc_putfield, rec, fld(Id.FldId));
 393       END;
 394     END;
 395 (*
 396  *  os.Code(Jvm.opc_return);
 397  *  os.Stack();
 398  *  os.Directive(Jvm.dot_end);
 399  *  os.Blank();
 400  *)
 401   END CallSuperCtor;
 402
 403 (* ---------------------------------------------------- *)
 404
 405   PROCEDURE (os : JsmnFile)CopyProcHead*(rec : Ty.Record);
 406   BEGIN
 407     os.proc := newProcInfo(NIL);
 408     os.Comment("standard record copy method");
 409     os.DirectiveIS(Jvm.dot_method, Jvm.att_public,
 410                                 "__copy__(" + rec.scopeNm^ + ")V");
 411   END CopyProcHead;
 412
 413 (* ============================================================ *)
 414 (*                      Private Methods                         *)
 415 (* ============================================================ *)
 416
 417   PROCEDURE (os : JsmnFile)Mark(),NEW;
 418   BEGIN
 419     GPTextFiles.WriteChar(os.file, ";");
 420     GPText.WriteInt(os.file, os.proc.dNum, 3);
 421     GPText.WriteInt(os.file, os.proc.dMax, 3);
 422     GPTextFiles.WriteEOL(os.file);
 423   END Mark;
 424
 425 (* ============================================================ *)
 426
 427   PROCEDURE (os : JsmnFile)CatStr(IN str : ARRAY OF CHAR),NEW;
 428   BEGIN
 429     GPTextFiles.WriteNChars(os.file, str, LEN(str$));
 430   END CatStr;
 431
 432 (* ============================================================ *)
 433
 434   PROCEDURE (os : JsmnFile)Tstring(IN str : ARRAY OF CHAR),NEW;
 435   BEGIN
 436     GPTextFiles.WriteChar(os.file, ASCII.HT);
 437     GPTextFiles.WriteNChars(os.file, str, LEN(str$));
 438   END Tstring;
 439
 440 (* ============================================================ *)
 441
 442   PROCEDURE (os : JsmnFile)Tint(int : INTEGER),NEW;
 443   BEGIN
 444     GPTextFiles.WriteChar(os.file, ASCII.HT);
 445     GPText.WriteInt(os.file, int, 1);
 446   END Tint;
 447
 448 (* ============================================================ *)
 449
 450   PROCEDURE (os : JsmnFile)Tlong(long : LONGINT),NEW;
 451   BEGIN
 452     GPTextFiles.WriteChar(os.file, ASCII.HT);
 453     GPText.WriteLong(os.file, long, 1);
 454   END Tlong;
 455
 456 (* ============================================================ *)
 457
 458   PROCEDURE (os : JsmnFile)QuoteStr(IN str : ARRAY OF CHAR),NEW;
 459     VAR ix : INTEGER;
 460         ch : CHAR;
 461   BEGIN
 462     ix := 0;
 463     ch := str[0];
 464     GPTextFiles.WriteChar(os.file, '"');
 465     WHILE ch # 0X DO
 466       CASE ch OF
 467       | "\",'"' : GPTextFiles.WriteChar(os.file, "\");
 468                   GPTextFiles.WriteChar(os.file, ch);
 469       | 9X      : GPTextFiles.WriteChar(os.file, "\");
 470                   GPTextFiles.WriteChar(os.file, "t");
 471       | 0AX     : GPTextFiles.WriteChar(os.file, "\");
 472                   GPTextFiles.WriteChar(os.file, "n");
 473       ELSE
 474         GPTextFiles.WriteChar(os.file, ch);
 475       END;
 476       INC(ix);
 477       ch := str[ix];
 478     END;
 479     GPTextFiles.WriteChar(os.file, '"');
 480   END QuoteStr;
 481
 482 (* ============================================================ *)
 483
 484   PROCEDURE (os : JsmnFile)Prefix(code : INTEGER),NEW;
 485   BEGIN
 486     GPTextFiles.WriteChar(os.file, ASCII.HT);
 487     GPTextFiles.WriteNChars(os.file,Jvm.op[code],LEN(Jvm.op[code]$));
 488   END Prefix;
 489
 490 (* ============================================================ *)
 491
 492   PROCEDURE (os : JsmnFile)Suffix(code : INTEGER),NEW;
 493   BEGIN
 494     GPTextFiles.WriteEOL(os.file);
 495     INC(os.proc.dNum, Jvm.dl[code]);
 496     IF os.proc.dNum > os.proc.dMax THEN os.proc.dMax := os.proc.dNum END;
 497     IF CompState.verbose THEN os.Mark() END;
 498   END Suffix;
 499
 500 (* ============================================================ *)
 501
 502   PROCEDURE (os : JsmnFile)Access(acc : SET),NEW;
 503     VAR att : INTEGER;
 504   BEGIN
 505     FOR att := 0 TO 10 DO
 506       IF att IN acc THEN
 507         GPText.WriteString(os.file, Jvm.access[att]);
 508         GPTextFiles.WriteChar(os.file, ' ');
 509       END;
 510     END;
 511   END Access;
 512
 513 (* ============================================================ *)
 514
 515   PROCEDURE (os : JsmnFile)RefLab(l : J.Label),NEW;
 516   BEGIN
 517     GPTextFiles.WriteChar(os.file, ASCII.HT);
 518     GPTextFiles.WriteChar(os.file, "l");
 519     GPTextFiles.WriteChar(os.file, "b");
 520     GPText.WriteInt(os.file, l.defIx, 1);
 521   END RefLab;
 522
 523   PROCEDURE (os : JsmnFile)AddSwitchLab*(l : J.Label; pos : INTEGER);
 524   BEGIN
 525     os.RefLab(l);
 526     GPTextFiles.WriteEOL(os.file);
 527   END AddSwitchLab;
 528
 529   PROCEDURE (os : JsmnFile)LstDef*(l : J.Label);
 530   BEGIN
 531     GPText.WriteString(os.file, "default:");
 532     os.RefLab(l);
 533     GPTextFiles.WriteEOL(os.file);
 534   END LstDef;
 535
 536 (* ============================================================ *)
 537
 538   PROCEDURE (os : JsmnFile)Idnt(idD : D.Idnt),NEW;
 539   BEGIN
 540     GPText.WriteString(os.file, D.getName.ChPtr(idD));
 541   END Idnt;
 542
 543 (* ============================================================ *)
 544
 545   PROCEDURE (os : JsmnFile)Type(typ : D.Type),NEW;
 546   BEGIN
 547     WITH typ : Ty.Base DO
 548         GPText.WriteString(os.file, typ.xName);
 549     | typ : Ty.Vector DO
 550         IF typ.xName = NIL THEN J.MkVecName(typ) END;
 551         GPText.WriteString(os.file, typ.xName);
 552         | typ : Ty.Procedure DO
 553         IF typ.xName = NIL THEN J.MkProcTypeName(typ) END;
 554         GPText.WriteString(os.file, typ.hostClass.scopeNm);
 555     | typ : Ty.Array DO
 556         GPTextFiles.WriteChar(os.file, "[");
 557         os.Type(typ.elemTp);
 558     | typ : Ty.Record DO
 559         IF typ.xName = NIL THEN J.MkRecName(typ) END;
 560         GPText.WriteString(os.file, typ.scopeNm);
 561     | typ : Ty.Enum DO
 562         GPText.WriteString(os.file, G.intTp.xName);
 563     | typ : Ty.Pointer DO
 564         os.Type(typ.boundTp);
 565     | typ : Ty.Opaque DO
 566         IF typ.xName = NIL THEN J.MkAliasName(typ) END;
 567         GPText.WriteString(os.file, typ.scopeNm);
 568     END;
 569   END Type;
 570
 571 (* ============================================================ *)
 572
 573   PROCEDURE (os : JsmnFile)TypeTag(typ : D.Type),NEW;
 574   BEGIN
 575     WITH typ : Ty.Base DO
 576         GPText.WriteString(os.file, typ.xName);
 577     | typ : Ty.Array DO
 578         GPTextFiles.WriteChar(os.file, "[");
 579         os.TypeTag(typ.elemTp);
 580     | typ : Ty.Record DO
 581         IF typ.xName = NIL THEN J.MkRecName(typ) END;
 582         GPText.WriteString(os.file, typ.xName);
 583     | typ : Ty.Pointer DO
 584         os.TypeTag(typ.boundTp);
 585     | typ : Ty.Opaque DO
 586         IF typ.xName = NIL THEN J.MkAliasName(typ) END;
 587         GPText.WriteString(os.file, typ.xName);
 588     END;
 589   END TypeTag;
 590
 591 (* ============================================================ *)
 592 (*                      Exported Methods                        *)
 593 (* ============================================================ *)
 594
 595   PROCEDURE (os : JsmnFile)newLabel*() : J.Label;
 596   VAR
 597     lab : J.Label;
 598   BEGIN
 599     NEW(lab);
 600     INC(os.nxtLb);
 601     lab.defIx := os.nxtLb;
 602     RETURN lab;
 603   END newLabel;
 604
 605 (* ============================================================ *)
 606
 607   PROCEDURE (os : JsmnFile)getLabelRange*(VAR labs : ARRAY OF J.Label);
 608     VAR labNo : INTEGER;
 609         count : INTEGER;
 610         i     : INTEGER;
 611
 612   BEGIN
 613     count := LEN(labs);
 614     labNo := os.nxtLb + 1;
 615     INC(os.nxtLb, count);
 616     FOR i := 0 TO count-1 DO
 617       NEW(labs[i]);
 618       labs[i].defIx := labNo;
 619       INC(labNo);
 620     END;
 621   END getLabelRange;
 622
 623 (* ============================================================ *)
 624
 625   PROCEDURE (os : JsmnFile)Blank*(),NEW;
 626   BEGIN
 627     GPTextFiles.WriteEOL(os.file);
 628   END Blank;
 629
 630 (* ============================================================ *)
 631
 632   PROCEDURE (os : JsmnFile)Directive(dir : INTEGER),NEW;
 633   BEGIN
 634     os.CatStr(Jvm.dirStr[dir]);
 635     GPTextFiles.WriteEOL(os.file);
 636   END Directive;
 637
 638 (* -------------------------------------------- *)
 639
 640   PROCEDURE (os : JsmnFile)DirectiveS(dir : INTEGER;
 641                                    IN str : ARRAY OF CHAR),NEW;
 642   BEGIN
 643     os.CatStr(Jvm.dirStr[dir]);
 644     GPTextFiles.WriteChar(os.file, " ");
 645     GPTextFiles.WriteNChars(os.file, str, LEN(str$));
 646     GPTextFiles.WriteEOL(os.file);
 647   END DirectiveS;
 648
 649 (* -------------------------------------------- *)
 650
 651   PROCEDURE (os : JsmnFile)DirectiveIS(dir : INTEGER;
 652                                         att : SET;
 653                                      IN str : ARRAY OF CHAR),NEW;
 654   BEGIN
 655     os.CatStr(Jvm.dirStr[dir]);
 656     GPTextFiles.WriteChar(os.file, " ");
 657     os.Access(att);
 658     GPTextFiles.WriteNChars(os.file, str, LEN(str$));
 659     GPTextFiles.WriteEOL(os.file);
 660   END DirectiveIS;
 661
 662 (* -------------------------------------------- *)
 663
 664   PROCEDURE (os : JsmnFile)DirectiveISS(dir : INTEGER;
 665                                          att : SET;
 666                                       IN s1  : ARRAY OF CHAR;
 667                                       IN s2  : ARRAY OF CHAR),NEW;
 668   BEGIN
 669     os.CatStr(Jvm.dirStr[dir]);
 670     GPTextFiles.WriteChar(os.file, " ");
 671     os.Access(att);
 672     GPTextFiles.WriteNChars(os.file, s1, LEN(s1$));
 673     GPTextFiles.WriteNChars(os.file, s2, LEN(s2$));
 674     GPTextFiles.WriteEOL(os.file);
 675   END DirectiveISS;
 676
 677 (* -------------------------------------------- *)
 678
 679   PROCEDURE (os : JsmnFile)Comment*(IN s : ARRAY OF CHAR);
 680   BEGIN
 681     GPTextFiles.WriteChar(os.file, ";");
 682     GPTextFiles.WriteChar(os.file, " ");
 683     GPTextFiles.WriteNChars(os.file, s, LEN(s$));
 684     GPTextFiles.WriteEOL(os.file);
 685   END Comment;
 686
 687 (* ============================================================ *)
 688
 689   PROCEDURE (os : JsmnFile)DefLab*(l : J.Label);
 690   BEGIN
 691     GPTextFiles.WriteChar(os.file, "l");
 692     GPTextFiles.WriteChar(os.file, "b");
 693     GPText.WriteInt(os.file, l.defIx, 1);
 694     GPTextFiles.WriteChar(os.file, ":");
 695     GPTextFiles.WriteEOL(os.file);
 696   END DefLab;
 697
 698 (* -------------------------------------------- *)
 699
 700   PROCEDURE (os : JsmnFile)DefLabC*(l : J.Label; IN c : ARRAY OF CHAR);
 701   BEGIN
 702     GPTextFiles.WriteChar(os.file, "l");
 703     GPTextFiles.WriteChar(os.file, "b");
 704     GPText.WriteInt(os.file, l.defIx, 1);
 705     GPTextFiles.WriteChar(os.file, ":");
 706     GPTextFiles.WriteChar(os.file, ASCII.HT);
 707     os.Comment(c);
 708   END DefLabC;
 709
 710 (* ============================================================ *)
 711
 712   PROCEDURE (os : JsmnFile)Code*(code : INTEGER);
 713   BEGIN
 714     os.Prefix(code);
 715     os.Suffix(code);
 716   END Code;
 717
 718 (* -------------------------------------------- *)
 719
 720   PROCEDURE (os : JsmnFile)CodeI*(code,int : INTEGER);
 721   BEGIN
 722     os.Prefix(code);
 723     os.Tint(int);
 724     os.Suffix(code);
 725   END CodeI;
 726
 727 (* -------------------------------------------- *)
 728
 729   PROCEDURE (os : JsmnFile)CodeT*(code : INTEGER; type : D.Type);
 730   BEGIN
 731     os.Prefix(code);
 732     GPTextFiles.WriteChar(os.file, ASCII.HT);
 733     os.TypeTag(type);
 734     os.Suffix(code);
 735   END CodeT;
 736
 737 (* -------------------------------------------- *)
 738
 739   PROCEDURE (os : JsmnFile)CodeL*(code : INTEGER; long : LONGINT);
 740   BEGIN
 741     os.Prefix(code);
 742     os.Tlong(long);
 743     os.Suffix(code);
 744   END CodeL;
 745
 746 (* -------------------------------------------- *)
 747
 748   PROCEDURE (os : JsmnFile)CodeR*(code : INTEGER; real : REAL; short : BOOLEAN);
 749     VAR nam : ARRAY 64 OF CHAR;
 750   BEGIN
 751     os.Prefix(code);
 752     RTS.RealToStr(real, nam);
 753     os.Tstring(nam$);
 754     os.Suffix(code);
 755   END CodeR;
 756
 757 (* -------------------------------------------- *)
 758
 759   PROCEDURE (os : JsmnFile)CodeLb*(code : INTEGER; i2 : J.Label);
 760   BEGIN
 761     os.Prefix(code);
 762     os.RefLab(i2);
 763     os.Suffix(code);
 764   END CodeLb;
 765
 766 (* -------------------------------------------- *)
 767
 768   PROCEDURE (os : JsmnFile)CodeII*(code,i1,i2 : INTEGER),NEW;
 769   BEGIN
 770     os.Prefix(code);
 771     os.Tint(i1);
 772     os.Tint(i2);
 773     os.Suffix(code);
 774   END CodeII;
 775
 776 (* -------------------------------------------- *)
 777
 778   PROCEDURE (os : JsmnFile)CodeInc*(localIx, incVal : INTEGER);
 779   BEGIN
 780     os.CodeII(Jvm.opc_iinc, localIx, incVal);
 781   END CodeInc;
 782
 783 (* -------------------------------------------- *)
 784
 785   PROCEDURE (os : JsmnFile)CodeS*(code : INTEGER; IN str : ARRAY OF CHAR),NEW;
 786   BEGIN
 787     os.Prefix(code);
 788     os.Tstring(str);
 789     os.Suffix(code);
 790   END CodeS;
 791
 792 (* -------------------------------------------- *)
 793
 794   PROCEDURE (os : JsmnFile)CodeC*(code : INTEGER; IN str : ARRAY OF CHAR);
 795   BEGIN
 796     os.Prefix(code);
 797     GPTextFiles.WriteNChars(os.file, str, LEN(str$));
 798     os.Suffix(code);
 799   END CodeC;
 800
 801 (* -------------------------------------------- *)
 802
 803   PROCEDURE (os : JsmnFile)CodeSwitch*(loIx,hiIx : INTEGER; dfLb : J.Label);
 804   BEGIN
 805     os.CodeII(Jvm.opc_tableswitch,loIx,hiIx);
 806   END CodeSwitch;
 807
 808 (* -------------------------------------------- *)
 809
 810   PROCEDURE (os : JsmnFile)PushStr*(IN str : LitValue.CharOpen);
 811   (* Use target quoting conventions for the literal string *)
 812   BEGIN
 813     os.Prefix(Jvm.opc_ldc);
 814     GPTextFiles.WriteChar(os.file, ASCII.HT);
 815     os.QuoteStr(str^);
 816     os.Suffix(Jvm.opc_ldc);
 817   END PushStr;
 818
 819 (* ============================================================ *)
 820
 821   PROCEDURE (os : JsmnFile)CallS*(code : INTEGER;
 822                                 IN str : ARRAY OF CHAR;
 823                                 argL,retL : INTEGER),NEW;
 824   BEGIN
 825     os.Prefix(code);
 826     os.Tstring(str);
 827     IF code = Jvm.opc_invokeinterface THEN os.Tint(argL) END;
 828     GPTextFiles.WriteEOL(os.file);
 829     INC(os.proc.dNum, retL-argL);
 830     IF os.proc.dNum > os.proc.dMax THEN os.proc.dMax := os.proc.dNum END;
 831     IF CompState.verbose THEN os.Mark() END;
 832   END CallS;
 833
 834 (* ============================================================ *)
 835
 836   PROCEDURE (os : JsmnFile)CallIT*(code : INTEGER;
 837                                    proc : Id.Procs;
 838                                    type : Ty.Procedure);
 839     VAR argL, retL : INTEGER;
 840         clsNam : LitValue.CharOpen;
 841   BEGIN
 842     os.Prefix(code);
 843     IF proc.scopeNm = NIL THEN J.MkProcName(proc) END;
 844     os.Tstring(proc.scopeNm);
 845     GPTextFiles.WriteChar(os.file, "/");
 846     WITH proc : Id.PrcId DO clsNam := proc.clsNm;
 847     |    proc : Id.MthId DO clsNam := proc.bndType(Ty.Record).extrnNm;
 848     END;
 849     os.CatStr(clsNam);
 850     GPTextFiles.WriteChar(os.file, "/");
 851     os.CatStr(proc.prcNm);
 852     os.CatStr(type.xName);
 853     argL := type.argN;
 854     retL := type.retN;
 855     IF code = Jvm.opc_invokeinterface THEN os.Tint(type.argN) END;
 856     GPTextFiles.WriteEOL(os.file);
 857     INC(os.proc.dNum, retL-argL);
 858     IF os.proc.dNum > os.proc.dMax THEN os.proc.dMax := os.proc.dNum END;
 859     IF CompState.verbose THEN os.Mark() END;
 860   END CallIT;
 861
 862 (* ============================================================ *)
 863
 864   PROCEDURE (os : JsmnFile)Call2*(code : INTEGER;
 865                                 IN st1 : ARRAY OF CHAR;
 866                                 IN st2 : ARRAY OF CHAR;
 867                                 argL,retL : INTEGER),NEW;
 868   BEGIN
 869     os.Prefix(code);
 870     os.Tstring(st1);
 871     os.CatStr(st2);
 872     IF code = Jvm.opc_invokeinterface THEN os.Tint(argL) END;
 873     GPTextFiles.WriteEOL(os.file);
 874     INC(os.proc.dNum, retL-argL);
 875     IF os.proc.dNum > os.proc.dMax THEN os.proc.dMax := os.proc.dNum END;
 876     IF CompState.verbose THEN os.Mark() END;
 877   END Call2;
 878
 879 (* ============================================================ *)
 880
 881   PROCEDURE (os : JsmnFile)MultiNew*(elT : D.Type;
 882                                      dms : INTEGER),NEW;
 883    (* dsc is the array descriptor, dms the number of dimensions *)
 884     VAR i : INTEGER;
 885   BEGIN
 886     os.Prefix(Jvm.opc_multianewarray);
 887     GPTextFiles.WriteChar(os.file, ASCII.HT);
 888     FOR i := 1 TO dms DO GPTextFiles.WriteChar(os.file, "[") END;
 889     os.TypeTag(elT);
 890     os.Tint(dms);
 891     GPTextFiles.WriteEOL(os.file);
 892     DEC(os.proc.dNum, dms-1);
 893   END MultiNew;
 894
 895 (* ============================================================ *)
 896
 897   PROCEDURE (os : JsmnFile)PutGetS*(code : INTEGER;
 898                                     blk  : Id.BlkId;
 899                                     fld  : Id.VarId);
 900     VAR size : INTEGER;
 901   (* Emit putstatic and getstatic for static field *)
 902   BEGIN
 903     os.Prefix(code);
 904     IF blk.xName = NIL THEN J.MkBlkName(blk) END;
 905     IF fld.varNm = NIL THEN J.MkVarName(fld) END;
 906     os.Tstring(blk.scopeNm);
 907     GPTextFiles.WriteChar(os.file, "/");
 908     os.CatStr(fld.clsNm);
 909     GPTextFiles.WriteChar(os.file, "/");
 910     os.CatStr(fld.varNm);
 911     GPTextFiles.WriteChar(os.file, " ");
 912     os.Type(fld.type);
 913     GPTextFiles.WriteEOL(os.file);
 914     size := J.jvmSize(fld.type);
 915     IF    code = Jvm.opc_getstatic THEN INC(os.proc.dNum, size);
 916     ELSIF code = Jvm.opc_putstatic THEN DEC(os.proc.dNum, size);
 917     END;
 918     IF os.proc.dNum > os.proc.dMax THEN os.proc.dMax := os.proc.dNum END;
 919     IF CompState.verbose THEN os.Mark() END;
 920   END PutGetS;
 921
 922 (* -------------------------------------------- *)
 923
 924   PROCEDURE (os : JsmnFile)PutGetF*(code : INTEGER;
 925                                     rec  : Ty.Record;
 926                                     fld  : Id.AbVar);
 927 (*
 928                                     fld  : Id.FldId);
 929  *)
 930     VAR size : INTEGER;
 931   (* Emit putfield and getfield for record field *)
 932   BEGIN
 933     os.Prefix(code);
 934     GPTextFiles.WriteChar(os.file, ASCII.HT);
 935     os.TypeTag(rec);
 936     GPTextFiles.WriteChar(os.file, "/");
 937     os.Idnt(fld);
 938     GPTextFiles.WriteChar(os.file, " ");
 939     os.Type(fld.type);
 940     GPTextFiles.WriteEOL(os.file);
 941     size := J.jvmSize(fld.type);
 942     IF    code = Jvm.opc_getfield THEN INC(os.proc.dNum, size-1);
 943     ELSIF code = Jvm.opc_putfield THEN DEC(os.proc.dNum, size+1);
 944     END;
 945     IF os.proc.dNum > os.proc.dMax THEN os.proc.dMax := os.proc.dNum END;
 946     IF CompState.verbose THEN os.Mark() END;
 947   END PutGetF;
 948
 949 (* ============================================================ *)
 950
 951   PROCEDURE (os : JsmnFile)Alloc1d*(elTp : D.Type);
 952   BEGIN
 953     WITH elTp : Ty.Base DO
 954       IF (elTp.tpOrd < Ty.anyRec) THEN
 955         os.CodeS(Jvm.opc_newarray, typeName[elTp.tpOrd]);
 956       ELSE
 957         os.Prefix(Jvm.opc_anewarray);
 958         os.Tstring(object);
 959         os.Suffix(Jvm.opc_anewarray);
 960       END;
 961     ELSE
 962       os.Prefix(Jvm.opc_anewarray);
 963       GPTextFiles.WriteChar(os.file, ASCII.HT);
 964       os.TypeTag(elTp);
 965       os.Suffix(Jvm.opc_anewarray);
 966     END;
 967   END Alloc1d;
 968
 969 (* ============================================================ *)
 970
 971   PROCEDURE (os : JsmnFile)MkNewRecord*(typ : Ty.Record);
 972   BEGIN
 973     os.CodeT(Jvm.opc_new, typ);
 974     os.Code(Jvm.opc_dup);
 975     os.Prefix(Jvm.opc_invokespecial);
 976     os.Tstring(typ.xName);
 977     os.CatStr(initSuffix);
 978     os.Suffix(Jvm.opc_invokespecial);
 979   END MkNewRecord;
 980
 981 (* ============================================================ *)
 982
 983   PROCEDURE (os : JsmnFile)MkNewFixedArray*(topE : D.Type; len0 : INTEGER);
 984     VAR dims : INTEGER;
 985         arTp : Ty.Array;
 986         elTp : D.Type;
 987   BEGIN
 988     (*
 989     //  Fixed-size, possibly multi-dimensional arrays.
 990     //  The code relies on the semantic property in CP
 991     //  that the element-type of a fixed array type cannot
 992     //  be an open array. This simplifies the code somewhat.
 993     *)
 994     os.PushInt(len0);
 995     dims := 1;
 996     elTp := topE;
 997    (*
 998     *  Find the number of dimensions ...
 999     *)
1000     LOOP
1001       WITH elTp : Ty.Array DO arTp := elTp ELSE EXIT END;
1002       elTp := arTp.elemTp;
1003       os.PushInt(arTp.length);
1004       INC(dims);
1005     END;
1006     IF dims = 1 THEN
1007       os.Alloc1d(elTp);
1008      (*
1009       *  Stack is (top) len0, ref...
1010       *)
1011       IF elTp.kind = Ty.recTp THEN os.Init1dArray(elTp, len0) END;
1012     ELSE
1013      (*
1014       *  Allocate the array headers for all dimensions.
1015       *  Stack is (top) lenN, ... len0, ref...
1016       *)
1017       os.MultiNew(elTp, dims);
1018      (*
1019       *  Stack is (top) ref...
1020       *)
1021       IF elTp.kind = Ty.recTp THEN os.InitNdArray(topE, elTp) END;
1022     END;
1023   END MkNewFixedArray;
1024
1025 (* ============================================================ *)
1026
1027   PROCEDURE (os : JsmnFile)MkNewOpenArray*(arrT : Ty.Array; dims : INTEGER);
1028     VAR elTp : D.Type;
1029         indx : INTEGER;
1030   BEGIN
1031    (*
1032     *  Assert: lengths are pushed already...
1033     *  and we know from semantic analysis that
1034     *  the number of open array dimensions match
1035     *  the number of integer LENs in dims.
1036     *)
1037     elTp := arrT;
1038    (*
1039     *   Find the number of dimensions ...
1040     *)
1041     FOR indx := 0 TO dims-1 DO
1042       elTp := elTp(Ty.Array).elemTp;
1043     END;
1044    (*
1045     *   Allocate the array headers for all _open_ dimensions.
1046     *)
1047     IF dims = 1 THEN
1048       os.Alloc1d(elTp);
1049      (*
1050       *  Stack is now (top) ref ...
1051       *  and we _might_ need to initialize the elements.
1052       *)
1053       IF (elTp.kind = Ty.recTp) OR
1054          (elTp.kind = Ty.arrTp) THEN
1055         os.Init1dArray(elTp, 0);
1056       END;
1057     ELSE
1058       os.MultiNew(elTp, dims);
1059      (*
1060       *    Stack is now (top) ref ...
1061       *    Now we _might_ need to initialize the elements.
1062       *)
1063       IF (elTp.kind = Ty.recTp) OR
1064          (elTp.kind = Ty.arrTp) THEN
1065         os.InitNdArray(arrT.elemTp, elTp);
1066       END;
1067     END;
1068   END MkNewOpenArray;
1069
1070
1071 (* ============================================================ *)
1072
1073   PROCEDURE (os : JsmnFile)MkArrayCopy*(arrT : Ty.Array);
1074     VAR dims : INTEGER;
1075         elTp : D.Type;
1076   BEGIN
1077    (*
1078     *   Assert: we must find the lengths from the runtime
1079     *   descriptors.  Find the number of dimensions.  The
1080     *   array to copy is on the top of stack, which reads -
1081     *           (top) aRef, ...
1082     *)
1083     elTp := arrT.elemTp;
1084     IF elTp.kind # Ty.arrTp THEN
1085       os.Code(Jvm.opc_arraylength);     (* (top) len0, aRef,... *)
1086       os.Alloc1d(elTp);                      (* (top) aRef, ...         *)
1087       IF elTp.kind = Ty.recTp THEN os.Init1dArray(elTp, 0) END; (*0 ==> open*)
1088     ELSE
1089       dims := 1;
1090       REPEAT
1091        (*
1092         *  Invariant: an array reference is on the top of
1093         *  of the stack, which reads:
1094         *               (top) [arRf, lengths,] arRf ...
1095         *)
1096         INC(dims);
1097         elTp := elTp(Ty.Array).elemTp;
1098         os.Code(Jvm.opc_dup);        (*          arRf, arRf,... *)
1099         os.Code(Jvm.opc_arraylength);   (*    len0, arRf, arRf,... *)
1100         os.Code(Jvm.opc_swap);       (*    arRf, len0, arRf,... *)
1101         os.Code(Jvm.opc_iconst_0);           (* 0, arRf, len0, arRf,... *)
1102         os.Code(Jvm.opc_aaload);             (*    arRf, len0, arRf,... *)
1103        (*
1104         *  Stack reads: (top) arRf, lenN, [lengths,] arRf ...
1105         *)
1106       UNTIL  elTp.kind # Ty.arrTp;
1107      (*
1108       *  Now get the final length...
1109       *)
1110       os.Code(Jvm.opc_arraylength);
1111      (*
1112       *   Stack reads:  (top) lenM, lenN, [lengths,] arRf ...
1113       *   Allocate the array headers for all dimensions.
1114       *)
1115       os.MultiNew(elTp, dims);
1116      (*
1117       *  Stack is (top) ref...
1118       *)
1119       IF elTp.kind = Ty.recTp THEN os.InitNdArray(arrT.elemTp, elTp) END;
1120     END;
1121   END MkArrayCopy;
1122
1123 (* ============================================================ *)
1124
1125   PROCEDURE (os : JsmnFile)VarInit*(var : D.Idnt);
1126     VAR typ : D.Type;
1127   BEGIN
1128    (*
1129     *  Precondition: var is of a type that needs initialization
1130     *)
1131     typ := var.type;
1132     WITH typ : Ty.Record DO
1133         os.MkNewRecord(typ);
1134     | typ : Ty.Array DO
1135         os.MkNewFixedArray(typ.elemTp, typ.length);
1136     ELSE
1137       os.Code(Jvm.opc_aconst_null);
1138     END;
1139   END VarInit;
1140
1141 (* ============================================================ *)
1142
1143   PROCEDURE (os : JsmnFile)ValRecCopy*(typ : Ty.Record);
1144     VAR nam : LitValue.CharOpen;
1145   BEGIN
1146    (*
1147     *     Stack at entry is (top) srcRef, dstRef...
1148     *)
1149     IF typ.xName = NIL THEN J.MkRecName(typ) END;
1150     nam := typ.xName;
1151     os.CallS(Jvm.opc_invokevirtual,
1152                         nam^ + "/__copy__(L" + nam^ + ";)V", 2, 0);
1153   END ValRecCopy;
1154
1155
1156 (* ============================================================ *)
1157
1158   PROCEDURE (os : JsmnFile)CallRTS*(ix,args,ret : INTEGER);
1159   BEGIN
1160     os.CallS(Jvm.opc_invokestatic, rtsProcs[ix], args, ret);
1161   END CallRTS;
1162
1163 (* ============================================================ *)
1164
1165   PROCEDURE (os : JsmnFile)CallGetClass*();
1166   BEGIN
1167     os.CallS(Jvm.opc_invokevirtual, rtsProcs[J.GetTpM], 1, 1);
1168   END CallGetClass;
1169
1170 (* ============================================================ *)
1171
1172   PROCEDURE (os : JsmnFile)Trap*(IN str : ARRAY OF CHAR);
1173   BEGIN
1174     os.CodeS(Jvm.opc_new, jlError);
1175     os.Code(Jvm.opc_dup);
1176 (* Do we need the quotes? *)
1177     os.PushStr(LitValue.strToCharOpen('"' + str + '"'));
1178     os.CallS(Jvm.opc_invokespecial, mkError,2,0);
1179     os.Code(Jvm.opc_athrow);
1180   END Trap;
1181
1182 (* ============================================================ *)
1183
1184   PROCEDURE (os : JsmnFile)CaseTrap*(i : INTEGER);
1185   BEGIN
1186     os.CodeS(Jvm.opc_new, jlError);
1187     os.Code(Jvm.opc_dup);
1188     os.LoadLocal(i, G.intTp);
1189     os.CallS(Jvm.opc_invokestatic,
1190                 "CP/CPJrts/CPJrts/CaseMesg(I)Ljava/lang/String;",1,1);
1191     os.CallS(Jvm.opc_invokespecial, mkError,2,0);
1192     os.Code(Jvm.opc_athrow);
1193   END CaseTrap;
1194
1195 (* ============================================================ *)
1196
1197   PROCEDURE (os : JsmnFile)WithTrap*(id : D.Idnt);
1198   BEGIN
1199     os.CodeS(Jvm.opc_new, jlError);
1200     os.Code(Jvm.opc_dup);
1201     os.GetVar(id);
1202     os.CallS(Jvm.opc_invokestatic,
1203         "CP/CPJrts/CPJrts/WithMesg(Ljava/lang/Object;)Ljava/lang/String;",1,1);
1204     os.CallS(Jvm.opc_invokespecial, mkError,2,0);
1205     os.Code(Jvm.opc_athrow);
1206   END WithTrap;
1207
1208 (* ============================================================ *)
1209
1210   PROCEDURE (os : JsmnFile)Header*(IN str : ARRAY OF CHAR);
1211     VAR date : ARRAY 64 OF CHAR;
1212   BEGIN
1213     RTS.GetDateString(date);
1214     os.Comment("Jasmin output produced by CPascal compiler (" +
1215                                         RTS.defaultTarget + " version)");
1216     os.Comment("at date: " + date);
1217     os.Comment("from source file <" + str + '>');
1218   END Header;
1219
1220 (* ============================================================ *)
1221
1222   PROCEDURE (os : JsmnFile)StartRecClass*(rec : Ty.Record);
1223   VAR
1224     baseT  : D.Type;
1225     attSet : SET;
1226     clsId  : D.Idnt;
1227     impRec : D.Type;
1228     index  : INTEGER;
1229   BEGIN
1230     os.Blank();
1231     os.DirectiveS(Jvm.dot_source, CompState.srcNam);
1232    (*
1233     *   Account for the record attributes.
1234     *)
1235     CASE rec.recAtt OF
1236     | Ty.noAtt : attSet := Jvm.att_final;
1237     | Ty.isAbs : attSet := Jvm.att_abstract;
1238     | Ty.limit : attSet := Jvm.att_empty;
1239     | Ty.extns : attSet := Jvm.att_empty;
1240     END;
1241    (*
1242     *   Get the pointer IdDesc, if this is anonymous.
1243     *)
1244     IF rec.bindTp # NIL THEN
1245       clsId := rec.bindTp.idnt;
1246     ELSE
1247       clsId := rec.idnt;
1248     END;
1249    (*
1250     *   Account for the identifier visibility.
1251     *)
1252     IF clsId # NIL THEN
1253       IF clsId.vMod = D.pubMode THEN
1254         attSet := attSet + Jvm.att_public;
1255       ELSIF clsId.vMod = D.prvMode THEN
1256         attSet := attSet + Jvm.att_private;
1257       END;
1258     END;
1259     os.DirectiveIS(Jvm.dot_class, attSet, rec.xName);
1260    (*
1261     *   Compute the super class attribute.
1262     *)
1263     baseT := rec.baseTp;
1264     WITH baseT : Ty.Record DO
1265       IF baseT.xName = NIL THEN J.MkRecName(baseT) END;
1266       os.DirectiveS(Jvm.dot_super, baseT.xName);
1267     ELSE
1268       os.DirectiveS(Jvm.dot_super, object);
1269     END;
1270    (*
1271     *   Emit interface declarations (if any)
1272     *)
1273     IF rec.interfaces.tide > 0 THEN
1274       FOR index := 0 TO rec.interfaces.tide-1 DO
1275         impRec := rec.interfaces.a[index];
1276         baseT  := impRec.boundRecTp();
1277         IF baseT.xName = NIL THEN J.MkRecName(baseT(Ty.Record)) END;
1278         os.DirectiveS(Jvm.dot_implements, baseT.xName);
1279       END;
1280     END;
1281     os.Blank();
1282   END StartRecClass;
1283
1284   PROCEDURE (os : JsmnFile)StartModClass*(mod : Id.BlkId);
1285   BEGIN
1286     IF mod.main THEN os.Comment("This module implements CPmain") END;
1287     os.Blank();
1288     os.DirectiveS(Jvm.dot_source, CompState.srcNam);
1289     IF mod.scopeNm[0] = 0X THEN
1290       os.DirectiveIS(Jvm.dot_class, modAttrib, mod.xName);
1291     ELSE
1292       os.DirectiveISS(Jvm.dot_class, modAttrib, mod.scopeNm^ + '/', mod.xName);
1293     END;
1294     os.DirectiveS(Jvm.dot_super, object);
1295     os.Blank();
1296   END StartModClass;
1297
1298 (* ============================================================ *)
1299
1300   PROCEDURE (os : JsmnFile)EmitField*(id : Id.AbVar);
1301   VAR
1302     att : SET;
1303   BEGIN
1304     IF id IS Id.FldId THEN att := Jvm.att_empty;
1305     ELSE att := Jvm.att_static; END;
1306     IF id.vMod # D.prvMode THEN (* any export ==> public in JVM *)
1307       att := att + Jvm.att_public;
1308     END;
1309     os.CatStr(Jvm.dirStr[Jvm.dot_field]);
1310     GPTextFiles.WriteChar(os.file, " ");
1311     os.Access(att);
1312     GPTextFiles.WriteChar(os.file, " ");
1313     os.Idnt(id);
1314     GPTextFiles.WriteChar(os.file, " ");
1315     os.Type(id.type);
1316     GPTextFiles.WriteEOL(os.file);
1317   END EmitField;
1318
1319 (* ============================================================ *)
1320
1321   PROCEDURE (os : JsmnFile)Line*(nm : INTEGER);
1322   BEGIN
1323     os.CatStr(Jvm.dirStr[Jvm.dot_line]);
1324     os.Tint(nm);
1325     GPTextFiles.WriteEOL(os.file);
1326   END Line;
1327
1328 (* ============================================================ *)
1329
1330   PROCEDURE (os : JsmnFile)Locals(),NEW;
1331   BEGIN
1332     os.CatStr(Jvm.dirStr[Jvm.dot_limit]);
1333     os.CatStr(" locals");
1334     os.Tint(os.proc.lMax);
1335     GPTextFiles.WriteEOL(os.file);
1336   END Locals;
1337
1338 (* ============================================================ *)
1339
1340   PROCEDURE (os : JsmnFile)Stack(),NEW;
1341   BEGIN
1342     os.CatStr(Jvm.dirStr[Jvm.dot_limit]);
1343     os.CatStr(" stack");
1344     os.Tint(os.proc.dMax);
1345     GPTextFiles.WriteEOL(os.file);
1346   END Stack;
1347
1348 (* ============================================================ *)
1349 (*                      Namehandling Methods                    *)
1350 (* ============================================================ *)
1351
1352   PROCEDURE (os : JsmnFile)LoadConst*(num : INTEGER);
1353   BEGIN
1354     IF (num >= MIN(SHORTINT)) & (num <= MAX(SHORTINT)) THEN
1355       os.CodeI(Jvm.opc_sipush, num);
1356     ELSE
1357       os.CodeI(Jvm.opc_ldc, num);
1358     END;
1359   END LoadConst;
1360
1361 (* ------------------------------------------------------------ *)
1362
1363   PROCEDURE (os : JsmnFile)Try*();
1364     VAR start : J.Label;
1365   BEGIN
1366     start := os.newLabel();
1367     os.proc.exLb := os.newLabel();
1368     os.proc.hnLb := os.newLabel();
1369     os.CatStr(Jvm.dirStr[Jvm.dot_catch]);
1370     os.CatStr(" java/lang/Exception from lb");
1371     GPText.WriteInt(os.file, start.defIx, 1);
1372     os.CatStr(" to lb");
1373     GPText.WriteInt(os.file, os.proc.exLb.defIx, 1);
1374     os.CatStr(" using lb");
1375     GPText.WriteInt(os.file, os.proc.hnLb.defIx, 1);
1376     GPTextFiles.WriteEOL(os.file);
1377     os.DefLab(start);
1378   END Try;
1379
1380 (* ------------------------------------------------------------ *)
1381
1382   PROCEDURE (os : JsmnFile)MkNewException*();
1383   BEGIN
1384     os.CodeS(Jvm.opc_new, jlExcept);
1385   END MkNewException;
1386
1387   PROCEDURE (os : JsmnFile)InitException*();
1388   BEGIN
1389     os.CallS(Jvm.opc_invokespecial, mkExcept, 2,0);
1390   END InitException;
1391
1392 (* ------------------------------------------------------------ *)
1393
1394   PROCEDURE (os : JsmnFile)Catch*(prc : Id.Procs);
1395   BEGIN
1396     os.DefLab(os.proc.exLb);
1397     os.DefLab(os.proc.hnLb);
1398     os.StoreLocal(prc.except.varOrd, NIL);
1399    (*
1400     *  Now make sure that the overall stack
1401     *  depth computation is correctly initialized
1402     *)
1403     IF os.proc.dMax < 1 THEN os.proc.dMax := 1 END;
1404     os.proc.dNum := 0;
1405   END Catch;
1406
1407 (* ============================================================ *)
1408
1409   PROCEDURE (jf : JsmnFile)Dump*();
1410   BEGIN
1411     jf.Blank();
1412     jf.Comment("end output produced by CPascal");
1413     GPTextFiles.CloseFile(jf.file);
1414   END Dump;
1415
1416 (* ============================================================ *)
1417 (* ============================================================ *)
1418 BEGIN
1419
1420   typeChar[       0] := "?";
1421   typeChar[ Ty.boolN] := "Z";
1422   typeChar[ Ty.sChrN] := "C";
1423   typeChar[ Ty.charN] := "C";
1424   typeChar[ Ty.byteN] := "B";
1425   typeChar[ Ty.sIntN] := "S";
1426   typeChar[  Ty.intN] := "I";
1427   typeChar[ Ty.lIntN] := "J";
1428   typeChar[ Ty.sReaN] := "F";
1429   typeChar[ Ty.realN] := "D";
1430   typeChar[  Ty.setN] := "I";
1431   typeChar[Ty.anyRec] := "?";
1432   typeChar[Ty.anyPtr] := "?";
1433   typeChar[  Ty.strN] := "?";
1434   typeChar[ Ty.sStrN] := "?";
1435
1436   typeName[     0] := "";
1437   typeName[ Ty.boolN] := "boolean";
1438   typeName[ Ty.sChrN] := "char";
1439   typeName[ Ty.charN] := "char";
1440   typeName[ Ty.byteN] := "byte";
1441   typeName[ Ty.sIntN] := "short";
1442   typeName[  Ty.intN] := "int";
1443   typeName[ Ty.lIntN] := "long";
1444   typeName[ Ty.sReaN] := "float";
1445   typeName[ Ty.realN] := "double";
1446   typeName[  Ty.setN] := "int";
1447   typeName[Ty.anyRec] := "";
1448   typeName[Ty.anyPtr] := "";
1449   typeName[  Ty.strN] := "";
1450   typeName[ Ty.sStrN] := "";
1451
1452   rtsProcs[J.StrCmp] := "CP/CPJrts/CPJrts/strCmp([C[C)I";
1453   rtsProcs[J.StrToChrOpen] :=
1454         "CP/CPJrts/CPJrts/JavaStrToChrOpen(Ljava/lang/String;)[C";
1455   rtsProcs[J.StrToChrs] :=
1456         "CP/CPJrts/CPJrts/JavaStrToFixChr([CLjava/lang/String;)V";
1457   rtsProcs[J.ChrsToStr] :=
1458         "CP/CPJrts/CPJrts/FixChToJavaStr([C)Ljava/lang/String;";
1459   rtsProcs[J.StrCheck] := "CP/CPJrts/CPJrts/ChrArrCheck([C)V";
1460   rtsProcs[J.StrLen] := "CP/CPJrts/CPJrts/ChrArrLength([C)I";
1461   rtsProcs[J.ToUpper] := "java/lang/Character/toUpperCase(C)C";
1462   rtsProcs[J.DFloor] := "java/lang/Math/floor(D)D";
1463   rtsProcs[J.ModI] := "CP/CPJrts/CPJrts/CpModI(II)I";
1464   rtsProcs[J.ModL] := "CP/CPJrts/CPJrts/CpModL(JJ)J";
1465   rtsProcs[J.DivI] := "CP/CPJrts/CPJrts/CpDivI(II)I";
1466   rtsProcs[J.DivL] := "CP/CPJrts/CPJrts/CpDivL(JJ)J";
1467   rtsProcs[J.StrCatAA] :=
1468         "CP/CPJrts/CPJrts/ArrArrToString([C[C)Ljava/lang/String;";
1469   rtsProcs[J.StrCatSA] :=
1470 "CP/CPJrts/CPJrts/StrArrToString(Ljava/lang/String;[C)Ljava/lang/String;";
1471   rtsProcs[J.StrCatAS] :=
1472 "CP/CPJrts/CPJrts/ArrStrToString([CLjava/lang/String;)Ljava/lang/String;";
1473   rtsProcs[J.StrCatSS] := "CP/CPJrts/CPJrts/StrStrToString(Ljava/lang/String;Ljava/lang/String;)Ljava/lang/String;";
1474   rtsProcs[J.StrLP1] := "CP/CPJrts/CPJrts/ChrArrLplus1([C)I";
1475   rtsProcs[J.StrVal] := "CP/CPJrts/CPJrts/ChrArrStrCopy([C[C)V";
1476   rtsProcs[J.SysExit] := "java/lang/System/exit(I)V";
1477   rtsProcs[J.LoadTp1] := "CP/CPJrts/CPJrts/getClassByOrd(I)Ljava/lang/Class;";
1478   rtsProcs[J.LoadTp2] :=
1479         "CP/CPJrts/CPJrts/getClassByName(Ljava/lang/String;)Ljava/lang/Class;";
1480   rtsProcs[J.GetTpM] := "java/lang/Object/getClass()Ljava/lang/Class;";
1481 END JsmnUtil.
1482 (* ============================================================ *)
1483 (* ============================================================ *)
1484