Incorporate base changes for v1.4.05NET

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/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 
@@ -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,6 +311,7 @@ MODULE Browse;
     output : Output;
     module : Module;
     modList : ModList;
+    dstPath : CharOpen;
 
 (* ============================================================ *)
 (* ============================================================ *)
@@ -362,7 +365,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 +382,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 +580,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		======= *)
 (* ============================================================ *)
@@ -969,6 +982,7 @@ MODULE Browse;
         impName : CharOpen;
         i,j : INTEGER;
   BEGIN
+    ReinitializeTypes();
     GetSym();
     typOrd := 0;
     WHILE sSym = tDefS DO
@@ -1208,7 +1222,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 +1304,8 @@ MODULE Browse;
     END;
   END GetSymAndModNames;
 
+(* ============================================================ *)
+
   PROCEDURE Parse();
   VAR 
     marker,modIx,i   : INTEGER;
@@ -1312,30 +1328,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
+	    Error.WriteString("Opened " + mod.pathName^); Error.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
+        Error.WriteString("Reading " + mod.name^); Error.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;
 
 (* ===================================================================== *)
 
@@ -2143,7 +2168,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);
@@ -2272,6 +2296,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 +2320,7 @@ END MethAnchor;
     rec : Record;
     first : BOOLEAN;
     heading : ARRAY 20 OF CHAR;
+    declarer : Desc;
     (* --------------------------- *)
     PROCEDURE WriteOptionalExtras(impMod : Module);
     BEGIN
@@ -2374,18 +2414,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 +2464,7 @@ END MethAnchor;
  *  NEW(t); t.name := "SPECIAL"; typeList[16] := t;
  *)
   END InitTypes;
- 
+
   PROCEDURE InitAccArray();
   BEGIN
     accArray[0] := ' ';
@@ -2439,46 +2480,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(" /dst=dir  ==> create output files in directory dir");
+    Console.WriteLn;
+    Console.WriteString(" /file     ==> write output to a file <ModuleName>.bro ");
     Console.WriteLn;
-    Console.WriteString(" /file ==> write output to a file <ModuleName>.bro ");
+    Console.WriteString(" /full     ==> display explicit foreign names ");
     Console.WriteLn;
-    Console.WriteString(" /full ==> display explicit foreign names ");
+    Console.WriteString(" /help     ==> display this usage message");
     Console.WriteLn;
-    Console.WriteString(" /help ==> display this usage message");
+    Console.WriteString(" /hex      ==> use hexadecimal for short literals"); 
     Console.WriteLn;
-    Console.WriteString(" /hex  ==> use hexadecimal for short literals"); 
+    Console.WriteString(" /html     ==> write html output to file <ModuleName>.html");
     Console.WriteLn;
-    Console.WriteString(
-                    " /html ==> write html output to file <ModuleName>.html");
+    Console.WriteString(" /sort     ==> sort procedures and types alphabetically");
     Console.WriteLn;
-    Console.WriteString(" /sort ==> sort procedures and types alphabetically");
+    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(" -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;
@@ -2499,6 +2546,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 +2601,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 +2631,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 +2644,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
+            Error.WriteString("Creating " + fNamePtr^);
+            Error.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 +2720,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 +2749,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

@@ -168,6 +168,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;
 

gpcp/ClsToType.cp

@@ -45,7 +45,8 @@ MODULE ClsToType;
         enuCls*  =  3; evtCls*  =  4; dlgCls*  =  5;
         primTyp* =  6; arrTyp*  =  7; voidTyp* =  8;
         strTyp*  =  9; objTyp*  = 10; sysValT* = 11;
-        sysEnuT* = 12; sysDelT* = 13; sysExcT* = 14; voidStar* = 15;
+        sysEnuT* = 12; sysDelT* = 13; sysExcT* = 14; 
+		voidStar* = 15;
 
   CONST (* type attribute enumeration bits   *)
         absTp = 7; intTp = 5; sldTp = 8;
@@ -530,7 +531,6 @@ MODULE ClsToType;
     | sysEnuT  : RETURN ntvEnu;
     | sysDelT  : RETURN ntvEvt;
     | voidStar : RETURN voidSt;
-
     ELSE (* default, refCls, valCls, enuCls, evtCls, dlgCls *)  
       WITH peT : Per.Class DO
         RETURN lookup(peT, spc);

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

@@ -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,8 @@ 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 30 August 2017"; 
 	verStr*    = " version " + VERSION;
 
   CONST	prefix     = "#gpcp: ";
@@ -74,7 +75,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 +90,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,75 @@
+
 MODULE Hello;
-  IMPORT CPmain, Console;
+  IMPORT CPmain, Console, 
+  BF := GPBinFiles,
+  RTS;
+
+  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
+    Console.Write(char);
+    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/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,8 @@ MODULE JavaMaker;
     CSt.ntvExc := exc.type;
     Bi.MkDummyClass("Class", blk, Ty.noAtt, cls);
     CSt.ntvTyp := cls.type;
-
+    Bi.MkDummyClass("Throwable", blk, Ty.extns, thr);
+    Bi.AddDummyBaseTp(exc, thr);
    (*
     *  Create import descriptor for CP.RTS
     *)

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/MsilMaker.cp

@@ -20,7 +20,7 @@ MODULE MsilMaker;
         GPFiles,
         GPBinFiles,
         GPTextFiles,
-        PeUtil,
+        (* PeUtil, *)
         IlasmUtil,
         Nh  := NameHash,
         Scn := CPascalS,
@@ -741,17 +741,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;

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/NewSymFileRW.cp

@@ -2,7 +2,7 @@
 (* ==================================================================== *)
 (*									*)
 (*  SymFileRW:  Symbol-file reading and writing for GPCP.		*)
-(*	Copyright (c) John Gough 1999 -- 2011.				*)
+(*	Copyright (c) John Gough 1999 -- 2017.				*)
 (*									*)
 (* ==================================================================== *)
 
@@ -922,7 +922,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.
       *)
@@ -1190,6 +1190,7 @@ MODULE NewSymFileRW;
       f.SymFile(filNm);
       IF CSt.verbose THEN 
         CSt.Message(message^ + ", Key: " + Lt.intToCharOpen(f.impS.modKey)^);
+        CSt.Message(BOX("Found " + BF.getFullPathName(f.file)^ + " ?"));
         FOR index := 0 TO f.sArray.tide - 1 DO
           CSt.Message("  imports " + NameAndKey(f.sArray.a[index])^);
         END;
@@ -1444,6 +1445,9 @@ 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>] 	*)
@@ -1477,18 +1481,18 @@ MODULE NewSymFileRW;
     rslt.recAtt := attr;
     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;
@@ -1610,8 +1614,13 @@ MODULE NewSymFileRW;
     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;
 
 (* ============================================ *)
@@ -1943,7 +1952,7 @@ MODULE NewSymFileRW;
               END;
             END;
           END;
-        ELSE (* skip *)
+        ELSE (* skip other types *)
         END; (* with *)
       END;
     END; (* for linkIx do *)
@@ -1953,7 +1962,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
@@ -2154,18 +2163,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/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/TypeDesc.cp

@@ -1103,6 +1103,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     *)
@@ -1642,7 +1650,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 +1718,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/csharp/MsilAsm.cs

@@ -17,17 +17,10 @@
 //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
+//  NOTE: this needs (since 2005) to be compiled using
 //
 //  $ csc /t:library /r:RTS.dll MsilAsm.cs
 // 
-#if !BETA1
-  #define BETA2
-#endif
 
 using System.Diagnostics;
 
@@ -51,12 +44,8 @@ public class MsilAsm {
 	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
 	}
     }
 
@@ -66,7 +55,7 @@ public class MsilAsm {
 	System.String suffx;
 	System.String fName = CP_rts.mkStr(fil);
 	if (hasMain) {
-	    optNm ="/exe ";
+	    optNm = "/exe ";
 	    suffx = ".exe";
 	} else {
 	    optNm = "/dll ";
@@ -100,14 +89,10 @@ public class MsilAsm {
 	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();
@@ -122,6 +107,5 @@ public class MsilAsm {
         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

@@ -52,7 +52,6 @@ MODULE N2State;
         Verbose-  : BOOLEAN;
         superVb-  : BOOLEAN;
         generics- : BOOLEAN;
-        legacy-   : BOOLEAN;
         cpCmpld-  : BOOLEAN;
 
  (* ---------------------------------------------------------- *)
@@ -201,17 +200,13 @@ MODULE N2State;
     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;
@@ -279,11 +274,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 +309,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

@@ -48,6 +48,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] = files[i].ToCharArray();
+	   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/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