Merge pull request #10 from k-john-gough/net-asm

Net asm

J2CPS/ClassDesc.java

@@ -42,7 +42,13 @@ public class ClassDesc extends TypeDesc  {
     
     ConstantPool cp;
     ClassDesc superClass;
-    int access, outBaseTypeNum=0, superNum=0, numInts=0, intNums[];
+    
+    int access;
+    int outBaseTypeNum=0;
+    int superNum=0;
+    int numInts=0;
+    int intNums[];
+    
     public String 
             /**
              * Qualified name of the class e.g. java/lang/Object
@@ -221,6 +227,8 @@ public class ClassDesc extends TypeDesc  {
         ClassDesc put = classMap.put(qualName,this);
       }
       isInterface = ConstantPool.isInterface(access);
+      if (this.isInterface && (access & 1) != 1)
+          throw new IOException("interface not public");
       int superIx = stream.readUnsignedShort();
       if (superIx > 0) {
         tmp = (ClassRef) cp.Get(superIx);

J2CPS/SymbolFile.java

@@ -159,7 +159,7 @@ class SymbolFile {
         out.writeByte(protect); 
     }
     else /* if (ConstantPool.isPrivate(access)) */ { 
-        out.writeByte(prvMode); 
+        out.writeByte(prvMode); // Why are we emitting this if it is private?
     }
     if (name == null) {
         name = "DUMMY" + count++;
@@ -210,6 +210,7 @@ class SymbolFile {
   }
 
   private static void InsertTypeInTypeList(TypeDesc ty) {
+    // Make a longer list.
     if (ty.outTypeNum > 0) { return; }
     ty.outTypeNum = nextType++;
     if (tListIx >= typeList.length) {
@@ -362,12 +363,16 @@ class SymbolFile {
                 System.out.printf("Member class %s\n", thisClass.javaName);   
             // -------------------
             // This class is a class of the package being
-            // emitted to this symbol file. Details are required.
+            // emitted to this symbol file. Details are required.            
             // -------------------
             thisClass.writeDetails = true;
             out.writeByte(typSy);
             writeName(out,thisClass.access,thisClass.objName);
             writeTypeOrd(out,thisClass);
+            // Sanity check.
+            assert (thisClass.access & 0x200) == 0 || 
+                    (thisClass.access & 1) == 1 :
+                    "Interface not public : " + thisClass.qualName;
         }
     }
     //
@@ -778,7 +783,7 @@ class SymbolFile {
                 impClass = null;
                 String impModName = null;
                 int impAcc = 0,
-                        impModAcc = 0;
+                    impModAcc = 0;
                 Check(tDefS);
                 int tNum = tOrd;
                 GetSym();

J2CPS/TypeDesc.java

@@ -177,6 +177,10 @@ public class TypeDesc {
     return typeArr; 
   }
 
+  /**
+   * Initialize <code>typeList</code> to begin with
+   * the basic, predeclared types.
+   */
   public static void InitTypes() {
     for (int i=0; i < specT; i++) {
       basicTypes[i] = new TypeDesc(i);

gpcp/AsmFrames.cp

@@ -159,7 +159,7 @@ MODULE AsmFrames;
 (*
  *PROCEDURE^ ( mFrm : MethodFrame )DiagFrame*( ),NEW;
  *PROCEDURE^ ( mFrm : MethodFrame )DiagEvalStack*(),NEW;
- *PROCEDURE^ (mFrm : MethodFrame )Diag*(code : INTEGER),NEW;
+ *PROCEDURE^ ( mFrm : MethodFrame )Diag*(code : INTEGER),NEW;
  *PROCEDURE^ ( fs : FrameSave )Diag*( ),NEW;
  *)
   PROCEDURE^ ( mFrm : MethodFrame )GetLocalArrStr*() : RTS.NativeString,NEW;
@@ -239,6 +239,13 @@ MODULE AsmFrames;
         pars : Id.ParSeq;
         parX : Id.ParId;
   BEGIN
+   (* ------------------ *
+    *  Allocate a method frame slot for the XHR if this is needed.  
+    * ------------------ *)
+    IF Id.hasXHR IN prc.pAttr THEN
+        frm.AddLocal( prc.xhrType );
+    END; 
+    
     pars := prc.type(Ty.Procedure).formals;
     FOR idx := 0 TO pars.tide-1 DO
       parX := pars.a[idx];

gpcp/AsmUtil.cp

@@ -1172,7 +1172,13 @@ MODULE AsmUtil;
 
   PROCEDURE (emtr : AsmEmitter)CallGetClass*();
   BEGIN
-    THROW( "method CallGetClass not implemented" );
+    emtr.CheckFrame();
+    emtr.thisMv.visitMethodInsn( 
+        ASM.Opcodes.INVOKEVIRTUAL,
+        jloStr,
+        MKSTR("getClass"), 
+        MKSTR("()Ljava/lang/Class;"),
+        FALSE ); (* ==> not an interface *)
   END CallGetClass; 
 
  (* --------------------------------------------------------- *)

gpcp/Browse.cp

@@ -1,3 +1,4 @@
+
 MODULE Browse;
 
   IMPORT 
@@ -172,9 +173,9 @@ MODULE Browse;
            END;
 
     Pointer = POINTER TO EXTENSIBLE RECORD (Type)
-                baseNum : INTEGER;
+                boundOrd  : INTEGER;
+                boundType : Type;
                 isAnonPointer : BOOLEAN;
-                baseType : Type;
               END;
 
     Record = POINTER TO EXTENSIBLE RECORD (Type)
@@ -182,7 +183,7 @@ MODULE Browse;
                baseType  : Type;
                ptrType   : Pointer;
                isAnonRec : BOOLEAN;
-               baseNum   : INTEGER;
+               baseOrd   : INTEGER;
                intrFaces : DescList; 
                fields    : DescList; 
                methods   : DescList; 
@@ -259,7 +260,7 @@ MODULE Browse;
                 list : POINTER TO ARRAY OF Module;
               END;
 
-    Module = POINTER TO RECORD
+    Module = POINTER TO RECORD 
                name      : CharOpen;
                symName   : CharOpen;
                fName     : CharOpen;
@@ -293,9 +294,10 @@ MODULE Browse;
 (* ============================================================ *)
 
   VAR
+    multiMods : BOOLEAN;
     args, argNo  : INTEGER;
     fileName, modName  : CharOpen;
-    printFNames, doAll, verbatim, verbose, hexCon, alpha : BOOLEAN;
+    printFNames, doAll, verbatim, verbose, unwind, hexCon, alpha : BOOLEAN;
     file  : GPBinFiles.FILE;
     sSym  : INTEGER;
     cAtt  : CHAR;
@@ -309,15 +311,12 @@ MODULE Browse;
     output : Output;
     module : Module;
     modList : ModList;
+    dstPath : CharOpen;
 
 (* ============================================================ *)
 (* ============================================================ *)
 
-  PROCEDURE QuickSortDescs(lo, hi : INTEGER; dLst : DescList);
-    VAR i,j : INTEGER;
-        dsc : Desc;
-	tmp : Desc;
-   (* -------------------------------------------------- *)
+ (* ---------------------------------------------------- *)
     PROCEDURE canonLT(l,r : ARRAY OF CHAR) : BOOLEAN;
       VAR i : INTEGER;
     BEGIN
@@ -334,7 +333,14 @@ MODULE Browse;
       FOR i := 0 TO LEN(r) - 1 DO r[i] := CAP(r[i]) END;
       RETURN l > r;
     END canonGT;
-   (* -------------------------------------------------- *)
+ (* ---------------------------------------------------- *)
+
+ (* ---------------------------------------------------- *)
+  PROCEDURE QuickSortDescs(lo, hi : INTEGER; dLst : DescList);
+    VAR i,j : INTEGER;
+        dsc : Desc;
+	tmp : Desc;
+ (* ---------------------------------------------------- *)
   BEGIN
     i := lo; j := hi;
     dsc := dLst.list[(lo+hi) DIV 2];
@@ -347,12 +353,38 @@ MODULE Browse;
       WHILE canonGT(dLst.list[j].name$, dsc.name$) DO DEC(j) END;
       IF i <= j THEN
         tmp := dLst.list[i]; dLst.list[i] := dLst.list[j]; dLst.list[j] := tmp; 
-	INC(i); DEC(j);
+        INC(i); DEC(j);
       END;
     UNTIL i > j;
     IF lo < j THEN QuickSortDescs(lo, j,  dLst) END;
     IF i < hi THEN QuickSortDescs(i,  hi, dLst) END;
   END QuickSortDescs;
+ (* ---------------------------------------------------- *)
+
+ (* ---------------------------------------------------- *)
+  PROCEDURE QuickSortMods(lo, hi : INTEGER; dLst : ModList);
+    VAR i,j : INTEGER;
+        dsc : Module;
+	tmp : Module;
+ (* ---------------------------------------------------- *)
+  BEGIN
+    i := lo; j := hi;
+    dsc := dLst.list[(lo+hi) DIV 2];
+    REPEAT
+   (*
+    * WHILE dLst.list[i].name < dsc.name DO INC(i) END;
+    * WHILE dLst.list[j].name > dsc.name DO DEC(j) END;
+    *)
+      WHILE canonLT(dLst.list[i].name$, dsc.name$) DO INC(i) END;
+      WHILE canonGT(dLst.list[j].name$, dsc.name$) DO DEC(j) END;
+      IF i <= j THEN
+        tmp := dLst.list[i]; dLst.list[i] := dLst.list[j]; dLst.list[j] := tmp; 
+        INC(i); DEC(j);
+      END;
+    UNTIL i > j;
+    IF lo < j THEN QuickSortMods(lo, j,  dLst) END;
+    IF i < hi THEN QuickSortMods(i,  hi, dLst) END;
+  END QuickSortMods;
 
 (* ============================================================ *)
 (* ============================================================ *)
@@ -362,7 +394,9 @@ MODULE Browse;
     i : INTEGER;
     tmp : POINTER TO ARRAY OF Module;
     mod : Module;
+	mlst : ModList;
   BEGIN
+    mlst := modList;
     ASSERT(modList.list # NIL);
     FOR i := 0 TO modList.tide-1 DO
       IF modList.list[i].name^ = name^ THEN RETURN modList.list[i] END;
@@ -377,7 +411,7 @@ MODULE Browse;
     NEW(mod);
     mod.systemMod := FALSE;
     mod.progArg := FALSE;
-    mod.name := name;
+    mod.name := BOX(name^$);
     mod.symName := BOX(name^ + symExt);
     modList.list[modList.tide] := mod;
     INC(modList.tide);
@@ -575,6 +609,14 @@ MODULE Browse;
     END;
   END readOrd;
 
+(* ======================================= *)
+
+  PROCEDURE ReinitializeTypes();
+    VAR i : INTEGER;
+  BEGIN
+    FOR i := Symbols.tOffset TO LEN(typeList) - 1 DO typeList[i] := NIL END;
+  END ReinitializeTypes;
+ 
 (* ============================================================ *)
 (* ========		Symbol File Reader		======= *)
 (* ============================================================ *)
@@ -749,7 +791,7 @@ MODULE Browse;
       ptr : Pointer;
   BEGIN
     NEW(ptr);
-    ptr.baseNum := readOrd();
+    ptr.boundOrd := readOrd();
     ptr.isAnonPointer := FALSE;
     GetSym();
     RETURN ptr;
@@ -866,10 +908,10 @@ MODULE Browse;
       GetSym();
     END;
     IF sSym = basSy THEN
-      rec.baseNum := iAtt;
+      rec.baseOrd := iAtt;
       GetSym();
     ELSE
-      rec.baseNum := 0;
+      rec.baseOrd := 0;
     END;
     IF sSym = iFcSy THEN
       GetSym();
@@ -969,6 +1011,7 @@ MODULE Browse;
         impName : CharOpen;
         i,j : INTEGER;
   BEGIN
+    ReinitializeTypes();
     GetSym();
     typOrd := 0;
     WHILE sSym = tDefS DO
@@ -997,7 +1040,7 @@ MODULE Browse;
       | eTpSy : typ := enumType();
       ELSE 
         NEW(namedType);
-	typ := namedType;
+	    typ := namedType;
       END;
       IF typ # NIL THEN
         AddType(typeList,typ,typOrd);
@@ -1016,8 +1059,8 @@ MODULE Browse;
         typ(Vector).elemType := typeList[typ(Vector).elemTypeNum];
       ELSIF typ IS Record THEN
         rec := typ(Record);
-        IF (rec.baseNum > 0) THEN
-          rec.baseType := typeList[rec.baseNum];
+        IF (rec.baseOrd > 0) THEN
+          rec.baseType := typeList[rec.baseOrd];
         END;
         FOR j := 0 TO rec.fields.tide-1 DO
           f := rec.fields.list[j](VarDesc);
@@ -1035,7 +1078,7 @@ MODULE Browse;
           END;
         END;
       ELSIF typ IS Pointer THEN
-        typ(Pointer).baseType := typeList[typ(Pointer).baseNum];
+        typ(Pointer).boundType := typeList[typ(Pointer).boundOrd];
       ELSIF typ IS Proc THEN
         ResolveProc(typ(Proc));
       END;
@@ -1065,11 +1108,11 @@ MODULE Browse;
         IF typ.declarer = NIL THEN (* anon record *)
           typ(Record).isAnonRec := TRUE;
         END;
-      ELSIF (typ IS Pointer) & (typ(Pointer).baseType IS Record) THEN
+      ELSIF (typ IS Pointer) & (typ(Pointer).boundType IS Record) THEN
         IF (typ.declarer = NIL) & (typ.importedFrom = NIL) THEN 
           typ(Pointer).isAnonPointer := TRUE; 
         END;
-        r := typ(Pointer).baseType(Record);
+        r := typ(Pointer).boundType(Record);
         IF (r.declarer = NIL) THEN  (* anon record *)
           r.isAnonRec := TRUE;
           r.ptrType := typ(Pointer);
@@ -1208,7 +1251,7 @@ MODULE Browse;
         Error.WriteString("Wrong name in symbol file. Expected <");
         Error.WriteString(mod.name^ + ">, found <");
         Error.WriteString(sAtt^ + ">"); 
-	    Error.WriteLn;
+        Error.WriteLn;
         HALT(1);
       END;
       GetSym();
@@ -1290,6 +1333,8 @@ MODULE Browse;
     END;
   END GetSymAndModNames;
 
+(* ============================================================ *)
+
   PROCEDURE Parse();
   VAR 
     marker,modIx,i   : INTEGER;
@@ -1312,30 +1357,39 @@ MODULE Browse;
         i := 0;
         WHILE (i < LEN(mod.pathName)) & (mod.pathName[i] # ".") DO INC(i); END;
         mod.pathName[i] := 0X;
-      ELSE 
-        marker := readInt();
-        IF marker = RTS.loInt(magic) THEN
-        (* normal case, nothing to do *)
-        ELSIF marker = RTS.loInt(syMag) THEN
-          mod.systemMod := TRUE;
-        ELSE
-          Error.WriteString("File <" + fileName^ + "> is not a valid symbol file"); 
-          Error.WriteLn;
-          RETURN;
-        END;
-        mod.print := TRUE;
-        GetSym();
-        IF verbose THEN
-          Error.WriteString("Reading " + mod.name^); Error.WriteLn;
-        END;
-        SymFile(mod);
-        GPBinFiles.CloseFile(file);
+	  ELSE
+	    mod.pathName := mod.symName;
+	  END;
+	  IF verbose THEN
+	    Console.WriteString("Opened " + mod.pathName^); Console.WriteLn;
+	  END;
+      marker := readInt();
+      IF marker = RTS.loInt(magic) THEN
+      (* normal case, nothing to do *)
+      ELSIF marker = RTS.loInt(syMag) THEN
+        mod.systemMod := TRUE;
+      ELSE
+        Error.WriteString("File <" + fileName^ + "> is not a valid symbol file"); 
+        Error.WriteLn;
+        RETURN;
+      END;
+      mod.print := TRUE;
+      GetSym();
+      IF verbose THEN
+        Console.WriteString("Reading " + mod.name^); Console.WriteLn;
       END;
+      SymFile(mod);
+      GPBinFiles.CloseFile(file);
     END;
+  END Parse;
+
+  PROCEDURE WrapParse();
+  BEGIN
+    Parse();
   RESCUE (x)
     Error.WriteString("Error in Parse()"); Error.WriteLn;
     Error.WriteString(RTS.getStr(x)); Error.WriteLn;
-  END Parse;
+  END WrapParse;
 
 (* ===================================================================== *)
 
@@ -1417,6 +1471,7 @@ END WriteTypeDecl;
 (* FIXME *)
 PROCEDURE (o : Output) MethRef(IN nam : ARRAY OF CHAR),NEW,EMPTY;
 PROCEDURE (o : Output) MethAnchor(IN nam : ARRAY OF CHAR),NEW,EMPTY;
+PROCEDURE (o : Output) WriteLinefold(indent : INTEGER),NEW,EMPTY;
 (* FIXME *)
 
 (* ------------------------------------------------------------------- *)
@@ -1601,13 +1656,18 @@ END WriteTypeDecl;
 (* FIXME *)
 PROCEDURE (h : HtmlOutput) MethRef(IN nam : ARRAY OF CHAR);
 BEGIN
-  GPText.WriteString(h.file, '    <a href="#meths-');;
+  GPText.WriteString(h.file,"<b> (* </b>");
+  GPText.WriteString(h.file, '<a href="#meths-');;
   GPText.WriteString(h.file, nam);
   GPText.WriteString(h.file, '">');
+  GPText.WriteString(h.file, "Typebound Procedures");
+(*
   GPText.WriteString(h.file, '<font color="#cc0033">');
-  GPText.WriteString(h.file, "(* Typebound Procedures *)");
+  GPText.WriteString(h.file, "Typebound Procedures");
   GPText.WriteString(h.file, "</font>");
+ *)
   GPText.WriteString(h.file, '</a>');
+  GPText.WriteString(h.file,"<b> *)</b>");
 END MethRef;
 
 PROCEDURE (h : HtmlOutput) MethAnchor(IN nam : ARRAY OF CHAR);
@@ -1616,6 +1676,12 @@ BEGIN
   GPText.WriteString(h.file, nam);
   GPText.WriteString(h.file, '"></a>');
 END MethAnchor;
+
+PROCEDURE (o : HtmlOutput) WriteLinefold(indent : INTEGER);
+BEGIN
+  o.WriteLn;
+  o.Indent(indent);
+END WriteLinefold;
 (* FIXME *)
 
 (* ==================================================================== *)
@@ -1968,7 +2034,7 @@ END MethAnchor;
      (* ##### *)
       FOR i := 0 TO r.intrFaces.tide-1 DO
         output.WriteString(" + ");
-	iTyp := r.intrFaces.list[i](TypeDesc).type;
+        iTyp := r.intrFaces.list[i](TypeDesc).type;
         IF (iTyp IS Record) & (iTyp(Record).ptrType # NIL) THEN
           iTyp(Record).ptrType.Print(0,FALSE);
         ELSE
@@ -1980,7 +2046,10 @@ END MethAnchor;
     END;
 
 (* FIXME *)
-    IF r.methods.tide > 0 THEN
+    IF r.methods.tide > 0 THEN (* If interfaces, then newline + indent? *)
+      IF r.intrFaces.tide > 1 THEN
+        output.WriteLinefold(indent);
+      END;
       IF r.declarer # NIL THEN 
         output.MethRef(r.declarer.name);
       ELSIF (r.ptrType # NIL) & (r.ptrType.declarer # NIL) THEN
@@ -2143,7 +2212,6 @@ END MethAnchor;
       INC(indent,LEN(m.recName$));
     END;
     output.WriteString(":"); 
-    ASSERT(m.receiver.importedFrom = NIL);
     output.WriteString(m.receiver.declarer.name);
     output.WriteString(") ");
     output.WriteIdent(m.declarer.name);
@@ -2172,7 +2240,7 @@ END MethAnchor;
   PROCEDURE (p : Pointer) PrintType(indent : INTEGER),EXTENSIBLE;
   BEGIN
     output.WriteKeyword("POINTER TO ");
-    p.baseType.Print(indent,FALSE);
+    p.boundType.Print(indent,FALSE);
   END PrintType;
 
   PROCEDURE (p : Event) PrintType(indent : INTEGER);
@@ -2272,6 +2340,21 @@ END MethAnchor;
     output.Write("]");
   END PrintDigest;
 
+(* ==================================================================== *)
+
+  PROCEDURE PrintProcType(procTp : Proc; desc : Desc);
+  BEGIN
+    WITH procTp : Meth DO
+      IF procTp.receiver.declarer = NIL THEN
+        procTp.receiver.declarer := desc;
+        procTp.receiver.importedFrom := NIL;
+        procTp.receiver.importedName := NIL;
+      END;
+    ELSE (* skip *)
+    END;
+    procTp.PrintType(0);
+  END PrintProcType;
+
 (* ==================================================================== *)
 
   PROCEDURE PrintModule(mod : Module);
@@ -2281,6 +2364,7 @@ END MethAnchor;
     rec : Record;
     first : BOOLEAN;
     heading : ARRAY 20 OF CHAR;
+    declarer : Desc;
     (* --------------------------- *)
     PROCEDURE WriteOptionalExtras(impMod : Module);
     BEGIN
@@ -2329,6 +2413,11 @@ END MethAnchor;
     END;
    (*  end optional strong name.  *)
     output.WriteLn; output.WriteLn;
+
+    IF (mod.imports.tide > 1) & alpha THEN
+      QuickSortMods(1, mod.imports.tide-1, mod.imports);
+    END;
+
     IF mod.imports.tide > 1 THEN
       output.WriteKeyword("IMPORT"); output.WriteLn;
       output.Indent(4);
@@ -2366,7 +2455,7 @@ END MethAnchor;
     output.WriteLn;
     FOR i := 0 TO mod.types.tide -1 DO 
       ty := mod.types.list[i](UserTypeDesc).type;
-      IF ty IS Pointer THEN ty := ty(Pointer).baseType; END;
+      IF ty IS Pointer THEN ty := ty(Pointer).boundType; END;
       IF ty IS Record THEN
         rec := ty(Record);
 
@@ -2374,18 +2463,19 @@ END MethAnchor;
           QuickSortDescs(0, rec.methods.tide-1, rec.methods);
         END;
 
-(* FIXME *)
         IF rec.methods.tide > 0 THEN
-          IF rec.declarer # NIL THEN 
-            output.MethAnchor(rec.declarer.name);
+          IF rec.declarer # NIL THEN
+            declarer := rec.declarer; 
           ELSIF (rec.ptrType # NIL) & (rec.ptrType.declarer # NIL) THEN
-            output.MethAnchor(rec.ptrType.declarer.name);
+            declarer := rec.ptrType.declarer;
+          ELSE 
+            declarer := NIL;
           END;
-        END;
-(* FIXME *)
+          IF declarer # NIL THEN output.MethAnchor(declarer.name) END;
 
-        FOR j := 0 TO rec.methods.tide -1 DO
-          rec.methods.list[j](ProcDesc).pType.PrintType(0);
+          FOR j := 0 TO rec.methods.tide - 1 DO
+            PrintProcType(rec.methods.list[j](ProcDesc).pType, declarer);
+          END;
         END;
       END;
     END;
@@ -2423,7 +2513,7 @@ END MethAnchor;
  *  NEW(t); t.name := "SPECIAL"; typeList[16] := t;
  *)
   END InitTypes;
- 
+
   PROCEDURE InitAccArray();
   BEGIN
     accArray[0] := ' ';
@@ -2439,46 +2529,52 @@ BEGIN
   Console.WriteString("gardens point Browse: " + GPCPcopyright.verStr);
   Console.WriteLn;
   IF RTS.defaultTarget = "net" THEN
-    Console.WriteString("Usage:  Browse [options] <ModuleName>");
+    Console.WriteString("Usage:  Browse [options] <ModuleNames>");
     Console.WriteLn;
     Console.WriteString("Browse Options ... ");
     Console.WriteLn;
-    Console.WriteString(" /all ==> browse this and all imported modules");
+    Console.WriteString(" /all      ==> browse this and all imported modules");
     Console.WriteLn;
-    Console.WriteString(" /file ==> write output to a file <ModuleName>.bro ");
+    Console.WriteString(" /dst=dir  ==> create output files in directory dir");
     Console.WriteLn;
-    Console.WriteString(" /full ==> display explicit foreign names ");
+    Console.WriteString(" /file     ==> write output to a file <ModuleName>.bro ");
     Console.WriteLn;
-    Console.WriteString(" /help ==> display this usage message");
+    Console.WriteString(" /full     ==> display explicit foreign names ");
     Console.WriteLn;
-    Console.WriteString(" /hex  ==> use hexadecimal for short literals"); 
+    Console.WriteString(" /help     ==> display this usage message");
     Console.WriteLn;
-    Console.WriteString(
-                    " /html ==> write html output to file <ModuleName>.html");
+    Console.WriteString(" /hex      ==> use hexadecimal for short literals"); 
     Console.WriteLn;
-    Console.WriteString(" /sort ==> sort procedures and types alphabetically");
+    Console.WriteString(" /html     ==> write html output to file <ModuleName>.html");
+    Console.WriteLn;
+    Console.WriteString(" /sort     ==> sort procedures and types alphabetically");
+    Console.WriteLn;
+    Console.WriteString(" /verbose  ==> chatter on about progress");
     Console.WriteLn;
     Console.WriteString(" /verbatim ==> display anonymous public type names");
     Console.WriteLn;
   ELSE			(* RTS.defaultTarget = "jvm" *)
-    Console.WriteString("Usage: cprun Browse [options] <ModuleName>");
+    Console.WriteString("Usage: browse [options] <ModuleNames>");
     Console.WriteLn;
     Console.WriteString("Browse Options ... ");
     Console.WriteLn;
-    Console.WriteString(" -all ==> browse this and all imported modules");
+    Console.WriteString(" -all      ==> browse this and all imported modules");
+    Console.WriteLn;
+    Console.WriteString(" -dst:dir  ==> create output files in directory dir");
     Console.WriteLn;
-    Console.WriteString(" -file ==> write output to a file <ModuleName>.bro ");
+    Console.WriteString(" -file     ==> write output to a file <ModuleName>.bro ");
     Console.WriteLn;
-    Console.WriteString(" -full ==> display explicit foreign names ");
+    Console.WriteString(" -full     ==> display explicit foreign names ");
     Console.WriteLn;
-    Console.WriteString(" -help ==> display this usage message");
+    Console.WriteString(" -help     ==> display this usage message");
     Console.WriteLn;
-    Console.WriteString(" -hex  ==> use hexadecimal for short literals"); 
+    Console.WriteString(" -hex      ==> use hexadecimal for short literals"); 
     Console.WriteLn;
-    Console.WriteString(
-	" -html ==> write html output to file <ModuleName>.html");
+    Console.WriteString(" -html     ==> write html output to file <ModuleName>.html");
     Console.WriteLn;
-    Console.WriteString(" -sort ==> sort procedures and types alphabetically");
+    Console.WriteString(" -sort     ==> sort procedures and types alphabetically");
+    Console.WriteLn;
+    Console.WriteString(" -verbose  ==> chatter on about progress");
     Console.WriteLn;
     Console.WriteString(" -verbatim ==> display anonymous public type names");
     Console.WriteLn;
@@ -2499,6 +2595,33 @@ VAR
   fOutput : FileOutput;
   hOutput : HtmlOutput; 
   fileOutput, htmlOutput : BOOLEAN;
+
+   (* ----------------------------------------- *)
+   (*  Note: str is mutable, pat is immutable   *)
+   (* ----------------------------------------- *)
+    PROCEDURE StartsWith(str : ARRAY OF CHAR; IN pat : ARRAY OF CHAR) : BOOLEAN;
+    BEGIN
+      str[LEN(pat$)] := 0X;
+      RETURN str = pat;
+    END StartsWith;
+   (* ----------------------------------------- *)
+    PROCEDURE SuffixString(IN str : ARRAY OF CHAR; ofst : INTEGER) : CharOpen;
+      VAR len : INTEGER;
+          idx : INTEGER;
+          out : CharOpen;
+    BEGIN
+      len := LEN(str$) - ofst;
+      IF len > 0 THEN
+        NEW(out, len + 1);
+        FOR idx := 0 TO len - 1 DO
+          out[idx] := str[ofst + idx];
+        END;
+        out[len] := 0X;
+        RETURN out;
+      END;
+      RETURN NIL;
+    END SuffixString;
+   (* ----------------------------------------- *)
 BEGIN
   printFNames := FALSE;
   fileOutput := FALSE;
@@ -2527,6 +2650,13 @@ BEGIN
       ELSE
         BadOption(option);
       END;
+    ELSIF option[1] = 'd' THEN
+      IF StartsWith(option, "-dst:") OR
+         StartsWith(option, "-dst=") THEN
+        dstPath := SuffixString(option, 5);
+      ELSE
+        BadOption(option);
+      END;
     ELSIF option[1] = 'v' THEN
       IF option = "-verbatim" THEN
         verbatim := TRUE;
@@ -2550,6 +2680,9 @@ BEGIN
       END;
     ELSIF option = "-sort" THEN
       alpha := TRUE;
+    ELSIF option = "-unwind" THEN
+      unwind := TRUE;
+      verbose := TRUE;
     ELSIF option = "-help" THEN
       Usage();
     ELSE
@@ -2560,27 +2693,73 @@ BEGIN
   RETURN argNo;
 END ParseOptions;
 
-PROCEDURE Print();
-VAR
-  i : INTEGER;
-BEGIN
-  FOR i := 0 TO modList.tide-1 DO
-    IF modList.list[i].print THEN
-      output.thisMod := modList.list[i];
-      IF output IS FileOutput THEN
-        output(FileOutput).file := 
-            GPTextFiles.createFile(modList.list[i].name^ + outExt);
-      END;
-      PrintModule(modList.list[i]); 
-      IF output IS FileOutput THEN
-        GPTextFiles.CloseFile(output(FileOutput).file);
+(* ============================================================ *)
+
+  PROCEDURE Print();
+  VAR
+    i : INTEGER;
+    fNamePtr : CharOpen;
+    (* ----------------------------------- *)
+      PROCEDURE mkPathName(IN fileName : ARRAY OF CHAR) : CharOpen;
+        VAR str : CharOpen;
+            sep : ARRAY 2 OF CHAR;
+      BEGIN
+        str := dstPath;
+        IF str[LEN(str) - 2] = GPFiles.fileSep THEN
+          str := BOX(str^ + fileName);
+        ELSE
+          sep[0] := GPFiles.fileSep;
+          str := BOX(str^ + sep + fileName);
+        END;
+        RETURN str;
+      END mkPathName;
+    (* ----------------------------------- *)
+  BEGIN
+    FOR i := 0 TO modList.tide-1 DO
+      IF modList.list[i].print THEN
+        output.thisMod := modList.list[i];
+        IF output IS FileOutput THEN
+          fNamePtr := BOX(modList.list[i].name^ + outExt);
+          IF dstPath = NIL THEN
+            output(FileOutput).file := 
+              GPTextFiles.createFile(fNamePtr^);
+          ELSE
+            fNamePtr := mkPathName(fNamePtr^);
+          output(FileOutput).file := 
+              GPTextFiles.createPath(fNamePtr);
+          END;
+          IF verbose THEN
+            Console.WriteString("Creating " + fNamePtr^);
+            Console.WriteLn;
+          END;
+        END;
+        PrintModule(modList.list[i]); 
+        IF output IS FileOutput THEN
+          GPTextFiles.CloseFile(output(FileOutput).file);
+        END;
       END;
     END;
-  END;
-RESCUE (x)
-  Error.WriteString("Error in Parse()"); Error.WriteLn;
-  Error.WriteString(RTS.getStr(x)); Error.WriteLn;
-END Print;
+  END Print;
+
+(* ============================================================ *)
+ (*
+  *  The hidden option -unwind is a diagnostic aid so 
+  *  that if the Print() procedure throws an exception
+  *  this is NOT caught and a stack-unwind is produced.
+  *
+  *  The default behaviour is for Print to be called via
+  *  WrapPrint(), which catches the exception, producing 
+  *  a simple diagnostic message but no stack-unwind.
+  *)
+  PROCEDURE WrapPrint();
+  BEGIN
+    Print();
+  RESCUE (x)
+    Error.WriteString("Error in Print()"); Error.WriteLn;
+    Error.WriteString(RTS.getStr(x)); Error.WriteLn;
+  END WrapPrint;
+
+(* ============================================================ *)
 
 BEGIN
   NEW(fileName, 256);
@@ -2590,6 +2769,25 @@ BEGIN
   modList.tide := 0;
   NEW(modList.list,5);
   NEW(output);
+
+  IF verbose & unwind THEN
+    args := ProgArgs.ArgNumber();
+    Console.WriteString("Before wildcard expansion"); Console.WriteLn;
+    FOR argNo := 0 TO args - 1 DO 
+      ProgArgs.GetArg(argNo,fileName);
+      Console.WriteString(fileName); Console.WriteLn;
+    END;
+    ProgArgs.ExpandWildcards(0);
+    args := ProgArgs.ArgNumber();
+    Console.WriteString("After wildcard expansion"); Console.WriteLn;
+    FOR argNo := 0 TO args - 1 DO 
+      ProgArgs.GetArg(argNo,fileName);
+      Console.WriteString(fileName); Console.WriteLn;
+    END;
+  ELSE
+    ProgArgs.ExpandWildcards(0);
+  END;
+
   args := ProgArgs.ArgNumber();
   IF (args < 1) THEN Usage(); END; 
   argNo := ParseOptions(); 
@@ -2600,16 +2798,21 @@ BEGIN
       outExt := broExt;
     END; 
   END;
-  WHILE (argNo < args) DO
+  multiMods := (args - argNo) > 1;
+  WHILE argNo < args DO
     ProgArgs.GetArg(argNo,fileName);
     GetSymAndModNames(fileName,modName);
+    IF multiMods & (output IS FileOutput) THEN
+      Console.WriteInt(argNo, 3);
+      Console.WriteString(" Processing "); 
+      Console.WriteString(fileName); Console.WriteLn;
+    END;
     module := GetModule(modName);
-    module.symName := fileName;
     module.progArg := TRUE;
     INC(argNo);
   END;
-  Parse();
-  Print();
+  IF unwind THEN Parse() ELSE WrapParse() END;
+  IF unwind THEN Print() ELSE WrapPrint() END;
 END Browse.
 
 (* ============================================================ *)

gpcp/Builtin.cp

@@ -130,13 +130,14 @@ MODULE Builtin;
 (* ============================================================ *)
 
   PROCEDURE MkDummyImport*(IN  nam : ARRAY OF CHAR;
-			   IN  xNm : ARRAY OF CHAR;
-			   OUT blk : IdDesc.BlkId);
+                           IN  xNm : ARRAY OF CHAR;
+                           OUT blk : IdDesc.BlkId);
     VAR jnk : BOOLEAN;
   BEGIN
     blk := IdDesc.newImpId();
     blk.dfScp   := blk;
     blk.hash    := NameHash.enterStr(nam);
+	blk.SetNameFromHash(blk.hash);
     IF LEN(xNm) > 1 THEN blk.scopeNm := LitValue.strToCharOpen(xNm) END;
     jnk := CompState.thisMod.symTb.enter(blk.hash, blk);
     INCL(blk.xAttr, Symbols.isFn);
@@ -168,6 +169,12 @@ MODULE Builtin;
     jnk := blk.symTb.enter(tId.hash, tId);
   END MkDummyClass;
 
+  PROCEDURE AddDummyBaseTp*(typId : IdDesc.TypId; basId : IdDesc.TypId);
+  BEGIN
+    typId.type(Typ.Pointer).boundTp(Typ.Record).baseTp := 
+                                       basId.type(Typ.Pointer).boundTp;
+  END AddDummyBaseTp;
+
 (* ------------------------------------------------------------	*)
 
   PROCEDURE MkDummyMethodAndInsert*(IN namStr : ARRAY OF CHAR;

gpcp/CPMake.cp

@@ -69,27 +69,27 @@ VAR
   END Warn;
 
   PROCEDURE Usage();
-    CONST jPre = "cprun ";
-	  str1 = "Usage: CPMake [";
-	  str2 = "all] [gpcp-options] <ModuleName>";
+    CONST 
+	  str0 = "Usage: cpmake [-all]";
+	  str1 = "Usage: CPMake [/all]";
+	  str2 = " [gpcp-options] <ModuleNames>";
 	  str3 = "	For gpcp-options, type: ";
-	  str4 = "gpcp ";
-	  str5 = "help";
+	  str4 = "gpcp -help";
+	  str5 = "gpcp /help";
     VAR   isNt : BOOLEAN;
   BEGIN
     Console.WriteString("gardens point CPMake: " + GPCPcopyright.verStr);
     Console.WriteLn;
     isNt := RTS.defaultTarget = "net";
-    IF ~isNt THEN Console.WriteString(jPre) END;
-    Console.WriteString(str1);
-    Console.Write(GPFiles.optChar);
+    IF ~isNt THEN Console.WriteString(str0);
+    ELSE Console.WriteString(str1);
+    END; 
     Console.WriteString(str2);
     Console.WriteLn();
     Console.WriteString(str3);
-    IF ~isNt THEN Console.WriteString(jPre) END;
-    Console.WriteString(str4);
-    Console.Write(GPFiles.optChar);
-    Console.WriteString(str5);
+    IF ~isNt THEN Console.WriteString(str4) 
+    ELSE Console.WriteString(str5);
+    END; 
     Console.WriteLn();
   END Usage;
 

gpcp/CPascalErrors.cp

@@ -8,6 +8,7 @@
 MODULE CPascalErrors;
 
   IMPORT 
+        RTS,
 	GPCPcopyright,
 	GPTextFiles,
 	Console,
@@ -42,12 +43,12 @@ MODULE CPascalErrors;
   VAR
       parsHdlr : ParseHandler;
       semaHdlr : SemanticHdlr;
-      eBuffer  : ErrBuff;	(* Invariant: eBuffer[eTide] = NIL *)
-      eLimit   : INTEGER;	(* High index of dynamic array.    *)
-      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       *)
+      eBuffer  : ErrBuff; (* Invariant: eBuffer[eTide] = NIL *)
+      eLimit   : INTEGER; (* High index of dynamic array.    *)
+      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;
@@ -419,7 +420,7 @@ MODULE CPascalErrors;
     | 153: str := "Bound type of foreign reference type cannot be value param";
     | 154: str := "It is not possible to extend an interface type";
     | 155: str := "NEW illegal unless foreign supertype has no-arg constructor";
-    | 156: str := "Interfaces can't extend anything. Leave blank or use ANYREC";
+    | 156: str := "Interfaces can only extend ANYREC or the target Object type";
     | 157: str := "Only extensions of Foreign classes can implement interfaces";
     | 158: str := "Additional base types must be interface types";
     | 159: str := "Not all interface methods were implemented";
@@ -594,9 +595,25 @@ MODULE CPascalErrors;
 			+ s1 + "> must be extensible");
     | 121: msg := LitValue.strToCharOpen("Missing methods <" + s1 + '>');
     | 145: msg := LitValue.strToCharOpen("Types on cycle <" + s1 + '>');
-    | 129, 
-      130, 
-      132: msg := LitValue.strToCharOpen("Filename <" + s1 + '>');
+
+    | 129: msg := LitValue.strToCharOpen (
+               "Cannot open symbol file <" + s1 + ">" );
+           StoreError(num,lin,0,msg);    
+           INC(Scnr.errors); 
+           RETURN;
+
+    | 130: msg := LitValue.strToCharOpen(
+               "Bad magic number in symbol file <" + s1 + ">" );
+           StoreError(num,lin,0,msg);    
+           INC(Scnr.errors); 
+           RETURN;
+
+    | 132: msg := LitValue.strToCharOpen(
+               "Corrupted symbol file <" + s1 + ">" );
+           StoreError(num,lin,0,msg);    
+           INC(Scnr.errors); 
+           RETURN;
+
     | 133: msg := LitValue.strToCharOpen("Module <" 
 			+ s1 + "> already imported with different key");
     | 138: msg := LitValue.strToCharOpen('<' 
@@ -646,14 +663,6 @@ MODULE CPascalErrors;
       StoreError(num,lin,0,msg);         (* (1) Store THIS message *)
       h.Report(num,lin,col);             (* (2) Generate other msg *)
     END;
-(*
- *  IF (num # 251) & (num # 252) THEN 
- *    StoreError(num,lin,col,msg); 
- *    h.Report(num,lin,col);
- *  ELSIF ~nowarn THEN
- *    StoreError(num,lin,col,msg); 
- *  END;
- *)
   END RepSt1;
 
 (* ============================================================ *)
@@ -661,12 +670,6 @@ MODULE CPascalErrors;
   PROCEDURE (h : SemanticHdlr)RepSt2*(num      : INTEGER;
 				      IN s1,s2 : ARRAY OF CHAR;
 				      lin,col  : INTEGER); 
-(*
- *  VAR str : ARRAY 128 OF CHAR;
- *      msg : Message;
- *      idx : INTEGER;
- *      len : INTEGER;
- *)
     VAR msg : Message;
   BEGIN
     CASE num OF
@@ -683,6 +686,14 @@ MODULE CPascalErrors;
                   "Inherited retType is " + s1 + ", this retType " + s2);
     | 131: msg := LitValue.strToCharOpen(
                   "Module name in file <" + s1 + ".cps> was <" + s2 + '>');
+    | 156: msg := LitValue.strToCharOpen(
+        "Interfaces can only extend ANYREC or the target Object type" + 
+        RTS.eol^ + "     Interface <" + s1 + "> has invalid base type" + 
+        RTS.eol^ + "     Basetype <" + s2 + "> is not the target Object type");
+        StoreError(156, lin, col, msg);
+        INC(Scnr.errors); 
+        RETURN; 
+
     | 172: msg := LitValue.strToCharOpen(
                   'Name <' + s1 + '> clashes in scope <' + s2 + '>');
     | 230: msg := LitValue.strToCharOpen(
@@ -690,14 +701,6 @@ MODULE CPascalErrors;
     | 309: msg := LitValue.strToCharOpen(
                   'Looking for module "' + s1 + '" in file <' + s2 + '>');
     END;
-(*
- *  len := LEN(str$);
- *  NEW(msg, len+1);
- *  FOR idx := 0 TO len-1 DO
- *    msg[idx] := str[idx];
- *  END;
- *  msg[len] := 0X;
- *)
     StoreError(num,lin,col,msg); 
     h.Report(num,lin,col);
   END RepSt2;

gpcp/CPascalP.cp

@@ -336,7 +336,6 @@ VAR
     ident.dfScp := ident;
     ident.hash  := idHsh;
 
-(* FIXME *)
     IF Cs.verbose THEN ident.SetNameFromHash(idHsh) ELSE ident.ClearName() END;
 
     IF ident.hash = Bi.sysBkt THEN
@@ -362,27 +361,27 @@ VAR
       clash.token := ident.token;   (* to help error reports  *)
       IF Cs.verbose THEN clash.SetNameFromHash(clash.hash) END;
       ident := clash(Id.BlkId);
-	 (*
-	  *  If this is the explicit import of a module that
-	  *  has an alias, then all is ok, make import usable.
-	  *)
-	  IF ident.aliasMod # NIL THEN
-	    EXCL(ident.xAttr, Sy.anon);
-		IF alias # NIL THEN (* multiple aliases for same module *)
-		  SemErrorS1(240, Sy.getName.ChPtr(ident.aliasMod));
-		END;
-	 (*
-	  *  If ident is the target of an alias then the 
-	  *  target is also made visible in the module.
-	  *)
-	  ELSIF alias # NIL THEN
-	    ident.aliasMod := alias;	    
      (*
-	  *  Else this really is an error.
-	  *)
+      *  If this is the explicit import of a module that
+      *  has an alias, then all is ok, make import usable.
+      *)
+      IF ident.aliasMod # NIL THEN
+        EXCL(ident.xAttr, Sy.anon);
+        IF alias # NIL THEN (* multiple aliases for same module *)
+          SemErrorS1(240, Sy.getName.ChPtr(ident.aliasMod));
+        END;
+       (*
+        *  If ident is the target of an alias then the 
+	*  target is also made visible in the module.
+	*)
+      ELSIF alias # NIL THEN
+        ident.aliasMod := alias;	    
+     (*
+      *  Else this really is an error.
+      *)
       ELSIF ~ident.isWeak() & 
          (ident.hash # Bi.sysBkt) THEN SemError(170); (* imported twice  *)
-	  END;
+      END;
     ELSE
       SemError(4);
     END;
@@ -402,22 +401,22 @@ VAR
 
     IF Sy.weak IN ident.xAttr THEN
      (*
-	  *  Module ident is a newly declared import.
+      *  Module ident is a newly declared import.
       *  List the file, for importation later  ...
       *)
       Sy.AppendScope(impSeq, ident);
       IF alias # NIL THEN 
-	    INCL(ident.xAttr, Sy.anon);
-	  END;	        
+        INCL(ident.xAttr, Sy.anon);
+      END;	        
       EXCL(ident.xAttr, Sy.weak); (* ==> directly imported *)
       INCL(ident.xAttr, Sy.need); (* ==> needed in symfile *)
-	END;
+    END;
    (*
     *  Alias (if any) must appear after ImpId
     *)
-	IF alias # NIL THEN
-	  alias.dfScp := ident;
-	  Sy.AppendScope(impSeq, alias);
+    IF alias # NIL THEN
+       alias.dfScp := ident;
+       Sy.AppendScope(impSeq, alias);
     END;
   END Import;
   
@@ -449,14 +448,14 @@ VAR
       Import(modScope, Cs.impSeq);
     END;
     Expect(T.semicolonSym);
-	(*
-	 * Now some STA-specific tests.
-	 *)
-	IF Sy.sta IN modScope.xAttr THEN
+   (*
+    * Now some STA-specific tests.
+    *)
+    IF Sy.sta IN modScope.xAttr THEN
       IF Sy.trgtNET THEN
         ImportThreading(modScope, Cs.impSeq);
-       ELSE
-         SemError(238);
+      ELSE
+        SemError(238);
       END;
       IF ~modScope.main THEN 
         SemError(319); 

gpcp/ClassUtil.cp

@@ -624,9 +624,11 @@ MODULE ClassUtil;
     fil.lineNumTabIx := 0;
     fil.jlExceptIx := 0;
     CSt.emitNam := BOX("ClassUtil");
-    IF CSt.doVersion THEN
-      CSt.Message("Using " + CSt.emitNam^ + " emitter" );
-    END;
+(*
+ *  IF CSt.doVersion & CSt.verbose THEN
+ *    CSt.Message("Using " + CSt.emitNam^ + " emitter" );
+ *  END;
+ *)
     RETURN fil;
   END newClassFile;
 
@@ -849,7 +851,7 @@ MODULE ClassUtil;
     NEW(m);
     m.methId := meth;
     IF meth = NIL THEN
-      m.localNum := 0;
+      m.localNum := 2;
       m.maxLocals := 2; (* need 2 for __copy__  'this' + 'arg'*)
     ELSE        (* Id.BlkId *)
       m.localNum := meth.rtsFram;

gpcp/CompState.cp

@@ -247,78 +247,88 @@ MODULE CompState;
 
 PrintLn("       $ gpcp [cp-options] file {file}");
 PrintLn("# CP Options ...");
-PrintLn("       /bindir=XXX  ==> Place binary files in directory XXX");
+PrintLn("  General Options ---");
 PrintLn("       /copyright   ==> Display copyright notice");
-PrintLn("       /cpsym=XXX   ==> Use environ. variable XXX instead of CPSYM");
-PrintLn("       /debug       ==> Generate debugging information (default)");
-PrintLn("       /nodebug     ==> Give up debugging for maximum speed");
 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("       /ilasm       ==> Force compilation via ILASM");
 PrintLn("       /list        ==> (default) Create *.lst file if errors");
 PrintLn("       /list+       ==> Unconditionally create *.lst file");
 PrintLn("       /list-       ==> Don't create error *.lst file");
+PrintLn("       /quiet       ==> Compile silently if possible");
+PrintLn("       /verbose     ==> Emit verbose diagnostics");
+PrintLn("       /version     ==> Write out version number");
+PrintLn("       /warn-       ==> Don't emit warnings");
+PrintLn("       /nowarn      ==> Don't emit warnings");
+PrintLn("  Environment Options ---");
+PrintLn("       /cpsym=XXX   ==> Use environ. variable XXX instead of CPSYM");
+PrintLn("       /hsize=NNN   ==> Set hashtable size >= NNN (0 .. 65000)");
+PrintLn("       /special     ==> Compile dummy symbol file");
+PrintLn("       /strict      ==> Disallow non-standard constructs");
+PrintLn("  Output Options ---");
+PrintLn("       /bindir=XXX  ==> Place binary files in directory XXX");
+PrintLn("       /debug       ==> Generate debugging information (default)");
 PrintLn("       /noasm       ==> Don't create asm (or object) files");
-PrintLn("       /nocode      ==> Don't create any object files");
 PrintLn("       /nocheck     ==> Don't perform arithmetic overflow checks");
+PrintLn("       /nocode      ==> Don't create any object files");
+PrintLn("       /nodebug     ==> Give up debugging for maximum speed");
 PrintLn("       /nosym       ==> Don't create *.sym (or asm or object) files");
-PrintLn("       /perwapi     ==> Force compilation via PERWAPI");
 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("  Code Generation Options ---");
+PrintLn("       /ilasm       ==> (default) Force compilation via ILASM emitter");
 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");
-PrintLn("       /version     ==> Write out version number");
 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    ==> Emit error messages in XML format");
 PrintLn(' Unix-style options: "-option" are recognized also');
 
+(* PrintLn("       /extras      ==> Enable experimental compiler features"); *)
+(* PrintLn("       /perwapi     ==> Force compilation via PERWAPI (Deprecated) "); *)
+(* PrintLn("       /vX.X        ==> (v1.0 | v1.1 | v2.0) CLR target version"); *)
+(* PrintLn("       /whidbey     ==> Target code for Whidbey Beta release"); *)
+
       ELSIF RTS.defaultTarget = "jvm" THEN
 
-PrintLn("       $ cprun gpcp [cp-options] file {file}, OR");
-PrintLn("       $ java [java-options] CP.gpcp.gpcp [cp-options] file {file}");
+PrintLn("       $ gpcp [cp-options] file {file}");
 PrintLn("# CP Options ...");
-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("  General Options ---");
 PrintLn("       -copyright   ==> Display copyright notice");
-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("       -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");
-PrintLn("       -nocode      ==> Don't create any object files");
-PrintLn("       -noasm       ==> Don't create asm (or object) files");
-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) 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("  Environment Options ---");
+PrintLn("       -clsdir:XXX  ==> Set class tree root in directory XXX");
+PrintLn("       -cpsym:XXX   ==> Use environ. variable XXX instead of CPSYM");
+PrintLn("       -hsize:NNN   ==> Set hashtable size >= NNN (0 .. 65000)");
+PrintLn("       -special     ==> Compile dummy symbol file");
+PrintLn("       -strict      ==> Disallow non-standard constructs");
+PrintLn("  Output Options ---");
+PrintLn("       -noasm       ==> Don't create asm (or object) files");
+PrintLn("       -nocode      ==> Don't create any object files");
+PrintLn("       -nosym       ==> Don't create *.sym (or asm or object) files");
+PrintLn("       -symdir:XXX  ==> Place symbol files in directory XXX");
 PrintLn("       -xmlerror    ==> Emit error messages in XML format");
+PrintLn("  Code Generation Options ---");
+PrintLn("       -asm7        ==> Default: Generate class files with V1_7 format");
+PrintLn("       -asmN        ==> Classfiles use V1_N format, N = (5 .. 8)");
+PrintLn("       -jasmin      ==> Create jasmin asm files (but do not run Jasmin)");
+PrintLn("       -legacy      ==> Use the pre-v1.4 jvm class writer");
+PrintLn("       -target:XXX  ==> Emit (jvm|net) assembly");
+
+(* PrintLn("       -extras      ==> Enable experimental compiler features"); *)
 
         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");
+PrintLn("       -DCPSYM=%CPSYM%   pass value of CPSYM environment variable to JRE");
 
         END;
       END;
@@ -471,7 +481,7 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
           copy[6] := 0X;
           IF copy = "help" THEN
             doHelp := TRUE;
-          ELSIF copy = "hsize=" THEN
+          ELSIF (copy = "hsize=") OR (copy = "hsize:") THEN
             ParseSize(opt);
           ELSE
             Unknown(opt);
@@ -480,6 +490,7 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
           IF copy = "ilasm" THEN 
             forceIlasm := TRUE;
             expectedNet := TRUE;
+            Message("ILASM is default emitter for this build");
           ELSE 
             Unknown(opt);
           END;
@@ -528,10 +539,13 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
           ELSE 
             Unknown(opt);
           END;
-          | "p" :
+      | "p" :
           IF copy = "perwapi" THEN
-            forcePerwapi := TRUE;
-            expectedNet := TRUE;
+           (*
+            * forcePerwapi := TRUE;
+            * expectedNet := TRUE;
+            *)
+            Message("PERWAPI is not supported for this build");
           ELSE
             Unknown(opt);
           END;
@@ -655,12 +669,18 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
       *  If gpcp is running on the CLR, then (currently) 
       *  the asm5 emitter is not supported.
       *)
-      IF (RTS.defaultTarget = "net") & doAsm5  THEN
-        Message
-          ("WARNING - gpcp-CLR does not support ASM5, using -legacy emitter"); 
-        doDWC      := TRUE;
-        doCode     := TRUE;
-        doAsm5     := FALSE;
+      IF (RTS.defaultTarget = "net") & (target = "jvm") THEN
+        IF doAsm5  THEN
+          Message
+            ("WARNING - gpcp-CLR does not support ASM5, using -legacy emitter"); 
+          doDWC      := TRUE;
+          doCode     := TRUE;
+          doAsm5     := FALSE;
+        ELSIF ~doDWC THEN
+          Message
+            ("gpcp-CLR will use the -legacy JVM emitter"); 
+          doDWC      := TRUE;
+        END;
       END;
      (* 
       *  If debug is set, for this version, ILASM is used unless /perwapi is explicit
@@ -668,7 +688,9 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
       *)
       IF forceIlasm THEN      doIlasm := TRUE;
       ELSIF forcePerwapi THEN doIlasm := FALSE;
-      ELSE                    doIlasm := debug;
+      ELSE                    
+        (* In version 1.4.0* doIlasm is always true, even with /nodebug *)
+                              doIlasm := TRUE; (* debug; *)
       END;
     END CheckOptionsOK;
 
@@ -744,9 +766,9 @@ PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JR
     unsafe      := FALSE;
     doStats     := FALSE;
     doJsmn      := FALSE;
-    doIlasm     := TRUE;
+    doIlasm     := TRUE;   (* doIlasm is the default currently *)
     forceIlasm  := FALSE;
-    forcePerwapi := FALSE;
+    forcePerwapi := FALSE; (* and stays false in 1.4.04 *)
     doCode      := TRUE;
     doAsm       := TRUE;
     doAsm5      := (RTS.defaultTarget = "jvm");

gpcp/ExprDesc.cp

@@ -972,14 +972,14 @@ MODULE ExprDesc;
           ELSE
             IF ~arg0.isIntExpr() THEN arg0.ExprError(37) END;
             IF ~arg1.isIntExpr() THEN arg1.ExprError(37) END;
-			(* FIXME, no folding yet ... *)
-			IF arg0.type = Builtin.lIntTp THEN
-			  dstT := Builtin.lIntTp;
-			ELSE
+           (* FIXME, no folding yet ... *)
+            IF arg0.type = Builtin.lIntTp THEN
+              dstT := Builtin.lIntTp;
+            ELSE
               IF arg0.type # Builtin.intTp THEN
                 arg0 := convert(arg0, Builtin.intTp);
-			  END;
-			  dstT := Builtin.intTp;
+              END;
+              dstT := Builtin.intTp;
             END;
             IF arg1.type # Builtin.intTp THEN
               arg1 := convert(arg1, Builtin.intTp);
@@ -2173,10 +2173,14 @@ MODULE ExprDesc;
         (x.ident.dfScp = scp) &
         ~x.ident.isIn(lIn) THEN 
       IF x.isPointerExpr() THEN
+       (*
+        * For v1.4.04 + this is an error rather than a warning
+        *)
         x.ExprError(316);
+        x.ExprError(135);
       ELSE
         x.ExprError(135);
-      END;
+      END; 
     END;
     RETURN lIn;
   END checkLive;

gpcp/GPCPcopyright.cp

@@ -1,5 +1,5 @@
 MODULE GPCPcopyright;
-  IMPORT Console;
+  IMPORT RTS, Console;
 
   CONST
      (*	VERSION    = "0.1 of 26 December 1999"; *)
@@ -53,7 +53,9 @@ MODULE GPCPcopyright;
      (* 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 13 June 2017"; 
+     (* VERSION    = "1.4.04 of 07 August 2017"; *)
+     (* VERSION    = "1.4.05 of 11 October 2017"; *)
+        VERSION    = "1.4.06 of 18 February 2018"; 
 	verStr*    = " version " + VERSION;
 
   CONST	prefix     = "#gpcp: ";
@@ -74,7 +76,7 @@ MODULE GPCPcopyright;
     W("GARDENS POINT COMPONENT PASCAL");
     W("The files which import this module constitute a compiler");
     W("for the programming language Component Pascal.");
-    W("Copyright (c) 1998 -- 2013 K John Gough.");
+    W("Copyright (c) 1998 -- 2017 K John Gough.");
     W("Copyright (c) 2000 -- 2013 Queensland University of Technology.");
     Console.WriteLn;
 
@@ -89,8 +91,7 @@ MODULE GPCPcopyright;
     Console.WriteLn;
 
     W("The authoritative version for this program, and all future upgrades");
-    W("is at http://gpcp.codeplex.com. The project page on CodePlex allows");
-    W("discussions, an issue tracker and source code repository");
+    W("is at https://github.com/k-john-gough/gpcp");
     W("The program's news group is GPCP@yahoogroups.com.");
   END Write;
 

gpcp/Hello.cp

@@ -1,9 +1,76 @@
+
 MODULE Hello;
-  IMPORT CPmain, Console;
+  IMPORT CPmain, Console, 
+  GF := GPFiles,
+  BF := GPBinFiles,
+  RTS,
+  Sys := mscorlib_System;
+
+  CONST greet = "Hello ASM World";
+  VAR   file : BF.FILE;
+        indx : INTEGER;
+        pLen : INTEGER;
+        path : POINTER TO ARRAY OF CHAR;
+        char : CHAR;
+        jStr : RTS.NativeString;
 
-  CONST greet = "Hello AsmEmitter world";
+  PROCEDURE WriteArray(IN a : ARRAY OF CHAR);
+    VAR indx : INTEGER;
+        char : CHAR;
+  BEGIN
+    FOR indx := 0 TO LEN(a) - 1 DO
+      char := a[indx];
+      Console.WriteInt(indx, 2);
+      Console.WriteInt(ORD(char), 0);
+      IF char # 0X THEN
+        Console.Write(" ");
+        Console.Write(char);
+      END;
+      Console.WriteLn;
+    END;
+  END WriteArray;
 
 BEGIN
-  Console.WriteString(greet); 
+  Console.WriteString(greet);
   Console.WriteLn;
+  NEW(path, 4);
+  path[0] := "A"; path[1] := "B"; path[2] := "C";
+  WriteArray(path);
+  Console.WriteString(MKSTR(path^)); Console.WriteLn;
+  Console.WriteString(path); Console.WriteLn;
+  Console.WriteString(path^ + " !"); Console.WriteLn;
+  path[3] := "D";
+  WriteArray(path);
+  Console.WriteString(MKSTR(path^)); Console.WriteLn;
+  Console.WriteString(path); Console.WriteLn;
+  Console.WriteString(path^ + " !"); Console.WriteLn;
+
+(*
+  file := BF.findOnPath("CPSYM", "rts.cps");
+  IF file # NIL THEN
+    path := BF.getFullPathName(file);
+    jStr := MKSTR(path^);
+    pLen := LEN(path);
+    Console.WriteString("path length =");
+    Console.WriteInt(pLen, 0); Console.WriteLn;
+    WriteArray(path);
+    Console.WriteString(path^); Console.WriteLn;
+    Console.WriteString(jStr); Console.WriteLn;
+    Console.WriteString(path^ + " was found"); Console.WriteLn;
+    Console.WriteString(jStr + " was found"); Console.WriteLn;
+    path := BOX("foobar");
+    jStr := MKSTR(path^);
+    pLen := LEN(path);
+    Console.WriteString("path length =");
+    Console.WriteInt(pLen, 0); Console.WriteLn;
+    WriteArray(path);
+    Console.WriteString(path^); Console.WriteLn;
+    Console.WriteString(jStr); Console.WriteLn;
+    Console.WriteString(path^ + " was found"); Console.WriteLn;
+    Console.WriteString(jStr + " was found"); Console.WriteLn;
+  ELSE
+    Console.WriteString("File not found"); Console.WriteLn;
+  END;
+ *)
 END Hello.
+

gpcp/IdDesc.cp

@@ -136,7 +136,7 @@ MODULE IdDesc;
     uplevW* = 2;  (* This bit set if local is uplevel written   *)
     uplevA* = 3;  (* This bit is set if Any uplevel access      *)
     cpVarP* = 4;  (* This bit denotes uplevel access to var-par *)
-    xMark* = -1;  (* varOrd is set to xMark is local is uplevel *)
+    xMark* = -1;  (* varOrd is set to xMark if local is uplevel *)
                   (* BUT ... not until after flow attribution!  *)
 
   TYPE
@@ -425,6 +425,10 @@ MODULE IdDesc;
   (** Determine if this block is an indirect module-import. *
    *  Overrides isWeak() for Symbols.Scope.     *)
   BEGIN RETURN D.weak IN s.xAttr END isWeak;
+(* -------------------------------------------- *)
+
+  PROCEDURE (s : BlkId)isNeeded*() : BOOLEAN;
+  BEGIN RETURN D.need IN s.xAttr END isNeeded;
 
 (* -------------------------------------------- *)
 

gpcp/JavaMaker.cp

@@ -243,6 +243,7 @@ MODULE JavaMaker;
         str : Id.TypId;
         exc : Id.TypId;
         xhr : Id.TypId;
+        thr : Id.TypId;
   BEGIN
    (*
     *  Create import descriptor for java.lang
@@ -261,7 +262,14 @@ MODULE JavaMaker;
     CSt.ntvExc := exc.type;
     Bi.MkDummyClass("Class", blk, Ty.noAtt, cls);
     CSt.ntvTyp := cls.type;
-
+   (*
+    * This next solves a perverse problem when java_lang
+    * (jl) is imported *after* RTS. The merging of the two
+    * definitions of java_lang.Exception loses the base
+    * class name jl.Throwable. There are alternative fixes ...
+    *)
+    Bi.MkDummyClass("Throwable", blk, Ty.extns, thr);
+    Bi.AddDummyBaseTp(exc, thr);
    (*
     *  Create import descriptor for CP.RTS
     *)
@@ -526,7 +534,7 @@ MODULE JavaMaker;
           Ju.MkProcName(method);
           Ju.RenumberLocals(method);
         END;
-        this.EmitProc(method)
+        this.EmitProc(method);
       END;
     END;
   END EmitBody;
@@ -562,19 +570,6 @@ MODULE JavaMaker;
       varId := this.mod.locals.a[index](Id.VarId);
       out.EmitField(varId);  
     END;
-    (*
-    FOR index := 0 TO this.mod.procs.tide-1 DO
-     (*
-      *  Create the mangled name for all non-forward procedures
-      *)
-      proc := this.mod.procs.a[index];
-      IF (proc.kind = Id.conPrc) OR 
-         (proc.kind = Id.conMth) THEN
-        Ju.MkProcName(proc);
-        Ju.RenumberLocals(proc);
-      END;
-    END;
-    *)
    (* 
     *  Do all the procs, including <init> and <clinit> 
     *)
@@ -584,18 +579,32 @@ MODULE JavaMaker;
     out.InitVars(this.mod);
     IF this.mod.main THEN
      (*
-      *   Emit <clinit>, and module body as main() 
+      *   This module imports CPmain, so ...
+      *   end emission of <clinit>, and then
+      *   emit module body as main() 
       *)
       out.VoidTail();
       out.MainHead();
       this.EmitStat(this.mod.modBody, returned);
       IF returned THEN
+       (*
+        * The following code is a workaround for a tricky
+        * corner case specific to stack frames in SE 7+.
+        * If the normal return does not reach module end
+        * due to an unterminated loop being the last 
+        * statement, then emission of dead code "return"
+        * will fail verification - as there is no possible
+        * correct stack-frame at that program point.
+        *)
         this.EmitStat(this.mod.modClose, returned);
+        out.VoidTail();
+      ELSE
+        out.EndProc();
       END;
-      out.VoidTail();
     ELSE
      (*
-      *   Emit single <clinit> incorporating module body
+      *   This module does not import CPmain, so ...
+      *   module body is emitted as <clinit>
       *)
       this.EmitStat(this.mod.modBody, returned);
       out.VoidTail();

gpcp/JavaTarget.cp

@@ -3,13 +3,12 @@
 (*  Copyright (c) John Gough 1999, 2017.			*)
 (* ============================================================ *)
 
-MODULE JavaTarget; (* JavaTargetForJVM.cp *)
+MODULE JavaTarget; (* JavaTargetForCLR.cp *)
 
   IMPORT 
         RTS,
 	GPCPcopyright,
 	CompState,
-        AsmUtil,
         JavaUtil,
         ClassUtil;
 
@@ -17,11 +16,7 @@ MODULE JavaTarget; (* JavaTargetForJVM.cp *)
 
   PROCEDURE NewJavaEmitter*(IN fileName : ARRAY OF CHAR) : JavaUtil.JavaFile;
   BEGIN
-    IF CompState.doAsm5 THEN 
-      IF CompState.verbose THEN CompState.Message("Using ASM emitter") END;
-      RETURN AsmUtil.newAsmEmitter(fileName);
-    ELSIF CompState.doDWC THEN 
-      IF CompState.verbose THEN CompState.Message("Using DWC emitter") END;
+    IF CompState.doDWC THEN 
       RETURN ClassUtil.newClassFile(fileName);
     ELSE 
       THROW( "no jvm emitter chosen" );
@@ -30,8 +25,8 @@ MODULE JavaTarget; (* JavaTargetForJVM.cp *)
 
 (* ============================================================ *)
 BEGIN
-  IF RTS.defaultTarget # "jvm" THEN
-    CompState.Abort("Wrong JavaTarget implementation: Use JavaTargetForCLR.cp");
+  IF RTS.defaultTarget = "jvm" THEN
+    CompState.Abort("Wrong JavaTarget implementation: Use JavaTargetForJVM.cp");
   END;
 END JavaTarget.
 (* ============================================================ *)

gpcp/JavaTargetForJVM.cp

@@ -1,3 +1,4 @@
+
 (* ============================================================ *)
 (*  Target is the module which selects the target ClassMaker.	*)
 (*  Copyright (c) John Gough 1999, 2017.			*)
@@ -18,8 +19,10 @@ MODULE JavaTarget; (* JavaTargetForJVM.cp *)
   PROCEDURE NewJavaEmitter*(IN fileName : ARRAY OF CHAR) : JavaUtil.JavaFile;
   BEGIN
     IF CompState.doAsm5 THEN 
+      IF CompState.verbose THEN CompState.Message("Using ASM emitter") END;
       RETURN AsmUtil.newAsmEmitter(fileName);
     ELSIF CompState.doDWC THEN 
+      IF CompState.verbose THEN CompState.Message("Using DWC emitter") END;
       RETURN ClassUtil.newClassFile(fileName);
     ELSE 
       THROW( "no jvm emitter chosen" );

gpcp/JavaUtil.cp

@@ -275,6 +275,21 @@ MODULE JavaUtil;
   PROCEDURE^ typeToChOpen(typ : Sym.Type) : L.CharOpen;
 
 
+(* ============================================================ *)
+  PROCEDURE DiagS*(IN s : ARRAY OF CHAR);
+  BEGIN
+    Console.WriteString(s); Console.WriteLn;
+  END DiagS;
+
+  PROCEDURE DiagSI*(IN s : ARRAY OF CHAR; n : INTEGER);
+  BEGIN
+    Console.WriteString(s); Console.WriteInt(n,0); Console.WriteLn;
+  END DiagSI;
+
+  PROCEDURE DiagSS*(IN p : ARRAY OF CHAR; IN s : ARRAY OF CHAR);
+  BEGIN
+    Console.WriteString(p); Console.WriteString(s); Console.WriteLn;
+  END DiagSS;
 (* ============================================================ *)
 
   PROCEDURE i2CO*( i : INTEGER ) : L.CharOpen;
@@ -1254,7 +1269,8 @@ CSt.Message( "made mNm name " + mNm^ );
 
 (* ------------------------------------------------------------ *)
 (* Proxies are the local variables corresponding to boxed       *)
-(* arguments that are not also passed by value i.e. OUT mode.   *)
+(* arguments that are not also passed by value, for example,    *)
+(* an OUT mode argument returned as the function return.    .   *)
 (* ------------------------------------------------------------ *)
   PROCEDURE NumberProxies(pIdn : Id.Procs; IN pars : Id.ParSeq);
     VAR parId : Id.ParId;
@@ -1356,10 +1372,8 @@ CSt.Message( "made mNm name " + mNm^ );
     *   Count params (and boxes if needed).
     *)
     NumberParams(prcId, frmTp);
-    IF prcId.body # NIL THEN
-      NumberProxies(prcId, frmTp.formals);
-      NumberLocals(prcId, prcId.locals);
-    END;
+    NumberProxies(prcId, frmTp.formals);
+    NumberLocals(prcId, prcId.locals);
   END RenumberLocals;
 
 (* ------------------------------------------------------------ *)

gpcp/JsmnUtil.cp

@@ -466,6 +466,8 @@ MODULE JsmnUtil;
   PROCEDURE (os : JsmnFile)CopyProcHead*(rec : Ty.Record);
   BEGIN
     os.proc := newProcInfo(NIL);
+    os.proc.lNum := 2; (* p0 ~ this, p1 ~ src-arg *)
+    os.proc.lMax := 2;
     os.Comment("standard record copy method");
     os.DirectiveIS(Jvm.dot_method, Jvm.att_public, 
 				"__copy__(" + rec.scopeNm^ + ")V");

gpcp/MakeIndex/BiHtmlWriter.cp

@@ -0,0 +1,137 @@
+
+MODULE BiHtmlWriter;
+  IMPORT 
+    Console,
+    Error,
+    GPFiles,
+    GPTextFiles,
+    Btd := BiTypeDefs,
+    RTS;
+
+(* ============================================================ *)
+
+  TYPE FileWriter* = POINTER TO RECORD file : GPTextFiles.FILE END;
+
+(* ============================================================ *)
+
+  PROCEDURE (w : FileWriter)EOL(),NEW;
+  BEGIN
+    GPTextFiles.WriteEOL(w.file); 
+  END EOL;
+
+  PROCEDURE (w : FileWriter)Text(IN tag : ARRAY OF CHAR),NEW;
+  BEGIN
+    GPTextFiles.WriteNChars(w.file, tag, LEN(tag)-1); 
+  END Text;
+
+  PROCEDURE (w : FileWriter)StartTag(IN tag : ARRAY OF CHAR),NEW;
+  BEGIN
+    GPTextFiles.WriteChar(w.file, '<'); 
+    GPTextFiles.WriteNChars(w.file, tag, LEN(tag)-1); 
+    GPTextFiles.WriteChar(w.file, '>');
+  END StartTag;
+
+  PROCEDURE (w : FileWriter)EndTag(IN tag : ARRAY OF CHAR),NEW;
+  BEGIN
+    GPTextFiles.WriteChar(w.file, '<'); 
+    GPTextFiles.WriteChar(w.file, '/'); 
+    GPTextFiles.WriteNChars(w.file, tag, LEN(tag)-1); 
+    GPTextFiles.WriteChar(w.file, '>');
+  END EndTag;
+
+  PROCEDURE (w : FileWriter)EntireTag(IN tag : ARRAY OF CHAR),NEW;
+  BEGIN
+    GPTextFiles.WriteChar(w.file, '<');
+    GPTextFiles.WriteNChars(w.file, tag, LEN(tag)-1); 
+    GPTextFiles.WriteChar(w.file, '/');
+    GPTextFiles.WriteChar(w.file, '>');
+  END EntireTag;
+
+  PROCEDURE (w : FileWriter)Heading(levl : INTEGER;
+                                 IN text : ARRAY OF CHAR),NEW;
+    VAR hx : ARRAY 3 OF CHAR;
+  BEGIN
+    hx[0] := 'h'; hx[1] := CHR((levl MOD 5) + ORD('0'));
+    w.StartTag(hx); w.Text(text); w.EndTag(hx); w.EOL();
+  END Heading;
+
+  PROCEDURE (w : FileWriter)WriteHref(ref : Btd.FileDescriptor),NEW;
+    VAR i : INTEGER;
+  BEGIN
+    FOR i := 0 TO ref.pkgDepth - 1 DO w.Text("|   ") END; 
+    w.StartTag('a href="' + ref.name^ + '"');
+    w.Text(ref.dotNam);
+    w.EndTag('a');
+    w.EOL();
+  END WriteHref;
+
+(* ============================================================ *)
+
+  PROCEDURE NewHtmlWriter*(IN name : ARRAY OF CHAR;
+                           IN dstP : ARRAY OF CHAR) : FileWriter;
+    VAR wrtr : FileWriter;
+        fSep : ARRAY 2 OF CHAR;
+  BEGIN
+    fSep[0] := GPFiles.fileSep;
+    NEW(wrtr);
+    wrtr.file := GPTextFiles.createPath(dstP + fSep + name);
+    IF wrtr.file = NIL THEN
+      Error.WriteString("Could not create file <");
+      Error.WriteString(dstP + fSep + name + ">, HALTING");
+      Error.WriteLn;
+      HALT(1);
+    END;
+    RETURN wrtr;
+  END NewHtmlWriter;
+
+  PROCEDURE (wrtr : FileWriter)WriteHeader*(),NEW;
+  BEGIN
+    wrtr.StartTag("!DOCTYPE html");
+    wrtr.StartTag("html");
+    wrtr.StartTag("head");
+    wrtr.StartTag("title");
+    wrtr.Text("Html-Index");
+    wrtr.EndTag("title");
+    wrtr.EndTag("head");
+    wrtr.EOL();
+    wrtr.StartTag('body bgcolor="white"');
+    wrtr.EntireTag("hr");
+    wrtr.Heading(1, "Browser File Index");
+    wrtr.EntireTag("hr");
+  END WriteHeader;
+
+  PROCEDURE (wrtr : FileWriter)WriteNamespaceHeader*(prefix : Btd.CharOpen),NEW;
+  BEGIN
+    wrtr.Heading(2, "Namespace " + prefix^);
+    wrtr.EntireTag("hr");
+  END WriteNamespaceHeader;
+
+  PROCEDURE (wrtr : FileWriter)WriteList*(list : VECTOR OF Btd.FileDescriptor),NEW;
+    VAR modIx : INTEGER;
+  BEGIN
+    wrtr.StartTag("pre");
+    FOR modIx := 0 TO LEN(list) - 1 DO wrtr.WriteHref(list[modIx]) END;
+    wrtr.EndTag("pre");
+    wrtr.EntireTag("hr");
+  END WriteList;
+
+  PROCEDURE (wrtr : FileWriter)WriteUnnamedList*(list : VECTOR OF Btd.FileDescriptor),NEW;
+  BEGIN
+    wrtr.Heading(2, "Component Pascal Modules (Native CP)");
+    wrtr.WriteList(list);
+  END WriteUnnamedList;
+
+  PROCEDURE (wrtr : FileWriter)WriteFooter*(),NEW;
+  BEGIN
+    wrtr.EntireTag("hr");
+    wrtr.EndTag("body");
+    wrtr.EndTag("html");
+    GPTextFiles.CloseFile(wrtr.file);
+  END WriteFooter;
+
+(* ============================================================ *)
+
+BEGIN
+END BiHtmlWriter.
+
+

gpcp/MakeIndex/BiStateHandler.cp

@@ -0,0 +1,288 @@
+(* ============================================================ *)
+
+MODULE BiStateHandler;
+
+  IMPORT 
+        RTS,
+        Console,
+        Error,
+        GPFiles,
+        GPBinFiles,
+        ProgArgs,
+        GPTextFiles,
+        Btd := BiTypeDefs,
+        Hwr := BiHtmlWriter;
+
+(* ============================================================ *)
+
+  TYPE
+    FileList = 
+        VECTOR OF Btd.FileDescriptor; (* all with same prefix *)
+
+    PackageList =
+        VECTOR OF FileList;
+
+(* ============================================================ *)
+
+  TYPE
+    PackageInfo = RECORD key : Btd.CharOpen; val : FileList END;
+               
+    PrefixTable = RECORD table : VECTOR OF PackageInfo END;
+                    
+(* ============================================================ *)
+
+  TYPE State* = 
+        POINTER TO RECORD
+          dstPath*    : Btd.CharOpen;
+          prefixTab   : PrefixTable;
+          unnamedList : FileList;
+          verbose*    : BOOLEAN;
+        END; 
+
+(* ============================================================ *)
+
+  VAR nilList     : FileList;
+
+  VAR idx : INTEGER;
+          arg : ARRAY 256 OF CHAR;
+          dstPath : Btd.CharOpen;
+
+(* ============================================================ *)
+
+  PROCEDURE (IN tab : PrefixTable)lookup(IN key : ARRAY OF CHAR) : FileList,NEW;
+    VAR ix : INTEGER;
+  BEGIN
+    FOR ix := 0 TO LEN(tab.table)-1 DO
+      IF key = tab.table[ix].key^ THEN RETURN tab.table[ix].val END;
+    END;
+    RETURN nilList;
+  END lookup;
+
+(* ============================================================ *)
+
+  PROCEDURE (s : State)InitPackageList*(),NEW; 
+    VAR newList : FileList;
+  BEGIN
+    NEW(nilList,2);
+   (*
+    *  Create a FileList for the empty prefix!
+    *  This FileList is NOT in the prefixTab.
+    *)
+    NEW(s.unnamedList, 8);
+   (*
+    *  Create an initially empty prefix lookup table.
+    *)
+    NEW(s.prefixTab.table, 8);
+  END InitPackageList;
+
+(* ============================================================ *)
+
+ (* 
+  *  For each FileList in prefixTab DO
+  *  * Find the min pkgDepth of all the FileDescs on this list
+  *  * Adjust pkgDepth for each FileDesc on the list
+  *)
+  PROCEDURE (s : State)AdjustPkgDepth*(),NEW;
+    VAR pCount, fCount : INTEGER;
+        thisInfo : PackageInfo;
+        thisList : FileList;
+        minDepth : INTEGER;
+  BEGIN
+    FOR pCount := 0 TO LEN(s.prefixTab.table) - 1 DO
+      thisInfo := s.prefixTab.table[pCount];
+      thisList := thisInfo.val;
+      minDepth := 100;
+      FOR fCount := 0 TO LEN(thisList) - 1 DO
+        minDepth := MIN(minDepth, thisList[fCount].pkgDepth);
+      END;
+      FOR fCount := 0 TO LEN(thisList) - 1 DO
+        DEC(thisList[fCount].pkgDepth, minDepth);
+      END;
+    END;
+  END AdjustPkgDepth;
+
+(* ============================================================ *)
+
+  PROCEDURE (s : State)GetFileList(IN label : ARRAY OF CHAR) : FileList,NEW; 
+    VAR result : FileList;
+        pkgInf : PackageInfo;
+  BEGIN
+    result := s.prefixTab.lookup(label);
+    IF LEN(result) = 0 THEN 
+      NEW(result, 4);
+      pkgInf.key := BOX(label);
+      pkgInf.val := result;
+      APPEND(s.prefixTab.table, pkgInf); (* value-copy of pkgInf *)
+    END;
+    RETURN result;
+  END GetFileList;
+
+(* ============================================================ *)
+(*                 Name-manipulation Utilities                  *)
+(* ============================================================ *)
+
+  PROCEDURE GetPrefix(IN name : ARRAY OF CHAR) : Btd.CharOpen;
+    VAR ix : INTEGER;
+        jx : INTEGER;
+        rz : Btd.CharOpen;
+  BEGIN
+    FOR ix := 0 TO LEN(name)-1 DO
+      IF name[ix] = '_' THEN 
+        NEW(rz, ix + 1);
+        FOR jx := 0 TO ix-1 DO rz[jx] := name[jx] END;
+        rz[ix] := 0X;
+        RETURN rz;
+      END;
+    END;
+    RETURN NIL;
+  END GetPrefix;
+
+  PROCEDURE TrimFileExt(IN name : ARRAY OF CHAR) : Btd.CharOpen;
+    VAR ix : INTEGER;
+        jx : INTEGER;
+        rz : Btd.CharOpen;
+  BEGIN
+    FOR ix := LEN(name)-1 TO 0 BY -1 DO
+      IF name[ix] = '.' THEN
+        NEW(rz, ix+1);
+        FOR jx := 0 TO ix-1 DO rz[jx] := name[jx] END;
+        rz[ix] := 0X;
+        RETURN rz;
+      END;
+    END; 
+    RETURN NIL;   
+  END TrimFileExt;
+
+  PROCEDURE WarpCharOpen(name : Btd.CharOpen) : INTEGER;
+    VAR ix : INTEGER;
+        ll : INTEGER; (* number of low_lines *)
+  BEGIN 
+    ll := 0;
+    FOR ix := 0 TO LEN(name)-1 DO
+      IF name[ix] = '_' THEN name[ix] := '.'; INC(ll) END;
+    END;
+    RETURN ll;
+  END WarpCharOpen;
+
+(* ============================================================ *)
+
+  PROCEDURE (s : State)ProcessFileName(IN name : ARRAY OF CHAR),NEW;
+    VAR fileDsc : Btd.FileDescriptor;
+        filLst : FileList;
+  BEGIN
+    NEW(fileDsc);
+    fileDsc.name := BOX(name);
+    fileDsc.dotNam := TrimFileExt(name);
+    fileDsc.prefix := GetPrefix(name);
+    fileDsc.pkgDepth := WarpCharOpen(fileDsc.dotNam);
+    IF fileDsc.prefix = NIL THEN
+      APPEND( s.unnamedList, fileDsc);
+    ELSE
+      filLst := s.GetFileList(fileDsc.prefix);
+      APPEND( filLst, fileDsc );
+    END;
+  END ProcessFileName;
+
+(* ============================================================ *)
+
+  PROCEDURE (s : State)ListFiles*(),NEW;
+    VAR rp, cp : INTEGER;
+        fName  : RTS.NativeString; 
+        files  : POINTER TO ARRAY OF RTS.CharOpen;
+    (* ------------------- *)
+    PROCEDURE EndsWith(name : RTS.CharOpen; 
+                    IN extn : ARRAY OF CHAR) : BOOLEAN;
+      VAR i, j : INTEGER;
+    BEGIN
+      i := LEN(name^); 
+      IF i < LEN(extn) THEN RETURN FALSE END;
+      FOR j := LEN(extn) - 1 TO 0 BY -1 DO
+        DEC(i);
+        IF CAP(name[i]) # CAP(extn[j]) THEN RETURN FALSE END;
+      END;
+      RETURN TRUE;
+    END EndsWith;
+    (* ------------------- *)
+  BEGIN
+    files := GPFiles.FileList(s.dstPath);
+    IF files = NIL THEN 
+      Error.WriteString("No Files for dst = " + s.dstPath^);
+      Error.WriteLn;
+    ELSE
+      FOR rp := 0 TO LEN(files) - 1 DO
+        IF EndsWith(files[rp], ".html") THEN 
+          s.ProcessFileName(files[rp]);
+        END;
+      END;
+    END;
+  END ListFiles;
+
+(* ============================================================ *)
+
+  PROCEDURE (s : State)DiagnosticDump(),NEW;
+    VAR pkgIx : INTEGER;
+        pkgInfo : PackageInfo;
+        fileList : FileList;
+   (* -------------------------- *)
+    PROCEDURE DumpList(fl : FileList);
+      VAR modIx : INTEGER;
+    BEGIN
+      FOR modIx := 0 TO LEN(fl) - 1 DO
+        Console.WriteInt(modIx + 1, 6); Console.Write(" ");
+        Console.WriteString(fl[modIx].name); Console.WriteLn;
+      END;
+    END DumpList;
+   (* -------------------------- *)
+  BEGIN
+    Console.WriteString("Index Diagnostic Dump"); Console.WriteLn;
+    Console.WriteString("    Local CP Modules"); Console.WriteLn;
+    DumpList(s.unnamedList);
+    FOR pkgIx := 0 TO LEN(s.prefixTab.table) - 1 DO
+      pkgInfo := s.prefixTab.table[pkgIx];
+      Console.WriteString(" NameSpace " + pkgInfo.key^); Console.WriteLn;
+      DumpList(pkgInfo.val);
+    END;    
+  END DiagnosticDump;
+
+(* ============================================================ *)
+
+  PROCEDURE (s : State)WriteHtml(),NEW;
+    VAR pkgIx : INTEGER;
+        pkgInfo : PackageInfo;
+        fileList : FileList;
+        writer : Hwr.FileWriter;
+   (* -------------------------- *
+    PROCEDURE WriteList(fl : FileList; wr : Hwr.FileWriter);
+      VAR modIx : INTEGER;
+    BEGIN
+      FOR modIx := 0 TO LEN(fl) - 1 DO wr.WriteHref(fl[modIx]) END;
+    END WriteList;
+    * -------------------------- *)
+  BEGIN
+    s.AdjustPkgDepth();
+    writer := Hwr.NewHtmlWriter("index.html", s.dstPath);
+    writer.WriteHeader();
+    writer.WriteUnnamedList(s.unnamedList);
+    FOR pkgIx := 0 TO LEN(s.prefixTab.table) - 1 DO
+      pkgInfo := s.prefixTab.table[pkgIx];
+      writer.WriteNamespaceHeader(pkgInfo.key);
+      writer.WriteList(pkgInfo.val);
+    END;    
+    writer.WriteFooter();    
+  END WriteHtml;
+
+(* ============================================================ *)
+
+  PROCEDURE (s : State)WriteIndex*(),NEW;
+  BEGIN
+    IF s.verbose THEN s.DiagnosticDump() END;
+    s.WriteHtml();
+  END WriteIndex;
+
+(* ============================================================ *)
+
+BEGIN (* Static code of Module *)
+END BiStateHandler.
+
+(* ============================================================ *)
+  

gpcp/MakeIndex/BiTypeDefs.cp

@@ -0,0 +1,24 @@
+
+MODULE BiTypeDefs;
+  IMPORT RTS;
+
+(* ============================================================ *)
+
+  TYPE
+    CharOpen* = POINTER TO ARRAY OF CHAR;
+
+(* ============================================================ *)
+
+  TYPE
+    FileDescriptor* = 
+        POINTER TO RECORD
+          name* : CharOpen;
+          prefix* : CharOpen;
+          dotNam* : CharOpen;
+          pkgDepth* : INTEGER;
+        END;
+
+(* ============================================================ *)
+
+END BiTypeDefs.
+

gpcp/MakeIndex/MakeIndex.cp

@@ -0,0 +1,96 @@
+
+MODULE MakeIndex;
+
+  IMPORT 
+        RTS,
+        Console,
+        Error,
+        CPmain,
+        ProgArgs,
+        Btd := BiTypeDefs,
+        Bsh := BiStateHandler;
+
+(* ============================================================ *)
+
+  VAR badOption : BOOLEAN;
+
+  VAR idx : INTEGER;
+      arg : ARRAY 256 OF CHAR;
+
+  VAR appState : Bsh.State;
+
+(* ============================================================ *)
+
+  PROCEDURE ParseOption(opt : ARRAY OF CHAR) : BOOLEAN;
+    VAR rst : Btd.CharOpen;
+        arg : ARRAY 256 OF CHAR;
+   (* ----------------------------------------- *)
+   (*  Note: str is mutable, pat is immutable   *)
+   (* ----------------------------------------- *)
+    PROCEDURE StartsWith(str : ARRAY OF CHAR; IN pat : ARRAY OF CHAR) : BOOLEAN;
+    BEGIN (* friendly warping of options *)
+      str[LEN(pat$)] := 0X;
+      RETURN str = pat;
+    END StartsWith;
+   (* ----------------------------------------- *)
+    PROCEDURE SuffixString(IN str : ARRAY OF CHAR; ofst : INTEGER) : Btd.CharOpen;
+      VAR len : INTEGER;
+          idx : INTEGER;
+          out : Btd.CharOpen;
+    BEGIN
+      len := LEN(str$) - ofst;
+      IF len > 0 THEN
+        NEW(out, len + 1);
+        FOR idx := 0 TO len - 1 DO
+          out[idx] := str[ofst + idx];
+        END;
+        out[len] := 0X;
+        RETURN out;
+      END;
+      RETURN NIL;
+    END SuffixString;
+   (* ----------------------------------------- *)
+  BEGIN
+    IF opt[0] = '/' THEN opt[0] := '-' END;
+    IF opt[4] = '=' THEN opt[4] := ':' END;
+    IF StartsWith(opt, "-dst:") THEN
+      appState.dstPath := SuffixString(opt, 5);
+    ELSIF (LEN(opt$) > 4) & StartsWith("-verbose", opt) THEN
+      appState.verbose := TRUE;  
+    ELSE
+      RETURN FALSE;
+    END;
+    RETURN TRUE;
+  END ParseOption;
+
+(* ============================================================ *)
+
+BEGIN (* Static code of Module *)
+  NEW(appState);
+  IF ProgArgs.ArgNumber() = 0 THEN
+    Console.WriteString("Usage: MakeIndex [-verb] -dst:dir"); Console.WriteLn;
+    Console.WriteString("     -dst:dir    - find symfiles in directory 'dir'"); Console.WriteLn;
+    Console.WriteString("     -verb[ose]  - emit progress information."); Console.WriteLn;
+    Console.WriteString("Output file is 'dir\index.html'"); Console.WriteLn;
+    HALT(0);
+  END;
+  FOR idx := 0 TO ProgArgs.ArgNumber() - 1 DO
+    ProgArgs.GetArg(idx, arg);
+    badOption := ~ParseOption(arg);
+    IF badOption THEN
+      Error.WriteString("Bad option: " + arg$ + " HALTING.");
+      Error.WriteLn;
+      HALT(1);
+    END;
+  END;
+  IF appState.dstPath = NIL THEN
+    Error.WriteString("-dst:dir argument is mandatory, HALTING");
+    Error.WriteLn;
+    HALT(1);
+  END;
+  appState.InitPackageList();
+  appState.ListFiles();
+  appState.WriteIndex();
+END MakeIndex.
+
+(* ============================================================ *)

gpcp/MkNetDistro.bat

@@ -0,0 +1,238 @@
+
+@echo off
+REM 
+REM ===================================
+REM This batch file creates a new distribution rooted at .\gpcp-NET
+REM The file must be executed from %CROOT%\sources\gpcp
+REM Most of the files are recompiled from the sources of the distribution
+REM rooted at %CROOT% using the binaries in %CROOT%\bin. However some 
+REM files (documentation, examples, .NET symbols files) are copied
+REM from the existing distribution.
+REM ===================================
+REM
+if defined CROOT goto :init
+echo CROOT is not defined, terminating.
+goto :EOF
+
+:init
+echo CROOT = %CROOT%
+setlocal
+set HOME=%CD%
+set SOURCES_GPCP=%CROOT%\sources\gpcp
+set TRGT=%HOME%\gpcp-NET
+REM Check if this is being executed from %CROOT%\sources\gpcp
+if /i %HOME% == %SOURCES_GPCP% goto :clean
+echo Current directory not %SOURCES_GPCP%, terminating
+goto :EOF
+
+:clean
+REM ===================================
+echo Cleaning old gpcp-NET filetree
+REM ===================================
+if exist gpcp-NET rmdir /s /q gpcp-NET 
+
+REM
+REM - Make sure that JavaTarget.cp is the CLR version.
+REM
+copy JavaTargetForCLR.cp JavaTarget.cp
+
+mkdir gpcp-NET\bin
+mkdir gpcp-NET\sources
+mkdir gpcp-NET\symfiles
+mkdir gpcp-NET\documentation\Examples
+mkdir gpcp-NET\symfiles\NetSystem
+mkdir gpcp-NET\symfiles\HtmlBrowseFiles
+
+REM ===================================
+echo Building C# library implementations
+REM ===================================
+CD %CROOT%\sources\libs\csharp
+set TOOL="CSC"
+csc /t:library /debug /nologo RTS.cs
+if errorlevel 1 goto :fail
+csc /t:library /debug /nologo GPFiles.cs
+if errorlevel 1 goto :fail
+csc /t:library /r:GPFiles.dll /debug /nologo GPBinFiles.cs
+if errorlevel 1 goto :fail
+csc /t:library /r:GPFiles.dll /debug /nologo GPTextFiles.cs
+if errorlevel 1 goto :fail
+REM ===================================
+echo moving PE files to TRGT\bin
+REM ===================================
+move *.dll %TRGT%\bin
+move *.pdb %TRGT%\bin
+CD %HOME%\libs\csharp
+REM ===================================
+echo compiling MsilAsm 
+REM ===================================
+csc /t:library /debug /nologo MsilAsm.cs
+if errorlevel 1 goto :fail
+move MsilAsm.dll %TRGT%\bin
+move MsilAsm.pdb %TRGT%\bin
+REM
+REM The source of PeToCpsUtils.cp is included.
+REM It is required to allow PeToCps v1.4.06 to be
+REM compiled using the gpcp v1.4.04 executables. 
+REM It is not required when re-compiling with gpcp 1.4.06
+REM
+REM csc /t:library /debug /nologo PeToCpsUtils.cs
+REM PeToCps PeToCpsUtils.dll
+REM move PeToCpsUtils.dll %TRGT%\bin
+REM move PeToCpsUtils.pdb %TRGT%\bin
+REM move PeToCpsUtils_.cps %TRGT%\symfiles
+REM if errorlevel 1 goto :fail
+REM move MsilAsm.dll %TRGT%\bin
+REM move MsilAsm.pdb %TRGT%\bin
+REM 
+REM ===================================
+echo Compiling CP library sources
+REM ===================================
+set TOOL="gpcp"
+CD %CROOT%\sources\libs\cpascal
+%CROOT%\bin\gpcp.exe /special /nowarn ASCII.cp Console.cp CPmain.cp Error.cp GPFiles.cp GPBinFiles.cp GPTextFiles.cp ProgArgs.cp RTS.cp STA.cp StdIn.cp WinMain.cp
+if errorlevel 1 goto :fail
+%CROOT%\bin\gpcp.exe /nowarn /bindir=%TRGT%\bin RealStr.cp StringLib.cp
+if errorlevel 1 goto :fail
+move *.cps %TRGT%\symfiles
+del *.il /q
+
+REM ===================================
+echo NOT Copying the PERWAPI symbol files
+REM  Have to leave this in until PERWAPI is removed from distro
+REM ===================================
+REM CD %CROOT%\symfiles
+REM copy QUT_*.cps %TRGT%\symfiles
+
+REM ===================================
+echo Copying the NetSystem symbol files
+REM ===================================
+CD %CROOT%\symfiles\NetSystem
+copy *.cps %TRGT%\symfiles\NetSystem
+
+REM ===================================
+echo Generating html browse files for NetSystem libraries
+REM ===================================
+CD %TRGT%\symfiles\NetSystem
+echo DST=%TRGT%\symfiles\HtmlBrowseFiles
+%CROOT%\bin\Browse.exe /verbose /html /sort /dst:%TRGT%\symfiles\HtmlBrowseFiles *.cps
+if errorlevel 1 goto :fail
+
+REM ===================================
+echo Generating html browse files for CP libraries
+REM ===================================
+CD %TRGT%\symfiles
+set TOOL="Browse"
+%CROOT%\bin\Browse.exe /html /sort /dst:HtmlBrowseFiles *.cps
+
+REM ===================================
+echo Generating index for html browse files
+REM ===================================
+%CROOT%\bin\MakeIndex.exe /verbose /dst:HtmlBrowseFiles
+
+REM ===================================
+echo Building compiler-tools exes and dlls
+REM ===================================
+CD %HOME%
+set TOOL="CPMake"
+%CROOT%\bin\CPMake.exe /all /bindir=%TRGT%\bin /nowarn gpcp
+if errorlevel 1 goto :fail
+set TOOL="gpcp"
+%CROOT%\bin\gpcp.exe /bindir=%TRGT%\bin /nowarn ModuleHandler.cp SymbolFile.cp CPMake.cp
+if errorlevel 1 goto :fail
+%CROOT%\bin\gpcp.exe /bindir=%TRGT%\bin /nowarn Browse.cp
+if errorlevel 1 goto :fail
+%CROOT%\bin\CPMake.exe /all /bindir=%TRGT%\bin /nowarn PeToCps.cp
+if errorlevel 1 goto :fail
+
+REM ===================================
+echo Building MakeIndex.exe
+REM ===================================
+set TOOL="MakeIndex"
+CD %HOME%\MakeIndex
+%CROOT%\bin\CPMake.exe /all /bindir=%TRGT%\bin /nowarn MakeIndex
+if errorlevel 1 goto :fail
+
+REM ===================================
+REM ===================================
+REM  This is only necessary until the new PeToCps
+REM  uses System.Reflection to build symbol files.
+REM ===================================
+REM ===================================
+echo NOT Copying PERWAPI to gpcp-NET\bin
+REM ===================================
+REM CD %CROOT%\bin
+REM copy QUT*.* %TRGT%\bin
+REM ===================================
+
+REM ===================================
+echo Copying the documentation
+REM ===================================
+CD %CROOT%\documentation
+copy *.pdf %TRGT%\documentation
+CD examples
+copy *.* %TRGT%\documentation\Examples
+
+REM ===================================
+echo Getting ready to copy the sources
+REM ===================================
+CD %CROOT%
+mkdir %TRGT%\sources\gpcp\libs\java
+mkdir %TRGT%\sources\gpcp\libs\csharp
+mkdir %TRGT%\sources\gpcp\MakeIndex
+mkdir %TRGT%\sources\libs\java
+mkdir %TRGT%\sources\libs\csharp
+mkdir %TRGT%\sources\libs\cpascal
+
+REM ===================================
+echo Copying GPCP sources
+REM ===================================
+copy sources\gpcp\*.cp %TRGT%\sources\gpcp
+copy sources\gpcp\MkNetDistro.bat %TRGT%\sources\gpcp
+copy sources\gpcp\MakeIndex\*.cp %TRGT%\sources\gpcp\MakeIndex
+copy sources\gpcp\libs\java\MsilAsm.java %TRGT%\sources\gpcp\libs\java
+copy sources\gpcp\libs\csharp\MsilAsm.cs %TRGT%\sources\gpcp\libs\csharp
+
+REM ===================================
+echo Copy helper files for .NET bin directory
+REM ===================================
+copy sources\gpcp\CopyNetLibs.bat %TRGT%\bin
+copy sources\gpcp\_README-NET.txt %TRGT%\bin
+copy sources\gpcp\CopyNetLibs.bat %TRGT%\sources\gpcp
+copy sources\gpcp\_README-NET.txt %TRGT%\sources\gpcp
+
+REM ===================================
+echo Copying CP library sources
+REM ===================================
+copy sources\libs\cpascal\*.cp %TRGT%\sources\libs\cpascal
+copy sources\libs\cpascal\*.bat %TRGT%\sources\libs\cpascal
+
+REM ===================================
+echo Copying C# library sources
+REM ===================================
+copy sources\libs\csharp\*.cs %TRGT%\sources\libs\csharp
+
+REM ===================================
+echo Copying java library sources
+REM ===================================
+copy sources\libs\java\*.* %TRGT%\sources\libs\java
+
+REM ===================================
+echo (Still) Copying PERWAPI-project.zip to gpcp-NET\sources
+REM ===================================
+copy sources\PERWAPI-project.zip %TRGT%\sources
+
+REM ===================================
+echo BUILD SUCCEDED
+REM ===================================
+CD %HOME%
+goto :EOF
+
+:fail
+REM ===================================
+echo BUILD FAILED IN %TOOL%
+REM ===================================
+CD %HOME%
+REM
+REM End of script
+REM
+

gpcp/MsilMaker.cp

@@ -20,7 +20,7 @@ MODULE MsilMaker;
         GPFiles,
         GPBinFiles,
         GPTextFiles,
-        PeUtil,
+        (* PeUtil, *)
         IlasmUtil,
         Nh  := NameHash,
         Scn := CPascalS,
@@ -122,8 +122,10 @@ MODULE MsilMaker;
 (* ============================================================ *)
 
   PROCEDURE (this : MsilEmitter)Init*();
-    VAR tId : Id.TypId;
-        blk : Id.BlkId;
+    VAR sysBlk : Id.BlkId;  (* mscorlib_System            *)
+        rflBlk : Id.BlkId;  (* mscorlib_System_Reflection *)
+        tmpBlk : Id.BlkId;  (* temporary BlkId object     *)
+        mem : Id.TypId;     (* Reflection.MemberInfo      *)
         obj : Id.TypId;
         str : Id.TypId;
         exc : Id.TypId;
@@ -134,33 +136,44 @@ MODULE MsilMaker;
    (*
     *  Create import descriptor for [mscorlib]System
     *)
-    Bi.MkDummyImport("mscorlib_System", "[mscorlib]System", blk);
-	CSt.SetSysLib(blk);
+    Bi.MkDummyImport("mscorlib_System", "[mscorlib]System", sysBlk);
+    Bi.MkDummyImport("mscorlib_System_Reflection", 
+                     "[mscorlib]System.Reflection", rflBlk);
+    CSt.SetSysLib(sysBlk);
    (*
     *  Create various classes.
     *)
-    Bi.MkDummyClass("Object", blk, Ty.isAbs, obj);
+    Bi.MkDummyClass("Object", sysBlk, Ty.isAbs, obj);
     CSt.ntvObj := obj.type;
-    Bi.MkDummyClass("String", blk, Ty.noAtt, str);
+    Bi.MkDummyClass("String", sysBlk, 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.MkDummyClass("Exception", sysBlk, Ty.extns, exc);
     Bi.SetPtrBase(exc, obj);
     CSt.ntvExc := exc.type;
-    Bi.MkDummyClass("Type", blk, Ty.isAbs, typ);
-    Bi.SetPtrBase(typ, obj);
+ 
+   (*
+    *  It is necessary to leave the base type of mscorlib_System.Type
+    *  undefined.  If it *is* defined it will not be overridden by
+    *  an import of mscorlib_System_Reflection which needs to set
+    *  the base type to mscorlib_System_Reflection.MemberInfo.
+    *)
+    Bi.MkDummyClass("MemberInfo", rflBlk, Ty.isAbs, mem);
+    Bi.SetPtrBase(mem, obj);
+    Bi.MkDummyClass("Type", sysBlk, Ty.isAbs, typ);
+    Bi.SetPtrBase(typ, mem);
     CSt.ntvTyp := typ.type;
 
-    Bi.MkDummyClass("Delegate", blk, Ty.extns, del);
+    Bi.MkDummyClass("Delegate", sysBlk, Ty.extns, del);
     Bi.SetPtrBase(del, obj);
-    Bi.MkDummyClass("MulticastDelegate", blk, Ty.extns, evt);
+    Bi.MkDummyClass("MulticastDelegate", sysBlk, Ty.extns, evt);
     Bi.SetPtrBase(evt, del);
     CSt.ntvEvt := evt.type;
 
     (* NEED SOME WORK HERE?? *)
 
-    Bi.MkDummyClass("ValueType", blk, Ty.extns, del);
+    Bi.MkDummyClass("ValueType", sysBlk, Ty.extns, del);
     Bi.SetPtrBase(del, obj);
     CSt.ntvVal := del.type.boundRecTp();
 
@@ -169,34 +182,34 @@ MODULE MsilMaker;
    (*
     *  Create import descriptor for [RTS]RTS
     *)
-    Bi.MkDummyImport("RTS", "[RTS]", blk);
-    Bi.MkDummyAlias("NativeType", blk, typ.type, CSt.clsId);
-    Bi.MkDummyAlias("NativeObject", blk, obj.type, CSt.objId);
-    Bi.MkDummyAlias("NativeString", blk, str.type, CSt.strId);
-    Bi.MkDummyAlias("NativeException", blk, exc.type, CSt.excId);
-    INCL(blk.xAttr, Sy.need);
-    CSt.rtsBlk := blk;
+    Bi.MkDummyImport("RTS", "[RTS]", tmpBlk);
+    Bi.MkDummyAlias("NativeType", tmpBlk, typ.type, CSt.clsId);
+    Bi.MkDummyAlias("NativeObject", tmpBlk, obj.type, CSt.objId);
+    Bi.MkDummyAlias("NativeString", tmpBlk, str.type, CSt.strId);
+    Bi.MkDummyAlias("NativeException", tmpBlk, exc.type, CSt.excId);
+    INCL(tmpBlk.xAttr, Sy.need);
+    CSt.rtsBlk := tmpBlk;
    (*
     *  Uplevel addressing stuff. This is part of RTS assembly.
     *)
-    Bi.MkDummyClass("XHR", blk, Ty.isAbs, typ);
+    Bi.MkDummyClass("XHR", tmpBlk, Ty.isAbs, typ);
     CSt.rtsXHR := typ.type;
     CSt.xhrId.recTyp := CSt.rtsXHR.boundRecTp();
     CSt.xhrId.type   := CSt.rtsXHR;
    (*
     *  Access to [RTS]RTS::dblPosInfinity, etc.
     *)
-    Bi.MkDummyVar("dblPosInfinity", blk, Bi.realTp, CSt.dblInf);
-    Bi.MkDummyVar("dblNegInfinity", blk, Bi.realTp, CSt.dblNInf);
-    Bi.MkDummyVar("fltPosInfinity", blk, Bi.sReaTp, CSt.fltInf);
-    Bi.MkDummyVar("fltNegInfinity", blk, Bi.sReaTp, CSt.fltNInf);
+    Bi.MkDummyVar("dblPosInfinity", tmpBlk, Bi.realTp, CSt.dblInf);
+    Bi.MkDummyVar("dblNegInfinity", tmpBlk, Bi.realTp, CSt.dblNInf);
+    Bi.MkDummyVar("fltPosInfinity", tmpBlk, Bi.sReaTp, CSt.fltInf);
+    Bi.MkDummyVar("fltNegInfinity", tmpBlk, Bi.sReaTp, CSt.fltNInf);
    (*
     *  Access to [RTS]ProgArgs::argList
     *)
-    Bi.MkDummyImport("ProgArgs", "", blk);
-    Bi.MkDummyVar("argList", blk, Ty.mkArrayOf(CSt.ntvStr), CSt.argLst);
-    INCL(blk.xAttr, Sy.rtsMd);
-    CSt.prgArg := blk;
+    Bi.MkDummyImport("ProgArgs", "", tmpBlk);
+    Bi.MkDummyVar("argList", tmpBlk, Ty.mkArrayOf(CSt.ntvStr), CSt.argLst);
+    INCL(tmpBlk.xAttr, Sy.rtsMd);
+    CSt.prgArg := tmpBlk;
   END Init;
 
 (* ============================================================ *)
@@ -741,17 +754,21 @@ MODULE MsilMaker;
         classIx   : INTEGER;
         idDesc    : Sy.Idnt;
         impElem   : Id.BlkId;
-        callApi   : BOOLEAN;
+        callApi   : BOOLEAN; 
   BEGIN
-(*
- *  callApi := CSt.doCode & ~CSt.debug;
- *)
+  (* callApi will become relevant again when we have the Reflection.Emit backend *)
     callApi := CSt.doCode & ~CSt.doIlasm;
     Mu.MkBlkName(this.mod);
     IF callApi THEN
-      out := PeUtil.newPeFile(this.mod.pkgNm, ~this.mod.main);
-      this.outF := out;
+      ASSERT(FALSE);
+      out := NIL;
+     (*
+      * CSt.emitNam := BOX("PERWAPI");
+      * out := PeUtil.newPeFile(this.mod.pkgNm, ~this.mod.main);
+      * this.outF := out;
+      *)
     ELSE (* just produce a textual IL file *)
+      CSt.emitNam := BOX("Ilasm-emit");
       out := IlasmUtil.newIlasmFile(this.mod.pkgNm);
       this.outF := out;
     END;
@@ -1582,7 +1599,6 @@ MODULE MsilMaker;
 	    *)
         out.Code(Asm.opc_shr);
 	  ELSE (* ==> kind = lshInt *)
-	  (* FIXME *)
 	    out.Code(Asm.opc_dup);            (* TOS: rOp, rOp, lOp, ...       *)
 	    out.StoreLocal(temp);             (* TOS: rOp, lOp, ...            *)
 	    out.PushInt(maskSz+1);            (* TOS: 32, rOp, lOp, ...        *)

gpcp/MsilUtil.cp

@@ -774,7 +774,7 @@ MODULE MsilUtil;
     END;
     info.dNum := 0;
     info.dMax := 0;
-    info.rtLc := -1;   (* maybe different for IlasmUtil and PeUtil? *)
+    info.rtLc := -1;   (* maybe different for IlasmUtil and API-writer? *)
   END InitProcInfo;
 
 (* ------------------------------------------------------------ *)

gpcp/NameHash.cp

@@ -68,13 +68,14 @@ MODULE NameHash;
     RTS.Throw(str + V.intToCharOpen(size)^);
   END HashtableOverflow;
 
-(* ============================================================ *)
+
 
   PROCEDURE hashStr(IN str : ARRAY OF CHAR) : INTEGER;
     VAR tot : INTEGER;
 	idx : INTEGER;
 	len : INTEGER;
   BEGIN [UNCHECKED_ARITHMETIC]
+
     (* need to turn off overflow checking *)
     len := LEN(str$);
     tot := 0;
@@ -143,6 +144,7 @@ MODULE NameHash;
     step := 1;
     key  := hashStr(str);
     val  := name[key];
+
     WHILE (val # NIL) & ~equalStr(val,str) DO
       INC(key, step);
       INC(step,2); 

gpcp/NewSymFileRW.cp

@@ -1,9 +1,10 @@
 
+
 (* ==================================================================== *)
-(*									*)
-(*  SymFileRW:  Symbol-file reading and writing for GPCP.		*)
-(*	Copyright (c) John Gough 1999 -- 2011.				*)
-(*									*)
+(*                                                                      *)
+(*  SymFileRW:  Symbol-file reading and writing for GPCP.               *)
+(*          Copyright (c) John Gough 1999 -- 2018.                      *)
+(*                                                                      *)
 (* ==================================================================== *)
 
 MODULE NewSymFileRW;
@@ -32,48 +33,48 @@ MODULE NewSymFileRW;
 // 
 // 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 ...
+//              {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
+//    -- 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
+//    -- 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
+//    -- 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
+//    -- 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
+//    -- 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
+//    -- 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
+//        [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.
+// Name       = namSy byte UTFstring.
 // Literal    = Number | String | Set | Char | Real | falSy | truSy.
 // Byte       = bytSy byte.
 // String     = strSy UTFstring.
@@ -118,37 +119,39 @@ MODULE NewSymFileRW;
         dumped* = -1;
         buffDefault = 1024;
 
+        logPrefix = "Rlog ";
+
 (* ============================================================ *)
 
   TYPE
         SymFile = POINTER TO RECORD 
-        	    file : BF.FILE;
-        	    cSum : INTEGER;
-        	    modS : Id.BlkId;
-        	    iNxt : INTEGER;
-        	    oNxt : INTEGER;
-        	    work : D.TypeSeq;
+                    file : BF.FILE;
+                    cSum : INTEGER;
+                    modS : Id.BlkId;
+                    iNxt : INTEGER;
+                    oNxt : INTEGER;
+                    work : D.TypeSeq;
                     (* Recycled scratch area *)
                     buff : POINTER TO ARRAY OF UBYTE; 
-        	  END;
+                  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;
-                    rScp  : ImpResScope;
-        	    strLen : INTEGER;
-        	    strAtt : Lt.CharOpen;
-                    oArray : D.IdSeq;
-        	    sArray : D.ScpSeq;		(* These two sequences	*)
-  		    tArray : D.TypeSeq;		(* must be private as   *)
-        	  END;				(* file parses overlap. *)
+             file  : BF.FILE;
+             modS  : Id.BlkId;
+             impS  : Id.BlkId;
+             sSym  : INTEGER;
+             cAtt  : CHAR;
+             iAtt  : INTEGER;
+             lAtt  : LONGINT;
+             rAtt  : REAL;
+             rScp  : ImpResScope;
+             strLen : INTEGER;
+             strAtt : Lt.CharOpen;
+             oArray : D.IdSeq;
+             sArray : D.ScpSeq;   (* These two sequences  *)
+             tArray : D.TypeSeq;  (* must be private as   *)
+           END;                   (* file parses overlap. *)
 
 (* ============================================================ *)
 
@@ -159,15 +162,17 @@ MODULE NewSymFileRW;
 
 (* ============================================================ *)
 
-  TYPE	TypeLinker*  = POINTER TO RECORD (D.SymForAll) sym : SymFileReader END;
-  TYPE	SymFileSFA*  = POINTER TO RECORD (D.SymForAll) sym : SymFile END;
-  TYPE	ResolveAll*  = POINTER TO RECORD (D.SymForAll) END;
+  TYPE TypeLinker*  = POINTER TO RECORD (D.SymForAll) sym : SymFileReader END;
+  TYPE SymFileSFA*  = POINTER TO RECORD (D.SymForAll) sym : SymFile END;
+  TYPE ResolveAll*  = POINTER TO RECORD (D.SymForAll) END;
 
 (* ============================================================ *)
 
-  VAR   lastKey : INTEGER;	(* private state for CPMake *)
+  VAR   lastKey : INTEGER; (* private state for CPMake *)
         fSepArr : ARRAY 2 OF CHAR;
 
+  PROCEDURE^ (f : SymFile)EmitType(type : D.Type),NEW;
+
 (* ============================================================ *)
 
   PROCEDURE GetLastKeyVal*() : INTEGER;
@@ -226,12 +231,12 @@ MODULE NewSymFileRW;
     idx := 0;
     chr := ORD(nam[0]);
     WHILE chr # 0H DO
-      IF    chr <= 7FH THEN 		(* [0xxxxxxx] *)
+      IF    chr <= 7FH THEN          (* [0xxxxxxx] *)
         f.buff[num] := USHORT(chr); INC(num);
-      ELSIF chr <= 7FFH THEN 		(* [110xxxxx,10xxxxxx] *)
+      ELSIF chr <= 7FFH THEN         (* [110xxxxx,10xxxxxx] *)
         f.buff[num+1] := USHORT(080H + chr MOD 64); chr := chr DIV 64;
         f.buff[num  ] := USHORT(0C0H + chr); INC(num, 2);
-      ELSE 				(* [1110xxxx,10xxxxxx,10xxxxxxx] *)
+      ELSE                           (* [1110xxxx,10xxxxxx,10xxxxxxx] *)
         f.buff[num+2] := USHORT(080H + chr MOD 64); chr := chr DIV 64;
         f.buff[num+1] := USHORT(080H + chr MOD 64); chr := chr DIV 64;
         f.buff[num  ] := USHORT(0E0H + chr); INC(num, 3);
@@ -269,12 +274,12 @@ MODULE NewSymFileRW;
       IF chr = 0 THEN         (* [11000000, 10000000] *)
         f.buff[num+1] := 080H; 
         f.buff[num  ] := 0C0H; INC(num, 2);
-      ELSIF chr <= 7FH THEN 		(* [0xxxxxxx] *)
+      ELSIF chr <= 7FH THEN         (* [0xxxxxxx] *)
         f.buff[num  ] := USHORT(chr); INC(num);
-      ELSIF chr <= 7FFH THEN 		(* [110xxxxx,10xxxxxx] *)
+      ELSIF chr <= 7FFH THEN        (* [110xxxxx,10xxxxxx] *)
         f.buff[num+1] := USHORT(080H + chr MOD 64); chr := chr DIV 64;
         f.buff[num  ] := USHORT(0C0H + chr); INC(num, 2);
-      ELSE 				(* [1110xxxx,10xxxxxx,10xxxxxxx] *)
+      ELSE                          (* [1110xxxx,10xxxxxx,10xxxxxxx] *)
         f.buff[num+2] := USHORT(080H + chr MOD 64); chr := chr DIV 64;
         f.buff[num+1] := USHORT(080H + chr MOD 64); chr := chr DIV 64;
         f.buff[num  ] := USHORT(0E0H + chr); INC(num, 3);
@@ -304,10 +309,12 @@ MODULE NewSymFileRW;
 (* ======================================= *)
 
   PROCEDURE (f : SymFile)WriteNameForId(idD : D.Idnt),NEW;
+    VAR name : Lt.CharOpen;
   BEGIN
+    name := Nh.charOpenOfHash(idD.hash);
     f.Write(namSy); 
-    f.Write(idD.vMod); 
-    f.WriteNameUTF(Nh.charOpenOfHash(idD.hash));
+    f.Write(idD.vMod);
+    f.WriteNameUTF(name);
   END WriteNameForId;
 
 (* ======================================= *)
@@ -373,8 +380,8 @@ MODULE NewSymFileRW;
     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  *)
+      f.Write(128 + ord MOD 128);  (* LS7-bits first *)
+      f.Write(ord DIV 128);        (* MS8-bits next  *)
     ELSE
       ASSERT(FALSE);
     END;
@@ -417,9 +424,9 @@ MODULE NewSymFileRW;
         *)
         IF (t.bindTp # NIL) & 
            (t.bindTp.dump = 0) THEN 
-          AddToWorklist(f, t.bindTp);		(* First the pointer...  *)
+          AddToWorklist(f, t.bindTp);   (* First the pointer...  *)
         END;
-        AddToWorklist(f, t);			(* Then this record type *)
+        AddToWorklist(f, t);            (* Then this record type *)
       | t : Ty.Pointer DO
        (*
         *  If a pointer to record is being emitted, and 
@@ -430,17 +437,17 @@ MODULE NewSymFileRW;
         *  relationship between the pointer and record.
         *  (It is possible that DCode need record size.)
         *)
-        AddToWorklist(f, t);			(* First this pointer... *)
+        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
-            AddToWorklist(f, t.boundTp);	(* Then the record type  *)
+            AddToWorklist(f, t.boundTp);    (* Then the record type  *)
           END;
         END;
       ELSE (* All others *)
-        AddToWorklist(f, t);			(* Just add the type.    *)
+        AddToWorklist(f, t);            (* Just add the type.    *)
       END;
     END;
     f.WriteOrd(t.dump);
@@ -537,6 +544,7 @@ MODULE NewSymFileRW;
   ** Import = impSy Name.
   *)
   BEGIN
+    IF id.namStr = NIL THEN id.SetNameFromHash(id.hash) END;
     IF D.need IN id.xAttr THEN
       f.Write(impSy);
       f.WriteNameForId(id);
@@ -668,6 +676,12 @@ MODULE NewSymFileRW;
       f.Write(fromS);
       f.WriteOrd(mod);
       f.WriteNameForId(idt);
+	  IF (mod > (f.iNxt - 1)) OR (mod < 0) THEN
+	    Console.WriteString(idt.dfScp.namStr); 
+		Console.Write(".");
+		Console.WriteString(idt.namStr);
+		Console.WriteLn;
+	  END;
     END;
   END EmitTypeHeader;
 
@@ -677,9 +691,6 @@ MODULE NewSymFileRW;
   BEGIN
     f.EmitTypeHeader(t);
     IF ~f.isImportedArray(t) THEN
-(*
- *  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
@@ -701,15 +712,12 @@ MODULE NewSymFileRW;
         method : D.Idnt;
   (*
   **  Record = TypeHeader recSy recAtt [truSy | falSy | <others>] 
-  **		[basSy TypeOrd] [iFcSy {basSy TypeOrd}]
-  **		{Name TypeOrd} {Method} {Statics} endRc.
+  **        [basSy TypeOrd] [iFcSy {basSy TypeOrd}]
+  **        {Name TypeOrd} {Method} {Statics} endRc.
   *)
   BEGIN
     f.EmitTypeHeader(t);
     IF ~f.isImportedRecord(t) THEN
-(*
- *  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;
@@ -717,19 +725,19 @@ MODULE NewSymFileRW;
       f.Write(index);
    (* ########## *)
       IF t.recAtt = Ty.iFace THEN
-  	f.Write(truSy);
+        f.Write(truSy);
       ELSIF CSt.special OR (D.isFn IN t.xAttr) THEN  
         f.Write(falSy);
       END;
    (* ########## *)
-      IF t.baseTp # NIL THEN			(* this is the parent type *)
+      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  *)
+        FOR index := 0 TO t.interfaces.tide-1 DO    (* any interfaces  *)
           f.Write(basSy);
           f.EmitTypeOrd(t.interfaces.a[index]);
         END;
@@ -796,10 +804,6 @@ MODULE NewSymFileRW;
   BEGIN
     f.EmitTypeHeader(t);
     IF ~f.isImportedPointer(t) THEN
-(*
- *  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;
@@ -817,6 +821,18 @@ MODULE NewSymFileRW;
 
 (* ======================================= *)
 
+  PROCEDURE (f : SymFile)EmitType(type : D.Type),NEW;
+  BEGIN
+    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;
+  END EmitType;
+
+
   PROCEDURE (f : SymFile)EmitTypeList(),NEW;
     VAR indx : INTEGER;
         type : D.Type;
@@ -824,17 +840,11 @@ MODULE NewSymFileRW;
    (*
     *   We cannot use a FOR loop here, as the tide changes
     *   during evaluation, as a result of reaching new types.
+    *   (This comment may not be true for the Reflection reader)
     *)
     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;
+      f.EmitType(f.work.a[indx]);
       INC(indx);
     END;
   END EmitTypeList;
@@ -863,8 +873,8 @@ MODULE NewSymFileRW;
   (*
   ** SymFile = Header [String (falSy | truSy | <others>)]
   **            [ VersionName]
-  **		{Import | Constant | Variable
-  **                 | Type | Procedure | Method} TypeList.
+  **            {Import | Constant | Variable
+  **             | Type | Procedure | Method} TypeList.
   ** Header = magic modSy Name.
   ** VersionName= numSy longint numSy longint numSy longint.
   **      --            mj# mn#       bld rv#        8xbyte extract
@@ -894,9 +904,9 @@ MODULE NewSymFileRW;
       IF CSt.verbose THEN CSt.Message("Created " + fNamePtr^) END;
      (* End of alternative gpcp1.2 code *)
       IF D.rtsMd IN m.xAttr THEN
-        marker := RTS.loInt(syMag);	(* ==> a system module *)
+        marker := RTS.loInt(syMag);    (* ==> a system module *)
       ELSE
-        marker := RTS.loInt(magic);	(* ==> a normal module *)
+        marker := RTS.loInt(magic);    (* ==> a normal module *)
       END;
       symfile.Write4B(RTS.loInt(marker));
       symfile.Write(modSy);
@@ -922,7 +932,7 @@ MODULE NewSymFileRW;
       *)
       NEW(symVisit);
       symVisit.sym := symfile;
-      symfile.modS.symTb.Apply(symVisit); 
+      symfile.modS.symTb.Apply(symVisit); (* Apply SymFileSFA to sym-tab *)
      (*
       *  Now emit the types on the worklist.
       *)
@@ -976,9 +986,9 @@ MODULE NewSymFileRW;
     idx := 0;
     WHILE idx < len DO
       chr := read(fil); INC(idx);
-      IF chr <= 07FH THEN		(* [0xxxxxxx] *)
+      IF chr <= 07FH THEN            (* [0xxxxxxx] *)
         rdr.strAtt[num] := CHR(chr); INC(num);
-      ELSIF chr DIV 32 = 06H THEN	(* [110xxxxx,10xxxxxx] *)
+      ELSIF chr DIV 32 = 06H THEN    (* [110xxxxx,10xxxxxx] *)
         bNm := chr MOD 32 * 64;
         chr := read(fil); INC(idx);
         IF chr DIV 64 = 02H THEN
@@ -986,7 +996,7 @@ MODULE NewSymFileRW;
         ELSE
           RTS.Throw(bad);
         END;
-      ELSIF chr DIV 16 = 0EH THEN	(* [1110xxxx,10xxxxxx,10xxxxxxx] *)
+      ELSIF chr DIV 16 = 0EH THEN    (* [1110xxxx,10xxxxxx,10xxxxxxx] *)
         bNm := chr MOD 16 * 64;
         chr := read(fil); INC(idx);
         IF chr DIV 64 = 02H THEN
@@ -1131,18 +1141,6 @@ MODULE NewSymFileRW;
         token    : S.Token;
         index    : INTEGER;
         
-    PROCEDURE NameAndKey(idnt : D.Scope) : Lt.CharOpen;
-      VAR name : Lt.CharOpen;
-          keyV : INTEGER;
-    BEGIN
-      WITH idnt : Id.BlkId DO
-        RETURN BOX(Nh.charOpenOfHash(idnt.hash)^ + 
-                   " : "  + Lt.intToCharOpen(idnt.modKey)^);
-      ELSE
-        RETURN BOX("bad idnt");
-      END; 
-    END NameAndKey;
-    
   BEGIN
     message := NIL;
     token := scope.token;
@@ -1169,12 +1167,10 @@ MODULE NewSymFileRW;
       S.SemError.RepSt1(129, BOX(filNm^ + ".cps"), token.lin, token.col); 
       RETURN;
     ELSE
-      IF CSt.verbose THEN 
-        IF D.weak IN scope.xAttr THEN
-          message := BOX("Implicit import " + filNm^);
-        ELSE
-          message := BOX("Explicit import " + filNm^);
-        END;
+      IF D.weak IN scope.xAttr THEN
+        message := BOX("Implicit import " + filNm^);
+      ELSE
+        message := BOX("Explicit import " + filNm^);
       END;
       marker := readInt(f.file);
       IF marker = RTS.loInt(magic) THEN
@@ -1188,12 +1184,6 @@ MODULE NewSymFileRW;
       END;
       f.GetSym();
       f.SymFile(filNm);
-      IF CSt.verbose THEN 
-        CSt.Message(message^ + ", Key: " + Lt.intToCharOpen(f.impS.modKey)^);
-        FOR index := 0 TO f.sArray.tide - 1 DO
-          CSt.Message("  imports " + NameAndKey(f.sArray.a[index])^);
-        END;
-      END;
       BF.CloseFile(f.file);
     END;
   END Parse;
@@ -1215,7 +1205,7 @@ MODULE NewSymFileRW;
     IF sc.symTb.enter(id.hash, id) THEN
       ident := id;
     ELSE
-      ident := sc.symTb.lookup(id.hash);	(* Warp the return Idnt	*)
+      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;
@@ -1235,7 +1225,7 @@ MODULE NewSymFileRW;
 
   BEGIN
     IF ~tb.enter(id.hash, id) THEN
-      ident := tb.lookup(id.hash);		(* and test isForeign? *)
+      ident := tb.lookup(id.hash);        (* and test isForeign? *)
       IF ident.kind # id.kind THEN Report(id) END;
     END;
   END Insert;
@@ -1252,10 +1242,6 @@ MODULE NewSymFileRW;
       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;
 
@@ -1279,7 +1265,7 @@ MODULE NewSymFileRW;
     | setSy : expr := ExprDesc.mkSetLt(BITS(f.iAtt));
     | strSy : expr := ExprDesc.mkStrLenLt(f.strAtt, f.strLen);
     END;
-    f.GetSym();						(* read past value  *)
+    f.GetSym();                        (* read past value  *)
     RETURN expr;
   END getLiteral;
 
@@ -1289,14 +1275,14 @@ MODULE NewSymFileRW;
     VAR newT : D.Type;
         indx : INTEGER;
   BEGIN
-    IF ord < D.tOffset THEN				(* builtin type	*)	
+    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 := Ty.newTmpTp();                 (* a placeholder *)
         newT.dump := indx; INC(indx);
         D.AppendType(f.tArray, newT);
       UNTIL indx > ord;
@@ -1317,10 +1303,10 @@ MODULE NewSymFileRW;
 (* ============================================ *)
 
   PROCEDURE (f : SymFileReader)getFormalType(rslt : Ty.Procedure;
-        				     indx : INTEGER) : D.Type,NEW;
+                                             indx : INTEGER) : D.Type,NEW;
   (*
   ** FormalType = [retSy TypeOrd] frmSy {parSy Byte TypeOrd [String]} endFm.
-  //	-- optional phrase is return type for proper procedures
+  //    -- optional phrase is return type for proper procedures
   *)
     VAR parD : Id.ParId;
         byte : INTEGER;
@@ -1336,6 +1322,7 @@ MODULE NewSymFileRW;
       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.strAtt); *)
         f.GetSym;
@@ -1350,8 +1337,8 @@ MODULE NewSymFileRW;
 (* ============================================ *)
 
   PROCEDURE (f : SymFileReader)pointerType(old : D.Type) : D.Type,NEW;
-  (* Assert: the current symbol ptrSy 		*)
-  (* Pointer   = TypeHeader ptrSy TypeOrd.	*)
+  (* Assert: the current symbol ptrSy         *)
+  (* Pointer   = TypeHeader ptrSy TypeOrd.    *)
     VAR rslt : Ty.Pointer;
         indx : INTEGER;
         junk : D.Type;
@@ -1381,29 +1368,29 @@ MODULE NewSymFileRW;
 (* ============================================ *)
 
   PROCEDURE (f : SymFileReader)procedureType() : D.Type,NEW;
-  (* Assert: the current symbol is pTpSy.	*)
-  (* ProcType  = TypeHeader pTpSy FormalType.	*)
+  (* Assert: the current symbol is pTpSy.     *)
+  (* ProcType  = TypeHeader pTpSy FormalType. *)
   BEGIN
-    f.GetSym();		(* read past pTpSy *)
+    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.	*)
+  (* Assert: the current symbol is evtSy.    *)
+  (* EventType = TypeHeader evtSy FormalType.    *)
   BEGIN
-    f.GetSym();		(* read past evtSy *)
+    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.		     *)
+  (* Assert: at entry the current symbol is arrSy.             *)
   (* Array      = TypeHeader arrSy TypeOrd (Byte | Number | ) endAr. *)
-  (*	-- nullable phrase is array length for fixed length arrays   *)
+  (*    -- nullable phrase is array length for fixed length arrays   *)
     VAR rslt : Ty.Array;
         eTyp : D.Type;
   BEGIN
@@ -1444,11 +1431,14 @@ MODULE NewSymFileRW;
   PROCEDURE^ (f : SymFileReader)variable()  : Id.VarId,NEW;
 (* ============================================ *)
 
+ (*
+  *  Read a record type from the symbol file.
+  *)
   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.			*)
+  (* 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;
@@ -1475,20 +1465,20 @@ MODULE NewSymFileRW;
     IF attr >= Ty.noNew THEN DEC(attr,Ty.noNew); INCL(rslt.xAttr,D.noNew) END;
 
     rslt.recAtt := attr;
-    f.GetSym();				(* Get past recSy rAtt	*)
+    f.GetSym();                (* Get past recSy rAtt    *)
     IF f.sSym = falSy THEN
-      INCL(rslt.xAttr, D.isFn);
+      INCL(rslt.xAttr, D.isFn);  (* This record type is foreign *)
       f.GetSym();
     ELSIF f.sSym = truSy THEN
-      INCL(rslt.xAttr, D.isFn);
-      INCL(rslt.xAttr, D.fnInf);
-      INCL(rslt.xAttr, D.noCpy);
+      INCL(rslt.xAttr, D.isFn);  (* This record type is foreign *)
+      INCL(rslt.xAttr, D.fnInf); (* This record is an interface *)
+      INCL(rslt.xAttr, D.noCpy); (* Record has no constructor   *)
       f.GetSym();
     END;
    (* 
-	*  Do not override extrnNm values set
-	*  by *Maker.Init for Native* types.
-	*)
+    *  Do not override extrnNm values set
+    *  by *Maker.Init for Native* types.
+    *)
     IF (f.impS.scopeNm # NIL) & (rslt.extrnNm = NIL) THEN
       rslt.extrnNm := f.impS.scopeNm; 
     END;
@@ -1498,10 +1488,10 @@ MODULE NewSymFileRW;
       *  Do not override baseTp values set
       *  by *Maker.Init for Native* types.
       *)
-	  IF rslt.baseTp = NIL THEN
+      IF rslt.baseTp = NIL THEN
         rslt.baseTp := f.typeOf(f.iAtt);
         IF f.iAtt # Ty.anyRec THEN INCL(rslt.xAttr, D.clsTp) END;
-	  END;
+      END;
       f.GetSym();
     END;
     IF f.sSym = iFcSy THEN
@@ -1569,13 +1559,13 @@ MODULE NewSymFileRW;
 (* ============================================ *)
 
   PROCEDURE (f : SymFileReader)enumType() : D.Type,NEW;
-  (* Assert: at entry the current symbol is eTpSy.			*)
-  (* Enum  = TypeHeader eTpSy { Constant} endRc.			*)
+  (* 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 	*)
+    f.GetSym();                (* Get past recSy     *)
     WHILE f.sSym = conSy DO
       f.GetSym();
       cnst := f.constant();
@@ -1589,14 +1579,14 @@ MODULE NewSymFileRW;
 (* ============================================ *)
 
   PROCEDURE (f : SymFileReader)Type(),NEW;
-  (* Type       = typSy Name TypeOrd.		*)
+  (* 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.
+    *   has the property:  id.type.idnt = id.
     *   If oldI # newT, then the new typId has
     *   newT.type.idnt = oldI.
     *)
@@ -1606,39 +1596,43 @@ MODULE NewSymFileRW;
     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;
+   (*
+    * In the case of symbol files created by J2CPS
+    * it is possible that oldI.vMod may be set to the
+    * default value private (0), while the real definition
+    * in newI should be public. ==> override oldI.vMod !
+    *)
+    IF newI.type.idnt = NIL THEN newI.type.idnt := oldI; oldI.SetMode(newI.vMod); END;
   END Type;
 
 (* ============================================ *)
 
   PROCEDURE (f : SymFileReader)Import(),NEW;
-  (* Import     = impSy Name [String] Key.	*)
-  (*	-- optional string is external name	*)
-  (* first symbol should be namSy here.		*)
+  (* 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 *)
+    impD.dfScp := impD;            (* ImpId define their own scope *)
 
     INCL(impD.xAttr, D.weak);
     impD.SetMode(f.iAtt);
     impD.hash := Nh.enterStr(f.strAtt);
     f.ReadPast(namSy); 
-    IF impD.hash = f.modS.hash THEN	(* Importing own imp indirectly	*)
-        				(* Shouldn't this be an error?  *)
+    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.	*)
+    ELSE                (* Importing some other module.    *)
       oldD := testInsert(impD, f.modS);
       IF f.sSym = strSy THEN 
         impD.scopeNm := Lt.arrToCharOpen(f.strAtt, f.strLen);
@@ -1648,9 +1642,9 @@ MODULE NewSymFileRW;
         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);
+          S.SemError.RepSt1(133,        (* Detected bad KeyVal    *)
+            Nh.charOpenOfHash(impD.hash)^, 
+            S.line, S.col);
         END;
       ELSE
         D.AppendScope(f.sArray, impD);
@@ -1663,9 +1657,9 @@ MODULE NewSymFileRW;
 (* ============================================ *)
 
   PROCEDURE (f : SymFileReader)constant() : Id.ConId,NEW;
-  (* Constant = conSy Name Literal.		*)
+  (* Constant = conSy Name Literal.        *)
   (* Name     = namSy byte UTFstring.           *)
-  (* Assert: f.sSym = namSy.			*)
+  (* Assert: f.sSym = namSy.            *)
     VAR newC : Id.ConId;
         anyI : D.Idnt;
   BEGIN
@@ -1682,7 +1676,7 @@ MODULE NewSymFileRW;
 (* ============================================ *)
 
   PROCEDURE (f : SymFileReader)variable() : Id.VarId,NEW;
-  (* Variable   = varSy Name TypeOrd.		*)
+  (* Variable   = varSy Name TypeOrd.        *)
     VAR newV : Id.VarId;
         anyI : D.Idnt;
   BEGIN
@@ -1713,10 +1707,10 @@ MODULE NewSymFileRW;
      (* and leave scopeNm = NIL *)
       f.GetSym();
     END;
-    IF f.sSym = truSy THEN	(* ### this is a constructor ### *)
+    IF f.sSym = truSy THEN    (* ### this is a constructor ### *)
       f.GetSym();
       newP.setPrcKind(Id.ctorP);
-    END;			(* ### this is a constructor ### *)
+    END;            (* ### this is a constructor ### *)
     newP.type := f.getFormalType(Ty.newPrcTp(), 0);
     (* IF this is a java module, do some semantic checks *)
     (* ... *)
@@ -1770,7 +1764,7 @@ MODULE NewSymFileRW;
 
   PROCEDURE (f : SymFileReader)TypeList(),NEW;
   (* TypeList   = start { Array | Record | Pointer      *)
-  (*		  | ProcType | Vector} close.           *)
+  (*          | ProcType | Vector} close.           *)
   (* TypeHeader = tDefS Ord [fromS Ord Name].           *)
     VAR modOrd : INTEGER;
         typOrd : INTEGER;
@@ -1786,18 +1780,19 @@ MODULE NewSymFileRW;
 
    (* ================================ *)
     PROCEDURE getDetails(f : SymFileReader; p : D.Type) : D.Type;
+      VAR rslt : D.Type;
     BEGIN
       CASE f.sSym OF
-      | arrSy : RETURN f.arrayType();
-      | vecSy : RETURN f.vectorType();
-      | recSy : RETURN f.recordType(p);
-      | pTpSy : RETURN f.procedureType();
-      | evtSy : RETURN f.eventType();
-      | eTpSy : RETURN f.enumType();
-      | ptrSy : RETURN f.pointerType(p);
-      ELSE 
-                RETURN Ty.newNamTp();
+      | arrSy : rslt := f.arrayType();      
+      | vecSy : rslt := f.vectorType();     
+      | recSy : rslt := f.recordType(p); 
+      | pTpSy : rslt := f.procedureType();
+      | evtSy : rslt := f.eventType();
+      | eTpSy : rslt := f.enumType();
+      | ptrSy : rslt := f.pointerType(p);   
+      ELSE      rslt := Ty.newNamTp();      
       END;
+      RETURN rslt;
     END getDetails;
    (* ================================ *)
   BEGIN
@@ -1904,6 +1899,8 @@ MODULE NewSymFileRW;
       END;
       f.tArray.a[typIdx] := tpDesc;
     END; (* while *)
+
+
     FOR linkIx := 0 TO f.tArray.tide - 1 DO
       tpDesc := f.tArray.a[linkIx];
      (*
@@ -1926,7 +1923,7 @@ MODULE NewSymFileRW;
       *
       *    set = {D.weak}            ==> module must be imported, but is not
       *                                   on the import worklist at this stage
-      *    set = {D.weak, D.need}   ==> module must be imported, and is 
+      *    set = {D.weak, D.need}    ==> module must be imported, and is 
       *                                   already on the import worklist.
       *)
       IF tpDesc # NIL THEN
@@ -1943,7 +1940,7 @@ MODULE NewSymFileRW;
               END;
             END;
           END;
-        ELSE (* skip *)
+        ELSE (* skip other types *)
         END; (* with *)
       END;
     END; (* for linkIx do *)
@@ -1953,7 +1950,7 @@ MODULE NewSymFileRW;
     *)
     NEW(typeFA);
     typeFA.sym := f;
-    f.impS.symTb.Apply(typeFA); 
+    f.impS.symTb.Apply(typeFA); (* Apply a TypeLinker to the sym-tab *)
     f.ReadPast(close);
    (*
     *  Now check that all overloaded ids are necessary
@@ -1969,8 +1966,8 @@ MODULE NewSymFileRW;
   PROCEDURE (f : SymFileReader)SymFile(IN nm : ARRAY OF CHAR),NEW;
    (*
    // SymFile    = Header [String (falSy | truSy | <others>)]
-   //		{Import | Constant | Variable | Type | Procedure} 
-   //		TypeList Key.
+   //        {Import | Constant | Variable | Type | Procedure} 
+   //        TypeList Key.
    // Header     = magic modSy Name.
    //
    //  magic has already been recognized.
@@ -2084,9 +2081,11 @@ MODULE NewSymFileRW;
 (* ============================================================ *)
 
   PROCEDURE (t : TypeLinker)Op*(id : D.Idnt);
+    VAR oldT : D.Type;
   BEGIN
     IF id.type = NIL THEN RETURN
     ELSIF id.type.kind = Ty.tmpTp THEN
+      oldT := id.type;
       id.type := Ty.update(t.sym.tArray, id.type);
     ELSE
       id.type.TypeFix(t.sym.tArray);
@@ -2101,7 +2100,10 @@ MODULE NewSymFileRW;
 
   PROCEDURE (t : ResolveAll)Op*(id : D.Idnt);
   BEGIN
-    IF id.type # NIL THEN id.type := id.type.resolve(1) END;
+    IF id.type # NIL THEN
+      IF id.namStr = NIL THEN id.SetNameFromHash(id.hash) END;
+      id.type := id.type.resolve(1);
+   END;
   END Op;
 
 (* ============================================================ *)
@@ -2154,18 +2156,18 @@ MODULE NewSymFileRW;
       INC(indx);
     END;
    (*
-	* If sysLib has NOT been explicitly imported, then
-	* insert dummy definitions for the native object methods
-	* so that user code may explictly extend RTS.NativeObject
-	* and override these methods.
-	*)
-	IF ~(D.fixd IN CSt.sysLib.xAttr) THEN 
-	  CSt.ImportObjectFeatures();
-	END;
+    * If sysLib has NOT been explicitly imported, then
+    * insert dummy definitions for the native object methods
+    * so that user code may explictly extend RTS.NativeObject
+    * and override these methods.
+    *)
+    IF ~(D.fixd IN CSt.sysLib.xAttr) THEN 
+         CSt.ImportObjectFeatures();
+    END;
     FOR indx := 0 TO fScp.work.tide-1 DO
       blkI := fScp.work.a[indx](Id.BlkId);
       NEW(rAll);
-      blkI.symTb.Apply(rAll);
+      blkI.symTb.Apply(rAll); (* Apply ResolveAll to sym-tab *)
     END;
    (*
     *  Copy the (possibly mutated) sequence out.

gpcp/PeToCps.cp

@@ -2,9 +2,9 @@
 (* ================================================================ *)
 (*                                                                  *)
 (*  Module of the V1.4+ gpcp tool to create symbol files from       *)
-(*  the metadata of .NET assemblies, using the PERWAPI interface.   *)
+(*  the metadata of .NET assemblies, using System.Reflection API.   *)
 (*                                                                  *)
-(*  Copyright QUT 2004 - 2005.                                      *)
+(*  Copyright QUT 2004 - 2005, K John Gough 2004 - 2018.            *)
 (*                                                                  *)
 (*  This code released under the terms of the GPCP licence.         *)
 (*                                                                  *)
@@ -20,9 +20,12 @@ MODULE PeToCps;
      FileNames,
      Glb := N2State,
      C2T := ClsToType,
-     Per := "[QUT.PERWAPI]QUT.PERWAPI",
+     IdDesc,
+   (*
+    *  Util := PeToCpsUtils_, only needed while bootstrapping v1.4.05
+    *)
      Sys := "[mscorlib]System",
-     IdDesc;
+     SysRfl := "[mscorlib]System.Reflection";
 
   TYPE
     ArgS = ARRAY 256 OF CHAR;
@@ -69,27 +72,25 @@ MODULE PeToCps;
 
 (* ------------------------------------------------------- *)
 
-  PROCEDURE GetVersionInfo(pef : Per.PEFile; 
+  PROCEDURE GetVersionInfo(asm : SysRfl.Assembly; 
                        OUT inf : POINTER TO ARRAY OF INTEGER);
-    CONST tag = "PublicKeyToken=";
-    VAR   asm : Per.Assembly;
-          str : Sys.String;
-          arr : Glb.CharOpen;
-          idx : INTEGER;
-          tok : LONGINT;
-  BEGIN
-    asm := pef.GetThisAssembly();
-    IF (asm.MajorVersion() # 0) & (LEN(asm.Key()) > 0) THEN
-      NEW(inf, 6);
-      tok := asm.KeyTokenAsLong(); 
-      inf[4] := RTS.hiInt(tok);
-      inf[5] := RTS.loInt(tok);
-
-      inf[0] := asm.MajorVersion();
-      inf[1] := asm.MinorVersion();
-      inf[2] := asm.BuildNumber();
-      inf[3] := asm.RevisionNumber();
-
+    VAR   asmNam : SysRfl.AssemblyName;
+          sysVer : Sys.Version;
+          kToken : POINTER TO ARRAY OF UBYTE;
+
+  BEGIN [UNCHECKED_ARITHMETIC]
+    asmNam := asm.GetName();
+    sysVer := asmNam.get_Version();
+    kToken := asmNam.GetPublicKeyToken();
+    IF (sysVer.get_Major() # 0) & (kToken # NIL) & (LEN(kToken) >= 8) THEN 
+      NEW(inf, 6); 
+      inf[4] := (((kToken[0] * 256 + kToken[1]) * 256 + kToken[2]) *256 + kToken[3]);
+      inf[5] := (((kToken[4] * 256 + kToken[5]) * 256 + kToken[6]) *256 + kToken[7]);
+
+      inf[0] := sysVer.get_Major();
+      inf[1] := sysVer.get_Minor();
+      inf[2] := sysVer.get_Revision();
+      inf[3] := sysVer.get_Build();
     ELSE
       inf := NIL;
     END;
@@ -111,50 +112,91 @@ MODULE PeToCps;
 
 (* ==================================================================== *)
 
-  PROCEDURE Process(IN  nam : ARRAY OF CHAR;
-                    OUT rVl : INTEGER);       (* return value *)
-    VAR peFl : Per.PEFile;
-        clss : POINTER TO ARRAY OF Per.ClassDef;
-        indx : INTEGER;
-        nSpc : VECTOR OF C2T.DefNamespace;
-        basS : ArgS;
-        vrsn : POINTER TO ARRAY OF INTEGER;
+  PROCEDURE GetAssembly(IN nam : ARRAY OF CHAR) : SysRfl.Assembly;
+    VAR basS : ArgS;
   BEGIN
-    rVl := 0;
+    Glb.CondMsg(" Reading PE file " + nam);
     FileNames.StripExt(nam, basS);
+    IF (basS = "mscorlib") THEN
+      Glb.AbortMsg("Cannot load mscorlib, use the /mscorlib option instead")
+    END;
+    Glb.GlobInit(nam, basS);
+    RETURN SysRfl.Assembly.(*ReflectionOnly*)LoadFrom(MKSTR(nam));
+  END GetAssembly;
 
-    Glb.CondMsg(" Reading PE file");
-    peFl := Per.PEFile.ReadPublicClasses(MKSTR(nam));
+  PROCEDURE GetMscorlib() : SysRfl.Assembly;
+    VAR objTp : RTS.NativeType;
+  BEGIN
+    Glb.CondMsg(" Reflecting loaded mscorlib assembly");
+    Glb.GlobInit("mscorlib.dll", "mscorlib" );
+    objTp := TYPEOF(RTS.NativeObject);
+    RETURN SysRfl.Assembly.GetAssembly(objTp)
+  END GetMscorlib;
+
+(* ==================================================================== *
+ * PROCEDURE Process(IN  nam : ARRAY OF CHAR;
+ *                   OUT rVl : INTEGER);       (* return value *)
+ * ==================================================================== *)
+
+  PROCEDURE Process(assm : SysRfl.Assembly;
+                OUT rtVl : INTEGER);       (* return value *)
+    VAR indx : INTEGER;
+        nSpc : VECTOR OF C2T.DefNamespace;
 
-    Glb.GlobInit(nam, basS);
+        vrsn : POINTER TO ARRAY OF INTEGER;
+      expTps : POINTER TO ARRAY OF Sys.Type;
+      vecTps : VECTOR OF Sys.Type;
+      asmRfs : POINTER TO ARRAY OF SysRfl.AssemblyName;
+
+  BEGIN
+    rtVl := 0;
+    expTps := assm.GetExportedTypes();
+   (*
+    asmRfs := Util.Utils.GetDependencies(assm);
+    *
+    *)
+    asmRfs := assm.GetReferencedAssemblies();
 
     IF ~Glb.isCorLib THEN C2T.InitCorLibTypes() END;
 
     Glb.CondMsg(" Processing PE file");
-    clss := peFl.GetClasses();
-    C2T.Classify(clss, nSpc);
    (*
-    *  Define BlkId for every namespace
+    *  Classify allocates a new DefNamspace object for each
+    *  namespace. Each object is decorated with an IdDesc.BlkId
+    *  module descriptor, a vector of System.Type objects and 
+    *  another of IdDesc.TypId objects.
+    *  Classes on the expTps list are added to the vector of
+    *  the corresponding namespace. For each such Type object
+    *  a TypId object is created and inserted in the TypId
+    *  vector. Each such TypId is inserted into the symbol 
+	*  table of the BlkId describing that namespace.
+    *)  
+    C2T.Classify(expTps, nSpc);
+   (*
+    *  If the assembly has version/strongname info
+    *  this is propagaed to each namespace of nSpc.
     *)
-    GetVersionInfo(peFl, vrsn);
+    GetVersionInfo(assm, vrsn);
     FOR indx := 0 TO LEN(nSpc) - 1 DO
-      C2T.MakeBlkId(nSpc[indx], Glb.basNam);
       CopyVersionInfo(vrsn, nSpc[indx].bloc);
     END;
-
    (*
-    *  Define TypIds in every namespace
+    *  Each namespace is traversed and an object of an appropriate 
+    *  subtype of Symbols.Type is assigned to the TypId.type field.
+    *  For the structured types the details are added later.
     *)
     FOR indx := 0 TO LEN(nSpc) - 1 DO
       IF ~Glb.isCorLib THEN C2T.ImportCorlib(nSpc[indx]) END;
-      C2T.MakeTypIds(nSpc[indx]); 
+      C2T.AddTypesToIds(nSpc[indx]); 
     END;
     IF Glb.isCorLib THEN C2T.BindSystemTypes() END;
    (*
-    *  Define structure of every class
+    *  The structure of each TypId.type field is now elaborated.
+    *  For record types it is only now that base-type, methods
+    *  and static features are added.
     *)
     FOR indx := 0 TO LEN(nSpc) - 1 DO
-      C2T.DefineClss(nSpc[indx]); 
+      C2T.DefineClss(nSpc[indx]);
     END;
    (*
     *  Write out symbol file(s)
@@ -168,11 +210,11 @@ MODULE PeToCps;
     resS := ExceptionName(sysX);
     Glb.Message(" " + resS^);
     Glb.Message(" " + RTS.getStr(sysX)^);
-    rVl := 4;
+    rtVl := 4;
   END Process;
 
 (* ==================================================================== *)
-(*			      Main Argument Loop			*)
+(*                            Main Argument Loop                        *)
 (* ==================================================================== *)
 
 BEGIN
@@ -185,16 +227,24 @@ BEGIN
     IF (chr0 = '-') OR (chr0 = GPFiles.optChar) THEN (* option string *)
       argS[0] := "-";
       Glb.ParseOption(argS$);
-    ELSE
-      timS := RTS.GetMillis();
-      Process(argS$, errs); 
+    ELSIF Glb.isCorLib THEN
+      Glb.Message("Filename arguments not allowed with /mscorlib");
+      Glb.AbortMsg("Rest of arguments will be skipped");
+    ELSE  
       INC(filN); 
-      IF errs = 0 THEN INC(okNm) END;
+      timS := RTS.GetMillis();
+      Process(GetAssembly(argS$), errs);
       timE := RTS.GetMillis();
-
+      IF errs = 0 THEN INC(okNm) END;
       Glb.Report(argS$, resStr(errs), timE - timS);
     END;
   END;
+  IF Glb.isCorLib THEN
+    timS := RTS.GetMillis();    
+    Process(GetMscorlib(), errs);
+    timE := RTS.GetMillis();
+    Glb.Report(argS$, resStr(errs), timE - timS);
+  END;
   Glb.Summary(filN, okNm, timE - tim0);
  (*
   *  Return the result code of the final compilation

gpcp/PeToCps/MakeNetSystem.bat

@@ -1,96 +0,0 @@
-REM This batch file for .NET Version 2.0 +
-REM build the .NET system CP symbol files
-..\..\..\bin\PeToCps mscorlib.dll
-..\..\..\bin\PeToCps System.dll
-..\..\..\bin\PeToCps System.Drawing.dll
-..\..\..\bin\PeToCps System.Security.dll
-..\..\..\bin\PeToCps /big System.Windows.Forms.dll
-..\..\..\bin\PeToCps System.XML.dll
-..\..\..\bin\PeToCps System.Data.dll
-..\..\..\bin\PeToCps System.Configuration.dll
-REM and then the corresponding HTML Browse files
-..\..\..\bin\Browse /html /sort mscorlib_Microsoft_Win32.cps
-..\..\..\bin\Browse /html /sort mscorlib_System.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Collections.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Configuration_Assemblies.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Diagnostics.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Diagnostics_SymbolStore.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Globalization.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_IO.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_IO_IsolatedStorage.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Reflection.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Reflection_Emit.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Resources.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Runtime_CompilerServices.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Runtime_InteropServices.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Runtime_InteropServices_Expando.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Runtime_Remoting.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Runtime_Remoting_Activation.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Runtime_Remoting_Channels.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Runtime_Remoting_Contexts.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Runtime_Remoting_Lifetime.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Runtime_Remoting_Messaging.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Runtime_Remoting_Metadata.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Runtime_Remoting_Metadata_W3cXsd2001.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Runtime_Remoting_Proxies.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Runtime_Remoting_Services.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Runtime_Serialization.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Runtime_Serialization_Formatters.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Runtime_Serialization_Formatters_Binary.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Security.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Security_Cryptography.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Security_Cryptography_X509Certificates.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Security_Permissions.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Security_Policy.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Security_Principal.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Text.cps
-..\..\..\bin\Browse /html /sort mscorlib_System_Threading.cps
-..\..\..\bin\Browse /html /sort System_.cps
-..\..\..\bin\Browse /html /sort System_Drawing_.cps
-..\..\..\bin\Browse /html /sort System_Drawing__Design.cps
-..\..\..\bin\Browse /html /sort System_Drawing__Drawing2D.cps
-..\..\..\bin\Browse /html /sort System_Drawing__Imaging.cps
-..\..\..\bin\Browse /html /sort System_Drawing__Printing.cps
-..\..\..\bin\Browse /html /sort System_Drawing__Text.cps
-..\..\..\bin\Browse /html /sort System_Microsoft_CSharp.cps
-..\..\..\bin\Browse /html /sort System_Microsoft_VisualBasic.cps
-..\..\..\bin\Browse /html /sort System_Microsoft_Win32.cps
-..\..\..\bin\Browse /html /sort System_Security__Cryptography_Xml.cps
-..\..\..\bin\Browse /html /sort System_Windows_Forms_.cps
-..\..\..\bin\Browse /html /sort System_Windows_Forms_System_Resources.cps
-..\..\..\bin\Browse /html /sort System_Windows_Forms__ComponentModel_Com2Interop.cps
-..\..\..\bin\Browse /html /sort System_Windows_Forms__Design.cps
-..\..\..\bin\Browse /html /sort System_Windows_Forms__PropertyGridInternal.cps
-..\..\..\bin\Browse /html /sort System__CodeDom.cps
-..\..\..\bin\Browse /html /sort System__CodeDom_Compiler.cps
-..\..\..\bin\Browse /html /sort System__Collections_Specialized.cps
-..\..\..\bin\Browse /html /sort System__ComponentModel.cps
-..\..\..\bin\Browse /html /sort System__ComponentModel_Design.cps
-..\..\..\bin\Browse /html /sort System__ComponentModel_Design_Serialization.cps
-..\..\..\bin\Browse /html /sort System__Configuration.cps
-..\..\..\bin\Browse /html /sort System__Diagnostics.cps
-..\..\..\bin\Browse /html /sort System__IO.cps
-..\..\..\bin\Browse /html /sort System__Net.cps
-..\..\..\bin\Browse /html /sort System__Net_Sockets.cps
-..\..\..\bin\Browse /html /sort System__Security_Cryptography_X509Certificates.cps
-..\..\..\bin\Browse /html /sort System__Security_Permissions.cps
-..\..\..\bin\Browse /html /sort System__Text_RegularExpressions.cps
-..\..\..\bin\Browse /html /sort System__Threading.cps
-..\..\..\bin\Browse /html /sort System__Timers.cps
-..\..\..\bin\Browse /html /sort System__Web.cps
-..\..\..\bin\Browse /html /sort System_Xml_.cps
-..\..\..\bin\Browse /html /sort System_Xml__Schema.cps
-..\..\..\bin\Browse /html /sort System_Xml__XPath.cps
-..\..\..\bin\Browse /html /sort System_Xml__Xsl.cps
-..\..\..\bin\Browse /html /sort System_Xml__Serialization.cps
-..\..\..\bin\Browse /html /sort System_Xml__Serialization_Advanced.cps
-..\..\..\bin\Browse /html /sort System_Xml__Serialization_Configuration.cps
-..\..\..\bin\Browse /html /sort System_Data_.cps
-..\..\..\bin\Browse /html /sort System_Data__Common.cps
-..\..\..\bin\Browse /html /sort System_Data__Odbc.cps
-..\..\..\bin\Browse /html /sort System_Data__OleDb.cps
-..\..\..\bin\Browse /html /sort System_Data__SqlClient.cps
-..\..\..\bin\Browse /html /sort System_Data__SqlTypes.cps
-..\..\..\bin\Browse /html /sort System_Data_System_Xml.cps
-..\..\..\bin\Browse /html /sort System_Configuration_.cps
-

gpcp/PeUtil.cp

@@ -1,396 +0,0 @@
-(* ============================================================ *)
-(*  PeUtil is the module which writes PE files using the        *)
-(*  managed interface.                                          *)
-(*  Copyright (c) John Gough 1999, 2000.                        *)
-(* ============================================================ *)
-(* ============================================================ *)
-(*  THIS IS THE EMPTY VERSION, THAT IS REQUIRED TO BOOTSTRAP    *)
-(*  THE JVM VERSION WITHOUT THE MSCORLIB ASSEMBLY AVAILABLE.    *)
-(* ============================================================ *)
-(* ============================================================ *)
-
-MODULE PeUtil;
-
-  IMPORT 
-        GPCPcopyright,
-        Mu  := MsilUtil,
-        Id  := IdDesc,
-        Lv  := LitValue,
-        Sy  := Symbols,
-        Ty  := TypeDesc;
-
-(* ============================================================ *)
-
-  TYPE PeFile*    = POINTER TO RECORD (Mu.MsilFile)
-                 (*   Fields inherited from MsilFile *
-                  *   srcS* : LitValue.CharOpen; (* source file name   *)
-                  *   outN* : LitValue.CharOpen; (* output file name   *)
-                  *   proc* : ProcInfo;
-                  *)
-                    END;
-
-(* ============================================================ *)
-(*                    Constructor Method                        *)
-(* ============================================================ *)
-
-  PROCEDURE newPeFile*(IN nam : ARRAY OF CHAR; isDll : BOOLEAN) : PeFile;
-  BEGIN
-    RETURN NIL;
-  END newPeFile;
-
-(* ============================================================ *)
-
-  PROCEDURE (t : PeFile)fileOk*() : BOOLEAN;
-  BEGIN
-    RETURN FALSE;
-  END fileOk;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkNewProcInfo*(proc : Sy.Scope);
-  BEGIN
-  END MkNewProcInfo;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)newLabel*() : Mu.Label;
-  BEGIN
-    RETURN NIL;
-  END newLabel;
-
-(* ============================================================ *)
-(*                    Exported Methods                  *)
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MethodDecl*(attr : SET; proc : Id.Procs);
-  END MethodDecl;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)ExternList*();
-  END ExternList;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)DefLab*(l : Mu.Label);
-  END DefLab;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)DefLabC*(l : Mu.Label; IN c : ARRAY OF CHAR);
-  END DefLabC;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)Code*(code : INTEGER);
-  END Code;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeI*(code,int : INTEGER);
-  END CodeI;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeT*(code : INTEGER; type : Sy.Type);
-  END CodeT;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeTn*(code : INTEGER; type : Sy.Type);
-  END CodeTn;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeL*(code : INTEGER; long : LONGINT);
-  END CodeL;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeR*(code : INTEGER; real : REAL);
-  END CodeR;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeLb*(code : INTEGER; labl : Mu.Label);
-  END CodeLb;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)StaticCall*(s : INTEGER; d : INTEGER);
-  END StaticCall;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeS*(code : INTEGER; str : INTEGER);
-  END CodeS;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)Try*();
-  END Try;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)Catch*(proc : Id.Procs);
-  END Catch;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CloseCatch*();
-  END CloseCatch;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CopyCall*(typ : Ty.Record);
-  END CopyCall;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)PushStr*(IN str : ARRAY OF CHAR);
-  END PushStr;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)CallIT*(code : INTEGER; 
-                                 proc : Id.Procs; 
-                                 type : Ty.Procedure);
-  END CallIT;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)CallCT*(proc : Id.Procs; 
-                                 type : Ty.Procedure);
-  END CallCT;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)CallDelegate*(typ : Ty.Procedure);
-  END CallDelegate;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)PutGetS*(code : INTEGER;
-                                  blk  : Id.BlkId;
-                                  fId  : Id.VarId);
-  END PutGetS;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)GetValObj*(code : INTEGER; ptrT : Ty.Pointer);
-  END GetValObj;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)PutGetXhr*(code : INTEGER; 
-                                    proc : Id.Procs; 
-                                    locl : Id.LocId);
-  END PutGetXhr;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)PutGetF*(code : INTEGER;
-                                  fId  : Id.FldId);
-  END PutGetF;
-
-(* ============================================================ *)
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkNewRecord*(typ : Ty.Record);
-  END MkNewRecord;
-
-(* ============================================================ *)
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkNewProcVal*(p : Sy.Idnt;   (* src Proc *)
-                                       t : Sy.Type);  (* dst Type *)
-  END MkNewProcVal;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)CallSuper*(rTp : Ty.Record;
-                                    prc : Id.PrcId);
-  END CallSuper;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)InitHead*(rTp : Ty.Record;
-                                   prc : Id.PrcId);
-  END InitHead;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)CopyHead*(typ : Ty.Record);
-  END CopyHead;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MarkInterfaces*(IN seq : Sy.TypeSeq);
-  END MarkInterfaces;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MainHead*(xAtt : SET);
-  END MainHead;
-
-  PROCEDURE (os : PeFile)SubSys*(xAtt : SET);
-  END SubSys;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)StartBoxClass*(rec : Ty.Record;
-                                        att : SET;
-                                        blk : Id.BlkId);
-  END StartBoxClass;
-
-
-  PROCEDURE (os : PeFile)MainTail*();
-  END MainTail;
-
-(* ------------------------------------------------------------ *)
-
-  PROCEDURE (os : PeFile)MethodTail*(id : Id.Procs);
-  END MethodTail;
-
-(* ------------------------------------------------------------ *)
-
-  PROCEDURE (os : PeFile)ClinitTail*();
-  END ClinitTail;
-
-(* ------------------------------------------------------------ *)
-
-  PROCEDURE (os : PeFile)CopyTail*();
-  END CopyTail;
-
-(* ------------------------------------------------------------ *)
-
-  PROCEDURE (os : PeFile)InitTail*(typ : Ty.Record);
-  END InitTail;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)ClinitHead*();
-  END ClinitHead;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)EmitField*(id : Id.AbVar; att : SET);
-  END EmitField;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)EmitEventMethods*(id : Id.AbVar);
-  END EmitEventMethods;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkAndLinkDelegate*(dl  : Sy.Idnt;
-                                            id  : Sy.Idnt;
-                                            ty  : Sy.Type;
-                                            isA : BOOLEAN);
-  END MkAndLinkDelegate;
-
-(* ============================================================ *)
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)EmitPTypeBody*(tId : Id.TypId);
-  END EmitPTypeBody;
-
-(* ============================================================ *)
-(*          End of Procedure Variable and Event Stuff           *)
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)Line*(nm : INTEGER),EMPTY;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)LoadType*(id : Sy.Idnt);
-  END LoadType;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)Finish*();
-  END Finish;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)RefRTS*();
-  END RefRTS;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)StartNamespace*(nm : Lv.CharOpen);
-  END StartNamespace;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkBodyClass*(mod : Id.BlkId);
-  END MkBodyClass;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)ClassHead*(attSet : SET; 
-                                    thisRc : Ty.Record;
-                                    superT : Ty.Record);
-  END ClassHead;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)CheckNestedClass*(typ : Ty.Record;
-                                           scp : Sy.Scope;
-                                           rNm : Lv.CharOpen);
-  END CheckNestedClass;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)ClassTail*();
-  END ClassTail;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkRecX*(t : Ty.Record; s : Sy.Scope);
-  END MkRecX;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkPtrX*(t : Ty.Pointer);
-  END MkPtrX;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkArrX*(t : Ty.Array);
-  END MkArrX;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkBasX*(t : Ty.Base);
-  END MkBasX;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkEnuX*(t : Ty.Enum; s : Sy.Scope);
-  END MkEnuX;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)NumberParams*(pId : Id.Procs; 
-                                       pTp : Ty.Procedure);
-  END NumberParams;
- 
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)SwitchHead*(num : INTEGER);
-  END SwitchHead;
-
-  PROCEDURE (os : PeFile)SwitchTail*();
-  END SwitchTail;
-
-  PROCEDURE (os : PeFile)LstLab*(l : Mu.Label);
-  END LstLab;
-
-(* ============================================================ *)
-(* ============================================================ *)
-END PeUtil.
-(* ============================================================ *)
-(* ============================================================ *)
-

gpcp/PeUtilForJVM.cp

@@ -1,396 +0,0 @@
-(* ============================================================ *)
-(*  PeUtil is the module which writes PE files using the        *)
-(*  managed interface.                                          *)
-(*  Copyright (c) John Gough 1999, 2000.                        *)
-(* ============================================================ *)
-(* ============================================================ *)
-(*  THIS IS THE EMPTY VERSION, THAT IS REQUIRED TO BOOTSTRAP    *)
-(*  THE JVM VERSION WITHOUT THE MSCORLIB ASSEMBLY AVAILABLE.    *)
-(* ============================================================ *)
-(* ============================================================ *)
-
-MODULE PeUtil;
-
-  IMPORT 
-        GPCPcopyright,
-        Mu  := MsilUtil,
-        Id  := IdDesc,
-        Lv  := LitValue,
-        Sy  := Symbols,
-        Ty  := TypeDesc;
-
-(* ============================================================ *)
-
-  TYPE PeFile*    = POINTER TO RECORD (Mu.MsilFile)
-                 (*   Fields inherited from MsilFile *
-                  *   srcS* : LitValue.CharOpen; (* source file name   *)
-                  *   outN* : LitValue.CharOpen; (* output file name   *)
-                  *   proc* : ProcInfo;
-                  *)
-                    END;
-
-(* ============================================================ *)
-(*                    Constructor Method                        *)
-(* ============================================================ *)
-
-  PROCEDURE newPeFile*(IN nam : ARRAY OF CHAR; isDll : BOOLEAN) : PeFile;
-  BEGIN
-    RETURN NIL;
-  END newPeFile;
-
-(* ============================================================ *)
-
-  PROCEDURE (t : PeFile)fileOk*() : BOOLEAN;
-  BEGIN
-    RETURN FALSE;
-  END fileOk;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkNewProcInfo*(proc : Sy.Scope);
-  BEGIN
-  END MkNewProcInfo;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)newLabel*() : Mu.Label;
-  BEGIN
-    RETURN NIL;
-  END newLabel;
-
-(* ============================================================ *)
-(*                    Exported Methods                  *)
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MethodDecl*(attr : SET; proc : Id.Procs);
-  END MethodDecl;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)ExternList*();
-  END ExternList;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)DefLab*(l : Mu.Label);
-  END DefLab;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)DefLabC*(l : Mu.Label; IN c : ARRAY OF CHAR);
-  END DefLabC;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)Code*(code : INTEGER);
-  END Code;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeI*(code,int : INTEGER);
-  END CodeI;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeT*(code : INTEGER; type : Sy.Type);
-  END CodeT;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeTn*(code : INTEGER; type : Sy.Type);
-  END CodeTn;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeL*(code : INTEGER; long : LONGINT);
-  END CodeL;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeR*(code : INTEGER; real : REAL);
-  END CodeR;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeLb*(code : INTEGER; labl : Mu.Label);
-  END CodeLb;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)StaticCall*(s : INTEGER; d : INTEGER);
-  END StaticCall;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeS*(code : INTEGER; str : INTEGER);
-  END CodeS;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)Try*();
-  END Try;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)Catch*(proc : Id.Procs);
-  END Catch;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CloseCatch*();
-  END CloseCatch;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CopyCall*(typ : Ty.Record);
-  END CopyCall;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)PushStr*(IN str : ARRAY OF CHAR);
-  END PushStr;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)CallIT*(code : INTEGER; 
-                                 proc : Id.Procs; 
-                                 type : Ty.Procedure);
-  END CallIT;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)CallCT*(proc : Id.Procs; 
-                                 type : Ty.Procedure);
-  END CallCT;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)CallDelegate*(typ : Ty.Procedure);
-  END CallDelegate;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)PutGetS*(code : INTEGER;
-                                  blk  : Id.BlkId;
-                                  fId  : Id.VarId);
-  END PutGetS;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)GetValObj*(code : INTEGER; ptrT : Ty.Pointer);
-  END GetValObj;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)PutGetXhr*(code : INTEGER; 
-                                    proc : Id.Procs; 
-                                    locl : Id.LocId);
-  END PutGetXhr;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)PutGetF*(code : INTEGER;
-                                  fId  : Id.FldId);
-  END PutGetF;
-
-(* ============================================================ *)
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkNewRecord*(typ : Ty.Record);
-  END MkNewRecord;
-
-(* ============================================================ *)
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkNewProcVal*(p : Sy.Idnt;   (* src Proc *)
-                                       t : Sy.Type);  (* dst Type *)
-  END MkNewProcVal;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)CallSuper*(rTp : Ty.Record;
-                                    prc : Id.PrcId);
-  END CallSuper;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)InitHead*(rTp : Ty.Record;
-                                   prc : Id.PrcId);
-  END InitHead;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)CopyHead*(typ : Ty.Record);
-  END CopyHead;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MarkInterfaces*(IN seq : Sy.TypeSeq);
-  END MarkInterfaces;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MainHead*(xAtt : SET);
-  END MainHead;
-
-  PROCEDURE (os : PeFile)SubSys*(xAtt : SET);
-  END SubSys;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)StartBoxClass*(rec : Ty.Record;
-                                        att : SET;
-                                        blk : Id.BlkId);
-  END StartBoxClass;
-
-
-  PROCEDURE (os : PeFile)MainTail*();
-  END MainTail;
-
-(* ------------------------------------------------------------ *)
-
-  PROCEDURE (os : PeFile)MethodTail*(id : Id.Procs);
-  END MethodTail;
-
-(* ------------------------------------------------------------ *)
-
-  PROCEDURE (os : PeFile)ClinitTail*();
-  END ClinitTail;
-
-(* ------------------------------------------------------------ *)
-
-  PROCEDURE (os : PeFile)CopyTail*();
-  END CopyTail;
-
-(* ------------------------------------------------------------ *)
-
-  PROCEDURE (os : PeFile)InitTail*(typ : Ty.Record);
-  END InitTail;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)ClinitHead*();
-  END ClinitHead;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)EmitField*(id : Id.AbVar; att : SET);
-  END EmitField;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)EmitEventMethods*(id : Id.AbVar);
-  END EmitEventMethods;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkAndLinkDelegate*(dl  : Sy.Idnt;
-                                            id  : Sy.Idnt;
-                                            ty  : Sy.Type;
-                                            isA : BOOLEAN);
-  END MkAndLinkDelegate;
-
-(* ============================================================ *)
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)EmitPTypeBody*(tId : Id.TypId);
-  END EmitPTypeBody;
-
-(* ============================================================ *)
-(*          End of Procedure Variable and Event Stuff           *)
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)Line*(nm : INTEGER),EMPTY;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)LoadType*(id : Sy.Idnt);
-  END LoadType;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)Finish*();
-  END Finish;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)RefRTS*();
-  END RefRTS;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)StartNamespace*(nm : Lv.CharOpen);
-  END StartNamespace;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkBodyClass*(mod : Id.BlkId);
-  END MkBodyClass;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)ClassHead*(attSet : SET; 
-                                    thisRc : Ty.Record;
-                                    superT : Ty.Record);
-  END ClassHead;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)CheckNestedClass*(typ : Ty.Record;
-                                           scp : Sy.Scope;
-                                           rNm : Lv.CharOpen);
-  END CheckNestedClass;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)ClassTail*();
-  END ClassTail;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkRecX*(t : Ty.Record; s : Sy.Scope);
-  END MkRecX;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkPtrX*(t : Ty.Pointer);
-  END MkPtrX;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkArrX*(t : Ty.Array);
-  END MkArrX;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkBasX*(t : Ty.Base);
-  END MkBasX;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkEnuX*(t : Ty.Enum; s : Sy.Scope);
-  END MkEnuX;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)NumberParams*(pId : Id.Procs; 
-                                       pTp : Ty.Procedure);
-  END NumberParams;
- 
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)SwitchHead*(num : INTEGER);
-  END SwitchHead;
-
-  PROCEDURE (os : PeFile)SwitchTail*();
-  END SwitchTail;
-
-  PROCEDURE (os : PeFile)LstLab*(l : Mu.Label);
-  END LstLab;
-
-(* ============================================================ *)
-(* ============================================================ *)
-END PeUtil.
-(* ============================================================ *)
-(* ============================================================ *)
-

gpcp/PeUtilForNET.cp

@@ -1,2544 +0,0 @@
-(* ============================================================ *)
-(*  PeUtil is the module which writes PE files using the        *)
-(*  managed interface.                                          *)
-(*  Copyright (c) John Gough 1999, 2002.                        *)
-(*  Copyright (c) Queensland University of Technology 2002-2006 *)
-(*  This is the PERWAPI-based prototype, March 2005             *)
-(*    previous versions used the PE-file <writer> PEAPI.        *)
-(* ============================================================ *)
-
-MODULE PeUtil;
-
-  IMPORT 
-        GPCPcopyright,
-        RTS, ASCII,
-        Console,
-        GPText,
-        GPBinFiles,
-        GPTextFiles,
-        FileNames,
-        ClassMaker,
-        MsilBase,
-        NameHash,
-        Mu  := MsilUtil,
-        Lv  := LitValue,
-        Sy  := Symbols,
-        Bi  := Builtin,
-        Id  := IdDesc,
-        Ty  := TypeDesc,
-        Api := "[QUT.PERWAPI]QUT.PERWAPI",
-        Scn := CPascalS,
-        Asm := IlasmCodes,
-        CSt := CompState,
-        Sys := "[mscorlib]System";
-
-(* ============================================================ *)
-
-(*
- * CONST
- *      (* various ILASM-specific runtime name strings *)
- *      initPrefix  = "instance void ";
- *      initSuffix  = ".ctor() ";
- *      managedStr  = "il managed";
- *      specialStr  = "public specialname rtspecialname ";
- *      cctorStr    = "static void .cctor() ";
- *      objectInit  = "instance void $o::.ctor() ";
- *
- * CONST
- *      catchStr    = "      catch [mscorlib]System.Exception";
- *)
-
-(* ============================================================ *)
-(* ============================================================ *)
-
-  TYPE PeFile*    = POINTER TO RECORD (Mu.MsilFile)
-                 (*   Fields inherited from MsilFile *
-                  *   srcS* : LitValue.CharOpen; (* source file name   *)
-                  *   outN* : LitValue.CharOpen; (* output file name   *)
-                  *   proc* : ProcInfo;
-                  *)
-                      peFl  : Api.PEFile;          (* Includes AssemblyDef  *)
-                      clsS  : Api.ClassDef;        (* Dummy static ClassDef *)
-                      clsD  : Api.ClassDef;        (* The current ClassDef  *)
-                      pePI  : PProcInfo;
-                      nmSp  : RTS.NativeString;
-                     (*
-                      *  Friendly access for system classes.
-                      *)
-                      rts      : Api.AssemblyRef;  (* "[RTS]"               *)
-                      cprts    : Api.ClassRef;     (* "[RTS]CP_rts"         *)
-                      progArgs : Api.ClassRef;     (* "[RTS]ProgArgs"       *)
-                    END;
-
-(* ============================================================ *)
-
-  TYPE PProcInfo  = POINTER TO RECORD 
-                      mthD  : Api.MethodDef;
-                      code  : Api.CILInstructions;
-                      tryB  : Api.TryBlock;
-                    END;
-
-(* ============================================================ *)
-
-  TYPE PeLab     = POINTER TO RECORD (Mu.Label)
-                      labl : Api.CILLabel;
-                   END;
-
-  TYPE TypArr    = POINTER TO ARRAY OF Api.Type;
-
-(* ============================================================ *)
-
-  VAR   cln2,                           (* "::"     *) 
-        evtAdd,
-        evtRem,
-        boxedObj       : Lv.CharOpen;
-
-(* ============================================================ *)
-
-  VAR   ctAtt,                          (* public + special + RTspecial *)
-        psAtt,                          (* public + static              *)
-        rmAtt,                          (* runtime managed              *)
-        ilAtt          : INTEGER;       (* cil managed                  *)
-
-  VAR   xhrCl          : Api.ClassRef;  (* the [RTS]XHR class reference *)
-        voidD          : Api.Type;      (* Api.PrimitiveType.Void       *)
-        objtD          : Api.Type;      (* Api.PrimitiveType.Object     *)
-        strgD          : Api.Type;      (* Api.PrimitiveType.String     *)
-        charD          : Api.Type;      (* Api.PrimitiveType.Char       *)
-        charA          : Api.Type;      (* Api.PrimitiveType.Char[]     *)
-        int4D          : Api.Type;      (* Api.PrimitiveType.Int32      *)
-        int8D          : Api.Type;      (* Api.PrimitiveType.Int64      *)
-        flt4D          : Api.Type;      (* Api.PrimitiveType.Float32    *)
-        flt8D          : Api.Type;      (* Api.PrimitiveType.Float64    *)
-        nIntD          : Api.Type;      (* Api.PrimitiveType.NativeInt  *)
-
-  VAR   vfldS          : RTS.NativeString;   (* "v$"    *)
-        copyS          : RTS.NativeString;   (* "copy"  *)
-        ctorS          : RTS.NativeString;   (* ".ctor" *)
-        invkS          : RTS.NativeString;   (* Invoke  *)
-        
-  VAR   defSrc : Api.SourceFile;
-
-  VAR   rHelper : ARRAY Mu.rtsLen OF Api.MethodRef;
-        mathCls : Api.ClassRef;
-        envrCls : Api.ClassRef;
-        excpCls : Api.ClassRef;
-        rtTpHdl : Api.ClassRef;
-        loadTyp : Api.MethodRef;
-        newObjt : Api.MethodRef;
-        multiCD : Api.ClassRef;     (* System.MulticastDelegate *)
-        delegat : Api.ClassRef;     (* System.Delegate          *)
-        combine : Api.MethodRef;    (* System.Delegate::Combine *)
-        remove  : Api.MethodRef;    (* System.Delegate::Remove  *)
-        corlib  : Api.AssemblyRef;  (* [mscorlib]               *)
-        
-(* ============================================================ *)
-(*      Data Structure for tgXtn field of BlkId descriptors     *)
-(* ============================================================ *)
-
-  TYPE BlkXtn = POINTER TO RECORD
-                  asmD : Api.AssemblyRef; (* This AssemblyRef   *)
-                  dscD : Api.Class;       (* Dummy Static Class *)
-                END;
-
-(* ============================================================ *)
-(*          Data Structure for Switch Statement Encoding        *)
-(* ============================================================ *)
-
-  TYPE Switch = RECORD
-                  list : POINTER TO ARRAY OF Api.CILLabel;
-                  next : INTEGER;
-                END;
-
-  VAR  switch : Switch;
-
-(* ============================================================ *)
-(*      Data Structure for tgXtn field of procedure types       *)
-(* ============================================================ *)
-
-  TYPE DelXtn = POINTER TO RECORD
-                  clsD : Api.Class;      (* Implementing class  *)
-                  newD : Api.Method;     (* Constructor method  *)
-                  invD : Api.Method;     (* The Invoke method   *)
-                END;
-
-(* ============================================================ *)
-(*      Data Structure for tgXtn field of event variables       *)
-(* ============================================================ *)
-
-  TYPE EvtXtn = POINTER TO RECORD
-                  fldD : Api.Field;      (* Field descriptor    *)
-                  addD : Api.Method;     (* add_<field> method  *)
-                  remD : Api.Method;     (* rem_<field> method  *)
-                END;
-
-(* ============================================================ *)
-(*      Data Structure for tgXtn field of Record types          *)
-(* ============================================================ *)
-
-  TYPE RecXtn = POINTER TO RECORD
-                  clsD : Api.Class;
-                  boxD : Api.Class;
-                  newD : Api.Method;
-                  cpyD : Api.Method;
-                  vDlr : Api.Field;
-                END;
-
-(* ============================================================ *)
-(*                    Constructor Method                        *)
-(* ============================================================ *)
-
-  PROCEDURE newPeFile*(IN nam : ARRAY OF CHAR; isDll : BOOLEAN) : PeFile;
-    VAR f : PeFile;
-        ver : INTEGER;
-   (* ------------------------------------------------------- *)
-    PROCEDURE file(IN f,a : ARRAY OF CHAR; d : BOOLEAN) : Api.PEFile;
-      VAR pef : Api.PEFile;
-    BEGIN 
-      pef := Api.PEFile.init(MKSTR(f), MKSTR(a));
-      pef.SetIsDLL(d);
-      IF CSt.binDir # "" THEN
-        pef.SetOutputDirectory(MKSTR(CSt.binDir));
-      END;
-      RETURN pef;
-    RESCUE (x) 
-      RETURN NIL;
-    END file;
-   (* ------------------------------------------------------- *)
-  BEGIN
-    NEW(f);
-(*
- *  f.peFl := file(nam, isDll);
- *)
-    IF isDll THEN
-      f.outN := BOX(nam + ".DLL");
-    ELSE
-      f.outN := BOX(nam + ".EXE");
-    END;
-(* -- start replacement -- *)
-    f.peFl := file(f.outN, nam, isDll);
-(* --- end replacement --- *)
-   (*
-    *  Initialize local variables holding common attributes.
-    *)
-    ctAtt := Api.MethAttr.Public + Api.MethAttr.SpecialRTSpecialName;
-    psAtt := Api.MethAttr.Public + Api.MethAttr.Static;
-    ilAtt := Api.ImplAttr.IL;
-    rmAtt := Api.ImplAttr.Runtime;
-   (*
-    *  Initialize local variables holding primitive type-enums.
-    *)
-    voidD := Api.PrimitiveType.Void;
-    objtD := Api.PrimitiveType.Object;
-    strgD := Api.PrimitiveType.String;
-    int4D := Api.PrimitiveType.Int32;
-    int8D := Api.PrimitiveType.Int64;
-    flt4D := Api.PrimitiveType.Float32;
-    flt8D := Api.PrimitiveType.Float64;
-    charD := Api.PrimitiveType.Char;
-    charA := Api.ZeroBasedArray.init(Api.PrimitiveType.Char);
-    nIntD := Api.PrimitiveType.IntPtr;
-
-    f.peFl.SetNetVersion(Api.NetVersion.Version2);
-
-    (*ver := f.peFl.GetNetVersion();*)
-
-    RETURN f;
-  END newPeFile;
-
-(* ============================================================ *)
-
-  PROCEDURE (t : PeFile)fileOk*() : BOOLEAN;
-  BEGIN
-    RETURN t.peFl # NIL;
-  END fileOk;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkNewProcInfo*(proc : Sy.Scope);
-    VAR p : PProcInfo;
-  BEGIN
-    NEW(os.proc);
-    NEW(os.pePI);
-    Mu.InitProcInfo(os.proc, proc);
-  END MkNewProcInfo;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)newLabel*() : Mu.Label;
-    VAR label : PeLab;
-  BEGIN
-    NEW(label); 
-    label.labl := os.pePI.code.NewLabel();
-    RETURN label;
-  END newLabel;
-
-(* ============================================================ *)
-(*                    Various utilities                         *)
-(* ============================================================ *)
-
-  PROCEDURE^ (os : PeFile)CallCombine(typ : Sy.Type; add : BOOLEAN),NEW;
-  PROCEDURE^ (os : PeFile)CodeLb*(code : INTEGER; labl : Mu.Label);
-  PROCEDURE^ (os : PeFile)DefLabC*(l : Mu.Label; IN c : ARRAY OF CHAR);
-  PROCEDURE^ (os : PeFile)Locals(),NEW;
-
-  PROCEDURE^ MkMthDef(os  : PeFile;
-                      xhr : BOOLEAN;
-                      pTp : Ty.Procedure;
-                      cls : Api.ClassDef;
-                      str : RTS.NativeString)  : Api.MethodDef;
-
-  PROCEDURE^ MkMthRef(os  : PeFile;
-                      pTp : Ty.Procedure;
-                      cls : Api.ClassRef;
-                      str : RTS.NativeString) : Api.MethodRef;
-
-  PROCEDURE^ (os : PeFile)mth(pId : Id.Procs)  : Api.Method,NEW;
-  PROCEDURE^ (os : PeFile)fld(fId : Id.AbVar)  : Api.Field,NEW;
-  PROCEDURE^ (os : PeFile)add(fId : Id.AbVar)  : Api.Method,NEW;
-  PROCEDURE^ (os : PeFile)rem(fId : Id.AbVar)  : Api.Method,NEW;
-  PROCEDURE^ (os : PeFile)asm(bId : Id.BlkId)  : Api.AssemblyRef,NEW;
-  PROCEDURE^ (os : PeFile)dsc(bId : Id.BlkId)  : Api.Class,NEW;
-  PROCEDURE^ (os : PeFile)cls(rTy : Ty.Record) : Api.Class,NEW;
-  PROCEDURE^ (os : PeFile)new(rTy : Ty.Record) : Api.Method,NEW;
-  PROCEDURE^ (os : PeFile)cpy(rTy : Ty.Record) : Api.Method,NEW;
-  PROCEDURE^ (os : PeFile)typ(tTy : Sy.Type)   : Api.Type,NEW;
-  PROCEDURE^ (os : PeFile)vDl(rTy : Ty.Record) : Api.Field,NEW;
-  PROCEDURE^ (os : PeFile)dxt(pTy : Ty.Procedure) : DelXtn,NEW;
-  PROCEDURE^ (os : PeFile)mcd() : Api.ClassRef,NEW;
-  PROCEDURE^ (os : PeFile)rmv() : Api.MethodRef,NEW;
-  PROCEDURE^ (os : PeFile)cmb() : Api.MethodRef,NEW;
-(*
- *  PROCEDURE^ box(os : PeFile; rTy : Ty.Record) : Api.Class;
- *)
-(* ============================================================ *)
-(*                    Private Methods                        *)
-(* ============================================================ *)
-
-  PROCEDURE boxedName(typ : Ty.Record) : RTS.NativeString;
-  BEGIN
-    ASSERT(typ.xName # NIL);
-    RETURN MKSTR(boxedObj^ + typ.xName^);
-  END boxedName;
-
-(* ============================================================ *)
-
-  PROCEDURE nms(idD : Sy.Idnt) : RTS.NativeString;
-  BEGIN
-    RETURN MKSTR(Sy.getName.ChPtr(idD)^);
-  END nms;
-
-(* ============================================================ *)
-
-  PROCEDURE toTypeAttr(attr : SET) : INTEGER;
-    VAR result : INTEGER;
-  BEGIN
-    CASE ORD(attr * {0 .. 3}) OF
-    | ORD(Asm.att_public)  : result := Api.TypeAttr.Public;
-    | ORD(Asm.att_empty)   : result := Api.TypeAttr.Private;
-    END;
-    IF attr * Asm.att_sealed # {}    THEN 
-      INC(result, Api.TypeAttr.Sealed);
-    END;
-    IF attr * Asm.att_abstract # {}  THEN 
-      INC(result, Api.TypeAttr.Abstract);
-    END;
-    IF attr * Asm.att_interface # {} THEN 
-      INC(result, Api.TypeAttr.Interface + Api.TypeAttr.Abstract);
-    END;
-(*
- *  what are "Import, AutoClass, UnicodeClass, *SpecialName" ? 
- *)
-    RETURN result;
-  END toTypeAttr;
-
-  
-(* ------------------------------------------------ *)
-(*              New code for PERWAPI                *)
-(* ------------------------------------------------ *)
-
-  PROCEDURE getOrAddClass(mod : Api.ReferenceScope; 
-                          nms : RTS.NativeString;
-                          nam : RTS.NativeString) : Api.ClassRef;
-    VAR cls : Api.Class;
-  BEGIN
-    cls := mod.GetClass(nms, nam);
-    IF cls = NIL THEN cls := mod.AddClass(nms, nam) END;
-    RETURN cls(Api.ClassRef);
-  END getOrAddClass;
-
-  PROCEDURE getOrAddValueClass(mod : Api.ReferenceScope; 
-                               nms : RTS.NativeString;
-                               nam : RTS.NativeString) : Api.ClassRef;
-    VAR cls : Api.Class;
-  BEGIN
-    cls := mod.GetClass(nms, nam);
-    IF cls = NIL THEN cls := mod.AddValueClass(nms, nam) END;
-    RETURN cls(Api.ClassRef);
-  END getOrAddValueClass;
-
-  PROCEDURE getOrAddMethod(cls : Api.ClassRef; 
-                           nam : RTS.NativeString;
-                           ret : Api.Type;
-                           prs : TypArr) : Api.MethodRef;
-    VAR mth : Api.Method;
-  BEGIN
-    mth := cls.GetMethod(nam, prs);
-    IF mth = NIL THEN mth := cls.AddMethod(nam, ret, prs) END;
-    RETURN mth(Api.MethodRef);
-  END getOrAddMethod;
-
-  PROCEDURE getOrAddField(cls : Api.ClassRef; 
-                          nam : RTS.NativeString;
-                          typ : Api.Type) : Api.FieldRef;
-    VAR fld : Api.FieldRef;
-  BEGIN
-    fld := cls.GetField(nam);
-    IF fld = NIL THEN fld := cls.AddField(nam, typ) END;
-    RETURN fld(Api.FieldRef);
-  END getOrAddField;
-
-(* ------------------------------------------------ *)
-
-  PROCEDURE toMethAttr(attr : SET) : INTEGER;
-    VAR result : INTEGER;
-  BEGIN
-    CASE ORD(attr * {0 .. 3}) OF
-    | ORD(Asm.att_assembly)  : result := Api.MethAttr.Assembly;
-    | ORD(Asm.att_public)    : result := Api.MethAttr.Public;
-    | ORD(Asm.att_private)   : result := Api.MethAttr.Private;
-    | ORD(Asm.att_protected) : result := Api.MethAttr.Family;
-    END;
-    IF  5 IN attr THEN INC(result, Api.MethAttr.Static) END;
-    IF  6 IN attr THEN INC(result, Api.MethAttr.Final) END;
-    IF  8 IN attr THEN INC(result, Api.MethAttr.Abstract) END;
-    IF  9 IN attr THEN INC(result, Api.MethAttr.NewSlot) END;
-    IF 13 IN attr THEN INC(result, Api.MethAttr.Virtual) END;
-    RETURN result;
-  END toMethAttr;
-
-(* ------------------------------------------------ *)
-
-  PROCEDURE toFieldAttr(attr : SET) : INTEGER;
-    VAR result : INTEGER;
-  BEGIN
-    CASE ORD(attr * {0 .. 3}) OF
-    | ORD(Asm.att_empty)     : result := Api.FieldAttr.Default;
-    | ORD(Asm.att_assembly)  : result := Api.FieldAttr.Assembly;
-    | ORD(Asm.att_public)    : result := Api.FieldAttr.Public;
-    | ORD(Asm.att_private)   : result := Api.FieldAttr.Private;
-    | ORD(Asm.att_protected) : result := Api.FieldAttr.Family;
-    END;
-    IF  5 IN attr THEN INC(result, Api.FieldAttr.Static) END;
-   (* what about Initonly? *)
-    RETURN result;
-  END toFieldAttr;
-
-(* ------------------------------------------------ *)
-
-  PROCEDURE (os : PeFile)MkCodeBuffer(),NEW;
-  BEGIN
-    ASSERT((defSrc # NIL) & (os.pePI.mthD # NIL));
-    os.pePI.code := os.pePI.mthD.CreateCodeBuffer();
-    os.pePI.code.OpenScope();
-    os.pePI.code.set_DefaultSourceFile(defSrc);
-  END MkCodeBuffer;
-
-(* ============================================================ *)
-(*                    Exported Methods                  *)
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MethodDecl*(attr : SET; proc : Id.Procs);
-    VAR prcT : Ty.Procedure; (* NOT NEEDED? *)
-        prcD : Api.MethodDef;
-  BEGIN
-   (*
-    *   Set the various attributes
-    *)
-    prcD := os.mth(proc)(Api.MethodDef);
-    prcD.AddMethAttribute(toMethAttr(attr));
-    prcD.AddImplAttribute(ilAtt);
-    os.pePI.mthD := prcD;
-    IF attr * Asm.att_abstract = {} THEN os.MkCodeBuffer() END;
-  END MethodDecl;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)DoExtern(blk : Id.BlkId),NEW;
- (*
-  *  Add references to all imported assemblies.
-  *)
-    VAR  asmRef  : Api.AssemblyRef;
-         blkXtn  : BlkXtn;
-   (* ----------------------------------------- *)
-    PROCEDURE AsmName(bk : Id.BlkId) : Lv.CharOpen;
-      VAR ix : INTEGER;
-          ln : INTEGER;
-          ch : CHAR;
-          cp : Lv.CharOpen;
-    BEGIN
-      IF Sy.isFn IN bk.xAttr THEN
-        ln := 0;
-        FOR ix := LEN(bk.scopeNm) - 1 TO 1 BY -1 DO
-          IF bk.scopeNm[ix] = "]" THEN ln := ix END;
-        END;
-        IF (ln = 0 ) OR (bk.scopeNm[0] # '[') THEN 
-                          RTS.Throw("bad extern name "+bk.scopeNm^) END;
-        NEW(cp, ln);
-        FOR ix := 1 TO ln-1 DO cp[ix-1] := bk.scopeNm[ix] END;
-        cp[ln-1] := 0X;
-        RETURN cp;
-      ELSE
-        RETURN bk.xName;
-      END;
-    END AsmName;
-   (* ----------------------------------------- *)
-    PROCEDURE MkBytes(t1, t2 : INTEGER) : POINTER TO ARRAY OF UBYTE;
-      VAR bIx : INTEGER;
-          tok : POINTER TO ARRAY OF UBYTE;
-    BEGIN [UNCHECKED_ARITHMETIC]
-      NEW(tok, 8);
-      FOR bIx := 3 TO 0 BY -1 DO
-        tok[bIx] := USHORT(t1 MOD 256);
-        t1 := t1 DIV 256;
-      END;
-      FOR bIx := 7 TO 4 BY -1 DO
-        tok[bIx] := USHORT(t2 MOD 256);
-        t2 := t2 DIV 256;
-      END;
-      RETURN tok;
-    END MkBytes;
-   (* ----------------------------------------- *)
-  BEGIN
-    IF blk.xName = NIL THEN Mu.MkBlkName(blk) END;
-    asmRef := os.peFl.MakeExternAssembly(MKSTR(AsmName(blk)^));
-    NEW(blkXtn);
-    blk.tgXtn := blkXtn;
-    blkXtn.asmD := asmRef;
-    blkXtn.dscD := getOrAddClass(asmRef, 
-                                 MKSTR(blk.pkgNm^), 
-                                 MKSTR(blk.clsNm^));
-    IF blk.verNm # NIL THEN
-      asmRef.AddVersionInfo(blk.verNm[0], blk.verNm[1], 
-                            blk.verNm[2], blk.verNm[3]);
-      IF (blk.verNm[4] # 0) OR (blk.verNm[5] # 0) THEN
-        asmRef.AddKeyToken(MkBytes(blk.verNm[4], blk.verNm[5]));
-      END;
-    END;
-  END DoExtern;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)DoRtsMod(blk : Id.BlkId),NEW;
- (*
-  *  Add references to all imported assemblies.
-  *)
-    VAR blkD : BlkXtn;
-  BEGIN
-    IF blk.xName = NIL THEN Mu.MkBlkName(blk) END;
-    NEW(blkD);
-    blkD.asmD := os.rts;
-    blkD.dscD := os.rts.AddClass("", MKSTR(blk.clsNm^));
-    blk.tgXtn := blkD;
-  END DoRtsMod;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)CheckNestedClass*(typ : Ty.Record;
-                                           scp : Sy.Scope;
-                                           str : Lv.CharOpen);
-    VAR len : INTEGER;
-        idx : INTEGER;
-        jdx : INTEGER;
-        kdx : INTEGER;
-        hsh : INTEGER;
-        tId : Sy.Idnt;
-  BEGIN
-   (* 
-    *  Find last occurrence of '$', except at index 0  
-    *  
-    *  We seek the last occurrence because this method might
-    *  be called recursively for a deeply nested class A$B$C.
-    *)
-    len := LEN(str$); (* LEN(x$) doen't count nul, therefore str[len] = 0X *)
-    FOR idx := len TO 1 BY -1 DO
-      IF str[idx] = '$' THEN (* a nested class *)
-        str[idx] := 0X; (* terminate the string early *)
-        hsh := NameHash.enterStr(str);
-        tId := Sy.bind(hsh, scp);
-        
-        IF (tId = NIL) OR ~(tId IS Id.TypId) THEN 
-          RTS.Throw(
-             "Foreign Class <" + str^ + "> not found in <" + typ.extrnNm^ + ">"
-          );
-        ELSE
-          typ.encCls := tId.type.boundRecTp();
-          jdx := 0; kdx := idx+1;
-          WHILE kdx <= len DO str[jdx] := str[kdx]; INC(kdx); INC(jdx) END;
-        END;
-        RETURN;
-      END;
-    END;
-  END CheckNestedClass;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)ExternList*();
-    VAR idx : INTEGER;
-        blk : Id.BlkId;
-  BEGIN
-    FOR idx := 0 TO CSt.impSeq.tide-1 DO
-      blk := CSt.impSeq.a[idx](Id.BlkId);
-      IF (Sy.need IN blk.xAttr)  &
-         (blk.tgXtn = NIL) THEN 
-        IF ~(Sy.rtsMd IN blk.xAttr) THEN 
-          os.DoExtern(blk);
-        ELSE
-          os.DoRtsMod(blk);
-        END;
-      END;
-    END;
-  END ExternList;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)DefLab*(l : Mu.Label);
-  BEGIN
-    os.pePI.code.CodeLabel(l(PeLab).labl);
-  END DefLab;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)DefLabC*(l : Mu.Label; IN c : ARRAY OF CHAR);
-  BEGIN
-    os.pePI.code.CodeLabel(l(PeLab).labl);
-  END DefLabC;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)Code*(code : INTEGER);
-  BEGIN
-    os.pePI.code.Inst(Asm.cd[code]);
-    os.Adjust(Asm.dl[code]);
-  END Code;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeF(code : INTEGER;
-                               fld  : Api.Field), NEW;
-  BEGIN
-    os.pePI.code.FieldInst(Asm.cd[code], fld);
-    os.Adjust(Asm.dl[code]);
-  END CodeF;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeI*(code,int : INTEGER);
-  BEGIN
-    os.pePI.code.IntInst(Asm.cd[code],int);
-    os.Adjust(Asm.dl[code]);
-  END CodeI;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeT*(code : INTEGER; type : Sy.Type);
-    VAR xtn : Api.Type;
-  BEGIN
-    xtn := os.typ(type);
-    os.pePI.code.TypeInst(Asm.cd[code], xtn);
-    os.Adjust(Asm.dl[code]);
-  END CodeT;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeTn*(code : INTEGER; type : Sy.Type);
-    VAR xtn : Api.Type;
-  BEGIN
-    xtn := os.typ(type);
-    os.pePI.code.TypeInst(Asm.cd[code], xtn);
-    os.Adjust(Asm.dl[code]);
-  END CodeTn;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeL*(code : INTEGER; long : LONGINT);
-  BEGIN
-    ASSERT(code = Asm.opc_ldc_i8);
-    os.pePI.code.ldc_i8(long);
-    os.Adjust(1);
-  END CodeL;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeR*(code : INTEGER; real : REAL);
-  BEGIN
-    IF code = Asm.opc_ldc_r8 THEN
-      os.pePI.code.ldc_r8(real);
-    ELSIF code = Asm.opc_ldc_r4 THEN
-      os.pePI.code.ldc_r4(SHORT(real));
-    ELSE
-      ASSERT(FALSE);
-    END;
-    os.Adjust(1);
-  END CodeR;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeLb*(code : INTEGER; labl : Mu.Label);
-  BEGIN
-    os.pePI.code.Branch(Asm.cd[code], labl(PeLab).labl);
-  END CodeLb;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)getMethod(s : INTEGER) : Api.Method,NEW;
-    VAR  mth : Api.MethodRef;
-         cpr : Api.ClassRef;
-         msc : Api.ClassRef;
-         sys : Api.ClassRef;
-  (* ----------------------------------- *)
-    PROCEDURE p1(p : Api.Type) : TypArr;
-      VAR a : TypArr;
-    BEGIN
-      NEW(a,1);
-      a[0] := p;
-      RETURN a;
-    END p1;
-  (* ----------------------------------- *)
-    PROCEDURE p2(p,q : Api.Type) : TypArr;
-      VAR a : TypArr;
-    BEGIN
-      NEW(a,2);
-      a[0] := p;
-      a[1] := q;
-      RETURN a;
-    END p2;
-  (* ----------------------------------- *)
-  BEGIN
-   (*
-    *  Lazy evaluation of array elements
-    *)
-    mth := rHelper[s];
-    IF mth = NIL THEN
-      cpr := os.cprts;
-      CASE s OF
-      | Mu.vStr2ChO  : mth := cpr.AddMethod("strToChO",charA,p1(strgD));
-      | Mu.vStr2ChF  : mth := cpr.AddMethod("StrToChF",voidD,p2(charA,strgD));
-      | Mu.aStrLen   : mth := cpr.AddMethod("chrArrLength",int4D,p1(charA));
-      | Mu.aStrChk   : mth := cpr.AddMethod("ChrArrCheck",voidD,p1(charA));
-      | Mu.aStrLp1   : mth := cpr.AddMethod("chrArrLplus1",int4D,p1(charA));
-      | Mu.aaStrCmp  : mth := cpr.AddMethod("strCmp",int4D,p2(charA,charA));
-      | Mu.aaStrCopy : mth := cpr.AddMethod("Stringify",voidD,p2(charA,charA));
-      | Mu.CpModI    : mth := cpr.AddMethod("CpModI",int4D,p2(int4D,int4D));
-      | Mu.CpDivI    : mth := cpr.AddMethod("CpDivI",int4D,p2(int4D,int4D));
-      | Mu.CpModL    : mth := cpr.AddMethod("CpModL",int8D,p2(int8D,int8D));
-      | Mu.CpDivL    : mth := cpr.AddMethod("CpDivL",int8D,p2(int8D,int8D));
-      | Mu.caseMesg  : mth := cpr.AddMethod("caseMesg",strgD,p1(int4D));
-      | Mu.withMesg  : mth := cpr.AddMethod("withMesg",strgD,p1(objtD));
-      | Mu.chs2Str   : mth :=  cpr.AddMethod("mkStr",strgD,p1(charA));
-      | Mu.CPJstrCatAA : mth := cpr.AddMethod("aaToStr",strgD,p2(charA,charA));
-      | Mu.CPJstrCatSA : mth := cpr.AddMethod("saToStr",strgD,p2(strgD,charA));
-      | Mu.CPJstrCatAS : mth := cpr.AddMethod("asToStr",strgD,p2(charA,strgD));
-      | Mu.CPJstrCatSS : mth := cpr.AddMethod("ssToStr",strgD,p2(strgD,strgD));
-
-      | Mu.toUpper   :  sys := getOrAddClass(corlib, "System", "Char");
-                        mth := getOrAddMethod(sys,"ToUpper",charD,p1(charD));
-
-      | Mu.sysExit   :  IF envrCls = NIL THEN
-                          envrCls := 
-                               getOrAddClass(corlib, "System", "Environment");
-                        END;
-                        mth := getOrAddMethod(envrCls,"Exit",voidD,p1(int4D));
-
-      | Mu.mkExcept  :  IF excpCls = NIL THEN
-                          IF CSt.ntvExc.tgXtn = NIL THEN
-                            excpCls := 
-                                  getOrAddClass(corlib, "System", "Exception");
-                            CSt.ntvExc.tgXtn := excpCls;
-                          ELSE
-                            excpCls := CSt.ntvExc.tgXtn(Api.ClassRef);
-                          END;
-                        END;
-                        sys := CSt.ntvExc.tgXtn(Api.ClassRef);
-(*
- *                      mth := sys.AddMethod(ctorS,voidD,p1(strgD));
- *)
-                        mth := getOrAddMethod(sys,ctorS,voidD,p1(strgD));
-                        mth.AddCallConv(Api.CallConv.Instance);
-
-      | Mu.getTpM    :  IF CSt.ntvTyp.tgXtn = NIL THEN
-                          CSt.ntvTyp.tgXtn := 
-                                  getOrAddClass(corlib, "System", "Type");
-                        END;
-                        sys := CSt.ntvTyp.tgXtn(Api.ClassRef);
-                        mth := getOrAddMethod(sys,"GetType",sys,NIL);
-                        mth.AddCallConv(Api.CallConv.Instance);
-
-      | Mu.dFloor, Mu.dAbs, Mu.fAbs, Mu.iAbs, Mu.lAbs :
-          IF mathCls = NIL THEN
-            mathCls := getOrAddClass(corlib, "System", "Math");
-          END;
-          rHelper[Mu.dFloor] := getOrAddMethod(mathCls,"Floor",flt8D,p1(flt8D));
-          rHelper[Mu.dAbs]   := getOrAddMethod(mathCls,"Abs",flt8D,p1(flt8D));
-          rHelper[Mu.fAbs]   := getOrAddMethod(mathCls,"Abs",flt4D,p1(flt4D));
-          rHelper[Mu.iAbs]   := getOrAddMethod(mathCls,"Abs",int4D,p1(int4D));
-          rHelper[Mu.lAbs]   := getOrAddMethod(mathCls,"Abs",int8D,p1(int8D));
-          mth := rHelper[s];
-      END;
-      rHelper[s] := mth;
-    END;
-    RETURN mth;
-  END getMethod;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)StaticCall*(s : INTEGER; d : INTEGER);
-    VAR mth : Api.Method;
-  BEGIN
-    mth := os.getMethod(s);
-    os.pePI.code.MethInst(Asm.cd[Asm.opc_call], mth);
-    os.Adjust(d);
-  END StaticCall;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CodeS*(code : INTEGER; str : INTEGER);
-    VAR mth : Api.Method;
-  BEGIN
-    mth := os.getMethod(str);
-    os.pePI.code.MethInst(Asm.cd[code], mth);
-  END CodeS;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)Try*();
-    VAR retT : Sy.Type;
-  BEGIN
-    os.proc.exLb := os.newLabel();
-    retT := os.proc.prId.type.returnType();
-    IF retT # NIL THEN os.proc.rtLc := os.proc.newLocal(retT) END;
-    os.pePI.code.StartBlock();
-  END Try;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)Catch*(proc : Id.Procs);
-  BEGIN
-    os.pePI.tryB := os.pePI.code.EndTryBlock();
-    os.pePI.code.StartBlock();
-    os.Adjust(1);	(* allow for incoming exception reference *)
-    os.StoreLocal(proc.except.varOrd);
-  END Catch;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CloseCatch*();
-  BEGIN
-    IF excpCls = NIL THEN
-      IF CSt.ntvExc.tgXtn = NIL THEN
-        excpCls := getOrAddClass(corlib, "System", "Exception");
-        CSt.ntvExc.tgXtn := excpCls;
-      ELSE
-        excpCls := CSt.ntvExc.tgXtn(Api.ClassRef);
-      END;
-    END;
-    os.pePI.code.EndCatchBlock(excpCls, os.pePI.tryB);
-  END CloseCatch;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)CopyCall*(typ : Ty.Record);
-  BEGIN
-    os.pePI.code.MethInst(Asm.cd[Asm.opc_call], os.cpy(typ));
-    os.Adjust(-2);
-  END CopyCall;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)PushStr*(IN str : ARRAY OF CHAR);
-  (* Use target quoting conventions for the literal string *)
-  BEGIN
-    (* os.pePI.code.ldstr(MKSTR(str)); *)
-    os.pePI.code.ldstr(Sys.String.init(BOX(str), 0, LEN(str) - 1));
-    os.Adjust(1);
-  END PushStr;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)CallIT*(code : INTEGER; 
-                                 proc : Id.Procs; 
-                                 type : Ty.Procedure);
-    VAR xtn : Api.Method;
-  BEGIN
-    xtn := os.mth(proc);
-    os.pePI.code.MethInst(Asm.cd[code], xtn);
-    os.Adjust(type.retN - type.argN);        
-  END CallIT;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)CallCT*(proc : Id.Procs; 
-                                 type : Ty.Procedure);
-    VAR xtn : Api.Method;
-  BEGIN
-    ASSERT(proc.tgXtn # NIL);
-    xtn := proc.tgXtn(Api.Method);
-    os.pePI.code.MethInst(Asm.cd[Asm.opc_newobj], xtn);
-    os.Adjust(-type.argN);        
-  END CallCT;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)CallDelegate*(typ : Ty.Procedure);
-    VAR xtn : Api.Method;
-  BEGIN
-    ASSERT(typ.tgXtn # NIL);
-(*
- *  xtn := typ.tgXtn(DelXtn).invD;
- *)
-    xtn := os.dxt(typ).invD;
-    os.pePI.code.MethInst(Asm.cd[Asm.opc_callvirt], xtn);
-    os.Adjust(-typ.argN + typ.retN);        
-  END CallDelegate;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)PutGetS*(code : INTEGER;
-                                  blk  : Id.BlkId;
-                                  fId  : Id.VarId);
-  (* Emit putstatic and getstatic for static field *)
-  BEGIN
-    os.pePI.code.FieldInst(Asm.cd[code], os.fld(fId));
-    os.Adjust(Asm.dl[code]);
-  END PutGetS;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)GetValObj*(code : INTEGER; ptrT : Ty.Pointer);
-    VAR rTp : Ty.Record;
-  BEGIN
-    rTp := ptrT.boundRecTp()(Ty.Record);
-    os.pePI.code.FieldInst(Asm.cd[code], os.vDl(rTp));
-    os.Adjust(Asm.dl[code]);
-  END GetValObj;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)PutGetXhr*(code : INTEGER; 
-                                    proc : Id.Procs; 
-                                    locl : Id.LocId);
-    VAR ix   : INTEGER;
-        name : Lv.CharOpen;
-        recT : Ty.Record;
-        fldI : Id.FldId;
-  BEGIN
-    ix := 0;
-    recT := proc.xhrType.boundRecTp()(Ty.Record);
-    WHILE recT.fields.a[ix].hash # locl.hash DO INC(ix) END;;
-    os.pePI.code.FieldInst(Asm.cd[code], os.fld(recT.fields.a[ix](Id.FldId)));
-  END PutGetXhr;
-
-(* -------------------------------------------- *)
-
-  PROCEDURE (os : PeFile)PutGetF*(code : INTEGER;
-                                  fId  : Id.FldId);
-  BEGIN
-    os.pePI.code.FieldInst(Asm.cd[code], os.fld(fId));
-    os.Adjust(Asm.dl[code]);
-  END PutGetF;
-
-(* ============================================================ *)
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkNewRecord*(typ : Ty.Record);
-    CONST code = Asm.opc_newobj;
-    VAR   name : Lv.CharOpen;
-  BEGIN
-   (*
-    *  We need "newobj instance void <name>::.ctor()"
-    *)
-    os.pePI.code.MethInst(Asm.cd[code], os.new(typ));
-    os.Adjust(1);
-  END MkNewRecord;
-
-(* ============================================================ *)
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkNewProcVal*(p : Sy.Idnt;   (* src Proc *)
-                                       t : Sy.Type);  (* dst Type *)
-    VAR ctor : Api.Method;
-        ldfi : INTEGER;
-        pTyp : Ty.Procedure;
-        proc : Id.Procs;
-  BEGIN
-(*
- *  ctor := t.tgXtn(DelXtn).newD;
- *)
-    proc := p(Id.Procs);
-    pTyp := t(Ty.Procedure);
-    ctor := os.dxt(pTyp).newD;
-   (*
-    *  We need "ldftn [instance] <retType> <procName>
-    *)
-    WITH p : Id.MthId DO
-      IF p.bndType.isInterfaceType() THEN
-        ldfi := Asm.opc_ldvirtftn;
-      ELSIF p.mthAtt * Id.mask = Id.final THEN
-        ldfi := Asm.opc_ldftn;
-      ELSE
-        ldfi := Asm.opc_ldvirtftn;
-      END;
-    ELSE
-      ldfi := Asm.opc_ldftn;
-    END;
-   (*
-    *  These next are needed for imported events
-    *)
-    Mu.MkProcName(proc, os);
-    os.NumberParams(proc, pTyp);
-   (*
-    *   If this will be a virtual method call, then we
-    *   must duplicate the receiver, since the call of
-    *   ldvirtftn uses up one copy.
-    *)
-    IF ldfi = Asm.opc_ldvirtftn THEN os.Code(Asm.opc_dup) END;
-    os.pePI.code.MethInst(Asm.cd[ldfi], os.mth(proc));
-    os.Adjust(1);
-   (*
-    *  Now we need "newobj instance void <name>::.ctor(...)"
-    *)
-    os.pePI.code.MethInst(Asm.cd[Asm.opc_newobj], ctor);
-    os.Adjust(-2);
-  END MkNewProcVal;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)CallSuper*(rTp : Ty.Record;
-                                    prc : Id.PrcId);
-    VAR pNm : INTEGER;
-        spr : Api.Method;
-  (* ---------------------------------------- *)
-    PROCEDURE getSuperCtor(os  : PeFile; 
-                           rTp : Ty.Record; 
-                           prc : Id.Procs) : Api.Method;
-      VAR bas : Ty.Record;
-          pTp : Ty.Procedure;
-          bcl : Api.Class;
-          mth : Api.Method;
-    BEGIN
-      bas := rTp.superType();
-      IF prc # NIL THEN
-       (*
-        *  This constructor has arguments.
-        *  The super constructor is prc.basCll.sprCtor
-        *)
-        pTp := prc.type(Ty.Procedure);
-        IF prc.tgXtn = NIL THEN
-          bcl := os.cls(bas);
-          WITH bcl : Api.ClassDef DO
-              mth := MkMthDef(os, FALSE, pTp, bcl, ctorS);
-              mth(Api.MethodDef).AddMethAttribute(ctAtt);
-          | bcl : Api.ClassRef DO
-              mth := MkMthRef(os, pTp, bcl, ctorS);
-          END;
-          mth.AddCallConv(Api.CallConv.Instance);
-          prc.tgXtn := mth;
-          RETURN mth;
-        ELSE
-          RETURN prc.tgXtn(Api.Method);
-        END;
-      ELSIF (bas # NIL) & (rTp.baseTp # Bi.anyRec) THEN
-       (*
-        * This is the explicit noarg constructor of the supertype.
-        *)
-        RETURN os.new(bas);
-      ELSE
-       (*
-        *  This is System.Object::.ctor()
-        *)
-        RETURN newObjt;
-      END;
-    END getSuperCtor;
-  (* ---------------------------------------- *)
-  BEGIN
-    IF prc # NIL THEN 
-      pNm := prc.type(Ty.Procedure).formals.tide;
-    ELSE 
-      pNm := 0;
-    END;
-    spr := getSuperCtor(os, rTp, prc);
-    os.pePI.code.MethInst(Asm.cd[Asm.opc_call], spr);
-    os.Adjust(-(pNm+1));
-  END CallSuper;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)InitHead*(rTp : Ty.Record;
-                                   prc : Id.PrcId);
-    VAR mDf : Api.MethodDef;
-        cDf : Api.ClassDef;
-  BEGIN
-    cDf := os.cls(rTp)(Api.ClassDef);
-
-    IF prc # NIL THEN
-      mDf := prc.tgXtn(Api.MethodDef);
-      mDf.AddMethAttribute(ctAtt);
-    ELSE
-      mDf := os.new(rTp)(Api.MethodDef);
-    END;
-    os.pePI.mthD := mDf;
-    os.MkCodeBuffer();
-    mDf.AddCallConv(Api.CallConv.Instance);
-   (*
-    *   Now we initialize the supertype;
-    *)
-    os.Code(Asm.opc_ldarg_0);
-  END InitHead;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)CopyHead*(typ : Ty.Record);
-    VAR mDf : Api.MethodDef;
-        cDf : Api.ClassDef;
-        par : Id.ParId;
-        prs : POINTER TO ARRAY OF Id.ParId;
-  BEGIN
-    cDf := os.cls(typ)(Api.ClassDef);
-    mDf := os.cpy(typ)(Api.MethodDef);
-    mDf.AddMethAttribute(Api.MethAttr.Public);
-    mDf.AddImplAttribute(ilAtt);
-    mDf.AddCallConv(Api.CallConv.Instance);
-    os.pePI.mthD := mDf;
-    os.MkCodeBuffer();
-  END CopyHead;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MarkInterfaces*(IN seq : Sy.TypeSeq);
-    VAR index  : INTEGER;
-        tideX  : INTEGER;
-        implT  : Ty.Record;
-  BEGIN
-    tideX := seq.tide-1;
-    ASSERT(tideX >= 0);
-    FOR index := 0 TO tideX DO
-      implT := seq.a[index].boundRecTp()(Ty.Record);
-      os.clsD.AddImplementedInterface(os.cls(implT));
-    END;
-  END MarkInterfaces;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MainHead*(xAtt : SET);
-    VAR mthD : Api.MethodDef;
-
-    VAR strA : Api.Type;
-        list : Api.Field;
-        pars : POINTER TO ARRAY OF Api.Param;
-  BEGIN 
-    NEW(pars, 1);
-    strA := Api.ZeroBasedArray.init(strgD);
-    pars[0] := Api.Param.init(0, "@args", strA);
-
-    IF Sy.wMain IN xAtt THEN
-      mthD := os.clsS.AddMethod(psAtt, ilAtt, ".WinMain", voidD, pars);
-    ELSE (* Sy.cMain IN xAtt THEN *)
-      mthD := os.clsS.AddMethod(psAtt, ilAtt, ".CPmain", voidD, pars);
-    END;
-    os.pePI.mthD := mthD;
-    os.MkCodeBuffer();
-    mthD.DeclareEntryPoint();
-    IF CSt.debug THEN os.LineSpan(Scn.mkSpanT(CSt.thisMod.begTok)) END;
-   (*
-    *  Save the command-line arguments to the RTS.
-    *)
-    os.Code(Asm.opc_ldarg_0);
-    os.CodeF(Asm.opc_stsfld, os.fld(CSt.argLst));
-  END MainHead;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)SubSys*(xAtt : SET);
-  BEGIN
-    IF Sy.wMain IN xAtt THEN os.peFl.SetSubSystem(2) END;
-  END SubSys;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)StartBoxClass*(rec : Ty.Record;
-                                        att : SET;
-                                        blk : Id.BlkId);
-    VAR mthD : Api.MethodDef;
-        sprC : Api.Method;
-        boxC : Api.ClassDef;
-  BEGIN
-    boxC := rec.tgXtn(RecXtn).boxD(Api.ClassDef);
-    boxC.AddAttribute(toTypeAttr(att));
-
-   (*
-    *   Emit the no-arg constructor
-    *)
-    os.MkNewProcInfo(blk);
-    mthD := os.new(rec)(Api.MethodDef);
-    os.pePI.mthD := mthD;
-    os.MkCodeBuffer();
-    mthD.AddCallConv(Api.CallConv.Instance);
-
-    os.Code(Asm.opc_ldarg_0);
-    sprC := newObjt;
-
-    os.pePI.code.MethInst(Asm.cd[Asm.opc_call], sprC);
-    os.InitHead(rec, NIL);
-    os.CallSuper(rec, NIL);
-    os.Code(Asm.opc_ret);
-    os.Locals();
-    os.InitTail(rec);
-    os.pePI := NIL;
-    os.proc := NIL;
-   (*
-    *   Copies of value classes are always done inline.
-    *)
-  END StartBoxClass;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)Tail(),NEW;
-  BEGIN
-    os.Locals();
-    os.pePI.code.CloseScope();  (* Needed for PERWAPI pdb files *)
-    os.pePI := NIL;
-    os.proc := NIL;
-  END Tail;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MainTail*();
-  BEGIN os.Tail() END MainTail;
-
-(* ------------------------------------------------------------ *)
-
-  PROCEDURE (os : PeFile)MethodTail*(id : Id.Procs);
-  BEGIN os.Tail() END MethodTail;
-
-(* ------------------------------------------------------------ *)
-
-  PROCEDURE (os : PeFile)ClinitTail*();
-  BEGIN os.Tail() END ClinitTail;
-
-(* ------------------------------------------------------------ *)
-
-  PROCEDURE (os : PeFile)CopyTail*();
-  BEGIN os.Tail() END CopyTail;
-
-(* ------------------------------------------------------------ *)
-
-  PROCEDURE (os : PeFile)InitTail*(typ : Ty.Record);
-  BEGIN os.Tail() END InitTail;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)ClinitHead*();
-    VAR mAtt : INTEGER;
-  BEGIN
-    mAtt := ctAtt + Api.MethAttr.Static;
-    os.pePI.mthD := os.clsS.AddMethod(mAtt, ilAtt, ".cctor", voidD, NIL);
-    os.MkCodeBuffer();
-    IF CSt.debug THEN
-      os.pePI.code.IntLine(CSt.thisMod.token.lin, 
-                           CSt.thisMod.token.col, 
-                           CSt.thisMod.token.lin,
-                           CSt.thisMod.token.col + CSt.thisMod.token.len);
-      os.Code(Asm.opc_nop);
-    END; 
-  END ClinitHead;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)EmitField*(id : Id.AbVar; att : SET);
-    VAR fDf : Api.FieldDef;
-  BEGIN
-    fDf := os.fld(id)(Api.FieldDef);
-    fDf.AddFieldAttr(toFieldAttr(att));
-  END EmitField;
-
-(* ============================================================ *)
-(*           Start of Procedure Variable and Event Stuff            *)
-(* ============================================================ *)
-
-  PROCEDURE MkAddRem(os : PeFile; fId : Id.AbVar);
-    VAR xtn : EvtXtn;
-        fXt : Api.Field;
-        clD : Api.Class;
-        namS : Lv.CharOpen;
-        typA : POINTER TO ARRAY OF Api.Type;
-        parA : POINTER TO ARRAY OF Api.Param;
-   (* -------------------------------- *)
-    PROCEDURE GetClass(os : PeFile; 
-                       id : Id.AbVar;
-                   OUT cl : Api.Class;
-                   OUT nm : Lv.CharOpen);
-    BEGIN
-      WITH id : Id.FldId DO
-           cl := os.cls(id.recTyp(Ty.Record));
-           nm := id.fldNm;
-      | id : Id.VarId DO
-           IF id.recTyp # NIL THEN cl:= os.cls(id.recTyp(Ty.Record));
-           ELSE cl:= os.dsc(id.dfScp(Id.BlkId));
-           END;
-           nm := id.varNm;
-      END;
-    END GetClass;
-   (* -------------------------------- *)
-  BEGIN
-   (*
-    *  First, need to ensure that there is a field 
-    *  descriptor created for this variable.
-    *)
-    IF fId.tgXtn = NIL THEN 
-      fXt := os.fld(fId);
-    ELSE 
-      fXt := fId.tgXtn(Api.Field);
-    END;
-   (*
-    *  Now allocate the Event Extension object.
-    *)
-    NEW(xtn);
-    xtn.fldD := fXt;
-   (*
-    *  Now create the MethodRef or MethodDef descriptors
-    *  for add_<fieldname>() and remove_<fieldname>()
-    *)
-    GetClass(os, fId, clD, namS);
-    WITH clD : Api.ClassDef DO
-          NEW(parA, 1);
-          parA[0] := Api.Param.init(0, "ev", os.typ(fId.type)); 
-          xtn.addD := clD.AddMethod(MKSTR(evtAdd^ + namS^), voidD, parA);
-          xtn.remD := clD.AddMethod(MKSTR(evtRem^ + namS^), voidD, parA);
-    | clD : Api.ClassRef DO
-          NEW(typA, 1);
-          typA[0] := os.typ(fId.type); 
-          xtn.addD := clD.AddMethod(MKSTR(evtAdd^ + namS^), voidD, typA);
-          xtn.remD := clD.AddMethod(MKSTR(evtRem^ + namS^), voidD, typA);
-    END;
-    fId.tgXtn := xtn;
-  END MkAddRem;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)EmitEventMethods*(id : Id.AbVar);
-    CONST att  = Api.MethAttr.Public + Api.MethAttr.SpecialName;
-    VAR   eTp  : Ty.Event;
-          evt  : Api.Event;
-          addD  : Api.MethodDef;
-          remD  : Api.MethodDef;
-   (* ------------------------------------------------- *)
-    PROCEDURE EmitEvtMth(os  : PeFile; 
-                         id  : Id.AbVar;
-                         add : BOOLEAN; 
-                         mth : Api.MethodDef);
-      VAR pFix : Lv.CharOpen;
-          mStr : RTS.NativeString;
-          mthD : Api.MethodDef;
-          parA : POINTER TO ARRAY OF Api.Param;
-    BEGIN
-      os.MkNewProcInfo(NIL);
-      WITH id : Id.FldId DO
-          mth.AddMethAttribute(att);
-          mth.AddCallConv(Api.CallConv.Instance);
-          mth.AddImplAttribute(ilAtt + Api.ImplAttr.Synchronised);
-          os.pePI.mthD := mth;
-          os.MkCodeBuffer();
-          os.Code(Asm.opc_ldarg_0);
-          os.Code(Asm.opc_ldarg_0);
-          os.PutGetF(Asm.opc_ldfld, id);
-          os.Code(Asm.opc_ldarg_1);
-          os.CallCombine(id.type, add);
-          os.PutGetF(Asm.opc_stfld, id);
-      | id : Id.VarId DO
-          mth.AddMethAttribute(att + Api.MethAttr.Static);
-          mth.AddImplAttribute(ilAtt + Api.ImplAttr.Synchronised);
-          os.pePI.mthD := mth;
-          os.MkCodeBuffer(); 
-          os.PutGetS(Asm.opc_ldsfld, id.dfScp(Id.BlkId), id);
-          os.Code(Asm.opc_ldarg_0);
-          os.CallCombine(id.type, add);
-          os.PutGetS(Asm.opc_stsfld, id.dfScp(Id.BlkId),id);
-      END;
-      os.Code(Asm.opc_ret);
-      os.Tail();
-    END EmitEvtMth;
-   (* ------------------------------------------------- *)
-  BEGIN
-   (*
-    *  Emit the "add_*" method
-    *)
-    addD := os.add(id)(Api.MethodDef);
-    EmitEvtMth(os, id, TRUE, addD);
-   (*
-    *  Emit the "remove_*" method
-    *)
-    remD := os.rem(id)(Api.MethodDef);
-    EmitEvtMth(os, id, FALSE, remD);
-   (*
-    *  Emit the .event declaration" 
-    *)
-    WITH id : Id.FldId DO
-        evt := os.clsD.AddEvent(MKSTR(id.fldNm^), os.typ(id.type));
-    | id : Id.VarId DO
-        evt := os.clsD.AddEvent(MKSTR(id.varNm^), os.typ(id.type));
-    END;
-    evt.AddMethod(addD, Api.MethodType.AddOn);
-    evt.AddMethod(remD, Api.MethodType.RemoveOn);
-  END EmitEventMethods;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)CallCombine(typ : Sy.Type;
-                                     add : BOOLEAN),NEW;
-    VAR xtn : Api.Method;
-  BEGIN
-    IF add THEN xtn := os.cmb() ELSE xtn := os.rmv() END; 
-    os.pePI.code.MethInst(Asm.cd[Asm.opc_call], xtn);
-    os.Adjust(-1);        
-    os.CodeT(Asm.opc_castclass, typ);
-  END CallCombine;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkAndLinkDelegate*(dl  : Sy.Idnt;
-                                            id  : Sy.Idnt;
-                                            ty  : Sy.Type;
-                                            isA : BOOLEAN);
-   (* --------------------------------------------------------- *)
-    VAR rcv : INTEGER;
-        mth : Api.Method;
-   (* --------------------------------------------------------- *)
-  BEGIN
-    WITH id : Id.FldId DO
-       (*
-        *      <push handle>                  // ... already done
-        *      <push receiver (or nil)>       // ... already done
-        *      <make new proc value>          // ... still to do
-        *      call      instance void A.B::add_fld(class tyName)
-        *)
-        os.MkNewProcVal(dl, ty);
-        IF isA THEN mth := os.add(id) ELSE mth := os.rem(id) END;
-        mth.AddCallConv(Api.CallConv.Instance);
-        os.pePI.code.MethInst(Asm.cd[Asm.opc_call], mth);
-    | id : Id.VarId DO
-       (*
-        *      <push receiver (or nil)>      // ... already done
-        *      <make new proc value>            // ... still to do
-        *      call      void A.B::add_fld(class tyName)
-        *)
-        os.MkNewProcVal(dl, ty);
-        IF isA THEN mth := os.add(id) ELSE mth := os.rem(id) END;
-        os.pePI.code.MethInst(Asm.cd[Asm.opc_call], mth);
-    | id : Id.LocId DO
-       (*
-        *      <save receiver>      
-        *      ldloc      'local'
-        *      <restore receiver>      
-        *      <make new proc value>            // ... still to do
-        *      call      class D D::Combine(class D, class D)
-        *)
-        rcv := os.proc.newLocal(CSt.ntvObj);
-        os.StoreLocal(rcv);
-        os.GetLocal(id);
-        os.PushLocal(rcv);
-        os.MkNewProcVal(dl, ty);
-        os.CallCombine(ty, isA);
-        os.PutLocal(id); 
-    END;
-  END MkAndLinkDelegate;
-
-(* ============================================================ *)
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)EmitPTypeBody*(tId : Id.TypId);
-  BEGIN
-    ASSERT(tId.tgXtn # NIL);
-  END EmitPTypeBody;
-
-(* ============================================================ *)
-(*          End of Procedure Variable and Event Stuff           *)
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)Line*(nm : INTEGER);
-  BEGIN
-    os.pePI.code.IntLine(nm,1,nm,100);
-    (*IF CSt.debug THEN os.Code(Asm.opc_nop) END;*)
-  END Line;
- 
-  PROCEDURE (os : PeFile)LinePlus*(lin, col : INTEGER); 
-  BEGIN
-    (*IF CSt.debug THEN os.Code(Asm.opc_nop) END;*)
-    os.pePI.code.IntLine(lin,1,lin,col); 
-  END LinePlus;
-  
-  PROCEDURE (os : PeFile)LineSpan*(s : Scn.Span);
-  BEGIN
-    IF s # NIL THEN 
-         os.pePI.code.IntLine(s.sLin, s.sCol, s.eLin, s.eCol) END;     
-  END LineSpan;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)Locals(),NEW;
-  (** Declare the local of this method. *)
-    VAR count : INTEGER;
-        index : INTEGER;
-        prcId : Sy.Scope;
-        locId : Id.LocId;
-        methD : Api.MethodDef;
-        loclA : POINTER TO ARRAY OF Api.Local;
-        boolA : POINTER TO ARRAY OF BOOLEAN;
-        lBind : Api.LocalBinding;
-  BEGIN
-    methD := os.pePI.mthD;
-   (*
-    *   If dMax < 8, leave maxstack as default 
-    *)
-    IF os.proc.dMax > 8 THEN 
-      methD.SetMaxStack(os.proc.dMax);
-    ELSE
-      methD.SetMaxStack(8);
-    END;
-    NEW(loclA, os.proc.tLst.tide);
-    NEW(boolA, os.proc.tLst.tide);
-
-    count := 0;
-    IF os.proc.prId # NIL THEN 
-      prcId := os.proc.prId;
-      WITH prcId : Id.Procs DO
-        IF Id.hasXHR IN prcId.pAttr THEN
-          loclA[count] := Api.Local.init("", os.typ(prcId.xhrType)); 
-          INC(count);
-        END;
-        FOR index := 0 TO prcId.locals.tide-1 DO
-          locId := prcId.locals.a[index](Id.LocId);
-          IF ~(locId IS Id.ParId) & (locId.varOrd # Id.xMark) THEN
-            loclA[count] := Api.Local.init(nms(locId), os.typ(locId.type));
-            IF CSt.debug THEN boolA[count] := TRUE END;
-            INC(count);
-          END;
-        END;
-      ELSE (* nothing for module blocks *)
-      END;
-    END;
-    WHILE count < os.proc.tLst.tide DO 
-      loclA[count] := Api.Local.init("", os.typ(os.proc.tLst.a[count])); 
-      INC(count);
-    END;
-    IF count > 0 THEN methD.AddLocals(loclA, TRUE) END;
-    FOR index := 0 TO count-1 DO
-      IF boolA[index] THEN lBind := os.pePI.code.BindLocal(loclA[index]) END;
-    END;
-  END Locals;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)LoadType*(id : Sy.Idnt);
-   (* ---------------------------------- *)
-    PROCEDURE getLdTyp(os : PeFile) : Api.MethodRef;
-      VAR typD : Api.ClassRef;
-          rthA : POINTER TO ARRAY OF Api.Type;
-    BEGIN
-      IF loadTyp = NIL THEN
-       (*
-        *  Make params for the call
-        *)
-        NEW(rthA, 1);
-        IF rtTpHdl = NIL THEN
-          rtTpHdl := getOrAddValueClass(corlib, "System", "RuntimeTypeHandle");
-        END;
-        rthA[0] := rtTpHdl;
-       (*
-        *  Make receiver/result type descriptor
-        *)
-        IF CSt.ntvTyp.tgXtn = NIL THEN
-          CSt.ntvTyp.tgXtn := getOrAddClass(corlib, "System", "Type");
-        END;
-        typD := CSt.ntvTyp.tgXtn(Api.ClassRef);
-        loadTyp := getOrAddMethod(typD, "GetTypeFromHandle", typD, rthA);
-      END;
-      RETURN loadTyp;
-    END getLdTyp;
-   (* ---------------------------------- *)
-  BEGIN
-   (*
-    *    ldtoken <Type>
-    *    call class [mscorlib]System.Type 
-    *           [mscorlib]System.Type::GetTypeFromHandle(
-    *                     value class [mscorlib]System.RuntimeTypeHandle)
-    *)
-    os.CodeT(Asm.opc_ldtoken, id.type);
-    os.pePI.code.MethInst(Asm.cd[Asm.opc_call], getLdTyp(os));
-  END LoadType;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)Finish*();
-   (*(* ------------------------------------ *)
-    PROCEDURE MakeDebuggable(pef : Api.PEFile);
-      VAR thisAssm : Api.Assembly;
-          debugRef : Api.ClassRef;
-          dbugCtor : Api.MethodRef;
-          trueCnst : Api.BoolConst;
-          twoBools : TypArr;
-          dbugArgs : POINTER TO ARRAY OF Api.Constant;
-    BEGIN
-      thisAssm := pef.GetThisAssembly();
-      debugRef := getOrAddClass(corlib, "System.Diagnostics", "DebuggableAttribute");
-      NEW(twoBools, 2);
-      NEW(dbugArgs, 2);
-      twoBools[0] := Api.PrimitiveType.Boolean;
-      twoBools[1] := Api.PrimitiveType.Boolean;
-      dbugArgs[0] := Api.BoolConst.init(TRUE);
-      dbugArgs[1] := Api.BoolConst.init(TRUE);
-      dbugCtor := getOrAddMethod(debugRef, ctorS, voidD, twoBools)(Api.MethodRef);
-      dbugCtor.AddCallConv(Api.CallConv.Instance);
-      thisAssm.AddCustomAttribute(dbugCtor, dbugArgs);  
-    END MakeDebuggable;
-   (* ------------------------------------ *)*)
-  BEGIN
-    IF CSt.debug THEN os.peFl.MakeDebuggable(TRUE, TRUE) END; 
-    (* bake the assembly ... *)
-    os.peFl.WritePEFile(CSt.debug); 
-  END Finish;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)RefRTS*();
-    VAR i : INTEGER;
-        xhrRc : Ty.Record;
-        xhrNw : Api.Method;
-        xhrXt : RecXtn;
-        rtsXt : BlkXtn;
-        recXt : RecXtn;
-  BEGIN
-   (*
-    *  Reset the descriptor pool.
-    *  Note that descriptors cannot persist between
-    *  compilation unit, since the token sequence
-    *  is reset in PEAPI.
-    *)
-    mathCls := NIL;
-    envrCls := NIL;
-    excpCls := NIL;
-    rtTpHdl := NIL;
-    loadTyp := NIL;
-    FOR i := 0 TO Mu.rtsLen-1 DO rHelper[i] := NIL END;
-   (*
-    *  Now we need to create tgXtn fields
-    *  for some of the system types.   All 
-    *  others are only allocated on demand.
-    *)
-    corlib := os.peFl.MakeExternAssembly("mscorlib");
-   (*
-    *  Must put xtn markers on both the pointer AND the record
-    *)
-    NEW(recXt);
-    CSt.ntvStr(Ty.Pointer).boundTp.tgXtn := recXt;      (* the record  *)
-(*
- *  recXt.clsD := corlib.AddClass("System", "String");
- *)
-(* -- start replacement -- *)
-    recXt.clsD := getOrAddClass(corlib, "System", "String");
-(* --- end replacement --- *)
-    CSt.ntvStr.tgXtn := recXt.clsD;                     (* the pointer *)
-   (*
-    *  Must put xtn markers on both the pointer AND the record
-    *)
-    NEW(recXt);
-    CSt.ntvObj(Ty.Pointer).boundTp.tgXtn := recXt;      (* the record  *)
-(*
- *  recXt.clsD := corlib.AddClass("System", "Object");
- *)
-(* -- start replacement -- *)
-    recXt.clsD := getOrAddClass(corlib, "System", "Object");
-(* --- end replacement --- *)
-    CSt.ntvObj.tgXtn := recXt.clsD;                     (* the pointer *)
-   (*
-    *  CSt.ntvVal IS a record descriptor, not a pointer
-    *)
-    NEW(recXt);
-    CSt.ntvVal.tgXtn := recXt;                          (* the record  *)
-(*
- *  recXt.clsD := corlib.AddClass("System", "ValueType");
- *)
-(* -- start replacement -- *)
-    recXt.clsD := getOrAddClass(corlib, "System", "ValueType");
-(* --- end replacement --- *)
-
-    newObjt := getOrAddMethod(CSt.ntvObj.tgXtn(Api.ClassRef),ctorS,voidD,NIL);
-    newObjt.AddCallConv(Api.CallConv.Instance);
-   (*
-    *  Create Api.AssemblyRef for "RTS"
-    *  Create Api.ClassRef for "[RTS]RTS"
-    *  Create Api.ClassRef for "[RTS]Cp_rts"
-    *)
-    IF CSt.rtsBlk.xName = NIL THEN Mu.MkBlkName(CSt.rtsBlk) END;
-    os.rts   := os.peFl.MakeExternAssembly("RTS");
-    NEW(rtsXt);
-    rtsXt.asmD := os.rts;
-    rtsXt.dscD := os.rts.AddClass("", "RTS");
-    CSt.rtsBlk.tgXtn := rtsXt;
-    os.cprts    := os.rts.AddClass("", "CP_rts");
-   (*
-    *  Create Api.AssemblyRef for "ProgArgs" (same as RTS)
-    *  Create Api.ClassRef for "[RTS]ProgArgs"
-    *)
-    os.DoRtsMod(CSt.prgArg);
-    os.progArgs := CSt.prgArg.tgXtn(BlkXtn).dscD(Api.ClassRef);
-   (*
-    *  Create Api.ClassRef for "[RTS]XHR"
-    *  Create method "[RTS]XHR::.ctor()"
-    *)
-    xhrCl := os.rts.AddClass("", "XHR");
-    xhrNw := xhrCl.AddMethod(ctorS, voidD, NIL);
-    xhrNw.AddCallConv(Api.CallConv.Instance);
-    xhrRc := CSt.rtsXHR.boundRecTp()(Ty.Record);
-    NEW(xhrXt);
-    xhrRc.tgXtn := xhrXt;
-    xhrXt.clsD := xhrCl;
-    xhrXt.newD := xhrNw;
-  END RefRTS;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)StartNamespace*(nm : Lv.CharOpen);
-  BEGIN
-    os.nmSp := MKSTR(nm^);
-  END StartNamespace;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkBodyClass*(mod : Id.BlkId);
-   (*
-    *   Instantiate a ClassDef object for the synthetic
-    *   static class, and assign to the PeFile::clsS field.
-    *   Of course, for the time being it is also the 
-    *   "current class" held in the PeFile::clsD field.
-    *)
-    VAR namStr : RTS.NativeString;
-        clsAtt : INTEGER;
-        modXtn : BlkXtn;
-  BEGIN
-    defSrc := Api.SourceFile.GetSourceFile(
-        MKSTR(CSt.srcNam), Sys.Guid.Empty, Sys.Guid.Empty, Sys.Guid.Empty);
-    namStr  := MKSTR(mod.clsNm^);
-    clsAtt  := toTypeAttr(Asm.modAttr);
-    os.clsS := os.peFl.AddClass(clsAtt, os.nmSp, namStr);
-    os.clsD := os.clsS; 
-    NEW(modXtn);
-    modXtn.asmD := NIL;
-    modXtn.dscD := os.clsS;
-    mod.tgXtn := modXtn;
-  END MkBodyClass;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)ClassHead*(attSet : SET; 
-                                    thisRc : Ty.Record;
-                                    superT : Ty.Record);
-    VAR clsAtt : INTEGER;
-        clsDef : Api.ClassDef;
-  BEGIN
-    clsAtt := toTypeAttr(attSet);
-    clsDef := os.cls(thisRc)(Api.ClassDef);
-    clsDef.AddAttribute(clsAtt);
-    os.clsD := clsDef;
-  END ClassHead;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)ClassTail*();
-  BEGIN
-    os.clsD := NIL;
-  END ClassTail;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkRecX*(t : Ty.Record; s : Sy.Scope);
-   (* -------------------------------- *
-    *  Create a ClassDef or a ClassRef for this type.
-    *  The type attributes are set to a default value
-    *  and are modified later for a ClassDef.
-    * -------------------------------- *)
-    VAR indx : INTEGER;
-        valR : BOOLEAN;               (* is a value record  *)
-        noNw : BOOLEAN;               (* no constructor...  *)
-        base : Ty.Record;
-        xAsm : Api.AssemblyRef;
-        xCls : Api.ClassRef;
-        cDef : Api.ClassDef;
-        cRef : Api.ClassRef;
-        nStr : RTS.NativeString;      (* record name string *)
-        aStr : RTS.NativeString;      (* imported namespace *)
-        recX : RecXtn;
-   (* -------------------------------- *)
-    PROCEDURE DoBoxDef(o : PeFile; t : Ty.Record);
-      VAR nStr : RTS.NativeString;
-          cDef : Api.ClassDef;
-          cFld : Api.FieldDef;
-          nMth : Api.MethodDef;
-          tXtn : RecXtn;
-    BEGIN
-      nStr := boxedName(t);
-      tXtn := t.tgXtn(RecXtn);
-      cDef := o.peFl.AddClass(0, o.nmSp, nStr);
-      cFld := cDef.AddField(vfldS, tXtn.clsD);
-      nMth := cDef.AddMethod(ctAtt,ilAtt,ctorS,voidD,NIL);
-
-      nMth.AddCallConv(Api.CallConv.Instance);
-      cFld.AddFieldAttr(Api.FieldAttr.Public);
-
-      tXtn.boxD := cDef;
-      tXtn.newD := nMth;
-      tXtn.vDlr := cFld;
-    END DoBoxDef;
-   (* -------------------------------- *)
-    PROCEDURE DoBoxRef(o : PeFile; t : Ty.Record; c : Api.ClassRef);
-      VAR cFld : Api.FieldRef;
-          nMth : Api.MethodRef;
-          tXtn : RecXtn;
-    BEGIN
-      tXtn := t.tgXtn(RecXtn);
-      cFld := getOrAddField(c, vfldS, tXtn.clsD);
-(*
- *    nMth := c.AddMethod(ctorS,voidD,NIL);
- *)
-      nMth := getOrAddMethod(c, ctorS, voidD, NIL);
-      nMth.AddCallConv(Api.CallConv.Instance);
-
-      tXtn.boxD := c;
-      tXtn.newD := nMth;
-      tXtn.vDlr := cFld;
-    END DoBoxRef;
-   (* -------------------------------- *)
-  BEGIN
-    nStr := MKSTR(t.xName^);
-    valR := Mu.isValRecord(t);
-    NEW(recX);
-    t.tgXtn := recX;
-   (*
-    *  No default no-arg constructor is defined if this
-    *  is an abstract record, an interface, or extends a
-    *  foreign record that does not export a no-arg ctor.
-    *)
-    noNw := t.isInterfaceType() OR (Sy.noNew IN t.xAttr);
-
-    IF s.kind # Id.impId THEN (* this is a classDEF *)
-      base := t.superType();  (* might return System.ValueType *)
-      IF base = NIL THEN
-        cDef := os.peFl.AddClass(0, os.nmSp, nStr);
-      ELSIF valR THEN
-        cDef := os.peFl.AddValueClass(0, os.nmSp, nStr);
-      ELSE
-        cDef := os.peFl.AddClass(0, os.nmSp, nStr, os.cls(base));
-      END;
-      recX.clsD := cDef; (* this field needed for MkFldName() *)
-      IF valR THEN 
-       (*
-        *  Create the boxed version of this value record
-        *  AND create a constructor for the boxed class
-        *)
-        DoBoxDef(os, t);
-      ELSIF ~noNw THEN
-       (*
-        *  Create a constructor for this reference class.
-        *)
-        recX.newD := cDef.AddMethod(ctAtt, ilAtt, ctorS, voidD, NIL);
-        recX.newD.AddCallConv(Api.CallConv.Instance);
-      END;
-      FOR indx := 0 TO t.fields.tide-1 DO
-        Mu.MkFldName(t.fields.a[indx](Id.FldId), os);
-      END;
-    ELSE                      (* this is a classREF *)
-      IF t.encCls # NIL THEN  (* ... a nested classREF *)
-        base := t.encCls(Ty.Record);
-        xCls := os.cls(base)(Api.ClassRef);
-        cRef := xCls.AddNestedClass(nStr);
-        recX.clsD := cRef;
-      ELSE                    (* ... a normal classREF *)
-        xAsm := os.asm(s(Id.BlkId));
-        aStr := MKSTR(s(Id.BlkId).xName^);
-        IF valR THEN
-          cRef := getOrAddValueClass(xAsm, aStr, nStr);
-        ELSE
-          cRef := getOrAddClass(xAsm, aStr, nStr);
-        END;
-        recX.clsD := cRef;
-        IF valR & ~(Sy.isFn IN t.xAttr) THEN
-          DoBoxRef(os, t, xAsm.AddClass(aStr, boxedName(t)));
-        END;
-      END;
-
-      IF ~noNw & ~valR THEN
-        recX.newD := getOrAddMethod(cRef, ctorS, voidD, NIL);
-        recX.newD.AddCallConv(Api.CallConv.Instance);
-      END;
-    END;
-  END MkRecX;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkVecX*(t : Sy.Type; m : Id.BlkId);
-    VAR xAsm : Api.AssemblyRef;
-        recX : RecXtn;
-        nStr : RTS.NativeString;      (* record name string *)
-        aStr : RTS.NativeString;      (* imported namespace *)
-        cRef : Api.ClassRef;
-  BEGIN
-    NEW(recX);
-    t.tgXtn := recX;
-
-    IF m.tgXtn = NIL THEN os.DoRtsMod(m) END;
-    IF t.xName = NIL THEN Mu.MkTypeName(t, os) END;
-
-    aStr := MKSTR(m.xName^);
-    nStr := MKSTR(t.xName^);
-
-    xAsm := os.asm(m);
-    cRef := xAsm.AddClass(aStr, nStr);
-    recX.clsD := cRef;
-    recX.newD := cRef.AddMethod(ctorS, voidD, NIL);
-    recX.newD.AddCallConv(Api.CallConv.Instance);
-  END MkVecX;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkDelX(t : Ty.Procedure;
-                                s : Sy.Scope),NEW;
-   (* -------------------------------- *)
-    CONST dAtt = Asm.att_public + Asm.att_sealed;
-    VAR   xtn : DelXtn;             (* The created descriptor   *)
-          str : RTS.NativeString;   (* The proc-type nameString *)
-          att : Api.TypeAttr;       (* public,sealed (for Def)  *)
-          asN : RTS.NativeString;   (* Assembly name (for Ref)  *)
-          asR : Api.AssemblyRef;    (* Assembly ref  (for Ref)  *)
-          rtT : Sy.Type;            (* AST return type of proc  *)
-          rtD : Api.Type;           (* Api return type of del.  *)
-          clD : Api.ClassDef;
-          clR : Api.ClassRef;
-          mtD : Api.MethodDef;
-   (* -------------------------------- *)
-    PROCEDURE t2() : POINTER TO ARRAY OF Api.Type;
-      VAR a : POINTER TO ARRAY OF Api.Type;
-    BEGIN 
-      NEW(a,2); a[0] := objtD; a[1] := nIntD; RETURN a; 
-    END t2;
-   (* -------------------------------- *)
-    PROCEDURE p2() : POINTER TO ARRAY OF Api.Param;
-      VAR a : POINTER TO ARRAY OF Api.Param;
-    BEGIN
-      NEW(a,2);
-      a[0] := Api.Param.init(0, "obj", objtD); 
-      a[1] := Api.Param.init(0, "mth", nIntD); 
-      RETURN a;
-    END p2;
-   (* -------------------------------- *)
-    PROCEDURE tArr(t: Ty.Procedure; o: PeFile) : POINTER TO ARRAY OF Api.Type;
-      VAR a : POINTER TO ARRAY OF Api.Type;
-          i : INTEGER;
-          p : Id.ParId;
-          d : Api.Type;
-    BEGIN
-      NEW(a, t.formals.tide);
-      FOR i := 0 TO t.formals.tide-1 DO
-        p := t.formals.a[i];
-        d := o.typ(p.type);
-        IF Mu.takeAdrs(p) THEN 
-          p.boxOrd := p.parMod;
-          d := Api.ManagedPointer.init(d);
-        END; 
-        a[i] := d; 
-      END;
-      RETURN a;
-    END tArr;
-   (* -------------------------------- *)
-    PROCEDURE pArr(t: Ty.Procedure; o: PeFile) : POINTER TO ARRAY OF Api.Param;
-      VAR a : POINTER TO ARRAY OF Api.Param;
-          i : INTEGER;
-          p : Id.ParId;
-          d : Api.Type;
-    BEGIN
-      NEW(a, t.formals.tide);
-      FOR i := 0 TO t.formals.tide-1 DO
-        p := t.formals.a[i];
-        d := o.typ(p.type);
-        IF Mu.takeAdrs(p) THEN 
-          p.boxOrd := p.parMod;
-          d := Api.ManagedPointer.init(d);
-        END; 
-        a[i] := Api.Param.init(0, nms(p), d); 
-      END;
-      RETURN a;
-    END pArr;
-   (* -------------------------------- *)
-  BEGIN
-    IF t.tgXtn # NIL THEN RETURN END;
-    NEW(xtn);
-    str := MKSTR(Sy.getName.ChPtr(t.idnt)^);
-    rtT := t.retType;
-    IF rtT = NIL THEN rtD := voidD ELSE rtD := os.typ(rtT) END;
-
-    IF s.kind # Id.impId THEN (* this is a classDEF *)
-      att := toTypeAttr(dAtt);
-      clD := os.peFl.AddClass(att, os.nmSp, str, os.mcd());
-      mtD := clD.AddMethod(ctorS, voidD, p2());
-      mtD.AddMethAttribute(ctAtt);
-      mtD.AddImplAttribute(rmAtt);
-      xtn.newD := mtD;
-      mtD := clD.AddMethod(invkS, rtD, pArr(t, os));
-      mtD.AddMethAttribute(Api.MethAttr.Public);
-      mtD.AddImplAttribute(rmAtt);
-      xtn.invD := mtD;
-      xtn.clsD := clD;
-    ELSE                      (* this is a classREF *)
-      asR := os.asm(s(Id.BlkId));
-      asN := MKSTR(s(Id.BlkId).xName^);
-      clR := getOrAddClass(asR, asN, str);
-      xtn.newD := clR.AddMethod(ctorS, voidD, t2());
-      xtn.invD := clR.AddMethod(invkS, rtD, tArr(t, os));
-      xtn.clsD := clR;
-    END;
-    xtn.newD.AddCallConv(Api.CallConv.Instance);
-    xtn.invD.AddCallConv(Api.CallConv.Instance);
-    t.tgXtn := xtn;
-    IF (t.idnt # NIL) & (t.idnt.tgXtn = NIL) THEN t.idnt.tgXtn := xtn END;
-  END MkDelX;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkPtrX*(t : Ty.Pointer);
-    VAR bTyp : Sy.Type;
-        recX : RecXtn;
-  BEGIN
-    bTyp := t.boundTp;
-    IF bTyp.tgXtn = NIL THEN Mu.MkTypeName(bTyp, os) END;
-    WITH bTyp : Ty.Record DO
-        recX := bTyp.tgXtn(RecXtn);
-        IF recX.boxD # NIL THEN t.tgXtn := recX.boxD;
-        ELSE t.tgXtn := recX.clsD;
-        END;
-    | bTyp : Ty.Array DO
-        t.tgXtn := bTyp.tgXtn;
-    END;
-  END MkPtrX;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkArrX*(t : Ty.Array);
-  BEGIN
-    t.tgXtn := Api.ZeroBasedArray.init(os.typ(t.elemTp));
-  END MkArrX;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkBasX*(t : Ty.Base);
-  BEGIN
-    CASE t.tpOrd OF
-    | Ty.uBytN            : t.tgXtn := Api.PrimitiveType.UInt8;
-    | Ty.byteN            : t.tgXtn := Api.PrimitiveType.Int8;
-    | Ty.sIntN            : t.tgXtn := Api.PrimitiveType.Int16;
-    | Ty.intN,Ty.setN     : t.tgXtn := Api.PrimitiveType.Int32;
-    | Ty.lIntN            : t.tgXtn := Api.PrimitiveType.Int64;
-    | Ty.boolN            : t.tgXtn := Api.PrimitiveType.Boolean;
-    | Ty.charN,Ty.sChrN   : t.tgXtn := Api.PrimitiveType.Char;
-    | Ty.realN            : t.tgXtn := Api.PrimitiveType.Float64;
-    | Ty.sReaN            : t.tgXtn := Api.PrimitiveType.Float32;
-    | Ty.anyRec,Ty.anyPtr : t.tgXtn := Api.PrimitiveType.Object;
-    END;
-  END MkBasX;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)MkEnuX*(t : Ty.Enum; s : Sy.Scope);
-    VAR scNs : RTS.NativeString;
-        enNm : RTS.NativeString;
-  BEGIN
-    ASSERT(s.kind = Id.impId);
-    scNs := MKSTR(s(Id.BlkId).xName^);
-    enNm := MKSTR(Sy.getName.ChPtr(t.idnt)^);
-    t.tgXtn := getOrAddValueClass(os.asm(s(Id.BlkId)), scNs, enNm);
-  END MkEnuX;
-
-(* ============================================================ *)
-(*
-  PROCEDURE (os : PeFile)MkTyXtn*(t : Sy.Type; s : Sy.Scope);
-  BEGIN
-    IF t.tgXtn # NIL THEN RETURN END;
-    WITH t : Ty.Record    DO os.MkRecX(t, s);
-    |    t : Ty.Enum      DO os.MkEnuX(t, s);
-    |    t : Ty.Procedure DO os.MkDelX(t, s);
-    |    t : Ty.Base      DO os.MkBasX(t);
-    |    t : Ty.Pointer   DO os.MkPtrX(t);
-    |    t : Ty.Array     DO os.MkArrX(t);
-    END;
-  END MkTyXtn;
- *)
-(* ============================================================ *)
-
-  PROCEDURE MkMthDef(os  : PeFile;
-                     xhr : BOOLEAN;
-                     pTp : Ty.Procedure;
-                     cls : Api.ClassDef;
-                     str : RTS.NativeString)  : Api.MethodDef;
-    VAR par : Id.ParId;
-        prd : Api.Type;
-        prs : POINTER TO ARRAY OF Api.Param;
-        rtT : Sy.Type;
-        rtd : Api.Type;
-        pId : Sy.Idnt;
-
-        idx : INTEGER;       (* index into formal array *)
-        prX : INTEGER;       (* index into param. array *)
-        prO : INTEGER;       (* runtime ordinal of arg. *)
-        num : INTEGER;       (* length of formal array  *)
-        len : INTEGER;       (* length of param array   *)
-  BEGIN
-    pId := pTp.idnt;
-    IF (pId # NIL) & (pId IS Id.MthId) & (Id.covar IN pId(Id.MthId).mthAtt) THEN 
-      rtT := pId(Id.MthId).retTypBound();
-    ELSE
-      rtT := pTp.retType;
-    END;
-    num := pTp.formals.tide;
-    IF xhr THEN len := num + 1 ELSE len := num END;
-    NEW(prs, len);
-    IF rtT = NIL THEN rtd := voidD ELSE rtd := os.typ(rtT) END;
-
-    prO := pTp.argN; (* count from 1 if xhr OR has this *)
-    IF xhr THEN
-      prs[0] := Api.Param.init(0, "", xhrCl); prX := 1;
-    ELSE
-      prX := 0;
-    END;
-    FOR idx := 0 TO num-1 DO
-      par := pTp.formals.a[idx];
-      par.varOrd := prO; 
-      prd := os.typ(par.type);
-      IF Mu.takeAdrs(par) THEN 
-        par.boxOrd := par.parMod;
-        prd := Api.ManagedPointer.init(prd);
-        IF Id.uplevA IN par.locAtt THEN 
-          par.boxOrd := Sy.val;
-          ASSERT(Id.cpVarP IN par.locAtt);
-        END;
-      END; (* just mark *)
-      prs[prX] := Api.Param.init(par.boxOrd, nms(par), prd); 
-      INC(prX); INC(prO);
-    END;
-   (*
-    *  Add attributes, Impl, Meth, CallConv in MethodDecl()
-    *)
-    RETURN cls.AddMethod(str, rtd, prs);
-  END MkMthDef;
-
-(* ============================================================ *)
-
-  PROCEDURE MkMthRef(os  : PeFile;
-                     pTp : Ty.Procedure;
-                     cls : Api.ClassRef;
-                     str : RTS.NativeString) : Api.MethodRef;
-    VAR par : Id.ParId;
-        tpD : Api.Type;
-        prs : POINTER TO ARRAY OF Api.Type;
-        rtT : Sy.Type;
-        rtd : Api.Type;
-        pId : Sy.Idnt;
-
-        idx : INTEGER;       (* index into formal array *)
-        prO : INTEGER;       (* runtime ordinal of arg. *)
-        num : INTEGER;       (* length of formal array  *)
-  BEGIN
-    pId := pTp.idnt;
-    IF (pId # NIL) & (pId IS Id.MthId) & (Id.covar IN pId(Id.MthId).mthAtt) THEN 
-      rtT := pId(Id.MthId).retTypBound();
-    ELSE
-      rtT := pTp.retType;
-    END;
-    num := pTp.formals.tide;
-    NEW(prs, num);
-    IF rtT = NIL THEN rtd := voidD ELSE rtd := os.typ(rtT) END;
-
-    prO := pTp.argN;
-    FOR idx := 0 TO num-1 DO
-      par := pTp.formals.a[idx];
-      tpD := os.typ(par.type);
-      par.varOrd := prO; (* if hasThis, then is (idx+1) *)
-      IF Mu.takeAdrs(par) THEN 
-        par.boxOrd := par.parMod;
-        tpD := Api.ManagedPointer.init(tpD);
-      END; (* just mark *)
-      prs[idx] := tpD; INC(prO);
-    END;
-    RETURN getOrAddMethod(cls, str, rtd, prs);
-  END MkMthRef;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)NumberParams*(pId : Id.Procs; 
-                                       pTp : Ty.Procedure);
-   (*
-    *   (1) Generate signature information for this procedure
-    *   (2) Generate the target extension Method(Def | Ref)
-    *)
-    VAR class : Api.Class;
-        methD : Api.Method;
-        namSt : RTS.NativeString;
-        xhrMk : BOOLEAN;
-        pLeng : INTEGER;
-   (* ----------------- *)
-    PROCEDURE classOf(os : PeFile; id : Id.Procs) : Api.Class;
-      VAR scp : Sy.Scope;
-    BEGIN
-      scp := id.dfScp;
-     (*
-      *  Check for methods bound to explicit classes
-      *)
-      IF id.bndType # NIL THEN RETURN os.cls(id.bndType(Ty.Record)) END;
-     (*
-      *  Or associate static methods with the dummy class
-      *)
-      WITH scp : Id.BlkId DO
-        RETURN os.dsc(scp);
-      | scp : Id.Procs DO (* Nested procs take class from scope *)
-        RETURN classOf(os, scp);
-      END;
-    END classOf;
-   (* ----------------- *)
-  BEGIN
-    IF pId = NIL THEN 
-      os.MkDelX(pTp, pTp.idnt.dfScp); RETURN;       (* PREMATURE RETURN HERE *)
-    END;
-    IF pId.tgXtn # NIL THEN RETURN END;             (* PREMATURE RETURN HERE *)
-
-    class := classOf(os, pId);    
-    namSt := MKSTR(pId.prcNm^);
-    xhrMk := pId.lxDepth > 0;
-   (*
-    *  The incoming argN counts one for a receiver,
-    *  and also counts one for nested procedures.
-    *)
-    IF pId IS Id.MthId THEN pLeng := pTp.argN-1 ELSE pLeng := pTp.argN END;
-   (*
-    *  Now create either a MethodDef or MethodRef
-    *)
-    WITH class : Api.ClassDef DO
-        methD :=  MkMthDef(os, xhrMk, pTp, class, namSt);
-    | class : Api.ClassRef DO
-        methD :=  MkMthRef(os, pTp, class, namSt);
-    END;
-    INC(pTp.argN, pTp.formals.tide);
-    IF pTp.retType # NIL THEN pTp.retN := 1 END;
-    IF (pId.kind = Id.ctorP) OR
-       (pId IS Id.MthId) THEN methD.AddCallConv(Api.CallConv.Instance) END;
-
-    pId.tgXtn := methD;
-    pTp.xName := cln2;  (* an arbitrary "done" marker *)
-
-    IF (pId.kind = Id.fwdPrc) OR (pId.kind = Id.fwdMth) THEN
-      pId.resolve.tgXtn := methD;
-    END;
-  END NumberParams;
- 
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)SwitchHead*(num : INTEGER);
-  BEGIN
-    switch.next := 0;
-    NEW(switch.list, num);
-  END SwitchHead;
-
-  PROCEDURE (os : PeFile)SwitchTail*();
-  BEGIN
-    os.pePI.code.Switch(switch.list);
-    switch.list := NIL;
-  END SwitchTail;
-
-  PROCEDURE (os : PeFile)LstLab*(l : Mu.Label);
-  BEGIN
-    WITH l : PeLab DO
-      switch.list[switch.next] := l.labl; 
-      INC(switch.next);
-    END;
-  END LstLab;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)mth(pId : Id.Procs) : Api.Method,NEW;
-  BEGIN
-    ASSERT(pId.tgXtn # NIL);
-    RETURN pId.tgXtn(Api.Method);
-  END mth;
-
-(* -------------------------------- *)
-
-  PROCEDURE (os : PeFile)fld(fId : Id.AbVar)  : Api.Field,NEW;
-    VAR cDf : Api.Class;
-        fNm : Lv.CharOpen;
-        obj : ANYPTR;
-   (* ---------------- *)
-    PROCEDURE AddField(os : PeFile;
-                       cl : Api.Class; 
-                       fn : Lv.CharOpen; 
-                       ty : Sy.Type) : Api.Field;
-      VAR fs : RTS.NativeString;
-    BEGIN
-      fs := MKSTR(fn^);
-      WITH cl : Api.ClassDef DO
-        RETURN cl.AddField(fs, os.typ(ty));
-      |    cl : Api.ClassRef DO
-        RETURN getOrAddField(cl, fs, os.typ(ty));
-      END;
-    END AddField;
-   (* ---------------- *)
-  BEGIN
-    IF fId.tgXtn = NIL THEN
-      WITH fId : Id.VarId DO
-          IF fId.varNm = NIL THEN Mu.MkVarName(fId,os) END;
-          IF fId.recTyp = NIL THEN (* module variable *)
-            cDf := os.dsc(fId.dfScp(Id.BlkId));
-          ELSE                     (* static field    *)
-            cDf := os.cls(fId.recTyp(Ty.Record));
-          END;
-          fNm := fId.varNm;
-      | fId : Id.FldId DO
-          IF fId.fldNm = NIL THEN Mu.MkFldName(fId,os) END;
-          cDf := os.cls(fId.recTyp(Ty.Record));
-          fNm := fId.fldNm;
-      END;
-      fId.tgXtn := AddField(os, cDf, fNm, fId.type);
-    END;
-    obj := fId.tgXtn;
-    WITH obj : Api.Field DO RETURN obj;
-    |    obj : EvtXtn    DO RETURN obj.fldD;
-    END;
-  END fld;
-
-(* -------------------------------- *)
-
-  PROCEDURE (os : PeFile)add(fId : Id.AbVar) : Api.Method,NEW;
-  BEGIN (* returns the descriptor of add_<fieldname> *)
-    IF (fId.tgXtn = NIL) OR ~(fId.tgXtn IS EvtXtn) THEN MkAddRem(os, fId) END;
-    RETURN fId.tgXtn(EvtXtn).addD;
-  END add;
-
-(* -------------------------------- *)
-
-  PROCEDURE (os : PeFile)rem(fId : Id.AbVar) : Api.Method,NEW;
-  BEGIN (* returns the descriptor of remove_<fieldname> *)
-    IF (fId.tgXtn = NIL) OR ~(fId.tgXtn IS EvtXtn) THEN MkAddRem(os, fId) END;
-    RETURN fId.tgXtn(EvtXtn).remD;
-  END rem;
-
-(* -------------------------------- *)
-
-  PROCEDURE (os : PeFile)asm(bId : Id.BlkId) : Api.AssemblyRef,NEW;
-  BEGIN (* returns the assembly reference of this module *)
-    IF bId.tgXtn = NIL THEN os.DoExtern(bId) END;
-    RETURN bId.tgXtn(BlkXtn).asmD;
-  END asm;
-
-(* -------------------------------- *)
-
-  PROCEDURE (os : PeFile)dsc(bId : Id.BlkId) : Api.Class,NEW;
-  BEGIN (* returns descriptor of dummy static class of this module *)
-    IF bId.tgXtn = NIL THEN os.DoExtern(bId) END;
-    RETURN bId.tgXtn(BlkXtn).dscD;
-  END dsc;
-
-(* -------------------------------- *)
-
-  PROCEDURE (os : PeFile)cls(rTy : Ty.Record) : Api.Class,NEW;
-  BEGIN (* returns descriptor for this class *)
-    IF rTy.tgXtn = NIL THEN Mu.MkRecName(rTy, os) END;
-    RETURN rTy.tgXtn(RecXtn).clsD;
-  END cls;
-
-(* -------------------------------- *)
-(*
- *  PROCEDURE (os : PeFile)box(rTy : Ty.Record) : Api.Class,NEW;
- *  BEGIN
- *    IF rTy.tgXtn = NIL THEN Mu.MkRecName(rTy, os) END;
- *    RETURN rTy.tgXtn(RecXtn).boxD;
- *  END box;
- *)
-(* -------------------------------- *)
-
-  PROCEDURE (os : PeFile)new(rTy : Ty.Record) : Api.Method,NEW;
-  BEGIN (* returns the ctor for this reference class *)
-    IF rTy.tgXtn = NIL THEN Mu.MkRecName(rTy, os) END;
-    RETURN rTy.tgXtn(RecXtn).newD;
-  END new;
-
-(* -------------------------------- *)
-
-  PROCEDURE (os : PeFile)dxt(pTy : Ty.Procedure) : DelXtn,NEW;
-  BEGIN (* returns the DelXtn extension for this delegate type *)
-    IF pTy.tgXtn = NIL THEN os.MkDelX(pTy, pTy.idnt.dfScp) END;
-    RETURN pTy.tgXtn(DelXtn);
-  END dxt;
-
-(* -------------------------------- *)
-
-  PROCEDURE mkCopyDef(cDf : Api.ClassDef; val : BOOLEAN) : Api.Method;
-    VAR pra : POINTER TO ARRAY OF Api.Param;
-        prd : Api.Type;
-  BEGIN
-    NEW(pra, 1);
-    prd := cDf;
-    IF val THEN prd := Api.ManagedPointer.init(prd) END;
-    pra[0] := Api.Param.init(0, "src", prd);
-    RETURN cDf.AddMethod(copyS, voidD, pra);
-  END mkCopyDef;
-
-(* -------------------------------- *)
-
-  PROCEDURE (os : PeFile)cpy(rTy : Ty.Record) : Api.Method,NEW;
-    VAR tXtn : RecXtn;
-        tCls : Api.Class;
-        mthX : Api.Method;
-        typA : POINTER TO ARRAY OF Api.Type;
-        valR : BOOLEAN;
-  BEGIN
-    tXtn := rTy.tgXtn(RecXtn);
-    tCls := tXtn.clsD;
-    IF tXtn.cpyD = NIL THEN
-      valR := Mu.isValRecord(rTy);
-      WITH tCls : Api.ClassDef DO
-          mthX := mkCopyDef(tCls, valR);
-      | tCls : Api.ClassRef DO
-          NEW(typA, 1);
-          IF valR THEN 
-            typA[0] := Api.ManagedPointer.init(tCls);
-          ELSE
-            typA[0] := tCls;
-          END;
-          mthX := tCls.AddMethod(copyS, voidD, typA);
-          mthX.AddCallConv(Api.CallConv.Instance);
-      END;
-      tXtn.cpyD := mthX;
-    ELSE
-      mthX := tXtn.cpyD;
-    END;
-    RETURN mthX;
-  END cpy;
-
-(* -------------------------------- *)
-
-  PROCEDURE (os : PeFile)vDl(rTy : Ty.Record) : Api.Field,NEW;
-  BEGIN (* returns descriptor of field "v$" for this boxed value type *)
-    IF rTy.tgXtn = NIL THEN Mu.MkRecName(rTy, os) END;
-    RETURN rTy.tgXtn(RecXtn).vDlr;
-  END vDl;
-
-(* -------------------------------- *)
-
-  PROCEDURE (os : PeFile)RescueOpaque(tTy : Sy.Type),NEW;
-    VAR blk : Id.BlkId;
-        ext : BlkXtn;
-  BEGIN
-    blk := tTy.idnt.dfScp(Id.BlkId);
-    os.DoExtern(blk);
-    ext := blk.tgXtn(BlkXtn);
-    (* Set tgXtn to a ClassRef *)
-    tTy.tgXtn := getOrAddClass(ext.asmD, MKSTR(blk.xName^), MKSTR(Sy.getName.ChPtr(tTy.idnt)^));
-  RESCUE (any)
-    (* Just leave tgXtn = NIL *)
-  END RescueOpaque;
-
-(* -------------------------------- *)
-
-  PROCEDURE (os : PeFile)typ(tTy : Sy.Type) : Api.Type,NEW;
-    VAR xtn : ANYPTR;
-  BEGIN (* returns Api.Type descriptor for this type *)
-    IF tTy.tgXtn = NIL THEN Mu.MkTypeName(tTy, os) END;
-    IF (tTy IS TypeDesc.Opaque) & (tTy.tgXtn = NIL) THEN os.RescueOpaque(tTy(TypeDesc.Opaque)) END;
-    xtn := tTy.tgXtn;
-    IF xtn = NIL THEN
-      IF tTy.xName # NIL THEN tTy.TypeErrStr(236, tTy.xName);
-      ELSE tTy.TypeError(236);
-      END;
-      RTS.Throw("Opaque Type Error");
-    END;
-    WITH xtn : Api.Type DO
-        RETURN xtn;
-    | xtn : RecXtn DO
-        RETURN xtn.clsD;
-    | xtn : DelXtn DO
-        RETURN xtn.clsD;
-    END;
-  END typ;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)mcd() : Api.ClassRef,NEW;
-  BEGIN (* returns System.MulticastDelegate *)
-    IF multiCD = NIL THEN 
-      multiCD := getOrAddClass(corlib, "System", "MulticastDelegate");
-    END;
-    RETURN multiCD;
-  END mcd;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)del() : Api.ClassRef,NEW;
-  BEGIN (* returns System.Delegate *)
-    IF delegat = NIL THEN 
-      delegat := getOrAddClass(corlib, "System", "Delegate");
-    END;
-    RETURN delegat;
-  END del;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)rmv() : Api.MethodRef,NEW;
-    VAR prs : POINTER TO ARRAY OF Api.Type;
-        dlg : Api.ClassRef;
-  BEGIN (* returns System.Delegate::Remove *)
-    IF remove = NIL THEN 
-      dlg := os.del();
-      NEW(prs, 2);
-      prs[0] := dlg; 
-      prs[1] := dlg;
-      remove := dlg.AddMethod("Remove", dlg, prs);
-    END;
-    RETURN remove;
-  END rmv;
-
-(* ============================================================ *)
-
-  PROCEDURE (os : PeFile)cmb() : Api.MethodRef,NEW;
-    VAR prs : POINTER TO ARRAY OF Api.Type;
-        dlg : Api.ClassRef;
-  BEGIN (* returns System.Delegate::Combine *)
-    IF combine = NIL THEN 
-      dlg := os.del();
-      NEW(prs, 2);
-      prs[0] := dlg; 
-      prs[1] := dlg;
-      combine := dlg.AddMethod("Combine", dlg, prs);
-    END;
-    RETURN combine;
-  END cmb;
-
-(* ============================================================ *)
-(* ============================================================ *)
-BEGIN
-  evtAdd   := Lv.strToCharOpen("add_"); 
-  evtRem   := Lv.strToCharOpen("remove_"); 
-  cln2     := Lv.strToCharOpen("::"); 
-  boxedObj := Lv.strToCharOpen("Boxed_"); 
-
-  vfldS  := MKSTR("v$");
-  ctorS  := MKSTR(".ctor");
-  invkS  := MKSTR("Invoke");
-  copyS  := MKSTR("__copy__");
-END PeUtil.
-(* ============================================================ *)
-(* ============================================================ *)
-

gpcp/Symbols.cp

@@ -325,6 +325,11 @@ MODULE Symbols;
   PROCEDURE (s : Idnt)isLocalVar*() : BOOLEAN,NEW,EXTENSIBLE;
   BEGIN RETURN FALSE END isLocalVar;
 
+(* -------------------------------------------- *)
+
+  PROCEDURE (s : Idnt)isNeeded*() : BOOLEAN,NEW,EXTENSIBLE;
+  BEGIN RETURN FALSE END isNeeded;
+
 (* -------------------------------------------- *)
 
   PROCEDURE (s : Idnt)isWeak*() : BOOLEAN,NEW,EXTENSIBLE;
@@ -1254,6 +1259,39 @@ MODULE Symbols;
 (*      Public static methods on symbol-tables                  *)
 (* ============================================================ *)
 
+  PROCEDURE trackedRefused*(id : Idnt; scp : Scope) : BOOLEAN;
+    VAR fail  : BOOLEAN;
+        clash : Idnt;
+  BEGIN
+    fail := ~scp.symTb.enter(id.hash, id);
+    IF fail THEN
+      Console.WriteString("Trial insert of ");
+      Console.WriteString(NameHash.charOpenOfHash(id.hash));
+      Console.Write('{');
+      IF id.isWeak() THEN Console.WriteString("weak,") END;
+      IF id.isNeeded() THEN Console.WriteString("need,") END;
+      Console.Write('}');
+      Console.WriteString(" clashes in scope ");
+      Console.WriteString(NameHash.charOpenOfHash(scp.hash));
+      Console.WriteLn;
+
+      clash := scp.symTb.lookup(id.hash);
+      IF clash.isImport() & clash.isWeak() THEN
+
+        Console.WriteString("Existing symTab entry is ");
+        Console.WriteString(NameHash.charOpenOfHash(clash.hash));
+        Console.Write('{');
+        IF clash.isWeak() THEN Console.WriteString("weak,") END;
+        IF clash.isNeeded() THEN Console.WriteString("need,") END;
+        Console.Write('}');
+        Console.WriteLn;
+
+        scp.symTb.Overwrite(id.hash, id); fail := FALSE;
+      END;
+    END;
+    RETURN fail;
+  END trackedRefused;
+
   PROCEDURE refused*(id : Idnt; scp : Scope) : BOOLEAN;
     VAR fail  : BOOLEAN;
         clash : Idnt;

gpcp/TypeDesc.cp

@@ -267,6 +267,26 @@ MODULE TypeDesc;
                    bndRec- : Record;
                  END;
 
+(* ============================================================ *)
+
+  PROCEDURE kindStr*(t : Sy.Type) : Lv.CharOpen;
+  BEGIN
+    CASE t.kind OF
+    | basTp : RETURN BOX("basTp");
+    | tmpTp : RETURN BOX("tmpTp");
+    | namTp : RETURN BOX("namTp");
+    | arrTp : RETURN BOX("arrTp");
+    | recTp : RETURN BOX("recTp");
+    | ptrTp : RETURN BOX("ptrTp");
+    | prcTp : RETURN BOX("prcTp");
+    | enuTp : RETURN BOX("enuTp");
+    | evtTp : RETURN BOX("evtTp");
+    | ovlTp : RETURN BOX("ovlTp");
+    | vecTp : RETURN BOX("vecTp");
+    ELSE      RETURN BOX("?typ?");
+    END;
+  END kindStr;
+
 (* ============================================================ *)
 (*               Predicates on Type extensions                  *)
 (* ============================================================ *)
@@ -1103,6 +1123,14 @@ MODULE TypeDesc;
       ty.TypeErrStr^(n,s);
     END;
   END TypeErrStr;
+(* -------------------------------------------- *)
+
+  PROCEDURE (ty : Record)TypeErrSS*(n : INTEGER;
+          IN s1 : ARRAY OF CHAR;
+          IN s2 : ARRAY OF CHAR),NEW;
+  BEGIN
+    S.SemError.RepSt2(n, s1, s2, S.line, S.col);
+  END TypeErrSS;
 
 (* ============================================================ *)
 (*      Constructor methods     *)
@@ -1505,6 +1533,9 @@ MODULE TypeDesc;
       *  do not find it, the type just stays opaque.
       *)
       i.depth := finishMark;
+	  IF (i.idnt # NIL) & (i.idnt.namStr = NIL) THEN
+	    i.idnt.SetNameFromHash(i.idnt.hash);
+	  END;
       oldTpId := i.idnt;
       newTpId := oldTpId.dfScp.symTb.lookup(oldTpId.hash);
       IF newTpId = NIL THEN
@@ -1642,7 +1673,6 @@ MODULE TypeDesc;
    (* ----------------------------------------- *)
   BEGIN (* resolve *)
     IF i.depth = initialMark THEN
-
 	  IF CSt.verbose THEN
   	    IF i.idnt # NIL THEN
 	      ntvNm := Sy.getName.NtStr(i.idnt);
@@ -1711,8 +1741,15 @@ MODULE TypeDesc;
           ELSE
             i.TypeError(16);  (* base type is not an extensible record   *)
           END;
-          IF (iFace = i.recAtt) &
-             ~baseT.isNativeObj() THEN i.TypeError(156) END;
+(* --- Checks for interface records --- *)
+          (*
+           *  There is a problem here when cross-compiling.
+           *  When cross-compiling the relevant native object
+           *  is NOT the native object type of the host.
+           *)
+          IF (iFace = i.recAtt) & ~baseT.isNativeObj() THEN 
+            i.TypeErrSS(156, i.name(), baseT.name());
+          END;
          (*
           *  Propagate no-block-copy attribute to extensions.
           *  Note the special case here: in .NET extensions 

gpcp/build.xml

@@ -37,7 +37,6 @@
     <target name="-buildgpcp" depends="init" description="Compile gpcp compiler sources"> 
 	    <!-- Ensure that we have the JVM-specific source variants -->
 	    <copy file="JavaTargetForJVM.cp" tofile="JavaTarget.cp" overwrite="true"/>
-	    <copy file="PeUtilForJVM.cp" tofile="PeUtil.cp" overwrite="true"/>
 	    <!-- Compile all the source files of gpcp in dependency order -->
 	    <java jar="${JRoot}/jars/cpmake.jar" failonerror="true" fork="true" dir=".">
                 <jvmarg value="-DCPSYM=${CPSYM}"/>

gpcp/csharp/MsilAsm.cs

@@ -15,20 +15,14 @@
 //  BEGIN END Assemble;
 //
 //END MsilAsm.
-// 
-// 
-//  NOTE: this needs (as at 13-Jun-2000) to be compiled using
-//
-//  $ csc /t:library /r:System.Diagnostics.dll /r:RTS.dll MsilAsm.cs
 //
-//  NOTE: for Beta2 this finds System.Diagnostics in mscorlib.dll
+// Compile with :
 //
-//  $ csc /t:library /r:RTS.dll MsilAsm.cs
+//  $ csc /t:library /debug MsilAsm.cs
 // 
-#if !BETA1
-  #define BETA2
-#endif
 
+using System;
+using System.Text;
 using System.Diagnostics;
 
 namespace MsilAsm {
@@ -42,83 +36,86 @@ public class MsilAsm {
     {
         // Get the path to mscorlib.dll
         string s = typeof(object).Module.FullyQualifiedName;
-
         // Remove the file part to get the directory
-        return System.IO.Directory.GetParent(s).ToString() + "\\";
+        return System.IO.Directory.GetParent(s).ToString();
     }
 
-    public static void Init() {
-	if (asm == null) {
-	    asm = new Process();
-	    asm.StartInfo.FileName = GetDotNetRuntimeInstallDirectory() + "ilasm";
-#if BETA1
-	    asm.StartInfo.WindowStyle = ProcessWindowStyle.Minimized;
-#else //BETA2
-	    asm.StartInfo.CreateNoWindow = true;
-	    asm.StartInfo.UseShellExecute = false;
-#endif
-	}
-    }
+        public static void Init() {
+            if (asm == null) {
+                asm = new Process();
+                System.String frameworkDir = GetDotNetRuntimeInstallDirectory();
+                //System.String frameworkDir = Environment.GetEnvironmentVariable("NET40", EnvironmentVariableTarget.User);
+                asm.StartInfo.FileName = frameworkDir + "\\" + "ilasm";
+                asm.StartInfo.CreateNoWindow = true;
+                asm.StartInfo.UseShellExecute = false;
+            }
+        }
+
+        private static int CPlen(char[] arr) {
+            int len = arr.Length;
+            for (int ix = 0; ix < len; ix++)
+                if (arr[ix] == '\0')
+                    return ix;
+            return len;
+        }
+
+        public static void Assemble(char[] fil, char[] opt, bool hasMain) {
+            int retCode;
+            System.String optNm;
+            System.String suffx;
+            System.String fName = new String(fil, 0, CPlen(fil));
+            if (hasMain) {
+                optNm = "/exe ";
+                suffx = ".exe";
+            }
+            else {
+                optNm = "/dll ";
+                suffx = ".dll";
+            }
+            optNm = optNm + new String(opt, 0, CPlen(opt)) + ' ';
+            asm.StartInfo.Arguments = optNm + "/nologo /quiet " + fName + ".il";
+            asm.Start();
+            asm.WaitForExit();
+            retCode = asm.ExitCode;
+            if (retCode != 0)
+                System.Console.WriteLine("#gpcp: ilasm FAILED " + retCode);
+            else
+                System.Console.WriteLine("#gpcp: created " + fName + suffx);
+        }
+
+        public static void DoAsm(char[] fil, char[] opt,
+                    bool hasMain,
+                    bool verbose,
+                    ref int rslt) {
+            System.String optNm;
+            System.String suffx;
+            System.String fName = new String(fil, 0, CPlen(fil));
+
+            if (hasMain) {
+                optNm = "/exe ";
+                suffx = ".exe";
+            }
+            else {
+                optNm = "/dll ";
+                suffx = ".dll";
+            }
+            optNm = optNm + new String(opt, 0, CPlen(opt)) + ' ';
+            if (verbose) {
+                asm.StartInfo.Arguments = optNm + "/nologo " + fName + ".il";
+                System.Console.WriteLine("#gpcp: Calling " + asm.StartInfo.FileName + ' ' + asm.StartInfo.Arguments);
+            }
+            else {
+                asm.StartInfo.Arguments = optNm + "/nologo /quiet " + fName + ".il";
+            }
+            asm.Start();
+            asm.WaitForExit();
+            rslt = asm.ExitCode;
+            if (rslt == 0)
+                System.Console.WriteLine("#gpcp: Created " + fName + suffx);
+        }
 
-    public static void Assemble(char[] fil, char[] opt, bool hasMain) {
-	int retCode;
-	System.String optNm;
-	System.String suffx;
-	System.String fName = CP_rts.mkStr(fil);
-	if (hasMain) {
-	    optNm ="/exe ";
-	    suffx = ".exe";
-	} else {
-	    optNm = "/dll ";
-	    suffx = ".dll";
-	}
-	optNm = optNm + CP_rts.mkStr(opt) + ' ';
-	asm.StartInfo.Arguments = optNm + "/nologo /quiet " + fName + ".il";
-	asm.Start();
-	asm.WaitForExit();
-	retCode = asm.ExitCode;
-	if (retCode != 0)
-	    System.Console.WriteLine("#gpcp: ilasm FAILED " + retCode);
-	else
-	    System.Console.WriteLine("#gpcp: created " + fName + suffx);
-    }
-    
-    public static void DoAsm(char[] fil, char[] opt, 
-				bool hasMain, 
-				bool verbose, 
-				ref int rslt) {
-	System.String optNm;
-	System.String suffx;
-	System.String fName = CP_rts.mkStr(fil);
-	if (hasMain) {
-	    optNm ="/exe ";
-	    suffx = ".exe";
-	} else {
-	    optNm = "/dll ";
-	    suffx = ".dll";
-	}
-	optNm = optNm + CP_rts.mkStr(opt) + ' ';
-	if (verbose) {
-	    System.Console.WriteLine("#gpcp: Calling " + asm.StartInfo.FileName);
-#if BETA2
-	    asm.StartInfo.CreateNoWindow = false;
-#endif
-	    asm.StartInfo.Arguments = optNm + "/nologo " + fName + ".il";
-	} else {
-#if BETA2
-	    asm.StartInfo.CreateNoWindow = true;
-#endif
-	    asm.StartInfo.Arguments = optNm + "/nologo /quiet " + fName + ".il";
-	}
-	asm.Start();
-	asm.WaitForExit();
-	rslt = asm.ExitCode;
-	if (rslt == 0)
-	    System.Console.WriteLine("#gpcp: Created " + fName + suffx);
-    }
 
-    
-    public static void Assemble(char[] fil, bool hasMain) {
+        public static void Assemble(char[] fil, bool hasMain) {
         char[] opt = {'/', 'd', 'e', 'b', 'u', 'g', '\0' };
         Assemble(fil, opt, hasMain);
     }

gpcp/gpcp.cp

@@ -31,6 +31,7 @@ MODULE gpcp;
 
 BEGIN
   filN := 0;
+  ProgArgs.ExpandWildcards(0);
   FOR parN := 0 TO ProgArgs.ArgNumber()-1 DO
     ProgArgs.GetArg(parN, argN);
     chr0 := argN[0];

gpcp/java/MsilAsm.java

@@ -4,7 +4,7 @@
 // (*	Modifications:						*)
 // (*		Version for GPCP V0.3 April 2000 (kjg)		*)
 // (* ========================================================= *)
-// (*	The real code is in MsilAsm.cool			*)	
+// (*	The real code is in MsilAsm.cs or MsilAsm.java          *)
 // (* ========================================================= *)
 //
 //MODULE MsilAsm;
@@ -21,23 +21,102 @@
 //
 //END MsilAsm.
 // 
+//  NOTES:
+//    This code assumes that ilasm.exe is visible on the path.
+//    If the DoAsm call fails with a "cannot find ilasm" error
+//    then you will have to locate it in the file system.
+//    The program exists if you have the .NET JDK (instead of
+//    just the runtime), or if you have any recent Visual Studio
+//    releases. 
+//    On Windows try searching C:\Windows\Microsoft.NET\Framework
+//    and choose the latest version if there are several.
+//    My ilasm.exe is in directory -
+//        C:\WINDOWS\Microsoft.NET\Framework\v4.0.30319
+//
 package CP.MsilAsm;
 
 public class MsilAsm {
 
     public static void Init() {
-//	if (main == null) 
-//	    main = new jasmin.Main();
+	    // empty
     }
 
-    public static void Assemble(char[] fil, char[] opt, boolean main) {
+    /**
+     *  Copies the characters from the stream 
+     *  <code>strm</code> to System.out, with every 
+     *  line prefixed by the string "#ilasm".
+     *  @throws IOException
+     */
+    static void CopyStream(java.io.InputStream strm) 
+	    throws java.io.IOException {
+        int chr;
+        String prefix = "#ilasm: ";
+        System.out.print(prefix);
+        while ((chr = strm.read()) != -1) {
+            System.out.print((char)chr);
+            if (chr == (int)'\n')
+                System.out.print(prefix);
+        }
+        System.out.println();
     }
 
-    public static int DoAsm(char[] fil, char[] opt, 
-				boolean main, boolean vrbs) {
-//	String fName = CP.CPJ.CPJ.MkStr(fil);
-//	main.assemble(null, fName, false);
-        return 0;
+    public static void Assemble(char[] fil, 
+                                char[] opt, 
+                                boolean main) {
+	    // empty
     }
 
+    public static int DoAsm(char[] fil,   // Command name 
+                            char[] opt,   // Options, usually /debug
+                            boolean main, // true ==> EXE, else DLL
+                            boolean vrbs) // true ==> -verbose flag set
+    {
+        int rslt = 0;
+        java.util.ArrayList<String> cmdList = new java.util.ArrayList<String>();
+	//
+	// Arg[0] is the command name
+	//
+        cmdList.add("ilasm");
+        cmdList.add(vrbs ? "/nologo" : "/quiet");
+        cmdList.add(main ? "/exe" : "/dll");
+	//
+	//  Now the rest of the user-supplied args
+	//
+        String[] args = new String(opt).trim().split(" ");
+        for (int i = 0; i < args.length; i++)
+            if (args[i].length() > 0)
+                cmdList.add(args[i]);
+        //
+	// Now add the IL source file name
+	//
+        String fName = new String(fil).trim();
+        cmdList.add(fName + ".il");
+
+        String sffx = (main ? ".exe" : ".dll");
+        // 
+        if (vrbs) {
+            System.out.print("#gpcp: MsilAsm spawning -\n       ");
+            for (int i = 0; i < cmdList.size(); i++)
+                 System.out.print(cmdList.get(i) + " ");
+            System.out.println();
+        }
+        //
+        try {
+            Process proc = 
+                new ProcessBuilder(cmdList).redirectErrorStream(true).start();
+	    // Write output of process to System.out
+            CopyStream(proc.getInputStream());
+	    // wait for process to exit.
+            rslt = proc.waitFor();
+        }
+        catch (Exception exc) {
+            rslt = 2;
+        }
+        if (rslt == 0)
+	    System.out.println("#gpcp: Created " + fName + (main ? ".exe" : ".dll"));
+        else
+	    System.out.println("#gpcp: ILASM FAILED");
+        return rslt;
+    }
 }
+

gpcp/n2state.cp

@@ -35,7 +35,8 @@ MODULE N2State;
 
   CONST prefix = "PeToCps: ";
         abtMsg = " ... Aborting";
-        usgMsg = 'Usage: "PeToCps [options] filenames"';
+        usgMsg1 = 'Usage: "PeToCps /mscorlib [options]"';
+        usgMsg2 = '       "PeToCps [options] filenames"';
 
  (* ---------------------------------------------------------- *)
 
@@ -52,7 +53,6 @@ MODULE N2State;
         Verbose-  : BOOLEAN;
         superVb-  : BOOLEAN;
         generics- : BOOLEAN;
-        legacy-   : BOOLEAN;
         cpCmpld-  : BOOLEAN;
 
  (* ---------------------------------------------------------- *)
@@ -64,9 +64,11 @@ MODULE N2State;
         initBkt-  : INTEGER;
         srcNam-   : CharOpen;
         basNam-   : CharOpen;
-        impSeq*   : Sy.ScpSeq;
+        impSeq*   : Sy.ScpSeq;   (* All the scopes known to this PE file *)
         typSeq-   : Sy.TypeSeq;
 
+       ignoreBlk* : Id.BlkId; (* symTb for generic classes *)
+
  (* ---------------------------------------------------------- *)
 
   PROCEDURE^ AbortMsg*(IN str : ARRAY OF CHAR);
@@ -94,11 +96,11 @@ MODULE N2State;
     Nh.InitNameHash(hashSize);
     srcNam := BOX(src$);
     basNam := BOX(bas$);
-    isCorLib := (bas = "mscorlib");
-
     CompState.CreateThisMod;
     thisMod := CompState.thisMod;
 
+    NEW(ignoreBlk);
+
     Sy.ResetScpSeq(impSeq);
     ctorBkt := Nh.enterStr(".ctor");
     initBkt := Nh.enterStr("init");
@@ -113,7 +115,8 @@ MODULE N2State;
     IF Sy.refused(blk, thisMod) THEN 
       AbortMsg("BlkId insert failure -- " + Nh.charOpenOfHash(blk.hash)^);
     END;
-    Sy.AppendScope(impSeq, blk)
+	(* Append this BlkId to the global import sequence *)
+    Sy.AppendScope(impSeq, blk); 
   END BlkIdInit;
 
  (* ------------------------------------- *)
@@ -163,6 +166,7 @@ MODULE N2State;
       impB := impSeq.a[indx];
       IF impB # mod THEN
         impB.SetKind(Id.impId);
+		impB(Id.BlkId).impOrd := 0;
       END;
     END;
   END ResetBlkIdFlags;
@@ -186,6 +190,11 @@ MODULE N2State;
     IF verbose THEN Message(str) END;
   END CondMsg;
 
+  PROCEDURE VerbMsg*(IN str : ARRAY OF CHAR);
+  BEGIN
+    IF Verbose THEN Message(str) END;
+  END VerbMsg;
+
   PROCEDURE AbortMsg*(IN str : ARRAY OF CHAR);
   BEGIN
     Error.WriteString(prefix);
@@ -196,22 +205,19 @@ MODULE N2State;
     
   PROCEDURE Usage();
   BEGIN
-    Message(usgMsg); 
+    Message(usgMsg1); 
+    Message(usgMsg2); 
     Message("filenames should have explicit .EXE or .DLL extension"); 
     IF netDflt THEN
       WLn("Options: /big       ==> allocate huge hash table");
       WLn("         /copyright ==> display copyright notice");
-      WLn("         /generics  ==> enable CLI v2.0 generics");
       WLn("         /help      ==> display this message");
-      WLn("         /legacy    ==> produce compatible symbol file");
       WLn("         /verbose   ==> chatter on about progress"); 
       WLn("         /Verbose   ==> go on and on and on about progress"); 
     ELSE
       WLn("Options: -big       ==> allocate huge hash table");
       WLn("         -copyright ==> display copyright notice");
-      WLn("         -generics  ==> enable CLI v2.0 generics");
       WLn("         -help      ==> display this message");
-      WLn("         -legacy    ==> produce compatible symbol file");
       WLn("         -verbose   ==> chatter on about progress"); 
       WLn("         -Verbose   ==> go on and on and on about progress"); 
     END;
@@ -269,7 +275,10 @@ MODULE N2State;
 
   PROCEDURE ParseOption*(IN arg : ARRAY OF CHAR);
   BEGIN
-    IF    arg = "-big" THEN
+    IF    arg = "-mscorlib" THEN
+	    isCorLib := TRUE;
+		hashSize := 40000; (* for sure, mscorlib *needs* /big *)
+    ELSIF arg = "-big" THEN
         hashSize := 40000;
     ELSIF arg = "-verbose" THEN
         verbose := TRUE;
@@ -279,11 +288,10 @@ MODULE N2State;
         verbose := TRUE;
         Verbose := TRUE;
         superVb := FALSE;
-    ELSIF arg = "-generics" THEN
-        generics := TRUE;
-    ELSIF arg = "-legacy" THEN
-        legacy := TRUE;
-        CompState.legacy := TRUE;
+   (*
+    * ELSIF arg = "-generics" THEN
+    *    generics := TRUE;
+	*)
     ELSIF arg = "-VERBOSE" THEN
         verbose := TRUE;
         Verbose := TRUE;
@@ -315,7 +323,6 @@ BEGIN
   verbose  := FALSE;
   Verbose  := FALSE;
   superVb  := FALSE;
-  legacy   := FALSE;
   cpCmpld  := FALSE; (* pending the custom attribute *)
   hashSize := 5000;
   Sy.InitScpSeq(impSeq, 10);

libs/cpascal/GPFiles.cp

@@ -16,4 +16,9 @@ PROCEDURE CurrentDirectory*(): FileNameArray;
 
 PROCEDURE exists*(fName : ARRAY OF CHAR) : BOOLEAN;
 
+PROCEDURE FileList*(IN dirPath : ARRAY OF CHAR) : 
+              POINTER TO ARRAY OF FileNameArray;
+
 END GPFiles.
+
+

libs/cpascal/MakeAll.bat → libs/cpascal/MakeAllCLR.bat

@@ -1,26 +1,26 @@
-gpcp /special ASCII.cp
-gpcp /special Console.cp
-gpcp /special CPmain.cp
-gpcp /special Error.cp
-gpcp /special GPBinFiles.cp
-gpcp /special GPFiles.cp
-gpcp /special GPTextFiles.cp
-gpcp /special ProgArgs.cp
-gpcp /special RTS.cp
-gpcp /special StdIn.cp
-gpcp /special WinMain.cp
-gpcp /special STA.cp
-gpcp RealStr.cp
-gpcp StringLib.cp
-Browse /html /sort ASCII.cps
-Browse /html /sort Console.cps
-Browse /html /sort Error.cps
-Browse /html /sort GPFiles.cps
-Browse /html /sort GPBinFiles.cps
-Browse /html /sort GPTextFiles.cps
-Browse /html /sort ProgArgs.cps
-Browse /html /sort RTS.cps
-Browse /html /sort StdIn.cps
-Browse /html /sort RealStr.cps
-Browse /html /sort StringLib.cps
-
+gpcp /special ASCII.cp
+gpcp /special Console.cp
+gpcp /special CPmain.cp
+gpcp /special Error.cp
+gpcp /special GPBinFiles.cp
+gpcp /special GPFiles.cp
+gpcp /special GPTextFiles.cp
+gpcp /special ProgArgs.cp
+gpcp /special RTS.cp
+gpcp /special StdIn.cp
+gpcp /special WinMain.cp
+gpcp /special STA.cp
+gpcp RealStr.cp
+gpcp StringLib.cp
+Browse /html /sort ASCII.cps
+Browse /html /sort Console.cps
+Browse /html /sort Error.cps
+Browse /html /sort GPFiles.cps
+Browse /html /sort GPBinFiles.cps
+Browse /html /sort GPTextFiles.cps
+Browse /html /sort ProgArgs.cps
+Browse /html /sort RTS.cps
+Browse /html /sort StdIn.cps
+Browse /html /sort RealStr.cps
+Browse /html /sort StringLib.cps
+

libs/cpascal/JvmMakeAll.bat → libs/cpascal/MakeAllJVM.bat

@@ -1,25 +1,25 @@
-
-call cprun gpcp -special ASCII.cp
-call cprun gpcp -special Console.cp
-call cprun gpcp -special CPmain.cp
-call cprun gpcp -special Error.cp
-call cprun gpcp -special GPBinFiles.cp
-call cprun gpcp -special GPFiles.cp
-call cprun gpcp -special GPTextFiles.cp
-call cprun gpcp -special ProgArgs.cp
-call cprun gpcp -special RTS.cp
-call cprun gpcp -special StdIn.cp
-call cprun gpcp RealStr.cp
-call cprun gpcp StringLib.cp
-call cprun Browse -html -sort ASCII.cps
-call cprun Browse -html -sort Console.cps
-call cprun Browse -html -sort Error.cps
-call cprun Browse -html -sort GPFiles.cps
-call cprun Browse -html -sort GPBinFiles.cps
-call cprun Browse -html -sort GPTextFiles.cps
-call cprun Browse -html -sort ProgArgs.cps
-call cprun Browse -html -sort RTS.cps
-call cprun Browse -html -sort StdIn.cps
-call cprun Browse -html -sort RealStr.cps
-call cprun Browse -html -sort StringLib.cps
-
+
+call cprun gpcp -special ASCII.cp
+call cprun gpcp -special Console.cp
+call cprun gpcp -special CPmain.cp
+call cprun gpcp -special Error.cp
+call cprun gpcp -special GPBinFiles.cp
+call cprun gpcp -special GPFiles.cp
+call cprun gpcp -special GPTextFiles.cp
+call cprun gpcp -special ProgArgs.cp
+call cprun gpcp -special RTS.cp
+call cprun gpcp -special StdIn.cp
+call cprun gpcp RealStr.cp
+call cprun gpcp StringLib.cp
+call cprun Browse -html -sort ASCII.cps
+call cprun Browse -html -sort Console.cps
+call cprun Browse -html -sort Error.cps
+call cprun Browse -html -sort GPFiles.cps
+call cprun Browse -html -sort GPBinFiles.cps
+call cprun Browse -html -sort GPTextFiles.cps
+call cprun Browse -html -sort ProgArgs.cps
+call cprun Browse -html -sort RTS.cps
+call cprun Browse -html -sort StdIn.cps
+call cprun Browse -html -sort RealStr.cps
+call cprun Browse -html -sort StringLib.cps
+

libs/cpascal/ProgArgs.cp

@@ -18,4 +18,6 @@ SYSTEM MODULE ProgArgs;
 
   PROCEDURE GetEnvVar*(IN name : ARRAY OF CHAR; OUT valu : ARRAY OF CHAR); 
 
+  PROCEDURE ExpandWildcards*(argsToSkip : INTEGER);
+
 END ProgArgs.

libs/csharp/GPFiles.cs

@@ -19,11 +19,18 @@ public abstract class GPFiles {
     int  ix = 0;
     char ch;
     do {
-	ch = arr[ix]; ix++;
+	  ch = arr[ix]; ix++;
     } while (ch != '\0');
     return new System.String(arr,0,ix-1);
   }
 
+  private static char[] mkArr(System.String str) {
+    char[] rslt = new char[str.Length + 1];
+    str.CopyTo(0, rslt, 0, str.Length);
+    rslt[str.Length] = '\0';
+    return rslt;
+  }
+
   /* ----------------------------------	*/
 
   public static bool isOlder(FILE first, FILE second) {
@@ -40,7 +47,7 @@ public abstract class GPFiles {
     }
 
   public static char[] CurrentDirectory() {
-        return System.IO.Directory.GetCurrentDirectory().ToCharArray();
+        return mkArr(System.IO.Directory.GetCurrentDirectory());
   }
   
   public static bool exists(char[] filName) {
@@ -48,6 +55,17 @@ public abstract class GPFiles {
 	return System.IO.File.Exists(path);
     }
 
+   public static char[][] FileList(char[] dirPath) {
+       string dirStr = mkStr(dirPath);
+       string[] files = System.IO.Directory.GetFiles(dirStr);
+       if (files == null || files.Length ==0) return null;
+       else {
+           char[][] rslt = new char[files.Length][];
+           for (int i = 0; i < files.Length; i++)
+               rslt[i] = mkArr(System.IO.Path.GetFileName(files[i]));
+	   return rslt;
+       }
+   } 
   } // end of class GPFiles
 
 /* ------------------------------------------------------------ */

libs/csharp/MakeAll.bat

@@ -2,3 +2,4 @@ csc /t:library /debug RTS.cs
 csc /t:library /debug GPFiles.cs
 csc /t:library /debug /r:GPFiles.dll GPBinFiles.cs
 csc /t:library /debug /r:GPFiles.dll GPTextFiles.cs
+

libs/csharp/PeToCpsUtils.cs

@@ -0,0 +1,24 @@
+
+using System;
+using System.IO;
+using System.Collections;
+using System.Collections.Generic;
+using System.Reflection;
+
+namespace PeToCpsUtils
+{
+    // This has to be wrapped, as the CLR v2 CPS file has it as an 
+    // instance method. Since 4.0 it is virtual and MUST be called with callvirt
+    //
+	public class Utils {
+		public static AssemblyName[] GetDependencies(Assembly asm) {
+            return asm.GetReferencedAssemblies();
+		}
+
+        public static String typName(System.Type typ) {
+            return typ.Name;
+        }
+	}
+}
+
+

libs/csharp/RTS.cs

@@ -6,9 +6,9 @@
  *  Merged version for N2CPS, gpcp etc.  SYChan, KJGough. 19-Aug-2001.
  */
 
-#if !BETA1
-  #define BETA2
-#endif
+using System;
+using System.IO;
+using System.Collections.Generic;
 
 public class RTS
 // Known in ILASM as [RTS]RTS
@@ -24,33 +24,33 @@ public class RTS
 /* ------------------------------------------------------------ */
 
   public static char[] defaultTarget = {'n','e','t','\0'};
-  public static char[] eol = NativeStrings.mkArr(System.Environment.NewLine);
+  public static char[] eol = NativeStrings.mkArr(Environment.NewLine);
 
-  public static double dblPosInfinity = System.Double.PositiveInfinity;
-  public static double dblNegInfinity = System.Double.NegativeInfinity;
-  public static float  fltPosInfinity = System.Single.PositiveInfinity;
-  public static float  fltNegInfinity = System.Single.NegativeInfinity;
+  public static double dblPosInfinity = Double.PositiveInfinity;
+  public static double dblNegInfinity = Double.NegativeInfinity;
+  public static float  fltPosInfinity = Single.PositiveInfinity;
+  public static float  fltNegInfinity = Single.NegativeInfinity;
 
   private static char[] ChrNaN    = {'N','a','N','\0'};
   private static char[] ChrPosInf = {'I','n','f','i','n','i','t','y','\0'};
   private static char[] ChrNegInf = {'-','I','n','f','i','n','i','t','y','\0'};
-  private static System.String StrNaN    = new System.String(ChrNaN); 
-  private static System.String StrPosInf = new System.String(ChrPosInf);
-  private static System.String StrNegInf = new System.String(ChrNegInf);
+  private static String StrNaN    = new String(ChrNaN); 
+  private static String StrPosInf = new String(ChrPosInf);
+  private static String StrNegInf = new String(ChrNegInf);
 
-  private static System.Type typDouble = System.Type.GetType("System.Double");
-  private static System.Type typSingle = System.Type.GetType("System.Single");
+  private static Type typDouble = Type.GetType("System.Double");
+  private static Type typSingle = Type.GetType("System.Single");
 
-  private static System.IFormatProvider invarCulture = 
-             (System.IFormatProvider) new System.Globalization.CultureInfo("");
-  private static System.IFormatProvider currentCulture = 
-      (System.IFormatProvider) System.Globalization.CultureInfo.CurrentCulture;
+  private static IFormatProvider invarCulture = 
+             (IFormatProvider) new System.Globalization.CultureInfo("");
+  private static IFormatProvider currentCulture = 
+      (IFormatProvider) System.Globalization.CultureInfo.CurrentCulture;
 
 /* -------------------------------------------------------------------- */
 //  PROCEDURE getStr*(x : NativeException) : RTS.CharOpen; END getStr;
 //
     	// Known in ILASM as [RTS]RTS::getStr
-	public static char[] getStr(System.Exception inp)
+	public static char[] getStr(Exception inp)
 	{
 	    return CP_rts.strToChO(inp.ToString());
 	}
@@ -65,9 +65,9 @@ public class RTS
 				     out bool  o, 	// OUT param
 				     out bool  r)	// OUT param
 	{
-	    System.String bstr = new System.String(str);
+	    String bstr = new String(str);
 	    try {
-		o = System.Boolean.Parse(bstr);
+		o = Boolean.Parse(bstr);
 		r = true;
 	    } catch {
 		o = false;
@@ -79,7 +79,7 @@ public class RTS
 //   PROCEDURE TypeName(typ : NativeType) : CharOpen
 //  (* Get the name of the argument type *)
 //
-    public static char[] TypeName(System.Type t) { 
+    public static char[] TypeName(Type t) { 
       return NativeStrings.mkArr(t.FullName);
     }
 
@@ -105,9 +105,9 @@ public class RTS
 				     out sbyte  o, 	// OUT param
 				     out bool  r)	// OUT param
 	{
-	    System.String bstr = new System.String(str);
+	    String bstr = new String(str);
 	    try {
-		o = System.SByte.Parse(bstr);
+		o = SByte.Parse(bstr);
 		r = true;
 	    } catch {
 		o = 0;
@@ -125,9 +125,9 @@ public class RTS
 				     out sbyte  o, 	// OUT param
 				     out bool  r)	// OUT param
 	{
-	    System.String bstr = new System.String(str);
+	    String bstr = new String(str);
 	    try {
-		o = (sbyte)System.Byte.Parse(bstr);
+		o = (sbyte)Byte.Parse(bstr);
 		r = true;
 	    } catch {
 		o = (sbyte)0;
@@ -143,9 +143,9 @@ public class RTS
 				     out sbyte  o, 	// OUT param
 				     out bool  r)	// OUT param
 	{
-	    System.String bstr = new System.String(str);
+	    String bstr = new String(str);
 	    try {
-		o = (sbyte)System.Byte.Parse
+		o = (sbyte)Byte.Parse
                            (bstr, System.Globalization.NumberStyles.HexNumber);
 		r = true;
 	    } catch {
@@ -164,9 +164,9 @@ public class RTS
 				     out short  o,	// OUT param
 				     out bool r)	// OUT param
 	{
-	    System.String sstr = new System.String(str);
+	    String sstr = new String(str);
 	    try {
-		o = System.Int16.Parse(sstr);
+		o = Int16.Parse(sstr);
 		r = true;
 	    } catch {
 		o = (short) 0;
@@ -184,9 +184,9 @@ public class RTS
 				     out short  o,	// OUT param
 				     out bool r)	// OUT param
 	{
-	    System.String sstr = new System.String(str);
+	    String sstr = new String(str);
 	    try {
-		o = (short)System.UInt16.Parse(sstr);
+		o = (short)UInt16.Parse(sstr);
 		r = true;
 	    } catch {
 		o = (short) 0;
@@ -204,9 +204,9 @@ public class RTS
 				    out int  o,		// OUT param
 				    out bool r)		// OUT param
 	{
-	    System.String lstr = new System.String(str);
+	    String lstr = new String(str);
 	    try {
-		o = System.Int32.Parse(lstr);
+		o = Int32.Parse(lstr);
 		r = true;
 	    } catch {
 		o = 0;
@@ -224,7 +224,7 @@ public class RTS
 				    out int o,		// OUT param
 				    out bool r)		// OUT param
 	{
-	    System.String lstr = new System.String(str);
+	    String lstr = new String(str);
 	    try {
 		o = (int)System.UInt32.Parse(lstr);
 		r = true;
@@ -471,26 +471,14 @@ public class RTS
         {
             System.String lls;
             if (obj.GetType().IsEnum) {
-#if BETA1
-                lls = obj.ToString();
-#else //BETA2
                 lls = System.Convert.ToString(System.Convert.ToInt64(obj));
-#endif
             }
             else {
                 if (obj.GetType().Equals(typDouble)) {
-#if BETA1
-                    lls = System.Convert.ToDouble(obj).ToString();
-#else //BETA2
                     lls = System.Convert.ToDouble(obj).ToString("R");
-#endif
                 }
                 else if (obj.GetType().Equals(typSingle)) {
-#if BETA1
-                    lls = System.Convert.ToSingle(obj).ToString();
-#else //BETA2
                     lls = System.Convert.ToSingle(obj).ToString("R");
-#endif
                 }
                 else {
                     lls = System.Convert.ToString(obj);
@@ -550,11 +538,7 @@ public class RTS
 	public static void RealToStr(double num,
 				     char[] str)
 	{
-#if BETA1
-	    System.String lls = System.Convert.ToString(num);
-#else //BETA2
             System.String lls = ((System.Double) num).ToString("R");
-#endif
             int    len = lls.Length;
             lls.CopyTo(0, str, 0, len);
             str[len] = '\0';
@@ -747,17 +731,57 @@ public class ProgArgs
  *  Original : kjg December 1999
  */
 {
-	public static System.String[] argList = null;
+    public static string[] argList = null;
 
-	// Known in ILASM as [RTS]ProgArgs::ArgNumber
-	// PROCEDURE ArgNumber*() : INTEGER
-	public static int ArgNumber()
-	{
+    // Known in ILASM as [RTS]ProgArgs::ArgNumber
+    // PROCEDURE ArgNumber*() : INTEGER
+    public static int ArgNumber()
+    {
         if (ProgArgs.argList == null)
-		return 0;
-	    else
-		return argList.Length;
-	}
+            return 0;
+        else
+            return argList.Length;
+    }
+
+    public static void ExpandWildcards(int N) {
+        ProgArgs.argList = ExpandArgs(argList, N);
+    }
+
+    private static bool needsExpansion(string arg) {
+        return (arg.Contains("*") || arg.Contains("?"));
+    }
+
+    private static string[] ExpandArgs(string[] inArgs, int first) {
+        List<string> list = new List<string>();
+        for (int i = 0; i < inArgs.Length; i++) {
+            string arg = inArgs[i];
+            //
+            // Copy args explicitly skipped, any option args 
+            // and eliminate a couple of mis-handled special cases.
+            //
+            if (i < first || arg[0] == '-' || arg[0] == '/' || !needsExpansion(arg)) 
+                list.Add(arg);
+            else {
+                string path = Path.GetDirectoryName(arg);
+                string pattern = Path.GetFileName(arg);
+                try {
+                    if (path == "") {
+                        IEnumerable<string> names = Directory.EnumerateFiles(".", pattern);
+                        foreach (string file in names)
+                            list.Add(Path.GetFileName(file));
+                    }
+                    else {
+                        IEnumerable<string> names = Directory.EnumerateFiles(path, pattern);
+                        foreach (string file in names)
+                            list.Add(file);
+                    }
+                } catch (Exception e) {
+                    System.Console.Error.WriteLine("ProgArgs.ExpandWildcards error\n" + e.Message);
+                }
+            }
+        }
+        return list.ToArray(); 
+    }
 
 	// Known in ILASM as [RTS]ProgArgs::GetArg
 	// PROCEDURE GetArg*(num : INTEGER; OUT arg : ARRAY OF CHAR) 
@@ -781,7 +805,7 @@ public class ProgArgs
 
         public static void GetEnvVar(char[] name, char[] valu) {
             System.String nam = CP_rts.mkStr(name);
-            System.String val = System.Environment.GetEnvironmentVariable(nam, System.EnvironmentVariableTarget.User);
+            System.String val = Environment.GetEnvironmentVariable(nam, EnvironmentVariableTarget.User);
             CP_rts.StrToChF(valu, val);
         }
 
@@ -860,6 +884,8 @@ public class CP_rts
 
 	// Known in ILASM as [RTS]CP_rts::mkStr
 	public static System.String mkStr(char[] arr) {
+            if (arr == null)
+                return null;
 	    int len = chrArrLength(arr);
 	    return new System.String(arr,0,len);
 	}
@@ -1046,6 +1072,8 @@ public class NativeStrings
 /* -------------------------------------------------------------------- */
 	// Known in ILASM as [RTS]NativeStrings::mkStr
 	public static System.String mkStr(char[] arr) {
+            if (arr == null)
+                return null;
 	    int len = CP_rts.chrArrLength(arr);
 	    return new System.String(arr,0,len);
 	}

libs/java/CPJrts.java

@@ -96,6 +96,20 @@ public class CPJrts
 	    return ix-1;
 	}
 
+/* -------------------------------------------------------------------- */
+
+	public static int ChrArrActiveLength(char[] src)
+	{
+            int  ix;
+	    char ch;
+	    for (ix = 0; ix < src.length; ix++) {
+		ch = src[ix];
+		if (ch == '\0') 
+			return ix;
+	    } 
+	    return ix;
+	}
+
 /* -------------------------------------------------------------------- */
 
 	public static int ChrArrLplus1(char[] src)
@@ -139,7 +153,7 @@ public class CPJrts
 	    //
             // This truncation makes semantics same as .NET version
 	    //
-            int len = ChrArrLength(arr);
+            int len = ChrArrActiveLength(arr);
 	    return new String(arr, 0, len);
 	}
 
@@ -264,22 +278,22 @@ public class CPJrts
 
 	public static String ArrArrToString(char[] l, char[] r)
 	{
-	    int llen = ChrArrLength(l);
-	    int rlen = ChrArrLength(r);
+	    int llen = ChrArrActiveLength(l);
+	    int rlen = ChrArrActiveLength(r);
 	    StringBuffer buff = new StringBuffer(llen + rlen);
 	    return buff.append(l,0,llen).append(r,0,rlen).toString();
 	}
 
 	public static String ArrStrToString(char[] l, String r)
 	{
-	    int llen = ChrArrLength(l);
+	    int llen = ChrArrActiveLength(l);
 	    StringBuffer buff = new StringBuffer(3 * llen);
 	    return buff.append(l,0,llen).append(r).toString();
 	}
 
 	public static String StrArrToString(String l, char[] r)
 	{
-	    int rlen = ChrArrLength(r);
+	    int rlen = ChrArrActiveLength(r);
 	    StringBuffer buff = new StringBuffer(3 * rlen);
 	    return buff.append(l).append(r,0,rlen).toString();
 	}

libs/java/GPFiles.java

@@ -34,5 +34,16 @@ public class GPFiles {
     File path = new File(CP.CPJ.CPJ.MkStr(dirName));
     return path.exists();
   }
-  
+
+  public static char[][] FileList(char[] dirPath) throws IOException {
+    File theDir = new File(CP.CPJ.CPJ.MkStr(dirPath));
+    String[] files = theDir.list();
+    if (files == null || files.length == 0 ) return null;
+    else {
+      char[][] rslt = new char[files.length][];
+      for (int i = 0; i < files.length; i++)
+        rslt[i] = CP.CPJrts.CPJrts.JavaStrToChrOpen(files[i]);
+      return rslt;
+    }
+  }
 }

libs/java/MakeAll.bat

@@ -6,6 +6,7 @@ javac -d . CPJrts.java
 javac -d . XHR.java
 javac -d . CPmain.java
 javac -d . Error.java
+javac -d . ProgArgs.java
 javac -d . GPFiles_FILE.java
 javac -d . GPFiles.java
 javac -d . GPBinFiles_FILE.java
@@ -13,7 +14,6 @@ javac -d . GPBinFiles.java
 javac -d . GPTextFiles_FILE.java
 javac -d . GPTextFiles.java
 javac -d . ProcType.java
-javac -d . ProgArgs.java
 javac -d . RTS.java
 javac -d . StdIn.java
 javac -d . VecBase.java

libs/java/MakeRTSjar.bat

@@ -1,7 +1,6 @@
 
 REM @echo off
 REM this compiles all of the standard java-sourced libraries for GPCP
-REM and collects then together in a JAR file. New for gpcp-JVM v1.4.*
 mkdir dest
 javac -d dest Console.java
 javac -d dest CPJ.java

libs/java/ProgArgs.java

@@ -10,44 +10,46 @@
 
 package CP.ProgArgs;
 import  CP.CPmain.CPmain;
+import  java.io.File;
+import  java.nio.file.*;
+import  java.util.ArrayList;
 
 public class ProgArgs
 {
+    public static int ArgNumber()
+    {
+        if (CP.CPmain.CPmain.args == null)
+            return 0;
+        else
+            return CP.CPmain.CPmain.args.length;
+    }
 
-	public static int ArgNumber()
-	{
-	    if (CP.CPmain.CPmain.args == null)
-		return 0;
-	    else
-		return CP.CPmain.CPmain.args.length;
-	}
-
-	public static void GetArg(int num, char[] str)
-	{
-	    int i;
-	    if (CP.CPmain.CPmain.args == null) {
-		str[0] = '\0';
-	    } else {
-		for (i = 0; 
-		     i < str.length && i < CP.CPmain.CPmain.args[num].length();
-		     i++) {
-		    str[i] = CP.CPmain.CPmain.args[num].charAt(i);
-		}
-		if (i == str.length)
-		    i--;
-		str[i] = '\0';
-	    }
-	}
-
-        public static void GetEnvVar(char[] ss, char[] ds) 
-        {
-            String path = CP.CPJ.CPJ.MkStr(ss);
-	    //
-	    //  getenv was deprecated between jave 1.1 and SE 5 (!)
-	    //
-            String valu = System.getProperty(path);
-	    if (valu == null) // Try getenv instead
-		    valu = System.getenv(path);
+    public static void GetArg(int num, char[] str)
+    {
+        int i;
+        if (CP.CPmain.CPmain.args == null) {
+            str[0] = '\0';
+        } else {
+            for (i = 0; 
+                i < str.length && i < CP.CPmain.CPmain.args[num].length();
+                i++) {
+                str[i] = CP.CPmain.CPmain.args[num].charAt(i);
+            }
+        if (i == str.length)
+            i--;
+        str[i] = '\0';
+        }
+    }
+
+    public static void GetEnvVar(char[] ss, char[] ds) 
+    {
+        String path = CP.CPJ.CPJ.MkStr(ss);
+        //
+        //  getenv was deprecated between jave 1.1 and SE 5 (!)
+        //
+        String valu = System.getProperty(path);
+        if (valu == null) // Try getenv instead
+            valu = System.getenv(path);
             int i;
             for (i = 0; 
                  i < valu.length() && i < ds.length;
@@ -59,4 +61,50 @@ public class ProgArgs
             ds[i] = '\0';
         }
 
+    public static void ExpandWildcards(int argsToSkip) {
+        //
+        // The Java launcher expands wildcards, but only
+        // for simple filenames in the current directory.
+        // 
+        try {
+            CP.CPmain.CPmain.args = ExpandArgs(CP.CPmain.CPmain.args, argsToSkip);
+        } catch (Exception x) {
+            System.err.println(x.toString());
+        }
+    }
+
+    private static boolean needsExpansion(String arg) {
+	return (arg.contains("*") || arg.contains("?"));
+    }
+
+    
+    private static String[] ExpandArgs(String[] args, int first) throws Exception {
+        ArrayList<String> list = new ArrayList<String>();
+        for (int i = 0; i < args.length; i++) {
+            String argS = args[i];
+            if (i < first || argS.charAt(0) == '-' || !needsExpansion(argS)) {
+                list.add(argS);
+            } else {
+                File argF = new File(args[i]);
+                File parent = argF.getParentFile();
+                String pattern = argF.getName();
+                boolean implicitParent = (parent == null);
+                if (implicitParent)
+                    parent = new File(".");
+                try (DirectoryStream<Path> stream = 
+                        Files.newDirectoryStream(parent.toPath(), pattern)) {
+                    for (Path entry: stream) {
+                        if (implicitParent)
+                            list.add(entry.toFile().getName());
+                        else
+                            list.add(entry.toString());
+                    }
+                } catch (DirectoryIteratorException x) {
+                        throw x.getCause();
+                }
+            }
+        }
+        return list.toArray(new String[0]);
+    }
+
 } // end of public class ProgArgs