gpcp/ClassUtil.cp

   1 (* ============================================================ *)
   2 (*  ClassUtil is the module which writes java classs file       *)
   3 (*  structures                                                  *)
   4 (*  Copyright (c) John Gough 1999, 2000.                        *)
   5 (*  Modified DWC September, 2000.                               *)
   6 (* ============================================================ *)
   7
   8 MODULE ClassUtil;
   9
  10   IMPORT
  11         GPCPcopyright,
  12         RTS,
  13         Console,
  14         L := LitValue,
  15         J := JavaUtil,
  16         FileNames,
  17         GPFiles,
  18         D := Symbols,
  19         G := Builtin,
  20         F := GPBinFiles,
  21         CSt := CompState,
  22         Jvm := JVMcodes,
  23         Id := IdDesc,
  24         Ty := TypeDesc;
  25
  26 (* ============================================================ *)
  27
  28    CONST
  29         classPrefix = "CP";
  30         maxUnsignedByte = 255;
  31         pubStat = Jvm.acc_public + Jvm.acc_static;
  32         genSep = "/";
  33
  34 (* ============================================================ *)
  35 (* ============================================================ *)
  36 (*                  Java Class File Format                      *)
  37 (*                                                              *)
  38 (* Classfile { u4 magic;                                        *)
  39 (*             u2 minor_version;                                *)
  40 (*             u2 major_version;                                *)
  41 (*             u2 constant_pool_count;                          *)
  42 (*             cp_info constant_pool[constant_pool_count];      *)
  43 (*             u2 access_flags;                                 *)
  44 (*             u2 this_class;                                   *)
  45 (*             u2 super_class;                                  *)
  46 (*             u2 interfaces_count;                             *)
  47 (*             u2 interfaces[interfaces_count];                 *)
  48 (*             u2 fields_count;                                 *)
  49 (*             field_info fields[field_count];                  *)
  50 (*             u2 methods_count;                                *)
  51 (*             method_info methods[method_count];               *)
  52 (*             u2 attributes_count;                             *)
  53 (*             attribute_info attributes[attribute_count];      *)
  54 (*           }                                                  *)
  55 (*                                                              *)
  56 (* ============================================================ *)
  57
  58   CONST
  59         (* magic = -889275714;    (* 0xCAFEBABE *) *)
  60         magic = 0CAFEBABEH;
  61         minorVersion = 3;
  62         majorVersion = 45;
  63         initSize = 50;
  64
  65 (* ============================================================ *)
  66
  67   TYPE CPEntry = POINTER TO ABSTRACT RECORD
  68                  END;
  69
  70   TYPE ClassRef = POINTER TO EXTENSIBLE RECORD (CPEntry)
  71                     nameIx : INTEGER;
  72                   END;
  73
  74   TYPE RecClass = POINTER TO RECORD (ClassRef)
  75                     rec : Ty.Record;
  76                   END;
  77
  78   TYPE ModClass = POINTER TO RECORD (ClassRef)
  79                     mod : D.Scope;
  80                   END;
  81
  82   TYPE Reference = POINTER TO EXTENSIBLE RECORD (CPEntry)
  83                      classIx : INTEGER;
  84                      nameAndTypeIx : INTEGER;
  85                    END;
  86
  87   TYPE FieldRef = POINTER TO RECORD (Reference)
  88                   END;
  89
  90   TYPE MethodRef = POINTER TO RECORD (Reference)
  91                    END;
  92
  93   TYPE IntMethodRef = POINTER TO RECORD (Reference)
  94                       END;
  95
  96   TYPE StringRef = POINTER TO RECORD (CPEntry)
  97                      stringIx : INTEGER;
  98                    END;
  99
 100   TYPE Integer = POINTER TO RECORD (CPEntry)
 101                    iVal : INTEGER;
 102                  END;
 103
 104   TYPE Float = POINTER TO RECORD (CPEntry)
 105                  fVal : SHORTREAL;
 106                END;
 107
 108   TYPE Long = POINTER TO RECORD (CPEntry)
 109                 lVal : LONGINT;
 110               END;
 111
 112   TYPE Double = POINTER TO RECORD (CPEntry)
 113                   dVal : REAL;
 114                 END;
 115
 116   TYPE NameAndType = POINTER TO RECORD (CPEntry)
 117                        nameIx : INTEGER;
 118                        descIx : INTEGER;
 119                      END;
 120
 121   TYPE UTF8 = POINTER TO RECORD (CPEntry)
 122                 val : L.CharOpen;
 123                 stringRef : INTEGER;
 124               END;
 125
 126   TYPE ConstantPool = RECORD
 127                         pool : POINTER TO ARRAY OF CPEntry;
 128                         tide : INTEGER;
 129                       END;
 130
 131   TYPE FieldInfo* = POINTER TO RECORD
 132                       access : INTEGER;
 133                       nameIx : INTEGER;
 134                       descIx : INTEGER;
 135                       constValIx : INTEGER;
 136                     END;
 137
 138   TYPE ExceptHandler = POINTER TO RECORD
 139                          start : INTEGER;
 140                          endAndHandler : INTEGER;
 141                        END;
 142
 143   TYPE LineNumberTable = RECORD
 144                            start : POINTER TO ARRAY OF INTEGER;
 145                            lineNum : POINTER TO ARRAY OF INTEGER;
 146                            tide : INTEGER;
 147                          END;
 148
 149   TYPE Op = POINTER TO EXTENSIBLE RECORD
 150               offset : INTEGER;
 151               op : INTEGER;
 152             END;
 153
 154   TYPE OpI = POINTER TO RECORD (Op)
 155                numBytes : INTEGER;
 156                val : INTEGER;
 157              END;
 158
 159   TYPE OpL = POINTER TO RECORD (Op)
 160                lab : J.Label;
 161              END;
 162
 163   TYPE OpII = POINTER TO RECORD (Op)
 164                numBytes : INTEGER;
 165                val1 : INTEGER;
 166                val2 : INTEGER;
 167              END;
 168
 169   TYPE Op2IB = POINTER TO RECORD (Op)
 170                  val : INTEGER;
 171                  bVal : INTEGER;
 172                  trailingZero : BOOLEAN;
 173                END;
 174
 175   TYPE OpSwitch = POINTER TO RECORD (Op)
 176                     defLabel : J.Label;
 177                     padding : INTEGER;
 178                     low,high : INTEGER;
 179                     offs : POINTER TO ARRAY OF J.Label;
 180                   END;
 181
 182   TYPE CodeList = RECORD
 183                     code : POINTER TO ARRAY OF Op;
 184                     tide : INTEGER;
 185                     codeLen : INTEGER;
 186                   END;
 187
 188   TYPE MethodInfo* = POINTER TO RECORD
 189                        methId- : D.Scope;
 190                        localNum : INTEGER;    (* current locals proc  *)
 191                        currStack  : INTEGER;  (* current depth proc.  *)
 192                        exLb  : INTEGER;
 193                        hnLb  : INTEGER;
 194                        access : INTEGER;
 195                        nameIx : INTEGER;
 196                        descIx : INTEGER;
 197                        maxStack : INTEGER;
 198                        maxLocals : INTEGER;
 199                        codes : CodeList;
 200                        except : ExceptHandler;
 201                        lineNumTab : LineNumberTable;
 202                      END;
 203
 204   TYPE ClassFile* = POINTER TO RECORD (J.JavaFile)
 205                       file* : F.FILE;
 206                       meth*  : MethodInfo;
 207                       nxtLb : INTEGER;
 208                       access : INTEGER;
 209                       cp : ConstantPool;
 210                       thisClassIx : INTEGER;
 211                       superClassIx : INTEGER;
 212                       interfaces : POINTER TO ARRAY OF INTEGER;
 213                       numInterfaces : INTEGER;
 214                       fields : POINTER TO ARRAY OF FieldInfo;
 215                       numFields : INTEGER;
 216                       methods : POINTER TO ARRAY OF MethodInfo;
 217                       numMethods : INTEGER;
 218                       srcFileIx : INTEGER;
 219                       srcFileAttIx : INTEGER;
 220                       codeAttIx : INTEGER;
 221                       exceptAttIx : INTEGER;
 222                       lineNumTabIx : INTEGER;
 223                       jlExceptIx : INTEGER;
 224                     END;
 225
 226 (* ============================================================ *)
 227
 228   TYPE  TypeNameString = ARRAY 12 OF CHAR;
 229
 230 (* ============================================================ *)
 231
 232   VAR
 233         typeArr   : ARRAY 16 OF INTEGER;
 234         procNames : ARRAY 24 OF L.CharOpen;
 235         procSigs  : ARRAY 24 OF L.CharOpen;
 236
 237         object-       : L.CharOpen;
 238         init-         : L.CharOpen;
 239         clinit-       : L.CharOpen;
 240         getCls-       : L.CharOpen;
 241         noArgVoid-    : L.CharOpen;
 242         noArgClass-   : L.CharOpen;
 243         errorClass-   : L.CharOpen;
 244         errorInitSig- : L.CharOpen;
 245         rtsClass-     : L.CharOpen;
 246         main-         : L.CharOpen;
 247         mainSig-      : L.CharOpen;
 248         CPmainClass-  : L.CharOpen;
 249         putArgs-      : L.CharOpen;
 250         srcFileStr    : L.CharOpen;
 251         codeStr       : L.CharOpen;
 252         lineNumTabStr : L.CharOpen;
 253         caseTrap      : L.CharOpen;
 254         caseTrapSig   : L.CharOpen;
 255         withTrap      : L.CharOpen;
 256         withTrapSig   : L.CharOpen;
 257         exceptType-   : L.CharOpen;
 258         srcFileName   : L.CharOpen;
 259         copy-         : L.CharOpen;
 260         sysClass      : L.CharOpen;
 261         charClass     : L.CharOpen;
 262         mathClass     : L.CharOpen;
 263         IIretI        : L.CharOpen;
 264         JJretJ        : L.CharOpen;
 265
 266   VAR
 267     byte-    : L.CharOpen;
 268     char-    : L.CharOpen;
 269     double-  : L.CharOpen;
 270     float-   : L.CharOpen;
 271     int-     : L.CharOpen;
 272     long-    : L.CharOpen;
 273     short-   : L.CharOpen;
 274     boolean- : L.CharOpen;
 275
 276
 277 (* ============================================================ *)
 278
 279   PROCEDURE^ cat2(i,j : L.CharOpen) : L.CharOpen;
 280   PROCEDURE^ GetTypeName(typ : D.Type) : L.CharOpen;
 281
 282   PROCEDURE^ (cf : ClassFile)Code2I*(code,val : INTEGER; updateS : BOOLEAN),NEW;
 283
 284 (* ============================================================ *)
 285 (*                   Constant Pool Stuff                        *)
 286 (* ============================================================ *)
 287
 288   PROCEDURE Add(VAR cp : ConstantPool; entry : CPEntry) : INTEGER;
 289   VAR
 290     i : INTEGER;
 291     tmp : POINTER TO ARRAY OF CPEntry;
 292   BEGIN
 293     IF LEN(cp.pool) <= cp.tide+1 THEN
 294       tmp := cp.pool;
 295       NEW(cp.pool,2 * cp.tide);
 296       FOR i := 1 TO cp.tide-1 DO
 297         cp.pool[i] := tmp[i];
 298       END;
 299     END;
 300     cp.pool[cp.tide] := entry;
 301     IF (entry IS Long) OR (entry IS Double) THEN
 302       INC(cp.tide,2);
 303       RETURN cp.tide-2;
 304     ELSE
 305       INC(cp.tide);
 306       RETURN cp.tide-1;
 307     END;
 308   END Add;
 309
 310   PROCEDURE Equal(utf : UTF8; str2 : L.CharOpen) : BOOLEAN;
 311   VAR
 312     i : INTEGER;
 313     str1 : L.CharOpen;
 314   BEGIN
 315     IF utf.val = str2 THEN RETURN TRUE END;
 316     str1 := utf.val;
 317     IF (str1[0] # str2[0]) OR
 318        (LEN(str1) # LEN(str2)) THEN RETURN FALSE END;
 319     FOR i := 1 TO LEN(str1) - 1 DO
 320       IF str1[i] # str2[i] THEN RETURN FALSE END;
 321     END;
 322     RETURN TRUE;
 323   END Equal;
 324
 325   PROCEDURE AddUTF(VAR cp : ConstantPool; str : L.CharOpen) : INTEGER;
 326   VAR
 327     i : INTEGER;
 328     utf : UTF8;
 329   BEGIN
 330     FOR i := 1 TO cp.tide-1 DO
 331       IF (cp.pool[i] # NIL) & (cp.pool[i] IS UTF8) &
 332          Equal(cp.pool[i](UTF8), str) THEN
 333         RETURN i;
 334       END;
 335     END;
 336     NEW(utf);
 337     utf.val := str;
 338     utf.stringRef := -1;
 339     RETURN Add(cp,utf);
 340   END AddUTF;
 341
 342   PROCEDURE AddRecClassRef(VAR cp : ConstantPool; rec : Ty.Record) : INTEGER;
 343   VAR
 344     i : INTEGER;
 345     rc : RecClass;
 346   BEGIN
 347     FOR i := 1 TO cp.tide-1 DO
 348       IF (cp.pool[i] # NIL) & (cp.pool[i] IS RecClass) &
 349          (cp.pool[i](RecClass).rec = rec) THEN
 350         RETURN i;
 351       END;
 352     END;
 353     NEW(rc);
 354     rc.rec := rec;
 355     IF rec.xName = NIL THEN J.MkRecName(rec); END;
 356     rc.nameIx := AddUTF(cp,rec.xName);
 357     RETURN Add(cp,rc);
 358   END AddRecClassRef;
 359
 360   PROCEDURE AddModClassRef(VAR cp : ConstantPool; mod : Id.BlkId) : INTEGER;
 361   VAR
 362     i : INTEGER;
 363     mc : ModClass;
 364   BEGIN
 365     FOR i := 1 TO cp.tide-1 DO
 366       IF (cp.pool[i] # NIL) & (cp.pool[i] IS ModClass) &
 367          (cp.pool[i](ModClass).mod = mod) THEN
 368         RETURN i;
 369       END;
 370     END;
 371     NEW(mc);
 372     mc.mod := mod;
 373     mc.nameIx := AddUTF(cp,mod.xName);
 374     RETURN Add(cp,mc);
 375   END AddModClassRef;
 376
 377   PROCEDURE AddClassRef(VAR cp : ConstantPool; clName : L.CharOpen) : INTEGER;
 378   VAR
 379     i,namIx : INTEGER;
 380     cr : ClassRef;
 381   BEGIN
 382     namIx := AddUTF(cp,clName);
 383     FOR i := 1 TO cp.tide-1 DO
 384       IF (cp.pool[i] # NIL) & (cp.pool[i] IS ClassRef) &
 385          (cp.pool[i](ClassRef).nameIx = namIx) THEN
 386         RETURN i;
 387       END;
 388     END;
 389     NEW(cr);
 390     cr.nameIx := namIx;
 391     RETURN Add(cp,cr);
 392   END AddClassRef;
 393
 394   PROCEDURE AddStringRef(VAR cp : ConstantPool;  str : L.CharOpen) : INTEGER;
 395   VAR
 396     utfIx,strIx : INTEGER;
 397     strRef : StringRef;
 398   BEGIN
 399     utfIx := AddUTF(cp,str);
 400     strIx := cp.pool[utfIx](UTF8).stringRef;
 401     IF strIx = -1 THEN
 402       NEW(strRef);
 403       strRef.stringIx := utfIx;
 404       RETURN Add(cp,strRef);
 405     ELSE
 406       RETURN strIx;
 407     END;
 408   END AddStringRef;
 409
 410   PROCEDURE AddNameAndType(VAR cp : ConstantPool; nam : L.CharOpen;
 411                            typ : L.CharOpen) : INTEGER;
 412   VAR
 413     namIx,typIx,i : INTEGER;
 414     nt : NameAndType;
 415   BEGIN
 416     namIx := AddUTF(cp,nam);
 417     typIx := AddUTF(cp,typ);
 418     FOR i := 1 TO cp.tide-1 DO
 419       IF (cp.pool[i] # NIL) & (cp.pool[i] IS NameAndType) THEN
 420         nt := cp.pool[i](NameAndType);
 421         IF (nt.nameIx = namIx) & (nt.descIx = typIx) THEN RETURN i; END;
 422       END;
 423     END;
 424     NEW(nt);
 425     nt.nameIx := namIx;
 426     nt.descIx := typIx;
 427     RETURN Add(cp,nt);
 428   END AddNameAndType;
 429
 430   PROCEDURE AddMethodRef(VAR cp : ConstantPool; classIx : INTEGER;
 431                          methName, signature : L.CharOpen) : INTEGER;
 432   VAR
 433     ntIx,mIx,i : INTEGER;
 434     meth : MethodRef;
 435   BEGIN
 436     ntIx := AddNameAndType(cp,methName,signature);
 437     FOR i := 1 TO cp.tide-1 DO
 438       IF (cp.pool[i] # NIL) & (cp.pool[i] IS MethodRef) THEN
 439         meth := cp.pool[i](MethodRef);
 440         IF (meth.classIx = classIx) & (meth.nameAndTypeIx = ntIx) THEN
 441           RETURN i;
 442         END;
 443       END;
 444     END;
 445     NEW(meth);
 446     meth.classIx := classIx;
 447     meth.nameAndTypeIx := ntIx;
 448     RETURN Add(cp,meth);
 449   END AddMethodRef;
 450
 451   PROCEDURE AddInterfaceMethodRef(VAR cp : ConstantPool; classIx : INTEGER;
 452                          methName, signature : L.CharOpen) : INTEGER;
 453   VAR
 454     ntIx,mIx,i : INTEGER;
 455     meth : IntMethodRef;
 456   BEGIN
 457     ntIx := AddNameAndType(cp,methName,signature);
 458     FOR i := 1 TO cp.tide-1 DO
 459       IF (cp.pool[i] # NIL) & (cp.pool[i] IS IntMethodRef) THEN
 460         meth := cp.pool[i](IntMethodRef);
 461         IF (meth.classIx = classIx) & (meth.nameAndTypeIx = ntIx) THEN
 462           RETURN i;
 463         END;
 464       END;
 465     END;
 466     NEW(meth);
 467     meth.classIx := classIx;
 468     meth.nameAndTypeIx := ntIx;
 469     RETURN Add(cp,meth);
 470   END AddInterfaceMethodRef;
 471
 472   PROCEDURE AddFieldRef(VAR cp : ConstantPool; classIx : INTEGER;
 473                         fieldName, signature : L.CharOpen) : INTEGER;
 474   VAR
 475     ntIx,mIx,i : INTEGER;
 476     field : FieldRef;
 477   BEGIN
 478     ntIx := AddNameAndType(cp,fieldName,signature);
 479     FOR i := 1 TO cp.tide-1 DO
 480       IF (cp.pool[i] # NIL) & (cp.pool[i] IS FieldRef) THEN
 481         field := cp.pool[i](FieldRef);
 482         IF (field.classIx = classIx) & (field.nameAndTypeIx = ntIx) THEN
 483           RETURN i;
 484         END;
 485       END;
 486     END;
 487     NEW(field);
 488     field.classIx := classIx;
 489     field.nameAndTypeIx := ntIx;
 490     RETURN Add(cp,field);
 491   END AddFieldRef;
 492
 493   PROCEDURE AddConstInt(VAR cp : ConstantPool; val : INTEGER) : INTEGER;
 494   VAR
 495     i : INTEGER;
 496     conInt : Integer;
 497   BEGIN
 498     FOR i := 1 TO cp.tide-1 DO
 499       IF (cp.pool[i] # NIL) & (cp.pool[i] IS Integer) &
 500          (cp.pool[i](Integer).iVal = val) THEN
 501         RETURN i;
 502       END;
 503     END;
 504     NEW(conInt);
 505     conInt.iVal := val;
 506     RETURN Add(cp,conInt);
 507   END AddConstInt;
 508
 509   PROCEDURE AddConstLong(VAR cp : ConstantPool; val : LONGINT) : INTEGER;
 510   VAR
 511     i : INTEGER;
 512     conLong : Long;
 513   BEGIN
 514     FOR i := 1 TO cp.tide-1 DO
 515       IF (cp.pool[i] # NIL) & (cp.pool[i] IS Long) &
 516          (cp.pool[i](Long).lVal = val) THEN
 517         RETURN i;
 518       END;
 519     END;
 520     NEW(conLong);
 521     conLong.lVal := val;
 522     RETURN Add(cp,conLong);
 523   END AddConstLong;
 524
 525   PROCEDURE AddConstFloat(VAR cp : ConstantPool; val : SHORTREAL) : INTEGER;
 526   VAR
 527     i : INTEGER;
 528     conFloat : Float;
 529   BEGIN
 530     FOR i := 1 TO cp.tide-1 DO
 531       IF (cp.pool[i] # NIL) & (cp.pool[i] IS Float) &
 532          (cp.pool[i](Float).fVal = val) THEN
 533         RETURN i;
 534       END;
 535     END;
 536     NEW(conFloat);
 537     conFloat.fVal := val;
 538     RETURN Add(cp,conFloat);
 539   END AddConstFloat;
 540
 541   PROCEDURE AddConstDouble(VAR cp : ConstantPool; val : REAL) : INTEGER;
 542   VAR
 543     i : INTEGER;
 544     conDouble : Double;
 545   BEGIN
 546     FOR i := 1 TO cp.tide-1 DO
 547       IF (cp.pool[i] # NIL) & (cp.pool[i] IS Double) &
 548          (cp.pool[i](Double).dVal = val) THEN
 549         RETURN i;
 550       END;
 551     END;
 552     NEW(conDouble);
 553     conDouble.dVal := val;
 554     RETURN Add(cp,conDouble);
 555   END AddConstDouble;
 556
 557 (* ============================================================ *)
 558 (*                      Constructor Method                      *)
 559 (* ============================================================ *)
 560
 561   PROCEDURE newClassFile*(fileName : ARRAY OF CHAR) : ClassFile;
 562     VAR fil : ClassFile;
 563         ptr : L.CharOpen;
 564    (* ------------------------------------------------- *)
 565     PROCEDURE Warp(VAR s : ARRAY OF CHAR);
 566       VAR i : INTEGER;
 567     BEGIN
 568       FOR i := 0 TO LEN(s)-1 DO
 569         IF s[i] = "/" THEN s[i] := GPFiles.fileSep END;
 570       END;
 571     END Warp;
 572    (* ------------------------------------------------- *)
 573     PROCEDURE GetFullPath(IN fn : ARRAY OF CHAR) : L.CharOpen;
 574       VAR ps : L.CharOpen;
 575           ch : CHAR;
 576     BEGIN
 577       ps := BOX(CSt.binDir$);
 578       ch := ps[LEN(ps) - 2];
 579       IF (ch # "/") & (ch # "\") THEN
 580         ps := BOX(ps^ + genSep + fn);
 581       ELSE
 582         ps := BOX(ps^ + fn);
 583       END;
 584       RETURN ps;
 585     END GetFullPath;
 586    (* ------------------------------------------------- *)
 587   BEGIN
 588     IF CSt.binDir # "" THEN
 589       ptr := GetFullPath(fileName);
 590     ELSE
 591       ptr := BOX(fileName$);
 592     END;
 593     Warp(ptr);
 594 (*
 595  *  IF GPFiles.fileSep # "/" THEN Warp(fileName) END;
 596  *
 597  *  srcFileName := L.strToCharOpen(CSt.srcNam);
 598  *  NEW(f);
 599  *
 600  *  f.file := F.createPath(fileName);
 601  *)
 602     srcFileName := BOX(CSt.srcNam$);
 603     NEW(fil);
 604     fil.file := F.createPath(ptr);
 605
 606     IF fil.file = NIL THEN RETURN NIL; END;
 607 (*
 608  *  Console.WriteString("Creating file ");
 609  *  Console.WriteString(ptr);
 610  *  Console.WriteLn;
 611  *)
 612     fil.access := 0;
 613     NEW(fil.cp.pool,initSize);
 614     fil.cp.tide := 1;
 615     fil.thisClassIx := 0;
 616     fil.superClassIx := 0;
 617     fil.numInterfaces := 0;
 618     fil.numFields := 0;
 619     fil.numMethods := 0;
 620     fil.srcFileIx := AddUTF(fil.cp,srcFileName);
 621     fil.srcFileAttIx := AddUTF(fil.cp,srcFileStr);
 622     fil.codeAttIx := AddUTF(fil.cp,codeStr);
 623     fil.exceptAttIx := 0;
 624     fil.lineNumTabIx := 0;
 625     fil.jlExceptIx := 0;
 626     RETURN fil;
 627   END newClassFile;
 628
 629   PROCEDURE (cf : ClassFile) StartModClass*(mod : Id.BlkId);
 630   BEGIN
 631     cf.access := Jvm.acc_public + Jvm.acc_final + Jvm.acc_super;
 632     cf.thisClassIx := AddModClassRef(cf.cp,mod);
 633     cf.superClassIx := AddClassRef(cf.cp,object);
 634   END StartModClass;
 635
 636   PROCEDURE^ (cf : ClassFile) AddInterface*(interface : Ty.Record),NEW;
 637
 638   PROCEDURE (cf : ClassFile)StartRecClass*(rec : Ty.Record);
 639   VAR
 640     clsId  : D.Idnt;
 641     impRec : D.Type;
 642     recAcc : INTEGER;
 643     index  : INTEGER;
 644   BEGIN
 645     recAcc := Jvm.acc_super;
 646     IF rec.recAtt = Ty.noAtt THEN
 647       recAcc := recAcc + Jvm.acc_final;
 648     ELSIF rec.recAtt = Ty.isAbs THEN
 649       recAcc := recAcc + Jvm.acc_abstract;
 650     END;
 651     IF rec.bindTp = NIL THEN
 652       clsId := rec.idnt;
 653     ELSE
 654       clsId := rec.bindTp.idnt;
 655     END;
 656     IF clsId # NIL THEN
 657       IF clsId.vMod = D.pubMode THEN
 658         recAcc := recAcc + Jvm.acc_public;
 659       ELSIF clsId.vMod = D.prvMode THEN
 660         recAcc := recAcc + Jvm.acc_package;
 661       END;
 662     END;
 663     cf.access := recAcc;
 664     cf.thisClassIx := AddRecClassRef(cf.cp,rec);
 665     IF rec.baseTp IS Ty.Record THEN
 666       IF rec.baseTp.xName = NIL THEN J.MkRecName(rec.baseTp(Ty.Record)); END;
 667       cf.superClassIx := AddClassRef(cf.cp,rec.baseTp.xName);
 668     ELSE
 669       cf.superClassIx := AddClassRef(cf.cp,object);
 670     END;
 671    (*
 672     *   Emit interface declarations (if any)
 673     *)
 674     IF rec.interfaces.tide > 0 THEN
 675       FOR index := 0 TO rec.interfaces.tide-1 DO
 676         impRec := rec.interfaces.a[index];
 677         cf.AddInterface(impRec.boundRecTp()(Ty.Record));
 678       END;
 679     END;
 680   END StartRecClass;
 681
 682 (* ============================================================ *)
 683 (*                   Java Class File Stuff                      *)
 684 (* ============================================================ *)
 685
 686   PROCEDURE (cf : ClassFile) InitFields*(numFields : INTEGER);
 687   BEGIN
 688     NEW(cf.fields,numFields);
 689   END InitFields;
 690
 691   PROCEDURE (cf : ClassFile) AddField*(field : FieldInfo),NEW;
 692   CONST
 693     incSize = 10;
 694   VAR
 695     tmp : POINTER TO ARRAY OF FieldInfo;
 696     i : INTEGER;
 697   BEGIN
 698     IF cf.fields = NIL THEN
 699       NEW(cf.fields,incSize);
 700     ELSIF cf.numFields >= LEN(cf.fields) THEN
 701       tmp := cf.fields;
 702       NEW(cf.fields,cf.numFields+incSize);
 703       FOR i := 0 TO cf.numFields-1 DO
 704         cf.fields[i] := tmp[i];
 705       END;
 706     END;
 707     cf.fields[cf.numFields] := field;
 708     INC(cf.numFields);
 709   END AddField;
 710
 711   PROCEDURE (cf : ClassFile) InitMethods*(numMethods : INTEGER);
 712   BEGIN
 713     NEW(cf.methods,numMethods);
 714   END InitMethods;
 715
 716   PROCEDURE (cf : ClassFile)AddMethod*(method : MethodInfo),NEW;
 717   CONST
 718     incSize = 10;
 719   VAR
 720     tmp : POINTER TO ARRAY OF MethodInfo;
 721     i : INTEGER;
 722   BEGIN
 723     IF cf.methods = NIL THEN
 724       NEW(cf.methods,incSize);
 725     ELSIF cf.numMethods >= LEN(cf.methods) THEN
 726       tmp := cf.methods;
 727       NEW(cf.methods,cf.numMethods+incSize);
 728       FOR i := 0 TO cf.numMethods-1 DO
 729         cf.methods[i] := tmp[i];
 730       END;
 731     END;
 732     cf.methods[cf.numMethods] := method;
 733     INC(cf.numMethods);
 734   END AddMethod;
 735
 736   PROCEDURE (cf : ClassFile) InitInterfaces*(numInterfaces : INTEGER),NEW;
 737   BEGIN
 738     NEW(cf.interfaces,numInterfaces);
 739   END InitInterfaces;
 740
 741   PROCEDURE (cf : ClassFile) AddInterface*(interface : Ty.Record),NEW;
 742   CONST
 743     incSize = 10;
 744   VAR
 745     tmp : POINTER TO ARRAY OF INTEGER;
 746     i, intIx : INTEGER;
 747   BEGIN
 748     IF cf.interfaces = NIL THEN
 749       NEW(cf.interfaces,incSize);
 750     ELSIF cf.numInterfaces >= LEN(cf.interfaces) THEN
 751       tmp := cf.interfaces;
 752       NEW(cf.interfaces,cf.numInterfaces+incSize);
 753       FOR i := 0 TO cf.numInterfaces-1 DO
 754         cf.interfaces[i] := tmp[i];
 755       END;
 756     END;
 757     IF interface.xName = NIL THEN J.MkRecName(interface); END;
 758     intIx := AddRecClassRef(cf.cp,interface);
 759     cf.interfaces[cf.numInterfaces] := intIx;
 760     INC(cf.numInterfaces);
 761   END AddInterface;
 762
 763 (* ============================================================ *)
 764 (*                      FieldInfo Methods                       *)
 765 (* ============================================================ *)
 766
 767   PROCEDURE (cf : ClassFile) EmitField*(field : Id.AbVar);
 768   VAR
 769     f : FieldInfo;
 770   BEGIN
 771     NEW(f);
 772     CASE field.vMod OF
 773     | D.prvMode : f.access := Jvm.acc_package;
 774     | D.pubMode : f.access := Jvm.acc_public;
 775     | D.rdoMode : f.access := Jvm.acc_public;
 776     | D.protect : f.access := Jvm.acc_protected;
 777     END;
 778     WITH field : Id.VarId DO
 779       f.access := f.access + Jvm.acc_static;
 780       IF field.varNm = NIL THEN J.MkVarName(field(Id.VarId)); END;
 781       f.nameIx := AddUTF(cf.cp,field.varNm);
 782     | field : Id.FldId DO
 783       f.nameIx := AddUTF(cf.cp,D.getName.ChPtr(field));
 784     END;
 785     f.descIx := AddUTF(cf.cp, GetTypeName(field.type));
 786     f.constValIx := -1; (* constants not currently stored in class file *)
 787     cf.AddField(f);
 788   END EmitField;
 789
 790 (* ============================================================ *)
 791 (*                      MethodInfo Methods                      *)
 792 (* ============================================================ *)
 793
 794   PROCEDURE newMethodInfo*(meth : Id.Procs) : MethodInfo;
 795     VAR m : MethodInfo;
 796   BEGIN
 797     NEW(m);
 798     m.methId := meth;
 799     IF meth = NIL THEN
 800       m.localNum := 0;
 801       m.maxLocals := 1;
 802     ELSE        (* Id.BlkId *)
 803       m.localNum := meth.rtsFram;
 804       m.maxLocals := MAX(meth.rtsFram, 1);
 805     END;
 806     m.currStack := 0;
 807     m.maxStack := 0;
 808     NEW(m.codes.code,initSize);
 809     m.codes.tide := 0;
 810     m.codes.codeLen := 0;
 811     m.lineNumTab.tide := 0;
 812     RETURN m;
 813   END newMethodInfo;
 814
 815 (* ------------------------------------------------------------ *)
 816
 817   PROCEDURE (cf : ClassFile)StartProc*(proc : Id.Procs);
 818   VAR
 819     attr : INTEGER;
 820     method : Id.MthId;
 821   BEGIN
 822     cf.meth := newMethodInfo(proc);
 823     cf.AddMethod(cf.meth);
 824    (*
 825     *  Compute the method attributes
 826     *)
 827     IF proc.kind = Id.conMth THEN
 828       method := proc(Id.MthId);
 829       attr := 0;
 830       IF method.mthAtt * Id.mask = {} THEN attr := Jvm.acc_final; END;
 831       IF method.mthAtt * Id.mask = Id.isAbs THEN
 832         attr := attr + Jvm.acc_abstract;
 833       END;
 834       IF Id.widen IN method.mthAtt THEN attr := attr + Jvm.acc_public END;
 835     ELSE
 836       attr := Jvm.acc_static;
 837     END;
 838 (*
 839  *  The following code fails for "implement-only" methods
 840  *  since the JVM places the "override method" in a different
 841  *  slot! We must thus live with the insecurity of public mode.
 842  *
 843  *  IF proc.vMod = D.pubMode THEN       (* explicitly public *)
 844  *)
 845     IF (proc.vMod = D.pubMode) OR       (* explicitly public *)
 846        (proc.vMod = D.rdoMode) THEN     (* "implement only"  *)
 847       attr := attr + Jvm.acc_public;
 848     ELSIF proc.dfScp IS Id.PrcId THEN   (* nested procedure  *)
 849       attr := attr + Jvm.acc_private;
 850     END;
 851     cf.meth.access := attr;
 852     IF (cf.meth.access >= Jvm.acc_abstract) THEN
 853       cf.meth.maxLocals := 0;
 854     END;
 855     cf.meth.nameIx := AddUTF(cf.cp,proc.prcNm);
 856     cf.meth.descIx := AddUTF(cf.cp,proc.type.xName);
 857   END StartProc;
 858
 859   PROCEDURE (cf : ClassFile)isAbstract*() : BOOLEAN;
 860   BEGIN
 861     RETURN (cf.meth.access >= Jvm.acc_abstract);
 862   END isAbstract;
 863
 864 (* ------------------------------------------------------------ *)
 865
 866   PROCEDURE (cf : ClassFile)getScope*() : D.Scope;
 867   BEGIN
 868     RETURN cf.meth.methId;
 869   END getScope;
 870
 871 (* ------------------------------------------------------------ *)
 872
 873   PROCEDURE (cf : ClassFile)newLocal*() : INTEGER;
 874     VAR ord : INTEGER;
 875   BEGIN
 876     ord := cf.meth.localNum;
 877     INC(cf.meth.localNum);
 878     IF cf.meth.localNum > cf.meth.maxLocals THEN
 879       cf.meth.maxLocals := cf.meth.localNum;
 880     END;
 881     RETURN ord;
 882   END newLocal;
 883
 884 (* ------------------------------------------------------------ *)
 885
 886   PROCEDURE (cf : ClassFile)ReleaseLocal*(i : INTEGER);
 887   BEGIN
 888    (*
 889     *  If you try to release not in LIFO order, the
 890     *  location will not be made free again. This is safe!
 891     *)
 892     IF i+1 = cf.meth.localNum THEN DEC(cf.meth.localNum) END;
 893   END ReleaseLocal;
 894
 895 (* ------------------------------------------------------------ *)
 896
 897   PROCEDURE (cf : ClassFile)markTop*() : INTEGER;
 898   BEGIN
 899     RETURN cf.meth.localNum;
 900   END markTop;
 901
 902 (* ------------------------------------------------------------ *)
 903
 904   PROCEDURE (cf : ClassFile)ReleaseAll*(m : INTEGER);
 905   BEGIN
 906     cf.meth.localNum := m;
 907   END ReleaseAll;
 908
 909 (* ------------------------------------------------------------ *)
 910
 911   PROCEDURE (cf : ClassFile)getDepth*() : INTEGER;
 912   BEGIN RETURN cf.meth.currStack END getDepth;
 913
 914   (* ------------------------------------------ *)
 915
 916   PROCEDURE (cf : ClassFile)setDepth*(i : INTEGER);
 917   BEGIN cf.meth.currStack := i END setDepth;
 918
 919
 920 (* ============================================================ *)
 921 (*                      Init Methods                            *)
 922 (* ============================================================ *)
 923
 924   PROCEDURE (cf : ClassFile)ClinitHead*();
 925   VAR
 926     meth : MethodInfo;
 927     returned : BOOLEAN;
 928   BEGIN
 929     meth := newMethodInfo(NIL);
 930     cf.AddMethod(meth);
 931     meth.access := pubStat;
 932     meth.nameIx := AddUTF(cf.cp,clinit);
 933     meth.descIx := AddUTF(cf.cp,noArgVoid);
 934     cf.meth := meth;
 935   END ClinitHead;
 936
 937 (* ============================================================ *)
 938
 939   PROCEDURE (cf : ClassFile)VoidTail*();
 940   BEGIN
 941     cf.Code(Jvm.opc_return);
 942   END VoidTail;
 943
 944 (* ============================================================ *)
 945
 946   PROCEDURE^ (cf : ClassFile)CallS*(code : INTEGER;
 947                             IN className : L.CharOpen;
 948                             IN procName  : L.CharOpen;
 949                             IN signature : L.CharOpen;
 950                                argL,retL : INTEGER),NEW;
 951
 952 (* ============================================================ *)
 953
 954   PROCEDURE (cf : ClassFile)MainHead*();
 955   VAR
 956     meth : MethodInfo;
 957     returned : BOOLEAN;
 958   BEGIN
 959     meth := newMethodInfo(NIL);
 960     cf.AddMethod(meth);
 961     meth.access := pubStat;
 962     meth.nameIx := AddUTF(cf.cp,main);
 963     meth.descIx := AddUTF(cf.cp,mainSig);
 964     cf.meth := meth;
 965    (*
 966     *  Save the command-line arguments to the RTS.
 967     *)
 968     cf.Code(Jvm.opc_aload_0);
 969     cf.CallS(Jvm.opc_invokestatic,CPmainClass,putArgs,mainSig,1,0);
 970   END MainHead;
 971
 972 (* ============================================================ *)
 973
 974   PROCEDURE (cf : ClassFile)ModNoArgInit*();
 975   VAR
 976     meth : MethodInfo;
 977   BEGIN
 978     meth := newMethodInfo(NIL);
 979     cf.AddMethod(meth);
 980     meth.access := Jvm.acc_public;
 981     meth.nameIx := AddUTF(cf.cp,init);
 982     meth.descIx := AddUTF(cf.cp,noArgVoid);
 983     cf.meth := meth;
 984     cf.Code(Jvm.opc_aload_0);
 985     cf.CallS(Jvm.opc_invokespecial,object,init,noArgVoid,1,0);
 986     cf.Code(Jvm.opc_return);
 987   END ModNoArgInit;
 988
 989 (* ---------------------------------------------------- *)
 990
 991   PROCEDURE (cf : ClassFile)RecMakeInit*(rec : Ty.Record;
 992                                          prc : Id.PrcId);
 993     VAR meth : MethodInfo;
 994         pTp : Ty.Procedure;
 995         signature : L.CharOpen;
 996   BEGIN
 997     IF (prc = NIL) &
 998        ((D.noNew IN rec.xAttr) OR (D.xCtor IN rec.xAttr)) THEN
 999       RETURN;                                       (* PREMATURE RETURN HERE *)
1000     END;
1001     meth := newMethodInfo(prc);
1002     cf.AddMethod(meth);
1003     cf.meth := meth;
1004     cf.Code(Jvm.opc_aload_0);
1005     meth.access := Jvm.acc_public;
1006     meth.nameIx := AddUTF(cf.cp,init);
1007    (*
1008     *  Get the procedure type, if any.
1009     *)
1010     IF prc # NIL THEN
1011       pTp := prc.type(Ty.Procedure);
1012       J.MkCallAttr(prc, pTp);
1013       signature := pTp.xName;
1014     ELSE
1015       pTp := NIL;
1016       signature := noArgVoid;
1017     END;
1018     meth.descIx := AddUTF(cf.cp,signature);
1019   END RecMakeInit;
1020
1021 (*
1022  *  IF pTp # NIL THEN
1023  *   (*
1024  *    *  Copy the args to the super-constructor
1025  *    *)
1026  *    FOR idx := 0 TO pNm-1 DO cf.GetLocal(pTp.formals.a[idx]) END;
1027  *  END;
1028  *)
1029
1030   PROCEDURE (cf : ClassFile)CallSuperCtor*(rec : Ty.Record;
1031                                            pTy : Ty.Procedure);
1032     VAR idx : INTEGER;
1033         fld : D.Idnt;
1034         pNm : INTEGER;
1035         initClass : L.CharOpen;
1036         signature : L.CharOpen;
1037   BEGIN
1038     IF pTy # NIL THEN
1039       pNm := pTy.formals.tide;
1040       signature := pTy.xName;
1041     ELSE
1042       pNm := 0;                 (* was 1 *)
1043       signature := noArgVoid;
1044     END;
1045    (*
1046     *    Initialize the embedded superclass object.
1047     *)
1048     IF (rec.baseTp # NIL) & (rec.baseTp # G.anyRec) THEN
1049       initClass := rec.baseTp(Ty.Record).xName;
1050     ELSE
1051       initClass := object;
1052     END;
1053     cf.CallS(Jvm.opc_invokespecial, initClass, init, signature, pNm+1, 0);
1054    (*
1055     *    Initialize fields, as necessary.
1056     *)
1057     FOR idx := 0 TO rec.fields.tide-1 DO
1058       fld := rec.fields.a[idx];
1059       IF (fld.type IS Ty.Record) OR (fld.type IS Ty.Array) THEN
1060         cf.Code(Jvm.opc_aload_0);
1061         cf.VarInit(fld);
1062         cf.PutGetF(Jvm.opc_putfield, rec, fld(Id.FldId));
1063       END;
1064     END;
1065 (*
1066  *  cf.Code(Jvm.opc_return);
1067  *)
1068   END CallSuperCtor;
1069
1070 (* ============================================================ *)
1071
1072   PROCEDURE makeClassVoidArgList(rec : Ty.Record) : L.CharOpen;
1073   BEGIN
1074     IF rec.xName = NIL THEN J.MkRecName(rec); END;
1075     RETURN J.cat3(J.lPar,rec.scopeNm,J.rParV);
1076   END makeClassVoidArgList;
1077
1078 (* ---------------------------------------------------- *)
1079
1080   PROCEDURE (cf : ClassFile)CopyProcHead*(rec : Ty.Record);
1081   VAR
1082     meth : MethodInfo;
1083   BEGIN
1084     meth := newMethodInfo(NIL);
1085     cf.AddMethod(meth);
1086     meth.access := Jvm.acc_public;
1087     meth.nameIx := AddUTF(cf.cp,copy);
1088     meth.descIx := AddUTF(cf.cp,makeClassVoidArgList(rec));
1089     cf.meth := meth;
1090   END CopyProcHead;
1091
1092 (* ============================================================ *)
1093 (*                      Private Methods                         *)
1094 (* ============================================================ *)
1095
1096   PROCEDURE (meth : MethodInfo)FixStack(code : INTEGER),NEW;
1097   BEGIN
1098     INC(meth.currStack, Jvm.dl[code]);
1099     IF meth.currStack > meth.maxStack THEN meth.maxStack := meth.currStack END;
1100   END FixStack;
1101
1102 (* ============================================================ *)
1103
1104   PROCEDURE GetTypeName*(typ : D.Type) : L.CharOpen;
1105   VAR
1106     arrayName : L.CharOpenSeq;
1107     arrayTy : D.Type;
1108   BEGIN
1109     WITH typ : Ty.Base DO
1110         RETURN typ.xName;
1111     | typ : Ty.Vector DO
1112         IF typ.xName = NIL THEN J.MkVecName(typ) END;
1113         RETURN typ.xName;
1114     | typ : Ty.Procedure DO
1115         IF typ.xName = NIL THEN J.MkProcTypeName(typ) END;
1116         RETURN typ.hostClass.scopeNm;
1117     | typ : Ty.Array DO
1118         IF typ.xName = NIL THEN
1119           L.InitCharOpenSeq(arrayName,3);
1120           arrayTy := typ;
1121           WHILE arrayTy IS Ty.Array DO
1122             L.AppendCharOpen(arrayName,J.brac);
1123             arrayTy := arrayTy(Ty.Array).elemTp;
1124           END;
1125           L.AppendCharOpen(arrayName,GetTypeName(arrayTy));
1126           typ.xName := L.arrayCat(arrayName);
1127         END;
1128         ASSERT(typ.xName # NIL);
1129         RETURN typ.xName;
1130     | typ : Ty.Record DO
1131         IF typ.xName = NIL THEN J.MkRecName(typ) END;
1132         RETURN typ.scopeNm;
1133     | typ : Ty.Enum DO
1134         RETURN G.intTp.xName;
1135     | typ : Ty.Pointer DO
1136         RETURN GetTypeName(typ.boundTp);
1137     | typ : Ty.Opaque DO
1138         IF typ.xName = NIL THEN J.MkAliasName(typ) END;
1139         RETURN typ.scopeNm;
1140     END;
1141   END GetTypeName;
1142
1143 (* ============================================================ *)
1144 (*                      Exported Methods                        *)
1145 (* ============================================================ *)
1146
1147   PROCEDURE (cf : ClassFile)newLabel*() : J.Label;
1148   VAR
1149     lab : J.Label;
1150   BEGIN
1151     NEW(lab);
1152     lab.defIx := 0;
1153     RETURN lab;
1154   END newLabel;
1155
1156 (* ============================================================ *)
1157
1158   PROCEDURE (cf : ClassFile)getLabelRange*(VAR labs : ARRAY OF J.Label);
1159   VAR
1160     i : INTEGER;
1161   BEGIN
1162     FOR i := 0 TO LEN(labs)-1 DO
1163       NEW(labs[i]);
1164       labs[i].defIx := 0;
1165     END;
1166   END getLabelRange;
1167
1168 (* ============================================================ *)
1169
1170   PROCEDURE (VAR lst : CodeList)AddInstruction(op : Op),NEW;
1171   VAR
1172     tmp : POINTER TO ARRAY OF Op;
1173     i : INTEGER;
1174   BEGIN
1175     ASSERT(lst.code # NIL);
1176     IF lst.tide >= LEN(lst.code) THEN
1177       tmp := lst.code;
1178       NEW(lst.code,2 * lst.tide);
1179       FOR i := 0 TO lst.tide-1 DO
1180         lst.code[i] := tmp[i];
1181       END;
1182     END;
1183     lst.code[lst.tide] := op;
1184     INC(lst.tide);
1185   END AddInstruction;
1186
1187 (* -------------------------------------------- *)
1188
1189   PROCEDURE (cf : ClassFile)DefLab*(lab : J.Label);
1190   BEGIN
1191     ASSERT(lab.defIx = 0);
1192     lab.defIx := cf.meth.codes.codeLen;
1193   END DefLab;
1194
1195   PROCEDURE (cf : ClassFile)DefLabC*(lab : J.Label; IN c : ARRAY OF CHAR);
1196   BEGIN
1197     ASSERT(lab.defIx = 0);
1198     lab.defIx := cf.meth.codes.codeLen;
1199   END DefLabC;
1200
1201 (* -------------------------------------------- *)
1202
1203   PROCEDURE (cf : ClassFile)AddSwitchLab*(lab : J.Label; pos : INTEGER);
1204   VAR
1205     sw : OpSwitch;
1206   BEGIN
1207     sw := cf.meth.codes.code[cf.meth.codes.tide-1](OpSwitch);
1208     sw.offs[pos] := lab;
1209   END AddSwitchLab;
1210
1211 (* -------------------------------------------- *)
1212
1213   PROCEDURE (cf : ClassFile)CodeLb*(code : INTEGER; lab : J.Label);
1214   VAR
1215     tmp : POINTER TO ARRAY OF INTEGER;
1216     i : INTEGER;
1217     op : OpL;
1218   BEGIN
1219     NEW(op);
1220     op.offset := cf.meth.codes.codeLen;
1221     op.op := code;
1222     op.lab := lab;
1223     INC(cf.meth.codes.codeLen,3);
1224     cf.meth.codes.AddInstruction(op);
1225     cf.meth.FixStack(code);
1226   END CodeLb;
1227
1228 (* -------------------------------------------- *)
1229
1230   PROCEDURE (cf : ClassFile)Code*(code : INTEGER);
1231   VAR
1232     op : Op;
1233   BEGIN
1234     NEW(op);
1235     op.offset := cf.meth.codes.codeLen;
1236     op.op := code;
1237     INC(cf.meth.codes.codeLen);
1238     cf.meth.codes.AddInstruction(op);
1239     cf.meth.FixStack(code);
1240   END Code;
1241
1242 (* -------------------------------------------- *)
1243
1244   PROCEDURE (cf : ClassFile)CodeI*(code,val : INTEGER);
1245   VAR
1246     op : OpI;
1247   BEGIN
1248     NEW(op);
1249     op.offset := cf.meth.codes.codeLen;
1250     op.op := code;
1251     op.val := val;
1252     IF (val > maxUnsignedByte) &
1253        (((code >= Jvm.opc_iload) & (code <= Jvm.opc_aload)) OR
1254        ((code >= Jvm.opc_istore) & (code <= Jvm.opc_astore))) THEN
1255       cf.Code(Jvm.opc_wide);
1256       op.numBytes := 2;
1257       INC(cf.meth.codes.codeLen,3);
1258     ELSE
1259       op.numBytes := 1;
1260       INC(cf.meth.codes.codeLen,2);
1261     END;
1262     cf.meth.codes.AddInstruction(op);
1263     cf.meth.FixStack(code);
1264   END CodeI;
1265
1266 (* -------------------------------------------- *)
1267
1268   PROCEDURE (cf : ClassFile)Code2I*(code,val : INTEGER; updateS : BOOLEAN),NEW;
1269   VAR
1270     op : OpI;
1271   BEGIN
1272     NEW(op);
1273     op.offset := cf.meth.codes.codeLen;
1274     op.op := code;
1275     op.val := val;
1276     op.numBytes := 2;
1277     INC(cf.meth.codes.codeLen,3);
1278     cf.meth.codes.AddInstruction(op);
1279     IF updateS THEN cf.meth.FixStack(code); END;
1280   END Code2I;
1281
1282 (* -------------------------------------------- *)
1283
1284   PROCEDURE (cf : ClassFile)Code4I*(code,val : INTEGER),NEW;
1285   VAR
1286     op : OpI;
1287   BEGIN
1288     NEW(op);
1289     op.offset := cf.meth.codes.codeLen;
1290     op.op := code;
1291     op.val := val;
1292     op.numBytes := 4;
1293     INC(cf.meth.codes.codeLen,5);
1294     cf.meth.codes.AddInstruction(op);
1295     cf.meth.FixStack(code);
1296   END Code4I;
1297
1298 (* -------------------------------------------- *)
1299
1300   PROCEDURE (cf : ClassFile)Code2IB*(code,val,bVal : INTEGER;
1301                                      endZero : BOOLEAN; updateS : BOOLEAN),NEW;
1302   VAR
1303     op : Op2IB;
1304     instSize : INTEGER;
1305   BEGIN
1306     NEW(op);
1307     op.offset := cf.meth.codes.codeLen;
1308     op.op := code;
1309     op.val := val;
1310     op.bVal := bVal;
1311     op.trailingZero := endZero;
1312     IF endZero THEN INC(cf.meth.codes.codeLen,5);
1313     ELSE INC(cf.meth.codes.codeLen,4); END;
1314     cf.meth.codes.AddInstruction(op);
1315     IF updateS THEN cf.meth.FixStack(code); END;
1316   END Code2IB;
1317
1318 (* -------------------------------------------- *)
1319
1320   PROCEDURE (cf : ClassFile)CodeL*(code : INTEGER; num : LONGINT);
1321   VAR
1322     conIx : INTEGER;
1323   BEGIN
1324     conIx := AddConstLong(cf.cp,num);
1325     cf.Code2I(Jvm.opc_ldc2_w, conIx, TRUE);
1326   END CodeL;
1327
1328   PROCEDURE (cf : ClassFile)CodeR*(code : INTEGER; num : REAL; short : BOOLEAN);
1329   VAR
1330     conIx : INTEGER;
1331   BEGIN
1332     IF short THEN
1333       conIx := AddConstFloat(cf.cp,SHORT(num));
1334       IF conIx > maxUnsignedByte THEN
1335         cf.Code2I(Jvm.opc_ldc_w, conIx, TRUE);
1336       ELSE
1337         cf.CodeI(Jvm.opc_ldc, conIx);
1338       END;
1339     ELSE
1340       conIx := AddConstDouble(cf.cp,num);
1341       cf.Code2I(Jvm.opc_ldc2_w, conIx, TRUE);
1342     END;
1343   END CodeR;
1344
1345 (* -------------------------------------------- *)
1346
1347   PROCEDURE (cf : ClassFile)CodeInc*(localIx,incVal : INTEGER);
1348   VAR
1349     op : OpII;
1350     needWide : BOOLEAN;
1351   BEGIN
1352     needWide := (localIx > maxUnsignedByte) OR (incVal < MIN(BYTE)) OR
1353                 (incVal > MAX(BYTE));
1354     IF needWide THEN cf.Code(Jvm.opc_wide); END;
1355     NEW(op);
1356     op.offset := cf.meth.codes.codeLen;
1357     op.op := Jvm.opc_iinc;
1358     op.val1 := localIx;
1359     op.val2 := incVal;
1360     IF needWide THEN
1361       op.numBytes := 2;
1362       INC(cf.meth.codes.codeLen,5);
1363     ELSE
1364       op.numBytes := 1;
1365       INC(cf.meth.codes.codeLen,3);
1366     END;
1367     cf.meth.codes.AddInstruction(op);
1368   END CodeInc;
1369
1370 (* -------------------------------------------- *)
1371
1372   PROCEDURE (cf : ClassFile)CodeSwitch*(low,high : INTEGER; defLab : J.Label);
1373   VAR
1374     sw : OpSwitch;
1375     len : INTEGER;
1376   BEGIN
1377     NEW(sw);
1378     sw.offset := cf.meth.codes.codeLen;
1379     sw.op := Jvm.opc_tableswitch;
1380     sw.defLabel := defLab;
1381     sw.low := low;
1382     sw.high := high;
1383     len := high-low+1;
1384     NEW(sw.offs,len);
1385     sw.padding := 3 - (sw.offset MOD 4);
1386     INC(cf.meth.codes.codeLen,13+sw.padding+4*len);
1387     cf.meth.codes.AddInstruction(sw);
1388     cf.meth.FixStack(Jvm.opc_tableswitch);
1389   END CodeSwitch;
1390
1391 (* -------------------------------------------- *)
1392
1393   PROCEDURE (cf : ClassFile)CodeT*(code : INTEGER; ty : D.Type);
1394   VAR
1395     op : OpI;
1396   BEGIN
1397     IF ty IS Ty.Pointer THEN ty := ty(Ty.Pointer).boundTp; END;
1398     NEW(op);
1399     op.offset := cf.meth.codes.codeLen;
1400     op.op := code;
1401 (*
1402  *  // old code ...
1403  *  op.val := AddRecClassRef(cf.cp,ty(Ty.Record));
1404  *  // now new code ...
1405  *)
1406     IF ty IS Ty.Record THEN
1407       op.val := AddRecClassRef(cf.cp, ty(Ty.Record));
1408     ELSE
1409       op.val := AddClassRef(cf.cp, GetTypeName(ty));
1410     END;
1411
1412     op.numBytes := 2;
1413     INC(cf.meth.codes.codeLen,3);
1414     cf.meth.codes.AddInstruction(op);
1415     cf.meth.FixStack(code);
1416   END CodeT;
1417
1418 (* -------------------------------------------- *)
1419
1420   PROCEDURE (cf : ClassFile)CodeC*(code : INTEGER; IN str : ARRAY OF CHAR);
1421   VAR
1422     op : Op;
1423   BEGIN
1424     NEW(op);
1425     op.offset := cf.meth.codes.codeLen;
1426     op.op := code;
1427     INC(cf.meth.codes.codeLen);
1428     cf.meth.codes.AddInstruction(op);
1429     cf.meth.FixStack(code);
1430   END CodeC;
1431
1432 (* -------------------------------------------- *)
1433   PROCEDURE (cf : ClassFile)PushStr*(IN str : L.CharOpen);
1434   (* Use target quoting conventions for the literal string *)
1435   VAR
1436     strIx : INTEGER;
1437   BEGIN
1438     strIx := AddStringRef(cf.cp,str);
1439     IF strIx > maxUnsignedByte THEN
1440       cf.Code2I(Jvm.opc_ldc_w, strIx, TRUE);
1441     ELSE
1442       cf.CodeI(Jvm.opc_ldc, strIx);
1443     END;
1444   END PushStr;
1445
1446 (* ============================================================ *)
1447
1448   PROCEDURE (cf : ClassFile)CallS*(code : INTEGER;
1449                                    IN className : L.CharOpen;
1450                                    IN procName  : L.CharOpen;
1451                                    IN signature : L.CharOpen;
1452                                       argL,retL : INTEGER),NEW;
1453   VAR
1454     cIx,mIx : INTEGER;
1455   BEGIN
1456     ASSERT(code # Jvm.opc_invokeinterface);
1457     cIx := AddClassRef(cf.cp,className);
1458     mIx := AddMethodRef(cf.cp,cIx,procName,signature);
1459     cf.Code2I(code,mIx,FALSE);
1460     INC(cf.meth.currStack, retL-argL);
1461     IF cf.meth.currStack > cf.meth.maxStack THEN
1462       cf.meth.maxStack := cf.meth.currStack;
1463     END;
1464   END CallS;
1465
1466 (* ============================================================ *)
1467
1468   PROCEDURE (cf : ClassFile)CallIT*(code : INTEGER;
1469                                    proc : Id.Procs;
1470                                    type : Ty.Procedure);
1471     VAR cIx,mIx : INTEGER;
1472         scp : D.Scope;
1473   BEGIN
1474     IF proc.scopeNm = NIL THEN J.MkProcName(proc) END;
1475     WITH proc : Id.PrcId DO
1476       cIx := AddClassRef(cf.cp,proc.clsNm);
1477     |    proc : Id.MthId DO
1478       cIx := AddRecClassRef(cf.cp,proc.bndType(Ty.Record));
1479     END;
1480     IF code = Jvm.opc_invokeinterface THEN
1481       mIx := AddInterfaceMethodRef(cf.cp,cIx,proc.prcNm,proc.type.xName);
1482       cf.Code2IB(code,mIx,type.argN,TRUE,FALSE);
1483     ELSE
1484       mIx := AddMethodRef(cf.cp,cIx,proc.prcNm,proc.type.xName);
1485       cf.Code2I(code,mIx,FALSE);
1486     END;
1487     INC(cf.meth.currStack, type.retN-type.argN);
1488     IF cf.meth.currStack > cf.meth.maxStack THEN
1489       cf.meth.maxStack := cf.meth.currStack;
1490     END;
1491   END CallIT;
1492
1493 (* ============================================================ *)
1494
1495   PROCEDURE (cf : ClassFile)MultiNew*(arrName : L.CharOpen;
1496                                      dms : INTEGER),NEW;
1497    (* dsc is the array descriptor, dms the number of dimensions *)
1498   VAR
1499     classIx : INTEGER;
1500   BEGIN
1501     classIx := AddClassRef(cf.cp,arrName);
1502     cf.Code2IB(Jvm.opc_multianewarray,classIx,dms,FALSE,TRUE);
1503     DEC(cf.meth.currStack, dms-1);
1504   END MultiNew;
1505
1506 (* ============================================================ *)
1507
1508   PROCEDURE (cf : ClassFile)PutGetS*(code : INTEGER;
1509                                     blk  : Id.BlkId;
1510                                     fld  : Id.VarId);
1511     VAR size : INTEGER;
1512         classIx : INTEGER;
1513         fieldIx : INTEGER;
1514         op : OpI;
1515   (* Emit putstatic and getstatic for static field *)
1516   BEGIN
1517     IF blk.xName = NIL THEN J.MkBlkName(blk) END;
1518     IF fld.varNm = NIL THEN J.MkVarName(fld) END;
1519     IF fld.recTyp = NIL THEN
1520       classIx := AddModClassRef(cf.cp,blk);
1521     ELSE
1522       classIx := AddRecClassRef(cf.cp,fld.recTyp(Ty.Record));
1523     END;
1524     fieldIx := AddFieldRef(cf.cp,classIx,fld.varNm,GetTypeName(fld.type));
1525     NEW(op);
1526     op.offset := cf.meth.codes.codeLen;
1527     op.op := code;
1528     op.val := fieldIx;
1529     op.numBytes := 2;
1530     INC(cf.meth.codes.codeLen,3);
1531     cf.meth.codes.AddInstruction(op);
1532     size := J.jvmSize(fld.type);
1533     IF    code = Jvm.opc_getstatic THEN INC(cf.meth.currStack, size);
1534     ELSIF code = Jvm.opc_putstatic THEN DEC(cf.meth.currStack, size);
1535     END;
1536     IF cf.meth.currStack > cf.meth.maxStack THEN
1537       cf.meth.maxStack := cf.meth.currStack
1538     END;
1539   END PutGetS;
1540
1541 (* -------------------------------------------- *)
1542
1543   PROCEDURE (cf : ClassFile)PutGetF*(code : INTEGER;
1544                                     rec  : Ty.Record;
1545                                     fld  : Id.AbVar);
1546     VAR size : INTEGER;
1547         classIx : INTEGER;
1548         fieldIx : INTEGER;
1549         op : OpI;
1550   (* Emit putfield and getfield for record field *)
1551   BEGIN
1552     classIx := AddRecClassRef(cf.cp,rec);
1553     fieldIx := AddFieldRef(cf.cp,classIx,D.getName.ChPtr(fld),
1554                            GetTypeName(fld.type));
1555     NEW(op);
1556     op.offset := cf.meth.codes.codeLen;
1557     op.op := code;
1558     op.val := fieldIx;
1559     op.numBytes := 2;
1560     INC(cf.meth.codes.codeLen,3);
1561     cf.meth.codes.AddInstruction(op);
1562     size := J.jvmSize(fld.type);
1563     IF    code = Jvm.opc_getfield THEN INC(cf.meth.currStack, size-1);
1564     ELSIF code = Jvm.opc_putfield THEN DEC(cf.meth.currStack, size+1);
1565     END;
1566     IF cf.meth.currStack > cf.meth.maxStack THEN
1567       cf.meth.maxStack := cf.meth.currStack;
1568     END;
1569   END PutGetF;
1570
1571 (* ============================================================ *)
1572
1573   PROCEDURE (cf : ClassFile)Alloc1d*(elTp : D.Type);
1574   VAR
1575     tName : L.CharOpen;
1576     classIx : INTEGER;
1577   BEGIN
1578     WITH elTp : Ty.Base DO
1579       IF (elTp.tpOrd < Ty.anyRec) OR (elTp.tpOrd = Ty.uBytN) THEN
1580         cf.CodeI(Jvm.opc_newarray, typeArr[elTp.tpOrd]);
1581       ELSE
1582         classIx := AddClassRef(cf.cp,object);
1583         cf.Code2I(Jvm.opc_anewarray,classIx,TRUE);
1584       END;
1585     ELSE
1586       IF elTp IS Ty.Pointer THEN elTp := elTp(Ty.Pointer).boundTp; END;
1587       IF elTp IS Ty.Record THEN
1588         classIx := AddRecClassRef(cf.cp,elTp(Ty.Record));
1589       ELSE
1590         classIx := AddClassRef(cf.cp,GetTypeName(elTp));
1591       END;
1592       cf.Code2I(Jvm.opc_anewarray,classIx,TRUE);
1593     END;
1594   END Alloc1d;
1595
1596 (* ============================================================ *)
1597
1598   PROCEDURE (cf : ClassFile)MkNewRecord*(typ : Ty.Record);
1599   VAR
1600     methIx,classIx : INTEGER;
1601   BEGIN
1602     classIx := AddRecClassRef(cf.cp,typ);
1603     cf.Code2I(Jvm.opc_new,classIx,TRUE);
1604     cf.Code(Jvm.opc_dup);
1605     methIx := AddMethodRef(cf.cp,classIx,init,noArgVoid);
1606     cf.Code2I(Jvm.opc_invokespecial,methIx,TRUE);
1607   END MkNewRecord;
1608
1609 (* ============================================================ *)
1610
1611   PROCEDURE (cf : ClassFile)MkNewFixedArray*(topE : D.Type; len0 : INTEGER);
1612     VAR dims : INTEGER;
1613         arTp : Ty.Array;
1614         elTp : D.Type;
1615   BEGIN
1616     (*
1617     //  Fixed-size, possibly multi-dimensional arrays.
1618     //  The code relies on the semantic property in CP
1619     //  that the element-type of a fixed array type cannot
1620     //  be an open array. This simplifies the code somewhat.
1621     *)
1622     cf.PushInt(len0);
1623     dims := 1;
1624     elTp := topE;
1625    (*
1626     *  Find the number of dimensions ...
1627     *)
1628     LOOP
1629       WITH elTp : Ty.Array DO arTp := elTp ELSE EXIT END;
1630       elTp := arTp.elemTp;
1631       cf.PushInt(arTp.length);
1632       INC(dims);
1633     END;
1634     IF dims = 1 THEN
1635       cf.Alloc1d(elTp);
1636      (*
1637       *  Stack is (top) len0, ref...
1638       *)
1639       IF elTp.kind = Ty.recTp THEN cf.Init1dArray(elTp, len0) END;
1640     ELSE
1641      (*
1642       *  Allocate the array headers for all dimensions.
1643       *  Stack is (top) lenN, ... len0, ref...
1644       *)
1645       cf.MultiNew(cat2(J.brac,GetTypeName(topE)), dims);
1646      (*
1647       *  Stack is (top) ref...
1648       *)
1649       IF elTp.kind = Ty.recTp THEN cf.InitNdArray(topE, elTp) END;
1650     END;
1651   END MkNewFixedArray;
1652
1653 (* ============================================================ *)
1654
1655   PROCEDURE (cf : ClassFile)MkNewOpenArray*(arrT : Ty.Array;dims : INTEGER);
1656     VAR elTp : D.Type;
1657         indx : INTEGER;
1658   BEGIN
1659    (*
1660     *  Assert: lengths are pushed already...
1661     *  and we know from semantic analysis that
1662     *  the number of open array dimensions match
1663     *  the number of integer LENs in dims.
1664     *)
1665     elTp := arrT;
1666    (*
1667     *   Find the number of dimensions ...
1668     *)
1669     FOR indx := 0 TO dims-1 DO
1670       elTp := elTp(Ty.Array).elemTp;
1671     END;
1672    (*
1673     *   Allocate the array headers for all _open_ dimensions.
1674     *)
1675     IF dims = 1 THEN
1676       cf.Alloc1d(elTp);
1677      (*
1678       *  Stack is now (top) ref ...
1679       *  and we _might_ need to initialize the elements.
1680       *)
1681       IF (elTp.kind = Ty.recTp) OR
1682          (elTp.kind = Ty.arrTp) THEN
1683         cf.Init1dArray(elTp, 0);
1684       END;
1685     ELSE
1686       cf.MultiNew(GetTypeName(arrT), dims);
1687      (*
1688       *    Stack is now (top) ref ...
1689       *    Now we _might_ need to initialize the elements.
1690       *)
1691       IF (elTp.kind = Ty.recTp) OR
1692          (elTp.kind = Ty.arrTp) THEN
1693         cf.InitNdArray(arrT.elemTp, elTp);
1694       END;
1695     END;
1696   END MkNewOpenArray;
1697
1698 (* ============================================================ *)
1699
1700   PROCEDURE (cf : ClassFile)MkArrayCopy*(arrT : Ty.Array);
1701     VAR dims : INTEGER;
1702         elTp : D.Type;
1703   BEGIN
1704    (*
1705     *   Assert: we must find the lengths from the runtime
1706     *   descriptors.  Find the number of dimensions.  The
1707     *   array to copy is on the top of stack, which reads -
1708     *           (top) aRef, ...
1709     *)
1710     elTp := arrT.elemTp;
1711     IF elTp.kind # Ty.arrTp THEN
1712       cf.Code(Jvm.opc_arraylength);     (* (top) len0, aRef,... *)
1713       cf.Alloc1d(elTp);                      (* (top) aRef, ...         *)
1714       IF elTp.kind = Ty.recTp THEN cf.Init1dArray(elTp, 0) END; (*0 ==> open*)
1715     ELSE
1716       dims := 1;
1717       REPEAT
1718        (*
1719         *  Invariant: an array reference is on the top of
1720         *  of the stack, which reads:
1721         *               (top) [arRf, lengths,] arRf ...
1722         *)
1723         INC(dims);
1724         elTp := elTp(Ty.Array).elemTp;
1725         cf.Code(Jvm.opc_dup);        (*          arRf, arRf,... *)
1726         cf.Code(Jvm.opc_arraylength);   (*    len0, arRf, arRf,... *)
1727         cf.Code(Jvm.opc_swap);       (*    arRf, len0, arRf,... *)
1728         cf.Code(Jvm.opc_iconst_0);           (* 0, arRf, len0, arRf,... *)
1729         cf.Code(Jvm.opc_aaload);             (*    arRf, len0, arRf,... *)
1730        (*
1731         *  Stack reads: (top) arRf, lenN, [lengths,] arRf ...
1732         *)
1733       UNTIL  elTp.kind # Ty.arrTp;
1734      (*
1735       *  Now get the final length...
1736       *)
1737       cf.Code(Jvm.opc_arraylength);
1738      (*
1739       *   Stack reads:  (top) lenM, lenN, [lengths,] arRf ...
1740       *   Allocate the array headers for all dimensions.
1741       *)
1742       cf.MultiNew(GetTypeName(arrT), dims);
1743      (*
1744       *  Stack is (top) ref...
1745       *)
1746       IF elTp.kind = Ty.recTp THEN cf.InitNdArray(arrT.elemTp, elTp) END;
1747     END;
1748   END MkArrayCopy;
1749
1750 (* ============================================================ *)
1751
1752   PROCEDURE (cf : ClassFile)VarInit*(var : D.Idnt);
1753     VAR typ : D.Type;
1754   BEGIN
1755    (*
1756     *  Precondition: var is of a type that needs initialization
1757     *)
1758     typ := var.type;
1759     WITH typ : Ty.Record DO
1760         cf.MkNewRecord(typ);
1761     | typ : Ty.Array DO
1762         cf.MkNewFixedArray(typ.elemTp, typ.length);
1763     ELSE
1764       cf.Code(Jvm.opc_aconst_null);
1765     END;
1766   END VarInit;
1767
1768 (* ============================================================ *)
1769
1770   PROCEDURE (cf : ClassFile)ValRecCopy*(typ : Ty.Record);
1771   BEGIN
1772    (*
1773     *     Stack at entry is (top) srcRef, dstRef...
1774     *)
1775     IF typ.xName = NIL THEN J.MkRecName(typ) END;
1776     cf.CallS(Jvm.opc_invokevirtual, typ.xName, copy,
1777                                     makeClassVoidArgList(typ), 2, 0);
1778   END ValRecCopy;
1779
1780 (* ============================================================ *)
1781
1782   PROCEDURE (cf : ClassFile)CallRTS*(ix,args,ret : INTEGER);
1783   VAR
1784     className : L.CharOpen;
1785   BEGIN
1786     IF ix = J.ToUpper THEN
1787       className := charClass;
1788     ELSIF ix = J.DFloor THEN
1789       className := mathClass;
1790     ELSIF ix = J.SysExit THEN
1791       className := sysClass;
1792     ELSE
1793       className := rtsClass;
1794     END;
1795     cf.CallS(Jvm.opc_invokestatic,className,procNames[ix],procSigs[ix],args,ret);
1796   END CallRTS;
1797
1798 (* ============================================================ *)
1799
1800   PROCEDURE (cf : ClassFile)CallGetClass*();
1801   BEGIN
1802     cf.CallS(Jvm.opc_invokevirtual, object, getCls, noArgClass, 1, 1);
1803   END CallGetClass;
1804
1805 (* ============================================================ *)
1806
1807   PROCEDURE (cf : ClassFile)Trap*(IN str : ARRAY OF CHAR);
1808   VAR
1809    clIx : INTEGER;
1810   BEGIN
1811     clIx := AddClassRef(cf.cp,errorClass);
1812     cf.Code2I(Jvm.opc_new,clIx,TRUE);
1813     cf.Code(Jvm.opc_dup);
1814     cf.PushStr(L.strToCharOpen(str));
1815     cf.CallS(Jvm.opc_invokespecial,errorClass,init,errorInitSig,2,0);
1816     cf.Code(Jvm.opc_athrow);
1817   END Trap;
1818
1819 (* ============================================================ *)
1820
1821   PROCEDURE (cf : ClassFile)CaseTrap*(i : INTEGER);
1822   VAR
1823    clIx : INTEGER;
1824   BEGIN
1825     clIx := AddClassRef(cf.cp,errorClass);
1826     cf.Code2I(Jvm.opc_new,clIx,TRUE);
1827     cf.Code(Jvm.opc_dup);
1828     cf.LoadLocal(i, G.intTp);
1829     cf.CallS(Jvm.opc_invokestatic,rtsClass,caseTrap,caseTrapSig,1,1);
1830     cf.CallS(Jvm.opc_invokespecial,errorClass,init,errorInitSig,2,0);
1831     cf.Code(Jvm.opc_athrow);
1832   END CaseTrap;
1833
1834 (* ============================================================ *)
1835
1836   PROCEDURE (cf : ClassFile)WithTrap*(id : D.Idnt);
1837   VAR
1838    clIx : INTEGER;
1839   BEGIN
1840     clIx := AddClassRef(cf.cp,errorClass);
1841     cf.Code2I(Jvm.opc_new,clIx,TRUE);
1842     cf.Code(Jvm.opc_dup);
1843     cf.GetVar(id);
1844     cf.CallS(Jvm.opc_invokestatic,rtsClass,withTrap,withTrapSig,1,1);
1845     cf.CallS(Jvm.opc_invokespecial,errorClass,init,errorInitSig,2,0);
1846     cf.Code(Jvm.opc_athrow);
1847   END WithTrap;
1848
1849 (* ============================================================ *)
1850
1851   PROCEDURE (cf : ClassFile)Line*(nm : INTEGER);
1852   VAR
1853     tmpStart, tmpNum : POINTER TO ARRAY OF INTEGER;
1854     i : INTEGER;
1855   BEGIN
1856     IF cf.lineNumTabIx = 0 THEN
1857       cf.lineNumTabIx := AddUTF(cf.cp,lineNumTabStr);
1858     END;
1859     IF cf.meth.lineNumTab.start = NIL THEN
1860       NEW(cf.meth.lineNumTab.start,initSize);
1861       NEW(cf.meth.lineNumTab.lineNum,initSize);
1862     ELSIF cf.meth.lineNumTab.tide >= LEN(cf.meth.lineNumTab.start) THEN
1863       tmpStart := cf.meth.lineNumTab.start;
1864       tmpNum := cf.meth.lineNumTab.lineNum;
1865       NEW(cf.meth.lineNumTab.start,cf.meth.lineNumTab.tide + initSize);
1866       NEW(cf.meth.lineNumTab.lineNum,cf.meth.lineNumTab.tide + initSize);
1867       FOR i := 0 TO cf.meth.lineNumTab.tide-1 DO
1868         cf.meth.lineNumTab.start[i] := tmpStart[i];
1869         cf.meth.lineNumTab.lineNum[i] := tmpNum[i];
1870       END;
1871     END;
1872     cf.meth.lineNumTab.start[cf.meth.lineNumTab.tide] := cf.meth.codes.codeLen;
1873     cf.meth.lineNumTab.lineNum[cf.meth.lineNumTab.tide] := nm;
1874     INC(cf.meth.lineNumTab.tide);
1875   END Line;
1876
1877 (* ============================================================ *)
1878 (*                      Namehandling Methods                    *)
1879 (* ============================================================ *)
1880
1881   PROCEDURE cat2(i,j : L.CharOpen) : L.CharOpen;
1882   BEGIN
1883     L.ResetCharOpenSeq(J.nmArray);
1884     L.AppendCharOpen(J.nmArray, i);
1885     L.AppendCharOpen(J.nmArray, j);
1886     RETURN L.arrayCat(J.nmArray);
1887   END cat2;
1888
1889 (* ------------------------------------------------------------ *)
1890
1891
1892   PROCEDURE (cf : ClassFile)LoadConst*(num : INTEGER);
1893   VAR
1894     conIx : INTEGER;
1895   BEGIN
1896     IF (num >= MIN(SHORTINT)) & (num <= MAX(SHORTINT)) THEN
1897       cf.Code2I(Jvm.opc_sipush, num,TRUE);
1898     ELSE
1899       conIx := AddConstInt(cf.cp,num);
1900       IF conIx > maxUnsignedByte THEN
1901         cf.Code2I(Jvm.opc_ldc_w, conIx,TRUE);
1902       ELSE
1903         cf.CodeI(Jvm.opc_ldc, conIx);
1904       END;
1905     END;
1906   END LoadConst;
1907
1908 (* ------------------------------------------------------------ *)
1909
1910   PROCEDURE (cf : ClassFile)Try*();
1911     VAR start : INTEGER;
1912   BEGIN
1913     NEW(cf.meth.except);
1914     cf.meth.except.start := cf.meth.codes.codeLen;
1915     IF cf.jlExceptIx = 0 THEN
1916       cf.jlExceptIx := AddClassRef(cf.cp,exceptType);
1917     END;
1918   END Try;
1919
1920 (* ------------------------------------------------------------ *)
1921
1922   PROCEDURE (cf : ClassFile)MkNewException*();
1923   BEGIN
1924     IF cf.jlExceptIx = 0 THEN
1925       cf.jlExceptIx := AddClassRef(cf.cp,exceptType);
1926     END;
1927     cf.Code2I(Jvm.opc_new, cf.jlExceptIx,TRUE);
1928   END MkNewException;
1929
1930   PROCEDURE (cf : ClassFile)InitException*();
1931   BEGIN
1932     cf.CallS(Jvm.opc_invokespecial, exceptType, init, errorInitSig, 2, 0);
1933   END InitException;
1934
1935 (* ------------------------------------------------------------ *)
1936
1937   PROCEDURE (cf : ClassFile)Catch*(prc : Id.Procs);
1938   BEGIN
1939     cf.meth.except.endAndHandler := cf.meth.codes.codeLen;
1940     cf.StoreLocal(prc.except.varOrd, NIL);
1941    (*
1942     *  Now make sure that the overall stack
1943     *  depth computation is correctly initialized
1944     *)
1945     IF cf.meth.maxStack < 1 THEN cf.meth.maxStack := 1 END;
1946     cf.meth.currStack := 0;
1947   END Catch;
1948
1949 (* ============================================================ *)
1950 (* ============================================================ *)
1951 (*                Class File Writing Procedures                 *)
1952 (* ============================================================ *)
1953 (* ============================================================ *)
1954
1955   PROCEDURE u2 (file : F.FILE; val : INTEGER);
1956   VAR
1957     b1,b2 : INTEGER;
1958   BEGIN
1959     b1 := val MOD 256;
1960     b2 := val DIV 256;
1961     F.WriteByte(file,b2);
1962     F.WriteByte(file,b1);
1963   END u2;
1964
1965 (* ------------------------------------------------------------ *)
1966
1967   PROCEDURE u4 (file : F.FILE; val : INTEGER);
1968   VAR
1969     b1,b2,b3,b4 : INTEGER;
1970   BEGIN
1971     b1 := val MOD 256; val := val DIV 256;
1972     b2 := val MOD 256; val := val DIV 256;
1973     b3 := val MOD 256; val := val DIV 256;
1974     b4 := val;
1975     F.WriteByte(file,b4);
1976     F.WriteByte(file,b3);
1977     F.WriteByte(file,b2);
1978     F.WriteByte(file,b1);
1979   END u4;
1980
1981 (* ============================================================ *)
1982
1983   PROCEDURE WriteVal(file : F.FILE; val : INTEGER; numBytes : INTEGER);
1984   BEGIN
1985     CASE numBytes OF
1986     | 1 : F.WriteByte(file,val);
1987     | 2 : u2(file,val);
1988     | 4 : u4(file,val);
1989     END;
1990   END WriteVal;
1991
1992   PROCEDURE (IN codes : CodeList)Dump(file : F.FILE),NEW;
1993   VAR
1994     i,j : INTEGER;
1995     op : Op;
1996     offset : INTEGER;
1997   BEGIN
1998     FOR i := 0 TO codes.tide-1 DO
1999       op := codes.code[i];
2000       F.WriteByte(file,op.op);
2001       WITH op : OpI DO
2002           WriteVal(file,op.val,op.numBytes);
2003       | op : OpII DO
2004           WriteVal(file,op.val1,op.numBytes);
2005           WriteVal(file,op.val2,op.numBytes);
2006       | op : OpL DO
2007           offset := op.lab.defIx - op.offset;
2008           u2(file,offset);
2009       | op : Op2IB DO
2010           u2(file,op.val);
2011           F.WriteByte(file,op.bVal);
2012           IF op.trailingZero THEN F.WriteByte(file,0); END;
2013       | op : OpSwitch DO
2014           FOR j := 0 TO op.padding-1 DO F.WriteByte(file,0); END;
2015           u4(file,(op.defLabel.defIx - op.offset));
2016           u4(file,op.low);
2017           u4(file,op.high);
2018           FOR j := 0 TO LEN(op.offs)-1 DO
2019             offset := op.offs[j].defIx - op.offset;
2020             u4(file,offset);
2021           END;
2022       ELSE (* nothing to do *)
2023       END;
2024     END;
2025   END Dump;
2026
2027 (* ============================================================ *)
2028
2029   PROCEDURE (meth : MethodInfo)Dump(cf : ClassFile),NEW;
2030   VAR
2031     i,len : INTEGER;
2032     linNumAttSize : INTEGER;
2033   BEGIN
2034     u2(cf.file,meth.access);
2035     u2(cf.file,meth.nameIx);
2036     u2(cf.file,meth.descIx);
2037     IF (meth.access >= Jvm.acc_abstract) THEN
2038       u2(cf.file,0);         (* no attributes *)
2039     ELSE
2040       u2(cf.file,1);         (* only attribute is code *)
2041       (* Start of Code attribute *)
2042       (* Calculate size of code attribute *)
2043       IF meth.lineNumTab.tide > 0 THEN
2044         linNumAttSize := 8 + 4 * meth.lineNumTab.tide;
2045       ELSE
2046         linNumAttSize := 0;
2047       END;
2048       len := 12 + meth.codes.codeLen + linNumAttSize;
2049       IF meth.except # NIL THEN INC(len,8); END;
2050       u2(cf.file,cf.codeAttIx);
2051       u4(cf.file,len);
2052       u2(cf.file,meth.maxStack);
2053       u2(cf.file,meth.maxLocals);
2054       u4(cf.file,meth.codes.codeLen);
2055       meth.codes.Dump(cf.file);
2056       IF meth.except # NIL THEN
2057         u2(cf.file,1);
2058         u2(cf.file,meth.except.start);
2059         u2(cf.file,meth.except.endAndHandler);
2060         u2(cf.file,meth.except.endAndHandler);
2061         u2(cf.file,cf.jlExceptIx);
2062       ELSE
2063         u2(cf.file,0);
2064       END;
2065       IF meth.lineNumTab.tide > 0 THEN
2066         u2(cf.file,1);
2067         (* Start of line number table attribute *)
2068         u2(cf.file,cf.lineNumTabIx);
2069         u4(cf.file,linNumAttSize-6);
2070         u2(cf.file,meth.lineNumTab.tide);
2071         FOR i := 0 TO meth.lineNumTab.tide-1 DO
2072           u2(cf.file,meth.lineNumTab.start[i]);
2073           u2(cf.file,meth.lineNumTab.lineNum[i]);
2074         END;
2075         (* End of line number table attribute *)
2076       ELSE
2077         u2(cf.file,0);
2078       END;
2079       (* End of Code attribute *)
2080     END;
2081   END Dump;
2082
2083 (* ------------------------------------------------------------ *)
2084
2085   PROCEDURE (field : FieldInfo)Dump(cf : ClassFile),NEW;
2086   BEGIN
2087     u2(cf.file,field.access);
2088     u2(cf.file,field.nameIx);
2089     u2(cf.file,field.descIx);
2090     u2(cf.file,0);  (* No attributes for fields.  ConstantValue is the     *)
2091                     (* only attribute recognized for fields, but constants *)
2092                     (* are not currently stored in the class file          *)
2093   END Dump;
2094
2095 (* ============================================================ *)
2096
2097   PROCEDURE (e : CPEntry)Dump(file : F.FILE),NEW,ABSTRACT;
2098
2099   PROCEDURE (u : UTF8)Dump(file : F.FILE);
2100   VAR
2101     buf : POINTER TO ARRAY OF INTEGER;
2102     num : INTEGER;
2103     idx : INTEGER;
2104     chr : INTEGER;
2105    (* ================================= *)
2106     PROCEDURE Expand(VAR b : POINTER TO ARRAY OF INTEGER);
2107       VAR old : POINTER TO ARRAY OF INTEGER; len, idx : INTEGER;
2108     BEGIN
2109       len := LEN(b);
2110       old := b;
2111       NEW(b, len * 2);
2112       FOR idx := 0 TO len-1 DO b[idx] := old[idx] END;
2113     END Expand;
2114    (* ================================= *)
2115   BEGIN
2116     NEW(buf, 128);
2117     num := 0;
2118     idx := 0;
2119     FOR idx := 0 TO LEN(u.val) - 2 DO
2120       chr := ORD(u.val[idx]);
2121       IF num > LEN(buf) - 3 THEN Expand(buf) END;
2122       IF chr <= 7FH THEN
2123         IF chr = 0H THEN (* Modified UTF8! *)
2124           buf[num] := 0C0H; INC(num);
2125           buf[num] := 080H; INC(num);
2126         ELSE
2127           buf[num] := chr;  INC(num);
2128         END;
2129       ELSIF chr <= 7FFH THEN
2130         buf[num+1] := 080H + chr MOD 64; chr := chr DIV 64;
2131         buf[num  ] := 0C0H + chr; INC(num, 2);
2132       ELSE
2133         buf[num+2] := 080H + chr MOD 64; chr := chr DIV 64;
2134         buf[num+1] := 080H + chr MOD 64; chr := chr DIV 64;
2135         buf[num  ] := 0E0H + chr; INC(num, 3);
2136       END;
2137     END;
2138     F.WriteByte(file,Jvm.const_utf8);
2139     u2(file,num);
2140     FOR idx := 0 TO num-1 DO F.WriteByte(file,buf[idx]) END;
2141   END Dump;
2142
2143   PROCEDURE (c : ClassRef)Dump(file : F.FILE);
2144   BEGIN
2145     F.WriteByte(file,Jvm.const_class);
2146     u2(file,c.nameIx);
2147   END Dump;
2148
2149   PROCEDURE (r : Reference)Dump(file : F.FILE);
2150   VAR
2151     tag : INTEGER;
2152   BEGIN
2153     IF r IS MethodRef THEN
2154       tag := Jvm.const_methodref;
2155     ELSIF r IS FieldRef THEN
2156       tag := Jvm.const_fieldref;
2157     ELSE
2158       tag := Jvm.const_interfacemethodref;
2159     END;
2160     F.WriteByte(file,tag);
2161     u2(file,r.classIx);
2162     u2(file,r.nameAndTypeIx);
2163   END Dump;
2164
2165   PROCEDURE (n : NameAndType)Dump(file : F.FILE);
2166   BEGIN
2167     F.WriteByte(file,Jvm.const_nameandtype);
2168     u2(file,n.nameIx);
2169     u2(file,n.descIx);
2170   END Dump;
2171
2172   PROCEDURE (s : StringRef)Dump(file : F.FILE);
2173   BEGIN
2174     F.WriteByte(file,Jvm.const_string);
2175     u2(file,s.stringIx);
2176   END Dump;
2177
2178   PROCEDURE (i : Integer)Dump(file : F.FILE);
2179   BEGIN
2180     F.WriteByte(file,Jvm.const_integer);
2181     u4(file,i.iVal);
2182   END Dump;
2183
2184   PROCEDURE (f : Float)Dump(file : F.FILE);
2185   BEGIN
2186     F.WriteByte(file,Jvm.const_float);
2187     u4(file,RTS.shortRealToIntBits(f.fVal));
2188   END Dump;
2189
2190   PROCEDURE (l : Long)Dump(file : F.FILE);
2191   BEGIN
2192     F.WriteByte(file,Jvm.const_long);
2193     u4(file,RTS.hiInt(l.lVal));
2194     u4(file,RTS.loInt(l.lVal));
2195   END Dump;
2196
2197   PROCEDURE (d : Double)Dump(file : F.FILE);
2198   VAR
2199     rBits : LONGINT;
2200   BEGIN
2201     F.WriteByte(file,Jvm.const_double);
2202     rBits := RTS.realToLongBits(d.dVal);
2203     u4(file,RTS.hiInt(rBits));
2204     u4(file,RTS.loInt(rBits));
2205   END Dump;
2206
2207 (* ============================================================ *)
2208
2209   PROCEDURE (cf : ClassFile)Dump*();
2210   VAR
2211     i,j : INTEGER;
2212   BEGIN
2213     u4(cf.file,RTS.loInt(magic));
2214     u2(cf.file,minorVersion);
2215     u2(cf.file,majorVersion);
2216     u2(cf.file,cf.cp.tide);     (* constant pool count *)
2217     FOR i := 1 TO cf.cp.tide-1 DO
2218       IF cf.cp.pool[i] # NIL THEN cf.cp.pool[i].Dump(cf.file); END;
2219     END;
2220     u2(cf.file,cf.access);
2221     u2(cf.file,cf.thisClassIx);
2222     u2(cf.file,cf.superClassIx);
2223     u2(cf.file,cf.numInterfaces);
2224     FOR i := 0 TO cf.numInterfaces-1 DO
2225       u2(cf.file,cf.interfaces[i]);
2226     END;
2227     u2(cf.file,cf.numFields);
2228     FOR i := 0 TO cf.numFields-1 DO
2229       cf.fields[i].Dump(cf);
2230     END;
2231     u2(cf.file,cf.numMethods);
2232     FOR i := 0 TO cf.numMethods-1 DO
2233       cf.methods[i].Dump(cf);
2234     END;
2235     u2(cf.file,1);  (* only class file attribute is SourceFile *)
2236     u2(cf.file,cf.srcFileAttIx);
2237     u4(cf.file,2);  (* length of source file attribute *)
2238     u2(cf.file,cf.srcFileIx);
2239     F.CloseFile(cf.file);
2240   END Dump;
2241
2242 (* ============================================================ *)
2243
2244 BEGIN
2245   srcFileStr := L.strToCharOpen("SourceFile");
2246   codeStr := L.strToCharOpen("Code");
2247   lineNumTabStr := L.strToCharOpen("LineNumberTable");
2248   object := L.strToCharOpen("java/lang/Object");
2249   init := L.strToCharOpen("<init>");
2250   clinit := L.strToCharOpen("<clinit>");
2251   noArgVoid := L.strToCharOpen("()V");
2252   noArgClass := L.strToCharOpen("()Ljava/lang/Class;");
2253 (*
2254   errorClass := L.strToCharOpen("java/lang/Error");
2255  *)
2256   errorClass := L.strToCharOpen("java/lang/Exception");
2257   errorInitSig := L.strToCharOpen("(Ljava/lang/String;)V");
2258   rtsClass := L.strToCharOpen("CP/CPJrts/CPJrts");
2259   caseTrap := L.strToCharOpen("CaseMesg");
2260   caseTrapSig := L.strToCharOpen("(I)Ljava/lang/String;");
2261   withTrap := L.strToCharOpen("WithMesg");
2262   withTrapSig := L.strToCharOpen("(Ljava/lang/Object;)Ljava/lang/String;");
2263   exceptType := L.strToCharOpen("java/lang/Exception");
2264   main := L.strToCharOpen("main");
2265   mainSig := L.strToCharOpen("([Ljava/lang/String;)V");
2266   CPmainClass := L.strToCharOpen("CP/CPmain/CPmain");
2267   putArgs := L.strToCharOpen("PutArgs");
2268   copy := L.strToCharOpen("__copy__");
2269   sysClass := L.strToCharOpen("java/lang/System");
2270   charClass := L.strToCharOpen("java/lang/Character");
2271   mathClass := L.strToCharOpen("java/lang/Math");
2272
2273   procNames[J.StrCmp]  := L.strToCharOpen("strCmp");
2274   procNames[J.StrToChrOpen] := L.strToCharOpen("JavaStrToChrOpen");
2275   procNames[J.StrToChrs] := L.strToCharOpen("JavaStrToFixChr");
2276   procNames[J.ChrsToStr] := L.strToCharOpen("FixChToJavaStr");
2277   procNames[J.StrCheck] := L.strToCharOpen("ChrArrCheck");
2278   procNames[J.StrLen] := L.strToCharOpen("ChrArrLength");
2279   procNames[J.ToUpper] := L.strToCharOpen("toUpperCase");
2280   procNames[J.DFloor] := L.strToCharOpen("floor");
2281   procNames[J.ModI] := L.strToCharOpen("CpModI");
2282   procNames[J.ModL] := L.strToCharOpen("CpModL");
2283   procNames[J.DivI] := L.strToCharOpen("CpDivI");
2284   procNames[J.DivL] := L.strToCharOpen("CpDivL");
2285   procNames[J.StrCatAA] := L.strToCharOpen("ArrArrToString");
2286   procNames[J.StrCatSA] := L.strToCharOpen("StrArrToString");
2287   procNames[J.StrCatAS] := L.strToCharOpen("ArrStrToString");
2288   procNames[J.StrCatSS] := L.strToCharOpen("StrStrToString");
2289   procNames[J.StrLP1] := L.strToCharOpen("ChrArrLplus1");
2290   procNames[J.StrVal] := L.strToCharOpen("ChrArrStrCopy");
2291   procNames[J.SysExit] := L.strToCharOpen("exit");
2292   procNames[J.LoadTp1] := L.strToCharOpen("getClassByOrd");
2293   procNames[J.LoadTp2] := L.strToCharOpen("getClassByName");
2294   getCls := L.strToCharOpen("getClass");
2295
2296   IIretI := L.strToCharOpen("(II)I");
2297   JJretJ := L.strToCharOpen("(JJ)J");
2298
2299   procSigs[J.StrCmp]   := L.strToCharOpen("([C[C)I");
2300   procSigs[J.StrToChrOpen] := L.strToCharOpen("(Ljava/lang/String;)[C");
2301   procSigs[J.StrToChrs] := L.strToCharOpen("([CLjava/lang/String;)V");
2302   procSigs[J.ChrsToStr] := L.strToCharOpen("([C)Ljava/lang/String;");
2303   procSigs[J.StrCheck] := L.strToCharOpen("([C)V");
2304   procSigs[J.StrLen] := L.strToCharOpen("([C)I");
2305   procSigs[J.ToUpper] := L.strToCharOpen("(C)C");
2306   procSigs[J.DFloor] := L.strToCharOpen("(D)D");
2307   procSigs[J.ModI] := IIretI;
2308   procSigs[J.ModL] := JJretJ;
2309   procSigs[J.DivI] := IIretI;
2310   procSigs[J.DivL] := JJretJ;
2311   procSigs[J.StrCatAA] := L.strToCharOpen("([C[C)Ljava/lang/String;");
2312   procSigs[J.StrCatSA] := L.strToCharOpen(
2313                                 "(Ljava/lang/String;[C)Ljava/lang/String;");
2314   procSigs[J.StrCatAS] := L.strToCharOpen(
2315                                 "([CLjava/lang/String;)Ljava/lang/String;");
2316   procSigs[J.StrCatSS] := L.strToCharOpen(
2317                    "(Ljava/lang/String;Ljava/lang/String;)Ljava/lang/String;");
2318   procSigs[J.StrLP1] := procSigs[J.StrLen];
2319   procSigs[J.StrVal] := L.strToCharOpen("([C[C)V");
2320   procSigs[J.SysExit] := L.strToCharOpen("(I)V");
2321   procSigs[J.LoadTp1] := L.strToCharOpen("(I)Ljava/lang/Class;");
2322   procSigs[J.LoadTp2] := L.strToCharOpen(
2323                                "(Ljava/lang/String;)Ljava/lang/Class;");
2324
2325   typeArr[ Ty.boolN] := 4;
2326   typeArr[ Ty.sChrN] := 5;
2327   typeArr[ Ty.charN] := 5;
2328   typeArr[ Ty.byteN] := 8;
2329   typeArr[ Ty.uBytN] := 8;
2330   typeArr[ Ty.sIntN] := 9;
2331   typeArr[  Ty.intN] := 10;
2332   typeArr[ Ty.lIntN] := 11;
2333   typeArr[ Ty.sReaN] := 6;
2334   typeArr[ Ty.realN] := 7;
2335   typeArr[  Ty.setN] := 10;
2336 END ClassUtil.
2337 (* ============================================================ *)
2338 (* ============================================================ *)
2339