Insert all ASM-related files and modifications

gpcp/AsmCodeSets.cp

@@ -0,0 +1,118 @@
+(* 
+ *  Code sets for ASM, to check for membership of
+ *  particular forbidden or permitted bytecode values.
+ *)
+MODULE AsmCodeSets;
+  IMPORT Jvm := JVMcodes;
+
+  TYPE ByteBitSet = ARRAY 8 OF SET;
+
+  VAR forbidden    : ByteBitSet; (* bytecodes not allowed by ASM5 *)
+  VAR deltaSpecial : ByteBitSet; (* bytecodes with variable delta *)
+
+
+(* ============================================================ *)
+(*               Handling of byte code bit maps                 *)
+(* ============================================================ *)
+
+  PROCEDURE Insert( VAR set : ByteBitSet; val : INTEGER );
+  BEGIN
+    IF (val < 0) OR (val > 255) THEN
+        THROW( "Illegal insert in bit set - " );
+    END;
+    INCL(set[val DIV 32], val MOD 32);
+  END Insert;
+
+(* -------------------- *)
+
+  PROCEDURE badCode*( code : INTEGER ) : BOOLEAN;
+  BEGIN
+    RETURN (code MOD 32) IN forbidden[code DIV 32];
+  END badCode;
+
+(* -------------------- *)
+
+  PROCEDURE badFix*( code : INTEGER ) : BOOLEAN;
+  BEGIN
+    RETURN (code MOD 32) IN deltaSpecial[code DIV 32];
+  END badFix;
+
+(* -------------------- *)
+
+  PROCEDURE isOk*( code : INTEGER ) : INTEGER;
+  BEGIN
+    IF (code MOD 32) IN forbidden[code DIV 32] THEN
+      THROW( "Illegal code called - " + Jvm.op[code] );
+     (* Permissive variant *)
+      (* Hlp.Msg( "Illegal code called - " + Jvm.op[code] ); *)
+    END;
+    RETURN code;
+  END isOk;
+
+(* ============================================================ *)
+(*               Initialization of module globals               *)
+(* ============================================================ *)
+BEGIN
+ (* -------------------------------------------- *)
+ (*       Initialize forbidden code set          *)
+ (* -------------------------------------------- *)
+  Insert( deltaSpecial, Jvm.opc_getstatic );
+  Insert( deltaSpecial, Jvm.opc_putstatic );
+  Insert( deltaSpecial, Jvm.opc_getfield );
+  Insert( deltaSpecial, Jvm.opc_putfield );
+  Insert( deltaSpecial, Jvm.opc_invokevirtual );
+  Insert( deltaSpecial, Jvm.opc_invokespecial );
+  Insert( deltaSpecial, Jvm.opc_invokestatic);
+  Insert( deltaSpecial, Jvm.opc_invokeinterface );
+  Insert( deltaSpecial, Jvm.opc_multianewarray );
+
+ (* -------------------------------------------- *)
+ (*       Initialize forbidden code set          *)
+ (* -------------------------------------------- *)
+  Insert( forbidden, Jvm.opc_iload_0 );
+  Insert( forbidden, Jvm.opc_iload_1 );
+  Insert( forbidden, Jvm.opc_iload_2 );
+  Insert( forbidden, Jvm.opc_iload_3 );
+  Insert( forbidden, Jvm.opc_aload_0 );
+  Insert( forbidden, Jvm.opc_aload_1 );
+  Insert( forbidden, Jvm.opc_aload_2 );
+  Insert( forbidden, Jvm.opc_aload_3 );
+  Insert( forbidden, Jvm.opc_lload_0 );
+  Insert( forbidden, Jvm.opc_lload_1 );
+  Insert( forbidden, Jvm.opc_lload_2 );
+  Insert( forbidden, Jvm.opc_lload_3 );
+  Insert( forbidden, Jvm.opc_fload_0 );
+  Insert( forbidden, Jvm.opc_fload_1 );
+  Insert( forbidden, Jvm.opc_fload_2 );
+  Insert( forbidden, Jvm.opc_fload_3 );
+  Insert( forbidden, Jvm.opc_dload_0 );
+  Insert( forbidden, Jvm.opc_dload_1 );
+  Insert( forbidden, Jvm.opc_dload_2 );
+  Insert( forbidden, Jvm.opc_dload_3 );
+
+  Insert( forbidden, Jvm.opc_istore_0 );
+  Insert( forbidden, Jvm.opc_istore_1 );
+  Insert( forbidden, Jvm.opc_istore_2 );
+  Insert( forbidden, Jvm.opc_istore_3 );
+  Insert( forbidden, Jvm.opc_astore_0 );
+  Insert( forbidden, Jvm.opc_astore_1 );
+  Insert( forbidden, Jvm.opc_astore_2 );
+  Insert( forbidden, Jvm.opc_astore_3 );
+  Insert( forbidden, Jvm.opc_lstore_0 );
+  Insert( forbidden, Jvm.opc_lstore_1 );
+  Insert( forbidden, Jvm.opc_lstore_2 );
+  Insert( forbidden, Jvm.opc_lstore_3 );
+  Insert( forbidden, Jvm.opc_fstore_0 );
+  Insert( forbidden, Jvm.opc_fstore_1 );
+  Insert( forbidden, Jvm.opc_fstore_2 );
+  Insert( forbidden, Jvm.opc_fstore_3 );
+  Insert( forbidden, Jvm.opc_dstore_0 );
+  Insert( forbidden, Jvm.opc_dstore_1 );
+  Insert( forbidden, Jvm.opc_dstore_2 );
+  Insert( forbidden, Jvm.opc_dstore_3 );
+
+ (* ------------------------------------ *)
+END AsmCodeSets.
+(* ============================================================ *)
+
+

gpcp/AsmDefinitions.cp

@@ -0,0 +1,38 @@
+
+(*
+ *  Define various types and values
+ *  for use by the other Asm* modules.
+ *  This must not depend of any other
+ *  gpcp module.
+ *)
+
+MODULE AsmDefinitions;
+  IMPORT 
+    GPCPcopyright,
+    RTS,
+    JL := java_lang,
+
+    ASM := org_objectweb_asm;
+
+  CONST versionDefault* = "7";
+
+(* ============================================================ *)
+
+  TYPE JlsArr* = POINTER TO ARRAY OF RTS.NativeString;
+       JloArr* = POINTER TO ARRAY OF RTS.NativeObject;
+
+(* ============================================================ *)
+
+  PROCEDURE GetClassVersion*( IN s : ARRAY OF CHAR) : INTEGER;
+  BEGIN
+    IF s = "" THEN RETURN GetClassVersion( versionDefault );
+    ELSIF s = "5" THEN RETURN ASM.Opcodes.V1_5;
+    ELSIF s = "6" THEN RETURN ASM.Opcodes.V1_6;
+    ELSIF s = "7" THEN RETURN ASM.Opcodes.V1_7;
+    ELSIF s = "8" THEN RETURN ASM.Opcodes.V1_8;
+    ELSE THROW( "Bad class version " + s );
+    END;
+  END GetClassVersion;
+
+END AsmDefinitions.
+

gpcp/AsmFrames.cp

@@ -0,0 +1,1234 @@
+
+
+(* ============================================================ *)
+(*  AsmFrames is the module which provides all the methods      *)
+(*  associated with the MethodFrame and FrameElement types.     *)
+(*  Copyright (c) John Gough 2016-2017.                         *)
+(* ============================================================ *)
+
+(* ============================================================ *
+ *
+ *  About stack frame emission.
+ *  At various points in the code, for Java SE 7+ a stack frame
+ *  marker is emitted to allow the new Prolog-based verifier to
+ *  run efficiently. The stack frames are emitted in a rather
+ *  tricky compressed form which, when expanded, gives the 
+ *  evaluation stack and local variable state at the corresponding 
+ *  code point.
+ *
+ *  Each element in the stack and locals is given a "verification
+ *  type". These are values from a type-lattice.
+ *
+ *  The way that this compiler generates the stack frames is to
+ *  maintain a shadow stack which is updated after the emission
+ *  of each instruction. At control-flow merge points the type
+ *  is the join-type of all the paths merging at that point.
+ *
+ *  The initial state of the shadow stack is determined from the
+ *  type and mode of the formal parameters. The initial state of
+ *  the locals requires that even allocated locals have type
+ *  "TOP" until a definite assignment is made to the local slot.
+ *  This requirement is met by storing the future type of the 
+ *  slot and copying to the locals stack on encountering a store
+ *  to that location.
+ *
+ *  It is a requirement that stack frames cannot be at the
+ *  beginning of method code, nor can they be adjacent without
+ *  at least one intervening instruction. The implementation of
+ *  this requirement is clunky, since GPCP generates code that
+ *  may have multiple target labels that are adjacent (when 
+ *  statements are deeply nested, for example). The clunky 
+ *  algorithm for this is that each label carries with it the 
+ *  verification types of its jump-off locations. As each 
+ *  label-definition is processed the merged state is updated 
+ *  but no frame is emitted. Only when the emission of a
+ *  non-label "instruction" is encountered is the latest merged 
+ *  state emitted in a stack frame.
+ *
+ * ============================================================ *)
+
+MODULE AsmFrames;
+  IMPORT 
+    RTS,
+    Jvm := JVMcodes,
+    Sym := Symbols,
+    Blt := Builtin,
+    CSt := CompState,
+    Id  := IdDesc,
+    Ty  := TypeDesc,
+    Ju  := JavaUtil,
+    Lv  := LitValue,
+
+    JL  := java_lang,
+
+    Hlp := AsmHelpers,
+    Acs := AsmCodeSets,
+    Def := AsmDefinitions,
+    ASM := org_objectweb_asm;
+
+(* ================================================= *)
+(*     Types used for manipulation of stack frames   *)
+(* ================================================= *)
+
+ (* ----------------------------------------------- *)
+ (* Element type of the locals frame vector --      *)
+ (* ----------------------------------------------- *)
+ (* 'state' asserts the state of the local:         *)
+ (*   TOP  - unknown type of value                  *)
+ (*   some java/lang/Integer denoting a basic type  *)
+ (*   some java/lang/String denoting a typename.    *) 
+ (*   NULL - value known to be nil                  *)
+ (* 'dclTp' denotes the CP declared static typename *)
+ (*   for a local of some reference type, after the *)
+ (*   local has had a definite assignment the dclTp *)
+ (*   is copied to the state field.                 *)
+ (* ----------------------------------------------- *)
+  TYPE FrameElement* = 
+    RECORD 
+      state* : RTS.NativeObject;
+      dclTp* : RTS.NativeObject;  (* "state" in waiting *)
+    END;
+
+  TYPE FrameVector* = VECTOR OF FrameElement;
+
+  TYPE FrameSave* = POINTER TO RECORD
+                      lDclArr : Def.JloArr;
+                      loclArr : Def.JloArr;
+                      evalArr : Def.JloArr;
+                    END;
+
+ (* ----------------------------------------------- *)
+ (* Element type of the eval stack vector --        *)
+ (* ----------------------------------------------- *)
+ (* Each item on the stack notes the stack state    *)
+ (* of the eval-stack element at that position.     *)
+ (* ----------------------------------------------- *)
+  TYPE StackVector* = VECTOR OF RTS.NativeObject;
+
+ (* ----------------------------------------------- *)
+ (* MethodFrames simulate locals and eval-stack     *)
+ (* ----------------------------------------------- *)
+ (* localStack holds declared local variables,      *)
+ (* initially with their statically declared types  *)
+ (* memorized in the dclTp field. State fields of   *)
+ (* all live elements of localStack are emitted by  *)
+ (* every mv.visitFrame() call.                     *)
+ (* ----------------------------------------------- *)
+ (* evalStack tracks the current contents of the    *)
+ (* evaluation stack of the JVM at each program     *)
+ (* point. Live elements of the evalStack are       *)
+ (* emitted by every mv.visitFrame() call.          *)
+ (* ----------------------------------------------- *)
+ (* Type-2 elements (LONG and DOUBLE) take up two   *)
+ (* slots in the localStack array, with the second  *)
+ (* being a dummy to preserve the mapping to local  *)
+ (* variable ordinal number. These dummies are      *)
+ (* skipped over in the creation of object arrays   *)
+ (* used in the visitFrame instruction.             *)
+ (* ----------------------------------------------- *)
+  TYPE MethodFrame* = 
+    POINTER TO RECORD
+      procName-   : Lv.CharOpen;
+      descriptor- : Id.Procs;
+      signature-  : RTS.NativeString;
+      localStack* : FrameVector;
+      evalStack*  : StackVector;
+      maxEval-    : INTEGER;
+      maxLocal-   : INTEGER;
+      sigMax-     : INTEGER; (* top of initialized locals *)
+      undefEval   : BOOLEAN;
+    END;
+
+  VAR dummyElement- : FrameElement; (* {TOP,NIL} *)
+
+(* ================================================ *)
+(* ================================================ *)
+(*          Forward Procedure Declarations          *)
+(* ================================================ *)
+(* ================================================ *)
+
+  PROCEDURE^ ( mFrm : MethodFrame )EvLn*() : INTEGER,NEW;
+  PROCEDURE^ ( mFrm : MethodFrame )EvHi*() : INTEGER,NEW;
+  PROCEDURE^ ( mFrm : MethodFrame )LcLn*() : INTEGER,NEW;
+  PROCEDURE^ ( mFrm : MethodFrame )LcHi*() : INTEGER,NEW;
+  PROCEDURE^ ( mFrm : MethodFrame )LcCount*() : INTEGER,NEW;
+  PROCEDURE^ ( mFrm : MethodFrame )EvCount*() : INTEGER,NEW;
+  PROCEDURE^ ( mFrm : MethodFrame )AddLocal*(type : Sym.Type),NEW;
+  PROCEDURE^ ( mFrm : MethodFrame )AddValParam*(type : Sym.Type),NEW;
+  PROCEDURE^ ( mFrm : MethodFrame )AddRefParam*(str : Lv.CharOpen),NEW;
+(*
+ *PROCEDURE^ ( mFrm : MethodFrame )DiagFrame*( ),NEW;
+ *PROCEDURE^ ( mFrm : MethodFrame )DiagEvalStack*(),NEW;
+ *PROCEDURE^ (mFrm : MethodFrame )Diag*(code : INTEGER),NEW;
+ *PROCEDURE^ ( fs : FrameSave )Diag*( ),NEW;
+ *)
+  PROCEDURE^ ( mFrm : MethodFrame )GetLocalArrStr*() : RTS.NativeString,NEW;
+  PROCEDURE^ ( mFrm : MethodFrame )GetDclTpArrStr*() : RTS.NativeString,NEW;
+  PROCEDURE^ ( mFrm : MethodFrame )GetEvalArrStr*() : RTS.NativeString,NEW;
+  PROCEDURE^ ( fs : FrameSave )EvLn*( ) : INTEGER,NEW;
+  PROCEDURE^ ( fs : FrameSave )EvHi*( ) : INTEGER,NEW;
+  PROCEDURE^ ( fs : FrameSave )LcLn*( ) : INTEGER,NEW;
+  PROCEDURE^ ( fs : FrameSave )LcHi*( ) : INTEGER,NEW;
+
+(* ================================================= *)
+(* ================================================= *)
+(*        Static procedures for MethodFrames         *)
+(* ================================================= *)
+(* ================================================= *)
+
+ (* ----------------------------------------------- *)
+ (*   Parse a signature and initialize the Frame    *)
+ (* ----------------------------------------------- *)
+  PROCEDURE ParseSig( frm : MethodFrame; sig : Lv.CharOpen );
+    VAR cIdx : INTEGER;
+        cVal : CHAR;
+        cVec : Lv.CharVector;
+  BEGIN
+    NEW( cVec, 32 );
+    cIdx := 0; cVal := sig[cIdx];
+    LOOP 
+      CASE cVal OF
+      | '(' : (* skip *);
+      | ')' : RETURN;
+
+      | 'I', 'B', 'C', 'S', 'Z' : 
+             (* 
+              *  All 32-bit ordinals get integer frame state 
+              *)
+              frm.AddValParam( Blt.intTp );  (* int      *)
+      | 'J' : frm.AddValParam( Blt.lIntTp ); (* long int *)
+      | 'F' : frm.AddValParam( Blt.sReaTp ); (* float    *)
+      | 'D' : frm.AddValParam( Blt.realTp ); (* double   *)
+
+      | 'L' : (* binary class name *)
+              CUT(cVec, 0);
+              APPEND( cVec, cVal );
+              REPEAT
+                INC( cIdx ); cVal := sig[cIdx]; (* Get Next *)
+                APPEND( cVec, cVal );
+              UNTIL cVal = ';';
+              frm.AddRefParam( Lv.chrVecToCharOpen( cVec ) );
+
+      | '[' : (* binary array name *)
+              CUT(cVec, 0);
+              WHILE cVal = '[' DO
+                APPEND( cVec, cVal );
+                INC( cIdx ); cVal := sig[cIdx]; (* Get Next *)
+              END;
+              APPEND( cVec, cVal ); 
+             (* if this was an 'L' continue until ';' *)
+              IF cVal = 'L' THEN
+                REPEAT
+                  INC( cIdx ); cVal := sig[cIdx]; (* Get Next *)
+                  APPEND( cVec, cVal );
+                UNTIL cVal = ';';
+              END;
+              frm.AddRefParam( Lv.chrVecToCharOpen( cVec ) );
+
+      (* else CASEtrap *)
+      END;
+      INC( cIdx ); cVal := sig[cIdx]; (* Get Next *)
+    END; (* LOOP *)
+  END ParseSig; 
+
+ (* ----------------------------------------------- *)
+ (*             Add Proxies to the frame            *)
+ (* ----------------------------------------------- *)
+  PROCEDURE AddProxies( frm : MethodFrame; prc : Id.Procs );
+    VAR idx  : INTEGER;
+        pars : Id.ParSeq;
+        parX : Id.ParId;
+  BEGIN
+    pars := prc.type(Ty.Procedure).formals;
+    FOR idx := 0 TO pars.tide-1 DO
+      parX := pars.a[idx];
+      IF parX.varOrd > frm.LcHi() THEN
+        frm.AddLocal( parX.type );
+      END;
+    END;
+  END AddProxies;
+ 
+ (* ----------------------------------------------- *)
+ (*             Add locals to the frame             *)
+ (* ----------------------------------------------- *)
+  PROCEDURE AddLocals( frm : MethodFrame; prc : Id.Procs );
+    VAR idx  : INTEGER;
+        locs : Sym.IdSeq;
+        locX : Sym.Idnt;
+  BEGIN
+    locs := prc.locals;
+    FOR idx := 0 TO locs.tide-1 DO
+      locX := locs.a[idx];
+      WITH locX : Id.ParId DO (* ignore *)
+      | locX : Id.LocId DO
+          frm.AddLocal( locX.type );
+      END;
+    END;
+  END AddLocals;
+ 
+ (* ----------------------------------------------- *)
+ (*  Create a new MethodFrame for procedure procId  *)
+ (* ----------------------------------------------- *)
+  PROCEDURE NewMethodFrame*( procId : Id.Procs) : MethodFrame;
+    VAR rslt : MethodFrame;
+        sigL : Lv.CharOpen;
+  BEGIN
+    sigL := procId.type(Ty.Procedure).xName;
+    NEW( rslt );
+    NEW( rslt.localStack , 8 );
+    NEW( rslt.evalStack , 8 );
+    rslt.procName   := procId.prcNm;
+    rslt.descriptor := procId;
+    rslt.signature  := MKSTR( sigL^ );
+    rslt.maxEval    := 0;
+    rslt.maxLocal   := procId.rtsFram;
+    rslt.undefEval  := FALSE;
+   (*
+    *  Allocate slot 0 for the receiver, if any
+    *)
+    IF procId IS Id.MthId THEN
+      rslt.AddRefParam( procId(Id.MthId).bndType.xName );
+    END;
+   (*
+    *  Now load up the frame with the param info.
+    *  All of these are initialized frame elements.
+    *)
+    ParseSig( rslt, sigL );
+    rslt.sigMax := LEN(rslt.localStack);
+   (*
+    *  And now with the local variable info
+    *  All of these are uninitialized frame elements.
+    *)
+    AddProxies( rslt, procId );
+    AddLocals( rslt, procId );
+
+    RETURN rslt;
+  END NewMethodFrame;
+
+ (* ----------------------------------------------- *)
+ (*   Create a MethodFrame for a known procedure    *)
+ (* ----------------------------------------------- *)
+  PROCEDURE SigFrame*( sigL, name, recv : Lv.CharOpen ) : MethodFrame;
+    VAR rslt : MethodFrame;
+  BEGIN
+    NEW( rslt );
+    NEW( rslt.localStack , 8 );
+    NEW( rslt.evalStack , 8 );
+    rslt.maxEval := 0;
+    rslt.maxLocal := 1;
+    rslt.procName := name;
+    IF recv # NIL THEN
+      rslt.AddRefParam( recv );
+    END;
+    ParseSig( rslt, sigL );
+    RETURN rslt;
+  END SigFrame;
+
+ (* ----------------------------------------------- *
+  *  FrameElements get initialized in several contexts:  
+  *   (1) uninitialized locals of any type
+  *        This case should get dclTp <== sigStr or INTEGER etc.,
+  *        and state <== ASM.Opcodes.TOP.
+  *   (2) initialized params of reference type
+  *        This case should get dclTp <== sigStr,
+  *        and state <== sigStr. This should be
+  *        true even in the case of out params.
+  *   (3) locals of basic, value types
+  *        This case should get dclTp <== ASM.Opcodes.INTEGER
+  *        etc. and state <== ASM.Opcodes.TOP
+  * ----------------------------------------------- *)
+
+ (* ----------------------------------------------- *)
+ (*  Create a FrameElement, reflecting the given    *)
+ (*  type. Determine is a dummy second slot needed. *)
+ (* ----------------------------------------------- *)
+  PROCEDURE Uninitialized( type : Sym.Type; 
+                       OUT twoE : BOOLEAN;
+                       OUT elem : FrameElement );
+  BEGIN
+    twoE := FALSE;
+    elem.state := ASM.Opcodes.TOP; 
+    Hlp.EnsureTypName( type );
+    IF (type.kind = Ty.basTp) OR (type.kind = Ty.enuTp) THEN
+      CASE (type(Ty.Base).tpOrd) OF
+      | Ty.boolN .. Ty.intN, Ty.setN, Ty.uBytN :
+          elem.dclTp := ASM.Opcodes.INTEGER;
+      | Ty.sReaN :
+          elem.dclTp := ASM.Opcodes.FLOAT;
+      | Ty.anyRec .. Ty.sStrN :
+          elem.dclTp := ASM.Opcodes.TOP;  (* ???? *)
+      | Ty.lIntN :
+          elem.dclTp := ASM.Opcodes.LONG; twoE := TRUE; 
+      | Ty.realN :
+          elem.dclTp := ASM.Opcodes.DOUBLE; twoE := TRUE;
+      END;
+    ELSE
+      elem.dclTp := MKSTR( type.xName^ );
+    END;
+  END Uninitialized;
+
+ (* ----------------------------------------------- *)
+ (*  Create a single-slot FrameElement with given   *)
+ (*  signature. This is marked as initialized.      *)
+ (* ----------------------------------------------- *)
+  PROCEDURE ParamRefElement( sig  : Lv.CharOpen;
+                         OUT elem : FrameElement);
+  BEGIN
+    elem.dclTp := MKSTR( sig^ );
+    elem.state := elem.dclTp;
+  END ParamRefElement;
+
+ (* ----------------------------------------------- *)
+  PROCEDURE MkFrameSave( loclLen, evalLen : INTEGER ) : FrameSave;
+    VAR rslt : FrameSave;
+  BEGIN
+    NEW( rslt );
+    IF loclLen > 0 THEN 
+      NEW( rslt.loclArr, loclLen );
+      NEW( rslt.lDclArr, loclLen );
+    ELSE
+      rslt.loclArr := NIL;
+      rslt.lDclArr := NIL;
+    END;
+    IF evalLen > 0 THEN 
+      NEW( rslt.evalArr, evalLen );
+    ELSE
+      rslt.evalArr := NIL;
+    END;
+    RETURN rslt;
+  END MkFrameSave;
+
+  PROCEDURE ( old : FrameSave)Shorten( newLen : INTEGER ) : FrameSave,NEW;
+    VAR new : FrameSave;
+        int : INTEGER;
+  BEGIN
+    ASSERT( LEN( old.loclArr ) >= newLen );
+    NEW( new );
+    new.evalArr := old.evalArr;
+    NEW( new.loclArr, newLen );
+    NEW( new.lDclArr, newLen );
+    FOR int := 0 TO newLen - 1 DO
+      new.loclArr[int] := old.loclArr[int];
+      new.lDclArr[int] := old.lDclArr[int];
+    END;
+    RETURN new;
+  END Shorten;
+
+(* ================================================ *)
+(* ================================================ *)
+(*       Typebound methods for MethodFrames         *)
+(* ================================================ *)
+(* ================================================ *)
+
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)isDummyElem(ix:INTEGER) : BOOLEAN,NEW;
+  BEGIN
+   (*
+    * (dclTp = NIL) ==> 2nd element of type-1 element.
+    * However if state of previous element is TOP
+    * then visitFrame will need to emit TOP, TOP.
+    *)
+    RETURN (mFrm.localStack[ix].dclTp = NIL) &
+           (mFrm.localStack[ix - 1].state # ASM.Opcodes.TOP);
+  END isDummyElem;
+
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)LcHi*() : INTEGER,NEW;
+  BEGIN
+    RETURN LEN( mFrm.localStack ) - 1;
+  END LcHi;
+
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)LcLn*() : INTEGER,NEW;
+  BEGIN
+    RETURN LEN( mFrm.localStack );
+  END LcLn;
+
+ (* --------------------------------------------- *)
+  PROCEDURE ( fs : FrameSave )LcLn( ) : INTEGER,NEW;
+  BEGIN
+    IF fs.loclArr = NIL THEN RETURN 0 END;
+    RETURN LEN( fs.loclArr );
+  END LcLn;
+
+ (* --------------------------------------------- *)
+  PROCEDURE ( fs : FrameSave )LcHi( ) : INTEGER,NEW;
+  BEGIN
+    IF fs.loclArr = NIL THEN RETURN -1 END;
+    RETURN LEN( fs.loclArr ) - 1;
+  END LcHi;
+
+ (* --------------------------------------------- *)
+ (* LcLn gives the *length* of the local array    *)
+ (* LcHi gives the *hi* index of the local array  *)
+ (* LcCount gives the number of logical elements  *)
+ (* However, uninitialized type-2s count as two.  *)
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)LcCount*() : INTEGER,NEW;
+    VAR count, index : INTEGER;
+  BEGIN
+    count := 0;
+    FOR index := 0 TO mFrm.LcHi() DO 
+      IF ~mFrm.isDummyElem(index) THEN INC(count) END;
+    END; 
+    RETURN count;
+  END LcCount;
+
+ (* --------------------------------------------- *)
+  PROCEDURE ( fs : FrameSave )EvLn( ) : INTEGER,NEW;
+  BEGIN
+    IF fs.evalArr = NIL THEN RETURN 0 END;
+    RETURN LEN( fs.evalArr );
+  END EvLn;
+
+ (* --------------------------------------------- *)
+  PROCEDURE ( fs : FrameSave )EvHi( ) : INTEGER,NEW;
+  BEGIN
+    IF fs.evalArr = NIL THEN RETURN -1 END;
+    RETURN LEN( fs.evalArr ) - 1;
+  END EvHi;
+
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)EvHi*() : INTEGER,NEW;
+  BEGIN
+    RETURN LEN( mFrm.evalStack ) - 1;
+  END EvHi;
+
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)EvLn*() : INTEGER,NEW;
+  BEGIN
+    RETURN LEN( mFrm.evalStack );
+  END EvLn;
+
+ (* --------------------------------------------- *)
+ (* EvLn gives the *length* of the eval array     *)
+ (* EvHi gives the *hi* index of the eval array   *)
+ (* EvCount gives the number of logical elements  *)
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)EvCount*() : INTEGER,NEW;
+    VAR count, index, evHi : INTEGER;
+        elem : RTS.NativeObject;
+  BEGIN
+    count := 0;
+    index := 0;
+    evHi  := mFrm.EvHi();
+    WHILE index <= evHi DO
+      INC(count);
+      elem := mFrm.evalStack[index];
+      IF (elem = ASM.Opcodes.LONG) OR
+         (elem = ASM.Opcodes.DOUBLE) THEN
+        INC(index);
+      END;
+      INC(index); 
+    END;
+    RETURN count;
+  END EvCount;
+
+ (* --------------------------------------------- *)
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)setDepth*( i : INTEGER ),NEW;
+    VAR len : INTEGER;
+  BEGIN
+    len := LEN( mFrm.evalStack );
+    IF len > i THEN
+      CUT( mFrm.evalStack, i );
+    ELSE
+      WHILE len < i DO 
+        APPEND( mFrm.evalStack, NIL ); INC(len);
+      END;
+    END;
+  END setDepth;
+
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)InvalidStack*() : BOOLEAN,NEW;
+  BEGIN
+    RETURN mFrm.undefEval;
+  END InvalidStack;
+
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)InvalidateEvalStack*(),NEW;
+  BEGIN
+    mFrm.undefEval := TRUE;
+  END InvalidateEvalStack;
+
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)ValidateEvalStack*(),NEW;
+  BEGIN
+    mFrm.undefEval := FALSE;
+  END ValidateEvalStack;
+
+ (* --------------------------------------------- *)
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)DeltaEvalDepth*( d : INTEGER ),NEW;
+    VAR new : INTEGER;
+  BEGIN
+    CASE d OF
+      0 : (* skip *)
+    | 1 : APPEND( mFrm.evalStack, NIL );
+    | 2 : APPEND( mFrm.evalStack, NIL ); 
+          APPEND( mFrm.evalStack, NIL );
+    | 3 : APPEND( mFrm.evalStack, NIL );
+          APPEND( mFrm.evalStack, NIL );
+          APPEND( mFrm.evalStack, NIL );
+    ELSE
+      IF d > 0 THEN 
+        CSt.Message( "Delta too big: " + Ju.i2CO(d)^ );
+      ELSIF (mFrm.EvLn()) < -d THEN
+        CSt.Message( "Delta too neg: " + Ju.i2CO(d)^ +
+                     " current count: " + Ju.i2CO(mFrm.EvLn() )^);
+      END;
+
+      ASSERT(d<0);
+      ASSERT((mFrm.EvLn() + d) >= 0);
+      CUT( mFrm.evalStack, mFrm.EvLn() + d );
+    END;
+    IF d > 0 THEN 
+      mFrm.maxEval := MAX( mFrm.maxEval, mFrm.EvLn() );
+    END;
+  END DeltaEvalDepth;
+
+ (* --------------------------------------------- *)
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)SetTosType*( t : Sym.Type ),NEW;
+    VAR tIx : INTEGER;
+        obj : RTS.NativeObject;
+  BEGIN
+    tIx := mFrm.EvHi();
+    obj := Hlp.TypeToObj( t );
+
+    IF t.isLongType() THEN
+      ASSERT( tIx >= 1 );
+      mFrm.evalStack[tIx - 1] := obj;
+      mFrm.evalStack[tIx] := ASM.Opcodes.TOP;
+    ELSE
+      ASSERT( tIx >= 0 );
+      mFrm.evalStack[tIx] := obj;
+    END;
+  END SetTosType;
+
+ (* --------------------------------------------- *)
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)SetTosSig*( sig : RTS.NativeString ),NEW;
+    VAR tIx : INTEGER;
+  BEGIN
+    tIx := mFrm.EvHi();
+    ASSERT( tIx >= 0 );
+    mFrm.evalStack[tIx] := Hlp.SigToObj( sig );
+  END SetTosSig;
+
+ (* --------------------------------------------- *)
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)SetTosState*( bSig : Lv.CharOpen ),NEW;
+  BEGIN
+    mFrm.SetTosSig( MKSTR( bSig^ ) );
+  END SetTosState;
+
+ (* --------------------------------------------- *)
+ (*  Adjust the eval stack depth and/or state.    *)
+ (*  Most instructions can use this, but a few,   *)
+ (*  such as the invoke* and multianewarray need  *)
+ (*  varying extra data, and are treated uniquely *)
+ (*  Also, long values (long, double) excluded.   *)
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)FixEvalSig*(
+                  code : INTEGER; 
+                  sig  : RTS.NativeString ),NEW;
+  BEGIN
+    ASSERT( ~Acs.badFix( code ) ); (* ==> fixed delta *)
+    IF code = Jvm.opc_goto THEN 
+      mFrm.InvalidateEvalStack(); 
+    ELSE
+      mFrm.DeltaEvalDepth( Jvm.dl[code] );
+      IF sig # NIL THEN 
+        mFrm.SetTosSig( sig );
+      END;
+    END;
+  END FixEvalSig;
+
+  (* 
+   *  Used after various typed *load instructions,
+   *  typed *store instructions, ldc variants, jumps,
+   *  new, newarray, anewarray.
+   *)
+  PROCEDURE (mFrm : MethodFrame)FixEvalStack*(
+                  code : INTEGER; 
+                  type : Sym.Type ),NEW;
+  BEGIN
+    ASSERT( ~Acs.badFix( code ) ); (* ==> fixed delta *)
+    IF code = Jvm.opc_goto THEN 
+      mFrm.InvalidateEvalStack(); 
+    ELSE
+      mFrm.DeltaEvalDepth( Jvm.dl[code] );
+      IF type # NIL THEN 
+        mFrm.SetTosType( type );
+      END;
+    END;
+  END FixEvalStack;
+
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)PutGetFix*(
+                  code : INTEGER; type : Sym.Type ),NEW;
+    VAR jvmSize : INTEGER;
+  BEGIN
+
+    jvmSize := Ju.jvmSize(type);
+    CASE code OF
+    | Jvm.opc_getfield  :                    (* t1 or t2 *) 
+        mFrm.DeltaEvalDepth( jvmSize - 1 );  (*  0 or 1  *)
+        mFrm.SetTosType( type );
+    | Jvm.opc_putfield  :
+        mFrm.DeltaEvalDepth( -jvmSize - 1 ); (* -2 or -3 *)
+    | Jvm.opc_getstatic :
+        mFrm.DeltaEvalDepth( jvmSize );      (*  1 or 2  *)
+        mFrm.SetTosType( type );
+    | Jvm.opc_putstatic :
+        mFrm.DeltaEvalDepth( -jvmSize );     (* -1 or -2 *)
+    END;
+  END PutGetFix;
+
+ (* --------------------------------------------- *)
+ (*    Infer new TOS and mutate evalStack state   *)
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)MutateEvalStack*( code : INTEGER ),NEW;
+    VAR delta : INTEGER;
+        tosHi : INTEGER;
+        tmpOb : RTS.NativeObject;
+        tmpSt : RTS.NativeString;
+        tempS : RTS.NativeObject;
+  BEGIN
+    delta := Jvm.dl[code];
+    mFrm.DeltaEvalDepth( delta );
+    tosHi := mFrm.EvHi();
+
+    CASE code OF 
+
+    | Jvm.opc_nop,       (* All of these discard the TOS, or    *)
+      Jvm.opc_pop,       (* leave the TOS state equal to that   *) 
+      Jvm.opc_pop2,      (* of (one of) the incoming operand(s) *)
+      Jvm.opc_iastore,
+      Jvm.opc_lastore,
+      Jvm.opc_fastore,
+      Jvm.opc_dastore,
+      Jvm.opc_aastore,
+      Jvm.opc_bastore,
+      Jvm.opc_castore,
+      Jvm.opc_sastore,
+      Jvm.opc_lneg,
+      Jvm.opc_ineg,
+      Jvm.opc_fneg,
+      Jvm.opc_dneg:
+         (* skip *)
+
+    | Jvm.opc_goto,
+      Jvm.opc_ireturn,
+      Jvm.opc_lreturn,
+      Jvm.opc_freturn,
+      Jvm.opc_dreturn,
+      Jvm.opc_areturn,
+      Jvm.opc_return,
+      Jvm.opc_athrow :
+          mFrm.undefEval := TRUE;
+
+    | ASM.Opcodes.ACONST_NULL :
+          mFrm.evalStack[tosHi] := ASM.Opcodes.NULL;
+
+    | ASM.Opcodes.ICONST_M1 ,
+      ASM.Opcodes.ICONST_0 ,
+      ASM.Opcodes.ICONST_1 ,
+      ASM.Opcodes.ICONST_2 ,
+      ASM.Opcodes.ICONST_3 ,
+      ASM.Opcodes.ICONST_4 ,
+      ASM.Opcodes.ICONST_5 ,
+      ASM.Opcodes.IALOAD ,
+      ASM.Opcodes.BALOAD ,
+      ASM.Opcodes.CALOAD ,
+      ASM.Opcodes.SALOAD ,
+      ASM.Opcodes.IADD ,
+
+      ASM.Opcodes.ISUB,
+      ASM.Opcodes.IMUL,
+      ASM.Opcodes.IDIV,
+
+      ASM.Opcodes.IREM ,
+      ASM.Opcodes.ISHL ,
+      ASM.Opcodes.ISHR ,
+      ASM.Opcodes.IUSHR ,
+      ASM.Opcodes.IAND ,
+      ASM.Opcodes.IOR ,
+      ASM.Opcodes.IXOR ,
+      ASM.Opcodes.L2I ,
+      ASM.Opcodes.F2I ,
+      ASM.Opcodes.D2I ,
+      ASM.Opcodes.I2B ,
+      ASM.Opcodes.I2C ,
+      ASM.Opcodes.I2S ,
+      ASM.Opcodes.LCMP, 
+      ASM.Opcodes.FCMPL, 
+      ASM.Opcodes.FCMPG, 
+      ASM.Opcodes.DCMPL, 
+      ASM.Opcodes.DCMPG, 
+      ASM.Opcodes.BIPUSH,
+      ASM.Opcodes.SIPUSH,
+      ASM.Opcodes.ARRAYLENGTH :
+          mFrm.evalStack[tosHi] := ASM.Opcodes.`INTEGER;
+
+    | ASM.Opcodes.LCONST_0 ,
+      ASM.Opcodes.LCONST_1 ,
+      ASM.Opcodes.LALOAD ,
+      ASM.Opcodes.LADD ,
+
+      ASM.Opcodes.LSUB,
+      ASM.Opcodes.LMUL,
+      ASM.Opcodes.LDIV,
+
+      ASM.Opcodes.LREM ,
+      ASM.Opcodes.LSHL ,
+      ASM.Opcodes.LSHR ,
+      ASM.Opcodes.LUSHR ,
+      ASM.Opcodes.LAND ,
+      ASM.Opcodes.LOR ,
+      ASM.Opcodes.LXOR ,
+      ASM.Opcodes.I2L ,
+      ASM.Opcodes.F2L ,
+      ASM.Opcodes.D2L :
+          mFrm.evalStack[tosHi] := ASM.Opcodes.TOP;
+          mFrm.evalStack[tosHi-1] := ASM.Opcodes.LONG;
+
+    | ASM.Opcodes.FCONST_0 ,
+      ASM.Opcodes.FCONST_1 ,
+      ASM.Opcodes.FCONST_2 ,
+      ASM.Opcodes.FALOAD ,
+      ASM.Opcodes.FADD ,
+
+      ASM.Opcodes.FSUB,
+      ASM.Opcodes.FMUL,
+      ASM.Opcodes.FDIV,
+
+      ASM.Opcodes.FREM ,
+      ASM.Opcodes.I2F ,
+      ASM.Opcodes.L2F ,
+      ASM.Opcodes.D2F :
+          mFrm.evalStack[tosHi] := ASM.Opcodes.FLOAT;
+
+    | ASM.Opcodes.DCONST_0 ,
+      ASM.Opcodes.DCONST_1 ,
+      ASM.Opcodes.DALOAD ,
+      ASM.Opcodes.DADD ,
+
+      ASM.Opcodes.DMUL,
+      ASM.Opcodes.DDIV,
+      ASM.Opcodes.DSUB,
+
+      ASM.Opcodes.DREM ,
+      ASM.Opcodes.I2D ,
+      ASM.Opcodes.L2D ,
+      ASM.Opcodes.F2D :
+          mFrm.evalStack[tosHi] := ASM.Opcodes.TOP;
+          mFrm.evalStack[tosHi] := ASM.Opcodes.DOUBLE;
+
+    | ASM.Opcodes.AALOAD : 
+         (* 
+          *  The new TOS location will still hold the
+          *  signature of the array type. Strip one '['
+          *  and assign the signature.
+          *)
+          tmpSt := mFrm.evalStack[tosHi](RTS.NativeString);
+          ASSERT( tmpSt.charAt(0) = '[' );
+          mFrm.evalStack[tosHi] := tmpSt.substring(1);
+
+    | ASM.Opcodes.DUP :
+          mFrm.evalStack[tosHi] := mFrm.evalStack[tosHi-1];
+
+    | ASM.Opcodes.DUP_X1 : 
+          mFrm.evalStack[tosHi] := mFrm.evalStack[tosHi-1];
+          mFrm.evalStack[tosHi-1] := mFrm.evalStack[tosHi-2];
+          mFrm.evalStack[tosHi-2] := mFrm.evalStack[tosHi];
+
+    | ASM.Opcodes.DUP_X2 :
+          mFrm.evalStack[tosHi] := mFrm.evalStack[tosHi-1];
+          mFrm.evalStack[tosHi-1] := mFrm.evalStack[tosHi-2];
+          mFrm.evalStack[tosHi-2] := mFrm.evalStack[tosHi-3];
+          mFrm.evalStack[tosHi-3] := mFrm.evalStack[tosHi];
+
+    | ASM.Opcodes.DUP2 :
+          mFrm.evalStack[tosHi] := mFrm.evalStack[tosHi-2];
+          mFrm.evalStack[tosHi-1] := mFrm.evalStack[tosHi-3];
+
+    | ASM.Opcodes.DUP2_X1 : 
+          mFrm.evalStack[tosHi] := mFrm.evalStack[tosHi-2];
+          mFrm.evalStack[tosHi-1] := mFrm.evalStack[tosHi-3];
+          mFrm.evalStack[tosHi-2] := mFrm.evalStack[tosHi-4];
+          mFrm.evalStack[tosHi-3] := mFrm.evalStack[tosHi];
+          mFrm.evalStack[tosHi-4] := mFrm.evalStack[tosHi-1];
+
+    | ASM.Opcodes.DUP2_X2 : 
+          mFrm.evalStack[tosHi] := mFrm.evalStack[tosHi-2];
+          mFrm.evalStack[tosHi-1] := mFrm.evalStack[tosHi-3];
+          mFrm.evalStack[tosHi-2] := mFrm.evalStack[tosHi-4];
+          mFrm.evalStack[tosHi-3] := mFrm.evalStack[tosHi-5];
+          mFrm.evalStack[tosHi-4] := mFrm.evalStack[tosHi];
+          mFrm.evalStack[tosHi-5] := mFrm.evalStack[tosHi-1];
+
+    | ASM.Opcodes.SWAP :
+          tmpOb := mFrm.evalStack[tosHi];
+          mFrm.evalStack[tosHi] := mFrm.evalStack[tosHi-1];
+          mFrm.evalStack[tosHi-1] := tmpOb;
+   (* --------------------------------- *)
+   (*       ELSE take a CASE TRAP       *)
+   (* --------------------------------- *)
+    END; 
+  END MutateEvalStack;
+
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)AddValParam*( 
+                                type : Sym.Type ),NEW;
+    VAR newFE : FrameElement;
+        need2 : BOOLEAN;
+  BEGIN
+    need2 := FALSE;
+    CASE (type(Ty.Base).tpOrd) OF
+      | Ty.boolN .. Ty.intN, Ty.setN, Ty.uBytN :
+          newFE.dclTp := ASM.Opcodes.INTEGER;
+      | Ty.sReaN :
+          newFE.dclTp := ASM.Opcodes.FLOAT;
+      | Ty.anyRec .. Ty.sStrN :
+          newFE.dclTp := ASM.Opcodes.TOP;  (* ???? *)
+      | Ty.lIntN :
+          newFE.dclTp := ASM.Opcodes.LONG; need2 := TRUE;
+      | Ty.realN :
+          newFE.dclTp := ASM.Opcodes.DOUBLE; need2 := TRUE;
+    END;
+    newFE.state := newFE.dclTp; (* ==> initialized *)
+    APPEND( mFrm.localStack, newFE );
+    IF need2 THEN
+      APPEND( mFrm.localStack, dummyElement );
+    END;
+    mFrm.maxLocal := MAX( mFrm.maxLocal, mFrm.LcLn() );
+  END AddValParam;
+
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)AddLocal*( 
+                                type : Sym.Type ),NEW;
+    VAR newFE : FrameElement;
+        need2 : BOOLEAN;
+        preHi : INTEGER;
+  BEGIN
+    Uninitialized( type, need2, newFE );
+    APPEND( mFrm.localStack, newFE );
+    IF need2 THEN APPEND( mFrm.localStack, dummyElement ) END;
+    mFrm.maxLocal := MAX( mFrm.maxLocal, mFrm.LcLn() );
+  END AddLocal;
+
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)TrackStore*( ord : INTEGER ),NEW;
+  BEGIN
+    IF mFrm.localStack[ord].state = ASM.Opcodes.TOP THEN
+      mFrm.localStack[ord].state := mFrm.localStack[ord].dclTp;
+    END;
+  END TrackStore;
+
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)PopLocal1*(),NEW;
+    VAR preHi : INTEGER;
+  BEGIN
+    CUT( mFrm.localStack, mFrm.LcHi() );
+(*
+ *    Hlp.IMsg( "=================================" );
+ *    Hlp.IMsg( "PopLocal start" );
+ *    mFrm.Diag(0);
+ *    preHi := mFrm.LcHi();
+ *    CUT( mFrm.localStack, mFrm.LcHi() );
+ *    Hlp.IMsg3( "PopLocal", Ju.i2CO(preHi), Ju.i2CO(mFrm.LcHi()) );
+ *    mFrm.Diag(0);
+ *    Hlp.IMsg( "PopLocal end" );
+ *    Hlp.IMsg( "=================================" );
+ *)
+  END PopLocal1;
+
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)PopLocal2*(),NEW;
+    VAR preHi : INTEGER;
+  BEGIN
+    CUT( mFrm.localStack, mFrm.LcHi() - 1 );
+  END PopLocal2;
+
+ (* --------------------------------------------- *)
+ (*     Invalidate locals from sigMax to top      *)
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)InvalidateLocals*(),NEW;
+    VAR ix : INTEGER;
+  BEGIN
+    FOR ix := mFrm.sigMax TO mFrm.LcHi() DO
+      mFrm.localStack[ix].state := ASM.Opcodes.TOP;
+    END;
+  END InvalidateLocals;
+
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)ReleaseTo*( mark : INTEGER),NEW;
+  BEGIN
+    CUT( mFrm.localStack, mark );
+  END ReleaseTo;
+
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)AddRefParam*( 
+                                str : Lv.CharOpen ),NEW;
+    VAR newFE : FrameElement;
+  BEGIN
+    ParamRefElement( str, newFE );
+    APPEND( mFrm.localStack, newFE );
+    mFrm.maxLocal := MAX( mFrm.maxLocal, mFrm.LcLn() );
+  END AddRefParam;
+
+ (* ================================================ *)
+
+  PROCEDURE ( mFrm : MethodFrame )GetLocalArr*() : Def.JloArr,NEW;
+    VAR indx, count : INTEGER;
+        rslt : POINTER TO ARRAY OF RTS.NativeObject;
+  BEGIN
+    rslt := NIL;
+    IF mFrm.LcLn() > 0 THEN
+      NEW( rslt, mFrm.LcCount() );
+      count := 0;
+      FOR indx := 0 TO mFrm.LcHi() DO
+        IF mFrm.isDummyElem( indx ) THEN (* skip *)
+        ELSE
+          rslt[count] := mFrm.localStack[indx].state;
+          INC(count);
+        END;
+      END;
+    END;
+    RETURN rslt;
+  END GetLocalArr;
+
+ (* --------------------------------------------- *)
+
+  PROCEDURE ( mFrm : MethodFrame )GetDclTpArr*() : Def.JloArr,NEW;
+    VAR indx, count : INTEGER;
+        rslt : POINTER TO ARRAY OF RTS.NativeObject;
+  BEGIN
+    rslt := NIL;
+    IF mFrm.LcLn() > 0 THEN
+      NEW( rslt, mFrm.LcCount() );
+      count := 0;
+      FOR indx := 0 TO mFrm.LcHi() DO
+        IF mFrm.isDummyElem( indx ) THEN (* skip *)
+        ELSE
+          rslt[count] := mFrm.localStack[indx].dclTp;
+          INC(count);
+        END;
+      END;
+    END;
+    RETURN rslt;
+  END GetDclTpArr;
+
+ (* --------------------------------------------- *)
+
+  PROCEDURE ( mFrm : MethodFrame )GetEvalArr*() : Def.JloArr,NEW;
+    VAR index, count : INTEGER;
+        rslt : POINTER TO ARRAY OF RTS.NativeObject;
+        elem : RTS.NativeObject;
+  BEGIN
+    rslt := NIL;
+(*
+ Hlp.Msg("GetEvalArr: count " + Ju.i2CO(mFrm.EvCount())^ + ", hi " + Ju.i2CO(mFrm.EvHi())^ );
+ *)
+    IF mFrm.EvLn() > 0 THEN
+      NEW( rslt, mFrm.EvCount() );
+      index := 0;
+      count := 0;
+      WHILE index <= mFrm.EvHi() DO
+        elem := mFrm.evalStack[index]; 
+(*
+ Hlp.Msg2("  elem " + Ju.i2CO(index)^, Hlp.objToStr(elem) );
+ *)
+        rslt[count] := elem; INC(index); INC(count);
+        IF (elem = ASM.Opcodes.DOUBLE) OR
+           (elem = ASM.Opcodes.LONG) THEN INC(index) ;
+(*
+ Hlp.Msg("  skipping next element " );
+ *)
+        END;
+      END;
+    END;
+    RETURN rslt;
+  END GetEvalArr;
+
+ (* --------------------------------------------- *)
+ (*  Make a shallow copy of the evaluation stack  *)
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)GetFrameSave*( 
+             save : FrameSave ) : FrameSave,NEW;
+    VAR int,min : INTEGER;
+        eMF, lMF : INTEGER;
+        eFS, lFS : INTEGER;
+        rslt : FrameSave;
+  BEGIN
+   (* ----------- *)
+    IF save = NIL THEN 
+      eMF := mFrm.EvLn();
+      lMF := mFrm.LcLn();
+      rslt := MkFrameSave( lMF, eMF );
+      FOR int := 0 TO eMF - 1 DO
+        rslt.evalArr[int] := mFrm.evalStack[int];
+      END;
+      FOR int := 0 TO lMF - 1 DO
+        rslt.loclArr[int] := mFrm.localStack[int].state;
+        rslt.lDclArr[int] := mFrm.localStack[int].dclTp;
+      END;
+    ELSE
+      eMF := mFrm.EvLn();  (* Eval length in method frame  *)
+      lMF := mFrm.LcLn();  (* Local length in method frame *)
+      eFS := save.EvLn();  (* Eval length in FrameSave     *)
+      lFS := save.LcLn();  (* Local length in FrameSave    *)
+      ASSERT( eFS = eMF );
+      min := MIN( lFS, lMF );
+      IF min < lFS THEN 
+        rslt := save.Shorten( min );
+      ELSE 
+        rslt := save;
+      END;
+      FOR int := 0 TO min-1 DO
+       (*
+        *  The following assertion is not true in general. For
+        *  example, several branches to an exit label may each 
+        *  have a temporary variable at the point of branching 
+        *  that are of different types.
+        *    ASSERT( rslt.lDclArr[int] = mFrm.localStack[int].dclTp );
+        *  At the label's definition point all of the temporaries will
+        *  be out of scope, and the merged list will be truncated.
+        *)
+        IF rslt.loclArr[int] # mFrm.localStack[int].state THEN
+          rslt.loclArr[int] := ASM.Opcodes.TOP;
+        END; 
+      END;
+    END;
+    RETURN rslt;
+  END  GetFrameSave;
+
+ (* --------------------------------------------- *)
+ (*        Copy the stored evaluation stack       *)
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)OverrideLocalState*( save : FrameSave ),NEW;
+    VAR elem : FrameElement;
+        sHi : INTEGER; (* High index of saved local state *)
+        idx : INTEGER;
+  BEGIN
+   (*
+    *  Frame state is invalid, therefore construct
+    *  new state using only the saved state.
+    *)
+    CUT( mFrm.localStack, 0 );
+    sHi := save.LcHi();
+    FOR idx := 0 TO sHi DO
+      elem.state := save.loclArr[idx];
+      elem.dclTp := save.lDclArr[idx];
+      APPEND( mFrm.localStack, elem );
+    END;
+  END OverrideLocalState;
+
+ (* --------------------------------------------- *)
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)MergeLocalState*( save : FrameSave ),NEW;
+    VAR elem : FrameElement;
+        lLn : INTEGER; (* length of local state *)
+        sLn : INTEGER;
+        idx : INTEGER;
+  BEGIN
+   (*
+    *  Frame state is valid, therefore construct
+    *  new state merging save and mFrm.localStack.
+    *)
+    sLn := save.LcLn();
+    lLn := MIN( mFrm.LcLn(), sLn );
+    FOR idx := 0 TO lLn - 1 DO
+      ASSERT( save.lDclArr[idx] = mFrm.localStack[idx].dclTp );
+      IF save.loclArr[idx] # mFrm.localStack[idx].state THEN
+        mFrm.localStack[idx].state := ASM.Opcodes.TOP;
+      END;
+      CUT( mFrm.localStack, lLn );
+    END;
+  END MergeLocalState;
+
+ (* --------------------------------------------- *)
+ (* --------------------------------------------- *)
+  PROCEDURE (mFrm : MethodFrame)RestoreFrameState*( save : FrameSave ),NEW;
+    VAR len, int, eL, lL : INTEGER;
+        definedAtEntry : BOOLEAN;
+        ePreState, lPreState : RTS.NativeString;
+  BEGIN
+    IF save = NIL THEN
+      mFrm.setDepth( 0 ); RETURN;
+    END;
+    definedAtEntry := ~mFrm.undefEval;
+    ePreState := NIL; (* Avoid "no initialization warning *)
+    lPreState := NIL; (* Avoid "no initialization warning *)
+    mFrm.undefEval := FALSE;
+   (*
+    *  First, fix the evaluation stack.
+    *)
+    len := save.EvLn();
+    mFrm.setDepth( 0 );
+    FOR int := 0 TO len-1 DO
+      APPEND( mFrm.evalStack, save.evalArr[int] );
+    END;
+   (*
+    *  Next, fix the frame state.
+    *  Note that there are two cases here:
+    *  (1) There is a fall-through into the current label 
+    *      which is the case if mFrm.undefEval is FALSE.
+    *      In this case the saved localStack is copied
+    *      up to the current LcHi, since the jump may 
+    *      have originated from a scope with more locals,
+    *      and the EvLn must match.
+    *  (2) mFrm.undefEval is TRUE: ==> no fall-through.
+    *      In this case the entire saved localStack is 
+    *      copied, as is the evalStack.
+    *)
+    IF definedAtEntry THEN
+      mFrm.MergeLocalState( save );
+    ELSE
+      mFrm.OverrideLocalState( save );
+    END;
+  END RestoreFrameState;
+
+ (* --------------------------------------------- *)
+
+  PROCEDURE ( mFrm : MethodFrame )GetLocalArrStr*() : 
+                                RTS.NativeString,NEW;
+    VAR objArr : Def.JloArr;
+  BEGIN
+    objArr := mFrm.GetLocalArr();
+    RETURN Hlp.ObjArrToStr( objArr );
+  END GetLocalArrStr;
+
+ (* --------------------------------------------- *)
+
+  PROCEDURE ( mFrm : MethodFrame )GetDclTpArrStr*() : 
+                                RTS.NativeString,NEW;
+    VAR objArr : Def.JloArr;
+  BEGIN
+    objArr := mFrm.GetDclTpArr();
+    RETURN Hlp.ObjArrToStr( objArr );
+  END GetDclTpArrStr;
+
+ (* --------------------------------------------- *)
+
+  PROCEDURE ( mFrm : MethodFrame )GetEvalArrStr*() :
+                               RTS.NativeString,NEW;
+    VAR objArr : Def.JloArr;
+  BEGIN
+    IF mFrm.undefEval THEN RETURN Hlp.invalid;
+    ELSE 
+      objArr := mFrm.GetEvalArr();
+      RETURN Hlp.ObjArrToStr( objArr );
+    END;
+  END GetEvalArrStr;
+
+
+(* ================================================ *)
+BEGIN
+  dummyElement.state := ASM.Opcodes.TOP;
+  dummyElement.dclTp := NIL;
+END AsmFrames.
+(* ================================================ *)
+

gpcp/AsmHelpers.cp

@@ -0,0 +1,546 @@
+
+(* ============================================================ *)
+(*  AsmHelpers is the module which provides static helper       *)
+(*  methods for module AsmUtil                                  *)
+(*  Copyright (c) John Gough 2016.                              *)
+(* ============================================================ *)
+
+MODULE AsmHelpers;
+  IMPORT 
+    RTS,
+    Jvm := JVMcodes,
+    Sym := Symbols,
+    Blt := Builtin,
+    CSt := CompState,
+    Id  := IdDesc,
+    Ty  := TypeDesc,
+    Ju  := JavaUtil,
+    Lv  := LitValue,
+
+    JL  := java_lang,
+
+    Def := AsmDefinitions,
+    Acs := AsmCodeSets,
+    ASM := org_objectweb_asm;
+
+(* ================================================ *)
+
+(*
+ *  Helper type for generating ident and
+ *  type names in style required by ASM5
+ *
+ *)
+  TYPE IdntTgPtr = 
+      POINTER TO RECORD
+        name,      (* plain name of ident referent *)
+        owner,     (* _classname_ of owning class  *)
+        signature  (* signature of identifier type *)
+                  : RTS.NativeString;
+      END;
+
+  TYPE TypeTgPtr =
+      POINTER TO RECORD
+        signature, (* signature of type- all cases *)
+        classname  (* class of type- all cases     *)
+            : RTS.NativeString;
+        auxField (* CASE OF type                   *)
+                 (*   Procedure: impl-ret-type     *)
+                 (*   Others: arr-typ (on demand)  *)
+            : Sym.Type;
+      END;
+
+(* ================================================ *)
+
+  VAR noName- : RTS.NativeString;
+      emptyMs- : RTS.NativeString;
+      invalid- : RTS.NativeString;
+
+(* ================================================ *)
+(* ================================================ *)
+(*          Forward Procedure Declarations          *)
+(* ================================================ *)
+(* ================================================ *)
+
+(*  -- currently unused diagnostic helpers
+ *
+ *PROCEDURE^ TyXtnMsg*( ty : Sym.Type );
+ *PROCEDURE^ IdXtnMsg*( id : Sym.Idnt );
+ *PROCEDURE^ IdXtnMsg2*( code : INTEGER; id : Sym.Idnt );
+ * --------------------------------- *)
+
+  PROCEDURE^ EnsurePrcName*( prc : Id.Procs );
+  PROCEDURE^ EnsureBlkName*( blk : Id.BlkId );
+  PROCEDURE^ EnsureRecName*( typ : Ty.Record );
+  PROCEDURE^ EnsureVecName*( vec : Ty.Vector );
+  PROCEDURE^ EnsurePTpName*( pTp : Ty.Procedure );
+  PROCEDURE^ EnsureTypName*( typ : Sym.Type );
+  PROCEDURE^ GetBinaryTypeName*(typ : Sym.Type) : Lv.CharOpen;
+  PROCEDURE^ tyXtn( this : Sym.Type ) : TypeTgPtr;
+  PROCEDURE^ tyCls*( this : Sym.Type ) : RTS.NativeString; 
+  PROCEDURE^ tySig*( this : Sym.Type ) : RTS.NativeString; 
+ 
+(* ================================================ *)
+(*      Notes on the usage of the tgXtn fields      *)
+(* ================================================ *)
+
+  PROCEDURE idXtn( this : Sym.Idnt ) : IdntTgPtr;
+    VAR xtn : IdntTgPtr;
+  BEGIN
+    IF this.tgXtn = NIL THEN 
+      NEW( xtn );
+      this.tgXtn := xtn;
+(* ... *)
+      WITH this : Id.BlkId DO
+          EnsureBlkName( this );
+          xtn.name := MKSTR( this.xName^ );
+          RETURN xtn;
+      | this : Id.PrcId DO
+          EnsurePrcName( this );
+          xtn.owner := MKSTR( this.clsNm^ );
+          xtn.name := MKSTR( this.prcNm^ );
+          xtn.signature := tySig( this.type );
+      | this : Id.MthId DO
+          EnsurePrcName( this );
+          xtn.owner := tyCls( this.bndType );
+          xtn.name := MKSTR( this.prcNm^ );
+          xtn.signature := tySig( this.type );
+      | this : Id.VarId DO (* A static variable *)
+          xtn.name := MKSTR( Sym.getName.ChPtr(this)^ );
+          IF this.recTyp = NIL THEN (* module var *)
+            xtn.owner := idXtn( this.dfScp ).name;
+          ELSE
+            xtn.owner := tyCls( this.recTyp );
+          END;
+          xtn.signature := MKSTR( GetBinaryTypeName( this.type )^ ); 
+
+ASSERT( xtn.name # NIL );
+ASSERT( xtn.owner # NIL );
+ASSERT( xtn.signature # NIL );
+
+      | this : Id.FldId DO
+          xtn.name := MKSTR( this.fldNm^ );
+          xtn.owner := tyCls( this.recTyp );
+          xtn.signature := MKSTR( GetBinaryTypeName( this.type )^ );
+
+ASSERT( this.fldNm # NIL );
+ASSERT( xtn.owner # NIL );
+ASSERT( xtn.signature # NIL );
+
+      | this : Id.LocId DO
+
+          ASSERT( Id.uplevA IN this.locAtt );
+          xtn.name := MKSTR( Sym.getName.ChPtr( this )^ );
+          xtn.owner := tyCls( this.dfScp(Id.Procs).xhrType.boundRecTp() );
+          xtn.signature := MKSTR( GetBinaryTypeName( this.type )^ ); 
+
+ASSERT( xtn.name # NIL );
+ASSERT( xtn.owner # NIL );
+ASSERT( xtn.signature # NIL );
+      END;
+(* ... *)
+      RETURN xtn;
+    ELSE
+      RETURN this.tgXtn(IdntTgPtr);
+    END;
+  END idXtn;
+
+  PROCEDURE idNam*( this : Sym.Idnt ) : RTS.NativeString; 
+  BEGIN
+    RETURN idXtn( this ).name;
+  END idNam;
+
+  PROCEDURE idCls*( this : Sym.Idnt ) : RTS.NativeString; 
+  BEGIN
+    RETURN idXtn( this ).owner;
+  END idCls;
+
+  PROCEDURE idSig*( this : Sym.Idnt ) : RTS.NativeString; 
+  BEGIN
+    RETURN idXtn( this ).signature;
+  END idSig;
+
+ (* --------------------------------------------- *)
+
+  PROCEDURE tyXtn( this : Sym.Type ) : TypeTgPtr;
+    VAR xtn : TypeTgPtr;
+        bnd : TypeTgPtr;
+        sig : Lv.CharOpen;
+  BEGIN
+    IF this.tgXtn = NIL THEN 
+      NEW( xtn );
+      this.tgXtn := xtn;
+      WITH this : Ty.Base DO
+         (* xName is loaded in JavaUtil's mod body *)
+          sig := this.xName;
+          xtn.auxField := Ty.mkArrayOf( this );
+          xtn.signature := MKSTR( sig^ );
+      | this : Ty.Vector DO
+          EnsureVecName( this );
+          xtn.signature := MKSTR( this.xName^ );
+          xtn.classname := tyCls( Ju.getHostRecTp( this ) )
+      | this : Ty.Record DO
+          EnsureRecName( this );
+          xtn.classname := MKSTR( this.xName^ );
+          xtn.signature := MKSTR( this.scopeNm^ );
+      | this : Ty.Array DO
+          sig := GetBinaryTypeName( this ); (* FIXME : Refactor later! *)
+          xtn.signature := MKSTR( sig^ );
+      | this : Ty.Procedure DO
+          EnsurePTpName( this );
+         (* FIXME: do we need classname? *)
+          xtn.signature := MKSTR( this.xName^ );
+      | this : Ty.Pointer DO
+          xtn^ := tyXtn( this.boundTp )^;
+      END;
+      RETURN xtn;
+    ELSE
+      ASSERT( this.tgXtn IS TypeTgPtr );
+      RETURN this.tgXtn(TypeTgPtr);
+    END;
+  END tyXtn;
+
+  (* Returns signature of this type *)
+  PROCEDURE tySig*( this : Sym.Type ) : RTS.NativeString; 
+  BEGIN
+    RETURN tyXtn(this).signature;
+  END tySig;
+
+  (* Returns classname of this type *)
+  PROCEDURE tyCls*( this : Sym.Type ) : RTS.NativeString; 
+  BEGIN
+    RETURN tyXtn(this).classname;
+  END tyCls;
+
+  PROCEDURE tyNam*( this : Sym.Type ) : RTS.NativeString;
+    VAR rslt : RTS.NativeString;
+        tXtn : TypeTgPtr;
+  BEGIN
+    tXtn := tyXtn( this );
+    rslt := tXtn.classname;
+    IF rslt # NIL THEN 
+      RETURN rslt;
+    ELSE
+      RETURN tXtn.signature;
+    END;
+  END tyNam;
+
+  (* Returns type descriptor of an array of this type *)
+  PROCEDURE tyArrTp*( this : Sym.Type ) : Sym.Type;
+    VAR xtn : TypeTgPtr;
+  BEGIN
+    xtn := tyXtn( this ); 
+    IF xtn.auxField = NIL THEN 
+      xtn.auxField := Ty.mkArrayOf( this );
+    END;
+    RETURN xtn.auxField;
+  END tyArrTp;
+
+  (* Returns signature of an array of this type *)
+  PROCEDURE tyArrSig*( this : Sym.Type ) : RTS.NativeString; 
+    VAR xtn : TypeTgPtr;
+  BEGIN
+    RETURN tySig( tyArrTp( this ) );
+  END tyArrSig;
+
+  PROCEDURE tyRetTyp*( this : Sym.Type ) : Sym.Type;
+    VAR xtn : TypeTgPtr;
+   (* ----------------------------- *)
+    PROCEDURE GetImplRetType( this : Ty.Procedure ) : Sym.Type;
+      VAR ix : INTEGER;
+          px : Id.ParId;
+    BEGIN
+      IF this.retType # NIL THEN
+        RETURN this.retType;
+      ELSE
+        FOR ix := 0 TO this.formals.tide-1 DO
+          px := this.formals.a[ix];
+          IF px.boxOrd = Ju.retMarker THEN RETURN px.type END;
+        END;
+        RETURN NIL;
+      END;
+    END GetImplRetType;
+   (* ----------------------------- *)
+  BEGIN
+    WITH this : Ty.Procedure DO
+      xtn := tyXtn( this );
+      IF xtn.auxField = NIL THEN
+        xtn.auxField := GetImplRetType( this );
+      END;
+      RETURN xtn.auxField;
+    (* else take the WITH-trap *)
+    END;
+  END tyRetTyp;
+
+(* ================================================ *)
+(* ================================================ *)
+  PROCEDURE objToStr*( obj : RTS.NativeObject ) : RTS.NativeString;
+    VAR dst : ARRAY 128 OF CHAR;
+  BEGIN
+    IF obj = NIL THEN RETURN noName END;
+
+    WITH obj : RTS.NativeString DO
+      RETURN obj;
+    | obj : JL.Integer DO
+        IF obj = ASM.Opcodes.NULL THEN RETURN MKSTR( "NIL" );
+        ELSIF obj = ASM.Opcodes.TOP THEN RETURN MKSTR( "TOP" );
+        ELSIF obj = ASM.Opcodes.INTEGER THEN RETURN MKSTR( "INT" );
+        ELSIF obj = ASM.Opcodes.LONG THEN RETURN MKSTR( "LNG" );
+        ELSIF obj = ASM.Opcodes.FLOAT THEN RETURN MKSTR( "FLT" );
+        ELSIF obj = ASM.Opcodes.DOUBLE THEN RETURN MKSTR( "DBL" );
+        ELSE RETURN MKSTR( "unknown" );
+        END;
+    ELSE
+      IF obj = NIL THEN dst := "NIL" ELSE RTS.ObjToStr( obj, dst ) END;
+      THROW( "objToStr arg is " + BOX(dst$)^ );
+    END;
+  END objToStr;
+ 
+(* ================================================ *)
+(*       Message Utilities for ASM modules          *)
+(* ================================================ *)
+
+  PROCEDURE Msg*( IN s : ARRAY OF CHAR );
+  BEGIN
+    CSt.Message( "ASM: " + s );
+  END Msg;
+
+ (* --------------------------------------------- *)
+
+  PROCEDURE MsgArr*( IN sep : ARRAY OF CHAR; 
+                          a : Lv.CharOpenArr );
+    VAR str : Lv.CharOpen;
+        idx : INTEGER;
+  BEGIN
+    str := BOX("ASM: " + a[0]^);
+    FOR idx := 1 TO LEN(a) - 1 DO
+      str := BOX( str^ + sep + a[idx]^ );
+    END;
+    CSt.Message( str );
+  END MsgArr;
+
+ (* --------------------------------------------- *)
+
+  PROCEDURE CatStrArr( a : Def.JlsArr ) : RTS.NativeString;
+    VAR str : RTS.NativeString;
+        idx : INTEGER;
+  BEGIN
+    IF a = NIL THEN RETURN emptyMs;
+    ELSE
+      str := a[0];
+      FOR idx := 1 TO LEN(a) - 1 DO
+        str := str + ", " + a[idx];
+      END;
+    END;
+    RETURN str;
+  END CatStrArr;
+
+ (* --------------------------------------------- *)
+
+  PROCEDURE ObjArrToStr*( arr : Def.JloArr ) : RTS.NativeString;
+    VAR strArr : Def.JlsArr;
+        ix : INTEGER;
+  BEGIN
+    IF arr = NIL THEN RETURN emptyMs END;
+    NEW( strArr, LEN( arr ) );
+    FOR ix := 0 TO LEN(strArr) - 1 DO
+      strArr[ix] := objToStr( arr[ix] );
+    END;
+    RETURN CatStrArr( strArr );
+  END ObjArrToStr;
+
+ (* ----------------------------------------------- *)
+ (* ----------------------------------------------- *)
+  PROCEDURE TypeToObj*( type : Sym.Type ) : RTS.NativeObject;
+    VAR rslt : RTS.NativeObject;
+  BEGIN
+    ASSERT( type # NIL );
+    IF (type.kind = Ty.basTp) OR (type.kind = Ty.enuTp) THEN
+      CASE (type(Ty.Base).tpOrd) OF
+      | Ty.boolN .. Ty.intN, Ty.setN, Ty.uBytN :
+          rslt := ASM.Opcodes.INTEGER;
+      | Ty.sReaN :
+          rslt := ASM.Opcodes.FLOAT;
+      | Ty.anyRec .. Ty.sStrN :
+          rslt := ASM.Opcodes.TOP; 
+      | Ty.lIntN :
+          rslt := ASM.Opcodes.LONG;
+      | Ty.realN :
+          rslt := ASM.Opcodes.DOUBLE;
+      END;
+    ELSE
+      EnsureTypName(type);
+      rslt := MKSTR( type.xName^ );
+    END;
+    RETURN rslt;
+  END TypeToObj;
+ (* ----------------------------------------------- *)
+
+ (* ----------------------------------------------- *)
+  PROCEDURE SigToObj*( sig : RTS.NativeString ) : RTS.NativeObject;
+  BEGIN
+    ASSERT( sig # NIL );
+    CASE sig.charAt(0) OF
+      | 'I','B','C','S','Z' : RETURN ASM.Opcodes.INTEGER;
+      | 'J' :                 RETURN ASM.Opcodes.LONG;
+      | 'F' :                 RETURN ASM.Opcodes.FLOAT;
+      | 'D' :                 RETURN ASM.Opcodes.DOUBLE;
+    ELSE
+      RETURN sig;
+    END;
+  END SigToObj;
+
+(* ================================================ *)
+(* ================================================ *)
+(*     Methods to ensure descriptor names exist     *)
+(* ================================================ *)
+(* ================================================ *)
+
+ (* ---------------------------------------------- *)
+ (*  Ensure that this record desc. has valid names *)
+ (* ---------------------------------------------- *)
+  PROCEDURE EnsureRecName*( typ : Ty.Record );
+  BEGIN
+    IF typ.xName = NIL THEN 
+      Ju.MkRecName(typ);
+    END;
+  END EnsureRecName;
+
+ (* ---------------------------------------------- *)
+ (*   Ensure that this proc desc. has valid names  *)
+ (* ---------------------------------------------- *)
+  PROCEDURE EnsurePrcName*( prc : Id.Procs );
+  BEGIN
+    IF prc.scopeNm = NIL THEN Ju.MkProcName( prc ) END;
+  END EnsurePrcName;
+
+ (* ---------------------------------------------- *)
+ (*   Ensure that this field desc. has valid names *)
+ (* ---------------------------------------------- *)
+  PROCEDURE EnsureFldName*( fld : Id.VarId );
+  BEGIN
+    IF fld.varNm = NIL THEN 
+      Ju.MkVarName(fld);
+    END;
+  END EnsureFldName;
+
+ (* ----------------------------------------------- *)
+ (*  Ensure that this block desc. has valid names   *)
+ (* ----------------------------------------------- *)
+  PROCEDURE EnsureBlkName*( blk : Id.BlkId );
+  BEGIN
+    IF blk.xName = NIL THEN Ju.MkBlkName(blk) END;
+  END EnsureBlkName;
+
+ (* ----------------------------------------------- *)
+ (*  Ensure that this vector desc. has valid names  *)
+ (* ----------------------------------------------- *)
+  PROCEDURE EnsureVecName*( vec : Ty.Vector );
+  BEGIN
+    IF vec.xName = NIL THEN Ju.MkVecName(vec) END;
+  END EnsureVecName;
+
+ (* ----------------------------------------------- *)
+ (*  Ensure that this block desc. has valid names   *)
+ (* ----------------------------------------------- *)
+  PROCEDURE EnsurePTpName*( pTp : Ty.Procedure );
+  BEGIN
+    IF pTp.xName = NIL THEN Ju.MkProcTypeName(pTp) END;
+  END EnsurePTpName;
+
+ (* ------------------------------------------------ *)
+ (* Ensure that this type descriptor has valid xName *)
+ (* ------------------------------------------------ *)
+  PROCEDURE EnsureTypName*( typ : Sym.Type );
+  BEGIN
+    IF typ.xName # NIL THEN RETURN END;
+    WITH typ : Ty.Record DO
+        Ju.MkRecName( typ );
+    | typ : Ty.Vector DO
+        Ju.MkVecName( typ );
+    | typ : Ty.Array DO
+        typ.xName := Ju.cat2( Ju.brac, GetBinaryTypeName( typ.elemTp ) );
+    | typ : Ty.Pointer DO
+        EnsureTypName( typ.boundTp );
+        typ.xName := typ.boundTp.xName;
+    | typ : Ty.Procedure DO
+        Ju.MkProcTypeName( typ );
+    ELSE
+      THROW( "Can't make TypName" );
+    END;
+  END EnsureTypName;
+
+ (* ------------------------------------------------- *)
+ (*    Compute the binary type name, and persist it   *)
+ (* ------------------------------------------------- *)
+  PROCEDURE GetBinaryTypeName*(typ : Sym.Type) : Lv.CharOpen;
+  VAR
+    arrayName : Lv.CharOpenSeq;
+    arrayTy : Sym.Type;
+  BEGIN
+    WITH typ : Ty.Base DO
+        RETURN typ.xName;
+    | typ : Ty.Vector DO
+        EnsureVecName( typ );
+        RETURN typ.xName;
+    | typ : Ty.Procedure DO
+        EnsurePTpName( typ );
+        RETURN typ.hostClass.scopeNm;
+    | typ : Ty.Array DO
+        IF typ.xName = NIL THEN
+          Lv.InitCharOpenSeq(arrayName,3);
+          arrayTy := typ;
+          WHILE arrayTy IS Ty.Array DO 
+            Lv.AppendCharOpen(arrayName,Ju.brac); 
+            arrayTy := arrayTy(Ty.Array).elemTp;
+          END;
+          Lv.AppendCharOpen(arrayName, GetBinaryTypeName(arrayTy)); 
+          typ.xName := Lv.arrayCat(arrayName);
+        END;
+        ASSERT(typ.xName # NIL);
+        RETURN typ.xName;
+    | typ : Ty.Record DO
+        EnsureRecName( typ );
+        RETURN typ.scopeNm;
+    | typ : Ty.Enum DO
+        RETURN Blt.intTp.xName;
+    | typ : Ty.Pointer DO
+        RETURN GetBinaryTypeName(typ.boundTp)
+    | typ : Ty.Opaque DO
+        IF typ.xName = NIL THEN 
+          Ju.MkAliasName(typ);
+        END;
+        RETURN typ.scopeNm;
+    END;
+  END GetBinaryTypeName;
+
+(* ================================================ *)
+(*  Factories for the creation of boxed basic types *) 
+(* ================================================ *)
+  PROCEDURE MkInteger*( val : INTEGER ) : JL.Object;
+  BEGIN
+    RETURN JL.Integer.Init( val );
+  END MkInteger;
+
+  PROCEDURE MkLong*( val : LONGINT ) : JL.Object;
+  BEGIN
+    RETURN JL.Long.Init( val );
+  END MkLong;
+
+  PROCEDURE MkFloat*( val : SHORTREAL ) : JL.Object;
+  BEGIN
+    RETURN JL.Float.Init( val );
+  END MkFloat;
+
+  PROCEDURE MkDouble*( val : REAL ) : JL.Object;
+  BEGIN
+    RETURN JL.Double.Init( val );
+  END MkDouble;
+
+(* ================================================ *)
+BEGIN
+  noName := MKSTR( "?" );
+  emptyMs := MKSTR( "empty" );
+  invalid := MKSTR( "invalid" );
+END AsmHelpers.
+(* ================================================ *)
+

gpcp/AsmUtil.cp

@@ -0,0 +1,1915 @@
+
+(* ============================================================ *)
+(*  AsmUtil is the module which writes java classs file         *)
+(*  structures using the ASM5.* libraries                       *)
+(*  Copyright (c) John Gough 2016.                              *)
+(* ============================================================ *)
+
+MODULE AsmUtil;
+
+  IMPORT 
+        GPCPcopyright,
+        RTS,
+        ASCII,
+        Console,
+        JavaBase,
+        FileNames,
+        GPF := GPFiles,
+        GPB := GPBinFiles,
+        Hsh := NameHash,
+        CSt := CompState,
+        Psr := CPascalP,
+        Jvm := JVMcodes,
+        Sym := Symbols,
+        Blt := Builtin,
+        Id  := IdDesc,
+        Xp  := ExprDesc,
+        Ty  := TypeDesc,
+        Lv  := LitValue,
+        Ju  := JavaUtil,
+        Cu  := ClassUtil,
+
+        JL  := java_lang,
+        Frm := AsmFrames,
+        Hlp := AsmHelpers,
+        Acs := AsmCodeSets,
+        Def := AsmDefinitions,
+        ASM := org_objectweb_asm;
+
+(* ============================================================ *)
+(* ============================================================ *)
+
+  CONST versionDefault = "V1_7";
+
+(* ============================================================ *)
+
+  TYPE AsmLabel*    = POINTER TO RECORD (Ju.Label)
+                     (*  defIx : INTEGER -- inherited field *)
+                     (*  attr*  : SET;                      *)
+                         serNm : Lv.CharOpen;
+                         asmLb : ASM.Label;
+                         evalSave : Frm.FrameSave;
+                     END;
+
+(* ============================================================ *)
+(*                Main Emitter Class Definition                 *)
+(* ============================================================ *)
+
+  TYPE AsmEmitter* = POINTER TO RECORD (Ju.JavaFile)
+                      (*
+                       *  The classfile binary file
+                       *) 
+                       file : GPB.FILE;     
+                      (*
+                       *  The class writer for this emitter
+                       *) 
+                       clsWrtr : ASM.ClassWriter;
+                       labelIx : INTEGER;
+                      (*
+                       *  Source filename of the module file.
+                       *) 
+                       srcFileName : Lv.CharOpen;
+                      (*
+                       *  Binary name of the static class
+                       *  that contains the module static code.
+                       *) 
+                       xName : Lv.CharOpen;
+                       nmStr : RTS.NativeString;
+                      (*
+                       *  The method visitor for the current method
+                       *) 
+                       thisMth : Id.Procs;
+                       procNam : Lv.CharOpen;
+                       thisMv  : ASM.MethodVisitor;
+                      (*
+                       *  Resources for tracking local variable use
+                       *) 
+                       entryLab   : AsmLabel;
+                       exitLab    : AsmLabel;
+                       rescueLab  : AsmLabel;
+                       caseArray  : POINTER TO ARRAY OF ASM.Label;
+                       caseEval   : Frm.FrameSave;
+                       mthFrame   : Frm.MethodFrame;
+                       emitStackFrames : BOOLEAN;
+                       stackFramePending : BOOLEAN;
+                     END;
+
+(* ============================================================ *)
+(*                Various Fixed Native Strings                  *)
+(* ============================================================ *)
+
+  VAR jloStr,     (* "java/lang/Object"    *)
+      jlsStr,     (* "java/lang/String"    *)
+      initStr,    (* "<init>"              *)
+      clinitStr,  (* "<clinit>"            *)
+      copyStr,    (* "__copy__"            *)
+      jleStr,     (* "java/lang/Exception" *)
+      jlmStr,     (* "java/lang/Math"      *)
+      jlcStr,     (* "java/lang/Class"     *)
+      jlchStr,    (* "java/lang/Character" *)
+      jlsyStr,    (* "java/lang/System"    *)
+      rtsStr,     (* "CP/CPJrts/CPJrts"    *)
+      cpMain,     (* "CP/CPmain/CPmain"    *)
+     (* ------------------------------------ *)
+      withTrap,   (* "WithMesg"              *)
+      withTrapSig,(* "(Ljlo;)Ljls"           *)
+      caseTrap,   (* "CaseMesg"              *) 
+      caseTrapSig,(* "(I)Ljava/lang/String;" *)
+     (* ------------------------------------ *)
+      mainSig,    (* "([Ljava/lang/String;)V *)
+      strToVoid,  (* "(Ljava/lang/String;)V  *)
+      noArgVoid : (* "()V"                   *) RTS.NativeString;
+     (* ------------------------------------ *)
+
+  VAR pubAcc,     (* ACC_PUBLIC            *)
+      prvAcc,     (* ACC_PRIVATE;          *)
+      finAcc,     (* ACC_FINAL             *)
+      supAcc,     (* ACC_SUPER             *)
+      staAcc,     (* ACC_STATIC            *)
+      absAcc,     (* ACC_ABSTRACT          *)
+      protec,     (* ACC_PACKAGE           *)
+      pckAcc,     (* ACC_PACKAGE           *)
+
+      pubSta,     (* pub + sta             *)
+      modAcc :    (* pub + fin + sup       *) INTEGER;
+
+      (* Kludge to make NIL typecheck with array formal *)
+      jlsEmptyArr : Def.JlsArr;
+
+  VAR procNames  : ARRAY 24 OF Lv.CharOpen;
+      procSigs   : ARRAY 24 OF Lv.CharOpen;
+      procRetS   : ARRAY 24 OF Lv.CharOpen;
+      getClass   : Lv.CharOpen;
+      IIretI     : Lv.CharOpen;
+      JJretJ     : Lv.CharOpen;
+
+  VAR typeArr    : ARRAY 16 OF INTEGER;
+      typeArrArr : ARRAY 16 OF Ty.Array;
+
+  VAR tagCount : INTEGER;
+
+(* ============================================================ *)
+(*                  Static Variables of Module                  *)
+(* ============================================================ *)
+
+  VAR fileSep : Lv.CharOpen;
+      wrtrFlag : INTEGER;
+      classVersion : INTEGER;
+
+(* ============================================================ *)
+(*    Forward Declarations of Static Procedures and Methods     *)
+(* ============================================================ *)
+
+  PROCEDURE^ MkNewAsmLabel( ) : AsmLabel;
+  PROCEDURE^ InterfaceNameList( rec : Ty.Record ) : Def.JlsArr;
+  PROCEDURE^ clsToVoidDesc(rec : Ty.Record) : Lv.CharOpen;
+
+  PROCEDURE^ (lab : AsmLabel)FixTag(),NEW;
+
+(* ============================================================ *)
+(* ============================================================ *)
+(*                   AsmEmitter Constructor Method              *)
+(* ============================================================ *)
+(* ============================================================ *)
+
+  PROCEDURE SetEmitVer();
+  BEGIN
+    IF CSt.asmVer = "" THEN 
+      CSt.emitNam := BOX("AsmUtil - default (V1_" + Def.versionDefault + ")");
+    ELSE
+      CSt.emitNam := BOX("AsmUtil - V1_" + CSt.asmVer);
+    END;
+  END SetEmitVer;
+
+  PROCEDURE newAsmEmitter*(fileName : ARRAY OF CHAR) : AsmEmitter;
+    VAR result : AsmEmitter;
+        pathName : Lv.CharOpen;
+   (* ------------------------------------------------- *)
+    PROCEDURE Warp(VAR s : ARRAY OF CHAR);
+      VAR i : INTEGER;
+    BEGIN
+      FOR i := 0 TO LEN(s)-1 DO
+        IF s[i] = "/" THEN s[i] := GPF.fileSep END;
+      END;
+    END Warp;
+   (* ------------------------------------------------- *)
+    PROCEDURE GetFullPath(IN fn : ARRAY OF CHAR) : Lv.CharOpen;
+      VAR ps : Lv.CharOpen;
+          ch : CHAR;
+    BEGIN
+      ps := BOX(CSt.binDir$);
+      ch := ps[LEN(ps) - 2]; (* last character *)
+      IF (ch # "/") & (ch # "\") THEN
+        ps := BOX(ps^ + fileSep^ + fn);
+      ELSE
+        ps := BOX(ps^ + fn);
+      END;
+      RETURN ps;
+    END GetFullPath;
+   (* ------------------------------------------------- *)
+  BEGIN
+   (*
+    *  Setting some module globals
+    * --------------- *)
+    wrtrFlag   := 0;
+    SetEmitVer();
+    IF CSt.doVersion THEN
+      CSt.Message("Using " + CSt.emitNam^ + " emitter" );
+    END;
+    classVersion := Def.GetClassVersion(CSt.asmVer);
+   (*
+    *  
+    *)
+    IF CSt.binDir # "" THEN
+      pathName := GetFullPath(fileName);
+    ELSE
+      pathName := BOX(fileName$);
+    END;
+    Warp(pathName);
+    NEW(result);
+    result.file := GPB.createPath(pathName);
+    IF result.file = NIL THEN RETURN NIL 
+    ELSE
+      result.srcFileName := BOX(CSt.srcNam$); 
+      result.emitStackFrames := 
+            (classVersion # ASM.Opcodes.V1_1) &
+            (classVersion > ASM.Opcodes.V1_5);
+    END;
+    RETURN result;
+  END newAsmEmitter;
+
+
+(* ============================================================ *)
+(*         Type-bound methods of AsmEmitter record type         *)
+(* ============================================================ *)
+
+  PROCEDURE (emtr : AsmEmitter)EmitStackFrame(),NEW;
+    VAR loclArr : POINTER TO ARRAY OF RTS.NativeObject;
+        evalArr : POINTER TO ARRAY OF RTS.NativeObject;
+        loclNum : INTEGER;
+        evalNum : INTEGER;
+  BEGIN
+    evalNum := emtr.mthFrame.EvCount();
+    loclNum := emtr.mthFrame.LcCount();
+    evalArr := emtr.mthFrame.GetEvalArr();
+    loclArr := emtr.mthFrame.GetLocalArr();
+    emtr.thisMv.visitFrame( ASM.Opcodes.F_NEW,
+        loclNum, loclArr, evalNum, evalArr );
+    emtr.stackFramePending := FALSE;
+  END EmitStackFrame;
+
+  PROCEDURE (emtr : AsmEmitter)CheckFrame(),NEW;
+  BEGIN
+    IF emtr.stackFramePending THEN emtr.EmitStackFrame() END;
+  END CheckFrame;
+
+ (* --------------------------------------------------------- *)
+
+  PROCEDURE (emtr : AsmEmitter)SetProcData( ),NEW;
+  BEGIN
+   (*
+    * Used for local variable table 
+    *)
+    IF CSt.debug THEN
+      emtr.rescueLab := NIL;
+      emtr.entryLab := NIL;
+      emtr.exitLab := NIL;
+     (*
+      * This field is used to suppress emission
+      * of multiple stack frames for the same offset.  
+      *)
+      emtr.stackFramePending := FALSE;
+    END;
+  END SetProcData;
+
+ (* --------------------------------------------------------- *)
+ (* * arrName is the binary name of the array type, e.g. [[D  *)
+ (* * dms is the number of dimensions                         *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)MultiNew*(arrName : Lv.CharOpen;
+                                             dms : INTEGER),NEW;
+  BEGIN
+    emtr.CheckFrame();
+    emtr.thisMv.visitMultiANewArrayInsn( MKSTR(arrName^), dms);
+    emtr.mthFrame.DeltaEvalDepth( 1 - dms );
+    emtr.mthFrame.SetTosState( arrName );
+  END MultiNew;
+
+ (* --------------------------------------------------------- *)
+ (* ------ Push local with index "ord" of a known type ------ *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)LoadLocal*(ord : INTEGER; typ : Sym.Type);
+    VAR code : INTEGER;
+  BEGIN
+   (*
+    *  ASM does not correctly compute stack height
+    *  if the optimized loads ( xLOAD_N for N 1..4)
+    *  are used.  Hence this -
+    *)
+    IF (typ # NIL) & (typ IS Ty.Base) THEN 
+      code := Ju.typeLoad[typ(Ty.Base).tpOrd];
+    ELSE
+      code := ASM.Opcodes.ALOAD; (* all reference types *)
+    END;
+    emtr.CheckFrame();
+    emtr.thisMv.visitVarInsn( code, ord );
+    emtr.mthFrame.FixEvalStack( code, typ );
+  END LoadLocal;
+
+
+ (* --------------------------------------------------------- *)
+ (* --------------------------------------------------------- *)
+ (* -- Store TOS to local with index "ord" of a known type -- *)
+ (* --------------------------------------------------------- *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)StoreLocal*(ord : INTEGER; type : Sym.Type);
+    VAR code : INTEGER;
+  BEGIN
+   (*
+    *  ASM does not correctly compute stack height
+    *  if the optimized loads ( xLOAD_N for N 1..4)
+    *  are used.  Hence this -
+    *)
+    IF (type # NIL) & (type IS Ty.Base) THEN 
+      code := Ju.typeStore[type(Ty.Base).tpOrd];
+    ELSE
+      code := ASM.Opcodes.ASTORE;
+    END;
+    emtr.CheckFrame();
+    emtr.thisMv.visitVarInsn( code, ord );
+    emtr.mthFrame.TrackStore( ord );
+    emtr.mthFrame.FixEvalStack( code, NIL ); (* No TOS type change *)
+  END StoreLocal;
+
+ (* --------------------------------------------------------- *)
+ (*   Push local of reference type to local with index "ord"  *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)AloadLocal*( ord : INTEGER; 
+                                            typ : Sym.Type );
+  BEGIN
+    emtr.CheckFrame();
+    emtr.thisMv.visitVarInsn( ASM.Opcodes.ALOAD, ord );
+    emtr.mthFrame.DeltaEvalDepth( 1 );
+    emtr.mthFrame.SetTosType( typ );
+  END AloadLocal;
+
+ (* --------------------------------------------------------- *)
+ (* --  Allocate new class emitter for static module class -- *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)StartModClass*(mod : Id.BlkId);
+  BEGIN
+    emtr.xName := mod.xName;
+    emtr.nmStr := MKSTR(emtr.xName^);
+    emtr.clsWrtr := ASM.ClassWriter.Init( wrtrFlag );
+    emtr.clsWrtr.visit( 
+        classVersion, modAcc, emtr.nmStr, NIL, jloStr, jlsEmptyArr );
+    emtr.clsWrtr.visitSource( MKSTR(emtr.srcFileName^), NIL );
+  END StartModClass;
+
+
+ (* --------------------------------------------------------- *)
+ (* --------------------------------------------------------- *)
+ (* --  Allocate new class emitter for record module class -- *)
+ (* --------------------------------------------------------- *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)StartRecClass*(rec : Ty.Record);
+    VAR recAtt : INTEGER;
+        index  : INTEGER;
+        clsId  : Sym.Idnt;
+        impRec : Sym.Type;
+        baseNm : RTS.NativeString;
+  BEGIN
+    Hlp.EnsureRecName( rec );
+    emtr.xName := rec.xName;
+    IF rec.baseTp IS Ty.Record THEN 
+      Hlp.EnsureRecName( rec.baseTp(Ty.Record) );
+      baseNm := MKSTR( rec.baseTp.xName^ );
+    ELSE
+      baseNm := jloStr;
+    END;
+    IF rec.recAtt = Ty.noAtt THEN
+      recAtt := supAcc + finAcc;
+    ELSIF rec.recAtt = Ty.isAbs THEN
+      recAtt := supAcc + absAcc;
+    ELSE
+      recAtt := supAcc;
+    END;
+    IF rec.bindTp = NIL THEN
+      clsId := rec.idnt;
+    ELSE
+      clsId := rec.bindTp.idnt;
+    END;
+    IF clsId # NIL THEN
+      IF clsId.vMod = Sym.pubMode THEN INC( recAtt, pubAcc ) END;
+    END;
+   (*
+    *  Get names of interface, if any, into list
+    *)
+    emtr.clsWrtr := ASM.ClassWriter.Init( wrtrFlag );
+    emtr.clsWrtr.visit( 
+        classVersion, recAtt, MKSTR(rec.xName^), NIL, 
+        baseNm, InterfaceNameList(rec) );
+    emtr.clsWrtr.visitSource( MKSTR(emtr.srcFileName^), NIL );
+  END StartRecClass;
+
+ (* --------------------------------------------------------- *)
+ (* ------   Dump the procedure local variable table   ------ *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)DumpLocalTable(),NEW;
+    VAR local : Id.LocId;
+        start : AsmLabel;
+        vName : RTS.NativeString;
+        tName : RTS.NativeString;
+        proc  : Id.Procs;
+        idx   : INTEGER;
+        mv    : ASM.MethodVisitor;
+  BEGIN
+    mv := emtr.thisMv;
+    proc := emtr.thisMth;
+    IF proc # NIL THEN
+      FOR idx := 0 TO proc.locals.tide - 1 DO
+        local := proc.locals.a[idx](Id.LocId);
+        vName := local.namStr;
+        tName := MKSTR( Hlp.GetBinaryTypeName( local.type )^ );
+        IF vName = NIL THEN 
+          IF local(Id.ParId).isRcv THEN
+            vName := MKSTR( "this" );
+          ELSE
+            vName := MKSTR( "__anon" + Ju.i2CO( idx )^ + "__" );
+          END;
+        END;
+        IF local = proc.except THEN 
+          start := emtr.rescueLab;
+        ELSE
+          start := emtr.entryLab;
+        END;
+        mv.visitLocalVariable( vName, tName, NIL,
+            start.asmLb, emtr.exitLab.asmLb, local.varOrd );
+      END;
+    END;
+  END DumpLocalTable;
+  
+
+ (* --------------------------------------------------------- *)
+ (* ------   Allocate method visitor for any method    ------ *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)StartProc*(proc : Id.Procs);
+    VAR attr : INTEGER;
+        method : Id.MthId;
+        mv : ASM.MethodVisitor;
+  BEGIN
+    emtr.thisMth := proc;
+    emtr.procNam := proc.prcNm;
+    IF proc.kind = Id.conMth THEN 
+      attr := 0;
+      method := proc(Id.MthId);
+      IF method.mthAtt * Id.mask = {} THEN attr := finAcc END;
+      IF method.mthAtt * Id.mask = Id.isAbs THEN INC(attr,absAcc) END;
+      IF Id.widen IN method.mthAtt THEN INC(attr,pubAcc) END;
+    ELSE
+      attr := staAcc;
+    END;
+(*
+ *  The following code fails for "implement-only" methods
+ *  since the JVM places the "override method" in a different 
+ *  slot! We must thus live with the insecurity of public mode.
+ *
+ *  IF proc.vMod = Sym.pubMode THEN     (* explicitly public *)
+ *)
+    IF (proc.vMod = Sym.pubMode) OR     (* explicitly public *)
+       (proc.vMod = Sym.rdoMode) THEN   (* "implement only"  *)
+      INC(attr,pubAcc);
+    ELSIF proc.dfScp IS Id.PrcId THEN   (* nested procedure  *)
+      INC(attr,prvAcc);
+    END;
+
+    mv := emtr.clsWrtr.visitMethod( attr, 
+        MKSTR(proc.prcNm^), 
+        MKSTR(proc.type.xName^), 
+        NIL, jlsEmptyArr );
+    emtr.thisMv := mv;
+    emtr.procNam := proc.prcNm;
+
+    emtr.mthFrame := Frm.NewMethodFrame( proc );
+    emtr.SetProcData( );
+
+    mv.visitCode();
+    IF CSt.debug THEN
+      emtr.entryLab := MkNewAsmLabel();
+      mv.visitLabel( emtr.entryLab.asmLb );
+    END;
+  END StartProc;
+
+ (* --------------------------------------------------------- *)
+
+  PROCEDURE (emtr : AsmEmitter)EndProc*(); (* NEW,EMPTY *)
+    VAR mv : ASM.MethodVisitor;
+        xL : AsmLabel;
+  BEGIN
+    mv := emtr.thisMv;
+    (* ... *)
+
+    (* ... *)
+    IF CSt.debug THEN
+      xL := MkNewAsmLabel();
+      mv.visitLabel( xL.asmLb );
+      xL.defIx := xL.asmLb.getOffset();
+      emtr.exitLab := xL;
+      emtr.DumpLocalTable();
+    END;
+    mv.visitMaxs( emtr.mthFrame.maxEval, emtr.mthFrame.maxLocal ); 
+    mv.visitEnd(); 
+    emtr.thisMv := NIL;
+    emtr.thisMth := NIL;
+  END EndProc;
+
+ (* --------------------------------------------------------- *)
+
+  PROCEDURE (emtr : AsmEmitter)isAbstract*():BOOLEAN;
+    VAR proc : Id.Procs;
+  BEGIN
+    proc := emtr.thisMth;
+    IF proc = NIL THEN
+      THROW( "Can only call isAbstract during a method visit" );
+    END;
+    WITH proc : Id.MthId DO
+      RETURN proc.mthAtt * Id.mask = Id.isAbs;
+    ELSE
+      RETURN FALSE;
+    END;
+  END isAbstract;
+
+ (* --------------------------------------------------------- *)
+
+  PROCEDURE (emtr : AsmEmitter)getScope*():Sym.Scope;
+  BEGIN
+    RETURN emtr.thisMth;
+  END getScope;
+
+ (* --------------------------------------------------------- *)
+ (* ------         ------ *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter) EmitField*(field : Id.AbVar);
+    VAR access : INTEGER;
+        fv     : ASM.FieldVisitor;
+  BEGIN
+   (*
+    *  emtr has already allocated a vector of fieldInfo
+    *)
+    CASE field.vMod OF
+    | Sym.prvMode : access := pckAcc;
+    | Sym.pubMode : access := pubAcc;
+    | Sym.rdoMode : access := pubAcc;
+    | Sym.protect : access := protec;
+    END;
+    IF field IS Id.VarId THEN INC( access, staAcc ) END;
+    fv := emtr.clsWrtr.visitField( access, Hlp.idNam(field), Hlp.idSig(field), NIL, NIL );
+    fv.visitEnd();
+  END EmitField;
+
+ (* --------------------------------------------------------- *)
+ (* ------   Translation of NEW( var of type "typ" )   ------ *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)MkNewRecord*(typ : Ty.Record);
+    VAR mv : ASM.MethodVisitor;
+        cn : RTS.NativeString;
+  BEGIN
+    mv := emtr.thisMv;
+    cn := Hlp.tyCls( typ );
+    emtr.CheckFrame();
+    mv.visitTypeInsn( ASM.Opcodes.`NEW, cn );
+    emtr.mthFrame.DeltaEvalDepth( 1 );
+    mv.visitInsn( ASM.Opcodes.DUP );
+    emtr.mthFrame.DeltaEvalDepth( 1 );
+    mv.visitMethodInsn(
+        ASM.Opcodes.INVOKESPECIAL, cn, initStr, noArgVoid, FALSE );
+    emtr.mthFrame.DeltaEvalDepth( -1 );
+    emtr.mthFrame.SetTosType( typ );
+  END MkNewRecord;
+
+ (* --------------------------------------------------------- *)
+
+  PROCEDURE (emtr : AsmEmitter)MkNewFixedArray*(topE : Sym.Type;
+                                                len0 : INTEGER);
+    VAR dims : INTEGER;
+        arTp : Ty.Array;
+        elTp : Sym.Type;
+  BEGIN
+    (*
+    //  Fixed-size, possibly multi-dimensional arrays.
+    //  The code relies on the semantic property in CP
+    //  that the element-type of a fixed array type cannot
+    //  be an open array. This simplifies the code somewhat.
+    *)
+    emtr.PushInt(len0);
+    dims := 1;
+    elTp := topE;
+   (*
+    *  Find the number of dimensions ...
+    *)
+    LOOP
+      WITH elTp : Ty.Array DO arTp := elTp ELSE EXIT END;
+      elTp := arTp.elemTp;
+      emtr.PushInt(arTp.length);
+      INC(dims);
+    END;
+    IF dims = 1 THEN
+      emtr.Alloc1d(elTp);
+     (*
+      *  Stack is (top) len0, ref...
+      *)
+      IF elTp.kind = Ty.recTp THEN emtr.Init1dArray(elTp, len0) END;
+    ELSE
+     (*
+      *  Allocate the array headers for all dimensions.
+      *  Stack is (top) lenN, ... len0, ref...
+      *)
+      emtr.MultiNew(Ju.cat2(Ju.brac, Hlp.GetBinaryTypeName(topE)), dims);
+     (*
+      *  Stack is (top) ref...
+      *)
+      IF elTp.kind = Ty.recTp THEN emtr.InitNdArray(topE, elTp) END;
+    END;
+  END MkNewFixedArray;
+
+ (* --------------------------------------------------------- *)
+
+  PROCEDURE (emtr : AsmEmitter)MkNewOpenArray*(arrT : Ty.Array;
+                                               dims : INTEGER);
+    VAR elTp : Sym.Type;
+        indx : INTEGER;
+  BEGIN
+   (* 
+    *  Assert: lengths are pushed already...
+    *  and we know from semantic analysis that
+    *  the number of open array dimensions match
+    *  the number of integer LENs in dims.
+    *)
+    elTp := arrT;
+   (*
+    *   Find the number of dimensions ...
+    *)
+    FOR indx := 0 TO dims-1 DO
+      elTp := elTp(Ty.Array).elemTp;
+    END;
+   (*
+    *   Allocate the array headers for all _open_ dimensions.
+    *)
+    IF dims = 1 THEN
+      emtr.Alloc1d(elTp);
+     (*
+      *  Stack is now (top) ref ...
+      *  and we _might_ need to initialize the elements.
+      *)
+      IF (elTp.kind = Ty.recTp) OR 
+         (elTp.kind = Ty.arrTp) THEN 
+        emtr.Init1dArray(elTp, 0);
+      END;
+    ELSE
+      emtr.MultiNew( Hlp.GetBinaryTypeName(arrT), dims );
+     (*
+      *    Stack is now (top) ref ...
+      *    Now we _might_ need to initialize the elements.
+      *)
+      IF (elTp.kind = Ty.recTp) OR 
+         (elTp.kind = Ty.arrTp) THEN 
+        emtr.InitNdArray(arrT.elemTp, elTp);
+      END;
+    END;
+  END MkNewOpenArray;
+
+ (* --------------------------------------------------------- *)
+
+  PROCEDURE (emtr : AsmEmitter)MkArrayCopy*(arrT : Ty.Array);
+    VAR dims : INTEGER;
+        elTp : Sym.Type;
+  BEGIN
+   (*
+    *   Assert: we must find the lengths from the runtime 
+    *   descriptors.  Find the number of dimensions.  The 
+    *   array to copy is on the top of stack, which reads -
+    *        (top) aRef, ...
+    *)
+    elTp := arrT.elemTp;
+    IF elTp.kind # Ty.arrTp THEN
+      emtr.Code(Jvm.opc_arraylength); (* (top) len0, aRef,...  *)
+      emtr.Alloc1d(elTp);             (* (top) aRef, ...       *)
+      IF elTp.kind = Ty.recTp THEN emtr.Init1dArray(elTp, 0) END; (*0 ==> open*)
+    ELSE
+      dims := 1;
+      REPEAT
+       (* 
+        *  Invariant: an array reference is on the top of
+        *  of the stack, which reads:
+        *        (top) [arRf, lengths,] arRf ...
+        *)
+        INC(dims);
+        elTp := elTp(Ty.Array).elemTp;
+        emtr.Code(Jvm.opc_dup);         (*           arRf, arRf,... *)
+        emtr.Code(Jvm.opc_arraylength); (*     len0, arRf, arRf,... *)
+        emtr.Code(Jvm.opc_swap);        (*     arRf, len0, arRf,... *)
+        emtr.Code(Jvm.opc_iconst_0);    (*  0, arRf, len0, arRf,... *)
+        emtr.Code(Jvm.opc_aaload);      (*     arRf, len0, arRf,... *)
+       (* 
+        *  Stack reads:        (top) arRf, lenN, [lengths,] arRf ...
+        *)
+      UNTIL  elTp.kind # Ty.arrTp;
+     (*
+      *  Now get the final length...
+      *)
+      emtr.Code(Jvm.opc_arraylength);  
+     (* 
+      *   Stack reads:        (top) lenM, lenN, [lengths,] arRf ...
+      *   Allocate the array headers for all dimensions.
+      *)
+      emtr.MultiNew( Hlp.GetBinaryTypeName(arrT), dims );
+     (*
+      *  Stack is (top) ref...
+      *)
+      IF elTp.kind = Ty.recTp THEN emtr.InitNdArray(arrT.elemTp, elTp) END;
+    END;
+  END MkArrayCopy;
+
+
+(* ============================================================ *)
+(* ============================================================ *)
+(*                 Temporary Local Management                   *)
+(* ============================================================ *)
+(* ============================================================ *)
+
+ (* --------------------------------------------------------- *)
+ (*      newLocal allocates a temp and bumps LocalNum         *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)newLocal*( t : Sym.Type ) : INTEGER;
+    VAR ord, new : INTEGER;
+  BEGIN
+    ord := emtr.mthFrame.LcHi();
+    emtr.mthFrame.AddLocal( t );
+    new := emtr.mthFrame.LcHi();
+    RETURN new;
+  END newLocal;
+
+ (* --------------------------------------------------------- *)
+ (*   newLongLocal allocates a 2-slot temp, bumps LocalNum    *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)newLongLocal*( t : Sym.Type ) : INTEGER;
+    VAR ord,new : INTEGER;
+  BEGIN
+    ord := emtr.mthFrame.LcHi();
+    emtr.mthFrame.AddLocal( t );
+    new := emtr.mthFrame.LcHi();
+    ASSERT( new = ord + 2 );
+    RETURN new;
+  END newLongLocal;
+
+ (* --------------------------------------------------------- *)
+ (*      ReleaseLocal discards the temporary at index "i"     *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)PopLocal*();
+  BEGIN
+    emtr.mthFrame.PopLocal1();
+  END PopLocal;
+
+ (* --------------------------------------------------------- *)
+ (*  ReleaseLongLocal discards the temporary at index i,i+1   *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)PopLongLocal*();
+  BEGIN
+    emtr.mthFrame.PopLocal2();
+  END PopLongLocal;
+
+ (* --------------------------------------------------------- *)
+ (*  Function markTop saves the local variable depth at the   *)
+ (*  point where a call is about to be made. This call may    *)
+ (*  allocate new temporaries during argument evaluation. All *)
+ (*  of these will be dead at the return, and are discarded.  *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)markTop*() : INTEGER;
+    VAR m : INTEGER;
+  BEGIN
+    m := emtr.mthFrame.LcLn();
+    RETURN m;
+  END markTop;
+
+ (* --------------------------------------------------------- *)
+ (*     ReleaseAll discards the temps, restoring localNum     *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)ReleaseAll*(m : INTEGER);
+  BEGIN
+    emtr.mthFrame.ReleaseTo( m );
+  END ReleaseAll;
+
+(* ============================================================ *)
+(* ============================================================ *)
+(*                   Shadow Stack Management                    *)
+(* ============================================================ *)
+(* ============================================================ *)
+
+ (* --------------------------------------------------------- *)
+ (*                Get Evaluation Stack Depth                 *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)getDepth*() : INTEGER;
+  BEGIN
+    RETURN LEN(emtr.mthFrame.evalStack);
+  END getDepth;
+
+ (* --------------------------------------------------------- *)
+ (*                Set Evaluation Stack Depth                 *)
+ (* --------------------------------------------------------- *)
+
+  PROCEDURE (emtr : AsmEmitter)setDepth*(i : INTEGER);
+  BEGIN
+    emtr.mthFrame.setDepth( i );
+  END setDepth;
+
+(* ============================================================ *)
+(* ============================================================ *)
+(*                      Label Management                        *)
+(* ============================================================ *)
+(* ============================================================ *)
+
+ (* --------------------------------------------------------- *)
+ (*             Allocate a single JavaUtil.Label              *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)newLabel*() : Ju.Label;
+  BEGIN
+    RETURN MkNewAsmLabel();
+  END newLabel;
+
+  PROCEDURE (emtr : AsmEmitter)newEmptystackLabel*() : Ju.Label;
+    VAR label : AsmLabel; 
+  BEGIN
+    label := MkNewAsmLabel();
+    INCL( label.attr, Ju.forceEmpty );
+    RETURN label;
+  END newEmptystackLabel;
+
+  PROCEDURE (emtr : AsmEmitter)newLoopheaderLabel*() : Ju.Label;
+    VAR label : AsmLabel; 
+  BEGIN
+    label := MkNewAsmLabel();
+    INCL( label.attr, Ju.forceEmit );
+    RETURN label;
+  END newLoopheaderLabel;
+
+ (* --------------------------------------------------------- *)
+ (*            Allocate an array of JavaUtil.Labels           *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)getLabelRange*(VAR labs:ARRAY OF Ju.Label);
+    VAR idx : INTEGER;
+  BEGIN
+    FOR idx := 0 TO LEN(labs) - 1 DO
+      labs[idx] := MkNewAsmLabel();
+    END;
+  END getLabelRange;
+
+ (* --------------------------------------------------------- *)
+ (*                Assign a unique tag to label               *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (lab : AsmLabel)FixTag(),NEW;
+  BEGIN
+    INC(tagCount);
+    lab.serNm := BOX( "label_" + Ju.i2CO(tagCount)^ );
+  END FixTag;
+
+ (* --------------------------------------------------------- *)
+ (*            Check if label has seen a jump edge            *)
+ (* --------------------------------------------------------- *)
+ (* // NOW uses the inherited proc Ju.JumpSeen() 
+  PROCEDURE (lab : AsmLabel)JumpSeen*() : BOOLEAN;
+  BEGIN
+    RETURN jumpSeen IN lab.attr;
+  END JumpSeen;
+  *)
+
+ (* --------------------------------------------------------- *)
+ (*   Check if label not fixed AND not previously jumped to   *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (lab : AsmLabel)FwdTarget() : BOOLEAN,NEW;
+  BEGIN
+    RETURN Ju.unfixed IN lab.attr;
+  END FwdTarget;
+
+ (* --------------------------------------------------------- *)
+  PROCEDURE ( lab : AsmLabel )Str*() : Lv.CharOpen;
+    VAR attr : ARRAY 12 OF CHAR;
+        posn : ARRAY 12 OF CHAR;
+  BEGIN
+    attr := "{.,..,..,.}";
+    IF (Ju.unfixed IN lab.attr)  THEN attr[1] := "?" END;
+    IF (Ju.posFixed IN lab.attr) THEN attr[1] := "P" END;
+    IF (Ju.forceEmpty IN lab.attr) THEN 
+                      attr[3] := "m"; attr[4] := "t" END;
+    IF (Ju.assertEmpty IN lab.attr) THEN 
+                      attr[3] := "M"; attr[4] := "T" END;
+    IF (Ju.jumpSeen IN lab.attr)  THEN   
+                      attr[6] := "j"; attr[7] := "s" END;
+    IF (Ju.forceEmit IN lab.attr) THEN   attr[9] := "!" END;
+    IF lab.defIx > 0 THEN posn := ", @" + Ju.i2CO( lab.defIx )^;
+                     ELSE posn := "" END; 
+    RETURN BOX( lab.serNm^ + ": // " + attr + posn );
+  END Str;
+
+ (* --------------------------------------------------------- *)
+ (*      Emit the no-arg instruction, after legality check    *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)Code*(code : INTEGER);
+  BEGIN
+    ASSERT( ~Acs.badCode( code ) );
+    emtr.CheckFrame();
+    emtr.thisMv.visitInsn( code );
+    emtr.mthFrame.MutateEvalStack( code ); (* Compute TOS change *)
+  END Code;
+
+ (* --------------------------------------------------------- *)
+
+  PROCEDURE (emtr : AsmEmitter)CodeI*(code,val : INTEGER);
+  BEGIN
+   (* 
+    * ASM5 allows bipush, sipush and newarray on basic types 
+    *      gpcp only allows bipush and sipush.
+    *) 
+    ASSERT((code = Jvm.opc_bipush) OR
+           (code = Jvm.opc_sipush));
+    emtr.CheckFrame();
+    emtr.thisMv.visitIntInsn( code, val );
+    emtr.mthFrame.MutateEvalStack( code ); 
+  END CodeI;
+
+ (* --------------------------------------------------------- *)
+ (*      Emit LDC for a long-int lit. Arg code is unused      *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)CodeL*(code : INTEGER; num : LONGINT);
+  BEGIN
+    (* code is ignored *)
+    emtr.CheckFrame();
+    emtr.thisMv.visitLdcInsn( Hlp.MkLong( num ) );
+    emtr.mthFrame.FixEvalStack( Jvm.opc_ldc2_w, Blt.lIntTp );
+  END CodeL;
+
+ (* --------------------------------------------------------- *)
+ (*     This is just a version of Code( c ) with a comment    *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)CodeC*(code : INTEGER; 
+                                   IN str  : ARRAY OF CHAR);
+  BEGIN
+    ASSERT( ~Acs.badCode( code ) );
+    emtr.CheckFrame();
+    emtr.thisMv.visitInsn( code );
+    emtr.mthFrame.MutateEvalStack( code ); (* Compute TOS change *)
+  END CodeC;
+
+ (* --------------------------------------------------------- *)
+ (*   Emit LDC for a floating point lit. Arg code is unused   *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)CodeR*(code : INTEGER; 
+                                      num  : REAL; short : BOOLEAN);
+  BEGIN
+    (* code is ignored *)
+    emtr.CheckFrame();
+    IF short THEN
+      emtr.thisMv.visitLdcInsn( Hlp.MkFloat( SHORT(num) ) );
+      emtr.mthFrame.FixEvalStack( Jvm.opc_ldc, Blt.sReaTp );
+    ELSE
+      emtr.thisMv.visitLdcInsn( Hlp.MkDouble( num ) );
+      emtr.mthFrame.FixEvalStack( Jvm.opc_ldc2_w, Blt.realTp );
+    END;
+  END CodeR;
+
+ (* --------------------------------------------------------- *)
+ (*        Emit a jump instruction to the given label         *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)CodeLb*(code : INTEGER; lab : Ju.Label);
+    VAR label : AsmLabel;
+  BEGIN
+    label := lab(AsmLabel);
+    emtr.CheckFrame();
+    emtr.thisMv.visitJumpInsn( code, label.asmLb );
+   (*
+    *  The eval stack effect of the jump must be applied
+    *  before the stack state is copied to label.evalSave
+    *)
+    emtr.mthFrame.FixEvalStack( code, NIL );
+    IF label.FwdTarget() THEN (* ==> this is a forward jump *)
+      label.evalSave := emtr.mthFrame.GetFrameSave( label.evalSave );
+      INCL( label.attr, Ju.jumpSeen );
+    END;
+  END CodeLb;
+
+ (* --------------------------------------------------------- *)
+ (*        Define a Label location and update lab.defIx       *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)DefLab*(lab : Ju.Label);
+    VAR label : AsmLabel;
+        undef : BOOLEAN; (* ==> eval stack is invalid *)
+  BEGIN
+    label := lab(AsmLabel);
+    ASSERT( label.defIx = 0 ); (* Labels are only defined once *)
+   (*
+    *  Only emit a label if a prior jump uses
+    *  this label as a target, or forceEmit is 
+    *  set as is the case for all loop headers.
+    *)
+    IF ~(Ju.jumpSeen IN label.attr) &
+       ~(Ju.forceEmit IN label.attr) THEN 
+      (* CSt.PrintLn("SKIPPING DefLab"); *)
+      RETURN;
+    END;
+
+    emtr.thisMv.visitLabel( label.asmLb );
+    label.defIx := label.asmLb.getOffset(); 
+
+    undef := emtr.mthFrame.InvalidStack();
+    IF Ju.assertEmpty IN label.attr THEN
+      ASSERT( ~undef & (emtr.mthFrame.EvLn() = 0 ) );
+    END;
+
+    IF Ju.jumpSeen IN label.attr THEN
+      emtr.mthFrame.RestoreFrameState( label.evalSave );
+    ELSIF Ju.forceEmpty IN label.attr THEN
+      emtr.mthFrame.RestoreFrameState( NIL );
+    ELSIF undef THEN
+     (*
+      *  State should not be undef, if the label has been
+      *  fallen into, i.e. is not following an unconditional jump.
+      *)
+      THROW( "Undefined stack state at back-edge target label" );
+    END;
+    INCL( label.attr, Ju.posFixed );
+    EXCL( label.attr, Ju.unfixed );
+    emtr.mthFrame.ValidateEvalStack();
+    IF emtr.emitStackFrames THEN
+      emtr.stackFramePending := TRUE;
+    END;
+  END DefLab;
+
+ (* --------------------------------------------------------- *)
+ (*   Define a commented Label location and update lab.defIx  *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)DefLabC*(lab : Ju.Label; 
+                                       IN c : ARRAY OF CHAR);
+  BEGIN
+    emtr.DefLab( lab );
+  END DefLabC;
+
+ (* --------------------------------------------------------- *)
+ (*   Emit an iinc instruction on a local variable of param   *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)CodeInc*(localIx,incVal : INTEGER);
+  BEGIN
+    emtr.CheckFrame();
+    emtr.thisMv.visitIincInsn( localIx, incVal );
+   (* no stack frame change *)
+  END CodeInc;
+
+ (* --------------------------------------------------------- *)
+ (* Emit an instruction that takes a type arg, e.g. checkcast *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)CodeT*(code : INTEGER; ty : Sym.Type);
+    VAR name : RTS.NativeString;
+  BEGIN
+    name := Hlp.tyNam( ty ); (* not signature! *)
+    emtr.CheckFrame();
+    emtr.thisMv.visitTypeInsn( code, name );
+   (* 
+    *  instanceof, checkcast, new, anewarray 
+    *  Stack is bumped for new, otherwise unchanged
+    *)
+    CASE code OF
+    | Jvm.opc_new        : emtr.mthFrame.FixEvalStack( code, ty );
+    | Jvm.opc_anewarray  : emtr.mthFrame.SetTosSig( Hlp.tyArrSig( ty ) );
+    | Jvm.opc_checkcast  : emtr.mthFrame.SetTosType( ty )
+    | Jvm.opc_instanceof : emtr.mthFrame.SetTosType( Blt.intTp );
+    END;
+  END CodeT;
+
+ (* --------------------------------------------------------- *)
+ (*  For ASM, this call just allocates the array of ASM.Label *)
+ (*  which will be filled in by AddSwitchLab calls. The ASM   *)
+ (*  call to emit the tableswitch op is in CodeSwitchEnd.     *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)CodeSwitch*(low,high : INTEGER; 
+                                   defLab : Ju.Label);
+    VAR asmLabs : POINTER TO ARRAY OF ASM.Label;
+        newLen : INTEGER;
+   (* ----------------------------- *)
+    PROCEDURE EvalStackAfterTableswitch(f : Frm.MethodFrame) : Frm.FrameSave;
+      VAR rslt : Frm.FrameSave;
+    BEGIN
+      f.DeltaEvalDepth( -1 );
+      rslt := f.GetFrameSave( NIL );
+      f.FixEvalStack( Jvm.opc_iconst_0, Blt.intTp );
+      RETURN rslt;
+    END EvalStackAfterTableswitch;
+   (* ----------------------------- *)
+  BEGIN
+    newLen := high - low + 1;
+    NEW( asmLabs, newLen );
+    emtr.caseArray := asmLabs;
+    emtr.caseEval := EvalStackAfterTableswitch(emtr.mthFrame);
+  END CodeSwitch;
+
+ (* --------------------------------------------------------- *)
+ (*      The dispatch table is passed to visitTableSwitch     *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)CodeSwitchEnd*( lo, hi : INTEGER;
+                                               defLab : Ju.Label );
+    VAR default : ASM.Label;
+  BEGIN
+    emtr.CheckFrame();
+    WITH defLab : AsmLabel DO
+      default := defLab.asmLb;
+      INCL( defLab.attr, Ju.jumpSeen );
+      defLab.evalSave := emtr.caseEval;
+      emtr.thisMv.visitTableSwitchInsn( lo, hi, default, emtr.caseArray );
+      INCL( defLab.attr, Ju.forceEmpty );
+    END;
+    emtr.mthFrame.InvalidateEvalStack();
+  END CodeSwitchEnd;
+
+ (* --------------------------------------------------------- *)
+ (*     Inserts an ASM.Label in the scratch array in emtr     *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)AddSwitchLab*(lab : Ju.Label; 
+                                             pos : INTEGER);
+  BEGIN
+    WITH lab : AsmLabel DO
+      lab.evalSave := emtr.caseEval;
+      emtr.caseArray[pos] := lab.asmLb;
+      INCL( lab.attr, Ju.forceEmpty );
+      INCL( lab.attr, Ju.jumpSeen );
+    END;
+  END AddSwitchLab;
+
+ (* --------------------------------------------------------- *)
+ (*         Emit a literal string to the constant pool        *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)PushStr*(IN str : Lv.CharOpen);
+  BEGIN
+   (* Push a literal string *)
+    emtr.CheckFrame();
+    emtr.thisMv.visitLdcInsn( MKSTR(str^) );
+    emtr.mthFrame.FixEvalStack( Jvm.opc_ldc, CSt.ntvStr );
+  END PushStr;
+
+ (* --------------------------------------------------------- *)
+ (*                 Load an integer constant                  *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)LoadConst*(num : INTEGER);
+  BEGIN
+(* FIXME for byte case *)
+    emtr.CheckFrame();
+    IF (num >= MIN(SHORTINT)) & (num <= MAX(SHORTINT)) THEN
+      emtr.thisMv.visitIntInsn( Jvm.opc_sipush, num );
+      emtr.mthFrame.FixEvalStack( Jvm.opc_sipush, Blt.sIntTp );
+    ELSE
+      emtr.thisMv.visitLdcInsn( Hlp.MkInteger( num ) );
+      emtr.mthFrame.FixEvalStack( Jvm.opc_ldc, Blt.intTp );
+    END;
+  END LoadConst;
+
+ (* --------------------------------------------------------- *)
+
+  PROCEDURE (emtr : AsmEmitter)CallGetClass*();
+  BEGIN
+    THROW( "method CallGetClass not implemented" );
+  END CallGetClass; 
+
+ (* --------------------------------------------------------- *)
+
+  PROCEDURE (emtr : AsmEmitter)CallRTS*(ix,args,ret : INTEGER);
+    VAR classStr : RTS.NativeString;
+  BEGIN
+   (*
+    *  Select the class that supplies the operation
+    *)
+    IF ix = Ju.ToUpper THEN
+       classStr := jlchStr        (* java/lang/Character *)
+    ELSIF ix = Ju.DFloor THEN
+       classStr := jlmStr         (* java/lang/Math      *)
+    ELSIF ix = Ju.SysExit THEN
+       classStr := jlsyStr        (* java/lang/System    *)
+    ELSE
+       classStr := rtsStr         (* CP/CPJrts/CPJrts    *);
+    END;
+
+    emtr.CheckFrame();
+    emtr.thisMv.visitMethodInsn( 
+        ASM.Opcodes.INVOKESTATIC, classStr, 
+        MKSTR(procNames[ix]^), MKSTR(procSigs[ix]^), FALSE );
+    emtr.mthFrame.DeltaEvalDepth( ret - args );
+    IF ret > 0 THEN emtr.mthFrame.SetTosState( procRetS[ix] ) END;
+  END CallRTS; 
+
+ (* --------------------------------------------------------- *)
+ (*         Call a proc with a statically known name          *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)CallIT*(code : INTEGER; 
+                                       proc : Id.Procs; 
+                                       type : Ty.Procedure);
+    VAR interface : BOOLEAN;
+  BEGIN
+    interface := code = Jvm.opc_invokeinterface;
+    emtr.CheckFrame();
+    emtr.thisMv.visitMethodInsn( code, Hlp.idCls( proc ), 
+               Hlp.idNam( proc ), Hlp.idSig( proc ), interface );
+    emtr.mthFrame.DeltaEvalDepth( type.retN - type.argN );
+   (* 
+    *  Return size retN may be non-zero for a pure procedure
+    *  due to the movement of an OUT or VAR parameter to the
+    *  return position. The JVM implementation return-type
+    *  is denoted by the target-specific field tgXtn.aux
+    *)
+    IF type.retN > 0 THEN emtr.mthFrame.SetTosType( Hlp.tyRetTyp( type ) ) END;
+  END CallIT;
+
+
+ (* --------------------------------------------------------- *)
+ (*   Emit head of the constructor for static class features  *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)ClinitHead*();
+    VAR mv : ASM.MethodVisitor;
+  BEGIN
+    mv := emtr.clsWrtr.visitMethod(
+        pubSta, clinitStr, noArgVoid, NIL, jlsEmptyArr );
+    emtr.thisMv := mv;
+    emtr.procNam := BOX("<clinit>");
+
+    emtr.mthFrame := Frm.SigFrame( BOX("()V"), emtr.procNam, NIL );
+    emtr.SetProcData( );
+
+    mv.visitCode();
+  END ClinitHead;
+
+ (* --------------------------------------------------------- *)
+ (*     Emit head of main( array of String ) static method    *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)MainHead*();
+    VAR mv : ASM.MethodVisitor;
+   (* --------------- *)
+    PROCEDURE mkPrcId() : Id.Procs;
+      VAR rslt : Id.PrcId;
+          parN : Id.ParId;
+    BEGIN
+      NEW(rslt);
+      rslt.setPrcKind(Id.conPrc);
+      parN := Id.newParId()(Id.ParId); 
+      parN.parMod := Sym.in;
+      parN.type := CSt.ntvStrArr;
+      Sym.AppendIdnt(rslt.locals, parN);
+      RETURN rslt;
+    END mkPrcId;
+   (* --------------- *)
+
+  BEGIN
+    emtr.thisMth := mkPrcId();
+    mv := emtr.clsWrtr.visitMethod(
+        pubSta, "main", "([Ljava/lang/String;)V", NIL, jlsEmptyArr ); 
+
+    mv.visitCode();
+    emtr.thisMv := mv; 
+    emtr.procNam := BOX("main");
+
+    emtr.mthFrame := Frm.SigFrame( 
+           BOX("([Ljava/lang/String;)V"), emtr.procNam, NIL );
+    emtr.SetProcData( );
+    emtr.entryLab := MkNewAsmLabel();
+   (*
+    *  Save the command line args to the RTS 
+    *)
+    emtr.AloadLocal( 0, CSt.ntvStrArr );
+    mv.visitMethodInsn( 
+        ASM.Opcodes.INVOKESTATIC, cpMain, "PutArgs", mainSig , FALSE );
+    emtr.mthFrame.DeltaEvalDepth( -1 ); (* no SetTos* *)
+  END MainHead;
+
+ (* --------------------------------------------------------- *)
+
+  PROCEDURE (emtr : AsmEmitter)VoidTail*();
+    VAR mv : ASM.MethodVisitor;
+  BEGIN
+    mv := emtr.thisMv; 
+    emtr.CheckFrame();
+    mv.visitInsn( ASM.Opcodes.`RETURN );
+   (* no SetTos* *)
+    IF CSt.debug & (emtr.thisMth # NIL) THEN
+      emtr.exitLab := MkNewAsmLabel();
+      mv.visitLabel( emtr.exitLab.asmLb );
+      emtr.exitLab.defIx := emtr.exitLab.asmLb.getOffset();
+      emtr.DumpLocalTable();
+    END;
+    mv.visitMaxs( emtr.mthFrame.maxEval, emtr.mthFrame.maxLocal );  
+    mv.visitEnd();
+    emtr.thisMv := NIL;
+    emtr.thisMth := NIL;
+  END VoidTail;
+
+ (* --------------------------------------------------------- *)
+ (*           Constructor for the module body class           *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)ModNoArgInit*();
+    VAR mv : ASM.MethodVisitor;
+   (* --------------- *)
+    PROCEDURE mkPrcId(e : AsmEmitter) : Id.Procs;
+      VAR rslt : Id.PrcId;
+          parN : Id.ParId;
+          type : Ty.Opaque;
+    BEGIN
+      NEW(rslt);
+      type := Ty.newNamTp();
+      type.xName := e.xName;
+      type.scopeNm := Ju.cat3(Ju.lCap, e.xName, Ju.semi);
+      rslt.setPrcKind(Id.conMth);
+      parN := Id.newParId()(Id.ParId); 
+      parN.isRcv := TRUE;
+      parN.parMod := Sym.in;
+      parN.type := type;
+      Sym.AppendIdnt(rslt.locals, parN);
+      RETURN rslt;
+    END mkPrcId;
+   (* --------------- *)
+  BEGIN
+    emtr.thisMth := mkPrcId(emtr);
+   (* 
+    * Create a new method visitor and save in emitter
+    *)
+    mv := emtr.clsWrtr.visitMethod(
+        ASM.Opcodes.ACC_PUBLIC, "<init>", "()V", NIL, jlsEmptyArr );
+    emtr.thisMv := mv;
+    emtr.procNam := BOX("<init>");
+
+    emtr.mthFrame := Frm.SigFrame( BOX("()V"), emtr.procNam, NIL );
+    emtr.SetProcData( );
+    mv.visitCode();
+    emtr.entryLab := MkNewAsmLabel();
+    mv.visitLabel( emtr.entryLab.asmLb );
+    
+    mv.visitVarInsn( ASM.Opcodes.ALOAD, 0 );
+    emtr.mthFrame.DeltaEvalDepth( 1 );
+    mv.visitMethodInsn( 
+        ASM.Opcodes.INVOKESPECIAL, jloStr, "<init>", "()V", FALSE );
+    emtr.mthFrame.DeltaEvalDepth( -1 );
+    emtr.VoidTail();
+(* FIXME: need to emit LocalVariableTable *)
+  END ModNoArgInit;
+
+ (* --------------------------------------------------------- *)
+ (*             Noarg Constructor for record class            *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)RecMakeInit*(rec : Ty.Record;
+                                            prc : Id.PrcId);
+    VAR mv : ASM.MethodVisitor;
+        sg  : Lv.CharOpen;
+        pTp : Ty.Procedure;
+  BEGIN
+    IF (prc = NIL) &
+       ((Sym.noNew IN rec.xAttr) OR (Sym.xCtor IN rec.xAttr)) THEN
+      RETURN;
+    END;
+   (*
+    *  Get the procedure type, if any.
+    *)
+    IF prc # NIL THEN
+      pTp := prc.type(Ty.Procedure);
+      Ju.MkCallAttr(prc, pTp);
+      sg := pTp.xName;
+    ELSE
+      pTp := NIL;
+      sg := BOX("()V");
+    END;
+   (* 
+    * Create a new method visitor and save in emitter
+    *)
+    mv := emtr.clsWrtr.visitMethod(
+        ASM.Opcodes.ACC_PUBLIC, "<init>", MKSTR(sg^), NIL, jlsEmptyArr );
+    emtr.thisMv := mv;
+    emtr.procNam := BOX("<init>");
+    emtr.mthFrame := Frm.SigFrame( sg, emtr.procNam, NIL );
+    emtr.SetProcData( );
+    mv.visitCode();
+
+    emtr.AloadLocal( 0, rec );
+  END RecMakeInit;
+
+ (* --------------------------------------------------------- *)
+
+  PROCEDURE (emtr : AsmEmitter)CallSuperCtor*(rec : Ty.Record;
+                                          pTy : Ty.Procedure);
+    VAR idx : INTEGER;
+        fld : Sym.Idnt;
+        baseStr, sg : RTS.NativeString;
+        mv : ASM.MethodVisitor;
+  BEGIN
+    emtr.CheckFrame();
+    IF pTy # NIL THEN
+      sg := MKSTR(pTy.xName^);
+    ELSE
+      sg := noArgVoid;
+    END;
+   (* 
+    *  Initialize the embedded superclass object
+    *  The receiver object is already pushed on the stack
+    *  QUESTION: what happens if the ctor needs args?
+    *)
+    IF (rec.baseTp # NIL) & (rec.baseTp # Blt.anyRec) THEN
+      baseStr := MKSTR(rec.baseTp(Ty.Record).xName^);
+    ELSE
+      baseStr := jloStr;
+    END;
+    mv := emtr.thisMv;
+    mv.visitMethodInsn(
+        ASM.Opcodes.INVOKESPECIAL, baseStr, initStr, sg, FALSE );
+    emtr.mthFrame.DeltaEvalDepth( -1 );
+   (* 
+    *  Initialize fields as necessary
+    *)
+    FOR idx := 0 TO rec.fields.tide - 1 DO
+      fld := rec.fields.a[idx];
+      IF (fld.type IS Ty.Record) OR 
+         ((fld.type IS Ty.Array) & ~(fld.type IS Ty.Vector)) THEN
+        emtr.AloadLocal( 0, rec ); (* ?? *)
+        emtr.VarInit(fld);
+        emtr.PutGetF( ASM.Opcodes.PUTFIELD, rec, fld(Id.FldId) );
+      END;
+    END;
+  END CallSuperCtor;
+
+ (* --------------------------------------------------------- *)
+ (*  Emit the header for the record (shallow) __copy__ method *)
+ (*  this method makes a *value* copy of the bound record.    *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)CopyProcHead*(rec : Ty.Record);
+    VAR mv : ASM.MethodVisitor;
+        sg : Lv.CharOpen;
+   (* --------------- *)
+    PROCEDURE mkMthId(rec : Ty.Record) : Id.Procs;
+      VAR rslt : Id.MthId;
+          parN : Id.ParId;
+    BEGIN
+      NEW(rslt);
+      rslt.setPrcKind(Id.conMth);
+     (* Receiver (dst) *)
+      parN := Id.newParId()(Id.ParId); 
+      parN.isRcv := TRUE;
+      parN.parMod := Sym.var;
+      parN.type := rec;
+      Sym.AppendIdnt(rslt.locals, parN);
+     (* Source val record *)
+      parN := Id.newParId()(Id.ParId); 
+      parN.parMod := Sym.in;
+      parN.type := rec;
+      Sym.AppendIdnt(rslt.locals, parN);
+      RETURN rslt;
+    END mkMthId;
+   (* --------------- *)
+  BEGIN
+    emtr.thisMth := mkMthId(rec);
+    sg := clsToVoidDesc(rec);
+
+    mv := emtr.clsWrtr.visitMethod( 
+            pubAcc, copyStr, MKSTR(sg^), NIL, jlsEmptyArr );
+    emtr.thisMv := mv;
+    emtr.procNam := BOX(copyStr); (* Coerce JLS to CharOpen *)
+    
+    emtr.mthFrame := Frm.SigFrame( sg, emtr.procNam, rec.xName );
+    emtr.SetProcData( );
+    mv.visitCode();
+    emtr.entryLab := MkNewAsmLabel();
+    mv.visitLabel( emtr.entryLab.asmLb );
+  END CopyProcHead;
+
+ (* --------------------------------------------------------- *)
+ (*       Emit a call to the bound type __copy__ method       *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)ValRecCopy*(typ : Ty.Record);
+  BEGIN
+   (*
+    *  Stack at entry is (top) srcRef, dstRef, ...
+    *)
+    emtr.CheckFrame();
+    emtr.thisMv.visitMethodInsn( ASM.Opcodes.INVOKEVIRTUAL,
+        MKSTR(typ.xName^), copyStr, MKSTR(clsToVoidDesc(typ)^), FALSE );
+    emtr.mthFrame.DeltaEvalDepth( -2 );
+  END ValRecCopy;
+
+ (* --------------------------------------------------------- *)
+ (* --------------------------------------------------------- *)
+
+  PROCEDURE (emtr : AsmEmitter)Try*();
+  BEGIN
+    emtr.rescueLab := MkNewAsmLabel();
+    INCL( emtr.rescueLab.attr, Ju.forceEmit );
+    emtr.thisMv.visitTryCatchBlock( 
+        emtr.entryLab.asmLb, 
+        emtr.rescueLab.asmLb, 
+        emtr.rescueLab.asmLb, jleStr );
+  END Try;
+
+ (* --------------------------------------------------------- *)
+ (*    At the catch block label stack depth is exactly one,   *)
+ (*    and variable state exactly as at entry to Try block.   *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)Catch*(prc : Id.Procs);
+    VAR ix : INTEGER;
+  BEGIN
+    emtr.mthFrame.ValidateEvalStack();
+    emtr.mthFrame.setDepth( 1 );
+    emtr.mthFrame.InvalidateLocals();
+    emtr.mthFrame.SetTosType( CSt.ntvExc );
+    emtr.DefLabC( emtr.rescueLab, "Catch Block Entry" );
+   (*
+    *  Remark:  at this label, stack depth is just one!
+    *           After this store the stack is empty.
+    *)
+    emtr.StoreLocal( prc.except.varOrd, NIL ); (* NIL ==> use astore *)
+  END Catch;
+
+ (* --------------------------------------------------------- *)
+
+  PROCEDURE (emtr : AsmEmitter)MkNewException*();
+  BEGIN
+    emtr.CheckFrame();
+    emtr.thisMv.visitTypeInsn( Jvm.opc_new, jleStr );
+    emtr.mthFrame.FixEvalStack( Jvm.opc_new, CSt.ntvExc );
+  END MkNewException;
+
+ (* --------------------------------------------------------- *)
+
+  PROCEDURE (emtr : AsmEmitter)InitException*();
+  BEGIN
+    emtr.CheckFrame();
+    emtr.thisMv.visitMethodInsn( 
+        ASM.Opcodes.INVOKESPECIAL, jleStr, initStr, strToVoid, FALSE );
+    emtr.mthFrame.DeltaEvalDepth( -2 );
+  END InitException;
+
+ (* --------------------------------------------------------- *)
+
+  PROCEDURE (emtr : AsmEmitter)Dump*();
+    VAR rslt : POINTER TO ARRAY OF BYTE;
+        indx : INTEGER;
+  BEGIN
+    emtr.clsWrtr.visitEnd();
+    rslt := emtr.clsWrtr.toByteArray();
+    FOR indx := 0 TO LEN(rslt) - 1 DO
+      GPB.WriteByte( emtr.file, rslt[indx] );
+    END;
+    GPB.CloseFile( emtr.file );
+  END Dump;
+
+ (* --------------------------------------------------------- *
+  * 
+  *  PutField and GetField for class *static* fields 
+  *  JVM static fields occur in two contexts in GPCP --
+  *  * Global variables of module SomeMod are static fields 
+  *    of the class CP/SomeMod/SomeMod.class
+  *  * Static fields of some JVM class defined in some other
+  *    language are accessed using the same instructions
+  *
+  * --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)PutGetS*(code : INTEGER; 
+                                    blk  : Id.BlkId; (* not used anymore *)
+                                    fld  : Id.VarId);
+  BEGIN
+    emtr.CheckFrame();
+    emtr.thisMv.visitFieldInsn( 
+        code, Hlp.idCls(fld), Hlp.idNam(fld), Hlp.idSig(fld) );
+    emtr.mthFrame.PutGetFix( code, fld.type );
+  END PutGetS;
+
+ (* --------------------------------------------------------- *
+  * 
+  *  PutField and GetField for class *instance* fields 
+  *
+  * --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)PutGetF*(code : INTEGER; 
+                                    rec  : Ty.Record; (* not used anymore *)
+                                    fld  : Id.AbVar);
+  BEGIN
+    emtr.CheckFrame();
+    emtr.thisMv.visitFieldInsn( 
+        code, Hlp.idCls(fld), Hlp.idNam(fld), Hlp.idSig(fld) );
+    emtr.mthFrame.PutGetFix( code, fld.type );
+  END PutGetF;
+
+ (* --------------------------------------------------------- *)
+ (*   Allocate a one-dimensional array of given element type  *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)Alloc1d*(elTp : Sym.Type);
+    VAR tName : RTS.NativeString;
+  BEGIN
+    emtr.CheckFrame();
+    WITH elTp : Ty.Base DO
+      IF (elTp.tpOrd < Ty.anyRec) OR (elTp.tpOrd = Ty.uBytN) THEN
+        emtr.thisMv.visitIntInsn(Jvm.opc_newarray, typeArr[elTp.tpOrd]);
+        emtr.mthFrame.FixEvalStack( Jvm.opc_newarray, typeArrArr[elTp.tpOrd] );
+      ELSE
+        emtr.thisMv.visitTypeInsn( Jvm.opc_anewarray, jloStr );
+        emtr.mthFrame.FixEvalStack( Jvm.opc_anewarray, CSt.ntvStrArr );
+      END;
+    ELSE
+      emtr.thisMv.visitTypeInsn( Jvm.opc_anewarray, Hlp.tyNam( elTp ) );
+      emtr.mthFrame.FixEvalSig( Jvm.opc_newarray, Hlp.tyArrSig( elTp ) );
+    END;
+  END Alloc1d;
+
+
+ (* --------------------------------------------------------- *)
+ (*  Initialize a declared variable -                         *)
+ (*  Because the JVM type system does not have value          *)
+ (*  aggregates ALL aggregate type have to be allocated on    *)
+ (*  heap at the point of declaration. This method does this. *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)VarInit*(var : Sym.Idnt);
+    VAR typ : Sym.Type;
+  BEGIN
+   (*
+    *  Precondition: var is of a type that needs initialization
+    *)
+    typ := var.type;
+    WITH typ : Ty.Record DO
+        emtr.MkNewRecord(typ);
+    | typ : Ty.Array DO
+        emtr.MkNewFixedArray(typ.elemTp, typ.length);
+    ELSE
+      emtr.Code(Jvm.opc_aconst_null);
+    END;
+   (* --------------- *)
+  END VarInit;
+
+ (* --------------------------------------------------------- *)
+
+  PROCEDURE (emtr : AsmEmitter)Trap*(IN str : ARRAY OF CHAR);
+    VAR mv : ASM.MethodVisitor;
+  BEGIN
+    emtr.CheckFrame();
+    mv := emtr.thisMv;
+    mv.visitTypeInsn( ASM.Opcodes.`NEW, jleStr );
+    mv.visitInsn( ASM.Opcodes.DUP );
+    mv.visitLdcInsn( MKSTR(str) );
+    emtr.mthFrame.DeltaEvalDepth( 3 );
+    mv.visitMethodInsn(
+        ASM.Opcodes.INVOKESPECIAL, jleStr, initStr, strToVoid, FALSE );
+    emtr.mthFrame.DeltaEvalDepth( -2 );
+    mv.visitInsn( ASM.Opcodes.ATHROW );
+    emtr.mthFrame.InvalidateEvalStack();
+   (* no net stack change *)
+  END Trap;
+
+ (* --------------------------------------------------------- *)
+
+  PROCEDURE (emtr : AsmEmitter)CaseTrap*(i : INTEGER);
+    VAR mv : ASM.MethodVisitor;
+  BEGIN
+    emtr.CheckFrame();
+    mv := emtr.thisMv;
+    mv.visitTypeInsn( ASM.Opcodes.`NEW, jleStr );
+    mv.visitInsn( ASM.Opcodes.DUP );
+    emtr.LoadLocal( i, Blt.intTp );
+    emtr.mthFrame.DeltaEvalDepth( 3 );
+    mv.visitMethodInsn(
+        ASM.Opcodes.INVOKESTATIC, rtsStr, caseTrap, caseTrapSig, FALSE );
+    mv.visitMethodInsn(
+        ASM.Opcodes.INVOKESPECIAL, jleStr, initStr, strToVoid, FALSE );
+    emtr.mthFrame.DeltaEvalDepth( -2 );
+    mv.visitInsn( ASM.Opcodes.ATHROW );
+    emtr.mthFrame.InvalidateEvalStack();
+   (* no net stack change *)
+  END CaseTrap;
+
+ (* --------------------------------------------------------- *)
+
+  PROCEDURE (emtr : AsmEmitter)WithTrap*(id : Sym.Idnt);
+    VAR mv : ASM.MethodVisitor;
+  BEGIN
+    emtr.CheckFrame();
+    mv := emtr.thisMv;
+    mv.visitTypeInsn( ASM.Opcodes.`NEW, jleStr ); (* +1 *)
+    mv.visitInsn( ASM.Opcodes.DUP );              (* +2 *)
+    emtr.GetVar( id );                            (* +3 *)
+    emtr.mthFrame.DeltaEvalDepth( 3 );
+    mv.visitMethodInsn(
+        ASM.Opcodes.INVOKESTATIC, rtsStr, withTrap, withTrapSig, FALSE );
+    mv.visitMethodInsn(
+        ASM.Opcodes.INVOKESPECIAL, jleStr, initStr, strToVoid, FALSE );
+    emtr.mthFrame.DeltaEvalDepth( -2 );
+    mv.visitInsn( ASM.Opcodes.ATHROW );
+    emtr.mthFrame.InvalidateEvalStack();
+   (* no net stack change *)
+  END WithTrap;
+
+ (* --------------------------------------------------------- *)
+ (*     We presume that there is not need otherwise for       *)
+ (*     a label at this location.  So we generate a dummy.    *)
+ (* --------------------------------------------------------- *)
+  PROCEDURE (emtr : AsmEmitter)Line*(lnNm : INTEGER);
+    VAR dummy : ASM.Label;
+        mv : ASM.MethodVisitor;
+  BEGIN
+    NEW( dummy );
+    mv := emtr.thisMv;
+    mv.visitLabel( dummy );
+    mv.visitLineNumber( lnNm, dummy );
+  END Line;
+
+(* ============================================================ *)
+(* ============================================================ *)
+(*                        Static Methods                        *)
+(* ============================================================ *)
+(* ============================================================ *)
+
+ (* ------------------------------------------------- *)
+ (* ------------------------------------------------- *)
+  PROCEDURE MkNewAsmLabel( ) : AsmLabel;
+    VAR rslt : AsmLabel;
+  BEGIN
+    NEW( rslt );
+    NEW( rslt.asmLb );
+    rslt.defIx := 0;
+    rslt.attr := { Ju.unfixed }; (* Alwasy born unfixed *)
+    rslt.evalSave := NIL;
+    rslt.FixTag();  (* assigns a dummy name to this label *)
+    RETURN rslt;
+  END MkNewAsmLabel;
+
+ (* ------------------------------------------------- *)
+
+  PROCEDURE InterfaceNameList( rec : Ty.Record ) : Def.JlsArr;
+    VAR result  : Def.JlsArr;
+        element : Lv.CharOpen;
+        ix,len  : INTEGER;
+  BEGIN
+    len := rec.interfaces.tide;
+    IF len > 0 THEN
+      NEW(result, len);
+      FOR ix := 0 TO len - 1 DO
+        element := rec.interfaces.a[ix].boundRecTp()(Ty.Record).xName;
+        result[ix] := MKSTR(element^);
+      END;
+    ELSE
+      result := jlsEmptyArr;
+    END;
+    RETURN result;
+  END InterfaceNameList;
+
+ (* ------------------------------------------------- *)
+
+  PROCEDURE clsToVoidDesc(rec : Ty.Record) : Lv.CharOpen;
+  BEGIN
+    Hlp.EnsureRecName( rec );
+    RETURN Ju.cat3(Ju.lPar,rec.scopeNm,Ju.rParV); 
+  END clsToVoidDesc;
+  
+(* ============================================================ *)
+BEGIN  (* Module Body *)
+  tagCount := 0;
+ (* -------------------------------------------- *)
+  jloStr        := MKSTR( "java/lang/Object"    );
+  jlsStr        := MKSTR( "java/lang/String"    );
+  initStr       := MKSTR( "<init>"              );
+  clinitStr     := MKSTR( "<clinit>"            );
+  copyStr       := MKSTR( "__copy__"            );
+  jleStr        := MKSTR( "java/lang/Exception" );
+  jlmStr        := MKSTR( "java/lang/Math"      );
+  jlcStr        := MKSTR( "java/lang/Class"     );
+  jlchStr       := MKSTR( "java/lang/Character" );
+  jlsyStr       := MKSTR( "java/lang/System"    );
+
+  cpMain        := MKSTR( "CP/CPmain/CPmain"    );
+  rtsStr        := MKSTR( "CP/CPJrts/CPJrts"    );
+
+  noArgVoid     := MKSTR( "()V"                    );
+  strToVoid     := MKSTR( "(Ljava/lang/String;)V"  );
+  mainSig       := MKSTR( "([Ljava/lang/String;)V" );
+  
+ (* --------------------------------------------- *)
+  withTrap      := MKSTR( "WithMesg"               ); 
+  withTrapSig   := 
+     MKSTR("(Ljava/lang/Object;)Ljava/lang/String;");
+  caseTrap      := MKSTR( "CaseMesg"               ); 
+  caseTrapSig   := 
+     MKSTR("(I)Ljava/lang/String;");
+ (* --------------------------------------------- *)
+
+  pubAcc        := ASM.Opcodes.ACC_PUBLIC;
+  prvAcc        := ASM.Opcodes.ACC_PRIVATE;
+  finAcc        := ASM.Opcodes.ACC_FINAL;
+  supAcc        := ASM.Opcodes.ACC_SUPER;
+  staAcc        := ASM.Opcodes.ACC_STATIC;
+  absAcc        := ASM.Opcodes.ACC_ABSTRACT;
+  protec        := ASM.Opcodes.ACC_PROTECTED;
+  pckAcc        := 0;
+
+  pubSta        := pubAcc + staAcc;
+  modAcc        := pubAcc + finAcc + supAcc;
+
+  fileSep := Lv.charToCharOpen(GPF.fileSep);
+
+  procNames[Ju.StrCmp]  := Lv.strToCharOpen("strCmp");
+  procNames[Ju.StrToChrOpen] := Lv.strToCharOpen("JavaStrToChrOpen");
+  procNames[Ju.StrToChrs] := Lv.strToCharOpen("JavaStrToFixChr");
+  procNames[Ju.ChrsToStr] := Lv.strToCharOpen("FixChToJavaStr");
+  procNames[Ju.StrCheck] := Lv.strToCharOpen("ChrArrCheck");
+  procNames[Ju.StrLen] := Lv.strToCharOpen("ChrArrLength");
+  procNames[Ju.ToUpper] := Lv.strToCharOpen("toUpperCase");
+  procNames[Ju.DFloor] := Lv.strToCharOpen("floor");
+  procNames[Ju.ModI] := Lv.strToCharOpen("CpModI");
+  procNames[Ju.ModL] := Lv.strToCharOpen("CpModL");
+  procNames[Ju.DivI] := Lv.strToCharOpen("CpDivI");
+  procNames[Ju.DivL] := Lv.strToCharOpen("CpDivL");
+  procNames[Ju.StrCatAA] := Lv.strToCharOpen("ArrArrToString");
+  procNames[Ju.StrCatSA] := Lv.strToCharOpen("StrArrToString");
+  procNames[Ju.StrCatAS] := Lv.strToCharOpen("ArrStrToString");
+  procNames[Ju.StrCatSS] := Lv.strToCharOpen("StrStrToString");
+  procNames[Ju.StrLP1] := Lv.strToCharOpen("ChrArrLplus1");
+  procNames[Ju.StrVal] := Lv.strToCharOpen("ChrArrStrCopy");
+  procNames[Ju.SysExit] := Lv.strToCharOpen("exit");
+  procNames[Ju.LoadTp1] := Lv.strToCharOpen("getClassByOrd");
+  procNames[Ju.LoadTp2] := Lv.strToCharOpen("getClassByName");
+
+  getClass := Lv.strToCharOpen("getClass");
+  IIretI   := Lv.strToCharOpen("(II)I");
+  JJretJ   := Lv.strToCharOpen("(JJ)J");
+
+  procSigs[Ju.StrCmp]   := Lv.strToCharOpen("([C[C)I");
+  procSigs[Ju.StrToChrOpen] := Lv.strToCharOpen("(Ljava/lang/String;)[C");
+  procSigs[Ju.StrToChrs] := Lv.strToCharOpen("([CLjava/lang/String;)V");
+  procSigs[Ju.ChrsToStr] := Lv.strToCharOpen("([C)Ljava/lang/String;");
+  procSigs[Ju.StrCheck] := Lv.strToCharOpen("([C)V");
+  procSigs[Ju.StrLen] := Lv.strToCharOpen("([C)I");
+  procSigs[Ju.ToUpper] := Lv.strToCharOpen("(C)C");
+  procSigs[Ju.DFloor] := Lv.strToCharOpen("(D)D");
+  procSigs[Ju.ModI] := IIretI;
+  procSigs[Ju.ModL] := JJretJ;
+  procSigs[Ju.DivI] := IIretI;
+  procSigs[Ju.DivL] := JJretJ;
+  procSigs[Ju.StrCatAA] := Lv.strToCharOpen("([C[C)Ljava/lang/String;");
+  procSigs[Ju.StrCatSA] := Lv.strToCharOpen(
+                                "(Ljava/lang/String;[C)Ljava/lang/String;");
+  procSigs[Ju.StrCatAS] := Lv.strToCharOpen(
+                                "([CLjava/lang/String;)Ljava/lang/String;");
+  procSigs[Ju.StrCatSS] := Lv.strToCharOpen(
+                   "(Ljava/lang/String;Ljava/lang/String;)Ljava/lang/String;");
+  procSigs[Ju.StrLP1] := procSigs[Ju.StrLen];
+  procSigs[Ju.StrVal] := Lv.strToCharOpen("([C[C)V");
+  procSigs[Ju.SysExit] := Lv.strToCharOpen("(I)V");
+  procSigs[Ju.LoadTp1] := Lv.strToCharOpen("(I)Ljava/lang/Class;");
+  procSigs[Ju.LoadTp2] := Lv.strToCharOpen(
+                               "(Ljava/lang/String;)Ljava/lang/Class;");
+
+  procRetS[Ju.StrVal] := NIL;
+  procRetS[Ju.SysExit] := NIL;
+  procRetS[Ju.StrToChrs] := NIL;
+  procRetS[Ju.StrCheck] := NIL;
+
+  procRetS[Ju.StrCmp] := Lv.strToCharOpen("I");
+  procRetS[Ju.ModI]   := procRetS[Ju.StrCmp];
+  procRetS[Ju.DivI]   := procRetS[Ju.StrCmp];
+  procRetS[Ju.StrLen] := procRetS[Ju.StrCmp];
+  procRetS[Ju.StrLP1] := procRetS[Ju.StrCmp];
+
+  procRetS[Ju.DivL] := Lv.strToCharOpen( "J" );
+  procRetS[Ju.ModL] := procRetS[Ju.DivL];
+
+  procRetS[Ju.LoadTp1] := Lv.strToCharOpen( "Ljava/lang/Class;");
+  procRetS[Ju.LoadTp2] := procRetS[Ju.LoadTp1];
+
+  procRetS[Ju.ChrsToStr] := Lv.strToCharOpen("Ljava/lang/String;");
+  procRetS[Ju.StrCatAA]  := procRetS[Ju.ChrsToStr];
+  procRetS[Ju.StrCatSA]  := procRetS[Ju.ChrsToStr];
+  procRetS[Ju.StrCatAS]  := procRetS[Ju.ChrsToStr];
+  procRetS[Ju.StrCatSS]  := procRetS[Ju.ChrsToStr];
+
+  procRetS[Ju.StrToChrOpen] := Lv.strToCharOpen("[C");
+  procRetS[Ju.ToUpper] := Lv.strToCharOpen("C");
+  procRetS[Ju.DFloor] := Lv.strToCharOpen("D");
+
+ (* Mapping of base types *)
+  typeArr[ Ty.boolN] := ASM.Opcodes.T_BOOLEAN;
+  typeArr[ Ty.sChrN] := ASM.Opcodes.T_SHORT;
+  typeArr[ Ty.charN] := ASM.Opcodes.T_CHAR;
+  typeArr[ Ty.byteN] := ASM.Opcodes.T_BYTE;
+  typeArr[ Ty.uBytN] := ASM.Opcodes.T_BYTE;
+  typeArr[ Ty.sIntN] := ASM.Opcodes.T_SHORT;
+  typeArr[  Ty.intN] := ASM.Opcodes.T_INT;
+  typeArr[ Ty.lIntN] := ASM.Opcodes.T_LONG;
+  typeArr[ Ty.sReaN] := ASM.Opcodes.T_FLOAT;
+  typeArr[ Ty.realN] := ASM.Opcodes.T_DOUBLE;
+  typeArr[  Ty.setN] := ASM.Opcodes.T_INT;
+
+ (* Arrays of base types *)
+  typeArrArr[ Ty.boolN] := Ty.mkArrayOf( Blt.boolTp );
+  typeArrArr[ Ty.charN] := Ty.mkArrayOf( Blt.charTp );
+  typeArrArr[ Ty.sChrN] := typeArrArr[ Ty.charN ];
+  typeArrArr[ Ty.byteN] := Ty.mkArrayOf( Blt.byteTp );
+  typeArrArr[ Ty.uBytN] := typeArrArr[ Ty.byteN ];
+  typeArrArr[ Ty.sIntN] := Ty.mkArrayOf( Blt.sIntTp );
+  typeArrArr[  Ty.intN] := Ty.mkArrayOf( Blt.intTp  );
+  typeArrArr[ Ty.lIntN] := Ty.mkArrayOf( Blt.lIntTp );
+  typeArrArr[ Ty.sReaN] := Ty.mkArrayOf( Blt.sReaTp );
+  typeArrArr[ Ty.realN] := Ty.mkArrayOf( Blt.realTp );
+  typeArrArr[  Ty.setN] := typeArrArr[ Ty.intN ];
+
+END AsmUtil.
+(* ============================================================ *)
+

gpcp/CPascal.cp

@@ -27,7 +27,6 @@ MODULE CPascal;
         Scnr := CPascalS,
         CPascalErrors,
         New := NewSymFileRW,
-        Old := OldSymFileRW,
         NameHash,
         Visitor,
         Builtin,
@@ -152,11 +151,7 @@ MODULE CPascal;
             IF Scnr.errors = 0 THEN
               IF CSt.doSym THEN
                 CondMsg("Emitting symbol file");
-                IF CSt.legacy THEN
-                  Old.EmitSymfile(CSt.thisMod);
-                ELSE
-                  New.EmitSymfile(CSt.thisMod);
-                END;
+                New.EmitSymfile(CSt.thisMod);
                 CSt.symEnd := RTS.GetMillis();
                 IF CSt.doAsm THEN
                   IF CSt.isForeign() THEN
@@ -178,6 +173,8 @@ MODULE CPascal;
         Finalize;
         IF CSt.doStats THEN CSt.Report END;
       END;
+(* ===================================================== *)
+(* Comment out the Rescue clause to get a stack unwind.
     RESCUE (sysX)
       retVal := 2;
       CSt.Message("<< COMPILER PANIC >>");
@@ -194,6 +191,8 @@ MODULE CPascal;
         FixListing;
       END;
       Finalize;
+ *)
+(* ===================================================== *)
     END Compile;
 
 (* ==================================================================== *)

gpcp/CPascalErrors.cp

@@ -47,6 +47,7 @@ MODULE CPascalErrors;
       eTide    : INTEGER;	(* Next index for insertion in buf *)
       prompt*  : BOOLEAN;	(* Emit error message immediately  *)
       nowarn*  : BOOLEAN;	(* Don't store warning messages    *)
+	  no239Err*: BOOLEAN;   (* Don't emit 239 while TRUE       *)
       srcNam   : FileNames.NameString;
       forVisualStudio* : BOOLEAN;
       xmlErrors* : BOOLEAN;
@@ -1001,6 +1002,7 @@ BEGIN
   NEW(eBuffer, 8); eBuffer[0] := NIL; eLimit := 7; eTide := 0;
   prompt := FALSE;
   nowarn := FALSE;
+  no239Err := FALSE;
   forVisualStudio := FALSE;
 END CPascalErrors.
 (* ============================================================ *)

gpcp/CPascalP.cp

@@ -27,7 +27,6 @@ MODULE CPascalP;
         Bi := Builtin,
         StatDesc,
         Visitor,
-        OldSymFileRW,
         NewSymFileRW,
         NameHash;
 
@@ -307,6 +306,7 @@ VAR
     IF (nextT.sym = T.colonequalSym) THEN
       alias := Id.newAlias();
       alias.hash  := NameHash.enterSubStr(token.pos, token.len);
+      IF Cs.verbose THEN alias.SetNameFromHash(alias.hash) END;
       IF Sy.refused(alias, modScope) THEN SemError(4) END;
       Get; (* Read past colonequals symbol *)
      (*
@@ -326,10 +326,9 @@ VAR
       ELSE
         Expect(T.identSym);
         alias.token := token;  (* fake the name for err-msg use *)
-		ident.aliasMod := alias;
-		IF Cs.verbose THEN alias.SetNameFromHash(alias.hash) END;
         idHsh := NameHash.enterSubStr(token.pos, token.len);
       END;
+      ident.aliasMod := alias;
     ELSE
       idHsh := NameHash.enterSubStr(token.pos, token.len);
     END;
@@ -337,7 +336,8 @@ VAR
     ident.dfScp := ident;
     ident.hash  := idHsh;
 
-	IF Cs.verbose THEN ident.SetNameFromHash(idHsh) END;
+(* FIXME *)
+    IF Cs.verbose THEN ident.SetNameFromHash(idHsh) ELSE ident.ClearName() END;
 
     IF ident.hash = Bi.sysBkt THEN
       dummy := Cs.thisMod.symTb.enter(Bi.sysBkt, Cs.sysMod);
@@ -360,7 +360,7 @@ VAR
       *  there are already references to it in the structure.
       *)
       clash.token := ident.token;   (* to help error reports  *)
-	  IF Cs.verbose THEN clash.SetNameFromHash(clash.hash) END;
+      IF Cs.verbose THEN clash.SetNameFromHash(clash.hash) END;
       ident := clash(Id.BlkId);
 	 (*
 	  *  If this is the explicit import of a module that
@@ -406,7 +406,9 @@ VAR
       *  List the file, for importation later  ...
       *)
       Sy.AppendScope(impSeq, ident);
-      IF alias # NIL THEN INCL(ident.xAttr, Sy.anon) END;	        
+      IF alias # NIL THEN 
+	    INCL(ident.xAttr, Sy.anon);
+	  END;	        
       EXCL(ident.xAttr, Sy.weak); (* ==> directly imported *)
       INCL(ident.xAttr, Sy.need); (* ==> needed in symfile *)
 	END;
@@ -463,11 +465,7 @@ VAR
     END;
     
     Cs.import1 := RTS.GetMillis();
-IF Cs.legacy THEN
-    OldSymFileRW.WalkImports(Cs.impSeq, modScope);
-ELSE
     NewSymFileRW.WalkImports(Cs.impSeq, modScope);
-END;
     Cs.import2 := RTS.GetMillis();
   END ImportList;
 
@@ -2604,6 +2602,7 @@ END;
         fDsc := list.a[fIdx](Id.FldId);
         fDsc.type := fTyp;
         fDsc.recTyp := recT;
+        fDsc.fldNm := Sy.getName.ChPtr(fDsc); (* retro fitted *)
         Sy.AppendIdnt(recT.fields, fDsc);
       END;
     END;
@@ -3250,7 +3249,7 @@ END;
       RETURN idnt;
     ELSE
       modS := idnt(Id.BlkId);
-	  IF Sy.anon IN modS.xAttr THEN 
+	  IF (Sy.anon IN modS.xAttr) & ~Cs.Suppress239() THEN 
 	    SemErrorS1(239, Sy.getName.ChPtr(modS.aliasMod));
 	  END;
     END;
@@ -3309,7 +3308,7 @@ END;
       RETURN idnt(Id.TypId);
     ELSIF (idnt.kind = Id.impId) OR (idnt.kind = Id.alias) THEN
       modS := idnt(Id.BlkId);
-	  IF Sy.anon IN modS.xAttr THEN 
+	  IF (Sy.anon IN modS.xAttr) & ~Cs.Suppress239() THEN 
 	    SemErrorS1(239, Sy.getName.ChPtr(modS.aliasMod));
 	  END;
     ELSE
@@ -3367,7 +3366,7 @@ END;
     IF iSyn IS Sy.Scope THEN iSyn(Sy.Scope).ovfChk := Cs.ovfCheck END;
     iSyn.token := nextT;
     iSyn.hash  := NameHash.enterSubStr(nextT.pos, nextT.len);
-    IF Cs.verbose THEN iSyn.SetNameFromHash(iSyn.hash) END;
+    IF Cs.verbose OR Cs.doAsm5 THEN iSyn.SetNameFromHash(iSyn.hash) END;
     iSyn.dfScp := inhScp;
     IF nextT.dlr & ~Cs.special THEN SemErrorT(186, nextT) END;
     Expect(T.identSym);

gpcp/CPascalS.cp

@@ -100,12 +100,12 @@ VAR
 (* ======================== EXPORTS ========================= *)
 PROCEDURE (s : ErrorHandler)Report*(num : INTEGER; 
 				    lin : INTEGER;
-			            col : INTEGER) ,NEW,ABSTRACT;
+                    col : INTEGER) ,NEW,ABSTRACT;
 
 PROCEDURE (s : ErrorHandler)RepSt1*(num : INTEGER; 
 				 IN str : ARRAY OF CHAR;
 				    lin : INTEGER;
-			            col : INTEGER) ,NEW,ABSTRACT;
+                    col : INTEGER) ,NEW,ABSTRACT;
 
 PROCEDURE (s : ErrorHandler)RepSt2*(num : INTEGER; 
 				 IN st1 : ARRAY OF CHAR;

gpcp/ClassMaker.cp

@@ -27,9 +27,16 @@ MODULE ClassMaker;
 
 (* ============================================================ *)
 
+ (* Emitter initialization *)
   PROCEDURE (maker : ClassEmitter)Init*(),NEW,EMPTY;
+
+ (* Define features of the type system base type *)
   PROCEDURE (maker : ClassEmitter)ObjectFeatures*(),NEW,EMPTY;
+
+ (* Emit the code for the Module *)
   PROCEDURE (maker : ClassEmitter)Emit*(),NEW,ABSTRACT;
+
+ (* Call the assembler, if necessary *)
   PROCEDURE (asmbl : Assembler)Assemble*(),NEW,EMPTY;
 
 (* ============================================================ *)

gpcp/ClassUtil.cp

@@ -623,6 +623,10 @@ MODULE ClassUtil;
     fil.exceptAttIx := 0;
     fil.lineNumTabIx := 0;
     fil.jlExceptIx := 0;
+    CSt.emitNam := BOX("ClassUtil");
+    IF CSt.doVersion THEN
+      CSt.Message("Using " + CSt.emitNam^ + " emitter" );
+    END;
     RETURN fil;
   END newClassFile;
 
@@ -683,6 +687,54 @@ MODULE ClassUtil;
 (*                   Java Class File Stuff                      *)
 (* ============================================================ *)
 
+  PROCEDURE (jf : ClassFile)LoadLocal*(ord : INTEGER; typ : D.Type);
+    VAR code : INTEGER;
+  BEGIN
+    IF (typ # NIL) & (typ IS Ty.Base) THEN 
+      code := J.typeLoad[typ(Ty.Base).tpOrd];
+    ELSE
+      code := Jvm.opc_aload; 
+    END;
+    IF ord < 4 THEN
+      CASE code OF
+      | Jvm.opc_iload : code := Jvm.opc_iload_0 + ord;
+      | Jvm.opc_lload : code := Jvm.opc_lload_0 + ord;
+      | Jvm.opc_fload : code := Jvm.opc_fload_0 + ord;
+      | Jvm.opc_dload : code := Jvm.opc_dload_0 + ord;
+      | Jvm.opc_aload : code := Jvm.opc_aload_0 + ord;
+      END;
+      jf.Code(code);
+    ELSE
+      jf.CodeI(code, ord);
+    END;
+  END LoadLocal;
+
+(* ---------------------------------------------------- *)
+
+  PROCEDURE (jf : ClassFile)StoreLocal*(ord : INTEGER; typ : D.Type);
+    VAR code : INTEGER;
+  BEGIN
+    IF (typ # NIL) & (typ IS Ty.Base) THEN 
+      code := J.typeStore[typ(Ty.Base).tpOrd];
+    ELSE
+      code := Jvm.opc_astore;
+    END;
+    IF ord < 4 THEN
+      CASE code OF
+      | Jvm.opc_istore : code := Jvm.opc_istore_0 + ord;
+      | Jvm.opc_lstore : code := Jvm.opc_lstore_0 + ord;
+      | Jvm.opc_fstore : code := Jvm.opc_fstore_0 + ord;
+      | Jvm.opc_dstore : code := Jvm.opc_dstore_0 + ord;
+      | Jvm.opc_astore : code := Jvm.opc_astore_0 + ord;
+      END;
+      jf.Code(code);
+    ELSE
+      jf.CodeI(code, ord);
+    END;
+  END StoreLocal;
+
+(* ---------------------------------------------------- *)
+
   PROCEDURE (cf : ClassFile) InitFields*(numFields : INTEGER);
   BEGIN
     NEW(cf.fields,numFields);
@@ -798,7 +850,7 @@ MODULE ClassUtil;
     m.methId := meth;
     IF meth = NIL THEN
       m.localNum := 0;
-      m.maxLocals := 1;
+      m.maxLocals := 2; (* need 2 for __copy__  'this' + 'arg'*)
     ELSE        (* Id.BlkId *)
       m.localNum := meth.rtsFram;
       m.maxLocals := MAX(meth.rtsFram, 1);
@@ -870,7 +922,7 @@ MODULE ClassUtil;
 
 (* ------------------------------------------------------------ *)
 
-  PROCEDURE (cf : ClassFile)newLocal*() : INTEGER;
+  PROCEDURE (cf : ClassFile)newLocal*( t : D.Type ) : INTEGER;
     VAR ord : INTEGER;
   BEGIN
     ord := cf.meth.localNum;
@@ -883,14 +935,30 @@ MODULE ClassUtil;
 
 (* ------------------------------------------------------------ *)
 
-  PROCEDURE (cf : ClassFile)ReleaseLocal*(i : INTEGER);
+  PROCEDURE (cf : ClassFile)newLongLocal*( t : D.Type ) : INTEGER;
+    VAR ord : INTEGER;
   BEGIN
-   (*
-    *  If you try to release not in LIFO order, the 
-    *  location will not be made free again. This is safe!
-    *)
-    IF i+1 = cf.meth.localNum THEN DEC(cf.meth.localNum) END;
-  END ReleaseLocal;
+    ord := cf.meth.localNum;
+    INC(cf.meth.localNum, 2);
+    IF cf.meth.localNum > cf.meth.maxLocals THEN 
+      cf.meth.maxLocals := cf.meth.localNum;
+    END;
+    RETURN ord;
+  END newLongLocal;
+
+(* ------------------------------------------------------------ *)
+
+  PROCEDURE (cf : ClassFile)PopLocal*();
+  BEGIN
+    DEC(cf.meth.localNum);
+  END PopLocal;
+
+(* ------------------------------------------------------------ *)
+
+  PROCEDURE (cf : ClassFile)PopLongLocal*();
+  BEGIN
+    DEC(cf.meth.localNum, 2);
+  END PopLongLocal;
 
 (* ------------------------------------------------------------ *)
 
@@ -1056,7 +1124,8 @@ MODULE ClassUtil;
     *)
     FOR idx := 0 TO rec.fields.tide-1 DO
       fld := rec.fields.a[idx];
-      IF (fld.type IS Ty.Record) OR (fld.type IS Ty.Array) THEN
+      IF (fld.type IS Ty.Record) OR 
+         ((fld.type IS Ty.Array) & ~(fld.type IS Ty.Vector)) THEN
 	cf.Code(Jvm.opc_aload_0);
 	cf.VarInit(fld);
         cf.PutGetF(Jvm.opc_putfield, rec, fld(Id.FldId));
@@ -1101,7 +1170,7 @@ MODULE ClassUtil;
 
 (* ============================================================ *)
 
-  PROCEDURE GetTypeName*(typ : D.Type) : L.CharOpen;
+  PROCEDURE GetTypeName(typ : D.Type) : L.CharOpen;
   VAR
     arrayName : L.CharOpenSeq;
     arrayTy : D.Type;
@@ -1188,14 +1257,15 @@ MODULE ClassUtil;
  
   PROCEDURE (cf : ClassFile)DefLab*(lab : J.Label);
   BEGIN
-    ASSERT(lab.defIx = 0);
-    lab.defIx := cf.meth.codes.codeLen;
+    IF lab.defIx = 0 THEN lab.defIx := cf.meth.codes.codeLen END;
   END DefLab;
 
   PROCEDURE (cf : ClassFile)DefLabC*(lab : J.Label; IN c : ARRAY OF CHAR);
   BEGIN
-    ASSERT(lab.defIx = 0);
-    lab.defIx := cf.meth.codes.codeLen;
+    IF lab.defIx = 0 THEN lab.defIx := cf.meth.codes.codeLen END;
+(*
+CSt.PrintLn( "DefLabC: " + c );
+ *)
   END DefLabC;
 
 (* -------------------------------------------- *)
@@ -1221,6 +1291,7 @@ MODULE ClassUtil;
     op.op := code;
     op.lab := lab;
     INC(cf.meth.codes.codeLen,3);
+    INCL(lab.attr, J.jumpSeen);
     cf.meth.codes.AddInstruction(op);
     cf.meth.FixStack(code);
   END CodeLb;
@@ -1368,8 +1439,10 @@ MODULE ClassUtil;
   END CodeInc;
 
 (* -------------------------------------------- *)
-
-  PROCEDURE (cf : ClassFile)CodeSwitch*(low,high : INTEGER; defLab : J.Label);
+(*          defLab is the default label         *)
+(* -------------------------------------------- *)
+  PROCEDURE (cf : ClassFile)CodeSwitch*(
+                   low,high : INTEGER; defLab : J.Label);
   VAR
     sw : OpSwitch;
     len : INTEGER;

gpcp/CompState.cp

@@ -20,6 +20,7 @@ MODULE CompState;
         IdDesc,
         Console, 
         CPascalS,
+        LitValue,
         NameHash,
         FileNames,
         ClassMaker,
@@ -44,6 +45,7 @@ MODULE CompState;
     ntvEvt* : Symbols.Type;     (* native MulticastDelegate     *)
     rtsXHR* : Symbols.Type;     (* native XHR type descriptor   *)
     ntvVal* : Symbols.Type;     (* native ValueType type        *)
+    ntvStrArr* : Symbols.Type; 
 
     objId*  : Symbols.Idnt;
     strId*  : Symbols.Idnt;
@@ -69,12 +71,15 @@ MODULE CompState;
     lstNam-   : FileNames.NameString;    (* name of the listing file    *)
 
     target-   : ARRAY 6 OF CHAR;
+    asmVer-   : ARRAY 6 OF CHAR; 
     emitter-  : ClassMaker.ClassEmitter;
+    emitNam*  : POINTER TO ARRAY OF CHAR;
 
     cpSymX-,                             (* User supplied CPSYM name    *)
     binDir-,                             (* PE-file directory .NET only *)
     symDir-   : FileNames.NameString;    (* Symbol file directory       *)
-
+    
+    
     strict-,
     special-,
     warning-,
@@ -89,15 +94,17 @@ MODULE CompState;
     doVersion-,
     doneVersion,
     doSym-,
-    doAsm-,
+    doAsm5-,      (* Default for jvm, as of gpcp v1.4.02  *)
+    doDWC-,       (* Legacy class file emitter in v1.3.19 *)
     doJsmn-,
     forceIlasm,
     forcePerwapi,
     doIlasm-,
+    doAsm-,
     doCode-,
     quiet-,
     system-    : BOOLEAN;
-    legacy*    : BOOLEAN;
+
     netRel-,
     listLevel-,
     hashSize-  : INTEGER;
@@ -125,10 +132,25 @@ MODULE CompState;
   VAR
     expectedNet : BOOLEAN;         (* A .NET specific option was parsed  *)
     expectedJvm : BOOLEAN;         (* A JVM specific option was parsed   *)
-    expectedLlvm : BOOLEAN;        (* An LLVM specific option was parsed *)
+
+  VAR
+    indent : INTEGER;
 
 (* ==================================================================== *)
 (*                             Utilities                                *)
+(* ==================================================================== *)
+
+    PROCEDURE IncIndent*(); BEGIN INC(indent) END IncIndent;
+    PROCEDURE DecIndent*(); BEGIN DEC(indent) END DecIndent;
+    PROCEDURE ZeroIndent*(); BEGIN indent := 0   END ZeroIndent;
+
+    PROCEDURE IndentMsg*( IN s : ARRAY OF CHAR );
+      VAR i : INTEGER;
+    BEGIN
+      FOR i := 0 TO indent DO Console.WriteString( "  " ) END;
+      Console.WriteString( s ); Console.WriteLn;
+    END IndentMsg;
+
 (* ==================================================================== *)
 
     PROCEDURE SetSysLib*(lib : IdDesc.BlkId);
@@ -146,14 +168,21 @@ MODULE CompState;
       emitter.ObjectFeatures();
     END ImportObjectFeatures;
 
+	PROCEDURE Suppress239*() : BOOLEAN; 
+	BEGIN 
+	  RETURN CPascalErrors.no239Err;
+	END Suppress239;
+
     PROCEDURE SetQuiet*(); 
     BEGIN
       CPascalErrors.nowarn := TRUE;
+	  CPascalErrors.no239Err := TRUE;
     END SetQuiet;
     
     PROCEDURE RestoreQuiet*();
     BEGIN
       CPascalErrors.nowarn := ~warning;
+	  CPascalErrors.no239Err := FALSE;
     END RestoreQuiet;
 
     PROCEDURE targetIsNET*() : BOOLEAN;
@@ -166,11 +195,6 @@ MODULE CompState;
       RETURN target = "jvm";
     END targetIsJVM;
 
-    PROCEDURE targetIsLLVM*() : BOOLEAN;
-    BEGIN
-      RETURN target = "llvm";
-    END targetIsLLVM;
-
     PROCEDURE Message*(IN mss : ARRAY OF CHAR);
     BEGIN
       Console.WriteString(prefix);
@@ -220,6 +244,7 @@ MODULE CompState;
       PrintLn("gardens point component pascal: " + GPCPcopyright.verStr);
       Message("Usage from the command line ...");
       IF RTS.defaultTarget = "net" THEN
+
 PrintLn("       $ gpcp [cp-options] file {file}");
 PrintLn("# CP Options ...");
 PrintLn("       /bindir=XXX  ==> Place binary files in directory XXX");
@@ -244,7 +269,7 @@ PrintLn("       /quiet       ==> Compile silently if possible");
 PrintLn("       /strict      ==> Disallow non-standard constructs");
 PrintLn("       /special     ==> Compile dummy symbol file");
 PrintLn("       /symdir=XXX  ==> Place symbol files in directory XXX");
-PrintLn("       /target=XXX  ==> Emit (jvm|net|llvm) assembly");
+PrintLn("       /target=XXX  ==> Emit (jvm|net) assembly");
 PrintLn("       /unsafe      ==> Allow unsafe code generation");
 PrintLn("       /vX.X        ==> (v1.0 | v1.1 | v2.0) CLR target version");
 PrintLn("       /verbose     ==> Emit verbose diagnostics");
@@ -253,24 +278,25 @@ PrintLn("       /vserror     ==> Print error messages in Visual Studio format");
 PrintLn("       /warn-       ==> Don't emit warnings");
 PrintLn("       /nowarn      ==> Don't emit warnings");
 PrintLn("       /whidbey     ==> Target code for Whidbey Beta release");
-PrintLn("       /xmlerror    ==> Print error messages in XML format");
+PrintLn("       /xmlerror    ==> Emit error messages in XML format");
 PrintLn(' Unix-style options: "-option" are recognized also');
-      ELSE
-        IF RTS.defaultTarget = "jvm" THEN
+
+      ELSIF RTS.defaultTarget = "jvm" THEN
+
 PrintLn("       $ cprun gpcp [cp-options] file {file}, OR");
 PrintLn("       $ java [java-options] CP.gpcp.gpcp [cp-options] file {file}");
-        ELSIF RTS.defaultTarget = "llvm" THEN
-          PrintLn("       $ gpcp [cp-options] file {file}");
-        END;
 PrintLn("# CP Options ...");
-PrintLn("       -clsdir=XXX  ==> Set class tree root in directory XXX");
+PrintLn("       -asm7        ==> Default: Generate class files with V1_7 format");
+PrintLn("       -asmN        ==> Classfiles use V1_N format, N = (5 .. 8)");
+PrintLn("       -clsdir:XXX  ==> Set class tree root in directory XXX");
 PrintLn("       -copyright   ==> Display copyright notice");
-PrintLn("       -cpsym=XXX   ==> Use environ. variable XXX instead of CPSYM");
+PrintLn("       -cpsym:XXX   ==> Use environ. variable XXX instead of CPSYM");
 PrintLn("       -dostats     ==> Give a statistical summary");
 PrintLn("       -extras      ==> Enable experimental compiler features");
 PrintLn("       -help        ==> Write out this usage message");
-PrintLn("       -hsize=NNN   ==> Set hashtable size >= NNN (0 .. 65000)");
+PrintLn("       -hsize:NNN   ==> Set hashtable size >= NNN (0 .. 65000)");
 PrintLn("       -jasmin      ==> Ceate asm files and run Jasmin");
+PrintLn("       -legacy      ==> Use the pre-v1.4 jvm class writer");
 PrintLn("       -list        ==> (default) Create *.lst file if errors");
 PrintLn("       -list+       ==> Unconditionally create *.lst file");
 PrintLn("       -list-       ==> Don't create error *.lst file");
@@ -280,17 +306,20 @@ PrintLn("       -nosym       ==> Don't create *.sym (or asm or object) files");
 PrintLn("       -quiet       ==> Compile silently if possible");
 PrintLn("       -special     ==> Compile dummy symbol file");
 PrintLn("       -strict      ==> Disallow non-standard constructs");
-PrintLn("       -symdir=XXX  ==> Place symbol files in directory XXX");
-PrintLn("       -target=XXX  ==> Emit (jvm|net|llvm) assembly");
+PrintLn("       -symdir:XXX  ==> Place symbol files in directory XXX");
+PrintLn("       -target:XXX  ==> Emit (jvm|net) assembly");
 PrintLn("       -verbose     ==> Emit verbose diagnostics");
 PrintLn("       -version     ==> Write out version number");
 PrintLn("       -warn-       ==> Don't emit warnings");
 PrintLn("       -nowarn      ==> Don't emit warnings");
-PrintLn("       -xmlerror    ==> Print error messages in XML format");
+PrintLn("       -xmlerror    ==> Emit error messages in XML format");
+
         IF RTS.defaultTarget = "jvm" THEN
+
 PrintLn("# Java Options ...");
 PrintLn("       -D<name>=<value>  pass <value> to JRE as system property <name>");
 PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JRE");
+
         END;
       END;
       Message("This program comes with NO WARRANTY");
@@ -304,7 +333,7 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
     PROCEDURE ParseOption*(IN opt : ARRAY OF CHAR);
 	  CONST MaxTargetLength = 4;
       VAR copy : ARRAY 16 OF CHAR;
-	      trgt : ARRAY MaxTargetLength + 1 OF CHAR;
+          trgt : ARRAY MaxTargetLength + 1 OF CHAR;
           indx : INTEGER;
      (* ----------------------------------------- *)
       PROCEDURE Unknown(IN str : ARRAY OF CHAR);
@@ -350,22 +379,23 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
         END;
       END GetSuffix;
      (* ----------------------------------------- *)
-	  PROCEDURE RaiseSuffix(preLen : INTEGER;
-	                        outLen : INTEGER;
-	                        IN opt : ARRAY OF CHAR;
-							OUT dir : ARRAY OF CHAR);
+      PROCEDURE RaiseSuffix(preLen : INTEGER;
+                            outLen : INTEGER;
+                            IN opt : ARRAY OF CHAR;
+                           OUT dir : ARRAY OF CHAR);
         VAR idx : INTEGER;
             chr : CHAR;
       BEGIN
         idx := 0;
-		REPEAT
+        REPEAT
           chr := opt[idx + preLen];
-		  dir[idx] := CAP(chr);
-		  INC(idx);
-		UNTIL (chr = 0X) OR (idx >= outLen) OR ((idx + preLen) > LEN(opt));
-		dir[idx] := 0X;
+          dir[idx] := CAP(chr);
+          INC(idx);
+        UNTIL (chr = 0X) OR (idx >= outLen) OR ((idx + preLen) > LEN(opt));
+        dir[idx] := 0X;
       END RaiseSuffix;
-
+     (* ----------------------------------------- *)
+     (*  Note: str is mutable, pat is immutable   *)
      (* ----------------------------------------- *)
       PROCEDURE StartsWith(str : ARRAY OF CHAR; IN pat : ARRAY OF CHAR) : BOOLEAN;
       BEGIN
@@ -381,8 +411,29 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
       copy[15] := 0X;
 
       CASE copy[0] OF
+      | "a" : 
+          IF StartsWith(copy, "asm") THEN
+            GetSuffix(LEN("-asm"), opt, asmVer);
+            IF (LEN(asmVer$) # 1) OR
+               ( asmVer[0] < '5') OR (asmVer[0] > '8') THEN 
+              Unknown(opt);
+            ELSE
+            (*
+              IF ~quiet THEN
+                Message( "ASM emitter, using jvm classfile version V1_" + asmVer$);
+              END;
+             *)
+              doCode     := TRUE;
+              doAsm5     := TRUE;
+              expectedJvm := TRUE;
+            END;
+           
+          ELSE 
+            Unknown(opt);
+          END;
       | "b" : 
-          IF StartsWith(copy, "bindir=") THEN
+          IF StartsWith(copy, "bindir=") OR 
+             StartsWith(copy, "bindir:") THEN
             GetSuffix(LEN("/bindir="), opt, binDir);
             expectedNet := TRUE;
             IF ~quiet THEN 
@@ -394,17 +445,21 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
       | "c" : 
           IF copy = "copyright" THEN 
             GPCPcopyright.Write;
-          ELSIF StartsWith(copy, "clsdir=") THEN
+          ELSIF StartsWith(copy, "clsdir=") OR
+                StartsWith(copy, "clsdir:") THEN
             GetSuffix(LEN("/clsdir="), opt, binDir);
             expectedJvm := TRUE;
             IF ~quiet THEN 
               Message("output class tree rooted at <" + binDir +">");
             END;
-          ELSIF StartsWith(copy, "cpsym=") THEN
+          ELSIF StartsWith(copy, "cpsym=") OR
+                StartsWith(copy, "cpsym:") THEN
             GetSuffix(LEN("/cpsym="), opt, cpSymX);
+          (*
             IF ~quiet THEN 
               Message("using %" + cpSymX +"% as symbol file path");
             END;
+           *)
           ELSE
             Unknown(opt);
           END;
@@ -450,7 +505,10 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
           ELSIF copy = "list" THEN
             listLevel  := CPascalS.listErrOnly;
           ELSIF copy = "legacy" THEN
-            legacy := TRUE;
+            doDWC      := TRUE;
+            doCode     := TRUE;
+            doAsm5     := FALSE;
+            expectedJvm := TRUE;
           ELSE 
             Unknown(opt);
           END;
@@ -497,7 +555,8 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
             strict     := FALSE;
           ELSIF copy = "strict" THEN
             strict     := TRUE;
-          ELSIF StartsWith(copy, "symdir=") THEN
+          ELSIF StartsWith(copy, "symdir=") OR
+                StartsWith(copy, "symdir:") THEN
             GetSuffix(LEN("/symdir="), opt, symDir);
             IF ~quiet THEN 
               Message("sym directory set to <" + symDir +">");
@@ -506,7 +565,8 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
             Unknown(opt);
           END;
       | "t" :
-          IF StartsWith(copy, "target=") THEN
+          IF StartsWith(copy, "target=") OR
+             StartsWith(copy, "target:") THEN
             RaiseSuffix(LEN("/target="), MaxTargetLength, opt, trgt);
             IF trgt = "JVM" THEN
               IF RTS.defaultTarget = "jvm" THEN
@@ -518,8 +578,6 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
                 Message("NET is default target for this build");
               END;
               target := "net";
-            ELSIF trgt = "LLVM" THEN
-              target := "llvm";
             ELSE
               Message('Unknown target, using "target=' +
                                                     RTS.defaultTarget + '"');
@@ -593,28 +651,11 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
           ("WARNING - a JVM-specific option was specified for .NET target");
           expectedJvm := FALSE;
         END;
-        IF expectedLlvm THEN Message
-          ("WARNING - an LLVM-specific option was specified for .NET target");
-          expectedLlvm := FALSE;
-        END;
       ELSIF target = "jvm" THEN
         IF expectedNet THEN Message
           ("WARNING - a .NET-specific option was specified for JVM target");
           expectedNet := FALSE;
         END;
-        IF expectedLlvm THEN Message
-          ("WARNING - an LLVM-specific option was specified for JVM target");
-          expectedLlvm := FALSE;
-        END;
-      ELSIF target = "llvm" THEN
-        IF expectedJvm THEN Message
-          ("WARNING - a JVM-specific option was specified for LLVM target");
-          expectedJvm := FALSE;
-        END;
-        IF expectedNet THEN Message
-          ("WARNING - a .NET-specific option was specified for LLVM target");
-          expectedNet := FALSE;
-        END;
       END;
      (* 
       *  If debug is set, for this version, ILASM is used unless /perwapi is explicit
@@ -644,8 +685,12 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
       FileNames.AppendExt(basNam, "lst", lstNam);
 
       CreateThisMod;
+
       xhrId := IdDesc.newFldId();
       xhrId.hash := NameHash.enterStr("prev");
+      xhrId.fldNm := BOX( "prev" );
+      emitNam    := BOX("????");
+
       srcBkt     := NameHash.enterStr("src");
       corBkt     := NameHash.enterStr("mscorlib_System");
 
@@ -659,7 +704,8 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
     VAR str1 : ARRAY 8 OF CHAR;
         str2 : ARRAY 8 OF CHAR;
   BEGIN
-    Message(target + GPCPcopyright.verStr); 
+    Message("GPCP-" + target + GPCPcopyright.verStr); 
+    Message("Using " + emitNam^ + " emitter" );
     GPText.IntToStr(CPascalS.line, str1);
     Message(str1 + " source lines");
     GPText.IntToStr(impMax, str1);
@@ -681,7 +727,6 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
 
   PROCEDURE InitOptions*;
   BEGIN
-    legacy      := FALSE;
     warning     := TRUE;
     verbose     := FALSE;
     doHelp      := FALSE; doneHelp    := FALSE;
@@ -699,6 +744,8 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
     forcePerwapi := FALSE;
     doCode      := TRUE;
     doAsm       := TRUE;
+    doAsm5      := TRUE;
+    doDWC       := FALSE;
     special     := FALSE;
     strict      := FALSE;
     quiet       := FALSE;
@@ -707,7 +754,6 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
     hashSize    := 5000;        (* gets default hash size *)
     expectedNet := FALSE;
     expectedJvm := FALSE;
-    expectedLlvm := FALSE;
     cpSymX      := "CPSYM";
   END InitOptions;
 

gpcp/ExprDesc.cp

@@ -2187,7 +2187,7 @@ MODULE ExprDesc;
                                    lIn : V.VarSet) : V.VarSet;
   (* Assert: expression has been fully attributed.   *)
   BEGIN
-      (* Really: recurse over set elements *)
+   (* Really: recurse over set elements *)
     RETURN lIn;
   END checkLive;
 

gpcp/GPCPcopyright.cp

@@ -49,7 +49,11 @@ MODULE GPCPcopyright;
      (* VERSION    = "1.3.15 of 04 October 2012"; *)
      (* VERSION    = "1.3.16 of 01 January 2013"; *)
      (* VERSION    = "1.3.17 of 01 June 2013"; *)
-        VERSION    = "1.3.18 of 26 August 2013"; 
+     (* VERSION    = "1.3.18 of 26 August 2013"; *)
+     (* VERSION    = "1.4.00 of 17 August 2016"; *)
+     (* VERSION    = "1.4.01 of 21 October 2016"; *)
+     (* VERSION    = "1.4.02 of 14 November 2016"; *)
+        VERSION    = "1.4.03 of 26 May 2017"; 
 	verStr*    = " version " + VERSION;
 
   CONST	prefix     = "#gpcp: ";

gpcp/GPCPcopyright.rtf

@@ -1,5 +1,5 @@
 {\rtf1\adeflang1025\ansi\ansicpg1252\uc1\adeff0\deff0\stshfdbch0\stshfloch0\stshfhich0\stshfbi0\deflang3081\deflangfe3081\themelang3081\themelangfe0\themelangcs0{\fonttbl{\f0\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\f1\fbidi \fswiss\fcharset0\fprq2{\*\panose 020b0604020202020204}Arial;}
-{\f34\fbidi \froman\fcharset1\fprq2{\*\panose 02040503050406030204}Cambria Math;}{\flomajor\f31500\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}
+{\f34\fbidi \froman\fcharset0\fprq2{\*\panose 02040503050406030204}Cambria Math;}{\flomajor\f31500\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}
 {\fdbmajor\f31501\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\fhimajor\f31502\fbidi \froman\fcharset0\fprq2{\*\panose 02040503050406030204}Cambria;}
 {\fbimajor\f31503\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\flominor\f31504\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}
 {\fdbminor\f31505\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\fhiminor\f31506\fbidi \fswiss\fcharset0\fprq2{\*\panose 020f0502020204030204}Calibri;}
@@ -7,31 +7,34 @@
 {\f42\fbidi \froman\fcharset161\fprq2 Times New Roman Greek;}{\f43\fbidi \froman\fcharset162\fprq2 Times New Roman Tur;}{\f44\fbidi \froman\fcharset177\fprq2 Times New Roman (Hebrew);}{\f45\fbidi \froman\fcharset178\fprq2 Times New Roman (Arabic);}
 {\f46\fbidi \froman\fcharset186\fprq2 Times New Roman Baltic;}{\f47\fbidi \froman\fcharset163\fprq2 Times New Roman (Vietnamese);}{\f49\fbidi \fswiss\fcharset238\fprq2 Arial CE;}{\f50\fbidi \fswiss\fcharset204\fprq2 Arial Cyr;}
 {\f52\fbidi \fswiss\fcharset161\fprq2 Arial Greek;}{\f53\fbidi \fswiss\fcharset162\fprq2 Arial Tur;}{\f54\fbidi \fswiss\fcharset177\fprq2 Arial (Hebrew);}{\f55\fbidi \fswiss\fcharset178\fprq2 Arial (Arabic);}
-{\f56\fbidi \fswiss\fcharset186\fprq2 Arial Baltic;}{\f57\fbidi \fswiss\fcharset163\fprq2 Arial (Vietnamese);}{\flomajor\f31508\fbidi \froman\fcharset238\fprq2 Times New Roman CE;}{\flomajor\f31509\fbidi \froman\fcharset204\fprq2 Times New Roman Cyr;}
-{\flomajor\f31511\fbidi \froman\fcharset161\fprq2 Times New Roman Greek;}{\flomajor\f31512\fbidi \froman\fcharset162\fprq2 Times New Roman Tur;}{\flomajor\f31513\fbidi \froman\fcharset177\fprq2 Times New Roman (Hebrew);}
-{\flomajor\f31514\fbidi \froman\fcharset178\fprq2 Times New Roman (Arabic);}{\flomajor\f31515\fbidi \froman\fcharset186\fprq2 Times New Roman Baltic;}{\flomajor\f31516\fbidi \froman\fcharset163\fprq2 Times New Roman (Vietnamese);}
-{\fdbmajor\f31518\fbidi \froman\fcharset238\fprq2 Times New Roman CE;}{\fdbmajor\f31519\fbidi \froman\fcharset204\fprq2 Times New Roman Cyr;}{\fdbmajor\f31521\fbidi \froman\fcharset161\fprq2 Times New Roman Greek;}
-{\fdbmajor\f31522\fbidi \froman\fcharset162\fprq2 Times New Roman Tur;}{\fdbmajor\f31523\fbidi \froman\fcharset177\fprq2 Times New Roman (Hebrew);}{\fdbmajor\f31524\fbidi \froman\fcharset178\fprq2 Times New Roman (Arabic);}
-{\fdbmajor\f31525\fbidi \froman\fcharset186\fprq2 Times New Roman Baltic;}{\fdbmajor\f31526\fbidi \froman\fcharset163\fprq2 Times New Roman (Vietnamese);}{\fhimajor\f31528\fbidi \froman\fcharset238\fprq2 Cambria CE;}
-{\fhimajor\f31529\fbidi \froman\fcharset204\fprq2 Cambria Cyr;}{\fhimajor\f31531\fbidi \froman\fcharset161\fprq2 Cambria Greek;}{\fhimajor\f31532\fbidi \froman\fcharset162\fprq2 Cambria Tur;}
-{\fhimajor\f31535\fbidi \froman\fcharset186\fprq2 Cambria Baltic;}{\fhimajor\f31536\fbidi \froman\fcharset163\fprq2 Cambria (Vietnamese);}{\fbimajor\f31538\fbidi \froman\fcharset238\fprq2 Times New Roman CE;}
-{\fbimajor\f31539\fbidi \froman\fcharset204\fprq2 Times New Roman Cyr;}{\fbimajor\f31541\fbidi \froman\fcharset161\fprq2 Times New Roman Greek;}{\fbimajor\f31542\fbidi \froman\fcharset162\fprq2 Times New Roman Tur;}
-{\fbimajor\f31543\fbidi \froman\fcharset177\fprq2 Times New Roman (Hebrew);}{\fbimajor\f31544\fbidi \froman\fcharset178\fprq2 Times New Roman (Arabic);}{\fbimajor\f31545\fbidi \froman\fcharset186\fprq2 Times New Roman Baltic;}
-{\fbimajor\f31546\fbidi \froman\fcharset163\fprq2 Times New Roman (Vietnamese);}{\flominor\f31548\fbidi \froman\fcharset238\fprq2 Times New Roman CE;}{\flominor\f31549\fbidi \froman\fcharset204\fprq2 Times New Roman Cyr;}
-{\flominor\f31551\fbidi \froman\fcharset161\fprq2 Times New Roman Greek;}{\flominor\f31552\fbidi \froman\fcharset162\fprq2 Times New Roman Tur;}{\flominor\f31553\fbidi \froman\fcharset177\fprq2 Times New Roman (Hebrew);}
-{\flominor\f31554\fbidi \froman\fcharset178\fprq2 Times New Roman (Arabic);}{\flominor\f31555\fbidi \froman\fcharset186\fprq2 Times New Roman Baltic;}{\flominor\f31556\fbidi \froman\fcharset163\fprq2 Times New Roman (Vietnamese);}
-{\fdbminor\f31558\fbidi \froman\fcharset238\fprq2 Times New Roman CE;}{\fdbminor\f31559\fbidi \froman\fcharset204\fprq2 Times New Roman Cyr;}{\fdbminor\f31561\fbidi \froman\fcharset161\fprq2 Times New Roman Greek;}
-{\fdbminor\f31562\fbidi \froman\fcharset162\fprq2 Times New Roman Tur;}{\fdbminor\f31563\fbidi \froman\fcharset177\fprq2 Times New Roman (Hebrew);}{\fdbminor\f31564\fbidi \froman\fcharset178\fprq2 Times New Roman (Arabic);}
-{\fdbminor\f31565\fbidi \froman\fcharset186\fprq2 Times New Roman Baltic;}{\fdbminor\f31566\fbidi \froman\fcharset163\fprq2 Times New Roman (Vietnamese);}{\fhiminor\f31568\fbidi \fswiss\fcharset238\fprq2 Calibri CE;}
-{\fhiminor\f31569\fbidi \fswiss\fcharset204\fprq2 Calibri Cyr;}{\fhiminor\f31571\fbidi \fswiss\fcharset161\fprq2 Calibri Greek;}{\fhiminor\f31572\fbidi \fswiss\fcharset162\fprq2 Calibri Tur;}
-{\fhiminor\f31575\fbidi \fswiss\fcharset186\fprq2 Calibri Baltic;}{\fhiminor\f31576\fbidi \fswiss\fcharset163\fprq2 Calibri (Vietnamese);}{\fbiminor\f31578\fbidi \froman\fcharset238\fprq2 Times New Roman CE;}
-{\fbiminor\f31579\fbidi \froman\fcharset204\fprq2 Times New Roman Cyr;}{\fbiminor\f31581\fbidi \froman\fcharset161\fprq2 Times New Roman Greek;}{\fbiminor\f31582\fbidi \froman\fcharset162\fprq2 Times New Roman Tur;}
-{\fbiminor\f31583\fbidi \froman\fcharset177\fprq2 Times New Roman (Hebrew);}{\fbiminor\f31584\fbidi \froman\fcharset178\fprq2 Times New Roman (Arabic);}{\fbiminor\f31585\fbidi \froman\fcharset186\fprq2 Times New Roman Baltic;}
-{\fbiminor\f31586\fbidi \froman\fcharset163\fprq2 Times New Roman (Vietnamese);}}{\colortbl;\red0\green0\blue0;\red0\green0\blue255;\red0\green255\blue255;\red0\green255\blue0;\red255\green0\blue255;\red255\green0\blue0;\red255\green255\blue0;
-\red255\green255\blue255;\red0\green0\blue128;\red0\green128\blue128;\red0\green128\blue0;\red128\green0\blue128;\red128\green0\blue0;\red128\green128\blue0;\red128\green128\blue128;\red192\green192\blue192;}{\*\defchp \fs22 }{\*\defpap 
-\ql \li0\ri0\sa200\sl276\slmult1\widctlpar\wrapdefault\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 }\noqfpromote {\stylesheet{\ql \li0\ri0\widctlpar\wrapdefault\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \rtlch\fcs1 \af0\afs24\alang1025 
-\ltrch\fcs0 \fs24\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 \snext0 \sqformat \spriority0 Normal;}{\s1\ql \li0\ri0\sb240\sa60\keepn\widctlpar\wrapdefault\aspalpha\aspnum\faauto\outlinelevel0\adjustright\rin0\lin0\itap0 \rtlch\fcs1 
-\ab\af1\afs32\alang1025 \ltrch\fcs0 \b\f1\fs32\lang1033\langfe1033\kerning32\cgrid\langnp1033\langfenp1033 \sbasedon0 \snext0 \slink15 \sqformat heading 1;}{\*\cs10 \additive \ssemihidden Default Paragraph Font;}{\*
+{\f56\fbidi \fswiss\fcharset186\fprq2 Arial Baltic;}{\f57\fbidi \fswiss\fcharset163\fprq2 Arial (Vietnamese);}{\f379\fbidi \froman\fcharset238\fprq2 Cambria Math CE;}{\f380\fbidi \froman\fcharset204\fprq2 Cambria Math Cyr;}
+{\f382\fbidi \froman\fcharset161\fprq2 Cambria Math Greek;}{\f383\fbidi \froman\fcharset162\fprq2 Cambria Math Tur;}{\f386\fbidi \froman\fcharset186\fprq2 Cambria Math Baltic;}{\f387\fbidi \froman\fcharset163\fprq2 Cambria Math (Vietnamese);}
+{\flomajor\f31508\fbidi \froman\fcharset238\fprq2 Times New Roman CE;}{\flomajor\f31509\fbidi \froman\fcharset204\fprq2 Times New Roman Cyr;}{\flomajor\f31511\fbidi \froman\fcharset161\fprq2 Times New Roman Greek;}
+{\flomajor\f31512\fbidi \froman\fcharset162\fprq2 Times New Roman Tur;}{\flomajor\f31513\fbidi \froman\fcharset177\fprq2 Times New Roman (Hebrew);}{\flomajor\f31514\fbidi \froman\fcharset178\fprq2 Times New Roman (Arabic);}
+{\flomajor\f31515\fbidi \froman\fcharset186\fprq2 Times New Roman Baltic;}{\flomajor\f31516\fbidi \froman\fcharset163\fprq2 Times New Roman (Vietnamese);}{\fdbmajor\f31518\fbidi \froman\fcharset238\fprq2 Times New Roman CE;}
+{\fdbmajor\f31519\fbidi \froman\fcharset204\fprq2 Times New Roman Cyr;}{\fdbmajor\f31521\fbidi \froman\fcharset161\fprq2 Times New Roman Greek;}{\fdbmajor\f31522\fbidi \froman\fcharset162\fprq2 Times New Roman Tur;}
+{\fdbmajor\f31523\fbidi \froman\fcharset177\fprq2 Times New Roman (Hebrew);}{\fdbmajor\f31524\fbidi \froman\fcharset178\fprq2 Times New Roman (Arabic);}{\fdbmajor\f31525\fbidi \froman\fcharset186\fprq2 Times New Roman Baltic;}
+{\fdbmajor\f31526\fbidi \froman\fcharset163\fprq2 Times New Roman (Vietnamese);}{\fhimajor\f31528\fbidi \froman\fcharset238\fprq2 Cambria CE;}{\fhimajor\f31529\fbidi \froman\fcharset204\fprq2 Cambria Cyr;}
+{\fhimajor\f31531\fbidi \froman\fcharset161\fprq2 Cambria Greek;}{\fhimajor\f31532\fbidi \froman\fcharset162\fprq2 Cambria Tur;}{\fhimajor\f31535\fbidi \froman\fcharset186\fprq2 Cambria Baltic;}
+{\fhimajor\f31536\fbidi \froman\fcharset163\fprq2 Cambria (Vietnamese);}{\fbimajor\f31538\fbidi \froman\fcharset238\fprq2 Times New Roman CE;}{\fbimajor\f31539\fbidi \froman\fcharset204\fprq2 Times New Roman Cyr;}
+{\fbimajor\f31541\fbidi \froman\fcharset161\fprq2 Times New Roman Greek;}{\fbimajor\f31542\fbidi \froman\fcharset162\fprq2 Times New Roman Tur;}{\fbimajor\f31543\fbidi \froman\fcharset177\fprq2 Times New Roman (Hebrew);}
+{\fbimajor\f31544\fbidi \froman\fcharset178\fprq2 Times New Roman (Arabic);}{\fbimajor\f31545\fbidi \froman\fcharset186\fprq2 Times New Roman Baltic;}{\fbimajor\f31546\fbidi \froman\fcharset163\fprq2 Times New Roman (Vietnamese);}
+{\flominor\f31548\fbidi \froman\fcharset238\fprq2 Times New Roman CE;}{\flominor\f31549\fbidi \froman\fcharset204\fprq2 Times New Roman Cyr;}{\flominor\f31551\fbidi \froman\fcharset161\fprq2 Times New Roman Greek;}
+{\flominor\f31552\fbidi \froman\fcharset162\fprq2 Times New Roman Tur;}{\flominor\f31553\fbidi \froman\fcharset177\fprq2 Times New Roman (Hebrew);}{\flominor\f31554\fbidi \froman\fcharset178\fprq2 Times New Roman (Arabic);}
+{\flominor\f31555\fbidi \froman\fcharset186\fprq2 Times New Roman Baltic;}{\flominor\f31556\fbidi \froman\fcharset163\fprq2 Times New Roman (Vietnamese);}{\fdbminor\f31558\fbidi \froman\fcharset238\fprq2 Times New Roman CE;}
+{\fdbminor\f31559\fbidi \froman\fcharset204\fprq2 Times New Roman Cyr;}{\fdbminor\f31561\fbidi \froman\fcharset161\fprq2 Times New Roman Greek;}{\fdbminor\f31562\fbidi \froman\fcharset162\fprq2 Times New Roman Tur;}
+{\fdbminor\f31563\fbidi \froman\fcharset177\fprq2 Times New Roman (Hebrew);}{\fdbminor\f31564\fbidi \froman\fcharset178\fprq2 Times New Roman (Arabic);}{\fdbminor\f31565\fbidi \froman\fcharset186\fprq2 Times New Roman Baltic;}
+{\fdbminor\f31566\fbidi \froman\fcharset163\fprq2 Times New Roman (Vietnamese);}{\fhiminor\f31568\fbidi \fswiss\fcharset238\fprq2 Calibri CE;}{\fhiminor\f31569\fbidi \fswiss\fcharset204\fprq2 Calibri Cyr;}
+{\fhiminor\f31571\fbidi \fswiss\fcharset161\fprq2 Calibri Greek;}{\fhiminor\f31572\fbidi \fswiss\fcharset162\fprq2 Calibri Tur;}{\fhiminor\f31573\fbidi \fswiss\fcharset177\fprq2 Calibri (Hebrew);}
+{\fhiminor\f31574\fbidi \fswiss\fcharset178\fprq2 Calibri (Arabic);}{\fhiminor\f31575\fbidi \fswiss\fcharset186\fprq2 Calibri Baltic;}{\fhiminor\f31576\fbidi \fswiss\fcharset163\fprq2 Calibri (Vietnamese);}
+{\fbiminor\f31578\fbidi \froman\fcharset238\fprq2 Times New Roman CE;}{\fbiminor\f31579\fbidi \froman\fcharset204\fprq2 Times New Roman Cyr;}{\fbiminor\f31581\fbidi \froman\fcharset161\fprq2 Times New Roman Greek;}
+{\fbiminor\f31582\fbidi \froman\fcharset162\fprq2 Times New Roman Tur;}{\fbiminor\f31583\fbidi \froman\fcharset177\fprq2 Times New Roman (Hebrew);}{\fbiminor\f31584\fbidi \froman\fcharset178\fprq2 Times New Roman (Arabic);}
+{\fbiminor\f31585\fbidi \froman\fcharset186\fprq2 Times New Roman Baltic;}{\fbiminor\f31586\fbidi \froman\fcharset163\fprq2 Times New Roman (Vietnamese);}}{\colortbl;\red0\green0\blue0;\red0\green0\blue255;\red0\green255\blue255;\red0\green255\blue0;
+\red255\green0\blue255;\red255\green0\blue0;\red255\green255\blue0;\red255\green255\blue255;\red0\green0\blue128;\red0\green128\blue128;\red0\green128\blue0;\red128\green0\blue128;\red128\green0\blue0;\red128\green128\blue0;\red128\green128\blue128;
+\red192\green192\blue192;}{\*\defchp \fs22 }{\*\defpap \ql \li0\ri0\sa200\sl276\slmult1\widctlpar\wrapdefault\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 }\noqfpromote {\stylesheet{
+\ql \li0\ri0\widctlpar\wrapdefault\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \rtlch\fcs1 \af0\afs24\alang1025 \ltrch\fcs0 \fs24\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 \snext0 \sqformat \spriority0 Normal;}{
+\s1\ql \li0\ri0\sb240\sa60\keepn\widctlpar\wrapdefault\aspalpha\aspnum\faauto\outlinelevel0\adjustright\rin0\lin0\itap0 \rtlch\fcs1 \ab\af1\afs32\alang1025 \ltrch\fcs0 \b\f1\fs32\lang1033\langfe1033\kerning32\cgrid\langnp1033\langfenp1033 
+\sbasedon0 \snext0 \slink15 \sqformat heading 1;}{\*\cs10 \additive \ssemihidden Default Paragraph Font;}{\*
 \ts11\tsrowd\trftsWidthB3\trpaddl108\trpaddr108\trpaddfl3\trpaddft3\trpaddfb3\trpaddfr3\trcbpat1\trcfpat1\tblind0\tblindtype3\tscellwidthfts0\tsvertalt\tsbrdrt\tsbrdrl\tsbrdrb\tsbrdrr\tsbrdrdgl\tsbrdrdgr\tsbrdrh\tsbrdrv \ql \li0\ri0\sa200\sl276\slmult1
 \widctlpar\wrapdefault\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \rtlch\fcs1 \af0\afs22\alang1025 \ltrch\fcs0 \fs22\lang3081\langfe3081\cgrid\langnp3081\langfenp3081 \snext11 \ssemihidden \sunhideused \sqformat Normal Table;}{\*\cs15 \additive 
 \rtlch\fcs1 \ab\af31503\afs32 \ltrch\fcs0 \b\fs32\lang1033\langfe1033\kerning32\loch\f31502\hich\af31502\dbch\af31501\langnp1033\langfenp1033 \sbasedon10 \slink1 \slocked \spriority9 Heading 1 Char;}}{\*\listtable{\list\listtemplateid-1508889896
@@ -45,9 +48,9 @@
 \rtlch\fcs1 \af0 \ltrch\fcs0 \hres0\chhres0 \fi-360\li5040\jclisttab\tx5040\lin5040 }{\listlevel\levelnfc4\levelnfcn4\leveljc0\leveljcn0\levelfollow0\levelstartat1\levelspace360\levelindent0{\leveltext\leveltemplateid67698713\'02\'07.;}{\levelnumbers
 \'01;}\rtlch\fcs1 \af0 \ltrch\fcs0 \hres0\chhres0 \fi-360\li5760\jclisttab\tx5760\lin5760 }{\listlevel\levelnfc2\levelnfcn2\leveljc2\leveljcn2\levelfollow0\levelstartat1\levelspace360\levelindent0{\leveltext\leveltemplateid67698715
 \'02\'08.;}{\levelnumbers\'01;}\rtlch\fcs1 \af0 \ltrch\fcs0 \hres0\chhres0 \fi-180\li6480\jclisttab\tx6480\lin6480 }{\listname ;}\listid1123961876}}{\*\listoverridetable{\listoverride\listid1123961876\listoverridecount0\ls1}}{\*\rsidtbl \rsid30932
-\rsid608180\rsid941286\rsid9770042}{\mmathPr\mmathFont34\mbrkBin0\mbrkBinSub0\msmallFrac0\mdispDef1\mlMargin0\mrMargin0\mdefJc1\mwrapIndent1440\mintLim0\mnaryLim1}{\info{\title Gardens Point Component Pascal Copyright}{\author gough}{\operator john}
-{\creatim\yr2001\mo12\dy17\hr21\min36}{\revtim\yr2012\mo7\dy31\hr11\min40}{\version5}{\edmins17}{\nofpages1}{\nofwords234}{\nofchars1303}{\*\company Faculty of Information Technology}{\nofcharsws1534}{\vern32773}}{\*\xmlnstbl {\xmlns1 http://schemas.micro
-soft.com/office/word/2003/wordml}{\xmlns2 urn:schemas-microsoft-com:office:smarttags}}\paperw12240\paperh15840\margl1800\margr1800\margt1440\margb1440\gutter0\ltrsect 
+\rsid608180\rsid941286\rsid8743837\rsid9770042}{\mmathPr\mmathFont34\mbrkBin0\mbrkBinSub0\msmallFrac0\mdispDef1\mlMargin0\mrMargin0\mdefJc1\mwrapIndent1440\mintLim0\mnaryLim1}{\info{\title Gardens Point Component Pascal Copyright}{\author gough}
+{\operator john}{\creatim\yr2001\mo12\dy17\hr21\min36}{\revtim\yr2017\mo6\dy12\hr11\min15}{\version6}{\edmins19}{\nofpages1}{\nofwords234}{\nofchars1303}{\*\company Faculty of Information Technology}{\nofcharsws1534}{\vern32775}}{\*\xmlnstbl {\xmlns1 http
+://schemas.microsoft.com/office/word/2003/wordml}{\xmlns2 urn:schemas-microsoft-com:office:smarttags}}\paperw12240\paperh15840\margl1800\margr1800\margt1440\margb1440\gutter0\ltrsect 
 \widowctrl\ftnbj\aenddoc\trackmoves1\trackformatting1\donotembedsysfont0\relyonvml0\donotembedlingdata1\grfdocevents0\validatexml0\showplaceholdtext0\ignoremixedcontent0\saveinvalidxml0\showxmlerrors0\noxlattoyen
 \expshrtn\noultrlspc\dntblnsbdb\nospaceforul\formshade\horzdoc\dgmargin\dghspace180\dgvspace180\dghorigin1800\dgvorigin1440\dghshow1\dgvshow1
 \jexpand\viewkind1\viewscale100\pgbrdrhead\pgbrdrfoot\splytwnine\ftnlytwnine\htmautsp\nolnhtadjtbl\useltbaln\alntblind\lytcalctblwd\lyttblrtgr\lnbrkrule\rsidroot9770042 \fet0{\*\wgrffmtfilter 013f}\ilfomacatclnup0{\*\template 
@@ -58,7 +61,7 @@ C:\\Documents and Settings\\gough\\Application Data\\Microsoft\\Templates\\Norma
 \b\f1\fs32\lang1033\langfe1033\kerning32\cgrid\langnp1033\langfenp1033 {\rtlch\fcs1 \af1 \ltrch\fcs0 \insrsid9770042 Gardens Point Component Pascal Copyright
 \par }\pard\plain \ltrpar\ql \li0\ri0\widctlpar\wrapdefault\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \rtlch\fcs1 \af0\afs24\alang1025 \ltrch\fcs0 \fs24\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 {\rtlch\fcs1 \af0 \ltrch\fcs0 \insrsid9770042 
 
-\par }{\rtlch\fcs1 \af0 \ltrch\fcs0 \insrsid941286 Copyright \'a9 1998 \endash  2012}{\rtlch\fcs1 \af0 \ltrch\fcs0 \insrsid9770042  Queensland University of Technology (QUT). All rights reserved.
+\par }{\rtlch\fcs1 \af0 \ltrch\fcs0 \insrsid8743837 Copyright \'a9 1998 \endash  2017}{\rtlch\fcs1 \af0 \ltrch\fcs0 \insrsid9770042  Queensland University of Technology (QUT). All rights reserved.
 \par 
 \par Redistribution and use in source and binary forms, with or without modification are permitted provided that the following conditions are met:
 \par 
@@ -180,8 +183,8 @@ fffffffffffffffffdfffffffeffffffffffffffffffffffffffffffffffffffffffffffffffffff
 ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
 ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
 ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffffffffffffffffffffffff52006f006f007400200045006e00740072007900000000000000000000000000000000000000000000000000000000000000000000000000000000000000000016000500ffffffffffffffffffffffffec69d9888b8b3d4c859eaf6cd158be0f0000000000000000000000000061
-bc69bd6ecd01feffffff00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ffffffffffffffffffffffff00000000000000000000000000000000000000000000000000000000
+ffffffffffffffffffffffffffffffff52006f006f007400200045006e00740072007900000000000000000000000000000000000000000000000000000000000000000000000000000000000000000016000500ffffffffffffffffffffffffec69d9888b8b3d4c859eaf6cd158be0f000000000000000000000000605c
+805119e3d201feffffff00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ffffffffffffffffffffffff00000000000000000000000000000000000000000000000000000000
 00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ffffffffffffffffffffffff0000000000000000000000000000000000000000000000000000
 000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ffffffffffffffffffffffff000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000105000000000000}}

gpcp/Hello.cp

@@ -1,7 +1,7 @@
 MODULE Hello;
   IMPORT CPmain, Console;
 
-  CONST greet = "Hello Beta2 world";
+  CONST greet = "Hello AsmEmitter world";
 
 BEGIN
   Console.WriteString(greet); 

gpcp/JVMcodes.cp

@@ -730,5 +730,6 @@ BEGIN
 	dl[opc_goto_w]		:= 0;
 	dl[opc_jsr_w]		:= 1;
 	dl[opc_breakpoint] 	:= 0;
+
 END JVMcodes.
 (* ============================================================ *)

gpcp/JsmnUtil.cp

@@ -14,9 +14,9 @@ MODULE JsmnUtil;
         FileNames,
 	GPTextFiles,
 	CompState,
-        J := JavaUtil,
-	D := Symbols,
-	G := Builtin,
+        J  := JavaUtil,
+	Sy := Symbols,
+	G  := Builtin,
 	Id := IdDesc,
 	Ty := TypeDesc,
 	Jvm := JVMcodes;
@@ -36,14 +36,8 @@ MODULE JsmnUtil;
 	objectInit* = "java/lang/Object/<init>()V";
 	mainStr*    = "main([Ljava/lang/String;)V";
 	jlExcept*   = "java/lang/Exception";
-(*
- *	jlError*    = "java/lang/Error";
- *)
 	jlError*    = jlExcept;
 	mkExcept*   = "java/lang/Exception/<init>(Ljava/lang/String;)V";
-(*
- *	mkError*    = "java/lang/Error/<init>(Ljava/lang/String;)V";
- *)
 	mkError*    = mkExcept;
 	putArgStr*  = "CP/CPmain/CPmain/PutArgs([Ljava/lang/String;)V";
 
@@ -51,7 +45,7 @@ MODULE JsmnUtil;
 (* ============================================================ *)
 
   TYPE ProcInfo*  = POINTER TO RECORD
-		      prId- : D.Scope;  (* mth., prc. or mod.	*)
+		      prId- : Sy.Scope;  (* mth., prc. or mod.	*)
 		      lMax  : INTEGER;	(* max locals for proc  *)
 		      lNum  : INTEGER;	(* current locals proc  *)
 		      dMax  : INTEGER;	(* max depth for proc.  *)
@@ -90,6 +84,7 @@ MODULE JsmnUtil;
     NEW(f);
     f.file := GPTextFiles.createFile(fileName);
     IF f.file = NIL THEN RETURN NIL; END;
+    CompState.emitNam := BOX("Jasmin");
     RETURN f;
   END newJsmnFile;
 
@@ -113,7 +108,7 @@ MODULE JsmnUtil;
 (*			ProcInfo Methods			*)
 (* ============================================================ *)
 
-  PROCEDURE newProcInfo*(proc : D.Scope) : ProcInfo;
+  PROCEDURE newProcInfo*(proc : Sy.Scope) : ProcInfo;
     VAR p : ProcInfo;
   BEGIN
     NEW(p);
@@ -140,7 +135,7 @@ MODULE JsmnUtil;
     procName : FileNames.NameString;
   BEGIN
     os.proc := newProcInfo(proc);
-    os.Comment("PROCEDURE " + D.getName.ChPtr(proc)^);
+    os.Comment("PROCEDURE " + Sy.getName.ChPtr(proc)^);
    (*
     *  Compute the method attributes
     *)
@@ -160,10 +155,10 @@ MODULE JsmnUtil;
  *  since the JVM places the "override method" in a different 
  *  slot! We must thus live with the insecurity of public mode.
  *
- *  IF proc.vMod = D.pubMode THEN	(* explicitly public *)
+ *  IF proc.vMod = Sy.pubMode THEN	(* explicitly public *)
  *)
-    IF (proc.vMod = D.pubMode) OR	(* explicitly public *)
-       (proc.vMod = D.rdoMode) THEN     (* "implement only"  *)
+    IF (proc.vMod = Sy.pubMode) OR	(* explicitly public *)
+       (proc.vMod = Sy.rdoMode) THEN     (* "implement only"  *)
       attr := attr + Jvm.att_public;
     ELSIF proc.dfScp IS Id.PrcId THEN	(* nested procedure  *)
       attr := attr + Jvm.att_private;
@@ -179,6 +174,8 @@ MODULE JsmnUtil;
   PROCEDURE^ (os : JsmnFile)Stack(),NEW;
   PROCEDURE^ (os : JsmnFile)Blank(),NEW;
 
+(* ------------------------------------------------------------ *)
+
   PROCEDURE (os : JsmnFile)EndProc*();
   BEGIN
     IF (os.proc.attr * Jvm.att_abstract # {}) THEN
@@ -198,14 +195,14 @@ MODULE JsmnUtil;
 
 (* ------------------------------------------------------------ *)
 
-  PROCEDURE (os : JsmnFile)getScope*() : D.Scope;
+  PROCEDURE (os : JsmnFile)getScope*() : Sy.Scope;
   BEGIN
     RETURN os.proc.prId; 
   END getScope;
 
 (* ------------------------------------------------------------ *)
 
-  PROCEDURE (os : JsmnFile)newLocal*() : INTEGER;
+  PROCEDURE (os : JsmnFile)newLocal*( t : Sy.Type ) : INTEGER;
     VAR ord : INTEGER;
         info : ProcInfo;
   BEGIN
@@ -218,14 +215,78 @@ MODULE JsmnUtil;
 
 (* ------------------------------------------------------------ *)
 
-  PROCEDURE (os : JsmnFile)ReleaseLocal*(i : INTEGER);
+  PROCEDURE (os : JsmnFile)newLongLocal*( t : Sy.Type ) : INTEGER;
+    VAR ord : INTEGER;
+        info : ProcInfo;
   BEGIN
-   (*
-    *  If you try to release not in LIFO order, the 
-    *  location will not be made free again. This is safe!
-    *)
-    IF i+1 = os.proc.lNum THEN DEC(os.proc.lNum) END;
-  END ReleaseLocal;
+    info := os.proc; 
+    ord := info.lNum;
+    INC(info.lNum, 2);
+    IF info.lNum > info.lMax THEN info.lMax := info.lNum END;
+    RETURN ord;
+  END newLongLocal;
+
+(* ------------------------------------------------------------ *)
+
+  PROCEDURE (jf : JsmnFile)LoadLocal*(ord : INTEGER; typ : Sy.Type);
+    VAR code : INTEGER;
+  BEGIN
+    IF (typ # NIL) & (typ IS Ty.Base) THEN 
+      code := J.typeLoad[typ(Ty.Base).tpOrd];
+    ELSE
+      code := Jvm.opc_aload; 
+    END;
+    IF ord < 4 THEN
+      CASE code OF
+      | Jvm.opc_iload : code := Jvm.opc_iload_0 + ord;
+      | Jvm.opc_lload : code := Jvm.opc_lload_0 + ord;
+      | Jvm.opc_fload : code := Jvm.opc_fload_0 + ord;
+      | Jvm.opc_dload : code := Jvm.opc_dload_0 + ord;
+      | Jvm.opc_aload : code := Jvm.opc_aload_0 + ord;
+      END;
+      jf.Code(code);
+    ELSE
+      jf.CodeI(code, ord);
+    END;
+  END LoadLocal;
+
+(* ---------------------------------------------------- *)
+
+  PROCEDURE (jf : JsmnFile)StoreLocal*(ord : INTEGER; typ : Sy.Type);
+    VAR code : INTEGER;
+  BEGIN
+    IF (typ # NIL) & (typ IS Ty.Base) THEN 
+      code := J.typeStore[typ(Ty.Base).tpOrd];
+    ELSE
+      code := Jvm.opc_astore;
+    END;
+    IF ord < 4 THEN
+      CASE code OF
+      | Jvm.opc_istore : code := Jvm.opc_istore_0 + ord;
+      | Jvm.opc_lstore : code := Jvm.opc_lstore_0 + ord;
+      | Jvm.opc_fstore : code := Jvm.opc_fstore_0 + ord;
+      | Jvm.opc_dstore : code := Jvm.opc_dstore_0 + ord;
+      | Jvm.opc_astore : code := Jvm.opc_astore_0 + ord;
+      END;
+      jf.Code(code);
+    ELSE
+      jf.CodeI(code, ord);
+    END;
+  END StoreLocal;
+
+(* ------------------------------------------------------------ *)
+
+  PROCEDURE (os : JsmnFile)PopLocal*();
+  BEGIN
+    DEC(os.proc.lNum);
+  END PopLocal;
+
+(* ------------------------------------------------------------ *)
+
+  PROCEDURE (os : JsmnFile)PopLongLocal*();
+  BEGIN
+    DEC(os.proc.lNum, 2);
+  END PopLongLocal;
 
 (* ------------------------------------------------------------ *)
 
@@ -321,11 +382,11 @@ MODULE JsmnUtil;
   BEGIN
     os.Blank();
     IF prc = NIL THEN
-      IF D.noNew IN rec.xAttr THEN 
+      IF Sy.noNew IN rec.xAttr THEN 
         os.Comment("There is no no-arg constructor for this class");
         os.Blank();
         RETURN;					(* PREMATURE RETURN HERE *)
-      ELSIF D.xCtor IN rec.xAttr THEN 
+      ELSIF Sy.xCtor IN rec.xAttr THEN 
         os.Comment("There is an explicit no-arg constructor for this class");
         os.Blank();
         RETURN;					(* PREMATURE RETURN HERE *)
@@ -360,7 +421,7 @@ MODULE JsmnUtil;
   PROCEDURE (os : JsmnFile)CallSuperCtor*(rec : Ty.Record;
                                           pTy : Ty.Procedure);
     VAR	idx : INTEGER;
-	fld : D.Idnt;
+	fld : Sy.Idnt;
 	pNm : INTEGER;
 	string2 : LitValue.CharOpen;
   BEGIN
@@ -535,14 +596,14 @@ MODULE JsmnUtil;
 
 (* ============================================================ *)
 
-  PROCEDURE (os : JsmnFile)Idnt(idD : D.Idnt),NEW;
+  PROCEDURE (os : JsmnFile)Idnt(idD : Sy.Idnt),NEW;
   BEGIN
-    GPText.WriteString(os.file, D.getName.ChPtr(idD));
+    GPText.WriteString(os.file, Sy.getName.ChPtr(idD));
   END Idnt;
 
 (* ============================================================ *)
 
-  PROCEDURE (os : JsmnFile)Type(typ : D.Type),NEW;
+  PROCEDURE (os : JsmnFile)Type(typ : Sy.Type),NEW;
   BEGIN
     WITH typ : Ty.Base DO
 	GPText.WriteString(os.file, typ.xName);
@@ -570,7 +631,7 @@ MODULE JsmnUtil;
 
 (* ============================================================ *)
 
-  PROCEDURE (os : JsmnFile)TypeTag(typ : D.Type),NEW;
+  PROCEDURE (os : JsmnFile)TypeTag(typ : Sy.Type),NEW;
   BEGIN
     WITH typ : Ty.Base DO
 	GPText.WriteString(os.file, typ.xName);
@@ -726,7 +787,7 @@ MODULE JsmnUtil;
 
 (* -------------------------------------------- *)
 
-  PROCEDURE (os : JsmnFile)CodeT*(code : INTEGER; type : D.Type);
+  PROCEDURE (os : JsmnFile)CodeT*(code : INTEGER; type : Sy.Type);
   BEGIN
     os.Prefix(code);
     GPTextFiles.WriteChar(os.file, ASCII.HT);
@@ -800,7 +861,8 @@ MODULE JsmnUtil;
 
 (* -------------------------------------------- *)
 
-  PROCEDURE (os : JsmnFile)CodeSwitch*(loIx,hiIx : INTEGER; dfLb : J.Label);
+  PROCEDURE (os : JsmnFile)CodeSwitch*(
+             loIx,hiIx : INTEGER; defLab : J.Label);
   BEGIN
     os.CodeII(Jvm.opc_tableswitch,loIx,hiIx);
   END CodeSwitch;
@@ -878,7 +940,7 @@ MODULE JsmnUtil;
 
 (* ============================================================ *)
 
-  PROCEDURE (os : JsmnFile)MultiNew*(elT : D.Type;
+  PROCEDURE (os : JsmnFile)MultiNew*(elT : Sy.Type;
 				     dms : INTEGER),NEW;
    (* dsc is the array descriptor, dms the number of dimensions *)
     VAR i : INTEGER;
@@ -948,7 +1010,7 @@ MODULE JsmnUtil;
 
 (* ============================================================ *)
 
-  PROCEDURE (os : JsmnFile)Alloc1d*(elTp : D.Type);
+  PROCEDURE (os : JsmnFile)Alloc1d*(elTp : Sy.Type);
   BEGIN
     WITH elTp : Ty.Base DO
       IF (elTp.tpOrd < Ty.anyRec) THEN
@@ -980,10 +1042,10 @@ MODULE JsmnUtil;
 
 (* ============================================================ *)
 
-  PROCEDURE (os : JsmnFile)MkNewFixedArray*(topE : D.Type; len0 : INTEGER);
+  PROCEDURE (os : JsmnFile)MkNewFixedArray*(topE : Sy.Type; len0 : INTEGER);
     VAR dims : INTEGER;
 	arTp : Ty.Array;
-	elTp : D.Type;
+	elTp : Sy.Type;
   BEGIN
     (*
     //  Fixed-size, possibly multi-dimensional arrays.
@@ -1025,7 +1087,7 @@ MODULE JsmnUtil;
 (* ============================================================ *)
 
   PROCEDURE (os : JsmnFile)MkNewOpenArray*(arrT : Ty.Array; dims : INTEGER);
-    VAR elTp : D.Type;
+    VAR elTp : Sy.Type;
 	indx : INTEGER;
   BEGIN
    (* 
@@ -1072,7 +1134,7 @@ MODULE JsmnUtil;
 
   PROCEDURE (os : JsmnFile)MkArrayCopy*(arrT : Ty.Array);
     VAR dims : INTEGER;
-        elTp : D.Type;
+        elTp : Sy.Type;
   BEGIN
    (*
     *	Assert: we must find the lengths from the runtime 
@@ -1122,8 +1184,8 @@ MODULE JsmnUtil;
 
 (* ============================================================ *)
 
-  PROCEDURE (os : JsmnFile)VarInit*(var : D.Idnt);
-    VAR typ : D.Type;
+  PROCEDURE (os : JsmnFile)VarInit*(var : Sy.Idnt);
+    VAR typ : Sy.Type;
   BEGIN
    (*
     *  Precondition: var is of a type that needs initialization
@@ -1194,7 +1256,7 @@ MODULE JsmnUtil;
 
 (* ============================================================ *)
 
-  PROCEDURE (os : JsmnFile)WithTrap*(id : D.Idnt);
+  PROCEDURE (os : JsmnFile)WithTrap*(id : Sy.Idnt);
   BEGIN
     os.CodeS(Jvm.opc_new, jlError);
     os.Code(Jvm.opc_dup);
@@ -1221,10 +1283,10 @@ MODULE JsmnUtil;
  
   PROCEDURE (os : JsmnFile)StartRecClass*(rec : Ty.Record);
   VAR
-    baseT  : D.Type;
+    baseT  : Sy.Type;
     attSet : SET;
-    clsId  : D.Idnt;
-    impRec : D.Type;
+    clsId  : Sy.Idnt;
+    impRec : Sy.Type;
     index  : INTEGER;
   BEGIN
     os.Blank();
@@ -1250,9 +1312,9 @@ MODULE JsmnUtil;
     *   Account for the identifier visibility.
     *)
     IF clsId # NIL THEN
-      IF clsId.vMod = D.pubMode THEN
+      IF clsId.vMod = Sy.pubMode THEN
 	attSet := attSet + Jvm.att_public;
-      ELSIF clsId.vMod = D.prvMode THEN
+      ELSIF clsId.vMod = Sy.prvMode THEN
 	attSet := attSet + Jvm.att_private;
       END;
     END;
@@ -1303,7 +1365,7 @@ MODULE JsmnUtil;
   BEGIN
     IF id IS Id.FldId THEN att := Jvm.att_empty; 
     ELSE att := Jvm.att_static; END;
-    IF id.vMod # D.prvMode THEN (* any export ==> public in JVM *)
+    IF id.vMod # Sy.prvMode THEN (* any export ==> public in JVM *)
       att := att + Jvm.att_public;
     END;
     os.CatStr(Jvm.dirStr[Jvm.dot_field]);

gpcp/LitValue.cp

@@ -19,14 +19,16 @@ MODULE LitValue;
 
   TYPE
     CharOpen*    = POINTER TO ARRAY OF CHAR;
+    CharOpenArr*  = POINTER TO ARRAY OF CharOpen;
     CharOpenSeq* = RECORD
 		     high  : INTEGER;
 		     tide- : INTEGER;
-		     a-    : POINTER TO ARRAY OF CharOpen;
+		     a-    : CharOpenArr;
 		   END;
 
     CharVector*  = VECTOR OF CHAR;
 
+
 (* ============================================================ *)
 
   TYPE
@@ -337,6 +339,16 @@ MODULE LitValue;
     RETURN strToCharOpen(arr);
   END intToCharOpen;   
 
+(* -------------------------------------------- *)
+
+  PROCEDURE charToCharOpen*(c : CHAR) : CharOpen;
+    VAR arr : CharOpen;
+  BEGIN
+    NEW( arr, 2 );
+    arr[0] := c;
+    RETURN arr;
+  END charToCharOpen;   
+
 (* -------------------------------------------- *)
 
   PROCEDURE ToStr*(in : CharOpen; OUT out : ARRAY OF CHAR);
@@ -531,6 +543,22 @@ MODULE LitValue;
     RETURN 0;
   END strCmp;
 
+(* -------------------------------------------- *)
+ 
+  PROCEDURE SvConcat3*( a,b,c : CharOpen; sp : CHAR ) : CharOpen;
+    VAR nmArray : CharOpenSeq;
+        spacer : CharOpen;
+  BEGIN
+    spacer := charToCharOpen( sp );
+    InitCharOpenSeq(nmArray, 5); 
+    AppendCharOpen(nmArray, a);
+    AppendCharOpen(nmArray, spacer);
+    AppendCharOpen(nmArray, b);
+    AppendCharOpen(nmArray, spacer);
+    AppendCharOpen(nmArray, c);
+    RETURN arrayCat(nmArray);
+  END SvConcat3;
+
 (* -------------------------------------------- *)
 
   PROCEDURE DiagCharOpen*(ptr : CharOpen);

gpcp/MsilAsmForeign.cp

@@ -14,8 +14,8 @@ FOREIGN MODULE MsilAsm;
   PROCEDURE Init*();
 
   PROCEDURE Assemble*(IN file : ARRAY OF CHAR; 
-		     IN optn : ARRAY OF CHAR; (* "/debug" or "" *)
-			    main : BOOLEAN); 	  (* /exe or /dll   *)
+                      IN optn : ARRAY OF CHAR; (* "/debug" or "" *)
+                         main : BOOLEAN); 	  (* /exe or /dll   *)
 
   PROCEDURE DoAsm*(IN file : ARRAY OF CHAR; 
 		   IN optn : ARRAY OF CHAR;	(* "/debug" or "" *)

gpcp/MsilMaker.cp

@@ -144,6 +144,7 @@ MODULE MsilMaker;
     Bi.MkDummyClass("String", blk, Ty.noAtt, str);
     Bi.SetPtrBase(str, obj);
     CSt.ntvStr := str.type;
+    CSt.ntvStrArr := Ty.mkArrayOf(str.type);
     Bi.MkDummyClass("Exception", blk, Ty.extns, exc);
     Bi.SetPtrBase(exc, obj);
     CSt.ntvExc := exc.type;

gpcp/NewSymFileRW.cp

@@ -470,7 +470,7 @@ MODULE NewSymFileRW;
      (*
       *   Emit Optional Parameter name 
       *)
-      IF ~CSt.legacy & (parI.hash # 0) THEN
+      IF (parI.hash # 0) THEN
         f.WriteStringForName(Nh.charOpenOfHash(parI.hash));
       END;
     END;
@@ -575,7 +575,7 @@ MODULE NewSymFileRW;
     f.Write(id.rcvFrm.parMod);
     f.EmitTypeOrd(id.rcvFrm.type);
     IF id.prcNm # NIL THEN f.WriteStringForName(id.prcNm) END; 
-    IF ~CSt.legacy & (id.rcvFrm.hash # 0) THEN f.WriteNameForId(id.rcvFrm) END;
+    IF (id.rcvFrm.hash # 0) THEN f.WriteNameForId(id.rcvFrm) END;
     f.FormalType(id.type(Ty.Procedure));
   END EmitMethodId;
 
@@ -1516,8 +1516,9 @@ MODULE NewSymFileRW;
     WHILE f.sSym = namSy DO
       fldD := Id.newFldId();
       fldD.SetMode(f.iAtt);
-      fldD.hash := Nh.enterStr(f.strAtt);
-      fldD.type := f.typeOf(readOrd(f.file));
+      fldD.hash  := Nh.enterStr(f.strAtt);
+      fldD.fldNm := BOX(f.strAtt^);
+      fldD.type  := f.typeOf(readOrd(f.file));
       fldD.recTyp := rslt;
       f.GetSym();
       IF rslt.symTb.enter(fldD.hash, fldD) THEN 

gpcp/OldSymFileRW.cp

@@ -1,2045 +0,0 @@
-(* ==================================================================== *)
-(*									*)
-(*  SymFileRW:  Symbol-file reading and writing for GPCP.		*)
-(*	Copyright (c) John Gough 1999, 2000.				*)
-(*									*)
-(* ==================================================================== *)
-
-MODULE OldSymFileRW;
-
-  IMPORT 
-        GPCPcopyright,
-        RTS,
-        Error,
-        Console,
-        GF := GPFiles,
-        BF := GPBinFiles,
-        Id := IdDesc,
-        D  := Symbols,
-        LitValue,
-        Visitor,
-        ExprDesc,
-        Ty := TypeDesc,
-        B  := Builtin,
-        S  := CPascalS,
-        G  := CompState,
-        Nh := NameHash,
-        FileNames;
-
-(* ========================================================================= *
-// Collected syntax ---
-// 
-// SymFile    = Header [String (falSy | truSy | <other attribute>)]
-//              [ VersionName ]
-//		{Import | Constant | Variable | Type | Procedure} 
-//		TypeList Key.
-//	-- optional String is external name.
-//	-- falSy ==> Java class
-//	-- truSy ==> Java interface
-//	-- others ...
-// Header     = magic modSy Name.
-// VersionName= numSy longint numSy longint numSy longint.
-//      --            mj# mn#       bld rv#    8xbyte extract
-// Import     = impSy Name [String] Key.
-//	-- optional string is explicit external name of class
-// Constant   = conSy Name Literal.
-// Variable   = varSy Name TypeOrd.
-// Type       = typSy Name TypeOrd.
-// Procedure  = prcSy Name [String] FormalType.
-//	-- optional string is explicit external name of procedure
-// Method     = mthSy Name byte byte TypeOrd [String] [Name] FormalType.
-//	-- optional string is explicit external name of method
-// FormalType = [retSy TypeOrd] frmSy {parSy byte TypeOrd [String]} endFm.
-//	-- optional phrase is return type for proper procedures
-// TypeOrd    = ordinal.
-// TypeHeader = tDefS Ord [fromS Ord Name].
-//	-- optional phrase occurs if:
-//	-- type not from this module, i.e. indirect export
-// TypeList   = start { Array | Record | Pointer | ProcType | 
-//                Enum | Vector | NamedType } close.
-// Array      = TypeHeader arrSy TypeOrd (Byte | Number | <empty>) endAr.
-//	-- nullable phrase is array length for fixed length arrays
-// Vector     = TypeHeader vecSy TypeOrd endAr.
-// Pointer    = TypeHeader ptrSy TypeOrd.
-// Event      = TypeHeader evtSy FormalType.
-// ProcType   = TypeHeader pTpSy FormalType.
-// Record     = TypeHeader recSy recAtt [truSy | falSy] 
-//		[basSy TypeOrd] [iFcSy {basSy TypeOrd}]
-//		{Name TypeOrd} {Method} {Statics} endRc.
-//	-- truSy ==> is an extension of external interface
-//	-- falSy ==> is an extension of external class
-// 	-- basSy option defines base type, if not ANY / j.l.Object
-// Statics    = ( Constant | Variable | Procedure ).
-// Enum       = TypeHeader eTpSy { Constant } endRc.
-// NamedType  = TypeHeader.
-// Name	      = namSy byte UTFstring.
-// Literal    = Number | String | Set | Char | Real | falSy | truSy.
-// Byte       = bytSy byte.
-// String     = strSy UTFstring.
-// Number     = numSy longint.
-// Real       = fltSy ieee-double.
-// Set        = setSy integer.
-// Key        = keySy integer..
-// Char       = chrSy unicode character.
-//
-// Notes on the syntax:
-// All record types must have a Name field, even though this is often
-// redundant.  The issue is that every record type (including those that
-// are anonymous in CP) corresponds to a IR class, and the definer 
-// and the user of the class _must_ agree on the IR name of the class.
-// The same reasoning applies to procedure types, which must have equal
-// interface names in all modules.
-// ======================================================================== *)
-
-  CONST
-        modSy = ORD('H'); namSy = ORD('$'); bytSy = ORD('\');
-        numSy = ORD('#'); chrSy = ORD('c'); strSy = ORD('s');
-        fltSy = ORD('r'); falSy = ORD('0'); truSy = ORD('1');
-        impSy = ORD('I'); setSy = ORD('S'); keySy = ORD('K');
-        conSy = ORD('C'); typSy = ORD('T'); tDefS = ORD('t');
-        prcSy = ORD('P'); retSy = ORD('R'); mthSy = ORD('M');
-        varSy = ORD('V'); parSy = ORD('p'); start = ORD('&');
-        close = ORD('!'); recSy = ORD('{'); endRc = ORD('}');
-        frmSy = ORD('('); fromS = ORD('@'); endFm = ORD(')');
-        arrSy = ORD('['); endAr = ORD(']'); pTpSy = ORD('%');
-        ptrSy = ORD('^'); basSy = ORD('+'); eTpSy = ORD('e');
-        iFcSy = ORD('~'); evtSy = ORD('v'); vecSy = ORD('*');
-
-  CONST
-        magic   = 0DEADD0D0H;
-        syMag   = 0D0D0DEADH;
-        dumped* = -1;
-
-(* ============================================================ *)
-
-  TYPE
-        SymFile = POINTER TO RECORD 
-        	    file : BF.FILE;
-        	    cSum : INTEGER;
-        	    modS : Id.BlkId;
-        	    iNxt : INTEGER;
-        	    oNxt : INTEGER;
-        	    work : D.TypeSeq;
-        	  END;
-
-  TYPE
-        SymFileReader* = POINTER TO RECORD
-        	    file  : BF.FILE;
-        	    modS  : Id.BlkId;
-        	    impS  : Id.BlkId;
-        	    sSym  : INTEGER;
-        	    cAtt  : CHAR;
-        	    iAtt  : INTEGER;
-        	    lAtt  : LONGINT;
-        	    rAtt  : REAL;
-        	    sAtt  : FileNames.NameString;
-                    oArray : D.IdSeq;
-        	    sArray : D.ScpSeq;		(* These two sequences	*)
-  		    tArray : D.TypeSeq;		(* must be private as   *)
-        	  END;				(* file parses overlap. *)
-
-(* ============================================================ *)
-
-  TYPE	TypeLinker*  = POINTER TO RECORD (D.SymForAll) sym : SymFileReader END;
-  TYPE	SymFileSFA*  = POINTER TO RECORD (D.SymForAll) sym : SymFile END;
-
-(* ============================================================ *)
-
-  VAR   lastKey : INTEGER;	(* private state for CPMake *)
-        fSepArr : ARRAY 2 OF CHAR;
-
-(* ============================================================ *)
-(* ========	     Import Stack Implementation	======= *)
-(* ============================================================ *)
-
-   VAR	stack	: ARRAY 32 OF Id.BlkId;
-        topIx	: INTEGER;
-
-   PROCEDURE InitStack;
-   BEGIN
-     topIx := 0; G.impMax := 0;
-   END InitStack;
-
-   PROCEDURE PushStack(b : Id.BlkId);
-   BEGIN
-     stack[topIx] := b; 
-     INC(topIx);
-     IF topIx > G.impMax THEN G.impMax := topIx END; 
-   END PushStack;
-
-   PROCEDURE PopStack;
-   BEGIN
-     DEC(topIx);
-   END PopStack;
-
-(* ============================================================ *)
-
-  PROCEDURE GetLastKeyVal*() : INTEGER;
-  BEGIN
-    RETURN lastKey;
-  END GetLastKeyVal;
-
-(* ============================================================ *)
-(* ========	Various writing utility procedures	======= *)
-(* ============================================================ *)
-
-  PROCEDURE newSymFile(mod : Id.BlkId) : SymFile;
-    VAR new : SymFile;
-  BEGIN
-    NEW(new);
-   (*
-    *  Initialization: cSum starts at zero. Since impOrd of
-    *  the module is zero, impOrd of the imports starts at 1.
-    *)
-    new.cSum := 0;
-    new.iNxt := 1;
-    new.oNxt := D.tOffset;
-    new.modS := mod;
-    D.InitTypeSeq(new.work, 32);
-    RETURN new;
-  END newSymFile;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)Write(chr : INTEGER),NEW;
-    VAR tmp : INTEGER;
-  BEGIN [UNCHECKED_ARITHMETIC]
-   (* need to turn off overflow checking here *)
-    tmp := f.cSum * 2 + chr;
-    IF f.cSum < 0 THEN INC(tmp) END;
-    f.cSum := tmp;
-    BF.WriteByte(f.file, chr);
-  END Write;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)WriteStrUTF(IN nam : ARRAY OF CHAR),NEW;
-    VAR buf : ARRAY 256 OF INTEGER;
-        num : INTEGER;
-        idx : INTEGER;
-        chr : INTEGER;
-  BEGIN
-    num := 0;
-    idx := 0;
-    chr := ORD(nam[idx]);
-    WHILE chr # 0H DO
-      IF    chr <= 7FH THEN 		(* [0xxxxxxx] *)
-        buf[num] := chr; INC(num);
-      ELSIF chr <= 7FFH THEN 		(* [110xxxxx,10xxxxxx] *)
-        buf[num+1] := 080H + chr MOD 64; chr := chr DIV 64;
-        buf[num  ] := 0C0H + chr; INC(num, 2);
-      ELSE 				(* [1110xxxx,10xxxxxx,10xxxxxxx] *)
-        buf[num+2] := 080H + chr MOD 64; chr := chr DIV 64;
-        buf[num+1] := 080H + chr MOD 64; chr := chr DIV 64;
-        buf[num  ] := 0E0H + chr; INC(num, 3);
-      END;
-      INC(idx); chr := ORD(nam[idx]);
-    END;
-    f.Write(num DIV 256);
-    f.Write(num MOD 256);
-    FOR idx := 0 TO num-1 DO f.Write(buf[idx]) END;
-  END WriteStrUTF;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)WriteOpenUTF(chOp : LitValue.CharOpen),NEW;
-    VAR buf : ARRAY 256 OF INTEGER;
-        num : INTEGER;
-        idx : INTEGER;
-        chr : INTEGER;
-  BEGIN
-    num := 0;
-    idx := 0;
-    chr := ORD(chOp[0]);
-    WHILE chr # 0H DO
-      IF    chr <= 7FH THEN 		(* [0xxxxxxx] *)
-        buf[num] := chr; INC(num);
-      ELSIF chr <= 7FFH THEN 		(* [110xxxxx,10xxxxxx] *)
-        buf[num+1] := 080H + chr MOD 64; chr := chr DIV 64;
-        buf[num  ] := 0C0H + chr; INC(num, 2);
-      ELSE 				(* [1110xxxx,10xxxxxx,10xxxxxxx] *)
-        buf[num+2] := 080H + chr MOD 64; chr := chr DIV 64;
-        buf[num+1] := 080H + chr MOD 64; chr := chr DIV 64;
-        buf[num  ] := 0E0H + chr; INC(num, 3);
-      END;
-      INC(idx);
-      chr := ORD(chOp[idx]);
-    END;
-    f.Write(num DIV 256);
-    f.Write(num MOD 256);
-    FOR idx := 0 TO num-1 DO f.Write(buf[idx]) END;
-  END WriteOpenUTF;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)WriteString(IN nam : ARRAY OF CHAR),NEW;
-  BEGIN
-    f.Write(strSy); 
-    f.WriteStrUTF(nam);
-  END WriteString;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)WriteName(idD : D.Idnt),NEW;
-  BEGIN
-    f.Write(namSy); 
-    f.Write(idD.vMod); 
-    f.WriteOpenUTF(Nh.charOpenOfHash(idD.hash));
-  END WriteName;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)WriteChar(chr : CHAR),NEW;
-    CONST mask = {0 .. 7};
-    VAR   a,b,int : INTEGER;
-  BEGIN
-    f.Write(chrSy);
-    int := ORD(chr);
-    b := ORD(BITS(int) * mask); int := ASH(int, -8);
-    a := ORD(BITS(int) * mask); 
-    f.Write(a); 
-    f.Write(b); 
-  END WriteChar;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)Write4B(int : INTEGER),NEW;
-    CONST mask = {0 .. 7};
-    VAR   a,b,c,d : INTEGER;
-  BEGIN
-    d := ORD(BITS(int) * mask); int := ASH(int, -8);
-    c := ORD(BITS(int) * mask); int := ASH(int, -8);
-    b := ORD(BITS(int) * mask); int := ASH(int, -8);
-    a := ORD(BITS(int) * mask); 
-    f.Write(a); 
-    f.Write(b); 
-    f.Write(c); 
-    f.Write(d); 
-  END Write4B;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)Write8B(val : LONGINT),NEW;
-  BEGIN
-    f.Write4B(RTS.hiInt(val));
-    f.Write4B(RTS.loInt(val));
-  END Write8B;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)WriteNum(val : LONGINT),NEW;
-  BEGIN
-    f.Write(numSy);
-    f.Write8B(val);
-  END WriteNum;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)WriteReal(flt : REAL),NEW;
-    VAR rslt : LONGINT;
-  BEGIN
-    f.Write(fltSy);
-    rslt := RTS.realToLongBits(flt);
-    f.Write8B(rslt);
-  END WriteReal;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)WriteOrd(ord : INTEGER),NEW;
-  BEGIN
-    IF ord <= 7FH THEN 
-      f.Write(ord);
-    ELSIF ord <= 7FFFH THEN
-      f.Write(128 + ord MOD 128);	(* LS7-bits first *)
-      f.Write(ord DIV 128);		(* MS8-bits next  *)
-    ELSE
-      ASSERT(FALSE);
-    END;
-  END WriteOrd;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)EmitTypeOrd(t : D.Type),NEW;
-  (*
-   *  This proceedure facilitates the naming rules
-   *  for records and (runtime) classes: -
-   *
-   *  (1)  Classes derived from named record types have
-   *       names synthesized from the record typename.
-   *  (2)  If a named pointer is bound to an anon record
-   *       the class takes its name from the pointer name.
-   *  (3)  If both the pointer and the record types have
-   *       names, the class is named from the record.
-   *)
-    VAR recT : Ty.Record;
-   (* ------------------------------------ *)
-    PROCEDURE AddToWorklist(syF :SymFile; tyD : D.Type);
-    BEGIN
-      tyD.dump := syF.oNxt; INC(syF.oNxt);
-      D.AppendType(syF.work, tyD);
-      IF tyD.idnt = NIL THEN 
-        tyD.idnt := Id.newSfAnonId(tyD.dump);
-        tyD.idnt.type := tyD;
-      END;
-    END AddToWorklist;
-   (* ------------------------------------ *)
-  BEGIN
-    IF t.dump = 0 THEN (* type is not dumped yet *)
-      WITH t : Ty.Record DO
-       (*
-        *   We wish to ensure that anonymous records are
-        *   never emitted before their binding pointer
-        *   types.  This ensures that we do not need to
-        *   merge types when reading the files.
-        *)
-        IF (t.bindTp # NIL) & 
-           (t.bindTp.dump = 0) THEN 
-          AddToWorklist(f, t.bindTp);		(* First the pointer...  *)
-        END;
-        AddToWorklist(f, t);			(* Then this record type *)
-      | t : Ty.Pointer DO
-       (*
-        *  If a pointer to record is being emitted, and 
-        *  the pointer is NOT anonymous, then the class
-        *  is known by the name of the record.  Thus the
-        *  record name must be emitted, at least opaquely.
-        *  Furthermore, we must indicate the binding
-        *  relationship between the pointer and record.
-        *  (It is possible that DCode need record size.)
-        *)
-        AddToWorklist(f, t);			(* First this pointer... *)
-        IF (t.boundTp # NIL) & 
-           (t.boundTp.dump = 0) &
-           (t.boundTp IS Ty.Record) THEN
-          recT := t.boundTp(Ty.Record);
-          IF recT.bindTp = NIL THEN
-            t.force := D.forced;
-            AddToWorklist(f, t.boundTp);	(* Then the record type  *)
-          END;
-        END;
-      ELSE (* All others *)
-        AddToWorklist(f, t);			(* Just add the type.    *)
-      END;
-    END;
-    f.WriteOrd(t.dump);
-  END EmitTypeOrd;
-
-(* ============================================================ *)
-(* ========	    Various writing procedures		======= *)
-(* ============================================================ *)
-
-  PROCEDURE (f : SymFile)FormalType(t : Ty.Procedure),NEW;
-  (*
-  ** FormalType = [retSy TypeOrd] frmSy {parSy Byte TypeOrd [String]} endFm.
-  *)
-    VAR indx : INTEGER;
-        parI : Id.ParId;
-  BEGIN
-    IF t.retType # NIL THEN
-      f.Write(retSy);
-      f.EmitTypeOrd(t.retType);
-     (*
-      *   The structure of this type must be
-      *   emitted, unless it is an imported type.
-      *)
-      t.retType.ConditionalMark();
-    END;
-    f.Write(frmSy);
-    FOR indx := 0 TO t.formals.tide-1 DO
-      parI := t.formals.a[indx];
-      f.Write(parSy);
-      f.Write(parI.parMod);
-      f.EmitTypeOrd(parI.type);
-     (*
-      *   Emit Optional Parameter name 
-      *)
-      IF ~G.legacy & (parI.hash # 0) THEN
-        f.WriteString(Nh.charOpenOfHash(parI.hash));
-      END;
-     (*
-      *   The structure of this type must be
-      *   emitted, unless it is an imported type.
-      *)
-      parI.type.ConditionalMark();
-    END;
-    f.Write(endFm);
-  END FormalType;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)EmitConstId(id : Id.ConId),NEW;
-    VAR conX : ExprDesc.LeafX;
-        cVal : LitValue.Value;
-        sVal : INTEGER;
-  (*
-  ** Constant = conSy Name Literal.
-  ** Literal  = Number | String | Set | Char | Real | falSy | truSy.
-  *)
-  BEGIN
-    conX := id.conExp(ExprDesc.LeafX);
-    cVal := conX.value;
-    f.Write(conSy);
-    f.WriteName(id);
-    CASE conX.kind OF
-    | ExprDesc.tBool  : f.Write(truSy);
-    | ExprDesc.fBool  : f.Write(falSy);
-    | ExprDesc.numLt  : f.WriteNum(cVal.long());
-    | ExprDesc.charLt : f.WriteChar(cVal.char());
-    | ExprDesc.realLt : f.WriteReal(cVal.real());
-    | ExprDesc.strLt  : f.WriteString(cVal.chOpen());
-    | ExprDesc.setLt  : 
-        f.Write(setSy); 
-        IF cVal # NIL THEN sVal := cVal.int() ELSE sVal := 0 END;
-        f.Write4B(sVal);
-    END;
-  END EmitConstId;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)EmitTypeId(id : Id.TypId),NEW;
-  (*
-  **  Type = TypeSy Name TypeOrd.
-  *)
-  BEGIN
-    f.Write(typSy);
-    f.WriteName(id);
-    f.EmitTypeOrd(id.type);
-   (*
-    *   The structure of this type must be
-    *   emitted, even if it is an imported type.
-    *)
-    id.type.UnconditionalMark();
-  END EmitTypeId;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)EmitVariableId(id : Id.VarId),NEW;
-  (*
-  ** Variable = varSy Name TypeOrd.
-  *)
-  BEGIN
-    f.Write(varSy);
-    f.WriteName(id);
-    f.EmitTypeOrd(id.type);
-   (*
-    *   The structure of this type must be
-    *   emitted, unless it is an imported type.
-    *)
-    id.type.ConditionalMark();
-  END EmitVariableId;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)EmitImportId(id : Id.BlkId),NEW;
-  (*
-  ** Import = impSy Name.
-  *)
-  BEGIN
-    IF D.need IN id.xAttr THEN
-      f.Write(impSy);
-      f.WriteName(id);
-      IF id.scopeNm # NIL THEN f.WriteString(id.scopeNm) END;
-      f.Write(keySy);
-      f.Write4B(id.modKey);
-      id.impOrd := f.iNxt; INC(f.iNxt);
-    END;
-  END EmitImportId;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)EmitProcedureId(id : Id.PrcId),NEW;
-  (*
-  ** Procedure = prcSy Name FormalType.
-  *)
-  BEGIN
-    f.Write(prcSy);
-    f.WriteName(id);
-    IF id.prcNm # NIL THEN f.WriteString(id.prcNm) END;
-    IF id.kind = Id.ctorP THEN f.Write(truSy) END;
-    f.FormalType(id.type(Ty.Procedure));
-  END EmitProcedureId;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)EmitMethodId(id : Id.MthId),NEW;
-  (*
-  ** Method = mthSy Name Byte Byte TypeOrd [strSy ] FormalType.
-  *)
-  BEGIN
-    IF id.kind = Id.fwdMth THEN id := id.resolve(Id.MthId) END;
-    f.Write(mthSy);
-    f.WriteName(id);
-    f.Write(ORD(id.mthAtt));
-    f.Write(id.rcvFrm.parMod);
-    f.EmitTypeOrd(id.rcvFrm.type);
-    IF id.prcNm # NIL THEN f.WriteString(id.prcNm) END;
-    IF ~G.legacy & (id.rcvFrm.hash # 0) THEN f.WriteName(id.rcvFrm) END;
-    f.FormalType(id.type(Ty.Procedure));
-  END EmitMethodId;
-
-(* ======================================= *)
-
-  PROCEDURE moduleOrd(tpId : D.Idnt) : INTEGER;
-    VAR impM : Id.BlkId;
-  BEGIN
-    IF  (tpId = NIL) OR 
-        (tpId.dfScp = NIL) OR 
-        (tpId.dfScp.kind = Id.modId) THEN
-      RETURN 0;
-    ELSE
-      impM := tpId.dfScp(Id.BlkId);
-      IF impM.impOrd = 0 THEN RETURN -1 ELSE RETURN impM.impOrd END;
-    END;
-  END moduleOrd;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)EmitTypeHeader(t : D.Type),NEW;
-  (*
-  **  TypeHeader = typSy Ord [fromS Ord Name].
-  *)
-    VAR mod : INTEGER;
-        idt : D.Idnt;
-   (* =================================== *)
-    PROCEDURE warp(id : D.Idnt) : D.Idnt;
-    BEGIN
-      IF    id.type = G.ntvObj THEN RETURN G.objId;
-      ELSIF id.type = G.ntvStr THEN RETURN G.strId;
-      ELSIF id.type = G.ntvExc THEN RETURN G.excId;
-      ELSIF id.type = G.ntvTyp THEN RETURN G.clsId;
-      ELSE  RETURN NIL;
-      END;
-    END warp;
-   (* =================================== *)
-  BEGIN
-    WITH t : Ty.Record DO
-      IF t.bindTp = NIL THEN 
-        idt := t.idnt;
-      ELSIF t.bindTp.dump = 0 THEN
-        ASSERT(FALSE);
-        idt := NIL;
-      ELSE
-        idt := t.bindTp.idnt;
-      END;
-    ELSE
-      idt := t.idnt;
-    END;
-    mod := moduleOrd(t.idnt);
-    f.Write(tDefS);
-    f.WriteOrd(t.dump);
-   (*
-    *  Convert native types back to RTS.nativeXXX, if necessary.
-    *  That is ... if the native module is not explicitly imported.
-    *)
-    IF mod = -1 THEN idt := warp(idt); mod := moduleOrd(idt) END;
-    IF mod # 0 THEN
-      f.Write(fromS);
-      f.WriteOrd(mod);
-      f.WriteName(idt);
-    END;
-  END EmitTypeHeader;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)EmitArrOrVecType(t : Ty.Array),NEW;
-  BEGIN
-    f.EmitTypeHeader(t);
-    IF t.force # D.noEmit THEN	(* Don't emit structure unless forced *)
-      IF t.kind = Ty.vecTp THEN f.Write(vecSy) ELSE f.Write(arrSy) END;
-      f.EmitTypeOrd(t.elemTp);
-      IF t.length > 127 THEN
-        f.Write(numSy);
-        f.Write8B(t.length);
-      ELSIF t.length > 0 THEN
-        f.Write(bytSy);
-        f.Write(t.length);
-      END;
-      f.Write(endAr);
-    END;
-  END EmitArrOrVecType;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)EmitRecordType(t : Ty.Record),NEW;
-    VAR index  : INTEGER;
-        field  : D.Idnt;
-        method : D.Idnt;
-  (*
-  **  Record = TypeHeader recSy recAtt [truSy | falSy | <others>] 
-  **		[basSy TypeOrd] [iFcSy {basSy TypeOrd}]
-  **		{Name TypeOrd} {Method} {Statics} endRc.
-  *)
-  BEGIN
-    f.EmitTypeHeader(t);
-    IF t.force # D.noEmit THEN	(* Don't emit structure unless forced *)
-      f.Write(recSy);
-      index := t.recAtt; 
-      IF D.noNew IN t.xAttr THEN INC(index, Ty.noNew) END;
-      IF D.clsTp IN t.xAttr THEN INC(index, Ty.clsRc) END;
-      f.Write(index);
-   (* ########## *)
-      IF t.recAtt = Ty.iFace THEN
-  	f.Write(truSy);
-      ELSIF G.special OR (D.isFn IN t.xAttr) THEN  
-        f.Write(falSy);
-      END;
-   (* ########## *)
-      IF t.baseTp # NIL THEN			(* this is the parent type *)
-        f.Write(basSy);
-        f.EmitTypeOrd(t.baseTp);
-      END;
-   (* ########## *)
-      IF t.interfaces.tide > 0 THEN
-        f.Write(iFcSy);
-        FOR index := 0 TO t.interfaces.tide-1 DO	(* any interfaces  *)
-          f.Write(basSy);
-          f.EmitTypeOrd(t.interfaces.a[index]);
-        END;
-      END;
-   (* ########## *)
-      FOR index := 0 TO t.fields.tide-1 DO
-        field := t.fields.a[index];
-        IF field.vMod # D.prvMode THEN
-          f.WriteName(field);
-          f.EmitTypeOrd(field.type);
-        END;
-      END;
-      IF t.force = D.forced THEN  (* Don't emit methods unless forced *)
-        FOR index := 0 TO t.methods.tide-1 DO
-          method := t.methods.a[index];
-          IF method.vMod # D.prvMode THEN
-            f.EmitMethodId(method(Id.MthId));
-          END;
-        END;
-(*
- *      IF G.special THEN  (* we might need to emit static stuff *)
- *
- *  From 1.2.0 this provides for contructors that do not
- *  extend imported foreign record types.
- *)
-          FOR index := 0 TO t.statics.tide-1 DO
-            field := t.statics.a[index];
-            IF field.vMod # D.prvMode THEN
-              CASE field.kind OF
-              | Id.conId  : f.EmitConstId(field(Id.ConId));
-              | Id.varId  : f.EmitVariableId(field(Id.VarId));
-              | Id.ctorP,
-                Id.conPrc : f.EmitProcedureId(field(Id.PrcId));
-              END;
-            END;
-          END;
-        END;
-(*
- *    END;
- *)
-      f.Write(endRc);
-    END;
-    D.AppendType(f.modS.expRecs, t);
-  END EmitRecordType;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)EmitEnumType(t : Ty.Enum),NEW;
-    VAR index  : INTEGER;
-        const  : D.Idnt;
-  (*
-  **  Enum = TypeHeader eTpSy { constant } endRc.
-  *)
-  BEGIN
-    f.EmitTypeHeader(t);
-    f.Write(eTpSy);
-    FOR index := 0 TO t.statics.tide-1 DO
-      const := t.statics.a[index];
-      IF const.vMod # D.prvMode THEN f.EmitConstId(const(Id.ConId)) END;
-    END;
-    f.Write(endRc);
-    (* D.AppendType(f.modS.expRecs, t); *)
-  END EmitEnumType;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)EmitOpaqueType(t : Ty.Opaque),NEW;
-  BEGIN
-    f.EmitTypeHeader(t);
-  END EmitOpaqueType;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)EmitPointerType(t : Ty.Pointer),NEW;
-  BEGIN
-    f.EmitTypeHeader(t);
-    IF (t.force # D.noEmit) OR 			(* Only emit structure if *)
-       (t.boundTp.force # D.noEmit) THEN	(* ptr or boundTp forced. *)
-      f.Write(ptrSy);
-      f.EmitTypeOrd(t.boundTp);
-    END;
-  END EmitPointerType;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)EmitProcedureType(t : Ty.Procedure),NEW;
-  BEGIN
-    f.EmitTypeHeader(t);
-    IF t.isEventType() THEN f.Write(evtSy) ELSE f.Write(pTpSy) END;
-    f.FormalType(t);
-    D.AppendType(f.modS.expRecs, t);
-  END EmitProcedureType;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)EmitTypeList(),NEW;
-    VAR indx : INTEGER;
-        type : D.Type;
-  BEGIN
-   (*
-    *   We cannot use a FOR loop here, as the tide changes
-    *   during evaluation, as a result of reaching new types.
-    *)
-    indx := 0;
-    WHILE indx < f.work.tide DO
-      type := f.work.a[indx];
-
-      WITH type : Ty.Array     DO f.EmitArrOrVecType(type);
-      |    type : Ty.Record    DO f.EmitRecordType(type);
-      |    type : Ty.Opaque    DO f.EmitOpaqueType(type);
-      |    type : Ty.Pointer   DO f.EmitPointerType(type);
-      |    type : Ty.Procedure DO f.EmitProcedureType(type);
-      |    type : Ty.Enum      DO f.EmitEnumType(type);
-      END;
-      INC(indx);
-    END;
-  END EmitTypeList;
-
-(* ======================================= *)
-
-  PROCEDURE EmitSymfile*(m : Id.BlkId);
-
-    VAR symVisit : SymFileSFA;
-        symfile  : SymFile;
-        marker   : INTEGER;
-(*
- *      fileName : FileNames.NameString;
- *)
-        fNamePtr : LitValue.CharOpen;
-  (* ----------------------------------- *)
-    PROCEDURE mkPathName(m : D.Idnt) : LitValue.CharOpen;
-      VAR str : LitValue.CharOpen;
-    BEGIN
-      str := BOX(G.symDir);
-      IF str[LEN(str) - 2] = GF.fileSep THEN
-        str := BOX(str^ + D.getName.ChPtr(m)^ + ".cps");
-      ELSE
-        str := BOX(str^ + fSepArr + D.getName.ChPtr(m)^ + ".cps");
-      END;
-      RETURN str;
-    END mkPathName;
-  (* ----------------------------------- *)
-  (*
-  ** SymFile = Header [String (falSy | truSy | <others>)]
-  **            [ VersionName]
-  **		{Import | Constant | Variable
-  **                 | Type | Procedure | Method} TypeList.
-  ** Header = magic modSy Name.
-  ** VersionName= numSy longint numSy longint numSy longint.
-  **      --            mj# mn#       bld rv#        8xbyte extract
-  *)
-  BEGIN
-   (*
-    *  Create the SymFile structure, and open the output file.
-    *)
-    symfile := newSymFile(m);
-   (* Start of alternative gpcp1.2 code *)
-    IF G.symDir # "" THEN
-      fNamePtr := mkPathName(m);
-      symfile.file := BF.createPath(fNamePtr);
-    ELSE
-      fNamePtr := BOX(D.getName.ChPtr(m)^ + ".cps");
-      symfile.file := BF.createFile(fNamePtr);
-    END;
-    IF symfile.file = NIL THEN
-      S.SemError.Report(177, 0, 0);
-      Error.WriteString("Cannot create file <" + fNamePtr^ + ">"); 
-      Error.WriteLn;
-      RETURN;
-    ELSE
-     (*
-      *  Emit the symbol file header
-      *)
-      IF G.verbose THEN G.Message("Created " + fNamePtr^) END;
-     (* End of alternative gpcp1.2 code *)
-      IF D.rtsMd IN m.xAttr THEN
-        marker := RTS.loInt(syMag);	(* ==> a system module *)
-      ELSE
-        marker := RTS.loInt(magic);	(* ==> a normal module *)
-      END;
-      symfile.Write4B(RTS.loInt(marker));
-      symfile.Write(modSy);
-      symfile.WriteName(m);
-      IF m.scopeNm # NIL THEN (* explicit name *)
-        symfile.WriteString(m.scopeNm);
-        symfile.Write(falSy);
-      END;
-     (*
-      *  Emit the optional TypeName, if required.
-      *
-      *  VersionName= numSy longint numSy longint numSy longint.
-      *       --            mj# mn#       bld rv#        8xbyte extract
-      *)
-      IF m.verNm # NIL THEN
-        symfile.WriteNum(m.verNm[0] * 100000000L + m.verNm[1]);
-        symfile.WriteNum(m.verNm[2] * 100000000L + m.verNm[3]);
-        symfile.WriteNum(m.verNm[4] * 100000000L + m.verNm[5]);
-      END;
-     (*
-      *  Create the symbol table visitor, an extension of 
-      *  Symbols.SymForAll type.  Emit symbols from the scope.
-      *)
-      NEW(symVisit);
-      symVisit.sym := symfile;
-      symfile.modS.symTb.Apply(symVisit); 
-     (*
-      *  Now emit the types on the worklist.
-      *)
-      symfile.Write(start);
-      symfile.EmitTypeList();
-      symfile.Write(close);
-     (*
-      *  Now emit the accumulated checksum key symbol.
-      *)
-      symfile.Write(keySy);
-      lastKey := symfile.cSum;
-      IF G.special THEN symfile.Write4B(0) ELSE symfile.Write4B(lastKey) END;
-      BF.CloseFile(symfile.file);
-    END;
-  END EmitSymfile;
-
-(* ============================================================ *)
-(* ========	Various reading utility procedures	======= *)
-(* ============================================================ *)
-
-  PROCEDURE read(f : BF.FILE) : INTEGER;
-  BEGIN
-    RETURN BF.readByte(f);
-  END read;
-
-(* ======================================= *)
-
-  PROCEDURE ReadUTF(f : BF.FILE; OUT nam : ARRAY OF CHAR);
-    CONST
-        bad = "Bad UTF-8 string";
-    VAR num : INTEGER;
-        bNm : INTEGER;
-        idx : INTEGER;
-        chr : INTEGER;
-  BEGIN
-    num := 0;
-    bNm := read(f) * 256 + read(f);
-    FOR idx := 0 TO bNm-1 DO
-      chr := read(f);
-      IF chr <= 07FH THEN		(* [0xxxxxxx] *)
-        nam[num] := CHR(chr); INC(num);
-      ELSIF chr DIV 32 = 06H THEN	(* [110xxxxx,10xxxxxx] *)
-        bNm := chr MOD 32 * 64;
-        chr := read(f);
-        IF chr DIV 64 = 02H THEN
-          nam[num] := CHR(bNm + chr MOD 64); INC(num);
-        ELSE
-          RTS.Throw(bad);
-        END;
-      ELSIF chr DIV 16 = 0EH THEN	(* [1110xxxx,10xxxxxx,10xxxxxxx] *)
-        bNm := chr MOD 16 * 64;
-        chr := read(f);
-        IF chr DIV 64 = 02H THEN
-          bNm := (bNm + chr MOD 64) * 64; 
-          chr := read(f);
-          IF chr DIV 64 = 02H THEN
-            nam[num] := CHR(bNm + chr MOD 64); INC(num);
-          ELSE 
-            RTS.Throw(bad);
-          END;
-        ELSE
-          RTS.Throw(bad);
-        END;
-      ELSE
-        RTS.Throw(bad);
-      END;
-    END;
-    nam[num] := 0X;
-  END ReadUTF;
-
-(* ======================================= *)
-
-  PROCEDURE readChar(f : BF.FILE) : CHAR;
-  BEGIN
-    RETURN CHR(read(f) * 256 + read(f));
-  END readChar;
-
-(* ======================================= *)
-
-  PROCEDURE readInt(f : BF.FILE) : INTEGER;
-  BEGIN [UNCHECKED_ARITHMETIC]
-    (* overflow checking off here *)
-    RETURN ((read(f) * 256 + read(f)) * 256 + read(f)) * 256 + read(f);
-  END readInt;
-
-(* ======================================= *)
-
-  PROCEDURE readLong(f : BF.FILE) : LONGINT;
-    VAR result : LONGINT;
-        index  : INTEGER;
-  BEGIN [UNCHECKED_ARITHMETIC]
-    (* overflow checking off here *)
-    result := read(f);
-    FOR index := 1 TO 7 DO
-      result := result * 256 + read(f);
-    END;
-    RETURN result;
-  END readLong;
-
-(* ======================================= *)
-
-  PROCEDURE readReal(f : BF.FILE) : REAL;
-    VAR result : LONGINT;
-  BEGIN
-    result := readLong(f);
-    RETURN RTS.longBitsToReal(result);
-  END readReal;
-
-(* ======================================= *)
-
-  PROCEDURE readOrd(f : BF.FILE) : INTEGER;
-    VAR chr : INTEGER;
-  BEGIN
-    chr := read(f);
-    IF chr <= 07FH THEN RETURN chr;
-    ELSE
-      DEC(chr, 128);
-      RETURN chr + read(f) * 128;
-    END;
-  END readOrd;
-
-(* ============================================================ *)
-(* ========		Symbol File Reader		======= *)
-(* ============================================================ *)
-
-  PROCEDURE newSymFileReader*(mod : Id.BlkId) : SymFileReader;
-    VAR new : SymFileReader;
-  BEGIN
-    NEW(new);
-    new.modS := mod;
-    D.InitIdSeq(new.oArray, 4);
-    D.InitTypeSeq(new.tArray, 8);
-    D.InitScpSeq(new.sArray, 8);
-    RETURN new;
-  END newSymFileReader;
-
-(* ======================================= *)
-  PROCEDURE^ (f : SymFileReader)SymFile(IN nm : ARRAY OF CHAR),NEW;
-  PROCEDURE^ WalkThisImport(imp, mod : Id.BlkId);
-(* ======================================= *)
-
-  PROCEDURE Abandon(f : SymFileReader);
-  BEGIN
-    RTS.Throw("Bad symbol file format" + 
-              Nh.charOpenOfHash(f.impS.hash)^); 
-  END Abandon;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFileReader)GetSym(),NEW;
-    VAR file : BF.FILE;
-  BEGIN
-    file := f.file;
-    f.sSym := read(file);
-    CASE f.sSym OF
-    | namSy : 
-        f.iAtt := read(file); ReadUTF(file, f.sAtt);
-    | strSy : 
-        ReadUTF(file, f.sAtt);
-    | retSy, fromS, tDefS, basSy :
-        f.iAtt := readOrd(file);
-    | bytSy :
-        f.iAtt := read(file);
-    | keySy, setSy :
-        f.iAtt := readInt(file);
-    | numSy :
-        f.lAtt := readLong(file);
-    | fltSy :
-        f.rAtt := readReal(file);
-    | chrSy :
-        f.cAtt := readChar(file);
-    ELSE (* nothing to do *)
-    END;
-  END GetSym;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFileReader)ReadPast(sym : INTEGER),NEW;
-  BEGIN
-    IF f.sSym # sym THEN Abandon(f) END;
-    f.GetSym();
-  END ReadPast;
-
-(* ======================================= *)
-
-  PROCEDURE (f : SymFileReader)Parse*(scope : Id.BlkId;
-                                      filNm : FileNames.NameString),NEW;
-    VAR fileName : FileNames.NameString;
-        marker   : INTEGER;
-        token    : S.Token;
-  BEGIN
-    token := scope.token;
-
-    f.impS := scope;
-    D.AppendScope(f.sArray, scope);
-    fileName := filNm + ".cps";
-    f.file := BF.findOnPath("CPSYM", fileName);
-   (* #### *)
-    IF f.file = NIL THEN
-      fileName := "__" + fileName;
-      f.file := BF.findOnPath("CPSYM", fileName);
-      IF f.file # NIL THEN
-        S.SemError.RepSt2(309, filNm, fileName, token.lin, token.col);
-        filNm := "__" + filNm;
-        scope.clsNm := LitValue.strToCharOpen(filNm);
-      END;
-    END;
-   (* #### *)
-    IF f.file = NIL THEN
-      S.SemError.Report(129, token.lin, token.col); RETURN;
-    ELSE
-      IF G.verbose THEN G.Message("Opened " + fileName) END;
-      marker := readInt(f.file);
-      IF marker = RTS.loInt(magic) THEN
-        (* normal case, nothing to do *)
-      ELSIF marker = RTS.loInt(syMag) THEN
-        INCL(scope.xAttr, D.rtsMd);
-      ELSE
-        S.SemError.Report(130, token.lin, token.col); RETURN;
-      END;
-      f.GetSym();
-      f.SymFile(filNm);
-      IF G.verbose THEN 
-        G.Message("Ended " + fileName + ", Key: " 
-        		+ LitValue.intToCharOpen(f.impS.modKey)^);
-      END;
-      BF.CloseFile(f.file);
-    END;
-  END Parse;
-
-(* ============================================ *)
-
-  PROCEDURE testInsert(id : D.Idnt; sc : D.Scope) : D.Idnt;
-    VAR ident : D.Idnt;
-
-    PROCEDURE Report(i,s : D.Idnt);
-      VAR iS, sS : FileNames.NameString;
-    BEGIN
-      D.getName.Of(i, iS);
-      D.getName.Of(s, sS);
-      S.SemError.RepSt2(172, iS, sS, S.line, S.col);
-    END Report;
-
-  BEGIN
-    IF sc.symTb.enter(id.hash, id) THEN
-      ident := id;
-    ELSE
-      ident := sc.symTb.lookup(id.hash);	(* Warp the return Idnt	*)
-      IF ident.kind # id.kind THEN Report(id, sc); ident := id END;
-    END;
-    RETURN ident;
-  END testInsert;
-
-(* ============================================ *)
-
-  PROCEDURE Insert(id : D.Idnt; VAR tb : D.SymbolTable);
-    VAR ident : D.Idnt;
-
-    PROCEDURE Report(i : D.Idnt);
-      VAR iS : FileNames.NameString;
-    BEGIN
-      D.getName.Of(i, iS);
-      S.SemError.RepSt1(172, iS, 1, 1);
-    END Report;
-
-  BEGIN
-    IF ~tb.enter(id.hash, id) THEN
-      ident := tb.lookup(id.hash);		(* and test isForeign? *)
-      IF ident.kind # id.kind THEN Report(id) END;
-    END;
-  END Insert;
-
-(* ============================================ *)
- 
-  PROCEDURE InsertInRec(id : D.Idnt; rec : Ty.Record; sfr : SymFileReader);
-  (* insert, taking into account possible overloaded methods. *)
-  VAR
-    ok : BOOLEAN;
-    oId : Id.OvlId;
-
-    PROCEDURE Report(i : D.Idnt; IN s : ARRAY OF CHAR);
-      VAR iS, sS : FileNames.NameString;
-    BEGIN
-      D.getName.Of(i, iS);
-(*
- *    D.getName.Of(s, sS);
- *    S.SemError.RepSt2(172, iS, sS, S.line, S.col);
- *)
-      S.SemError.RepSt2(172, iS, s, S.line, S.col);
-    END Report;
-
-  BEGIN
-    Ty.InsertInRec(id,rec,TRUE,oId,ok);
-    IF oId # NIL THEN D.AppendIdnt(sfr.oArray,oId); END;
-(*
-    IF ~ok THEN Report(id,rec.idnt); END;
- *)
-    IF ~ok THEN Report(id, rec.name()) END;
-  END InsertInRec;
-
-(* ============================================ *)
-
-  PROCEDURE (f : SymFileReader)getLiteral() : D.Expr,NEW;
-    VAR expr : D.Expr;
-  BEGIN
-    CASE f.sSym OF
-    | truSy : expr := ExprDesc.mkTrueX();
-    | falSy : expr := ExprDesc.mkFalseX();
-    | numSy : expr := ExprDesc.mkNumLt(f.lAtt);
-    | chrSy : expr := ExprDesc.mkCharLt(f.cAtt);
-    | fltSy : expr := ExprDesc.mkRealLt(f.rAtt);
-    | setSy : expr := ExprDesc.mkSetLt(BITS(f.iAtt));
-    | strSy : expr := ExprDesc.mkStrLt(f.sAtt);		(* implicit f.sAtt^ *)
-    END;
-    f.GetSym();						(* read past value  *)
-    RETURN expr;
-  END getLiteral;
-
-(* ============================================ *)
-
-  PROCEDURE (f : SymFileReader)typeOf(ord : INTEGER) : D.Type,NEW;
-    VAR newT : D.Type;
-        indx : INTEGER;
-  BEGIN
-    IF ord < D.tOffset THEN				(* builtin type	*)	
-      RETURN B.baseTypeArray[ord];
-    ELSIF ord - D.tOffset < f.tArray.tide THEN
-      RETURN f.tArray.a[ord - D.tOffset];
-    ELSE 
-      indx := f.tArray.tide + D.tOffset;
-      REPEAT
-        newT := Ty.newTmpTp();
-        newT.dump := indx; INC(indx);
-        D.AppendType(f.tArray, newT);
-      UNTIL indx > ord;
-      RETURN newT;
-    END;
-  END typeOf;
-
-(* ============================================ *)
-
-  PROCEDURE (f : SymFileReader)getTypeFromOrd() : D.Type,NEW;
-    VAR ord : INTEGER;
-  BEGIN
-    ord := readOrd(f.file);
-    f.GetSym();
-    RETURN f.typeOf(ord);
-  END getTypeFromOrd;
-
-(* ============================================ *)
-
-  PROCEDURE (f : SymFileReader)getFormalType(rslt : Ty.Procedure;
-        				     indx : INTEGER) : D.Type,NEW;
-  (*
-  ** FormalType = [retSy TypeOrd] frmSy {parSy Byte TypeOrd [String]} endFm.
-  //	-- optional phrase is return type for proper procedures
-  *)
-    VAR parD : Id.ParId;
-        byte : INTEGER;
-  BEGIN
-    IF f.sSym = retSy THEN 
-      rslt.retType := f.typeOf(f.iAtt);
-      f.GetSym();
-    END;
-    f.ReadPast(frmSy);
-    WHILE f.sSym = parSy DO
-      byte := read(f.file);
-      parD := Id.newParId();
-      parD.parMod := byte;
-      parD.varOrd := indx; 
-      parD.type := f.getTypeFromOrd();
-     (* Skip over optional parameter name string *)
-      IF f.sSym = strSy THEN (* parD.hash := Nh.enterStr(f.sAtt); *)
-        f.GetSym;
-      END;
-      Id.AppendParam(rslt.formals, parD);
-      INC(indx);
-    END;
-    f.ReadPast(endFm);
-    RETURN rslt;
-  END getFormalType;
-
-(* ============================================ *)
-
-  PROCEDURE (f : SymFileReader)pointerType(old : D.Type) : D.Type,NEW;
-  (* Assert: the current symbol ptrSy 		*)
-  (* Pointer   = TypeHeader ptrSy TypeOrd.	*)
-    VAR rslt : Ty.Pointer;
-        indx : INTEGER;
-        junk : D.Type;
-        isEvt: BOOLEAN;
-  BEGIN
-    isEvt := (f.sSym = evtSy);
-    indx := readOrd(f.file);
-    WITH old : Ty.Pointer DO
-      rslt := old;
-     (*
-      *  Check if there is space in the tArray for this
-      *  element, otherwise expand using typeOf().
-      *)
-      IF indx - D.tOffset >= f.tArray.tide THEN
-        junk := f.typeOf(indx);
-      END;
-      f.tArray.a[indx - D.tOffset] := rslt.boundTp;
-    ELSE
-      rslt := Ty.newPtrTp();
-      rslt.boundTp := f.typeOf(indx);
-      IF isEvt THEN rslt.SetKind(Ty.evtTp) END;
-    END;
-    f.GetSym();
-    RETURN rslt;
-  END pointerType;
-
-(* ============================================ *)
-
-  PROCEDURE (f : SymFileReader)procedureType() : D.Type,NEW;
-  (* Assert: the current symbol is pTpSy.	*)
-  (* ProcType  = TypeHeader pTpSy FormalType.	*)
-  BEGIN
-    f.GetSym();		(* read past pTpSy *)
-    RETURN f.getFormalType(Ty.newPrcTp(), 0);
-  END procedureType;
-
-(* ============================================ *)
-
-  PROCEDURE (f : SymFileReader)eventType() : D.Type,NEW;
-  (* Assert: the current symbol is evtSy.	*)
-  (* EventType = TypeHeader evtSy FormalType.	*)
-  BEGIN
-    f.GetSym();		(* read past evtSy *)
-    RETURN f.getFormalType(Ty.newEvtTp(), 0);
-  END eventType;
-
-(* ============================================ *)
-
-  PROCEDURE (f : SymFileReader)arrayType() : Ty.Array,NEW;
-  (* Assert: at entry the current symbol is arrSy.		     *)
-  (* Array      = TypeHeader arrSy TypeOrd (Byte | Number | ) endAr. *)
-  (*	-- nullable phrase is array length for fixed length arrays   *)
-    VAR rslt : Ty.Array;
-        eTyp : D.Type;
-  BEGIN
-    rslt := Ty.newArrTp();
-    rslt.elemTp := f.typeOf(readOrd(f.file));
-    f.GetSym();
-    IF f.sSym = bytSy THEN
-      rslt.length := f.iAtt;
-      f.GetSym();
-    ELSIF f.sSym = numSy THEN
-      rslt.length := SHORT(f.lAtt);
-      f.GetSym();
-    (* ELSE length := 0 *)
-    END;
-    f.ReadPast(endAr);
-    RETURN rslt;
-  END arrayType;
-
-(* ============================================ *)
-
-  PROCEDURE (f : SymFileReader)vectorType() : Ty.Vector,NEW;
-  (* Assert: at entry the current symbol is vecSy.                   *)
-  (* Vector     = TypeHeader vecSy TypeOrd endAr.                    *)
-    VAR rslt : Ty.Vector;
-        eTyp : D.Type;
-  BEGIN
-    rslt := Ty.newVecTp();
-    rslt.elemTp := f.typeOf(readOrd(f.file));
-    f.GetSym();
-    f.ReadPast(endAr);
-    RETURN rslt;
-  END vectorType;
-
-(* ============================================ *)
-  PROCEDURE^ (f : SymFileReader)procedure() : Id.PrcId,NEW;
-  PROCEDURE^ (f : SymFileReader)method()    : Id.MthId,NEW;
-  PROCEDURE^ (f : SymFileReader)constant()  : Id.ConId,NEW;
-  PROCEDURE^ (f : SymFileReader)variable()  : Id.VarId,NEW;
-(* ============================================ *)
-
-  PROCEDURE (f : SymFileReader)recordType(old  : D.Type) : D.Type,NEW;
-  (* Assert: at entry the current symbol is recSy.			*)
-  (* Record     = TypeHeader recSy recAtt [truSy | falSy | <others>] 	*)
-  (*	[basSy TypeOrd] [iFcSy {basSy TypeOrd}]				*)
-  (*	{Name TypeOrd} {Method} {Statics} endRc.			*)
-    CONST 
-        vlTp = Ty.valRc;
-    VAR rslt : Ty.Record;
-        fldD : Id.FldId;
-        varD : Id.VarId;
-        mthD : Id.MthId;
-        conD : Id.ConId;
-        prcD : Id.PrcId;
-        typD : Id.TypId;
-        oldS : INTEGER;
-        attr : INTEGER;
-        mskd : INTEGER;
-  BEGIN
-    WITH old : Ty.Record DO rslt := old ELSE rslt := Ty.newRecTp() END;
-    attr := read(f.file);
-    mskd := attr MOD 8;
-   (*
-    *  The recAtt field has two other bits piggy-backed onto it.
-    *  The noNew Field of xAttr is just added on in the writing 
-    *  and is stripped off here.  The valRc field is used to lock
-    *  in foreign value classes, even though they have basTp # NIL.
-    *)
-(*
- *  IF mskd # Ty.noAtt THEN INCL(rslt.xAttr, D.clsTp) END;
- *  IF attr >= noNw THEN DEC(attr, noNw); INCL(rslt.xAttr, D.noNew) END;
- *)
-    IF attr >= Ty.clsRc THEN DEC(attr,Ty.clsRc); INCL(rslt.xAttr,D.clsTp) END;
-    IF attr >= Ty.noNew THEN DEC(attr,Ty.noNew); INCL(rslt.xAttr,D.noNew) END;
-
-    rslt.recAtt := attr;
-    f.GetSym();				(* Get past recSy rAtt	*)
-    IF f.sSym = falSy THEN
-      INCL(rslt.xAttr, D.isFn);
-      f.GetSym();
-    ELSIF f.sSym = truSy THEN
-      INCL(rslt.xAttr, D.isFn);
-      INCL(rslt.xAttr, D.fnInf);
-      INCL(rslt.xAttr, D.noCpy);
-      f.GetSym();
-    END;
-    IF f.impS.scopeNm # NIL THEN rslt.extrnNm := f.impS.scopeNm END;
-
-    IF f.sSym = basSy THEN
-      rslt.baseTp := f.typeOf(f.iAtt);
-      IF f.iAtt # Ty.anyRec THEN INCL(rslt.xAttr, D.clsTp) END;
-      f.GetSym();
-    END;
-    IF f.sSym = iFcSy THEN
-      f.GetSym();
-      WHILE f.sSym = basSy DO
-        typD := Id.newSfAnonId(f.iAtt);
-        typD.type := f.typeOf(f.iAtt);
-        D.AppendType(rslt.interfaces, typD.type);
-        f.GetSym();
-      END;
-    END;
-    WHILE f.sSym = namSy DO
-      fldD := Id.newFldId();
-      fldD.SetMode(f.iAtt);
-      fldD.hash := Nh.enterStr(f.sAtt);
-      fldD.type := f.typeOf(readOrd(f.file));
-      fldD.recTyp := rslt;
-      f.GetSym();
-      IF rslt.symTb.enter(fldD.hash, fldD) THEN 
-        D.AppendIdnt(rslt.fields, fldD);
-      END;
-    END;
-
-    WHILE (f.sSym = mthSy) OR
-          (f.sSym = prcSy) OR
-          (f.sSym = varSy) OR
-          (f.sSym = conSy) DO
-      oldS := f.sSym; f.GetSym();
-      IF oldS = mthSy THEN
-        mthD := f.method();
-        mthD.bndType := rslt;
-        mthD.type(Ty.Procedure).receiver := rslt;
-        InsertInRec(mthD,rslt,f);
-        D.AppendIdnt(rslt.methods, mthD);
-      ELSIF oldS = prcSy THEN
-        prcD := f.procedure();
-        prcD.bndType := rslt;
-        InsertInRec(prcD,rslt,f);
-        D.AppendIdnt(rslt.statics, prcD);
-      ELSIF oldS = varSy THEN
-        varD := f.variable();
-        varD.recTyp := rslt;
-        InsertInRec(varD,rslt,f);
-        D.AppendIdnt(rslt.statics, varD);
-      ELSIF oldS = conSy THEN
-        conD := f.constant();
-        conD.recTyp := rslt;
-        InsertInRec(conD,rslt,f);
-      ELSE
-        Abandon(f);
-      END;
-    END;
-(* #### *)
-    IF attr >= Ty.valRc THEN 
-      DEC(attr, Ty.valRc); 
-      EXCL(rslt.xAttr, D.clsTp);
-      EXCL(rslt.xAttr, D.noCpy);
-    END;
-(* #### *)
-    f.ReadPast(endRc); 
-    RETURN rslt;
-  END recordType;
-
-(* ============================================ *)
-
-  PROCEDURE (f : SymFileReader)enumType() : D.Type,NEW;
-  (* Assert: at entry the current symbol is eTpSy.			*)
-  (* Enum  = TypeHeader eTpSy { Constant} endRc.			*)
-    VAR rslt : Ty.Enum;
-        cnst : D.Idnt;
-  BEGIN
-    rslt := Ty.newEnuTp();
-    f.GetSym();				(* Get past recSy 	*)
-    WHILE f.sSym = conSy DO
-      f.GetSym();
-      cnst := f.constant();
-      Insert(cnst, rslt.symTb);
-      D.AppendIdnt(rslt.statics, cnst);
-    END;
-    f.ReadPast(endRc); 
-    RETURN rslt;
-  END enumType;
-
-(* ============================================ *)
-
-  PROCEDURE (f : SymFileReader)Type(),NEW;
-  (* Type       = typSy Name TypeOrd.		*)
-    VAR newI : Id.TypId;
-        oldI : D.Idnt;
-        type : D.Type;
-  BEGIN
-   (* 
-    * Post: every previously unknown typId id
-    *	has the property:  id.type.idnt = id.
-    *   If oldI # newT, then the new typId has
-    *   newT.type.idnt = oldI.
-    *)
-    newI := Id.newTypId(NIL);
-    newI.SetMode(f.iAtt);
-    newI.hash := Nh.enterStr(f.sAtt);
-    newI.type := f.getTypeFromOrd(); 
-    newI.dfScp := f.impS;
-    oldI := testInsert(newI, f.impS);
-
-    IF oldI # newI THEN 
-      f.tArray.a[newI.type.dump - D.tOffset] := oldI.type;
-    END;
-
-    IF newI.type.idnt = NIL THEN newI.type.idnt := oldI END;
-  END Type;
-
-(* ============================================ *)
-
-  PROCEDURE (f : SymFileReader)Import(),NEW;
-  (* Import     = impSy Name [String] Key.	*)
-  (*	-- optional string is external name	*)
-  (* first symbol should be namSy here.		*)
-    VAR impD : Id.BlkId;
-        oldS : Id.BlkId;
-        oldD : D.Idnt;
-  BEGIN
-    impD := Id.newImpId();
-    impD.dfScp := impD;			(* ImpId define their own scope *)
-
-    INCL(impD.xAttr, D.weak);
-    impD.SetMode(f.iAtt);
-    impD.hash := Nh.enterStr(f.sAtt);
-    f.ReadPast(namSy); 
-    IF impD.hash = f.modS.hash THEN	(* Importing own imp indirectly	*)
-        				(* Shouldn't this be an error?  *)
-      D.AppendScope(f.sArray, f.modS);
-      IF f.sSym = strSy THEN 
-        (* probably don't need to do anything here ... *)
-        f.GetSym();
-      END;
-    ELSE				(* Importing some other module.	*)
-      oldD := testInsert(impD, f.modS);
-      IF f.sSym = strSy THEN 
-        impD.scopeNm := LitValue.strToCharOpen(f.sAtt);
-        f.GetSym();
-      END;
-      IF (oldD # impD) & (oldD.kind = Id.impId) THEN
-        oldS := oldD(Id.BlkId);
-        D.AppendScope(f.sArray, oldS);
-        IF (oldS.modKey # 0) & (f.iAtt # oldS.modKey) THEN
-          S.SemError.RepSt1(133,		(* Detected bad KeyVal	*)
-        	Nh.charOpenOfHash(impD.hash)^, 
-        	S.line, S.col);
-        END;
-(* should not be necessary anymore *)
-        IF ~(D.weak IN oldS.xAttr) &
-           ~(D.fixd IN oldS.xAttr) THEN
-         (*
-          *   This recursively reads the symbol files for 
-          *   any imports of this file which are on the
-          *   list to be imported later anyhow.
-          *)
-          WalkThisImport(oldS, f.modS);
-        END;
-      ELSE
-        D.AppendScope(f.sArray, impD);
-      END;
-      impD.modKey := f.iAtt;
-    END;
-    f.ReadPast(keySy);
-  END Import;
-
-(* ============================================ *)
-
-  PROCEDURE (f : SymFileReader)constant() : Id.ConId,NEW;
-  (* Constant   = conSy Name Literal.		*)
-  (* Assert: f.sSym = namSy.			*)
-    VAR newC : Id.ConId;
-        anyI : D.Idnt;
-  BEGIN
-    newC := Id.newConId();
-    newC.SetMode(f.iAtt);
-    newC.hash := Nh.enterStr(f.sAtt);
-    newC.dfScp := f.impS;
-    f.ReadPast(namSy);
-    newC.conExp := f.getLiteral();
-    newC.type := newC.conExp.type;
-    RETURN newC;
-  END constant;
-
-(* ============================================ *)
-
-  PROCEDURE (f : SymFileReader)variable() : Id.VarId,NEW;
-  (* Variable   = varSy Name TypeOrd.		*)
-    VAR newV : Id.VarId;
-        anyI : D.Idnt;
-  BEGIN
-    newV := Id.newVarId();
-    newV.SetMode(f.iAtt);
-    newV.hash := Nh.enterStr(f.sAtt);
-    newV.type := f.getTypeFromOrd();
-    newV.dfScp := f.impS;
-    RETURN newV;
-  END variable;
-
-(* ============================================ *)
-
-  PROCEDURE (f : SymFileReader)procedure() : Id.PrcId,NEW;
-  (* Procedure  = prcSy Name[String]FormalType. *)
-  (* This is a static proc, mths come with Recs *)
-    VAR newP : Id.PrcId;
-        anyI : D.Idnt;
-  BEGIN
-    newP := Id.newPrcId();
-    newP.setPrcKind(Id.conPrc);
-    newP.SetMode(f.iAtt);
-    newP.hash := Nh.enterStr(f.sAtt);
-    newP.dfScp := f.impS;
-    f.ReadPast(namSy);
-    IF f.sSym = strSy THEN 
-      newP.prcNm := LitValue.strToCharOpen(f.sAtt);
-     (* and leave scopeNm = NIL *)
-      f.GetSym();
-    END;
-    IF f.sSym = truSy THEN	(* ### this is a constructor ### *)
-      f.GetSym();
-      newP.setPrcKind(Id.ctorP);
-    END;			(* ### this is a constructor ### *)
-    newP.type := f.getFormalType(Ty.newPrcTp(), 0);
-    (* IF this is a java module, do some semantic checks *)
-    (* ... *)
-    RETURN newP;
-  END procedure;
-
-(* ============================================ *)
-
-  PROCEDURE (f : SymFileReader)method() : Id.MthId,NEW;
-  (* Method     = mthSy Name byte byte TypeOrd [String][Name] FormalType. *)
-    VAR newM : Id.MthId;
-        rcvD : Id.ParId;
-        rFrm : INTEGER;
-        mAtt : SET;
-  BEGIN
-    newM := Id.newMthId();
-    newM.SetMode(f.iAtt);
-    newM.setPrcKind(Id.conMth);
-    newM.hash := Nh.enterStr(f.sAtt);
-    newM.dfScp := f.impS;
-    rcvD := Id.newParId();
-    rcvD.varOrd := 0;
-   (* byte1 is the method attributes  *)
-    mAtt := BITS(read(f.file));
-   (* byte2 is param form of receiver *)
-    rFrm := read(f.file);
-   (* next 1 or 2 bytes are rcv-type  *)
-    rcvD.type := f.typeOf(readOrd(f.file));
-    f.GetSym();
-    rcvD.parMod := rFrm;
-    IF f.sSym = strSy THEN 
-      newM.prcNm := LitValue.strToCharOpen(f.sAtt);
-     (* and leave scopeNm = NIL *)
-      f.GetSym();
-    END;
-   (* Skip over optional receiver name string *)
-    IF f.sSym = namSy THEN (* rcvD.hash := Nh.enterString(f.sAtt); *)
-      f.GetSym();
-    END;
-   (* End skip over optional receiver name *)
-    newM.type := f.getFormalType(Ty.newPrcTp(), 1);
-    newM.mthAtt := mAtt;
-    newM.rcvFrm := rcvD;
-   (* IF this is a java module, do some semantic checks *)
-    RETURN newM;
-  END method;
-
-(* ============================================ *)
-
-  PROCEDURE (f : SymFileReader)TypeList(),NEW;
-  (* TypeList   = start { Array | Record | Pointer      *)
-  (*		  | ProcType | Vector} close.           *)
-  (* TypeHeader = tDefS Ord [fromS Ord Name].           *)
-    VAR modOrd : INTEGER;
-        typOrd : INTEGER;
-        typIdx : INTEGER;
-        tpDesc : D.Type;
-        tpTemp : D.Type;
-        tpIdnt : Id.TypId;
-        prevId : D.Idnt;
-        prevTp : D.Type;
-        impScp : D.Scope;
-        linkIx : INTEGER;
-        bndTyp : D.Type;
-        typeFA : TypeLinker;
-  BEGIN
-    WHILE f.sSym = tDefS DO
-      linkIx := 0;
-      tpIdnt := NIL;
-     (* Do type header *)
-      typOrd := f.iAtt;
-      typIdx := typOrd - D.tOffset;
-      tpTemp := f.tArray.a[typIdx];
-      impScp := NIL;
-      f.ReadPast(tDefS);
-     (*
-      *  The [fromS modOrd typNam] appears if the type is imported.
-      *  There are two cases:
-      *     this is the first time that "mod.typNam" has been 
-      *     seen during this compilation 
-      *                   ==> insert a new typId descriptor in mod.symTb
-      *     this name is already in the mod.symTb table
-      *                   ==> fetch the previous descriptor
-      *)
-      IF f.sSym = fromS THEN
-        modOrd := f.iAtt;
-        impScp := f.sArray.a[modOrd];
-        f.GetSym();
-        tpIdnt := Id.newTypId(NIL);
-        tpIdnt.SetMode(f.iAtt);
-        tpIdnt.hash := Nh.enterStr(f.sAtt);
-        tpIdnt.dfScp := impScp;
-        tpIdnt := testInsert(tpIdnt, impScp)(Id.TypId);
-        f.ReadPast(namSy);
-      END;
-
-     (* Get type info. *)
-      CASE f.sSym OF
-      | arrSy : tpDesc := f.arrayType();
-      | vecSy : tpDesc := f.vectorType();
-      | recSy : tpDesc := f.recordType(tpTemp);
-      | pTpSy : tpDesc := f.procedureType();
-      | evtSy : tpDesc := f.eventType();
-      | eTpSy : tpDesc := f.enumType();
-      | ptrSy : tpDesc := f.pointerType(tpTemp);
-                IF tpDesc # NIL THEN 
-                  bndTyp := tpDesc(Ty.Pointer).boundTp;
-                  IF (bndTyp # NIL) & 
-                     (bndTyp.kind = Ty.tmpTp) THEN
-                    linkIx := bndTyp.dump - D.tOffset;
-                  END;
-                END;
-      ELSE 
-        tpDesc := Ty.newNamTp();
-      END;
-      IF tpIdnt # NIL THEN
-       (*
-        *  A name has been declared for this type, tpIdnt is
-        *  the (possibly previously known) id descriptor, and
-        *  tpDesc is the newly parsed descriptor of the type.
-        *) 
-        IF  tpIdnt.type = NIL THEN 
-         (*
-          *  Case #1: no previous type.
-          *  This is the first time the compiler has seen this type
-          *)
-          tpIdnt.type := tpDesc;
-          tpDesc.idnt := tpIdnt;
-        ELSIF tpDesc IS Ty.Opaque THEN
-         (* 
-          *  Case #2: previous type exists, new type is opaque.
-          *  Throw away the newly parsed opaque type desc, and
-          *  use the previously known type *even* if it is opaque!
-          *)
-          tpDesc := tpIdnt.type;
-        ELSIF tpIdnt.type IS Ty.Opaque THEN
-         (*
-          *  Case #3: previous type is opaque, new type is non-opaque.
-          *  This type had been seen opaquely, but now has a 
-          *  non-opaque definition
-          *)
-          tpIdnt.type(Ty.Opaque).resolved := tpDesc;
-          tpIdnt.type := tpDesc;
-          tpDesc.idnt := tpIdnt;
-        ELSE
-         (*
-          *  Case #4: previous type is non-opaque, new type is non-opaque.
-          *  This type already has a non-opaque descriptor.
-          *  We shall keep the original copy.
-          *)
-          tpDesc := tpIdnt.type;
-        END;
-       (*
-        *  Normally, imported types cannot be anonymous.
-        *  However, there is one special case here. Anon
-        *  records can be record base types, but are always 
-        *  preceeded by the binding pointer type. A typical
-        *  format of output from SymDec might be ---
-        *
-        *       T18 = SomeMod.BasePtr
-        *             POINTER TO T19;
-        *       T19 = EXTENSIBLE RECORD  (T11) ... END;
-        *
-        *  in this case T19 is an anon record from SomeMod,
-        *  not the current module.
-        *
-        *  Thus we pre-override the future record declaration
-        *  by the bound type of the pointer.  This ensures
-        *  uniqueness of the record descriptor, even if it is
-        *  imported indirectly multiple times.
-        *)
-        WITH tpDesc : Ty.Pointer DO
-          IF linkIx # 0 THEN f.tArray.a[linkIx] := tpDesc.boundTp END;
-        ELSE (* skip *)
-        END;
-        f.tArray.a[typIdx] := tpDesc;
-      ELSE  
-       (* 
-        *  tpIdnt is NIL ==> type is from this import,
-        *  except for the special case above.  In the usual
-        *  case we replace the tmpTp by tpDesc. In the special
-        *  case the tmpTp has been already been overridden by 
-        *  the previously imported bound type.
-        *)
-        prevTp := f.tArray.a[typIdx];
-        prevId := prevTp.idnt;
-        IF (prevId # NIL) &
-           (prevId.type.kind = Ty.namTp) THEN
-          prevId.type(Ty.Opaque).resolved := tpDesc;
-          prevId.type := tpDesc;
-        END;
-        tpDesc.idnt := prevId;
-        f.tArray.a[typIdx] := tpDesc;
-      END;
-    END; (* while *)
-   (*
-    *  First we fix up all symbolic references in the
-    *  the type array.  Postcondition is : no element
-    *  of the type array directly or indirectly refers
-    *  to a temporary type.
-    *)
-    FOR linkIx := 0 TO f.tArray.tide - 1 DO
-      f.tArray.a[linkIx].TypeFix(f.tArray);
-    END;
-   (*
-    *  We now fix up all references in the symbol table
-    *  that still refer to temporary symbol-file types.
-    *)
-    NEW(typeFA);
-    typeFA.sym := f;
-    f.impS.symTb.Apply(typeFA); 
-    f.ReadPast(close);
-   (*
-    *  Now check that all overloaded ids are necessary
-    *)
-    FOR linkIx := 0 TO f.oArray.tide - 1 DO
-      f.oArray.a[linkIx].OverloadFix();
-      f.oArray.a[linkIx] := NIL;
-    END;
-  END TypeList;
-
-(* ============================================ *)
-
-  PROCEDURE (f : SymFileReader)SymFile(IN nm : ARRAY OF CHAR),NEW;
-   (*
-   // SymFile    = Header [String (falSy | truSy | <others>)]
-   //		{Import | Constant | Variable | Type | Procedure} 
-   //		TypeList Key.
-   // Header     = magic modSy Name.
-   //
-   //  magic has already been recognized.
-   *)
-    VAR oldS : INTEGER;
-  BEGIN
-    f.ReadPast(modSy);
-    IF f.sSym = namSy THEN (* do something with f.sAtt *)
-      IF nm # f.sAtt THEN
-        Error.WriteString("Wrong name in symbol file. Expected <");
-        Error.WriteString(nm + ">, found <");
-        Error.WriteString(f.sAtt + ">"); 
-        Error.WriteLn;
-        HALT(1);
-      END;
-      f.GetSym();
-    ELSE RTS.Throw("Bad symfile header");
-    END;
-    IF f.sSym = strSy THEN (* optional name *)
-      f.impS.scopeNm := LitValue.strToCharOpen(f.sAtt);
-      f.GetSym();
-      IF f.sSym = falSy THEN 
-        INCL(f.impS.xAttr, D.isFn);
-        f.GetSym();
-      ELSIF f.sSym = truSy THEN
-        INCL(f.impS.xAttr, D.isFn);
-        INCL(f.impS.xAttr, D.fnInf);
-        f.GetSym();
-      ELSE RTS.Throw("Bad explicit name");
-      END; 
-    END; 
-    IF f.sSym = numSy THEN (* optional strong name info.    *)
-      NEW(f.impS.verNm);   (* POINTER TO ARRAY 6 OF INTEGER *)
-      f.impS.verNm[0] := RTS.hiInt(f.lAtt);
-      f.impS.verNm[1] := RTS.loInt(f.lAtt);
-      f.GetSym();
-      f.impS.verNm[2] := RTS.hiInt(f.lAtt);
-      f.impS.verNm[3] := RTS.loInt(f.lAtt);
-      f.GetSym();
-      f.impS.verNm[4] := RTS.hiInt(f.lAtt);
-      f.impS.verNm[5] := RTS.loInt(f.lAtt);
-      f.GetSym();
-      IF G.verbose THEN
-        Console.WriteString("version:"); 
-        Console.WriteInt(f.impS.verNm[0],1); Console.Write(".");
-        Console.WriteInt(f.impS.verNm[1],1); Console.Write(".");
-        Console.WriteInt(f.impS.verNm[2],1); Console.Write(".");
-        Console.WriteInt(f.impS.verNm[3],1); 
-        Console.WriteHex(f.impS.verNm[4],9);
-        Console.WriteHex(f.impS.verNm[5],9); Console.WriteLn;
-      END;
-    END;
-    LOOP
-      oldS := f.sSym;
-      f.GetSym();
-      CASE oldS OF
-      | start : EXIT;
-      | typSy : f.Type();
-      | impSy : f.Import();
-      | conSy : Insert(f.constant(),  f.impS.symTb);
-      | varSy : Insert(f.variable(),  f.impS.symTb);
-      | prcSy : Insert(f.procedure(), f.impS.symTb);
-      ELSE RTS.Throw("Bad object");
-      END;
-    END;
-   (* Now read the typelist *)
-    f.TypeList();
-    IF f.sSym = keySy THEN
-      IF f.impS.modKey = 0 THEN 
-        f.impS.modKey := f.iAtt;
-      ELSIF f.impS.modKey # f.iAtt THEN
-        S.SemError.Report(173, S.line, S.col);	(* Detected bad KeyVal	*)
-      END;
-    ELSE RTS.Throw("Missing keySy");
-    END; 
-  END SymFile;
-
-(* ============================================================ *)
-(* ========	     SymFileSFA visitor method		======= *)
-(* ============================================================ *)
-
-  PROCEDURE (t : SymFileSFA)Op*(id : D.Idnt);
-  BEGIN
-    IF (id.kind = Id.impId) OR (id.vMod # D.prvMode) THEN
-      CASE id.kind OF
-      | Id.typId  : t.sym.EmitTypeId(id(Id.TypId));
-      | Id.conId  : t.sym.EmitConstId(id(Id.ConId));
-      | Id.impId  : t.sym.EmitImportId(id(Id.BlkId));
-      | Id.varId  : t.sym.EmitVariableId(id(Id.VarId));
-(* new *)
-      | Id.conPrc : t.sym.EmitProcedureId(id(Id.PrcId));
-(*
- * old ... we used to emit the constructor as a static method.
- *         Now it appears as a static in the bound record decl.
- *
- *    | Id.ctorP,
- *      Id.conPrc : t.sym.EmitProcedureId(id(Id.PrcId));
- *)
-      ELSE (* skip *)
-      END;
-    END;
-  END Op;
-
-(* ============================================================ *)
-(* ========	     TypeLinker visitor method		======= *)
-(* ============================================================ *)
-
-  PROCEDURE (t : TypeLinker)Op*(id : D.Idnt);
-  BEGIN
-    IF id.type = NIL THEN RETURN
-    ELSIF id.type.kind = Ty.tmpTp THEN
-      id.type := Ty.update(t.sym.tArray, id.type);
-    ELSE
-      id.type.TypeFix(t.sym.tArray);
-    END;
-    IF  (id IS Id.TypId) & 
-        (id.type.idnt = NIL) THEN id.type.idnt := id END;
-  END Op;
-
-(* ============================================================ *)
-(* ========	    Symbol file parser method		======= *)
-(* ============================================================ *)
-
-  PROCEDURE WalkThisImport(imp, mod : Id.BlkId);
-    VAR syFil : SymFileReader;
-        filNm : FileNames.NameString;
-  BEGIN
-    PushStack(imp);
-    INCL(imp.xAttr, D.fixd);
-    S.GetString(imp.token.pos, imp.token.len, filNm);
-    syFil := newSymFileReader(mod);
-    syFil.Parse(imp, filNm);
-    PopStack;
-  END WalkThisImport;
- 
-(* ============================================ *)
-
-  PROCEDURE WalkImports*(IN imps : D.ScpSeq; modI : Id.BlkId);
-    VAR indx : INTEGER;
-        scpI : D.Scope;
-        blkI : Id.BlkId;
-  BEGIN
-   (*
-    *  The list of scopes has been constructed by
-    *  the parser, while reading the import list.
-    *  In the case of already known scopes the list
-    *  references the original descriptor.
-    *)
-    InitStack;
-    FOR indx := 0 TO imps.tide-1 DO
-      scpI := imps.a[indx];
-      blkI := scpI(Id.BlkId);
-      IF blkI.kind = Id.alias THEN
-        blkI.symTb  := blkI.dfScp.symTb;
-      ELSIF ~(D.fixd IN blkI.xAttr) THEN 
-        WalkThisImport(blkI,modI);
-      END;
-    END;
-  END WalkImports;
-
-(* ============================================================ *)
-BEGIN
-  lastKey := 0;
-  fSepArr[0] := GF.fileSep;
-END OldSymFileRW.
-(* ============================================================ *)

gpcp/Symbols.cp

@@ -237,6 +237,11 @@ MODULE Symbols;
     t.namStr := MKSTR(NameHash.charOpenOfHash(hash)^);
   END SetNameFromHash;
 
+  PROCEDURE (t : Idnt)ClearName*(),NEW;
+  BEGIN
+    t.namStr := NIL;
+  END ClearName;
+
 (* ============================================================ *)
 (*  This diagnostic method is placed here to use when GPCP-CLR  *)
 (*  itself is being debugged. If ToString is present then       *)

gpcp/Target.cp

@@ -11,9 +11,6 @@ MODULE Target;
 	CompState,
 	ClassMaker,
 	JavaMaker,
-(*
- *	LlvmMaker,
- *)
 	MsilMaker,
 	IdDesc;
 
@@ -36,14 +33,6 @@ MODULE Target;
       maker := MsilMaker.newMsilEmitter(mod);
       assmb := MsilMaker.newMsilAsm();
       Symbols.SetTargetIsNET(TRUE);
-(*
- *   (* LLVM backend coming in 2013? *)
- *  ELSIF str = "llvm" THEN 
- *    maker := LlvmMaker.newBitCodeEmitter(mod);
- *    assmb := LlvmMaker.newBitCodeAssembler();
- *    Symbols.SetTargetIsNET(FALSE);
- *  ELSIF ...
- *)
     ELSE
       CompState.Message("Unknown emitter name <" + str + ">");
     END;

gpcp/TypeDesc.cp

@@ -1444,19 +1444,19 @@ MODULE TypeDesc;
         *  - else this is an overload, and must be marked.
         *)
         WITH existingId : Id.FldId DO
-            ok := rec.symTb.enter(id.hash, id);
+            ok := rec.symTb.enter(id.hash, id); (* *)
         | existingId : Id.Procs DO
             IF existingId.type.sigsMatch(id.type) THEN
-              ok := rec.symTb.enter(id.hash, id);
+              ok := rec.symTb.enter(id.hash, id); (* *)
             ELSE
               oId := newOvlIdent(id,rec);
-              ok := rec.symTb.enter(oId.hash,oId);
+              ok := rec.symTb.enter(oId.hash,oId); (* *)
             END;
         | existingId : Id.OvlId DO
             oId := existingId;
-            AddToOvlIdent(id,existingId,doKindCheck,ok);
+            AddToOvlIdent(id,existingId,doKindCheck,ok); (* *)
         ELSE (* must be a field *)
-            ok := rec.symTb.enter(id.hash, id);
+            ok := rec.symTb.enter(id.hash, id); (* *)
         END;
       END;
     ELSIF ~rec.symTb.enter(id.hash, id) THEN

gpcp/gpcp.cp

@@ -1,7 +1,7 @@
 (* ==================================================================== *)
 (*									*)
 (*  Driver Module for the Gardens Point Component Pascal Compiler.	*)
-(*	Copyright (c) John Gough 1999, 2000.				*)
+(*	Copyright (c) John Gough 1999, 2016.				*)
 (*	This module was extensively modified from the driver		*)
 (*	automatically produced by the M2 version of COCO/R, using	*)
 (*	the CPascal.atg grammar used for the JVM version of GPCP.	*)