Bug fixes + new version of PeToCps for NET version, using System.Reflection

gpcp/AsmFrames.cp

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

gpcp/Browse.cp

@@ -173,9 +173,9 @@ MODULE Browse;
            END;
 
     Pointer = POINTER TO EXTENSIBLE RECORD (Type)
-                baseNum : INTEGER;
+                boundOrd  : INTEGER;
+                boundType : Type;
                 isAnonPointer : BOOLEAN;
-                baseType : Type;
               END;
 
     Record = POINTER TO EXTENSIBLE RECORD (Type)
@@ -183,7 +183,7 @@ MODULE Browse;
                baseType  : Type;
                ptrType   : Pointer;
                isAnonRec : BOOLEAN;
-               baseNum   : INTEGER;
+               baseOrd   : INTEGER;
                intrFaces : DescList; 
                fields    : DescList; 
                methods   : DescList; 
@@ -260,7 +260,7 @@ MODULE Browse;
                 list : POINTER TO ARRAY OF Module;
               END;
 
-    Module = POINTER TO RECORD
+    Module = POINTER TO RECORD 
                name      : CharOpen;
                symName   : CharOpen;
                fName     : CharOpen;
@@ -316,11 +316,7 @@ MODULE Browse;
 (* ============================================================ *)
 (* ============================================================ *)
 
-  PROCEDURE QuickSortDescs(lo, hi : INTEGER; dLst : DescList);
-    VAR i,j : INTEGER;
-        dsc : Desc;
-	tmp : Desc;
-   (* -------------------------------------------------- *)
+ (* ---------------------------------------------------- *)
     PROCEDURE canonLT(l,r : ARRAY OF CHAR) : BOOLEAN;
       VAR i : INTEGER;
     BEGIN
@@ -337,7 +333,14 @@ MODULE Browse;
       FOR i := 0 TO LEN(r) - 1 DO r[i] := CAP(r[i]) END;
       RETURN l > r;
     END canonGT;
-   (* -------------------------------------------------- *)
+ (* ---------------------------------------------------- *)
+
+ (* ---------------------------------------------------- *)
+  PROCEDURE QuickSortDescs(lo, hi : INTEGER; dLst : DescList);
+    VAR i,j : INTEGER;
+        dsc : Desc;
+	tmp : Desc;
+ (* ---------------------------------------------------- *)
   BEGIN
     i := lo; j := hi;
     dsc := dLst.list[(lo+hi) DIV 2];
@@ -350,12 +353,38 @@ MODULE Browse;
       WHILE canonGT(dLst.list[j].name$, dsc.name$) DO DEC(j) END;
       IF i <= j THEN
         tmp := dLst.list[i]; dLst.list[i] := dLst.list[j]; dLst.list[j] := tmp; 
-	INC(i); DEC(j);
+        INC(i); DEC(j);
       END;
     UNTIL i > j;
     IF lo < j THEN QuickSortDescs(lo, j,  dLst) END;
     IF i < hi THEN QuickSortDescs(i,  hi, dLst) END;
   END QuickSortDescs;
+ (* ---------------------------------------------------- *)
+
+ (* ---------------------------------------------------- *)
+  PROCEDURE QuickSortMods(lo, hi : INTEGER; dLst : ModList);
+    VAR i,j : INTEGER;
+        dsc : Module;
+	tmp : Module;
+ (* ---------------------------------------------------- *)
+  BEGIN
+    i := lo; j := hi;
+    dsc := dLst.list[(lo+hi) DIV 2];
+    REPEAT
+   (*
+    * WHILE dLst.list[i].name < dsc.name DO INC(i) END;
+    * WHILE dLst.list[j].name > dsc.name DO DEC(j) END;
+    *)
+      WHILE canonLT(dLst.list[i].name$, dsc.name$) DO INC(i) END;
+      WHILE canonGT(dLst.list[j].name$, dsc.name$) DO DEC(j) END;
+      IF i <= j THEN
+        tmp := dLst.list[i]; dLst.list[i] := dLst.list[j]; dLst.list[j] := tmp; 
+        INC(i); DEC(j);
+      END;
+    UNTIL i > j;
+    IF lo < j THEN QuickSortMods(lo, j,  dLst) END;
+    IF i < hi THEN QuickSortMods(i,  hi, dLst) END;
+  END QuickSortMods;
 
 (* ============================================================ *)
 (* ============================================================ *)
@@ -762,7 +791,7 @@ MODULE Browse;
       ptr : Pointer;
   BEGIN
     NEW(ptr);
-    ptr.baseNum := readOrd();
+    ptr.boundOrd := readOrd();
     ptr.isAnonPointer := FALSE;
     GetSym();
     RETURN ptr;
@@ -879,10 +908,10 @@ MODULE Browse;
       GetSym();
     END;
     IF sSym = basSy THEN
-      rec.baseNum := iAtt;
+      rec.baseOrd := iAtt;
       GetSym();
     ELSE
-      rec.baseNum := 0;
+      rec.baseOrd := 0;
     END;
     IF sSym = iFcSy THEN
       GetSym();
@@ -1011,7 +1040,7 @@ MODULE Browse;
       | eTpSy : typ := enumType();
       ELSE 
         NEW(namedType);
-	typ := namedType;
+	    typ := namedType;
       END;
       IF typ # NIL THEN
         AddType(typeList,typ,typOrd);
@@ -1030,8 +1059,8 @@ MODULE Browse;
         typ(Vector).elemType := typeList[typ(Vector).elemTypeNum];
       ELSIF typ IS Record THEN
         rec := typ(Record);
-        IF (rec.baseNum > 0) THEN
-          rec.baseType := typeList[rec.baseNum];
+        IF (rec.baseOrd > 0) THEN
+          rec.baseType := typeList[rec.baseOrd];
         END;
         FOR j := 0 TO rec.fields.tide-1 DO
           f := rec.fields.list[j](VarDesc);
@@ -1049,7 +1078,7 @@ MODULE Browse;
           END;
         END;
       ELSIF typ IS Pointer THEN
-        typ(Pointer).baseType := typeList[typ(Pointer).baseNum];
+        typ(Pointer).boundType := typeList[typ(Pointer).boundOrd];
       ELSIF typ IS Proc THEN
         ResolveProc(typ(Proc));
       END;
@@ -1079,11 +1108,11 @@ MODULE Browse;
         IF typ.declarer = NIL THEN (* anon record *)
           typ(Record).isAnonRec := TRUE;
         END;
-      ELSIF (typ IS Pointer) & (typ(Pointer).baseType IS Record) THEN
+      ELSIF (typ IS Pointer) & (typ(Pointer).boundType IS Record) THEN
         IF (typ.declarer = NIL) & (typ.importedFrom = NIL) THEN 
           typ(Pointer).isAnonPointer := TRUE; 
         END;
-        r := typ(Pointer).baseType(Record);
+        r := typ(Pointer).boundType(Record);
         IF (r.declarer = NIL) THEN  (* anon record *)
           r.isAnonRec := TRUE;
           r.ptrType := typ(Pointer);
@@ -1332,7 +1361,7 @@ MODULE Browse;
 	    mod.pathName := mod.symName;
 	  END;
 	  IF verbose THEN
-	    Error.WriteString("Opened " + mod.pathName^); Error.WriteLn;
+	    Console.WriteString("Opened " + mod.pathName^); Console.WriteLn;
 	  END;
       marker := readInt();
       IF marker = RTS.loInt(magic) THEN
@@ -1347,7 +1376,7 @@ MODULE Browse;
       mod.print := TRUE;
       GetSym();
       IF verbose THEN
-        Error.WriteString("Reading " + mod.name^); Error.WriteLn;
+        Console.WriteString("Reading " + mod.name^); Console.WriteLn;
       END;
       SymFile(mod);
       GPBinFiles.CloseFile(file);
@@ -1442,6 +1471,7 @@ END WriteTypeDecl;
 (* FIXME *)
 PROCEDURE (o : Output) MethRef(IN nam : ARRAY OF CHAR),NEW,EMPTY;
 PROCEDURE (o : Output) MethAnchor(IN nam : ARRAY OF CHAR),NEW,EMPTY;
+PROCEDURE (o : Output) WriteLinefold(indent : INTEGER),NEW,EMPTY;
 (* FIXME *)
 
 (* ------------------------------------------------------------------- *)
@@ -1626,13 +1656,18 @@ END WriteTypeDecl;
 (* FIXME *)
 PROCEDURE (h : HtmlOutput) MethRef(IN nam : ARRAY OF CHAR);
 BEGIN
-  GPText.WriteString(h.file, '    <a href="#meths-');;
+  GPText.WriteString(h.file,"<b> (* </b>");
+  GPText.WriteString(h.file, '<a href="#meths-');;
   GPText.WriteString(h.file, nam);
   GPText.WriteString(h.file, '">');
+  GPText.WriteString(h.file, "Typebound Procedures");
+(*
   GPText.WriteString(h.file, '<font color="#cc0033">');
-  GPText.WriteString(h.file, "(* Typebound Procedures *)");
+  GPText.WriteString(h.file, "Typebound Procedures");
   GPText.WriteString(h.file, "</font>");
+ *)
   GPText.WriteString(h.file, '</a>');
+  GPText.WriteString(h.file,"<b> *)</b>");
 END MethRef;
 
 PROCEDURE (h : HtmlOutput) MethAnchor(IN nam : ARRAY OF CHAR);
@@ -1641,6 +1676,12 @@ BEGIN
   GPText.WriteString(h.file, nam);
   GPText.WriteString(h.file, '"></a>');
 END MethAnchor;
+
+PROCEDURE (o : HtmlOutput) WriteLinefold(indent : INTEGER);
+BEGIN
+  o.WriteLn;
+  o.Indent(indent);
+END WriteLinefold;
 (* FIXME *)
 
 (* ==================================================================== *)
@@ -1993,7 +2034,7 @@ END MethAnchor;
      (* ##### *)
       FOR i := 0 TO r.intrFaces.tide-1 DO
         output.WriteString(" + ");
-	iTyp := r.intrFaces.list[i](TypeDesc).type;
+        iTyp := r.intrFaces.list[i](TypeDesc).type;
         IF (iTyp IS Record) & (iTyp(Record).ptrType # NIL) THEN
           iTyp(Record).ptrType.Print(0,FALSE);
         ELSE
@@ -2005,7 +2046,10 @@ END MethAnchor;
     END;
 
 (* FIXME *)
-    IF r.methods.tide > 0 THEN
+    IF r.methods.tide > 0 THEN (* If interfaces, then newline + indent? *)
+      IF r.intrFaces.tide > 1 THEN
+        output.WriteLinefold(indent);
+      END;
       IF r.declarer # NIL THEN 
         output.MethRef(r.declarer.name);
       ELSIF (r.ptrType # NIL) & (r.ptrType.declarer # NIL) THEN
@@ -2196,7 +2240,7 @@ END MethAnchor;
   PROCEDURE (p : Pointer) PrintType(indent : INTEGER),EXTENSIBLE;
   BEGIN
     output.WriteKeyword("POINTER TO ");
-    p.baseType.Print(indent,FALSE);
+    p.boundType.Print(indent,FALSE);
   END PrintType;
 
   PROCEDURE (p : Event) PrintType(indent : INTEGER);
@@ -2369,6 +2413,11 @@ END MethAnchor;
     END;
    (*  end optional strong name.  *)
     output.WriteLn; output.WriteLn;
+
+    IF (mod.imports.tide > 1) & alpha THEN
+      QuickSortMods(1, mod.imports.tide-1, mod.imports);
+    END;
+
     IF mod.imports.tide > 1 THEN
       output.WriteKeyword("IMPORT"); output.WriteLn;
       output.Indent(4);
@@ -2406,7 +2455,7 @@ END MethAnchor;
     output.WriteLn;
     FOR i := 0 TO mod.types.tide -1 DO 
       ty := mod.types.list[i](UserTypeDesc).type;
-      IF ty IS Pointer THEN ty := ty(Pointer).baseType; END;
+      IF ty IS Pointer THEN ty := ty(Pointer).boundType; END;
       IF ty IS Record THEN
         rec := ty(Record);
 
@@ -2680,8 +2729,8 @@ END ParseOptions;
               GPTextFiles.createPath(fNamePtr);
           END;
           IF verbose THEN
-            Error.WriteString("Creating " + fNamePtr^);
-            Error.WriteLn;
+            Console.WriteString("Creating " + fNamePtr^);
+            Console.WriteLn;
           END;
         END;
         PrintModule(modList.list[i]); 

gpcp/Builtin.cp

@@ -130,13 +130,14 @@ MODULE Builtin;
 (* ============================================================ *)
 
   PROCEDURE MkDummyImport*(IN  nam : ARRAY OF CHAR;
-			   IN  xNm : ARRAY OF CHAR;
-			   OUT blk : IdDesc.BlkId);
+                           IN  xNm : ARRAY OF CHAR;
+                           OUT blk : IdDesc.BlkId);
     VAR jnk : BOOLEAN;
   BEGIN
     blk := IdDesc.newImpId();
     blk.dfScp   := blk;
     blk.hash    := NameHash.enterStr(nam);
+	blk.SetNameFromHash(blk.hash);
     IF LEN(xNm) > 1 THEN blk.scopeNm := LitValue.strToCharOpen(xNm) END;
     jnk := CompState.thisMod.symTb.enter(blk.hash, blk);
     INCL(blk.xAttr, Symbols.isFn);

gpcp/ClassUtil.cp

@@ -851,7 +851,7 @@ MODULE ClassUtil;
     NEW(m);
     m.methId := meth;
     IF meth = NIL THEN
-      m.localNum := 0;
+      m.localNum := 2;
       m.maxLocals := 2; (* need 2 for __copy__  'this' + 'arg'*)
     ELSE        (* Id.BlkId *)
       m.localNum := meth.rtsFram;

gpcp/ExprDesc.cp

@@ -972,14 +972,14 @@ MODULE ExprDesc;
           ELSE
             IF ~arg0.isIntExpr() THEN arg0.ExprError(37) END;
             IF ~arg1.isIntExpr() THEN arg1.ExprError(37) END;
-			(* FIXME, no folding yet ... *)
-			IF arg0.type = Builtin.lIntTp THEN
-			  dstT := Builtin.lIntTp;
-			ELSE
+           (* FIXME, no folding yet ... *)
+            IF arg0.type = Builtin.lIntTp THEN
+              dstT := Builtin.lIntTp;
+            ELSE
               IF arg0.type # Builtin.intTp THEN
                 arg0 := convert(arg0, Builtin.intTp);
-			  END;
-			  dstT := Builtin.intTp;
+              END;
+              dstT := Builtin.intTp;
             END;
             IF arg1.type # Builtin.intTp THEN
               arg1 := convert(arg1, Builtin.intTp);

gpcp/GPCPcopyright.cp

@@ -54,7 +54,8 @@ MODULE GPCPcopyright;
      (* VERSION    = "1.4.01 of 21 October 2016"; *)
      (* VERSION    = "1.4.02 of 14 November 2016"; *)
      (* VERSION    = "1.4.04 of 07 August 2017"; *)
-        VERSION    = "1.4.05 of 11 October 2017"; 
+     (* VERSION    = "1.4.05 of 11 October 2017"; *)
+        VERSION    = "1.4.06 of 18 February 2018"; 
 	verStr*    = " version " + VERSION;
 
   CONST	prefix     = "#gpcp: ";

gpcp/Hello.cp

@@ -1,8 +1,10 @@
 
 MODULE Hello;
   IMPORT CPmain, Console, 
+  GF := GPFiles,
   BF := GPBinFiles,
-  RTS;
+  RTS,
+  Sys := mscorlib_System;
 
   CONST greet = "Hello ASM World";
   VAR   file : BF.FILE;
@@ -16,7 +18,6 @@ MODULE Hello;
     VAR indx : INTEGER;
         char : CHAR;
   BEGIN
-    Console.Write(char);
     FOR indx := 0 TO LEN(a) - 1 DO
       char := a[indx];
       Console.WriteInt(indx, 2);

gpcp/IdDesc.cp

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

gpcp/JavaMaker.cp

@@ -534,7 +534,7 @@ MODULE JavaMaker;
           Ju.MkProcName(method);
           Ju.RenumberLocals(method);
         END;
-        this.EmitProc(method)
+        this.EmitProc(method);
       END;
     END;
   END EmitBody;
@@ -570,19 +570,6 @@ MODULE JavaMaker;
       varId := this.mod.locals.a[index](Id.VarId);
       out.EmitField(varId);  
     END;
-    (*
-    FOR index := 0 TO this.mod.procs.tide-1 DO
-     (*
-      *  Create the mangled name for all non-forward procedures
-      *)
-      proc := this.mod.procs.a[index];
-      IF (proc.kind = Id.conPrc) OR 
-         (proc.kind = Id.conMth) THEN
-        Ju.MkProcName(proc);
-        Ju.RenumberLocals(proc);
-      END;
-    END;
-    *)
    (* 
     *  Do all the procs, including <init> and <clinit> 
     *)
@@ -592,18 +579,32 @@ MODULE JavaMaker;
     out.InitVars(this.mod);
     IF this.mod.main THEN
      (*
-      *   Emit <clinit>, and module body as main() 
+      *   This module imports CPmain, so ...
+      *   end emission of <clinit>, and then
+      *   emit module body as main() 
       *)
       out.VoidTail();
       out.MainHead();
       this.EmitStat(this.mod.modBody, returned);
       IF returned THEN
+       (*
+        * The following code is a workaround for a tricky
+        * corner case specific to stack frames in SE 7+.
+        * If the normal return does not reach module end
+        * due to an unterminated loop being the last 
+        * statement, then emission of dead code "return"
+        * will fail verification - as there is no possible
+        * correct stack-frame at that program point.
+        *)
         this.EmitStat(this.mod.modClose, returned);
+        out.VoidTail();
+      ELSE
+        out.EndProc();
       END;
-      out.VoidTail();
     ELSE
      (*
-      *   Emit single <clinit> incorporating module body
+      *   This module does not import CPmain, so ...
+      *   module body is emitted as <clinit>
       *)
       this.EmitStat(this.mod.modBody, returned);
       out.VoidTail();

gpcp/JavaUtil.cp

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

gpcp/JsmnUtil.cp

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

gpcp/MakeIndex/BiHtmlWriter.cp

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

gpcp/MakeIndex/BiStateHandler.cp

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

gpcp/MakeIndex/BiTypeDefs.cp

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

gpcp/MakeIndex/MakeIndex.cp

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

gpcp/MkNetDistro.bat

@@ -56,14 +56,34 @@ csc /t:library /r:GPFiles.dll /debug /nologo GPBinFiles.cs
 if errorlevel 1 goto :fail
 csc /t:library /r:GPFiles.dll /debug /nologo GPTextFiles.cs
 if errorlevel 1 goto :fail
+REM ===================================
+echo moving PE files to TRGT\bin
+REM ===================================
 move *.dll %TRGT%\bin
 move *.pdb %TRGT%\bin
 CD %HOME%\libs\csharp
+REM ===================================
+echo compiling MsilAsm 
+REM ===================================
 csc /t:library /debug /nologo MsilAsm.cs
 if errorlevel 1 goto :fail
 move MsilAsm.dll %TRGT%\bin
 move MsilAsm.pdb %TRGT%\bin
-
+REM
+REM The source of PeToCpsUtils.cp is included.
+REM It is required to allow PeToCps v1.4.06 to be
+REM compiled using the gpcp v1.4.04 executables. 
+REM It is not required when re-compiling with gpcp 1.4.06
+REM
+REM csc /t:library /debug /nologo PeToCpsUtils.cs
+REM PeToCps PeToCpsUtils.dll
+REM move PeToCpsUtils.dll %TRGT%\bin
+REM move PeToCpsUtils.pdb %TRGT%\bin
+REM move PeToCpsUtils_.cps %TRGT%\symfiles
+REM if errorlevel 1 goto :fail
+REM move MsilAsm.dll %TRGT%\bin
+REM move MsilAsm.pdb %TRGT%\bin
+REM 
 REM ===================================
 echo Compiling CP library sources
 REM ===================================
@@ -76,6 +96,13 @@ if errorlevel 1 goto :fail
 move *.cps %TRGT%\symfiles
 del *.il /q
 
+REM ===================================
+echo NOT Copying the PERWAPI symbol files
+REM  Have to leave this in until PERWAPI is removed from distro
+REM ===================================
+REM CD %CROOT%\symfiles
+REM copy QUT_*.cps %TRGT%\symfiles
+
 REM ===================================
 echo Copying the NetSystem symbol files
 REM ===================================
@@ -131,11 +158,11 @@ REM  This is only necessary until the new PeToCps
 REM  uses System.Reflection to build symbol files.
 REM ===================================
 REM ===================================
-echo Copying PERWAPI to gpcp-NET\bin
+echo NOT Copying PERWAPI to gpcp-NET\bin
+REM ===================================
+REM CD %CROOT%\bin
+REM copy QUT*.* %TRGT%\bin
 REM ===================================
-CD %CROOT%\bin
-copy QUT*.* %TRGT%\bin
-copy CopyNetLibs.bat %TRGT%\bin
 
 REM ===================================
 echo Copying the documentation
@@ -165,6 +192,14 @@ copy sources\gpcp\MakeIndex\*.cp %TRGT%\sources\gpcp\MakeIndex
 copy sources\gpcp\libs\java\MsilAsm.java %TRGT%\sources\gpcp\libs\java
 copy sources\gpcp\libs\csharp\MsilAsm.cs %TRGT%\sources\gpcp\libs\csharp
 
+REM ===================================
+echo Copy helper files for .NET bin directory
+REM ===================================
+copy sources\gpcp\CopyNetLibs.bat %TRGT%\bin
+copy sources\gpcp\_README-NET.txt %TRGT%\bin
+copy sources\gpcp\CopyNetLibs.bat %TRGT%\sources\gpcp
+copy sources\gpcp\_README-NET.txt %TRGT%\sources\gpcp
+
 REM ===================================
 echo Copying CP library sources
 REM ===================================
@@ -182,7 +217,7 @@ REM ===================================
 copy sources\libs\java\*.* %TRGT%\sources\libs\java
 
 REM ===================================
-echo Copying PERWAPI-project.zip to gpcp-NET\sources
+echo (Still) Copying PERWAPI-project.zip to gpcp-NET\sources
 REM ===================================
 copy sources\PERWAPI-project.zip %TRGT%\sources
 

gpcp/MsilMaker.cp

@@ -122,8 +122,10 @@ MODULE MsilMaker;
 (* ============================================================ *)
 
   PROCEDURE (this : MsilEmitter)Init*();
-    VAR tId : Id.TypId;
-        blk : Id.BlkId;
+    VAR sysBlk : Id.BlkId;  (* mscorlib_System            *)
+        rflBlk : Id.BlkId;  (* mscorlib_System_Reflection *)
+        tmpBlk : Id.BlkId;  (* temporary BlkId object     *)
+        mem : Id.TypId;     (* Reflection.MemberInfo      *)
         obj : Id.TypId;
         str : Id.TypId;
         exc : Id.TypId;
@@ -134,33 +136,44 @@ MODULE MsilMaker;
    (*
     *  Create import descriptor for [mscorlib]System
     *)
-    Bi.MkDummyImport("mscorlib_System", "[mscorlib]System", blk);
-	CSt.SetSysLib(blk);
+    Bi.MkDummyImport("mscorlib_System", "[mscorlib]System", sysBlk);
+    Bi.MkDummyImport("mscorlib_System_Reflection", 
+                     "[mscorlib]System.Reflection", rflBlk);
+    CSt.SetSysLib(sysBlk);
    (*
     *  Create various classes.
     *)
-    Bi.MkDummyClass("Object", blk, Ty.isAbs, obj);
+    Bi.MkDummyClass("Object", sysBlk, Ty.isAbs, obj);
     CSt.ntvObj := obj.type;
-    Bi.MkDummyClass("String", blk, Ty.noAtt, str);
+    Bi.MkDummyClass("String", sysBlk, Ty.noAtt, str);
     Bi.SetPtrBase(str, obj);
     CSt.ntvStr := str.type;
     CSt.ntvStrArr := Ty.mkArrayOf(str.type);
-    Bi.MkDummyClass("Exception", blk, Ty.extns, exc);
+    Bi.MkDummyClass("Exception", sysBlk, Ty.extns, exc);
     Bi.SetPtrBase(exc, obj);
     CSt.ntvExc := exc.type;
-    Bi.MkDummyClass("Type", blk, Ty.isAbs, typ);
-    Bi.SetPtrBase(typ, obj);
+ 
+   (*
+    *  It is necessary to leave the base type of mscorlib_System.Type
+    *  undefined.  If it *is* defined it will not be overridden by
+    *  an import of mscorlib_System_Reflection which needs to set
+    *  the base type to mscorlib_System_Reflection.MemberInfo.
+    *)
+    Bi.MkDummyClass("MemberInfo", rflBlk, Ty.isAbs, mem);
+    Bi.SetPtrBase(mem, obj);
+    Bi.MkDummyClass("Type", sysBlk, Ty.isAbs, typ);
+    Bi.SetPtrBase(typ, mem);
     CSt.ntvTyp := typ.type;
 
-    Bi.MkDummyClass("Delegate", blk, Ty.extns, del);
+    Bi.MkDummyClass("Delegate", sysBlk, Ty.extns, del);
     Bi.SetPtrBase(del, obj);
-    Bi.MkDummyClass("MulticastDelegate", blk, Ty.extns, evt);
+    Bi.MkDummyClass("MulticastDelegate", sysBlk, Ty.extns, evt);
     Bi.SetPtrBase(evt, del);
     CSt.ntvEvt := evt.type;
 
     (* NEED SOME WORK HERE?? *)
 
-    Bi.MkDummyClass("ValueType", blk, Ty.extns, del);
+    Bi.MkDummyClass("ValueType", sysBlk, Ty.extns, del);
     Bi.SetPtrBase(del, obj);
     CSt.ntvVal := del.type.boundRecTp();
 
@@ -169,34 +182,34 @@ MODULE MsilMaker;
    (*
     *  Create import descriptor for [RTS]RTS
     *)
-    Bi.MkDummyImport("RTS", "[RTS]", blk);
-    Bi.MkDummyAlias("NativeType", blk, typ.type, CSt.clsId);
-    Bi.MkDummyAlias("NativeObject", blk, obj.type, CSt.objId);
-    Bi.MkDummyAlias("NativeString", blk, str.type, CSt.strId);
-    Bi.MkDummyAlias("NativeException", blk, exc.type, CSt.excId);
-    INCL(blk.xAttr, Sy.need);
-    CSt.rtsBlk := blk;
+    Bi.MkDummyImport("RTS", "[RTS]", tmpBlk);
+    Bi.MkDummyAlias("NativeType", tmpBlk, typ.type, CSt.clsId);
+    Bi.MkDummyAlias("NativeObject", tmpBlk, obj.type, CSt.objId);
+    Bi.MkDummyAlias("NativeString", tmpBlk, str.type, CSt.strId);
+    Bi.MkDummyAlias("NativeException", tmpBlk, exc.type, CSt.excId);
+    INCL(tmpBlk.xAttr, Sy.need);
+    CSt.rtsBlk := tmpBlk;
    (*
     *  Uplevel addressing stuff. This is part of RTS assembly.
     *)
-    Bi.MkDummyClass("XHR", blk, Ty.isAbs, typ);
+    Bi.MkDummyClass("XHR", tmpBlk, Ty.isAbs, typ);
     CSt.rtsXHR := typ.type;
     CSt.xhrId.recTyp := CSt.rtsXHR.boundRecTp();
     CSt.xhrId.type   := CSt.rtsXHR;
    (*
     *  Access to [RTS]RTS::dblPosInfinity, etc.
     *)
-    Bi.MkDummyVar("dblPosInfinity", blk, Bi.realTp, CSt.dblInf);
-    Bi.MkDummyVar("dblNegInfinity", blk, Bi.realTp, CSt.dblNInf);
-    Bi.MkDummyVar("fltPosInfinity", blk, Bi.sReaTp, CSt.fltInf);
-    Bi.MkDummyVar("fltNegInfinity", blk, Bi.sReaTp, CSt.fltNInf);
+    Bi.MkDummyVar("dblPosInfinity", tmpBlk, Bi.realTp, CSt.dblInf);
+    Bi.MkDummyVar("dblNegInfinity", tmpBlk, Bi.realTp, CSt.dblNInf);
+    Bi.MkDummyVar("fltPosInfinity", tmpBlk, Bi.sReaTp, CSt.fltInf);
+    Bi.MkDummyVar("fltNegInfinity", tmpBlk, Bi.sReaTp, CSt.fltNInf);
    (*
     *  Access to [RTS]ProgArgs::argList
     *)
-    Bi.MkDummyImport("ProgArgs", "", blk);
-    Bi.MkDummyVar("argList", blk, Ty.mkArrayOf(CSt.ntvStr), CSt.argLst);
-    INCL(blk.xAttr, Sy.rtsMd);
-    CSt.prgArg := blk;
+    Bi.MkDummyImport("ProgArgs", "", tmpBlk);
+    Bi.MkDummyVar("argList", tmpBlk, Ty.mkArrayOf(CSt.ntvStr), CSt.argLst);
+    INCL(tmpBlk.xAttr, Sy.rtsMd);
+    CSt.prgArg := tmpBlk;
   END Init;
 
 (* ============================================================ *)
@@ -1586,7 +1599,6 @@ MODULE MsilMaker;
 	    *)
         out.Code(Asm.opc_shr);
 	  ELSE (* ==> kind = lshInt *)
-	  (* FIXME *)
 	    out.Code(Asm.opc_dup);            (* TOS: rOp, rOp, lOp, ...       *)
 	    out.StoreLocal(temp);             (* TOS: rOp, lOp, ...            *)
 	    out.PushInt(maskSz+1);            (* TOS: 32, rOp, lOp, ...        *)

gpcp/NameHash.cp

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

gpcp/NewSymFileRW.cp

@@ -1,9 +1,10 @@
 
+
 (* ==================================================================== *)
-(*									*)
-(*  SymFileRW:  Symbol-file reading and writing for GPCP.		*)
-(*	Copyright (c) John Gough 1999 -- 2017.				*)
-(*									*)
+(*                                                                      *)
+(*  SymFileRW:  Symbol-file reading and writing for GPCP.               *)
+(*          Copyright (c) John Gough 1999 -- 2018.                      *)
+(*                                                                      *)
 (* ==================================================================== *)
 
 MODULE NewSymFileRW;
@@ -32,48 +33,48 @@ MODULE NewSymFileRW;
 // 
 // SymFile    = Header [String (falSy | truSy | <other attribute>)]
 //              [ VersionName ]
-//		{Import | Constant | Variable | Type | Procedure} 
-//		TypeList Key.
-//	-- optional String is external name.
-//	-- falSy ==> Java class
-//	-- truSy ==> Java interface
-//	-- others ...
+//              {Import | Constant | Variable | Type | Procedure} 
+//              TypeList Key.
+//    -- optional String is external name.
+//    -- falSy ==> Java class
+//    -- truSy ==> Java interface
+//    -- others ...
 // Header     = magic modSy Name.
 // VersionName= numSy longint numSy longint numSy longint.
 //      --            mj# mn#       bld rv#    8xbyte extract
 // Import     = impSy Name [String] Key.
-//	-- optional string is explicit external name of class
+//    -- optional string is explicit external name of class
 // Constant   = conSy Name Literal.
 // Variable   = varSy Name TypeOrd.
 // Type       = typSy Name TypeOrd.
 // Procedure  = prcSy Name [String] FormalType.
-//	-- optional string is explicit external name of procedure
+//    -- optional string is explicit external name of procedure
 // Method     = mthSy Name byte byte TypeOrd [String] [Name] FormalType.
-//	-- optional string is explicit external name of method
+//    -- optional string is explicit external name of method
 // FormalType = [retSy TypeOrd] frmSy {parSy byte TypeOrd [String]} endFm.
-//	-- optional phrase is return type for proper procedures
+//    -- optional phrase is return type for proper procedures
 // TypeOrd    = ordinal.
 // TypeHeader = tDefS Ord [fromS Ord Name].
-//	-- optional phrase occurs if:
-//	-- type not from this module, i.e. indirect export
+//    -- optional phrase occurs if:
+//    -- type not from this module, i.e. indirect export
 // TypeList   = start { Array | Record | Pointer | ProcType | 
 //                Enum | Vector | NamedType } close.
 // Array      = TypeHeader arrSy TypeOrd (Byte | Number | <empty>) endAr.
-//	-- nullable phrase is array length for fixed length arrays
+//    -- nullable phrase is array length for fixed length arrays
 // Vector     = TypeHeader vecSy TypeOrd endAr.
 // Pointer    = TypeHeader ptrSy TypeOrd.
 // Event      = TypeHeader evtSy FormalType.
 // ProcType   = TypeHeader pTpSy FormalType.
 // Record     = TypeHeader recSy recAtt [truSy | falSy] 
-//		[basSy TypeOrd] [iFcSy {basSy TypeOrd}]
-//		{Name TypeOrd} {Method} {Statics} endRc.
-//	-- truSy ==> is an extension of external interface
-//	-- falSy ==> is an extension of external class
-// 	-- basSy option defines base type, if not ANY / j.l.Object
+//        [basSy TypeOrd] [iFcSy {basSy TypeOrd}]
+//        {Name TypeOrd} {Method} {Statics} endRc.
+//    -- truSy ==> is an extension of external interface
+//    -- falSy ==> is an extension of external class
+//     -- basSy option defines base type, if not ANY / j.l.Object
 // Statics    = ( Constant | Variable | Procedure ).
 // Enum       = TypeHeader eTpSy { Constant } endRc.
 // NamedType  = TypeHeader.
-// Name	      = namSy byte UTFstring.
+// Name       = namSy byte UTFstring.
 // Literal    = Number | String | Set | Char | Real | falSy | truSy.
 // Byte       = bytSy byte.
 // String     = strSy UTFstring.
@@ -118,37 +119,39 @@ MODULE NewSymFileRW;
         dumped* = -1;
         buffDefault = 1024;
 
+        logPrefix = "Rlog ";
+
 (* ============================================================ *)
 
   TYPE
         SymFile = POINTER TO RECORD 
-        	    file : BF.FILE;
-        	    cSum : INTEGER;
-        	    modS : Id.BlkId;
-        	    iNxt : INTEGER;
-        	    oNxt : INTEGER;
-        	    work : D.TypeSeq;
+                    file : BF.FILE;
+                    cSum : INTEGER;
+                    modS : Id.BlkId;
+                    iNxt : INTEGER;
+                    oNxt : INTEGER;
+                    work : D.TypeSeq;
                     (* Recycled scratch area *)
                     buff : POINTER TO ARRAY OF UBYTE; 
-        	  END;
+                  END;
 
   TYPE
         SymFileReader* = POINTER TO RECORD
-        	    file  : BF.FILE;
-        	    modS  : Id.BlkId;
-        	    impS  : Id.BlkId;
-        	    sSym  : INTEGER;
-        	    cAtt  : CHAR;
-        	    iAtt  : INTEGER;
-        	    lAtt  : LONGINT;
-        	    rAtt  : REAL;
-                    rScp  : ImpResScope;
-        	    strLen : INTEGER;
-        	    strAtt : Lt.CharOpen;
-                    oArray : D.IdSeq;
-        	    sArray : D.ScpSeq;		(* These two sequences	*)
-  		    tArray : D.TypeSeq;		(* must be private as   *)
-        	  END;				(* file parses overlap. *)
+             file  : BF.FILE;
+             modS  : Id.BlkId;
+             impS  : Id.BlkId;
+             sSym  : INTEGER;
+             cAtt  : CHAR;
+             iAtt  : INTEGER;
+             lAtt  : LONGINT;
+             rAtt  : REAL;
+             rScp  : ImpResScope;
+             strLen : INTEGER;
+             strAtt : Lt.CharOpen;
+             oArray : D.IdSeq;
+             sArray : D.ScpSeq;   (* These two sequences  *)
+             tArray : D.TypeSeq;  (* must be private as   *)
+           END;                   (* file parses overlap. *)
 
 (* ============================================================ *)
 
@@ -159,15 +162,17 @@ MODULE NewSymFileRW;
 
 (* ============================================================ *)
 
-  TYPE	TypeLinker*  = POINTER TO RECORD (D.SymForAll) sym : SymFileReader END;
-  TYPE	SymFileSFA*  = POINTER TO RECORD (D.SymForAll) sym : SymFile END;
-  TYPE	ResolveAll*  = POINTER TO RECORD (D.SymForAll) END;
+  TYPE TypeLinker*  = POINTER TO RECORD (D.SymForAll) sym : SymFileReader END;
+  TYPE SymFileSFA*  = POINTER TO RECORD (D.SymForAll) sym : SymFile END;
+  TYPE ResolveAll*  = POINTER TO RECORD (D.SymForAll) END;
 
 (* ============================================================ *)
 
-  VAR   lastKey : INTEGER;	(* private state for CPMake *)
+  VAR   lastKey : INTEGER; (* private state for CPMake *)
         fSepArr : ARRAY 2 OF CHAR;
 
+  PROCEDURE^ (f : SymFile)EmitType(type : D.Type),NEW;
+
 (* ============================================================ *)
 
   PROCEDURE GetLastKeyVal*() : INTEGER;
@@ -226,12 +231,12 @@ MODULE NewSymFileRW;
     idx := 0;
     chr := ORD(nam[0]);
     WHILE chr # 0H DO
-      IF    chr <= 7FH THEN 		(* [0xxxxxxx] *)
+      IF    chr <= 7FH THEN          (* [0xxxxxxx] *)
         f.buff[num] := USHORT(chr); INC(num);
-      ELSIF chr <= 7FFH THEN 		(* [110xxxxx,10xxxxxx] *)
+      ELSIF chr <= 7FFH THEN         (* [110xxxxx,10xxxxxx] *)
         f.buff[num+1] := USHORT(080H + chr MOD 64); chr := chr DIV 64;
         f.buff[num  ] := USHORT(0C0H + chr); INC(num, 2);
-      ELSE 				(* [1110xxxx,10xxxxxx,10xxxxxxx] *)
+      ELSE                           (* [1110xxxx,10xxxxxx,10xxxxxxx] *)
         f.buff[num+2] := USHORT(080H + chr MOD 64); chr := chr DIV 64;
         f.buff[num+1] := USHORT(080H + chr MOD 64); chr := chr DIV 64;
         f.buff[num  ] := USHORT(0E0H + chr); INC(num, 3);
@@ -269,12 +274,12 @@ MODULE NewSymFileRW;
       IF chr = 0 THEN         (* [11000000, 10000000] *)
         f.buff[num+1] := 080H; 
         f.buff[num  ] := 0C0H; INC(num, 2);
-      ELSIF chr <= 7FH THEN 		(* [0xxxxxxx] *)
+      ELSIF chr <= 7FH THEN         (* [0xxxxxxx] *)
         f.buff[num  ] := USHORT(chr); INC(num);
-      ELSIF chr <= 7FFH THEN 		(* [110xxxxx,10xxxxxx] *)
+      ELSIF chr <= 7FFH THEN        (* [110xxxxx,10xxxxxx] *)
         f.buff[num+1] := USHORT(080H + chr MOD 64); chr := chr DIV 64;
         f.buff[num  ] := USHORT(0C0H + chr); INC(num, 2);
-      ELSE 				(* [1110xxxx,10xxxxxx,10xxxxxxx] *)
+      ELSE                          (* [1110xxxx,10xxxxxx,10xxxxxxx] *)
         f.buff[num+2] := USHORT(080H + chr MOD 64); chr := chr DIV 64;
         f.buff[num+1] := USHORT(080H + chr MOD 64); chr := chr DIV 64;
         f.buff[num  ] := USHORT(0E0H + chr); INC(num, 3);
@@ -304,10 +309,12 @@ MODULE NewSymFileRW;
 (* ======================================= *)
 
   PROCEDURE (f : SymFile)WriteNameForId(idD : D.Idnt),NEW;
+    VAR name : Lt.CharOpen;
   BEGIN
+    name := Nh.charOpenOfHash(idD.hash);
     f.Write(namSy); 
-    f.Write(idD.vMod); 
-    f.WriteNameUTF(Nh.charOpenOfHash(idD.hash));
+    f.Write(idD.vMod);
+    f.WriteNameUTF(name);
   END WriteNameForId;
 
 (* ======================================= *)
@@ -373,8 +380,8 @@ MODULE NewSymFileRW;
     IF ord <= 7FH THEN 
       f.Write(ord);
     ELSIF ord <= 7FFFH THEN
-      f.Write(128 + ord MOD 128);	(* LS7-bits first *)
-      f.Write(ord DIV 128);		(* MS8-bits next  *)
+      f.Write(128 + ord MOD 128);  (* LS7-bits first *)
+      f.Write(ord DIV 128);        (* MS8-bits next  *)
     ELSE
       ASSERT(FALSE);
     END;
@@ -417,9 +424,9 @@ MODULE NewSymFileRW;
         *)
         IF (t.bindTp # NIL) & 
            (t.bindTp.dump = 0) THEN 
-          AddToWorklist(f, t.bindTp);		(* First the pointer...  *)
+          AddToWorklist(f, t.bindTp);   (* First the pointer...  *)
         END;
-        AddToWorklist(f, t);			(* Then this record type *)
+        AddToWorklist(f, t);            (* Then this record type *)
       | t : Ty.Pointer DO
        (*
         *  If a pointer to record is being emitted, and 
@@ -430,17 +437,17 @@ MODULE NewSymFileRW;
         *  relationship between the pointer and record.
         *  (It is possible that DCode need record size.)
         *)
-        AddToWorklist(f, t);			(* First this pointer... *)
+        AddToWorklist(f, t);            (* First this pointer... *)
         IF (t.boundTp # NIL) & 
            (t.boundTp.dump = 0) &
            (t.boundTp IS Ty.Record) THEN
           recT := t.boundTp(Ty.Record);
           IF recT.bindTp = NIL THEN
-            AddToWorklist(f, t.boundTp);	(* Then the record type  *)
+            AddToWorklist(f, t.boundTp);    (* Then the record type  *)
           END;
         END;
       ELSE (* All others *)
-        AddToWorklist(f, t);			(* Just add the type.    *)
+        AddToWorklist(f, t);            (* Just add the type.    *)
       END;
     END;
     f.WriteOrd(t.dump);
@@ -537,6 +544,7 @@ MODULE NewSymFileRW;
   ** Import = impSy Name.
   *)
   BEGIN
+    IF id.namStr = NIL THEN id.SetNameFromHash(id.hash) END;
     IF D.need IN id.xAttr THEN
       f.Write(impSy);
       f.WriteNameForId(id);
@@ -668,6 +676,12 @@ MODULE NewSymFileRW;
       f.Write(fromS);
       f.WriteOrd(mod);
       f.WriteNameForId(idt);
+	  IF (mod > (f.iNxt - 1)) OR (mod < 0) THEN
+	    Console.WriteString(idt.dfScp.namStr); 
+		Console.Write(".");
+		Console.WriteString(idt.namStr);
+		Console.WriteLn;
+	  END;
     END;
   END EmitTypeHeader;
 
@@ -677,9 +691,6 @@ MODULE NewSymFileRW;
   BEGIN
     f.EmitTypeHeader(t);
     IF ~f.isImportedArray(t) THEN
-(*
- *  IF t.force # D.noEmit THEN	(* Don't emit structure unless forced *)
- *)
       IF t.kind = Ty.vecTp THEN f.Write(vecSy) ELSE f.Write(arrSy) END;
       f.EmitTypeOrd(t.elemTp);
       IF t.length > 127 THEN
@@ -701,15 +712,12 @@ MODULE NewSymFileRW;
         method : D.Idnt;
   (*
   **  Record = TypeHeader recSy recAtt [truSy | falSy | <others>] 
-  **		[basSy TypeOrd] [iFcSy {basSy TypeOrd}]
-  **		{Name TypeOrd} {Method} {Statics} endRc.
+  **        [basSy TypeOrd] [iFcSy {basSy TypeOrd}]
+  **        {Name TypeOrd} {Method} {Statics} endRc.
   *)
   BEGIN
     f.EmitTypeHeader(t);
     IF ~f.isImportedRecord(t) THEN
-(*
- *  IF t.force # D.noEmit THEN	(* Don't emit structure unless forced *)
- *)
       f.Write(recSy);
       index := t.recAtt; 
       IF D.noNew IN t.xAttr THEN INC(index, Ty.noNew) END;
@@ -717,19 +725,19 @@ MODULE NewSymFileRW;
       f.Write(index);
    (* ########## *)
       IF t.recAtt = Ty.iFace THEN
-  	f.Write(truSy);
+        f.Write(truSy);
       ELSIF CSt.special OR (D.isFn IN t.xAttr) THEN  
         f.Write(falSy);
       END;
    (* ########## *)
-      IF t.baseTp # NIL THEN			(* this is the parent type *)
+      IF t.baseTp # NIL THEN              (* this is the parent type *)
         f.Write(basSy);
         f.EmitTypeOrd(t.baseTp);
       END;
    (* ########## *)
       IF t.interfaces.tide > 0 THEN
         f.Write(iFcSy);
-        FOR index := 0 TO t.interfaces.tide-1 DO	(* any interfaces  *)
+        FOR index := 0 TO t.interfaces.tide-1 DO    (* any interfaces  *)
           f.Write(basSy);
           f.EmitTypeOrd(t.interfaces.a[index]);
         END;
@@ -796,10 +804,6 @@ MODULE NewSymFileRW;
   BEGIN
     f.EmitTypeHeader(t);
     IF ~f.isImportedPointer(t) THEN
-(*
- *  IF (t.force # D.noEmit) OR 			(* Only emit structure if *)
- *     (t.boundTp.force # D.noEmit) THEN	(* ptr or boundTp forced. *)
- *)
       f.Write(ptrSy);
       f.EmitTypeOrd(t.boundTp);
     END;
@@ -817,6 +821,18 @@ MODULE NewSymFileRW;
 
 (* ======================================= *)
 
+  PROCEDURE (f : SymFile)EmitType(type : D.Type),NEW;
+  BEGIN
+    WITH type : Ty.Array     DO f.EmitArrOrVecType(type);
+    |    type : Ty.Record    DO f.EmitRecordType(type);
+    |    type : Ty.Opaque    DO f.EmitOpaqueType(type);
+    |    type : Ty.Pointer   DO f.EmitPointerType(type);
+    |    type : Ty.Procedure DO f.EmitProcedureType(type);
+    |    type : Ty.Enum      DO f.EmitEnumType(type);
+    END;
+  END EmitType;
+
+
   PROCEDURE (f : SymFile)EmitTypeList(),NEW;
     VAR indx : INTEGER;
         type : D.Type;
@@ -824,17 +840,11 @@ MODULE NewSymFileRW;
    (*
     *   We cannot use a FOR loop here, as the tide changes
     *   during evaluation, as a result of reaching new types.
+    *   (This comment may not be true for the Reflection reader)
     *)
     indx := 0;
     WHILE indx < f.work.tide DO
-      type := f.work.a[indx];
-      WITH type : Ty.Array     DO f.EmitArrOrVecType(type);
-      |    type : Ty.Record    DO f.EmitRecordType(type);
-      |    type : Ty.Opaque    DO f.EmitOpaqueType(type);
-      |    type : Ty.Pointer   DO f.EmitPointerType(type);
-      |    type : Ty.Procedure DO f.EmitProcedureType(type);
-      |    type : Ty.Enum      DO f.EmitEnumType(type);
-      END;
+      f.EmitType(f.work.a[indx]);
       INC(indx);
     END;
   END EmitTypeList;
@@ -863,8 +873,8 @@ MODULE NewSymFileRW;
   (*
   ** SymFile = Header [String (falSy | truSy | <others>)]
   **            [ VersionName]
-  **		{Import | Constant | Variable
-  **                 | Type | Procedure | Method} TypeList.
+  **            {Import | Constant | Variable
+  **             | Type | Procedure | Method} TypeList.
   ** Header = magic modSy Name.
   ** VersionName= numSy longint numSy longint numSy longint.
   **      --            mj# mn#       bld rv#        8xbyte extract
@@ -894,9 +904,9 @@ MODULE NewSymFileRW;
       IF CSt.verbose THEN CSt.Message("Created " + fNamePtr^) END;
      (* End of alternative gpcp1.2 code *)
       IF D.rtsMd IN m.xAttr THEN
-        marker := RTS.loInt(syMag);	(* ==> a system module *)
+        marker := RTS.loInt(syMag);    (* ==> a system module *)
       ELSE
-        marker := RTS.loInt(magic);	(* ==> a normal module *)
+        marker := RTS.loInt(magic);    (* ==> a normal module *)
       END;
       symfile.Write4B(RTS.loInt(marker));
       symfile.Write(modSy);
@@ -976,9 +986,9 @@ MODULE NewSymFileRW;
     idx := 0;
     WHILE idx < len DO
       chr := read(fil); INC(idx);
-      IF chr <= 07FH THEN		(* [0xxxxxxx] *)
+      IF chr <= 07FH THEN            (* [0xxxxxxx] *)
         rdr.strAtt[num] := CHR(chr); INC(num);
-      ELSIF chr DIV 32 = 06H THEN	(* [110xxxxx,10xxxxxx] *)
+      ELSIF chr DIV 32 = 06H THEN    (* [110xxxxx,10xxxxxx] *)
         bNm := chr MOD 32 * 64;
         chr := read(fil); INC(idx);
         IF chr DIV 64 = 02H THEN
@@ -986,7 +996,7 @@ MODULE NewSymFileRW;
         ELSE
           RTS.Throw(bad);
         END;
-      ELSIF chr DIV 16 = 0EH THEN	(* [1110xxxx,10xxxxxx,10xxxxxxx] *)
+      ELSIF chr DIV 16 = 0EH THEN    (* [1110xxxx,10xxxxxx,10xxxxxxx] *)
         bNm := chr MOD 16 * 64;
         chr := read(fil); INC(idx);
         IF chr DIV 64 = 02H THEN
@@ -1131,18 +1141,6 @@ MODULE NewSymFileRW;
         token    : S.Token;
         index    : INTEGER;
         
-    PROCEDURE NameAndKey(idnt : D.Scope) : Lt.CharOpen;
-      VAR name : Lt.CharOpen;
-          keyV : INTEGER;
-    BEGIN
-      WITH idnt : Id.BlkId DO
-        RETURN BOX(Nh.charOpenOfHash(idnt.hash)^ + 
-                   " : "  + Lt.intToCharOpen(idnt.modKey)^);
-      ELSE
-        RETURN BOX("bad idnt");
-      END; 
-    END NameAndKey;
-    
   BEGIN
     message := NIL;
     token := scope.token;
@@ -1169,12 +1167,10 @@ MODULE NewSymFileRW;
       S.SemError.RepSt1(129, BOX(filNm^ + ".cps"), token.lin, token.col); 
       RETURN;
     ELSE
-      IF CSt.verbose THEN 
-        IF D.weak IN scope.xAttr THEN
-          message := BOX("Implicit import " + filNm^);
-        ELSE
-          message := BOX("Explicit import " + filNm^);
-        END;
+      IF D.weak IN scope.xAttr THEN
+        message := BOX("Implicit import " + filNm^);
+      ELSE
+        message := BOX("Explicit import " + filNm^);
       END;
       marker := readInt(f.file);
       IF marker = RTS.loInt(magic) THEN
@@ -1188,13 +1184,6 @@ MODULE NewSymFileRW;
       END;
       f.GetSym();
       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;
-      END;
       BF.CloseFile(f.file);
     END;
   END Parse;
@@ -1216,7 +1205,7 @@ MODULE NewSymFileRW;
     IF sc.symTb.enter(id.hash, id) THEN
       ident := id;
     ELSE
-      ident := sc.symTb.lookup(id.hash);	(* Warp the return Idnt	*)
+      ident := sc.symTb.lookup(id.hash);    (* Warp the return Idnt    *)
       IF ident.kind # id.kind THEN Report(id, sc); ident := id END;
     END;
     RETURN ident;
@@ -1236,7 +1225,7 @@ MODULE NewSymFileRW;
 
   BEGIN
     IF ~tb.enter(id.hash, id) THEN
-      ident := tb.lookup(id.hash);		(* and test isForeign? *)
+      ident := tb.lookup(id.hash);        (* and test isForeign? *)
       IF ident.kind # id.kind THEN Report(id) END;
     END;
   END Insert;
@@ -1253,10 +1242,6 @@ MODULE NewSymFileRW;
       VAR iS, sS : FileNames.NameString;
     BEGIN
       D.getName.Of(i, iS);
-(*
- *    D.getName.Of(s, sS);
- *    S.SemError.RepSt2(172, iS, sS, S.line, S.col);
- *)
       S.SemError.RepSt2(172, iS, s, S.line, S.col);
     END Report;
 
@@ -1280,7 +1265,7 @@ MODULE NewSymFileRW;
     | setSy : expr := ExprDesc.mkSetLt(BITS(f.iAtt));
     | strSy : expr := ExprDesc.mkStrLenLt(f.strAtt, f.strLen);
     END;
-    f.GetSym();						(* read past value  *)
+    f.GetSym();                        (* read past value  *)
     RETURN expr;
   END getLiteral;
 
@@ -1290,14 +1275,14 @@ MODULE NewSymFileRW;
     VAR newT : D.Type;
         indx : INTEGER;
   BEGIN
-    IF ord < D.tOffset THEN				(* builtin type	*)	
+    IF ord < D.tOffset THEN                    (* builtin type    *)    
       RETURN B.baseTypeArray[ord];
     ELSIF ord - D.tOffset < f.tArray.tide THEN
       RETURN f.tArray.a[ord - D.tOffset];
     ELSE 
       indx := f.tArray.tide + D.tOffset;
       REPEAT
-        newT := Ty.newTmpTp();
+        newT := Ty.newTmpTp();                 (* a placeholder *)
         newT.dump := indx; INC(indx);
         D.AppendType(f.tArray, newT);
       UNTIL indx > ord;
@@ -1318,10 +1303,10 @@ MODULE NewSymFileRW;
 (* ============================================ *)
 
   PROCEDURE (f : SymFileReader)getFormalType(rslt : Ty.Procedure;
-        				     indx : INTEGER) : D.Type,NEW;
+                                             indx : INTEGER) : D.Type,NEW;
   (*
   ** FormalType = [retSy TypeOrd] frmSy {parSy Byte TypeOrd [String]} endFm.
-  //	-- optional phrase is return type for proper procedures
+  //    -- optional phrase is return type for proper procedures
   *)
     VAR parD : Id.ParId;
         byte : INTEGER;
@@ -1337,6 +1322,7 @@ MODULE NewSymFileRW;
       parD.parMod := byte;
       parD.varOrd := indx; 
       parD.type := f.getTypeFromOrd();
+
      (* Skip over optional parameter name string *)
       IF f.sSym = strSy THEN (* parD.hash := Nh.enterStr(f.strAtt); *)
         f.GetSym;
@@ -1351,8 +1337,8 @@ MODULE NewSymFileRW;
 (* ============================================ *)
 
   PROCEDURE (f : SymFileReader)pointerType(old : D.Type) : D.Type,NEW;
-  (* Assert: the current symbol ptrSy 		*)
-  (* Pointer   = TypeHeader ptrSy TypeOrd.	*)
+  (* Assert: the current symbol ptrSy         *)
+  (* Pointer   = TypeHeader ptrSy TypeOrd.    *)
     VAR rslt : Ty.Pointer;
         indx : INTEGER;
         junk : D.Type;
@@ -1382,29 +1368,29 @@ MODULE NewSymFileRW;
 (* ============================================ *)
 
   PROCEDURE (f : SymFileReader)procedureType() : D.Type,NEW;
-  (* Assert: the current symbol is pTpSy.	*)
-  (* ProcType  = TypeHeader pTpSy FormalType.	*)
+  (* Assert: the current symbol is pTpSy.     *)
+  (* ProcType  = TypeHeader pTpSy FormalType. *)
   BEGIN
-    f.GetSym();		(* read past pTpSy *)
+    f.GetSym();        (* read past pTpSy *)
     RETURN f.getFormalType(Ty.newPrcTp(), 0);
   END procedureType;
 
 (* ============================================ *)
 
   PROCEDURE (f : SymFileReader)eventType() : D.Type,NEW;
-  (* Assert: the current symbol is evtSy.	*)
-  (* EventType = TypeHeader evtSy FormalType.	*)
+  (* Assert: the current symbol is evtSy.    *)
+  (* EventType = TypeHeader evtSy FormalType.    *)
   BEGIN
-    f.GetSym();		(* read past evtSy *)
+    f.GetSym();        (* read past evtSy *)
     RETURN f.getFormalType(Ty.newEvtTp(), 0);
   END eventType;
 
 (* ============================================ *)
 
   PROCEDURE (f : SymFileReader)arrayType() : Ty.Array,NEW;
-  (* Assert: at entry the current symbol is arrSy.		     *)
+  (* Assert: at entry the current symbol is arrSy.             *)
   (* Array      = TypeHeader arrSy TypeOrd (Byte | Number | ) endAr. *)
-  (*	-- nullable phrase is array length for fixed length arrays   *)
+  (*    -- nullable phrase is array length for fixed length arrays   *)
     VAR rslt : Ty.Array;
         eTyp : D.Type;
   BEGIN
@@ -1449,10 +1435,10 @@ MODULE NewSymFileRW;
   *  Read a record type from the symbol file.
   *)
   PROCEDURE (f : SymFileReader)recordType(old  : D.Type) : D.Type,NEW;
-  (* Assert: at entry the current symbol is recSy.			*)
-  (* Record     = TypeHeader recSy recAtt [truSy | falSy | <others>] 	*)
-  (*	[basSy TypeOrd] [iFcSy {basSy TypeOrd}]				*)
-  (*	{Name TypeOrd} {Method} {Statics} endRc.			*)
+  (* Assert: at entry the current symbol is recSy.            *)
+  (* Record     = TypeHeader recSy recAtt [truSy | falSy | <others>]     *)
+  (*    [basSy TypeOrd] [iFcSy {basSy TypeOrd}]                *)
+  (*    {Name TypeOrd} {Method} {Statics} endRc.            *)
     CONST 
         vlTp = Ty.valRc;
     VAR rslt : Ty.Record;
@@ -1479,7 +1465,7 @@ MODULE NewSymFileRW;
     IF attr >= Ty.noNew THEN DEC(attr,Ty.noNew); INCL(rslt.xAttr,D.noNew) END;
 
     rslt.recAtt := attr;
-    f.GetSym();				(* Get past recSy rAtt	*)
+    f.GetSym();                (* Get past recSy rAtt    *)
     IF f.sSym = falSy THEN
       INCL(rslt.xAttr, D.isFn);  (* This record type is foreign *)
       f.GetSym();
@@ -1502,10 +1488,10 @@ MODULE NewSymFileRW;
       *  Do not override baseTp values set
       *  by *Maker.Init for Native* types.
       *)
-	  IF rslt.baseTp = NIL THEN
+      IF rslt.baseTp = NIL THEN
         rslt.baseTp := f.typeOf(f.iAtt);
         IF f.iAtt # Ty.anyRec THEN INCL(rslt.xAttr, D.clsTp) END;
-	  END;
+      END;
       f.GetSym();
     END;
     IF f.sSym = iFcSy THEN
@@ -1573,13 +1559,13 @@ MODULE NewSymFileRW;
 (* ============================================ *)
 
   PROCEDURE (f : SymFileReader)enumType() : D.Type,NEW;
-  (* Assert: at entry the current symbol is eTpSy.			*)
-  (* Enum  = TypeHeader eTpSy { Constant} endRc.			*)
+  (* Assert: at entry the current symbol is eTpSy.            *)
+  (* Enum  = TypeHeader eTpSy { Constant} endRc.            *)
     VAR rslt : Ty.Enum;
         cnst : D.Idnt;
   BEGIN
     rslt := Ty.newEnuTp();
-    f.GetSym();				(* Get past recSy 	*)
+    f.GetSym();                (* Get past recSy     *)
     WHILE f.sSym = conSy DO
       f.GetSym();
       cnst := f.constant();
@@ -1593,14 +1579,14 @@ MODULE NewSymFileRW;
 (* ============================================ *)
 
   PROCEDURE (f : SymFileReader)Type(),NEW;
-  (* Type       = typSy Name TypeOrd.		*)
+  (* Type       = typSy Name TypeOrd.        *)
     VAR newI : Id.TypId;
         oldI : D.Idnt;
         type : D.Type;
   BEGIN
    (* 
     * Post: every previously unknown typId 'id'
-    *	has the property:  id.type.idnt = id.
+    *   has the property:  id.type.idnt = id.
     *   If oldI # newT, then the new typId has
     *   newT.type.idnt = oldI.
     *)
@@ -1610,7 +1596,6 @@ MODULE NewSymFileRW;
     newI.type := f.getTypeFromOrd(); 
     newI.dfScp := f.impS;
     oldI := testInsert(newI, f.impS);
-
     IF oldI # newI THEN 
       f.tArray.a[newI.type.dump - D.tOffset] := oldI.type;
     END;
@@ -1626,28 +1611,28 @@ MODULE NewSymFileRW;
 (* ============================================ *)
 
   PROCEDURE (f : SymFileReader)Import(),NEW;
-  (* Import     = impSy Name [String] Key.	*)
-  (*	-- optional string is external name	*)
-  (* first symbol should be namSy here.		*)
+  (* Import     = impSy Name [String] Key.    *)
+  (*    -- optional string is external name    *)
+  (* first symbol should be namSy here.        *)
     VAR impD : Id.BlkId;
         oldS : Id.BlkId;
         oldD : D.Idnt;
   BEGIN
     impD := Id.newImpId();
-    impD.dfScp := impD;			(* ImpId define their own scope *)
+    impD.dfScp := impD;            (* ImpId define their own scope *)
 
     INCL(impD.xAttr, D.weak);
     impD.SetMode(f.iAtt);
     impD.hash := Nh.enterStr(f.strAtt);
     f.ReadPast(namSy); 
-    IF impD.hash = f.modS.hash THEN	(* Importing own imp indirectly	*)
-        				(* Shouldn't this be an error?  *)
+    IF impD.hash = f.modS.hash THEN    (* Importing own imp indirectly    *)
+                        (* Shouldn't this be an error?  *)
       D.AppendScope(f.sArray, f.modS);
       IF f.sSym = strSy THEN 
         (* probably don't need to do anything here ... *)
         f.GetSym();
       END;
-    ELSE				(* Importing some other module.	*)
+    ELSE                (* Importing some other module.    *)
       oldD := testInsert(impD, f.modS);
       IF f.sSym = strSy THEN 
         impD.scopeNm := Lt.arrToCharOpen(f.strAtt, f.strLen);
@@ -1657,9 +1642,9 @@ MODULE NewSymFileRW;
         oldS := oldD(Id.BlkId);
         D.AppendScope(f.sArray, oldS);
         IF (oldS.modKey # 0) & (f.iAtt # oldS.modKey) THEN
-          S.SemError.RepSt1(133,		(* Detected bad KeyVal	*)
-        	Nh.charOpenOfHash(impD.hash)^, 
-        	S.line, S.col);
+          S.SemError.RepSt1(133,        (* Detected bad KeyVal    *)
+            Nh.charOpenOfHash(impD.hash)^, 
+            S.line, S.col);
         END;
       ELSE
         D.AppendScope(f.sArray, impD);
@@ -1672,9 +1657,9 @@ MODULE NewSymFileRW;
 (* ============================================ *)
 
   PROCEDURE (f : SymFileReader)constant() : Id.ConId,NEW;
-  (* Constant = conSy Name Literal.		*)
+  (* Constant = conSy Name Literal.        *)
   (* Name     = namSy byte UTFstring.           *)
-  (* Assert: f.sSym = namSy.			*)
+  (* Assert: f.sSym = namSy.            *)
     VAR newC : Id.ConId;
         anyI : D.Idnt;
   BEGIN
@@ -1691,7 +1676,7 @@ MODULE NewSymFileRW;
 (* ============================================ *)
 
   PROCEDURE (f : SymFileReader)variable() : Id.VarId,NEW;
-  (* Variable   = varSy Name TypeOrd.		*)
+  (* Variable   = varSy Name TypeOrd.        *)
     VAR newV : Id.VarId;
         anyI : D.Idnt;
   BEGIN
@@ -1722,10 +1707,10 @@ MODULE NewSymFileRW;
      (* and leave scopeNm = NIL *)
       f.GetSym();
     END;
-    IF f.sSym = truSy THEN	(* ### this is a constructor ### *)
+    IF f.sSym = truSy THEN    (* ### this is a constructor ### *)
       f.GetSym();
       newP.setPrcKind(Id.ctorP);
-    END;			(* ### this is a constructor ### *)
+    END;            (* ### this is a constructor ### *)
     newP.type := f.getFormalType(Ty.newPrcTp(), 0);
     (* IF this is a java module, do some semantic checks *)
     (* ... *)
@@ -1779,7 +1764,7 @@ MODULE NewSymFileRW;
 
   PROCEDURE (f : SymFileReader)TypeList(),NEW;
   (* TypeList   = start { Array | Record | Pointer      *)
-  (*		  | ProcType | Vector} close.           *)
+  (*          | ProcType | Vector} close.           *)
   (* TypeHeader = tDefS Ord [fromS Ord Name].           *)
     VAR modOrd : INTEGER;
         typOrd : INTEGER;
@@ -1795,18 +1780,19 @@ MODULE NewSymFileRW;
 
    (* ================================ *)
     PROCEDURE getDetails(f : SymFileReader; p : D.Type) : D.Type;
+      VAR rslt : D.Type;
     BEGIN
       CASE f.sSym OF
-      | arrSy : RETURN f.arrayType();
-      | vecSy : RETURN f.vectorType();
-      | recSy : RETURN f.recordType(p);
-      | pTpSy : RETURN f.procedureType();
-      | evtSy : RETURN f.eventType();
-      | eTpSy : RETURN f.enumType();
-      | ptrSy : RETURN f.pointerType(p);
-      ELSE 
-                RETURN Ty.newNamTp();
+      | arrSy : rslt := f.arrayType();      
+      | vecSy : rslt := f.vectorType();     
+      | recSy : rslt := f.recordType(p); 
+      | pTpSy : rslt := f.procedureType();
+      | evtSy : rslt := f.eventType();
+      | eTpSy : rslt := f.enumType();
+      | ptrSy : rslt := f.pointerType(p);   
+      ELSE      rslt := Ty.newNamTp();      
       END;
+      RETURN rslt;
     END getDetails;
    (* ================================ *)
   BEGIN
@@ -1913,6 +1899,8 @@ MODULE NewSymFileRW;
       END;
       f.tArray.a[typIdx] := tpDesc;
     END; (* while *)
+
+
     FOR linkIx := 0 TO f.tArray.tide - 1 DO
       tpDesc := f.tArray.a[linkIx];
      (*
@@ -1935,7 +1923,7 @@ MODULE NewSymFileRW;
       *
       *    set = {D.weak}            ==> module must be imported, but is not
       *                                   on the import worklist at this stage
-      *    set = {D.weak, D.need}   ==> module must be imported, and is 
+      *    set = {D.weak, D.need}    ==> module must be imported, and is 
       *                                   already on the import worklist.
       *)
       IF tpDesc # NIL THEN
@@ -1978,8 +1966,8 @@ MODULE NewSymFileRW;
   PROCEDURE (f : SymFileReader)SymFile(IN nm : ARRAY OF CHAR),NEW;
    (*
    // SymFile    = Header [String (falSy | truSy | <others>)]
-   //		{Import | Constant | Variable | Type | Procedure} 
-   //		TypeList Key.
+   //        {Import | Constant | Variable | Type | Procedure} 
+   //        TypeList Key.
    // Header     = magic modSy Name.
    //
    //  magic has already been recognized.
@@ -2093,9 +2081,11 @@ MODULE NewSymFileRW;
 (* ============================================================ *)
 
   PROCEDURE (t : TypeLinker)Op*(id : D.Idnt);
+    VAR oldT : D.Type;
   BEGIN
     IF id.type = NIL THEN RETURN
     ELSIF id.type.kind = Ty.tmpTp THEN
+      oldT := id.type;
       id.type := Ty.update(t.sym.tArray, id.type);
     ELSE
       id.type.TypeFix(t.sym.tArray);
@@ -2110,7 +2100,10 @@ MODULE NewSymFileRW;
 
   PROCEDURE (t : ResolveAll)Op*(id : D.Idnt);
   BEGIN
-    IF id.type # NIL THEN id.type := id.type.resolve(1) END;
+    IF id.type # NIL THEN
+      IF id.namStr = NIL THEN id.SetNameFromHash(id.hash) END;
+      id.type := id.type.resolve(1);
+   END;
   END Op;
 
 (* ============================================================ *)

gpcp/PeToCps.cp

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

gpcp/Symbols.cp

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

gpcp/TypeDesc.cp

@@ -267,6 +267,26 @@ MODULE TypeDesc;
                    bndRec- : Record;
                  END;
 
+(* ============================================================ *)
+
+  PROCEDURE kindStr*(t : Sy.Type) : Lv.CharOpen;
+  BEGIN
+    CASE t.kind OF
+    | basTp : RETURN BOX("basTp");
+    | tmpTp : RETURN BOX("tmpTp");
+    | namTp : RETURN BOX("namTp");
+    | arrTp : RETURN BOX("arrTp");
+    | recTp : RETURN BOX("recTp");
+    | ptrTp : RETURN BOX("ptrTp");
+    | prcTp : RETURN BOX("prcTp");
+    | enuTp : RETURN BOX("enuTp");
+    | evtTp : RETURN BOX("evtTp");
+    | ovlTp : RETURN BOX("ovlTp");
+    | vecTp : RETURN BOX("vecTp");
+    ELSE      RETURN BOX("?typ?");
+    END;
+  END kindStr;
+
 (* ============================================================ *)
 (*               Predicates on Type extensions                  *)
 (* ============================================================ *)
@@ -1513,6 +1533,9 @@ MODULE TypeDesc;
       *  do not find it, the type just stays opaque.
       *)
       i.depth := finishMark;
+	  IF (i.idnt # NIL) & (i.idnt.namStr = NIL) THEN
+	    i.idnt.SetNameFromHash(i.idnt.hash);
+	  END;
       oldTpId := i.idnt;
       newTpId := oldTpId.dfScp.symTb.lookup(oldTpId.hash);
       IF newTpId = NIL THEN

gpcp/build.xml

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

gpcp/n2state.cp

@@ -35,7 +35,8 @@ MODULE N2State;
 
   CONST prefix = "PeToCps: ";
         abtMsg = " ... Aborting";
-        usgMsg = 'Usage: "PeToCps [options] filenames"';
+        usgMsg1 = 'Usage: "PeToCps /mscorlib [options]"';
+        usgMsg2 = '       "PeToCps [options] filenames"';
 
  (* ---------------------------------------------------------- *)
 
@@ -63,9 +64,11 @@ MODULE N2State;
         initBkt-  : INTEGER;
         srcNam-   : CharOpen;
         basNam-   : CharOpen;
-        impSeq*   : Sy.ScpSeq;
+        impSeq*   : Sy.ScpSeq;   (* All the scopes known to this PE file *)
         typSeq-   : Sy.TypeSeq;
 
+       ignoreBlk* : Id.BlkId; (* symTb for generic classes *)
+
  (* ---------------------------------------------------------- *)
 
   PROCEDURE^ AbortMsg*(IN str : ARRAY OF CHAR);
@@ -93,11 +96,11 @@ MODULE N2State;
     Nh.InitNameHash(hashSize);
     srcNam := BOX(src$);
     basNam := BOX(bas$);
-    isCorLib := (bas = "mscorlib");
-
     CompState.CreateThisMod;
     thisMod := CompState.thisMod;
 
+    NEW(ignoreBlk);
+
     Sy.ResetScpSeq(impSeq);
     ctorBkt := Nh.enterStr(".ctor");
     initBkt := Nh.enterStr("init");
@@ -112,7 +115,8 @@ MODULE N2State;
     IF Sy.refused(blk, thisMod) THEN 
       AbortMsg("BlkId insert failure -- " + Nh.charOpenOfHash(blk.hash)^);
     END;
-    Sy.AppendScope(impSeq, blk)
+	(* Append this BlkId to the global import sequence *)
+    Sy.AppendScope(impSeq, blk); 
   END BlkIdInit;
 
  (* ------------------------------------- *)
@@ -162,6 +166,7 @@ MODULE N2State;
       impB := impSeq.a[indx];
       IF impB # mod THEN
         impB.SetKind(Id.impId);
+		impB(Id.BlkId).impOrd := 0;
       END;
     END;
   END ResetBlkIdFlags;
@@ -185,6 +190,11 @@ MODULE N2State;
     IF verbose THEN Message(str) END;
   END CondMsg;
 
+  PROCEDURE VerbMsg*(IN str : ARRAY OF CHAR);
+  BEGIN
+    IF Verbose THEN Message(str) END;
+  END VerbMsg;
+
   PROCEDURE AbortMsg*(IN str : ARRAY OF CHAR);
   BEGIN
     Error.WriteString(prefix);
@@ -195,7 +205,8 @@ MODULE N2State;
     
   PROCEDURE Usage();
   BEGIN
-    Message(usgMsg); 
+    Message(usgMsg1); 
+    Message(usgMsg2); 
     Message("filenames should have explicit .EXE or .DLL extension"); 
     IF netDflt THEN
       WLn("Options: /big       ==> allocate huge hash table");
@@ -264,7 +275,10 @@ MODULE N2State;
 
   PROCEDURE ParseOption*(IN arg : ARRAY OF CHAR);
   BEGIN
-    IF    arg = "-big" THEN
+    IF    arg = "-mscorlib" THEN
+	    isCorLib := TRUE;
+		hashSize := 40000; (* for sure, mscorlib *needs* /big *)
+    ELSIF arg = "-big" THEN
         hashSize := 40000;
     ELSIF arg = "-verbose" THEN
         verbose := TRUE;

libs/csharp/PeToCpsUtils.cs

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