gpcp/JavaUtil.cp

   1
   2 (* ============================================================ *)
   3 (*  JavaUtil is the module which writes java classs file        *)
   4 (*  structures                                                  *)
   5 (*  Copyright (c) John Gough 1999, 2000.                        *)
   6 (*  Modified DWC September, 2000.                               *)
   7 (* ============================================================ *)
   8
   9 MODULE JavaUtil;
  10
  11   IMPORT
  12         GPCPcopyright,
  13         RTS,
  14         Console,
  15         JavaBase,
  16         Hsh := NameHash,
  17         Cst := CompState,
  18         Psr := CPascalP,
  19         Jvm := JVMcodes,
  20         Sym := Symbols,
  21         Blt := Builtin,
  22         Id  := IdDesc,
  23         Xp  := ExprDesc,
  24         Ty  := TypeDesc,
  25         L   := LitValue;
  26
  27 (* ============================================================ *)
  28
  29   CONST
  30        initStr* = "<init>";
  31        classPrefix* = "CP";
  32        retMarker* = -1;   (* ==> out param is func-return *)
  33        StrCmp* = 1;       (* indexes for rts procs *)
  34        StrToChrOpen* = 2;
  35        StrToChrs* = 3;
  36        ChrsToStr* = 4;
  37        StrCheck* = 5;
  38        StrLen* = 6;
  39        ToUpper* = 7;
  40        DFloor* = 8;
  41        ModI* = 9;
  42        ModL* = 10;
  43        DivI* = 11;
  44        DivL* = 12;
  45        StrCatAA* = 13;
  46        StrCatSA* = 14;
  47        StrCatAS* = 15;
  48        StrCatSS* = 16;
  49        StrLP1* = 17;
  50        StrVal* = 18;
  51        SysExit* = 19;
  52        LoadTp1* = 20;   (* getClassByOrd  *)
  53        LoadTp2* = 21;   (* getClassByName *)
  54        GetTpM* = 22;
  55
  56 (* ============================================================ *)
  57
  58   TYPE JavaFile* = POINTER TO ABSTRACT RECORD
  59                      theP* : Id.Procs;
  60                    END;
  61
  62 (* ============================================================ *)
  63
  64   TYPE Label* = POINTER TO RECORD
  65                   defIx* : INTEGER;
  66                 END;
  67
  68 (* ============================================================ *)
  69
  70   VAR
  71         typeRetn-  : ARRAY 16 OF INTEGER;
  72         typeLoad-  : ARRAY 16 OF INTEGER;
  73         typeStore- : ARRAY 16 OF INTEGER;
  74         typePutE-  : ARRAY 16 OF INTEGER;
  75         typeGetE-  : ARRAY 16 OF INTEGER;
  76
  77   VAR   nmArray*   : L.CharOpenSeq;
  78         fmArray*   : L.CharOpenSeq;
  79
  80   VAR   semi-,comma-,colon-,lPar-,rPar-,rParV-,
  81         brac-,lCap-, void-,lowL-,dlar-,slsh-,prfx- : L.CharOpen;
  82
  83 (* ============================================================ *)
  84
  85   VAR   xhrIx : INTEGER;
  86         xhrDl : L.CharOpen;
  87         xhrMk : L.CharOpen;
  88
  89   VAR   invokeHash : INTEGER;
  90                 ptvIx      : INTEGER;    (* Index number for procedure type literals *)
  91         procLitPrefix : L.CharOpen;
  92
  93 (* ============================================================ *)
  94
  95   VAR   vecBlkId  : Id.BlkId;
  96         vecBase   : Id.TypId;
  97         vecTypes  : ARRAY Ty.anyPtr+1 OF Id.TypId;
  98         vecTide   : Id.FldId;
  99         vecElms   : ARRAY Ty.anyPtr+1 OF Id.FldId;
 100         vecExpnd  : ARRAY Ty.anyPtr+1 OF Id.MthId;
 101
 102 (* ============================================================ *)
 103
 104   PROCEDURE (jf : JavaFile)StartModClass*(mod : Id.BlkId),NEW,ABSTRACT;
 105   PROCEDURE (jf : JavaFile)StartRecClass*(rec : Ty.Record),NEW,ABSTRACT;
 106   PROCEDURE (jf : JavaFile)StartProc*(proc : Id.Procs),NEW,ABSTRACT;
 107   PROCEDURE (jf : JavaFile)EndProc*(),NEW,EMPTY;
 108   PROCEDURE (jf : JavaFile)isAbstract*():BOOLEAN,NEW,ABSTRACT;
 109
 110   PROCEDURE (jf : JavaFile)getScope*():Sym.Scope,NEW,ABSTRACT;
 111
 112   PROCEDURE (jf : JavaFile) EmitField*(field : Id.AbVar),NEW,ABSTRACT;
 113
 114   PROCEDURE (jf : JavaFile)MkNewRecord*(typ : Ty.Record),NEW,ABSTRACT;
 115   PROCEDURE (jf : JavaFile)MkNewFixedArray*(topE : Sym.Type;
 116                                             len0 : INTEGER),NEW,ABSTRACT;
 117   PROCEDURE (jf : JavaFile)MkNewOpenArray*(arrT : Ty.Array;
 118                                            dims : INTEGER),NEW,ABSTRACT;
 119   PROCEDURE (jf : JavaFile)MkArrayCopy*(arrT : Ty.Array),NEW,ABSTRACT;
 120
 121   PROCEDURE (jf : JavaFile)newLocal*() : INTEGER,NEW,ABSTRACT;
 122   PROCEDURE (jf : JavaFile)ReleaseLocal*(i : INTEGER),NEW,ABSTRACT;
 123   PROCEDURE (jf : JavaFile)ReleaseAll*(m : INTEGER),NEW,ABSTRACT;
 124
 125   PROCEDURE (jf : JavaFile)markTop*() : INTEGER,NEW,ABSTRACT;
 126   PROCEDURE (jf : JavaFile)getDepth*() : INTEGER,NEW,ABSTRACT;
 127   PROCEDURE (jf : JavaFile)setDepth*(i : INTEGER),NEW,ABSTRACT;
 128
 129   PROCEDURE (jf : JavaFile)newLabel*() : Label,NEW,ABSTRACT;
 130   PROCEDURE (jf : JavaFile)getLabelRange*(VAR labs:ARRAY OF Label),NEW,ABSTRACT;
 131   PROCEDURE (jf : JavaFile)AddSwitchLab*(lab : Label;
 132                                          pos : INTEGER),NEW,ABSTRACT;
 133
 134
 135   PROCEDURE (jf : JavaFile)Comment*(IN msg : ARRAY OF CHAR),NEW,EMPTY;
 136   PROCEDURE (jf : JavaFile)Header*(IN str : ARRAY OF CHAR),NEW,EMPTY;
 137
 138   PROCEDURE (jf : JavaFile)Code*(code : INTEGER),NEW,ABSTRACT;
 139   PROCEDURE (jf : JavaFile)CodeI*(code,val : INTEGER),NEW,ABSTRACT;
 140   PROCEDURE (jf : JavaFile)CodeL*(code : INTEGER; num : LONGINT),NEW,ABSTRACT;
 141   PROCEDURE (jf : JavaFile)CodeC*(code : INTEGER;
 142                                   IN str : ARRAY OF CHAR),NEW,ABSTRACT;
 143   PROCEDURE (jf : JavaFile)CodeR*(code : INTEGER;
 144                                   num : REAL; short : BOOLEAN),NEW,ABSTRACT;
 145   PROCEDURE (jf : JavaFile)CodeLb*(code : INTEGER; lab : Label),NEW,ABSTRACT;
 146   PROCEDURE (jf : JavaFile)LstDef*(l : Label),NEW,EMPTY;
 147   PROCEDURE (jf : JavaFile)DefLab*(lab : Label),NEW,ABSTRACT;
 148   PROCEDURE (jf : JavaFile)DefLabC*(lab : Label;
 149                                     IN c : ARRAY OF CHAR),NEW,ABSTRACT;
 150   PROCEDURE (jf : JavaFile)CodeInc*(localIx,incVal : INTEGER),NEW,ABSTRACT;
 151   PROCEDURE (jf : JavaFile)CodeT*(code : INTEGER; ty : Sym.Type),NEW,ABSTRACT;
 152   PROCEDURE (jf : JavaFile)CodeSwitch*(low,high : INTEGER;
 153                                        defLab : Label),NEW,ABSTRACT;
 154
 155   PROCEDURE (jf : JavaFile)PushStr*(IN str : L.CharOpen),NEW,ABSTRACT;
 156   PROCEDURE (jf : JavaFile)LoadConst*(num : INTEGER),NEW,ABSTRACT;
 157
 158
 159   PROCEDURE (jf : JavaFile)CallGetClass*(),NEW,ABSTRACT;
 160   PROCEDURE (jf : JavaFile)CallRTS*(ix,args,ret : INTEGER),NEW,ABSTRACT;
 161   PROCEDURE (jf : JavaFile)CallIT*(code : INTEGER;
 162                                    proc : Id.Procs;
 163                                    type : Ty.Procedure),NEW,ABSTRACT;
 164
 165
 166   PROCEDURE (jf : JavaFile)ClinitHead*(),NEW,ABSTRACT;
 167   PROCEDURE (jf : JavaFile)MainHead*(),NEW,ABSTRACT;
 168   PROCEDURE (jf : JavaFile)VoidTail*(),NEW,ABSTRACT;
 169   PROCEDURE (jf : JavaFile)ModNoArgInit*(),NEW,ABSTRACT;
 170   PROCEDURE (jf : JavaFile)RecMakeInit*(rec : Ty.Record;
 171                                         prc : Id.PrcId),NEW,ABSTRACT;
 172   PROCEDURE (jf : JavaFile)CallSuperCtor*(rec : Ty.Record;
 173                                           pTy : Ty.Procedure),NEW,ABSTRACT;
 174   PROCEDURE (jf : JavaFile)CopyProcHead*(rec : Ty.Record),NEW,ABSTRACT;
 175   PROCEDURE (jf : JavaFile)ValRecCopy*(typ : Ty.Record),NEW,ABSTRACT;
 176
 177   PROCEDURE (jf : JavaFile)InitFields*(num : INTEGER),NEW,EMPTY;
 178   PROCEDURE (jf : JavaFile)InitMethods*(num : INTEGER),NEW,EMPTY;
 179
 180   PROCEDURE (jf : JavaFile)Try*(),NEW,ABSTRACT;
 181   PROCEDURE (jf : JavaFile)Catch*(prc : Id.Procs),NEW,ABSTRACT;
 182   PROCEDURE (jf : JavaFile)MkNewException*(),NEW,ABSTRACT;
 183   PROCEDURE (jf : JavaFile)InitException*(),NEW,ABSTRACT;
 184
 185   PROCEDURE (jf : JavaFile)Dump*(),NEW,ABSTRACT;
 186
 187 (* ============================================================ *)
 188
 189   PROCEDURE (jf : JavaFile)PutGetS*(code : INTEGER; (* static field *)
 190                                     blk  : Id.BlkId;
 191                                     fld  : Id.VarId),NEW,ABSTRACT;
 192
 193   PROCEDURE (jf : JavaFile)PutGetF*(code : INTEGER; (* instance field *)
 194                                     rec  : Ty.Record;
 195                                     fld  : Id.AbVar),NEW,ABSTRACT;
 196
 197 (* ============================================================ *)
 198
 199   PROCEDURE (jf : JavaFile)Alloc1d*(elTp : Sym.Type),NEW,ABSTRACT;
 200   PROCEDURE (jf : JavaFile)VarInit*(var : Sym.Idnt),NEW,ABSTRACT;
 201   PROCEDURE (jf : JavaFile)Trap*(IN str : ARRAY OF CHAR),NEW,ABSTRACT;
 202   PROCEDURE (jf : JavaFile)CaseTrap*(i : INTEGER),NEW,ABSTRACT;
 203   PROCEDURE (jf : JavaFile)WithTrap*(id : Sym.Idnt),NEW,ABSTRACT;
 204   PROCEDURE (jf : JavaFile)Line*(nm : INTEGER),NEW,ABSTRACT;
 205
 206 (* ============================================================ *)
 207 (*                      Some XHR utilities                      *)
 208 (* ============================================================ *)
 209
 210   PROCEDURE^ (jf : JavaFile)PutUplevel*(var : Id.LocId),NEW;
 211   PROCEDURE^ (jf : JavaFile)GetUplevel*(var : Id.LocId),NEW;
 212   PROCEDURE^ (jf : JavaFile)PushInt*(num : INTEGER),NEW;
 213   PROCEDURE^ (jf : JavaFile)PutElement*(typ : Sym.Type),NEW;
 214   PROCEDURE^ (jf : JavaFile)GetElement*(typ : Sym.Type),NEW;
 215   PROCEDURE^ (jf : JavaFile)ConvertDn*(inT, outT : Sym.Type),NEW;
 216
 217   PROCEDURE^ cat2*(i,j : L.CharOpen) : L.CharOpen;
 218   PROCEDURE^ MkRecName*(typ : Ty.Record);
 219   PROCEDURE^ MkProcName*(proc : Id.Procs);
 220   PROCEDURE^ NumberParams(pIdn : Id.Procs; pTyp : Ty.Procedure);
 221   PROCEDURE^ typeToChOpen(typ : Sym.Type) : L.CharOpen;
 222
 223
 224 (* ============================================================ *)
 225
 226   PROCEDURE xhrCount(tgt, ths : Id.Procs) : INTEGER;
 227     VAR count : INTEGER;
 228   BEGIN
 229     IF ths.lxDepth = 0 THEN RETURN 0 END;
 230    (*
 231     *  "ths" is the calling procedure.
 232     *  "tgt" is the procedure with the uplevel data.
 233     *)
 234     count := 0;
 235     REPEAT
 236       ths := ths.dfScp(Id.Procs);
 237       IF Id.hasXHR IN ths.pAttr THEN INC(count) END;
 238     UNTIL (ths.lxDepth = 0) OR
 239           ((ths.lxDepth <= tgt.lxDepth) & (Id.hasXHR  IN ths.pAttr));
 240     RETURN count;
 241   END xhrCount;
 242
 243   PROCEDURE newXHR() : L.CharOpen;
 244   BEGIN
 245     INC(xhrIx);
 246     RETURN cat2(xhrDl, L.intToCharOpen(xhrIx));
 247   END newXHR;
 248
 249   PROCEDURE MkXHR(scp : Id.Procs);
 250     VAR typId : Id.TypId;
 251         recTp : Ty.Record;
 252         index : INTEGER;
 253         locVr : Id.LocId;
 254         fldVr : Id.FldId;
 255   BEGIN
 256     Blt.MkDummyClass(newXHR(), Cst.thisMod, Ty.noAtt, typId);
 257     typId.SetMode(Sym.prvMode);
 258     scp.xhrType := typId.type;
 259     recTp := typId.type.boundRecTp()(Ty.Record);
 260     recTp.baseTp := Cst.rtsXHR.boundRecTp();
 261     INCL(recTp.xAttr, Sym.noCpy);
 262
 263     FOR index := 0 TO scp.locals.tide-1 DO
 264       locVr := scp.locals.a[index](Id.LocId);
 265       IF Id.uplevA IN locVr.locAtt THEN
 266         fldVr := Id.newFldId();
 267         fldVr.hash := locVr.hash;
 268         fldVr.type := locVr.type;
 269         fldVr.recTyp := recTp;
 270         Sym.AppendIdnt(recTp.fields, fldVr);
 271       END;
 272     END;
 273   END MkXHR;
 274
 275 (* ============================================================ *)
 276 (*                      Some vector utilities                   *)
 277 (* ============================================================ *)
 278
 279   PROCEDURE mapVecElTp(typ : Sym.Type) : INTEGER;
 280   BEGIN
 281     WITH typ : Ty.Base DO
 282       CASE typ.tpOrd OF
 283       | Ty.sChrN : RETURN Ty.charN;
 284       | Ty.boolN, Ty.byteN, Ty.sIntN, Ty.setN, Ty.uBytN : RETURN Ty.intN;
 285       | Ty.charN, Ty.intN, Ty.lIntN, Ty.sReaN, Ty.realN : RETURN typ.tpOrd;
 286       ELSE RETURN Ty.anyPtr;
 287       END;
 288     ELSE RETURN Ty.anyPtr;
 289     END;
 290   END mapVecElTp;
 291
 292   PROCEDURE mapOrdRepT(ord : INTEGER) : Sym.Type;
 293   BEGIN
 294     CASE ord OF
 295     | Ty.charN  : RETURN Blt.charTp;
 296     | Ty.intN   : RETURN Blt.intTp;
 297     | Ty.lIntN  : RETURN Blt.lIntTp;
 298     | Ty.sReaN  : RETURN Blt.sReaTp;
 299     | Ty.realN  : RETURN Blt.realTp;
 300     | Ty.anyPtr : RETURN Blt.anyPtr;
 301     END;
 302   END mapOrdRepT;
 303
 304 (* ------------------------------------------------------------ *)
 305
 306   PROCEDURE InitVecDescriptors;
 307     VAR i : INTEGER;
 308   BEGIN
 309     vecBlkId := NIL;
 310     vecBase  := NIL;
 311     vecTide  := NIL;
 312     FOR i := 0 TO Ty.anyPtr DO
 313       vecTypes[i] := NIL;
 314       vecElms[i]  := NIL;
 315       vecExpnd[i] := NIL;
 316     END;
 317   END InitVecDescriptors;
 318
 319   PROCEDURE vecModId() : Id.BlkId;
 320   BEGIN
 321     IF vecBlkId = NIL THEN
 322       Blt.MkDummyImport("$CPJvec$", "CP.CPJvec", vecBlkId);
 323       Blt.MkDummyClass("VecBase", vecBlkId, Ty.noAtt, vecBase);
 324      (*
 325       *  Initialize vecTide while we are at it ...
 326       *)
 327       vecTide := Id.newFldId();
 328       vecTide.hash := Hsh.enterStr("tide");
 329       vecTide.dfScp := vecBlkId;
 330       vecTide.recTyp := vecBase.type.boundRecTp();
 331       vecTide.type := Blt.intTp;
 332       MkRecName(vecTide.recTyp(Ty.Record));
 333     END;
 334     RETURN vecBlkId;
 335   END vecModId;
 336
 337   PROCEDURE vecClsTyId(ord : INTEGER) : Id.TypId;
 338     VAR str : ARRAY 8 OF CHAR;
 339         tId : Id.TypId;
 340         rcT : Ty.Record;
 341   BEGIN
 342     IF vecTypes[ord] = NIL THEN
 343       CASE ord OF
 344       | Ty.charN  : str := "VecChr";
 345       | Ty.intN   : str := "VecI32";
 346       | Ty.lIntN  : str := "VecI64";
 347       | Ty.sReaN  : str := "VecR32";
 348       | Ty.realN  : str := "VecR64";
 349       | Ty.anyPtr : str := "VecRef";
 350       END;
 351       Blt.MkDummyClass(str, vecModId(), Ty.noAtt, tId);
 352       rcT := tId.type.boundRecTp()(Ty.Record);
 353       rcT.baseTp := vecTide.recTyp;
 354       vecTypes[ord] := tId;
 355     END;
 356     RETURN vecTypes[ord];
 357   END vecClsTyId;
 358
 359   PROCEDURE vecRecTyp(ord : INTEGER) : Ty.Record;
 360   BEGIN
 361     RETURN vecClsTyId(ord).type.boundRecTp()(Ty.Record);
 362   END vecRecTyp;
 363
 364   PROCEDURE vecArrFlId(ord : INTEGER) : Id.FldId;
 365     VAR fld : Id.FldId;
 366   BEGIN
 367     IF vecElms[ord] = NIL THEN
 368       fld := Id.newFldId();
 369       fld.hash := Hsh.enterStr("elms");
 370       fld.dfScp := vecModId();
 371       fld.recTyp := vecRecTyp(ord);
 372       fld.type := Ty.mkArrayOf(mapOrdRepT(ord));
 373       vecElms[ord] := fld;
 374     END;
 375     RETURN vecElms[ord];
 376   END vecArrFlId;
 377
 378 (* ------------------------------------------------------------ *)
 379
 380   PROCEDURE (jf : JavaFile)MkVecRec*(eTp : Sym.Type),NEW;
 381     VAR ord : INTEGER;
 382   BEGIN
 383     ord := mapVecElTp(eTp);
 384     jf.MkNewRecord(vecRecTyp(ord));
 385   END MkVecRec;
 386
 387 (* ------------------------------- *)
 388
 389   PROCEDURE (jf : JavaFile)MkVecArr*(eTp : Sym.Type),NEW;
 390     VAR ord : INTEGER;
 391         vTp : Sym.Type;
 392   BEGIN
 393     ord := mapVecElTp(eTp);
 394     jf.Alloc1d(mapOrdRepT(ord));
 395     jf.PutGetF(Jvm.opc_putfield, vecRecTyp(ord), vecArrFlId(ord));
 396   END MkVecArr;
 397
 398 (* ------------------------------------------------------------ *)
 399
 400   PROCEDURE (jf : JavaFile)GetVecArr*(eTp : Sym.Type),NEW;
 401     VAR ord : INTEGER;
 402         fId : Id.FldId;
 403   BEGIN
 404     ord := mapVecElTp(eTp);
 405     fId := vecArrFlId(ord);
 406     jf.PutGetF(Jvm.opc_getfield, fId.recTyp(Ty.Record), fId);
 407   END GetVecArr;
 408
 409 (* ------------------------------- *)
 410
 411   PROCEDURE (jf : JavaFile)GetVecLen*(),NEW;
 412   BEGIN
 413     jf.PutGetF(Jvm.opc_getfield, vecTide.recTyp(Ty.Record), vecTide);
 414   END GetVecLen;
 415
 416 (* ------------------------------- *)
 417
 418   PROCEDURE (jf : JavaFile)PutVecLen*(),NEW;
 419   BEGIN
 420     jf.PutGetF(Jvm.opc_putfield, vecTide.recTyp(Ty.Record), vecTide);
 421   END PutVecLen;
 422
 423 (* ------------------------------- *)
 424
 425   PROCEDURE (jf : JavaFile)InvokeExpand*(eTp : Sym.Type),NEW;
 426     VAR ord : INTEGER;
 427         mth : Id.MthId;
 428         typ : Ty.Procedure;
 429   BEGIN
 430     ord := mapVecElTp(eTp);
 431     IF vecExpnd[ord] = NIL THEN
 432       mth := Id.newMthId();
 433       mth.hash := Blt.xpndBk;
 434       mth.dfScp := vecModId();
 435       typ := Ty.newPrcTp();
 436       typ.idnt := mth;
 437       typ.receiver := vecClsTyId(ord).type;
 438       mth.bndType  := typ.receiver.boundRecTp();
 439       MkProcName(mth);
 440       NumberParams(mth, typ);
 441       mth.type := typ;
 442       vecExpnd[ord] := mth;
 443     ELSE
 444       mth := vecExpnd[ord];
 445       typ := mth.type(Ty.Procedure);
 446     END;
 447     jf.CallIT(Jvm.opc_invokevirtual, mth, typ);
 448   END InvokeExpand;
 449
 450 (* ------------------------------- *)
 451
 452   PROCEDURE (jf : JavaFile)PutVecElement*(eTp : Sym.Type),NEW;
 453   BEGIN
 454     jf.PutElement(mapOrdRepT(mapVecElTp(eTp)));
 455   END PutVecElement;
 456
 457 (* ------------------------------- *)
 458
 459   PROCEDURE (jf : JavaFile)GetVecElement*(eTp : Sym.Type),NEW;
 460     VAR rTp : Sym.Type; (* representation type *)
 461   BEGIN
 462     rTp := mapOrdRepT(mapVecElTp(eTp));
 463    (*
 464     *  If rTp and eTp are not equal, then must restore erased type
 465     *)
 466     jf.GetElement(rTp);
 467     IF rTp # eTp THEN
 468       IF rTp = Blt.anyPtr THEN
 469         jf.CodeT(Jvm.opc_checkcast, eTp);
 470       ELSE
 471         jf.ConvertDn(rTp, eTp);
 472       END;
 473     END;
 474   END GetVecElement;
 475
 476 (* ============================================================ *)
 477 (*                     Some static utilities                    *)
 478 (* ============================================================ *)
 479
 480   PROCEDURE jvmSize*(t : Sym.Type) : INTEGER;
 481   BEGIN
 482     IF t.isLongType() THEN RETURN 2 ELSE RETURN 1 END;
 483   END jvmSize;
 484
 485 (* ------------------------------------------------------------ *)
 486
 487   PROCEDURE newAnonLit() : L.CharOpen;
 488   BEGIN
 489     INC(ptvIx);
 490     RETURN cat2(procLitPrefix, L.intToCharOpen(ptvIx));
 491   END newAnonLit;
 492
 493 (* ------------------------------------------------------------ *)
 494
 495   PROCEDURE needsBox*(i : Id.ParId) : BOOLEAN;
 496   (*   A parameter needs to be boxed if it has non-reference    *)
 497   (*   representation in the JVM, and is OUT or VAR mode.       *)
 498   BEGIN
 499     RETURN ((i.parMod = Sym.var) OR (i.parMod = Sym.out)) &
 500            i.type.isScalarType();
 501   END needsBox;
 502
 503 (* ============================================================ *)
 504
 505   PROCEDURE cat2*(i,j : L.CharOpen) : L.CharOpen;
 506   BEGIN
 507     L.ResetCharOpenSeq(nmArray);
 508     L.AppendCharOpen(nmArray, i);
 509     L.AppendCharOpen(nmArray, j);
 510     RETURN L.arrayCat(nmArray);
 511   END cat2;
 512
 513   PROCEDURE cat3*(i,j,k : L.CharOpen) : L.CharOpen;
 514   BEGIN
 515     L.ResetCharOpenSeq(nmArray);
 516     L.AppendCharOpen(nmArray, i);
 517     L.AppendCharOpen(nmArray, j);
 518     L.AppendCharOpen(nmArray, k);
 519     RETURN L.arrayCat(nmArray);
 520   END cat3;
 521
 522 (* ------------------------------------------------------------ *)
 523
 524   PROCEDURE MkBlkName*(mod : Id.BlkId);
 525     VAR mNm : L.CharOpen;
 526   (* -------------------------------------------------- *)
 527     PROCEDURE dotToSlash(arr : L.CharOpen) : L.CharOpen;
 528       VAR ix : INTEGER;
 529     BEGIN
 530       FOR ix := 0 TO LEN(arr)-1 DO
 531         IF arr[ix] = "." THEN arr[ix] := "/" END;
 532       END;
 533       RETURN arr;
 534     END dotToSlash;
 535   (* -------------------------------------------------- *)
 536   BEGIN
 537     IF mod.xName # NIL THEN RETURN END;
 538     mNm := Sym.getName.ChPtr(mod);
 539     IF mod.scopeNm # NIL THEN
 540       mod.scopeNm := dotToSlash(mod.scopeNm);
 541     ELSE
 542       mod.scopeNm := cat3(prfx, slsh, mNm); (* "CP/<modname>" *)
 543     END;
 544     IF ~Cst.doCode         (* Only doing Jasmin output       *)
 545         OR Cst.doJsmn      (* Forcing assembly via Jasmin    *)
 546         OR (mod.scopeNm[0] = 0X) (* Explicitly forcing no package! *) THEN
 547       mod.xName   := mNm;
 548     ELSE (* default case *)
 549       mod.xName := cat3(mod.scopeNm, slsh, mNm);
 550     END;
 551   END MkBlkName;
 552
 553 (* ------------------------------------------------------------ *)
 554
 555   PROCEDURE scopeName(scp : Sym.Scope) : L.CharOpen;
 556   BEGIN
 557     WITH scp : Id.BlkId DO
 558         IF scp.xName = NIL THEN MkBlkName(scp) END;
 559         IF Cst.doCode & ~Cst.doJsmn THEN
 560           RETURN Sym.getName.ChPtr(scp);
 561         ELSE
 562           RETURN scp.xName;
 563         END;
 564     | scp : Id.Procs DO
 565         IF scp.prcNm = NIL THEN MkProcName(scp) END;
 566         RETURN scp.prcNm;
 567     END;
 568   END scopeName;
 569
 570 (* ------------------------------------------------------------ *)
 571
 572   PROCEDURE qualScopeName(scp : Sym.Scope) : L.CharOpen;
 573   BEGIN
 574     WITH scp : Id.BlkId DO
 575       IF scp.xName = NIL THEN MkBlkName(scp) END;
 576       RETURN scp.scopeNm;
 577     | scp : Id.Procs DO
 578       IF scp.prcNm = NIL THEN MkProcName(scp) END;
 579       RETURN scp.scopeNm;
 580     END;
 581   END qualScopeName;
 582
 583 (* ------------------------------------------------------------ *)
 584   PROCEDURE newMthId*(IN name : ARRAY OF CHAR; dfScp : Id.BlkId; bndTp : Sym.Type) : Id.MthId;
 585     VAR rslt : Id.MthId;
 586   BEGIN
 587     rslt := Id.newMthId();
 588         rslt.SetKind(Id.conMth);
 589         rslt.hash := Hsh.enterStr(name);
 590         rslt.dfScp := dfScp;
 591         rslt.bndType := bndTp;
 592         rslt.rcvFrm := Id.newParId();
 593         rslt.rcvFrm.type := bndTp;
 594         IF bndTp IS Ty.Record THEN rslt.rcvFrm.parMod := Sym.var END;
 595     RETURN rslt;
 596   END newMthId;
 597
 598 (* ------------------------------------------------------------ *)
 599 (* Generate all naming strings for this record type, and put    *)
 600 (* a corresponding emitter record on the work list.             *)
 601 (* ------------------------------------------------------------ *)
 602   PROCEDURE MkRecName*(typ : Ty.Record);
 603     VAR mNm : L.CharOpen;
 604         qNm : L.CharOpen;
 605         rNm : L.CharOpen;
 606         tId : Sym.Idnt;
 607   BEGIN
 608    (* ###################################### *)
 609     IF typ.xName # NIL THEN RETURN END;
 610    (* ###################################### *)
 611     IF typ.bindTp # NIL THEN            (* Synthetically named rec'd *)
 612       tId := typ.bindTp.idnt;
 613     ELSE                                (* Normal, named record type *)
 614       IF typ.idnt = NIL THEN            (* Anonymous record type     *)
 615         typ.idnt := Id.newAnonId(typ.serial);
 616       END;
 617       tId := typ.idnt;
 618     END;
 619     IF tId.dfScp = NIL THEN tId.dfScp := Cst.thisMod END;
 620     rNm := Sym.getName.ChPtr(tId);
 621     mNm := scopeName(tId.dfScp);
 622     qNm := qualScopeName(tId.dfScp);
 623    (*
 624     *  At this point:
 625     *       rNm holds the simple record name
 626     *       mNm holds the qualifying module name
 627     *       qNm holds the qualifying scope name
 628     *       If extrnNm = NIL, the default mangling is used.
 629     *  At exit we want:
 630     *       xName to hold the fully qualified name
 631     *       extrnNm to hold the simple name
 632     *       scopeNm to hold the "L<qualid>;" name
 633     *)
 634     IF typ.extrnNm # NIL THEN
 635       typ.extrnNm := rNm;
 636     ELSE
 637       typ.extrnNm := cat3(mNm, lowL, rNm);
 638     END;
 639     IF qNm[0] # 0X THEN
 640       typ.xName := cat3(qNm, slsh, typ.extrnNm);
 641     ELSE
 642       typ.xName := typ.extrnNm;
 643     END;
 644     typ.scopeNm := cat3(lCap, typ.xName, semi);
 645    (*
 646     *   It is at this point that we link records into the
 647     *   class-emission worklist.
 648     *)
 649     IF tId.dfScp.kind # Id.impId THEN
 650       JavaBase.worklist.AddNewRecEmitter(typ);
 651     END;
 652   END MkRecName;
 653
 654 (* ============================================================ *)
 655 (*               Some Procedure Variable utilities              *)
 656 (* ============================================================ *)
 657
 658   PROCEDURE getProcWrapperInvoke*(typ : Ty.Record) : Id.MthId;
 659     VAR idnt : Sym.Idnt;
 660   BEGIN
 661    (*  We could get the method descriptor more cheaply by
 662     *  indexing into the symbol table, but this would be
 663         *  very fragile against future code changes.
 664         *)
 665     idnt := typ.symTb.lookup(invokeHash);
 666         RETURN idnt(Id.MthId);
 667   END getProcWrapperInvoke;
 668
 669   PROCEDURE getProcVarInvoke*(typ : Ty.Procedure) : Id.MthId;
 670   BEGIN
 671     IF (typ = NIL) OR (typ.hostClass = NIL) THEN RETURN NIL;
 672         ELSE RETURN getProcWrapperInvoke(typ.hostClass);
 673         END;
 674   END getProcVarInvoke;
 675
 676 (* ------------------------------------------------------------ *)
 677
 678  (*
 679   *  Copy the formals from the template procedure type descriptor
 680   *  to the type descriptor for the method 'scp'.  Change the
 681   *  dfScp of the params (and receiver) to be local to scp.
 682   *  Also, in the case of methods imported without parameter
 683   *  names, generate synthetic names for the formals.
 684   *)
 685   PROCEDURE RescopeFormals(template : Ty.Procedure; scp : Id.MthId);
 686         VAR param : Id.ParId;
 687             index : INTEGER;
 688                 synthH : INTEGER;
 689                 newTyp : Ty.Procedure;
 690   BEGIN
 691         newTyp := scp.type(Ty.Procedure);
 692         newTyp.retType := template.retType;
 693         FOR index := 0 TO template.formals.tide -1 DO
 694           param := Id.cloneParInScope(template.formals.a[index], scp);
 695           IF param.hash = 0 THEN
 696             synthH := Hsh.enterStr("p" + L.intToCharOpen(index)^);
 697                 template.formals.a[index].hash := synthH;
 698                 param.hash := synthH;
 699           END;
 700       IF ~Sym.refused(param, scp) THEN
 701             Id.AppendParam(newTyp.formals, param);
 702             Sym.AppendIdnt(scp.locals, param);
 703       END;
 704         END;
 705   END RescopeFormals;
 706
 707 (* ------------------------------------------------------------ *)
 708 (* Generate all naming strings for this procedure type, and     *)
 709 (* put a corresponding emitter record on the work list.         *)
 710 (* ------------------------------------------------------------ *)
 711   PROCEDURE MkProcTypeName*(typ : Ty.Procedure);
 712     VAR tIdent : Sym.Idnt;
 713             hostTp : Ty.Record;
 714                 (*invoke : Id.MthId;*)
 715             rNm, mNm, qNm : L.CharOpen;
 716   BEGIN
 717    (* ###################################### *)
 718     IF typ.xName # NIL THEN RETURN END;
 719    (* ###################################### *)
 720     IF typ.idnt = NIL THEN              (* Anonymous procedure type *)
 721       typ.idnt := Id.newAnonId(typ.serial);
 722       typ.idnt.type := typ;
 723     END;
 724         tIdent := typ.idnt;
 725     IF tIdent.dfScp = NIL THEN tIdent.dfScp := Cst.thisMod END;
 726         NEW(hostTp);
 727         rNm := Sym.getName.ChPtr(tIdent);
 728         mNm := scopeName(tIdent.dfScp);
 729         qNm := qualScopeName(tIdent.dfScp);
 730    (*
 731     *  At this point:
 732     *       rNm holds the simple record name
 733     *       mNm holds the qualifying module name
 734     *       qNm holds the qualifying scope name
 735     *  At exit we want:
 736     *       xName to hold the fully qualified name
 737     *)
 738         hostTp.extrnNm := cat3(mNm, lowL, rNm);
 739     hostTp.xName := cat3(qNm, slsh, hostTp.extrnNm);
 740     hostTp.scopeNm := cat3(lCap, hostTp.xName, semi);
 741         typ.hostClass := hostTp;
 742         Blt.MkDummyMethodAndInsert("Invoke", Ty.newPrcTp(), hostTp, Cst.thisMod, Sym.pubMode, Sym.var, Id.isAbs);
 743         RescopeFormals(typ, getProcVarInvoke(typ));
 744         typ.xName := hostTp.xName;
 745    (*
 746     *   It is at this point that we link records into the
 747     *   class-emission worklist.
 748     *)
 749         IF tIdent.dfScp.kind # Id.impId THEN
 750           JavaBase.worklist.AddNewProcTypeEmitter(typ);
 751         END;
 752   END MkProcTypeName;
 753
 754 (* ------------------------------------------------------------ *)
 755 (*  Generate the body statement sequence for the proc-type      *)
 756 (*  wrapper class to invoke the encapsulated procedure literal. *)
 757 (* ------------------------------------------------------------ *)
 758   PROCEDURE procLitBodyStatement(targetId : Sym.Idnt; thisMth : Id.MthId) : Sym.Stmt;
 759     VAR text  : L.CharOpenSeq;
 760             mthTp : Ty.Procedure;
 761             param : Id.ParId;
 762             index : INTEGER;
 763    (* ###################################### *)
 764         PROCEDURE textName(trgt : Sym.Idnt) : L.CharOpen;
 765           VAR simple : L.CharOpen;
 766         BEGIN
 767           simple := trgt.name();
 768           IF trgt.dfScp = Cst.thisMod THEN
 769             RETURN simple;
 770           ELSE
 771             RETURN BOX(trgt.dfScp.name()^ + '.' + simple^);
 772           END;
 773         END textName;
 774    (* ###################################### *)
 775  BEGIN
 776     mthTp := thisMth.type(Ty.Procedure);
 777     IF mthTp.retType # NIL THEN L.AppendCharOpen(text, BOX("RETURN ")) END;
 778         L.AppendCharOpen(text, textName(targetId));
 779         L.AppendCharOpen(text, lPar);
 780     FOR index := 0 TO mthTp.formals.tide - 1 DO
 781           IF index # 0 THEN L.AppendCharOpen(text, comma) END;
 782           param := mthTp.formals.a[index];
 783           L.AppendCharOpen(text, param.name());
 784         END;
 785         L.AppendCharOpen(text, rPar);
 786         L.AppendCharOpen(text, BOX("END"));
 787         RETURN Psr.parseTextAsStatement(text.a, thisMth);
 788   END procLitBodyStatement;
 789
 790 (* ------------------------------------------------------------ *)
 791 (*  Every value of procedure type is represented by a singleton *)
 792 (*  class derived from the abstract host type of the proc-type. *)
 793 (* ------------------------------------------------------------ *)
 794   PROCEDURE newProcLitWrapperClass(exp : Sym.Expr; typ : Ty.Procedure) : Ty.Record;
 795     VAR singleton : Id.TypId;
 796             hostClass : Ty.Record;
 797                 newInvoke : Id.MthId;
 798   BEGIN
 799     ASSERT(exp IS Xp.IdLeaf);
 800         Blt.MkDummyClass(newAnonLit(), Cst.thisMod, Ty.noAtt, singleton);
 801         hostClass := singleton.type.boundRecTp()(Ty.Record);
 802         Blt.MkDummyMethodAndInsert("Invoke", Ty.newPrcTp(), hostClass, Cst.thisMod, Sym.pubMode, Sym.var, {});
 803         MkRecName(hostClass); (* Add this class to the emission work-list *)
 804         newInvoke := getProcWrapperInvoke(hostClass);
 805         RescopeFormals(typ, newInvoke);
 806         newInvoke.body := procLitBodyStatement(exp(Xp.IdLeaf).ident, newInvoke);
 807         RETURN hostClass;
 808   END newProcLitWrapperClass;
 809
 810 (* ------------------------------------------------------------ *)
 811 (* ------------------------------------------------------------ *)
 812
 813   PROCEDURE MkVecName*(typ : Ty.Vector);
 814     VAR ord : INTEGER;
 815         rTp : Ty.Record;
 816   BEGIN
 817     ord := mapVecElTp(typ.elemTp);
 818     rTp := vecRecTyp(ord);
 819     IF rTp.xName = NIL THEN MkRecName(rTp) END;
 820     typ.xName := rTp.scopeNm;
 821   END MkVecName;
 822
 823 (* ------------------------------------------------------------ *)
 824
 825   PROCEDURE MkProcName*(proc : Id.Procs);
 826     VAR pNm : L.CharOpen;
 827         res : Id.Procs;
 828         scp : Sym.Scope;
 829         bTp : Ty.Record;
 830   (* -------------------------------------------------- *)
 831     PROCEDURE clsNmFromRec(typ : Sym.Type) : L.CharOpen;
 832     BEGIN
 833       IF Cst.doCode & ~Cst.doJsmn THEN
 834         RETURN typ(Ty.Record).xName;
 835       ELSE
 836         RETURN typ(Ty.Record).extrnNm;
 837       END;
 838     END clsNmFromRec;
 839   (* -------------------------------------------------- *)
 840     PROCEDURE className(p : Id.Procs) : L.CharOpen;
 841     BEGIN
 842       WITH p : Id.PrcId DO RETURN p.clsNm;
 843       |    p : Id.MthId DO RETURN clsNmFromRec(p.bndType);
 844       END;
 845     END className;
 846   (* -------------------------------------------------- *)
 847     PROCEDURE GetClassName(pr : Id.PrcId; bl : Id.BlkId);
 848       VAR nm : L.CharOpen;
 849     BEGIN
 850       nm := Sym.getName.ChPtr(pr);
 851       IF pr.bndType = NIL THEN  (* normal case  *)
 852         pr.clsNm := bl.xName;
 853         IF pr.prcNm = NIL THEN pr.prcNm := nm END;
 854       ELSE                      (* static method *)
 855         IF pr.bndType.xName = NIL THEN MkRecName(pr.bndType(Ty.Record)) END;
 856         pr.clsNm := clsNmFromRec(pr.bndType);
 857         IF pr.prcNm = NIL THEN
 858           pr.prcNm := nm;
 859         ELSIF pr.prcNm^ = initStr THEN
 860           pr.SetKind(Id.ctorP);
 861         END;
 862       END;
 863     END GetClassName;
 864   (* -------------------------------------------------- *)
 865     PROCEDURE MkPrcNm(prc : Id.PrcId);
 866       VAR res : Id.PrcId;
 867           scp : Sym.Scope;
 868           blk : Id.BlkId;
 869           rTp : Ty.Record;
 870     BEGIN
 871       IF prc.scopeNm # NIL THEN RETURN;
 872       ELSIF prc.kind = Id.fwdPrc THEN
 873         res := prc.resolve(Id.PrcId); MkPrcNm(res);
 874         prc.prcNm := res.prcNm;
 875         prc.clsNm := res.clsNm;
 876         prc.scopeNm := res.scopeNm;
 877       ELSIF prc.kind = Id.conPrc THEN
 878         scp := prc.dfScp;
 879         WITH scp : Id.BlkId DO
 880             IF scp.xName = NIL THEN MkBlkName(scp) END;
 881             IF  Sym.isFn IN scp.xAttr THEN
 882               GetClassName(prc, scp);
 883             ELSE
 884               prc.clsNm := scp.xName;
 885               IF prc.prcNm = NIL THEN prc.prcNm := Sym.getName.ChPtr(prc) END;
 886             END;
 887         | scp : Id.Procs DO
 888             MkProcName(scp);
 889             prc.clsNm := className(scp);
 890             prc.prcNm   := cat3(Sym.getName.ChPtr(prc), dlar, scp.prcNm);
 891         END;
 892         prc.scopeNm := scp.scopeNm;
 893       ELSE (* prc.kind = Id.ctorP *)
 894         blk := prc.dfScp(Id.BlkId);
 895         rTp := prc.type.returnType().boundRecTp()(Ty.Record);
 896         IF blk.xName = NIL THEN MkBlkName(blk) END;
 897         IF rTp.xName = NIL THEN MkRecName(rTp) END;
 898         prc.clsNm := clsNmFromRec(rTp);
 899         prc.prcNm := L.strToCharOpen(initStr);
 900         prc.scopeNm := blk.scopeNm;
 901       END;
 902     END MkPrcNm;
 903   (* -------------------------------------------------- *)
 904     PROCEDURE MkMthNm(mth : Id.MthId);
 905       VAR res : Id.MthId;
 906           scp : Id.BlkId;
 907           typ : Sym.Type;
 908     BEGIN
 909       IF mth.scopeNm # NIL THEN RETURN;
 910       ELSIF mth.kind = Id.fwdMth THEN
 911         res := mth.resolve(Id.MthId); MkMthNm(res);
 912         mth.prcNm := res.prcNm; mth.scopeNm := res.scopeNm;
 913       ELSE
 914         scp := mth.dfScp(Id.BlkId);
 915         typ := mth.bndType;
 916         IF typ.xName = NIL THEN MkRecName(typ(Ty.Record)) END;
 917         IF scp.xName = NIL THEN MkBlkName(scp) END;
 918
 919         mth.scopeNm := scp.scopeNm;
 920         IF mth.prcNm = NIL THEN mth.prcNm := Sym.getName.ChPtr(mth) END;
 921       END;
 922     END MkMthNm;
 923   (* -------------------------------------------------- *)
 924   BEGIN (* MkProcName *)
 925     WITH proc : Id.MthId DO MkMthNm(proc);
 926     |    proc : Id.PrcId DO MkPrcNm(proc);
 927     END;
 928   END MkProcName;
 929
 930 (* ------------------------------------------------------------ *)
 931
 932   PROCEDURE MkAliasName*(typ : Ty.Opaque);
 933     VAR mNm : L.CharOpen;
 934         rNm : L.CharOpen;
 935         sNm : L.CharOpen;
 936   BEGIN
 937    (*
 938     * This was almost certainly broken,
 939     * at least for foreign explicit names
 940     *)
 941     IF typ.xName # NIL THEN RETURN END;
 942     rNm := Sym.getName.ChPtr(typ.idnt);
 943    (*
 944     * old code --
 945     *  mNm := scopeName(typ.idnt.dfScp);
 946     *  sNm := cat3(mNm, lowL, rNm);
 947     *  typ.xName   := cat3(qualScopeName(typ.idnt.dfScp), slsh, sNm);
 948     *
 949     * replaced by ...
 950     *)
 951     typ.xName   := cat3(qualScopeName(typ.idnt.dfScp), slsh, rNm);
 952    (* end *)
 953     typ.scopeNm := cat3(lCap, typ.xName, semi);
 954   END MkAliasName;
 955
 956 (* ------------------------------------------------------------ *)
 957
 958   PROCEDURE MkVarName*(var : Id.VarId);
 959     VAR mod : Id.BlkId;
 960   BEGIN
 961     IF var.varNm # NIL THEN RETURN END;
 962     mod := var.dfScp(Id.BlkId);
 963     var.varNm := Sym.getName.ChPtr(var);
 964     IF var.recTyp = NIL THEN    (* normal case *)
 965       var.clsNm := mod.xName;
 966     ELSE                        (* static field *)
 967       IF var.recTyp.xName = NIL THEN MkRecName(var.recTyp(Ty.Record)) END;
 968       var.clsNm := var.recTyp(Ty.Record).extrnNm;
 969     END;
 970   END MkVarName;
 971
 972 (* ------------------------------------------------------------ *)
 973
 974   PROCEDURE NumberParams(pIdn : Id.Procs; pTyp : Ty.Procedure);
 975     VAR parId : Id.ParId;
 976         index : INTEGER;
 977         count : INTEGER;
 978         retTp : Sym.Type;
 979    (* ----------------------------------------- *)
 980     PROCEDURE AppendTypeName(VAR lst : L.CharOpenSeq; typ : Sym.Type);
 981     BEGIN
 982       WITH typ : Ty.Base DO
 983           L.AppendCharOpen(lst, typ.xName);
 984       | typ : Ty.Vector DO
 985           IF typ.xName = NIL THEN MkVecName(typ) END;
 986           L.AppendCharOpen(lst, typ.xName);
 987       | typ : Ty.Array DO
 988           L.AppendCharOpen(lst, brac);
 989           AppendTypeName(lst, typ.elemTp);
 990       | typ : Ty.Record DO
 991           IF typ.xName = NIL THEN MkRecName(typ) END;
 992           L.AppendCharOpen(lst, typ.scopeNm);
 993       | typ : Ty.Enum DO
 994           AppendTypeName(lst, Blt.intTp);
 995       | typ : Ty.Pointer DO
 996           AppendTypeName(lst, typ.boundTp);
 997       | typ : Ty.Opaque DO
 998           IF typ.xName = NIL THEN MkAliasName(typ) END;
 999           L.AppendCharOpen(lst, typ.scopeNm);
1000       | typ : Ty.Procedure DO
1001           IF typ.xName = NIL THEN MkProcTypeName(typ) END;
1002           L.AppendCharOpen(lst, typ.hostClass.scopeNm);
1003       END;
1004     END AppendTypeName;
1005    (* ----------------------------------------- *)
1006   BEGIN
1007    (*
1008     *  The parameter numbering scheme tries to use the return
1009     *  value for the first OUT or VAR parameter.  The variable
1010     *  'hasRt' notes whether this possiblity has been used up. If
1011     *  this is a value returning function hasRt is true at entry.
1012     *)
1013     count := pIdn.rtsFram;
1014     retTp := pTyp.retType;
1015     IF pIdn.kind = Id.ctorP THEN
1016       INC(count);
1017     ELSIF retTp # NIL THEN      (* and not a constructor... *)
1018       pTyp.retN := jvmSize(pTyp.retType);
1019     END;
1020     L.ResetCharOpenSeq(fmArray);
1021     L.AppendCharOpen(fmArray, lPar);
1022     IF pIdn.lxDepth > 0 THEN
1023       L.AppendCharOpen(fmArray, xhrMk); INC(count);
1024     END;
1025     FOR index := 0 TO pTyp.formals.tide-1 DO
1026       parId := pTyp.formals.a[index];
1027       IF needsBox(parId) THEN
1028         IF parId.parMod = Sym.var THEN (* pass value as well *)
1029           parId.varOrd := count;
1030           INC(count, jvmSize(parId.type));
1031           AppendTypeName(fmArray, parId.type);
1032         END;
1033         IF retTp = NIL THEN
1034          (*
1035           *  Return slot is not already used, use it now.
1036           *)
1037           parId.boxOrd := retMarker;
1038           pTyp.retN := jvmSize(parId.type);
1039           retTp := parId.type;
1040         ELSE
1041          (*
1042           *  Return slot is already used, use a boxed variable.
1043           *)
1044           parId.boxOrd := count;
1045           INC(count);
1046           L.AppendCharOpen(fmArray, brac);
1047           AppendTypeName(fmArray, parId.type);
1048         END;
1049       ELSE  (* could be two slots ... *)
1050         parId.varOrd := count;
1051         INC(count, jvmSize(parId.type));
1052         AppendTypeName(fmArray, parId.type);
1053       END;
1054     END;
1055     L.AppendCharOpen(fmArray, rPar);
1056     IF (retTp = NIL) OR (pIdn.kind = Id.ctorP) THEN
1057       L.AppendCharOpen(fmArray, void);
1058     ELSIF (pIdn IS Id.MthId) & (Id.covar IN pIdn(Id.MthId).mthAtt) THEN
1059      (*
1060       *  This is a method with a covariant return type. We must
1061       *  erase the declared type, substituting the non-covariant
1062       *  upper-bound. Calls will cast the result to the real type.
1063       *)
1064       AppendTypeName(fmArray, pIdn.retTypBound());
1065     ELSE
1066       AppendTypeName(fmArray, retTp);
1067     END;
1068     pTyp.xName := L.arrayCat(fmArray);
1069    (*
1070     *   We must now set the argsize and retsize.
1071     *   The current info.lNum (before the locals
1072     *   have been added) is the argsize.
1073     *)
1074     pTyp.argN := count;
1075     pIdn.rtsFram := count;
1076   END NumberParams;
1077
1078 (* ------------------------------------------------------------ *)
1079 (* Proxies are the local variables corresponding to boxed       *)
1080 (* arguments that are not also passed by value i.e. OUT mode.   *)
1081 (* ------------------------------------------------------------ *)
1082   PROCEDURE NumberProxies(pIdn : Id.Procs; IN pars : Id.ParSeq);
1083     VAR parId : Id.ParId;
1084         index : INTEGER;
1085   BEGIN
1086    (* ------------------ *
1087     *  Allocate an activation record slot for the XHR,
1088     *  if this is needed.  The XHR reference will be local
1089     *  number pIdn.type.argN.
1090     * ------------------ *)
1091     IF Id.hasXHR IN pIdn.pAttr THEN MkXHR(pIdn); INC(pIdn.rtsFram) END;
1092     FOR index := 0 TO pars.tide-1 DO
1093       parId := pars.a[index];
1094       IF parId.parMod # Sym.var THEN
1095         IF needsBox(parId) THEN
1096           parId.varOrd := pIdn.rtsFram;
1097           INC(pIdn.rtsFram, jvmSize(parId.type));
1098         END;
1099       END;
1100     END;
1101   END NumberProxies;
1102
1103 (* ------------------------------------------------------------ *)
1104
1105   PROCEDURE NumberLocals(pIdn : Id.Procs; IN locs : Sym.IdSeq);
1106     VAR ident : Sym.Idnt;
1107         index : INTEGER;
1108         count : INTEGER;
1109   BEGIN
1110     count := pIdn.rtsFram;
1111     FOR index := 0 TO locs.tide-1 DO
1112       ident := locs.a[index];
1113       WITH ident : Id.ParId DO (* skip *)
1114       | ident : Id.LocId DO
1115           ident.varOrd := count;
1116           INC(count, jvmSize(ident.type));
1117       END;
1118     END;
1119     pIdn.rtsFram := count;
1120   END NumberLocals;
1121
1122 (* ------------------------------------------------------------ *)
1123
1124   PROCEDURE MkCallAttr*(pIdn : Sym.Idnt; pTyp : Ty.Procedure);
1125   BEGIN
1126     WITH pIdn : Id.MthId DO
1127       IF ~needsBox(pIdn.rcvFrm) THEN
1128         pIdn.rtsFram := 1;      (* count one for "this" *)
1129       ELSE
1130         pIdn.rtsFram := 2;      (* this plus the retbox *)
1131       END;
1132       MkProcName(pIdn);
1133       NumberParams(pIdn, pTyp);
1134     | pIdn : Id.PrcId DO
1135         pIdn.rtsFram := 0;
1136         MkProcName(pIdn);
1137         NumberParams(pIdn, pTyp);
1138     END;
1139   END MkCallAttr;
1140
1141 (* ------------------------------------------------------------ *)
1142
1143   PROCEDURE RenumberLocals*(prcId : Id.Procs);
1144     VAR parId : Id.ParId;
1145         frmTp : Ty.Procedure;
1146         funcT : BOOLEAN;
1147   BEGIN
1148    (*
1149     * Rules:
1150     *   (i)   The receiver (if any) must be #0
1151     *   (ii)  Params are #1 .. #N, or #0 .. for statics
1152     *   (iii) Locals are #(N+1) ...
1153     *   (iv)  doubles and longs take two slots.
1154     *
1155     *   This procedure computes the number of local slots. It
1156     *   renumbers the varOrd fields, and initializes rtsFram.
1157     *   The procedure also computes the formal name for the JVM.
1158     *)
1159     prcId.rtsFram := 0;
1160     frmTp := prcId.type(Ty.Procedure);
1161     funcT := (frmTp.retType # NIL);
1162     WITH prcId : Id.MthId DO
1163       parId := prcId.rcvFrm;
1164       parId.varOrd := 0;   prcId.rtsFram := 1;  (* count one for "this" *)
1165       ASSERT(~needsBox(parId));
1166 (*
1167  *  Receivers are never boxed in Component Pascal
1168  *
1169  *    IF needsBox(parId) THEN
1170  *      parId.boxOrd := 1; prcId.rtsFram := 2;  (* count one for retbox *)
1171  *    END;
1172  *)
1173     ELSE (* skip static procedures *)
1174     END;
1175    (*
1176     *   Assert: params do not appear in the local array.
1177     *   Count params (and boxes if needed).
1178     *)
1179     NumberParams(prcId, frmTp);
1180     IF prcId.body # NIL THEN
1181       NumberProxies(prcId, frmTp.formals);
1182       NumberLocals(prcId, prcId.locals);
1183     END;
1184   END RenumberLocals;
1185
1186 (* ------------------------------------------------------------ *)
1187 (* ------------------------------------------------------------ *)
1188
1189   PROCEDURE (jf : JavaFile)MakeAndPushProcLitValue*(exp : Sym.Expr; typ : Ty.Procedure),NEW;
1190     VAR singleton : Id.TypId;
1191             hostClass : Ty.Record;
1192   BEGIN
1193         MkProcTypeName(typ);
1194         hostClass := newProcLitWrapperClass(exp, typ);
1195         hostClass.baseTp := typ.hostClass;
1196         jf.MkNewRecord(hostClass);
1197   END MakeAndPushProcLitValue;
1198
1199 (* ------------------------------------------------------------ *)
1200
1201   PROCEDURE (jf : JavaFile)LoadLocal*(ord : INTEGER; typ : Sym.Type),NEW;
1202     VAR code : INTEGER;
1203   BEGIN
1204     IF (typ # NIL) & (typ IS Ty.Base) THEN
1205       code := typeLoad[typ(Ty.Base).tpOrd];
1206     ELSE
1207       code := Jvm.opc_aload;
1208     END;
1209     IF ord < 4 THEN
1210       CASE code OF
1211       | Jvm.opc_iload : code := Jvm.opc_iload_0 + ord;
1212       | Jvm.opc_lload : code := Jvm.opc_lload_0 + ord;
1213       | Jvm.opc_fload : code := Jvm.opc_fload_0 + ord;
1214       | Jvm.opc_dload : code := Jvm.opc_dload_0 + ord;
1215       | Jvm.opc_aload : code := Jvm.opc_aload_0 + ord;
1216       END;
1217       jf.Code(code);
1218     ELSE
1219       jf.CodeI(code, ord);
1220     END;
1221   END LoadLocal;
1222
1223 (* ---------------------------------------------------- *)
1224
1225   PROCEDURE (jf : JavaFile)GetLocal*(var : Id.LocId),NEW;
1226   BEGIN
1227     IF Id.uplevA IN var.locAtt THEN jf.GetUplevel(var);
1228     ELSE jf.LoadLocal(var.varOrd, var.type);
1229     END;
1230   END GetLocal;
1231
1232 (* ---------------------------------------------------- *)
1233
1234   PROCEDURE typeToChOpen(typ : Sym.Type) : L.CharOpen;
1235    (* --------------------------------------------- *)
1236     PROCEDURE slashToDot(a : L.CharOpen) : L.CharOpen;
1237       VAR nw : L.CharOpen; ix : INTEGER; ch : CHAR;
1238     BEGIN
1239       NEW(nw, LEN(a));
1240       FOR ix := 0 TO LEN(a)-1 DO
1241         ch := a[ix]; IF ch = "/" THEN nw[ix] := "." ELSE nw[ix] := ch  END;
1242       END;
1243       RETURN nw;
1244     END slashToDot;
1245    (* --------------------------------------------- *)
1246     PROCEDURE typeTag(typ : Sym.Type) : L.CharOpen;
1247     BEGIN
1248       WITH typ : Ty.Base DO
1249           RETURN typ.xName;
1250       | typ : Ty.Array DO
1251           RETURN cat2(brac, typeTag(typ.elemTp));
1252       | typ : Ty.Record DO
1253           IF typ.xName = NIL THEN MkRecName(typ) END;
1254           RETURN slashToDot(typ.scopeNm);
1255       | typ : Ty.Enum DO
1256           RETURN Blt.intTp.xName;
1257       | typ : Ty.Pointer DO
1258           RETURN typeTag(typ.boundTp);
1259       | typ : Ty.Opaque DO
1260           IF typ.xName = NIL THEN MkAliasName(typ) END;
1261           RETURN slashToDot(typ.scopeNm);
1262       END;
1263     END typeTag;
1264    (* --------------------------------------------- *)
1265   BEGIN
1266     WITH typ : Ty.Base DO
1267             RETURN typeTag(typ);
1268         | typ : Ty.Array DO
1269         RETURN cat2(brac, typeTag(typ.elemTp));
1270     | typ : Ty.Record DO
1271         IF typ.xName = NIL THEN MkRecName(typ) END;
1272         RETURN slashToDot(typ.xName);
1273     | typ : Ty.Pointer DO
1274         RETURN typeToChOpen(typ.boundTp);
1275     | typ : Ty.Opaque DO
1276         IF typ.xName = NIL THEN MkAliasName(typ) END;
1277         RETURN slashToDot(typ.xName);
1278     END;
1279   END typeToChOpen;
1280
1281 (* ---------------------------------------------------- *)
1282
1283   PROCEDURE (jf : JavaFile)LoadType*(id : Sym.Idnt),NEW;
1284     VAR tp : Sym.Type;
1285   BEGIN
1286     ASSERT(id IS Id.TypId);
1287     tp := id.type;
1288     WITH tp : Ty.Base DO
1289       jf.PushInt(tp.tpOrd);
1290       jf.CallRTS(LoadTp1, 1, 1);
1291     ELSE
1292      (*
1293       *  First we get the string-name of the
1294       *  type, and then we push the string.
1295       *)
1296       jf.PushStr(typeToChOpen(id.type));
1297      (*
1298       *  Then we call getClassByName
1299       *)
1300       jf.CallRTS(LoadTp2, 1, 1);
1301     END;
1302   END LoadType;
1303
1304 (* ---------------------------------------------------- *)
1305
1306   PROCEDURE (jf : JavaFile)GetVar*(id : Sym.Idnt),NEW;
1307     VAR var : Id.AbVar;
1308         scp : Sym.Scope;
1309   BEGIN
1310     var := id(Id.AbVar);
1311     IF var.kind = Id.conId THEN
1312       jf.GetLocal(var(Id.LocId));
1313     ELSE
1314       scp := var.dfScp;
1315       WITH scp : Id.BlkId DO
1316         jf.PutGetS(Jvm.opc_getstatic, scp, var(Id.VarId));
1317       ELSE (* must be local *)
1318         jf.GetLocal(var(Id.LocId));
1319       END;
1320     END;
1321   END GetVar;
1322
1323 (* ------------------------------------------------------------ *)
1324
1325   PROCEDURE (jf : JavaFile)StoreLocal*(ord : INTEGER; typ : Sym.Type),NEW;
1326     VAR code : INTEGER;
1327   BEGIN
1328     IF (typ # NIL) & (typ IS Ty.Base) THEN
1329       code := typeStore[typ(Ty.Base).tpOrd];
1330     ELSE
1331       code := Jvm.opc_astore;
1332     END;
1333     IF ord < 4 THEN
1334       CASE code OF
1335       | Jvm.opc_istore : code := Jvm.opc_istore_0 + ord;
1336       | Jvm.opc_lstore : code := Jvm.opc_lstore_0 + ord;
1337       | Jvm.opc_fstore : code := Jvm.opc_fstore_0 + ord;
1338       | Jvm.opc_dstore : code := Jvm.opc_dstore_0 + ord;
1339       | Jvm.opc_astore : code := Jvm.opc_astore_0 + ord;
1340       END;
1341       jf.Code(code);
1342     ELSE
1343       jf.CodeI(code, ord);
1344     END;
1345   END StoreLocal;
1346
1347 (* ---------------------------------------------------- *)
1348
1349   PROCEDURE (jf : JavaFile)PutLocal*(var : Id.LocId),NEW;
1350   BEGIN
1351     IF Id.uplevA IN var.locAtt THEN jf.PutUplevel(var);
1352     ELSE jf.StoreLocal(var.varOrd, var.type);
1353     END;
1354   END PutLocal;
1355
1356 (* ---------------------------------------------------- *)
1357
1358   PROCEDURE (jf : JavaFile)PutVar*(id : Sym.Idnt),NEW;
1359     VAR var : Id.AbVar;
1360         scp : Sym.Scope;
1361   BEGIN
1362     var := id(Id.AbVar);
1363     scp := var.dfScp;
1364     WITH scp : Id.BlkId DO
1365       jf.PutGetS(Jvm.opc_putstatic, scp, var(Id.VarId));
1366     ELSE (* could be in an XHR *)
1367       jf.PutLocal(var(Id.LocId));
1368     END;
1369   END PutVar;
1370
1371 (* ------------------------------------------------------------ *)
1372
1373   PROCEDURE (jf : JavaFile)PutElement*(typ : Sym.Type),NEW;
1374     VAR code : INTEGER;
1375   BEGIN
1376     IF (typ # NIL) & (typ IS Ty.Base) THEN
1377       code := typePutE[typ(Ty.Base).tpOrd];
1378     ELSE
1379       code := Jvm.opc_aastore;
1380     END;
1381     jf.Code(code);
1382   END PutElement;
1383
1384 (* ------------------------------------------------------------ *)
1385
1386   PROCEDURE (jf : JavaFile)GetElement*(typ : Sym.Type),NEW;
1387     VAR code : INTEGER;
1388   BEGIN
1389     IF (typ # NIL) & (typ IS Ty.Base) THEN
1390       code := typeGetE[typ(Ty.Base).tpOrd];
1391     ELSE
1392       code := Jvm.opc_aaload;
1393     END;
1394     jf.Code(code);
1395   END GetElement;
1396
1397 (* ------------------------------------------------------------ *)
1398
1399   PROCEDURE (jf : JavaFile)PushInt*(num : INTEGER),NEW;
1400   VAR
1401     conIx : INTEGER;
1402   BEGIN
1403     IF (num >= MIN(BYTE)) & (num <= MAX(BYTE)) THEN
1404       CASE num OF
1405       | -1 : jf.Code(Jvm.opc_iconst_m1);
1406       |  0 : jf.Code(Jvm.opc_iconst_0);
1407       |  1 : jf.Code(Jvm.opc_iconst_1);
1408       |  2 : jf.Code(Jvm.opc_iconst_2);
1409       |  3 : jf.Code(Jvm.opc_iconst_3);
1410       |  4 : jf.Code(Jvm.opc_iconst_4);
1411       |  5 : jf.Code(Jvm.opc_iconst_5);
1412       ELSE
1413         jf.CodeI(Jvm.opc_bipush, num);
1414       END;
1415     ELSE
1416       jf.LoadConst(num);
1417     END;
1418   END PushInt;
1419
1420 (* ------------------------------------------------------------ *)
1421
1422   PROCEDURE (jf : JavaFile)PushLong*(num : LONGINT),NEW;
1423   BEGIN
1424     IF num = 0 THEN
1425       jf.Code(Jvm.opc_lconst_0);
1426     ELSIF num = 1 THEN
1427       jf.Code(Jvm.opc_lconst_1);
1428     ELSIF (num >= MIN(INTEGER)) & (num <= MAX(INTEGER)) THEN
1429       jf.PushInt(SHORT(num));
1430       jf.Code(Jvm.opc_i2l);
1431     ELSE
1432       jf.CodeL(Jvm.opc_ldc2_w, num);
1433     END;
1434   END PushLong;
1435
1436 (* ------------------------------------------------------------ *)
1437
1438   PROCEDURE (jf : JavaFile)PushReal*(num : REAL),NEW;
1439   BEGIN
1440     IF num = 0.0 THEN
1441       jf.Code(Jvm.opc_dconst_0);
1442     ELSIF num = 1.0 THEN
1443       jf.Code(Jvm.opc_dconst_1);
1444     ELSE
1445       jf.CodeR(Jvm.opc_ldc2_w, num, FALSE);
1446     END;
1447   END PushReal;
1448
1449 (* ------------------------------------------------------------ *)
1450
1451   PROCEDURE (jf : JavaFile)PushSReal*(num : REAL),NEW;
1452   VAR
1453     conIx : INTEGER;
1454   BEGIN
1455     IF num = 0.0 THEN
1456       jf.Code(Jvm.opc_fconst_0);
1457     ELSIF num = 1.0 THEN
1458       jf.Code(Jvm.opc_fconst_1);
1459     ELSIF num = 2.0 THEN
1460       jf.Code(Jvm.opc_fconst_2);
1461     ELSE
1462       jf.CodeR(Jvm.opc_ldc, num, TRUE);
1463     END;
1464   END PushSReal;
1465
1466 (* ------------------------------------------------------------ *)
1467
1468   PROCEDURE (jf : JavaFile)PushStaticLink*(tgt : Id.Procs),NEW;
1469     VAR lxDel : INTEGER;
1470         clr   : Id.Procs;
1471         pTp   : Ty.Procedure;
1472   BEGIN
1473     clr   := jf.theP;
1474     lxDel := tgt.lxDepth - clr.lxDepth;
1475     pTp   := clr.type(Ty.Procedure);
1476
1477     CASE lxDel OF
1478     | 0 : jf.Code(Jvm.opc_aload_0);
1479     | 1 : IF Id.hasXHR IN clr.pAttr THEN
1480             jf.LoadLocal(pTp.argN, NIL);
1481           ELSIF clr.lxDepth = 0 THEN
1482             jf.Code(Jvm.opc_aconst_null);
1483           ELSE
1484             jf.Code(Jvm.opc_aload_0);
1485           END;
1486     ELSE
1487       jf.Code(Jvm.opc_aload_0);
1488       REPEAT
1489         clr := clr.dfScp(Id.Procs);
1490         IF Id.hasXHR IN clr.pAttr THEN
1491           jf.PutGetF(Jvm.opc_getfield,
1492                 Cst.rtsXHR.boundRecTp()(Ty.Record), Cst.xhrId);
1493         END;
1494       UNTIL clr.lxDepth = tgt.lxDepth;
1495     END;
1496   END PushStaticLink;
1497
1498 (* ------------------------------------------------------------ *)
1499
1500   PROCEDURE (jf : JavaFile)GetXHR(var : Id.LocId),NEW;
1501     VAR scp : Id.Procs; (* the scope holding the datum *)
1502         clr : Id.Procs; (* the scope making the call   *)
1503         pTp : Ty.Procedure;
1504         del : INTEGER;
1505   BEGIN
1506     scp := var.dfScp(Id.Procs);
1507     clr := jf.theP;
1508     pTp := clr.type(Ty.Procedure);
1509    (*
1510     *  Check if this is an own local
1511     *)
1512     IF scp = clr THEN
1513       jf.LoadLocal(pTp.argN, NIL);
1514     ELSE
1515       del := xhrCount(scp, clr);
1516      (*
1517       *  First, load the static link
1518       *)
1519       jf.Code(Jvm.opc_aload_0);
1520      (*
1521       *  Next, load the XHR pointer.
1522       *)
1523       WHILE del > 1 DO
1524         jf.PutGetF(Jvm.opc_getfield,
1525                 Cst.rtsXHR.boundRecTp()(Ty.Record), Cst.xhrId);
1526         DEC(del);
1527       END;
1528      (*
1529       *  Finally, cast to concrete type
1530       *)
1531       jf.CodeT(Jvm.opc_checkcast, scp.xhrType);
1532     END;
1533   END GetXHR;
1534
1535 (* ------------------------------------------------------------ *)
1536
1537   PROCEDURE (jf : JavaFile)PutGetX*(cde : INTEGER; var : Id.LocId),NEW;
1538     VAR pTyp : Sym.Type;
1539   BEGIN
1540     pTyp := var.dfScp(Id.Procs).xhrType;
1541     jf.PutGetF(cde, pTyp.boundRecTp()(Ty.Record), var);
1542   END PutGetX;
1543
1544 (* ------------------------------------------------------------ *)
1545
1546   PROCEDURE (jf : JavaFile)XhrHandle*(var : Id.LocId),NEW;
1547   BEGIN
1548     jf.GetXHR(var);
1549   END XhrHandle;
1550
1551 (* ------------------------------------------------------------ *)
1552
1553   PROCEDURE (jf : JavaFile)GetUplevel*(var : Id.LocId),NEW;
1554   BEGIN
1555     jf.GetXHR(var);
1556     jf.PutGetX(Jvm.opc_getfield, var);
1557   END GetUplevel;
1558
1559 (* ------------------------------------------------------------ *)
1560
1561   PROCEDURE (jf : JavaFile)PutUplevel*(var : Id.LocId),NEW;
1562   BEGIN
1563     jf.PutGetX(Jvm.opc_putfield, var);
1564   END PutUplevel;
1565
1566 (* ------------------------------------------------------------ *)
1567
1568   PROCEDURE (jf : JavaFile)ConvertUp*(inT, outT : Sym.Type),NEW;
1569    (* Conversion "up" is always safe at runtime. Many are nop.  *)
1570     VAR inB, outB, code : INTEGER;
1571   BEGIN
1572     inB  := inT(Ty.Base).tpOrd;
1573     outB := outT(Ty.Base).tpOrd;
1574     IF inB = outB THEN RETURN END;              (* PREMATURE RETURN! *)
1575     CASE outB OF
1576     | Ty.realN :
1577         IF    inB = Ty.sReaN THEN code := Jvm.opc_f2d;
1578         ELSIF inB = Ty.lIntN THEN code := Jvm.opc_l2d;
1579         ELSE                      code := Jvm.opc_i2d;
1580         END;
1581     | Ty.sReaN :
1582         IF    inB = Ty.lIntN THEN code := Jvm.opc_l2f;
1583         ELSE                      code := Jvm.opc_i2f;
1584         END;
1585     | Ty.lIntN :
1586         code := Jvm.opc_i2l;
1587     ELSE RETURN;                                (* PREMATURE RETURN! *)
1588     END;
1589     jf.Code(code);
1590   END ConvertUp;
1591
1592 (* ------------------------------------------------------------ *)
1593
1594   PROCEDURE (jf : JavaFile)ConvertDn*(inT, outT : Sym.Type),NEW;
1595    (* Conversion "down" often needs a runtime check. *)
1596     VAR inB, outB, code : INTEGER;
1597   BEGIN
1598     inB  := inT(Ty.Base).tpOrd;
1599     outB := outT(Ty.Base).tpOrd;
1600     IF inB = outB THEN RETURN END;              (* PREMATURE RETURN! *)
1601     CASE outB OF
1602     | Ty.realN : RETURN;                        (* PREMATURE RETURN! *)
1603     | Ty.sReaN :
1604         code := Jvm.opc_d2f;
1605     | Ty.lIntN :
1606         IF    inB = Ty.realN THEN code := Jvm.opc_d2l;
1607         ELSIF inB = Ty.sReaN THEN code := Jvm.opc_f2l;
1608         ELSE  RETURN;                           (* PREMATURE RETURN! *)
1609         END;
1610     | Ty.intN  :
1611         IF    inB = Ty.realN THEN code := Jvm.opc_d2i;
1612         ELSIF inB = Ty.sReaN THEN code := Jvm.opc_f2i;
1613         ELSIF inB = Ty.lIntN THEN
1614           (* jf.RangeCheck(...); STILL TO DO *)
1615           code := Jvm.opc_l2i;
1616         ELSE  RETURN;                           (* PREMATURE RETURN! *)
1617         END;
1618     | Ty.sIntN :
1619         jf.ConvertDn(inT, Blt.intTp);
1620         (* jf.RangeCheck(...); STILL TO DO *)
1621         code := Jvm.opc_i2s;
1622     | Ty.uBytN :
1623          jf.ConvertDn(inT, Blt.intTp);
1624         (* jf.RangeCheck(...); STILL TO DO *)
1625         jf.PushInt(255);
1626         code := Jvm.opc_iand;
1627     | Ty.byteN :
1628         jf.ConvertDn(inT, Blt.intTp);
1629         (* jf.RangeCheck(...); STILL TO DO *)
1630         code := Jvm.opc_i2b;
1631     | Ty.setN  :
1632         jf.ConvertDn(inT, Blt.intTp); RETURN;   (* PREMATURE RETURN! *)
1633     | Ty.charN  :
1634         jf.ConvertDn(inT, Blt.intTp);
1635         (* jf.RangeCheck(...); STILL TO DO *)
1636         code := Jvm.opc_i2c;
1637     | Ty.sChrN  :
1638         jf.ConvertDn(inT, Blt.intTp);
1639         (* jf.RangeCheck(...); STILL TO DO *)
1640         jf.PushInt(255);
1641         code := Jvm.opc_iand;
1642     END;
1643     jf.Code(code);
1644   END ConvertDn;
1645
1646 (* ------------------------------------------------------------ *)
1647
1648   PROCEDURE (jf : JavaFile)EmitOneRange*
1649                (var : INTEGER;          (* local variable index *)
1650                 loC : INTEGER;          (* low-value of range   *)
1651                 hiC : INTEGER;          (* high-value of range  *)
1652                 min : INTEGER;          (* minimun selector val *)
1653                 max : INTEGER;          (* maximum selector val *)
1654                 def : Label;          (* default code label   *)
1655                 target : Label),NEW;
1656   (* ---------------------------------------------------------- *
1657    *  The selector value is known to be in the range min .. max *
1658    *  and we wish to send values between loC and hiC to the     *
1659    *  target code label. All otherwise go to def.               *
1660    *  A range is "compact" if it is hard against min/max limits *
1661    * ---------------------------------------------------------- *)
1662   BEGIN
1663    (*
1664     *    Deal with several special cases...
1665     *)
1666     IF (min = loC) & (max = hiC) THEN   (* fully compact: just GOTO *)
1667       jf.CodeLb(Jvm.opc_goto, target);
1668     ELSE
1669       jf.LoadLocal(var, Blt.intTp);
1670       IF loC = hiC THEN (* a singleton *)
1671         jf.PushInt(loC);
1672         jf.CodeLb(Jvm.opc_if_icmpeq, target);
1673       ELSIF min = loC THEN              (* compact at low end only  *)
1674         jf.PushInt(hiC);
1675         jf.CodeLb(Jvm.opc_if_icmple, target);
1676       ELSIF max = hiC THEN              (* compact at high end only *)
1677         jf.PushInt(loC);
1678         jf.CodeLb(Jvm.opc_if_icmpge, target);
1679       ELSE                              (* Shucks! The general case *)
1680         jf.PushInt(loC);
1681         jf.CodeLb(Jvm.opc_if_icmplt, def);
1682         jf.LoadLocal(var, Blt.intTp);
1683         jf.PushInt(hiC);
1684         jf.CodeLb(Jvm.opc_if_icmple, target);
1685       END;
1686       jf.CodeLb(Jvm.opc_goto, def);
1687     END;
1688   END EmitOneRange;
1689
1690 (* ------------------------------------------------------------ *)
1691
1692   PROCEDURE (jf : JavaFile)Return*(ret : Sym.Type),NEW;
1693   BEGIN
1694     IF ret = NIL THEN
1695       jf.Code(Jvm.opc_return);
1696     ELSIF ret IS Ty.Base THEN
1697       jf.Code(typeRetn[ret(Ty.Base).tpOrd]);
1698     ELSE
1699       jf.Code(Jvm.opc_areturn);
1700     END;
1701   END Return;
1702
1703 (* ------------------------------------------------------------ *)
1704
1705   PROCEDURE (jf : JavaFile)FixPar(par : Id.ParId),NEW;
1706   BEGIN
1707    (*
1708     *   Load up the actual into boxVar[0];
1709     *)
1710     jf.LoadLocal(par.boxOrd, NIL);
1711     jf.Code(Jvm.opc_iconst_0);
1712    (*
1713     *   The param might be an XHR field, so
1714     *   jf.LoadLocal(par.varOrd, par.type) breaks.
1715     *)
1716     jf.GetLocal(par);
1717     jf.PutElement(par.type);
1718   END FixPar;
1719
1720 (* ------------------------------------------------------------ *)
1721
1722   PROCEDURE (jf : JavaFile)FixOutPars*(pId : Id.Procs; OUT ret : Sym.Type),NEW;
1723     VAR frm : Ty.Procedure;
1724         par : Id.ParId;
1725         idx : INTEGER;
1726   BEGIN
1727     ret := NIL;
1728 (*
1729  *  Receivers are never boxed in Component Pascal.
1730  *
1731  *  WITH pId : Id.MthId DO
1732  *    par := pId.rcvFrm;
1733  *    IF par.boxOrd # 0 THEN jf.FixPar(par) END;
1734  *  ELSE (* nothing *)
1735  *  END;
1736  *)
1737     frm := pId.type(Ty.Procedure);
1738     FOR idx := 0 TO frm.formals.tide-1 DO
1739       par := frm.formals.a[idx];
1740       IF par.boxOrd = retMarker THEN
1741         ret := par.type;
1742        (*
1743         *   The param might be an XHR field, so
1744         *   jf.LoadLocal(par.varOrd, ret) breaks.
1745         *)
1746         jf.GetLocal(par);
1747       ELSIF needsBox(par) THEN
1748         jf.FixPar(par);
1749       END;
1750     END;
1751    (*
1752     *  If ret is still NIL, then either there is an explicit
1753     *  return type, or there was no OUT or VAR parameters here.
1754     *  So...
1755     *)
1756     IF (ret = NIL) & (pId.kind # Id.ctorP) THEN ret := frm.retType END;
1757   END FixOutPars;
1758
1759 (* ------------------------------------------------------------ *)
1760
1761   PROCEDURE (jf : JavaFile)PushJunkAndReturn*(),NEW;
1762     VAR frm : Ty.Procedure;
1763         ret : Sym.Type;
1764         idx : INTEGER;
1765         par : Id.ParId;
1766   BEGIN
1767    (*
1768     *  This procedure pushes a dummy return value
1769     *  if that is necessary, and calls return.
1770     *)
1771     ret := NIL;
1772     IF jf.theP = NIL THEN RETURN END;         (* PREMATURE EXIT FOR MOD BODY *)
1773     frm := jf.theP.type(Ty.Procedure);
1774    (*
1775     *  First, we must find the (jvm) return type.
1776     *  It would have been nice to store this in out.info!
1777     *)
1778     FOR idx := 0 TO frm.formals.tide-1 DO
1779       par := frm.formals.a[idx];
1780       IF par.boxOrd = retMarker THEN ret := par.type END;
1781     END;
1782     IF ret = NIL THEN ret := frm.retType END;
1783    (*
1784     *  Now push a "zero" if necessary, then return.
1785     *  If this is a void function in the JVM, then we
1786     *  may safely leave things to the fall through return.
1787     *)
1788     IF ret # NIL THEN
1789       WITH ret : Ty.Base DO
1790         CASE ret.tpOrd OF
1791         |  Ty.boolN .. Ty.intN : jf.Code(Jvm.opc_iconst_0);
1792         |  Ty.lIntN            : jf.Code(Jvm.opc_lconst_0);
1793         |  Ty.sReaN            : jf.Code(Jvm.opc_fconst_0);
1794         |  Ty.realN            : jf.Code(Jvm.opc_dconst_0);
1795         ELSE                     jf.Code(Jvm.opc_aconst_null);
1796         END;
1797       ELSE
1798         jf.Code(Jvm.opc_aconst_null);
1799       END;
1800       jf.Return(ret);
1801     END;
1802   END PushJunkAndReturn;
1803
1804 (* ------------------------------------------------------------ *)
1805
1806   PROCEDURE (jf : JavaFile)Init1dArray*(elTp : Sym.Type; leng : INTEGER),NEW;
1807     CONST inlineLimit = 4;
1808     VAR indx : INTEGER;
1809         labl : Label;
1810         arrT : Ty.Array;
1811   BEGIN
1812    (*
1813     *   Precondition: elTp is either a record or fixed array.
1814     *   At entry stack is (top) arrayRef, unchanged at exit.
1815     *   (len == 0) ==> take length from runtime descriptor.
1816     *)
1817     IF (leng < 4) & (leng # 0) & (elTp.kind = Ty.recTp) THEN
1818      (*
1819       *    Do a compile-time loop ...
1820       *)
1821       FOR indx := 0 TO leng-1 DO
1822         jf.Code(Jvm.opc_dup);
1823         jf.PushInt(indx);
1824         jf.MkNewRecord(elTp(Ty.Record));
1825         jf.Code(Jvm.opc_aastore);
1826       END;
1827     ELSE
1828      (* ------------------------------------------------------ *
1829       *    Do a runtime loop ...
1830       *
1831       *         push-len>       ; (top) len, ref,...
1832       *  loop:
1833       *         iconst_1        ; (top) 1, len, ref,...
1834       *         isub            ; (top) len*, ref,...
1835       *         dup2            ; (top) len*, ref, len*, ref,...
1836       *         <newElem>       ; (top) new, len*, ref, len*, ref,...
1837       *         aastore         ; (top) len*, ref,...
1838       *         dup             ; (top) len*, len*, ref,...
1839       *         ifne loop       ; (top) len*, ref,...
1840       *         pop             ; (top) ref, ...
1841       * ------------------------------------------------------ *)
1842       IF leng = 0 THEN (* find the length from the descriptor  *)
1843         jf.Code(Jvm.opc_dup);
1844         jf.Code(Jvm.opc_arraylength);
1845       ELSE
1846         jf.PushInt(leng);
1847       END;
1848       labl := jf.newLabel();
1849       jf.DefLabC(labl, "1-d init loop");
1850       jf.Code(Jvm.opc_iconst_1);
1851       jf.Code(Jvm.opc_isub);
1852       jf.Code(Jvm.opc_dup2);
1853       IF elTp.kind = Ty.recTp THEN
1854         jf.MkNewRecord(elTp(Ty.Record));
1855       ELSE
1856         arrT := elTp(Ty.Array);
1857         jf.MkNewFixedArray(arrT.elemTp, arrT.length);
1858       END;
1859       jf.Code(Jvm.opc_aastore);
1860       jf.Code(Jvm.opc_dup);
1861       jf.CodeLb(Jvm.opc_ifne, labl);
1862       jf.CodeC(Jvm.opc_pop, "   ; end 1-d loop");
1863     END;
1864   END Init1dArray;
1865
1866 (* ============================================================ *)
1867
1868   PROCEDURE (jf : JavaFile)InitNdArray*(desc : Sym.Type; elTp : Sym.Type),NEW;
1869     VAR labl : Label;
1870   BEGIN
1871    (* ------------------------------------------------------ *
1872     *   Initialize multi-dimensional array, using
1873     *   the runtime array descriptors to generate lengths.
1874     *   Here, desc is the outer element type; elTp
1875     *   most nested type.
1876     *
1877     *   At entry stack is (top) arrayRef, unchanged at exit.
1878     *
1879     *           dup             ; (top) ref,ref...
1880     *           arraylength     ; (top) len,ref...
1881     *     loop:
1882     *           iconst_1        ; (top) 1,len,ref...
1883     *           isub            ; (top) len',ref...
1884     *           dup2            ; (top) hi,ref,hi,ref...
1885     *           if (desc == elTp)
1886     *              <eleminit>   ; (top) rec,ref[i],hi,ref...
1887     *              aastore      ; (top) hi,ref...
1888     *           else
1889     *              aaload       ; (top) ref[i],hi,ref...
1890     *              <recurse>    ; (top) ref[i],hi,ref...
1891     *              pop          ; (top) hi,ref...
1892     *           endif
1893     *           dup             ; (top) hi,hi,ref...
1894     *           ifne loop       ; (top) hi,ref...
1895     *           pop             ; (top) ref...
1896     * ------------------------------------------------------ *)
1897     labl := jf.newLabel();
1898     jf.Code(Jvm.opc_dup);
1899     jf.Code(Jvm.opc_arraylength);
1900     jf.DefLabC(labl, "Element init loop");
1901     jf.Code(Jvm.opc_iconst_1);
1902     jf.Code(Jvm.opc_isub);
1903     jf.Code(Jvm.opc_dup2);
1904     IF desc = elTp THEN
1905      (*
1906       *    This is the innermost loop!
1907       *)
1908       WITH elTp : Ty.Array DO
1909          (*
1910           *  Must be switching from open to fixed arrays...
1911           *)
1912           jf.MkNewFixedArray(elTp.elemTp, elTp.length);
1913       | elTp : Ty.Record DO
1914          (*
1915           *  Element type is some record type.
1916           *)
1917           jf.MkNewRecord(elTp);
1918       END;
1919       jf.Code(Jvm.opc_aastore);
1920     ELSE
1921      (*
1922       *    There are more dimensions to go ... so recurse down.
1923       *)
1924       jf.Code(Jvm.opc_aaload);
1925       jf.InitNdArray(desc(Ty.Array).elemTp, elTp);
1926       jf.Code(Jvm.opc_pop);
1927     END;
1928     jf.Code(Jvm.opc_dup);
1929     jf.CodeLb(Jvm.opc_ifne, labl);
1930     jf.CodeC(Jvm.opc_pop, "     ; end loop");
1931   END InitNdArray;
1932
1933 (* ============================================================ *)
1934
1935   PROCEDURE (jf : JavaFile)ValArrCopy*(typ : Ty.Array),NEW;
1936     VAR local : INTEGER;
1937         sTemp : INTEGER;
1938         label : Label;
1939         elTyp : Sym.Type;
1940   BEGIN
1941    (*
1942     *    Stack at entry is (top) srcRef, dstRef...
1943     *)
1944     label := jf.newLabel();
1945     local := jf.newLocal();
1946     IF typ.length = 0 THEN (* open array, get length from source desc *)
1947       jf.Code(Jvm.opc_dup);
1948       jf.Code(Jvm.opc_arraylength);
1949     ELSE
1950       jf.PushInt(typ.length);
1951     END;
1952     jf.StoreLocal(local, Blt.intTp);
1953    (*
1954     *      <get length> ; (top) n,rr,lr...
1955     *      store(n)     ; (top) rr,lr...
1956     * lab:
1957     *      dup2         ; (top) rr,lr,rr,lr...
1958     *      iinc n -1    ; (top) rr,lr...
1959     *      load(n)      ; (top) n,rr,lr,rr,lr...
1960     *      dup_x1       ; (top) n,rr,n,lr,rr,lr...
1961     *      <doassign>   ; (top) rr,lr
1962     *      load(n)      ; (top) n,rr,lr...
1963     *      ifne lab     ; (top) rr,lr...
1964     *      pop2         ; (top) ...
1965     *)
1966     jf.DefLab(label);
1967     jf.Code(Jvm.opc_dup2);
1968     jf.CodeInc(local, -1);
1969     jf.LoadLocal(local, Blt.intTp);
1970     jf.Code(Jvm.opc_dup_x1);
1971    (*
1972     *    Assign the element
1973     *)
1974     elTyp := typ.elemTp;
1975     jf.GetElement(elTyp);               (* (top) r[n],n,lr,rr,lr...     *)
1976     IF  (elTyp.kind = Ty.arrTp) OR
1977         (elTyp.kind = Ty.recTp) THEN
1978       sTemp := jf.newLocal();   (* must recurse in copy code    *)
1979       jf.StoreLocal(sTemp, elTyp);      (* (top) n,lr,rr,lr...          *)
1980       jf.GetElement(elTyp);             (* (top) l{n],rr,lr...          *)
1981       jf.LoadLocal(sTemp, elTyp);       (* (top) r[n],l[n],rr,lr...     *)
1982       jf.ReleaseLocal(sTemp);
1983       WITH elTyp : Ty.Record DO
1984           jf.ValRecCopy(elTyp);
1985       | elTyp : Ty.Array DO
1986           jf.ValArrCopy(elTyp);
1987       END;
1988     ELSE
1989       jf.PutElement(elTyp);
1990     END;
1991    (*
1992     *    stack is (top) rr,lr...
1993     *)
1994     jf.LoadLocal(local, Blt.intTp);
1995     jf.CodeLb(Jvm.opc_ifne, label);
1996     jf.Code(Jvm.opc_pop2);
1997     jf.ReleaseLocal(local);
1998   END ValArrCopy;
1999
2000 (* ============================================================ *)
2001
2002   PROCEDURE (jf : JavaFile)InitVars*(scp : Sym.Scope),NEW;
2003     VAR index : INTEGER;
2004         xhrNo : INTEGER;
2005         ident : Sym.Idnt;
2006         scalr : BOOLEAN;
2007   BEGIN
2008     xhrNo := 0;
2009    (*
2010     *  Create the explicit activation record, if needed.
2011     *)
2012     WITH scp : Id.Procs DO
2013       IF Id.hasXHR IN scp.pAttr THEN
2014         xhrNo := scp.type(Ty.Procedure).argN;
2015         jf.Comment("create XHR record");
2016         jf.MkNewRecord(scp.xhrType.boundRecTp()(Ty.Record));
2017         IF scp.lxDepth > 0 THEN
2018           jf.Code(Jvm.opc_dup);
2019           jf.Code(Jvm.opc_aload_0);
2020           jf.PutGetF(Jvm.opc_putfield,
2021                 Cst.rtsXHR.boundRecTp()(Ty.Record), Cst.xhrId);
2022         END;
2023         jf.StoreLocal(xhrNo, NIL);
2024       END;
2025     ELSE (* skip *)
2026     END;
2027    (*
2028     *  Initialize local fields, if needed
2029     *)
2030     FOR index := 0 TO scp.locals.tide-1 DO
2031       ident := scp.locals.a[index];
2032       scalr := ident.type.isScalarType();
2033       WITH ident : Id.ParId DO
2034          (*
2035           *   If any args are uplevel addressed, they must
2036           *   be copied to the correct field of the XHR.
2037           *   The test "varOrd < xhrNo" excludes out params.
2038           *)
2039           IF (Id.uplevA IN ident.locAtt) & (ident.varOrd < xhrNo) THEN
2040             jf.LoadLocal(xhrNo, NIL);
2041             jf.LoadLocal(ident.varOrd, ident.type);
2042             jf.PutGetX(Jvm.opc_putfield, ident);
2043           END;
2044       | ident : Id.LocId DO
2045           IF ~scalr THEN
2046             IF Id.uplevA IN ident.locAtt THEN jf.LoadLocal(xhrNo, NIL) END;
2047             jf.VarInit(ident);
2048             jf.PutLocal(ident);
2049           END;
2050       | ident : Id.VarId DO
2051           IF ~scalr THEN
2052             jf.VarInit(ident);
2053             jf.PutGetS(Jvm.opc_putstatic, scp(Id.BlkId), ident);
2054           END;
2055       END;
2056     END;
2057   END InitVars;
2058
2059 (* ============================================================ *)
2060
2061   PROCEDURE Init*();
2062   BEGIN
2063     xhrIx := 0;
2064     InitVecDescriptors();
2065   END Init;
2066
2067 (* ============================================================ *)
2068 (* ============================================================ *)
2069
2070 BEGIN
2071   invokeHash := Hsh.enterStr("Invoke");
2072
2073   L.InitCharOpenSeq(fmArray, 8);
2074   L.InitCharOpenSeq(nmArray, 8);
2075
2076   typeRetn[ Ty.boolN] := Jvm.opc_ireturn;
2077   typeRetn[ Ty.sChrN] := Jvm.opc_ireturn;
2078   typeRetn[ Ty.charN] := Jvm.opc_ireturn;
2079   typeRetn[ Ty.byteN] := Jvm.opc_ireturn;
2080   typeRetn[ Ty.sIntN] := Jvm.opc_ireturn;
2081   typeRetn[  Ty.intN] := Jvm.opc_ireturn;
2082   typeRetn[ Ty.lIntN] := Jvm.opc_lreturn;
2083   typeRetn[ Ty.sReaN] := Jvm.opc_freturn;
2084   typeRetn[ Ty.realN] := Jvm.opc_dreturn;
2085   typeRetn[  Ty.setN] := Jvm.opc_ireturn;
2086   typeRetn[Ty.anyPtr] := Jvm.opc_areturn;
2087   typeRetn[ Ty.uBytN] := Jvm.opc_ireturn;
2088
2089   typeLoad[ Ty.boolN] := Jvm.opc_iload;
2090   typeLoad[ Ty.sChrN] := Jvm.opc_iload;
2091   typeLoad[ Ty.charN] := Jvm.opc_iload;
2092   typeLoad[ Ty.byteN] := Jvm.opc_iload;
2093   typeLoad[ Ty.sIntN] := Jvm.opc_iload;
2094   typeLoad[  Ty.intN] := Jvm.opc_iload;
2095   typeLoad[ Ty.lIntN] := Jvm.opc_lload;
2096   typeLoad[ Ty.sReaN] := Jvm.opc_fload;
2097   typeLoad[ Ty.realN] := Jvm.opc_dload;
2098   typeLoad[  Ty.setN] := Jvm.opc_iload;
2099   typeLoad[Ty.anyPtr] := Jvm.opc_aload;
2100   typeLoad[Ty.anyRec] := Jvm.opc_aload;
2101   typeLoad[ Ty.uBytN] := Jvm.opc_iload;
2102
2103   typeStore[ Ty.boolN] := Jvm.opc_istore;
2104   typeStore[ Ty.sChrN] := Jvm.opc_istore;
2105   typeStore[ Ty.charN] := Jvm.opc_istore;
2106   typeStore[ Ty.byteN] := Jvm.opc_istore;
2107   typeStore[ Ty.sIntN] := Jvm.opc_istore;
2108   typeStore[  Ty.intN] := Jvm.opc_istore;
2109   typeStore[ Ty.lIntN] := Jvm.opc_lstore;
2110   typeStore[ Ty.sReaN] := Jvm.opc_fstore;
2111   typeStore[ Ty.realN] := Jvm.opc_dstore;
2112   typeStore[  Ty.setN] := Jvm.opc_istore;
2113   typeStore[Ty.anyPtr] := Jvm.opc_astore;
2114   typeStore[Ty.anyRec] := Jvm.opc_astore;
2115   typeStore[ Ty.uBytN] := Jvm.opc_istore;
2116
2117   typePutE[ Ty.boolN] := Jvm.opc_bastore;
2118   typePutE[ Ty.sChrN] := Jvm.opc_castore;
2119   typePutE[ Ty.charN] := Jvm.opc_castore;
2120   typePutE[ Ty.byteN] := Jvm.opc_bastore;
2121   typePutE[ Ty.sIntN] := Jvm.opc_sastore;
2122   typePutE[  Ty.intN] := Jvm.opc_iastore;
2123   typePutE[ Ty.lIntN] := Jvm.opc_lastore;
2124   typePutE[ Ty.sReaN] := Jvm.opc_fastore;
2125   typePutE[ Ty.realN] := Jvm.opc_dastore;
2126   typePutE[  Ty.setN] := Jvm.opc_iastore;
2127   typePutE[Ty.anyPtr] := Jvm.opc_aastore;
2128   typePutE[Ty.anyRec] := Jvm.opc_aastore;
2129   typePutE[ Ty.uBytN] := Jvm.opc_bastore;
2130
2131   typeGetE[ Ty.boolN] := Jvm.opc_baload;
2132   typeGetE[ Ty.sChrN] := Jvm.opc_caload;
2133   typeGetE[ Ty.charN] := Jvm.opc_caload;
2134   typeGetE[ Ty.byteN] := Jvm.opc_baload;
2135   typeGetE[ Ty.sIntN] := Jvm.opc_saload;
2136   typeGetE[  Ty.intN] := Jvm.opc_iaload;
2137   typeGetE[ Ty.lIntN] := Jvm.opc_laload;
2138   typeGetE[ Ty.sReaN] := Jvm.opc_faload;
2139   typeGetE[ Ty.realN] := Jvm.opc_daload;
2140   typeGetE[  Ty.setN] := Jvm.opc_iaload;
2141   typeGetE[Ty.anyPtr] := Jvm.opc_aaload;
2142   typeGetE[Ty.anyRec] := Jvm.opc_aaload;
2143   typeGetE[ Ty.uBytN] := Jvm.opc_baload;
2144
2145   semi := L.strToCharOpen(";");
2146   comma := L.strToCharOpen(",");
2147   colon := L.strToCharOpen(":");
2148   lPar := L.strToCharOpen("(");
2149   rPar := L.strToCharOpen(")");
2150   brac := L.strToCharOpen("[");
2151   lCap := L.strToCharOpen("L");
2152   void := L.strToCharOpen("V");
2153   rParV:= L.strToCharOpen(")V");
2154   lowL := L.strToCharOpen("_");
2155   slsh := L.strToCharOpen("/");
2156   dlar := L.strToCharOpen("$");
2157   prfx := L.strToCharOpen(classPrefix);
2158   xhrDl := L.strToCharOpen("XHR$");
2159   xhrMk := L.strToCharOpen("LCP/CPJrts/XHR;");
2160   procLitPrefix := L.strToCharOpen("Proc$Lit$");
2161
2162   Blt.setTp.xName := L.strToCharOpen("I");
2163   Blt.intTp.xName := L.strToCharOpen("I");
2164   Blt.boolTp.xName := L.strToCharOpen("Z");
2165   Blt.byteTp.xName := L.strToCharOpen("B");
2166   Blt.uBytTp.xName := L.strToCharOpen("B");  (* same as BYTE *)
2167   Blt.charTp.xName := L.strToCharOpen("C");
2168   Blt.sChrTp.xName := L.strToCharOpen("C");
2169   Blt.sIntTp.xName := L.strToCharOpen("S");
2170   Blt.lIntTp.xName := L.strToCharOpen("J");
2171   Blt.realTp.xName := L.strToCharOpen("D");
2172   Blt.sReaTp.xName := L.strToCharOpen("F");
2173   Blt.anyRec.xName := L.strToCharOpen("Ljava/lang/Object;");
2174   Blt.anyPtr.xName := Blt.anyRec.xName;
2175 END JavaUtil.
2176 (* ============================================================ *)
2177 (* ============================================================ *)
2178