Changes for version 1.4.07

J2CPS/J2CPS.java

@@ -11,7 +11,9 @@ import j2cpsfiles.j2cpsfiles;
 
 public class j2cps {
 
+    static String pkgOrJar;
     static String argString;
+    static final String versionStr = "j2cps version 1.4.07 (March 2018)";
   /**
    * Main program. Takes a package name as a parameter, produces the 
    * Component Pascal symbol file.  The class-files of the package must
@@ -27,18 +29,7 @@ public class j2cps {
     MkArgString(args);
     TypeDesc.InitTypes();
     if (argLen == 0) {
-        System.err.println("j2cps version 1.4.0.2 (March 2017)");
-        System.err.println("Usage:");
-        System.err.println("java [VM-opts] j2cps.j2cps [options] PackageNameOrJarFile");
-        System.err.println("java [VM-opts] -jar j2cps.jar [options] PackageNameOrJarFile");
-        System.err.println("J2cps options may be in any order.");
-        System.err.println("  -d[st] dir => symbol file destination directory");
-        System.err.println("  -p[kg] dir => package-root directory");
-        System.err.println("  -jar       => process the named jar file");
-        System.err.println("  -s[ummary] => summary of progress");
-        System.err.println("  -v[erbose] => verbose diagnostic messages");
-        System.err.println("  -nocpsym   => only use sym-files from destination,");
-        System.err.println("                (overrides any CPSYM path setting)");
+	ShowHelp();
         System.exit(0);
     }
     else {
@@ -49,7 +40,10 @@ public class j2cps {
             /* parse options here */
             switch (argStr.charAt(1)) {
                 case 'V':
-                    if ("VERBOSE".startsWith(optString)) {
+                    if (optString.equalsIgnoreCase("version")) {
+                        System.out.println(versionStr);
+		    }
+		    else if ("VERBOSE".startsWith(optString)) {
                         ClassDesc.VERBOSE = true;
                         ClassDesc.verbose = true;
                         ClassDesc.summary = true;
@@ -57,7 +51,10 @@ public class j2cps {
                         BadOption(argStr);  
                     break;
                 case 'v':
-                    if ("verbose".startsWith(optString)) {
+                    if ("version".equals(optString)) {
+                        System.out.println(versionStr);
+		    }
+		    else if ("verbose".startsWith(optString)) {
                         ClassDesc.verbose = true;
                         ClassDesc.summary = true;
                         j2cpsfiles.SetVerbose( true );
@@ -93,6 +90,13 @@ public class j2cps {
                         System.err.println(
                             "-p option is missing package-root directory name");    
                     break;
+                case 'h':
+                case 'H':
+                    if (optString.equalsIgnoreCase("help")) {
+                        ShowHelp();
+                    } else
+                        BadOption(argStr);
+                    break;
                 case 'j':
                     if (optString.equalsIgnoreCase("jar")) {
                         ClassDesc.useJar = true;
@@ -132,11 +136,13 @@ public class j2cps {
                 System.err.println("After -jar, filename must end \".jar\"");
                 System.exit(1);
             }
+            pkgOrJar = "jar-file " + argStr;
             JarFile jf = new JarFile(argStr);
             JarHandler jh = new JarHandler();
             jh.ProcessJar(jf);
             PackageDesc.ProcessJarDependencies();           
         } else {
+            pkgOrJar = "java package " + argStr;
             PackageDesc.MakeRootPackageDescriptor(argStr, anonPack);
             PackageDesc.ProcessPkgWorklist();
         }
@@ -151,10 +157,6 @@ public class j2cps {
     }
   }
   
-  static private void BadOption(String s) {
-      System.err.println("Unknown option " + s);
-  }
-   
   static void MkArgString( String[] args ) {
       StringBuilder bldr = new StringBuilder( "J2cps args>");
       for (String arg : args) {
@@ -164,5 +166,24 @@ public class j2cps {
       argString = bldr.toString();
   }
 
+  static private void BadOption(String s) {
+      System.out.println("Unknown option " + s);
+  }
+   
+  static private void ShowHelp( ) {
+        System.err.println(versionStr);
+        System.err.println("Usage:");
+        System.err.println("java [VM-opts] j2cps.j2cps [options] PackageNameOrJarFile");
+        System.err.println("java [VM-opts] -jar j2cps.jar [options] PackageNameOrJarFile");
+        System.err.println("J2cps options may be in any order.");
+        System.err.println("  -d[st] dir => symbol file destination directory");
+        System.err.println("  -p[kg] dir => package-root directory");
+        System.err.println("  -jar       => process the named jar file");
+        System.err.println("  -s[ummary] => summary of progress");
+        System.err.println("  -v[erbose] => verbose diagnostic messages");
+        System.err.println("  -version   => show version string");
+        System.err.println("  -nocpsym   => only use sym-files from destination,");
+        System.err.println("                (overrides any CPSYM path setting)");
+  }
 }
 

J2CPS/J2CPSFiles.java

@@ -212,6 +212,7 @@ public class j2cpsfiles /*implements FilenameFilter*/ {
       }
       return null;
     } else {
+        //char[] arr = inFile.getPath().toCharArray();
         return inFile;
     }
   }

J2CPS/SymbolFile.java

@@ -395,6 +395,10 @@ class SymbolFile {
     out.writeByte(close);
     out.writeByte(keySy);
     out.writeInt(0);
+    // We need to emit the optional comments to 
+    // trigger special behaviour from Browse.
+    writeString(out, "Creator PeToCps " + j2cps.versionStr);
+    writeString(out, "Compiled from " + j2cps.pkgOrJar);
     thisPack.ResetImports();
   }
 

gpcp/Browse.cp

@@ -1,4 +1,11 @@
 
+(* ==================================================================== *)
+(*									*)
+(*      Module for the Gardens Point Component Symbol File Browser      *)
+(*	Copyright (c) John Gough 2018.                                  *)
+(*									*)
+(* ==================================================================== *)
+
 MODULE Browse;
 
   IMPORT 
@@ -11,56 +18,59 @@ MODULE Browse;
         LitValue,
         ProgArgs,
         Symbols,
-        IdDesc,
+        TypeDesc,
         GPText,
         GPTextFiles,
         GPCPcopyright,
+        BrowsePopups,
+        BrowseLookup,
+        NameHash,
         FileNames;
 
 (* ========================================================================= *
 // Collected syntax ---
 // 
-// SymFile    = Header [String (falSy | truSy | <other attribute>)]
-//		{Import | Constant | Variable | Type | Procedure} 
-//		TypeList Key.
-//	-- optional String is external name.
-//	-- falSy ==> Java class
-//	-- truSy ==> Java interface
-//	-- others ...
+// SymFile    = Header [String (falSy | truSy | <other attribute> )]
+//    {Import | Constant | Variable | Type | Procedure} 
+//        TypeList Key.
+//    -- optional String is external name.
+//    -- falSy ==> Java class
+//    -- truSy ==> Java interface
+//    -- others ...
 // Header     = magic modSy Name.
 // 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 | 
 //                      NamedType | Enum | Vector } 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 arrSy basSy 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
 // NamedType  = TypeHeader.
 // Statics    = ( Constant | Variable | Procedure ).
 // Enum       = TypeHeader eTpSy { Constant } endRc.
-// Name	      = namSy byte UTFstring.
+// Name       = namSy byte UTFstring.
 // Literal    = Number | String | Set | Char | Real | falSy | truSy.
 // Byte       = bytSy byte.
 // String     = strSy UTFstring.
@@ -86,26 +96,26 @@ MODULE Browse;
 // ======================================================================== *)
 
   CONST
-	modSy = ORD('H'); namSy = ORD('$'); bytSy = ORD('\');
-	numSy = ORD('#'); chrSy = ORD('c'); strSy = ORD('s');
-	fltSy = ORD('r'); falSy = ORD('0'); truSy = ORD('1');
-	impSy = ORD('I'); setSy = ORD('S'); keySy = ORD('K');
-	conSy = ORD('C'); typSy = ORD('T'); tDefS = ORD('t');
-	prcSy = ORD('P'); retSy = ORD('R'); mthSy = ORD('M');
-	varSy = ORD('V'); parSy = ORD('p'); start = ORD('&');
-	close = ORD('!'); recSy = ORD('{'); endRc = ORD('}');
-	frmSy = ORD('('); fromS = ORD('@'); endFm = ORD(')');
-	arrSy = ORD('['); endAr = ORD(']'); pTpSy = ORD('%');
-	ptrSy = ORD('^'); basSy = ORD('+'); eTpSy = ORD('e');
-	iFcSy = ORD('~'); evtSy = ORD('v'); vecSy = ORD('*');
+    modSy = ORD('H'); namSy = ORD('$'); bytSy = ORD('\');
+    numSy = ORD('#'); chrSy = ORD('c'); strSy = ORD('s');
+    fltSy = ORD('r'); falSy = ORD('0'); truSy = ORD('1');
+    impSy = ORD('I'); setSy = ORD('S'); keySy = ORD('K');
+    conSy = ORD('C'); typSy = ORD('T'); tDefS = ORD('t');
+    prcSy = ORD('P'); retSy = ORD('R'); mthSy = ORD('M');
+    varSy = ORD('V'); parSy = ORD('p'); start = ORD('&');
+    close = ORD('!'); recSy = ORD('{'); endRc = ORD('}');
+    frmSy = ORD('('); fromS = ORD('@'); endFm = ORD(')');
+    arrSy = ORD('['); endAr = ORD(']'); pTpSy = ORD('%');
+    ptrSy = ORD('^'); basSy = ORD('+'); eTpSy = ORD('e');
+    iFcSy = ORD('~'); evtSy = ORD('v'); vecSy = ORD('*');
 
   CONST
-	magic   = 0DEADD0D0H;
-	syMag   = 0D0D0DEADH;
-	dumped* = -1;
-        symExt  = ".cps";
-        broExt  = ".bro";
-        htmlExt = ".html";
+    magic   = 0DEADD0D0H;
+    syMag   = 0D0D0DEADH;
+    dumped* = -1;
+    symExt  = ".cps";
+    broExt  = ".bro";
+    htmlExt = ".html";
 
 
 (* ============================================================ *)
@@ -116,9 +126,9 @@ MODULE Browse;
 (* ============================================================ *)
 
   TYPE
-    Desc = POINTER TO ABSTRACT RECORD
-             name   : CharOpen;
-             access : INTEGER;
+    Desc = POINTER TO ABSTRACT RECORD (BrowseLookup.DescBase)
+           (* name   : CharOpen; -- Inherited field *)
+              access : INTEGER;
            END;
 
     DescList = RECORD
@@ -188,6 +198,7 @@ MODULE Browse;
                fields    : DescList; 
                methods   : DescList; 
                statics   : DescList;
+               xAttr     : SET;
              END;
     
     Array = POINTER TO EXTENSIBLE RECORD (Type)
@@ -240,15 +251,15 @@ MODULE Browse;
                   val : AbsValue;
                 END;
 
-    TypeDesc = POINTER TO EXTENSIBLE RECORD (Desc)
+    TypedDesc = POINTER TO EXTENSIBLE RECORD (Desc)
                 type : Type;
                 typeNum : INTEGER;
               END;
 
-    UserTypeDesc = POINTER TO RECORD (TypeDesc)
+    UserTypeDesc = POINTER TO RECORD (TypedDesc)
                    END;
 
-    VarDesc = POINTER TO RECORD (TypeDesc)
+    VarDesc = POINTER TO RECORD (TypedDesc)
               END;
 
     ProcDesc = POINTER TO RECORD (Desc)
@@ -274,6 +285,9 @@ MODULE Browse;
                progArg   : BOOLEAN;
                print     : BOOLEAN;
                strongNm  : POINTER TO ARRAY 6 OF INTEGER;
+               symTable  : BrowseLookup.SymbolTable;
+               comment1  : CharOpen;
+               comment2  : CharOpen;
              END;
     
 (* ============================================================ *)
@@ -298,6 +312,7 @@ MODULE Browse;
     args, argNo  : INTEGER;
     fileName, modName  : CharOpen;
     printFNames, doAll, verbatim, verbose, unwind, hexCon, alpha : BOOLEAN;
+    doJS  : BOOLEAN;
     file  : GPBinFiles.FILE;
     sSym  : INTEGER;
     cAtt  : CHAR;
@@ -339,7 +354,7 @@ MODULE Browse;
   PROCEDURE QuickSortDescs(lo, hi : INTEGER; dLst : DescList);
     VAR i,j : INTEGER;
         dsc : Desc;
-	tmp : Desc;
+        tmp : Desc;
  (* ---------------------------------------------------- *)
   BEGIN
     i := lo; j := hi;
@@ -365,7 +380,7 @@ MODULE Browse;
   PROCEDURE QuickSortMods(lo, hi : INTEGER; dLst : ModList);
     VAR i,j : INTEGER;
         dsc : Module;
-	tmp : Module;
+        tmp : Module;
  (* ---------------------------------------------------- *)
   BEGIN
     i := lo; j := hi;
@@ -394,7 +409,7 @@ MODULE Browse;
     i : INTEGER;
     tmp : POINTER TO ARRAY OF Module;
     mod : Module;
-	mlst : ModList;
+    mlst : ModList;
   BEGIN
     mlst := modList;
     ASSERT(modList.list # NIL);
@@ -494,7 +509,7 @@ MODULE Browse;
   END AddType;
 
 (* ============================================================ *)
-(* ========	Various reading utility procedures	======= *)
+(* ========     Various reading utility procedures      ======= *)
 (* ============================================================ *)
 
   PROCEDURE read() : INTEGER;
@@ -526,9 +541,9 @@ MODULE Browse;
     idx := 0;
     WHILE idx < len DO
       chr := read(); INC(idx);
-      IF chr <= 07FH THEN		(* [0xxxxxxx] *)
+      IF chr <= 07FH THEN        (* [0xxxxxxx] *)
         buff[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(); INC(idx);
         IF chr DIV 64 = 02H THEN
@@ -536,7 +551,7 @@ MODULE Browse;
         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(); INC(idx);
         IF chr DIV 64 = 02H THEN
@@ -577,7 +592,7 @@ MODULE Browse;
 
   PROCEDURE readLong() : LONGINT;
     VAR result : LONGINT;
-	index  : INTEGER;
+        index  : INTEGER;
   BEGIN [UNCHECKED_ARITHMETIC]
     (* overflow checking off here *)
     result := read();
@@ -657,10 +672,10 @@ MODULE Browse;
     | ORD('t') : Console.WriteString("TypeDef t#"); Console.WriteInt(iAtt,1);
     | ORD('+') : Console.WriteString("BaseType t#"); Console.WriteInt(iAtt,1);
     | ORD('R') : Console.WriteString("RETURN t#"); Console.WriteInt(iAtt,1);
-    | ORD('#') :
-	    RTS.LongToStr(lAtt, arg); 
-	    Console.WriteString("Number "); 
-		Console.WriteString(arg$);
+    | ORD('#') : 
+        RTS.LongToStr(lAtt, arg); 
+        Console.WriteString("Number "); 
+        Console.WriteString(arg$);
     | ORD('$') : 
         Console.WriteString("NameSymbol #");
         Console.WriteInt(iAtt,1); 
@@ -675,9 +690,9 @@ MODULE Browse;
         Console.WriteString("Real "); 
         Console.WriteString(arg$);
     ELSE 
-	    Console.WriteString("Bad Symbol ");
-		Console.WriteInt(sSym, 1);
-	    Console.WriteString(" in File");
+        Console.WriteString("Bad Symbol ");
+        Console.WriteInt(sSym, 1);
+        Console.WriteString(" in File");
     END;
     Console.WriteLn;
   END DiagnoseSymbol;
@@ -745,7 +760,7 @@ MODULE Browse;
     | setSy : NEW(s); s.setVal := BITS(iAtt); lit := s;
     | strSy : NEW(st); st.strVal := sAtt; lit := st;
     END;
-    GetSym();						(* read past value  *)
+    GetSym(); (* read past value  *)
   END GetLiteral;
 
 (* ============================================ *)
@@ -885,6 +900,7 @@ MODULE Browse;
 
 (* ============================================ *)
 
+  PROCEDURE^ GetMeth() : ProcDesc;
   PROCEDURE^ GetProc() : ProcDesc;
   PROCEDURE^ GetVar() : VarDesc;
 
@@ -896,17 +912,33 @@ MODULE Browse;
     VAR 
         rec  : Record;
         f : VarDesc;
-        t : TypeDesc;
+        t : TypedDesc;
         m : ProcDesc;
         mth : Meth;
   BEGIN
     NEW(rec);
     rec.recAtt := read();
     rec.isAnonRec := FALSE;
-    GetSym();				(* Get past recSy rAtt	*)
-    IF (sSym = falSy) OR (sSym = truSy) THEN
+    GetSym();				(* Get past recSy rAtt	 *)
+    IF (sSym = falSy) THEN
+      INCL(rec.xAttr, Symbols.isFn);
+      INCL(rec.xAttr, Symbols.noNew);   (* remvove if ctor found *)
+      GetSym();
+    ELSIF (sSym = truSy) THEN
+      INCL(rec.xAttr, Symbols.fnInf);   (* This is an interface  *)
+      INCL(rec.xAttr, Symbols.noNew);
       GetSym();
     END;
+    IF rec.recAtt >= TypeDesc.clsRc THEN
+      INCL(rec.xAttr, Symbols.clsTp); 
+      IF Symbols.isFn IN rec.xAttr THEN
+        INCL(rec.xAttr, Symbols.noNew); 
+        INCL(rec.xAttr, Symbols.noCpy); 
+      END;
+    ELSIF rec.recAtt >= TypeDesc.valRc THEN
+      INCL(rec.xAttr, Symbols.valTp);
+      EXCL(rec.xAttr, Symbols.noNew);
+    END;
     IF sSym = basSy THEN
       rec.baseOrd := iAtt;
       GetSym();
@@ -916,11 +948,6 @@ MODULE Browse;
     IF sSym = iFcSy THEN
       GetSym();
       WHILE sSym = basSy DO
-(* *
- * *	Console.WriteString("got interface $T");
- * *	Console.WriteInt(iAtt,1);
- * *	Console.WriteLn;
- * *)
         NEW(t);
         t.typeNum := iAtt;
 	GetSym();
@@ -935,45 +962,29 @@ MODULE Browse;
       GetSym();
       AddDesc(rec.fields,f);
     END;
-   (* Method     = mthSy Name byte byte TypeOrd [String] FormalType. *)
-    WHILE sSym = mthSy DO
-      NEW(m);
-      NEW(mth);
-      mth.importedFrom := NIL;
-      mth.isConstructor := FALSE;
-      m.pType := mth;
-      GetSym();
-      IF (sSym # namSy) THEN RTS.Throw("Bad symbol file format"); END;
-      m.name := sAtt;
-      m.access := iAtt;
-      mth.declarer := m;
-     (* byte1 is the method attributes  *)
-      mth.attr := read();
-     (* byte2 is param form of receiver *)
-      mth.recMode := read();
-     (* next 1 or 2 bytes are rcv-type  *)
-      mth.recTypeNum := readOrd();
-      GetSym();
-      IF sSym = strSy THEN 
-        mth.fName := sAtt;
-        GetSym(); 
-      ELSE
-        mth.fName := NIL;
-      END;
-      IF sSym = namSy THEN 
-        mth.recName := sAtt;
-        GetSym(); 
-      END;
-      GetFormalType(mth);
+   (* Method    = mthSy Name byte byte TypeOrd [String] FormalType. *)
+    WHILE (sSym = mthSy) OR (sSym = conSy) OR (sSym = prcSy) OR (sSym = varSy) DO
+      IF sSym = mthSy THEN
+       (* Instance Method *)
+        m := GetMeth();
       AddDesc(rec.methods,m);
-    END;
-    WHILE (sSym = conSy) OR (sSym = prcSy) OR (sSym = varSy) DO
-      IF sSym = conSy THEN
+      ELSIF sSym = conSy THEN
+       (* Static Constants *)
         AddDesc(rec.statics,GetConstant());
       ELSIF sSym = prcSy THEN
-        AddDesc(rec.statics,GetProc());
-      ELSE
-        AddDesc(rec.statics,GetVar());
+       (* Static Procedures *)
+        m := GetProc();        
+        AddDesc(rec.statics, m);
+        IF m.pType.isConstructor THEN
+          IF m.pType.pars.tide = 0 THEN 
+            EXCL(rec.xAttr, Symbols.noNew);
+          ELSE 
+            INCL(rec.xAttr, Symbols.xCtor);
+          END;
+        END;
+      ELSE 
+       (* Static Fields *)
+        AddDesc(rec.statics, GetVar());
       END;
     END;
     ReadPast(endRc); 
@@ -1003,7 +1014,7 @@ MODULE Browse;
   (*		| ProcType | NamedType | Enum } close.  *)
   (* TypeHeader = tDefS Ord [fromS Ord Name].		*)
     VAR modOrd : INTEGER;
-	typOrd : INTEGER;
+        typOrd : INTEGER;
         typ    : Type;
         namedType : Named;
         f : VarDesc;
@@ -1040,7 +1051,7 @@ MODULE Browse;
       | eTpSy : typ := enumType();
       ELSE 
         NEW(namedType);
-	    typ := namedType;
+        typ := namedType;
       END;
       IF typ # NIL THEN
         AddType(typeList,typ,typOrd);
@@ -1102,8 +1113,8 @@ MODULE Browse;
       IF typ IS Record THEN 
         r := typ(Record);
         FOR j := 0 TO r.intrFaces.tide - 1 DO
-          k := r.intrFaces.list[j](TypeDesc).typeNum;
-          r.intrFaces.list[j](TypeDesc).type := typeList[k];
+          k := r.intrFaces.list[j](TypedDesc).typeNum;
+          r.intrFaces.list[j](TypedDesc).type := typeList[k];
         END;
         IF typ.declarer = NIL THEN (* anon record *)
           typ(Record).isAnonRec := TRUE;
@@ -1226,6 +1237,43 @@ MODULE Browse;
     RETURN procDesc;
   END GetProc;
 
+ (* ============================================ *)
+
+  PROCEDURE GetMeth() : ProcDesc;
+    VAR m   : ProcDesc;
+        mth : Meth;
+  BEGIN 
+    NEW(m);
+    NEW(mth);
+    mth.importedFrom := NIL;
+    mth.isConstructor := FALSE;
+    m.pType := mth;
+    GetSym();
+    IF (sSym # namSy) THEN RTS.Throw("Bad symbol file format"); END;
+    m.name := sAtt;
+    m.access := iAtt;
+    mth.declarer := m;
+   (* byte1 is the method attributes  *)
+    mth.attr := read();
+   (* byte2 is param form of receiver *)
+    mth.recMode := read();
+   (* next 1 or 2 bytes are rcv-type  *)
+    mth.recTypeNum := readOrd();
+    GetSym();
+    IF sSym = strSy THEN 
+      mth.fName := sAtt;
+      GetSym(); 
+    ELSE
+      mth.fName := NIL;
+    END;
+    IF sSym = namSy THEN 
+      mth.recName := sAtt;
+      GetSym(); 
+    END;
+    GetFormalType(mth);
+    RETURN m;
+  END GetMeth;
+
 (* ============================================ *)
 
   PROCEDURE SymFile(mod : Module);
@@ -1243,7 +1291,19 @@ MODULE Browse;
     varDesc  : VarDesc;
     procDesc : ProcDesc;
     thisType : Type;
+   (* ----------------------------- *)
+    PROCEDURE AddType(mod : Module);
+      VAR type : UserTypeDesc;
+    BEGIN
+      type := GetType();
+      AddDesc(mod.types, type);
+      IF ~mod.symTable.enter(type.name, type) THEN
+        THROW("Type name " + type.name^ + " rejected in symbol table");
+      END;
+    END AddType;
+   (* ----------------------------- *)
   BEGIN
+    doJS := FALSE;
     AddMod(mod.imports,mod);
     ReadPast(modSy);
     IF sSym = namSy THEN (* do something with f.sAtt *)
@@ -1286,7 +1346,7 @@ MODULE Browse;
     LOOP
       CASE sSym OF
       | start : EXIT;
-      | typSy : AddDesc(mod.types,GetType());
+      | typSy : AddType(mod);
       | impSy : AddMod(mod.imports,GetImport());
       | conSy : AddDesc(mod.consts,GetConstant());
       | varSy : AddDesc(mod.vars,GetVar());
@@ -1298,6 +1358,18 @@ MODULE Browse;
     IF sSym # keySy THEN
       RTS.Throw("Missing keySy");
     END; 
+
+    GetSym();
+    IF sSym = strSy THEN
+      doJS := TRUE;
+      mod.comment1 := sAtt;
+      GetSym();
+      IF sSym = strSy THEN mod.comment2 := sAtt END;
+    ELSE
+      mod.comment1 := NIL;
+      mod.comment2 := NIL;
+    END;
+
     FOR i := 0 TO mod.types.tide-1 DO
       typeDesc := mod.types.list[i](UserTypeDesc);
       thisType := typeList[typeDesc.typeNum];
@@ -1357,12 +1429,12 @@ MODULE Browse;
         i := 0;
         WHILE (i < LEN(mod.pathName)) & (mod.pathName[i] # ".") DO INC(i); END;
         mod.pathName[i] := 0X;
-	  ELSE
-	    mod.pathName := mod.symName;
-	  END;
-	  IF verbose THEN
-	    Console.WriteString("Opened " + mod.pathName^); Console.WriteLn;
-	  END;
+      ELSE
+        mod.pathName := mod.symName;
+      END;
+      IF verbose THEN
+        Console.WriteString("Opened " + mod.pathName^); Console.WriteLn;
+      END;
       marker := readInt();
       IF marker = RTS.loInt(magic) THEN
       (* normal case, nothing to do *)
@@ -1407,6 +1479,11 @@ BEGIN
   Console.WriteString(str);
 END WriteIdent;
 
+PROCEDURE (o : Output) WriteComment(str : ARRAY OF CHAR),NEW,EXTENSIBLE;
+BEGIN
+  Console.WriteString(str);
+END WriteComment;
+
 PROCEDURE (o : Output) WriteImport(impMod : Module),NEW,EXTENSIBLE;
 BEGIN
   Console.WriteString(impMod.name);
@@ -1468,11 +1545,14 @@ BEGIN
   Console.WriteString(tName);
 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 *)
+
+PROCEDURE (o : Output) WriteLinefold(indent : INTEGER),NEW,EXTENSIBLE;
+BEGIN
+  o.WriteLn;
+  o.Indent(indent);
+END WriteLinefold;
 
 (* ------------------------------------------------------------------- *)
 
@@ -1486,6 +1566,11 @@ BEGIN
   GPText.WriteString(f.file,str);
 END WriteIdent;
 
+PROCEDURE (f : FileOutput) WriteComment(str : ARRAY OF CHAR),EXTENSIBLE;
+BEGIN
+  GPText.WriteString(f.file,str);
+END WriteComment;
+
 PROCEDURE (f : FileOutput) WriteImport(impMod : Module),EXTENSIBLE;
 BEGIN
   GPText.WriteString(f.file,impMod.name);
@@ -1546,8 +1631,13 @@ PROCEDURE (h : HtmlOutput) WriteStart(mod : Module);
 BEGIN
   GPText.WriteString(h.file,"<html><head><title>");
   GPText.WriteString(h.file,mod.name);
-  GPText.WriteString(h.file,"</title></head>");
+  GPText.WriteString(h.file,"</title>");
   GPText.WriteLn(h.file);
+  IF doJS THEN
+    GPText.WriteString(h.file, BrowsePopups.stylePrefix);
+    GPText.WriteLn(h.file);
+  END;
+  GPText.WriteString(h.file,"</head>");
   GPText.WriteString(h.file,'<body bgcolor="white">');
   GPText.WriteLn(h.file);
   GPText.WriteString(h.file,"<hr><pre>");
@@ -1556,7 +1646,13 @@ END WriteStart;
 
 PROCEDURE (h : HtmlOutput) WriteEnd();
 BEGIN
-  GPText.WriteString(h.file,"</font></pre></hr></body></html>");
+  GPText.WriteString(h.file,"</font></pre></hr>");
+  GPText.WriteLn(h.file);
+  IF doJS THEN
+    GPText.WriteString(h.file, BrowsePopups.ecmaScript);
+    GPText.WriteLn(h.file);
+  END;
+  GPText.WriteString(h.file, "</body></html>");
   GPText.WriteLn(h.file);
 END WriteEnd;
 
@@ -1585,6 +1681,13 @@ BEGIN
   GPText.WriteString(h.file,"</font>");
 END WriteIdent;
 
+PROCEDURE (h : HtmlOutput) WriteComment(str : ARRAY OF CHAR);
+BEGIN
+  GPText.WriteString(h.file,'<font color="green">');
+  GPText.WriteString(h.file,str);
+  GPText.WriteString(h.file,"</font>");
+END WriteComment;
+
 PROCEDURE (h : HtmlOutput) WriteString(str : ARRAY OF CHAR);
 BEGIN
   GPText.WriteString(h.file,str);
@@ -1653,21 +1756,17 @@ BEGIN
   GPText.WriteString(h.file,"</font>");
 END WriteTypeDecl;
 
-(* FIXME *)
 PROCEDURE (h : HtmlOutput) MethRef(IN nam : ARRAY OF CHAR);
 BEGIN
+  GPText.WriteString(h.file,'<font color="green">');
   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, "</font>");
- *)
   GPText.WriteString(h.file, '</a>');
   GPText.WriteString(h.file,"<b> *)</b>");
+  GPText.WriteString(h.file,"</font>");
 END MethRef;
 
 PROCEDURE (h : HtmlOutput) MethAnchor(IN nam : ARRAY OF CHAR);
@@ -1682,7 +1781,6 @@ BEGIN
   o.WriteLn;
   o.Indent(indent);
 END WriteLinefold;
-(* FIXME *)
 
 (* ==================================================================== *)
 (*				Format Helpers				*)
@@ -1690,8 +1788,8 @@ END WriteLinefold;
 
   PROCEDURE qStrOf(str : CharOpen) : CharOpen;
     VAR len : INTEGER;
-	idx : INTEGER;
-	ord : INTEGER;
+        idx : INTEGER;
+        ord : INTEGER;
         rslt : LitValue.CharVector;
     (* -------------------------------------- *)
     PROCEDURE hexDigit(d : INTEGER) : CHAR;
@@ -1754,8 +1852,8 @@ END WriteLinefold;
 
   PROCEDURE hexOf(ch : CHAR) : CharOpen;
     VAR res : CharOpen;
-	idx : INTEGER;
-	ord : INTEGER;
+        idx : INTEGER;
+        ord : INTEGER;
     (* -------------------------------------- *)
     PROCEDURE hexDigit(d : INTEGER) : CHAR;
     BEGIN
@@ -1789,6 +1887,15 @@ END WriteLinefold;
     RETURN res;
   END hexOf;
 
+(* ==================================================================== *)
+
+  PROCEDURE LongToComment(n : LONGINT) : CharOpen;
+    VAR arr : ARRAY 40 OF CHAR;
+  BEGIN
+    RTS.LongToStr(n, arr);
+    RETURN BOX(" (* " + arr$ + " *)");
+  END LongToComment;
+
 (* ==================================================================== *)
 
   PROCEDURE LongToHex(n : LONGINT) : CharOpen;
@@ -1841,6 +1948,7 @@ END WriteLinefold;
   BEGIN
     IF hexCon & (n.numVal >= 0) THEN
       output.WriteString(LongToHex(n.numVal));
+      output.WriteComment(LongToComment(n.numVal));
     ELSE
       output.WriteLong(n.numVal);
     END;
@@ -1867,7 +1975,7 @@ END WriteLinefold;
       CASE k-j OF
       | 0 : (* skip *)
       | 1 : output.Write(','); 
-	    output.WriteInt(k);
+            output.WriteInt(k);
       ELSE  output.WriteString('..');
             output.WriteInt(k);
       END;
@@ -1878,11 +1986,11 @@ END WriteLinefold;
     first := TRUE;  inSet := FALSE; j := 0; k := 0;
     FOR i := 0 TO MAX(SET) DO
       IF inSet THEN
-	IF i IN s.setVal THEN k := i;
-	ELSE inSet := FALSE; WriteRange(j,k,first);
-	END;
+        IF i IN s.setVal THEN k := i;
+        ELSE inSet := FALSE; WriteRange(j,k,first);
+        END;
       ELSE
-	IF i IN s.setVal THEN inSet := TRUE; j := i; k := i END;
+        IF i IN s.setVal THEN inSet := TRUE; j := i; k := i END;
       END;
     END;
     IF k = MAX(SET) THEN WriteRange(j,k,first) END;
@@ -1917,10 +2025,24 @@ END WriteLinefold;
   PROCEDURE (t : Type) PrintType(indent : INTEGER),NEW,EMPTY;
 
   PROCEDURE (t : Type) Print(indent : INTEGER;details : BOOLEAN),NEW,EXTENSIBLE;
+    VAR res : BrowseLookup.DescBase;
   BEGIN
     IF t.importedFrom # NIL THEN
       IF t.importedFrom = output.thisMod THEN
-        output.WriteKeyword(t.importedName);
+       (*
+        *  This code catches formal parameters that 
+        *  have not been resolved to a type defined
+        *  in this module. Occasionally this still 
+        *  fails - for example some java.lang distros
+        *  list AbstractStringBuilder as the base 
+        *  type of StringBuilder, rather than JL.Object.
+        *)
+        res := output.thisMod.symTable.lookup(t.importedName);
+        IF res # NIL THEN
+           res(TypedDesc).type.Print(indent, details);
+        ELSE
+          output.WriteKeyword(t.importedName);
+        END;
       ELSE
         output.WriteImportedTypeName(t.importedFrom, t.importedName);
       END;
@@ -1977,8 +2099,13 @@ END WriteLinefold;
     aStr = "ABSTRACT ";
     lStr = "LIMITED ";
     iStr = "INTERFACE ";
-    vStr = "(* vlCls *) ";
-    nStr = "(* noNew *) ";
+    prFx = '<span class="popup"><span class="popuptext" onclick="toggle(this)"></span></span>';
+    cStr = ' <span onclick="cls(this)">class</span>';
+    vStr = ' <span onclick="valueclass(this)">valueclass</span>';
+    nNew = ' <span onclick="noNew(this)">no noArg-ctor</span>';
+    hNew = ' <span onclick="newOk(this)">has noArg-ctor</span>';
+    nCpy = ' <span onclick="noCpy(this)">no value-assign</span>';
+    init = ' <span onclick="argCtor(this)">has arg-ctor</span>';
   VAR
     rStr : ARRAY 12 OF CHAR; 
     iTyp : Type;
@@ -2008,6 +2135,49 @@ END WriteLinefold;
       RETURN lst.tide;
     END fieldNumber;
 
+    PROCEDURE MkComment(xAttr : SET) : CharOpen;
+      VAR str : CharOpen;
+          num : INTEGER;
+    BEGIN
+      str := BOX(" (*");
+      num := 0;
+      IF Symbols.valTp IN xAttr THEN
+        IF num = 0 THEN str := BOX(str^ + vStr);
+        ELSE str := BOX(str^ + " |" + vStr);
+        END;
+        INC(num);
+      ELSIF Symbols.clsTp IN xAttr THEN
+        IF num = 0 THEN str := BOX(str^ + cStr);
+        ELSE str := BOX(str^ + " |" + cStr);
+        END;
+        INC(num);
+      END;
+      IF Symbols.noNew IN xAttr THEN
+        IF num = 0 THEN str := BOX(str^ + nNew);
+        ELSE str := BOX(str^ + " |" + nNew);
+        END;
+      ELSIF ~(Symbols.valTp IN xAttr) THEN
+        IF num = 0 THEN str := BOX(str^ + hNew);
+        ELSE str := BOX(str^ + " |" + hNew);
+        END;
+      END;
+      INC(num);
+      IF Symbols.xCtor IN xAttr THEN
+        IF num = 0 THEN str := BOX(str^ + init);
+        ELSE str := BOX(str^ + " |" + init);
+        END;
+        INC(num);
+      END;
+      IF Symbols.noCpy IN xAttr THEN
+        IF num = 0 THEN str := BOX(str^ + nCpy);
+        ELSE str := BOX(str^ + " |" + nCpy);
+        END;
+        INC(num);
+      END;
+      str := BOX(str^ + " *)");
+      RETURN str;
+    END MkComment;
+
   BEGIN
     CASE r.recAtt MOD 8 OF
     | 1 : rStr := aStr;
@@ -2016,11 +2186,7 @@ END WriteLinefold;
     | 4 : rStr := iStr;
     ELSE  rStr := "";
     END;
-    IF printFNames THEN
-      IF r.recAtt DIV 8 = 1 THEN output.WriteString(nStr);
-      ELSIF r.recAtt DIV 16 = 1 THEN output.WriteString(vStr);
-      END;
-    END;
+
     output.WriteKeyword(rStr + "RECORD"); 
     IF printBaseType(r) THEN
       output.WriteString(" (");
@@ -2034,7 +2200,7 @@ END WriteLinefold;
      (* ##### *)
       FOR i := 0 TO r.intrFaces.tide-1 DO
         output.WriteString(" + ");
-        iTyp := r.intrFaces.list[i](TypeDesc).type;
+        iTyp := r.intrFaces.list[i](TypedDesc).type;
         IF (iTyp IS Record) & (iTyp(Record).ptrType # NIL) THEN
           iTyp(Record).ptrType.Print(0,FALSE);
         ELSE
@@ -2044,19 +2210,21 @@ END WriteLinefold;
      (* ##### *)
       output.WriteString(")"); 
     END;
-
-(* FIXME *)
-    IF r.methods.tide > 0 THEN (* If interfaces, then newline + indent? *)
-      IF r.intrFaces.tide > 1 THEN
-        output.WriteLinefold(indent);
-      END;
+   (* should only apply for html output? *)
+    IF Symbols.isFn IN r.xAttr THEN
+      output.WriteLinefold(indent);
+      output.WriteString(prFx);
+      output.WriteComment(MkComment(r.xAttr));
+    END;
+    
+    IF r.methods.list # NIL THEN
+      output.WriteLinefold(indent);
       IF r.declarer # NIL THEN 
         output.MethRef(r.declarer.name);
       ELSIF (r.ptrType # NIL) & (r.ptrType.declarer # NIL) THEN
         output.MethRef(r.ptrType.declarer.name);
       END;
     END;
-(* FIXME *)
 
     output.WriteLn;
     fLen := maxFldLen(r);
@@ -2165,7 +2333,7 @@ END WriteLinefold;
     END;
   END PrintFormals;
 
- (* -----------------------------------------------------------	*)
+ (* ----------------------------------------------------------- *)
 
   PROCEDURE (p : Proc) PrintType(indent : INTEGER),EXTENSIBLE;
   BEGIN
@@ -2173,7 +2341,7 @@ END WriteLinefold;
     PrintFormals(p, indent+9);
   END PrintType;
 
- (* -----------------------------------------------------------	*)
+ (* ----------------------------------------------------------- *)
 
   PROCEDURE (p : Proc) PrintProc(indent : INTEGER),NEW;
   BEGIN
@@ -2190,7 +2358,7 @@ END WriteLinefold;
     output.WriteString(";"); output.WriteLn;
   END PrintProc;
 
- (* -----------------------------------------------------------	*)
+ (* ----------------------------------------------------------- *)
 
   PROCEDURE (m : Meth) PrintType(indent : INTEGER),EXTENSIBLE;
   BEGIN
@@ -2283,7 +2451,7 @@ END WriteLinefold;
         IF xLine THEN output.WriteLn; END;
       ELSE
         output.Indent(indent);
-        IF d IS TypeDesc THEN 
+        IF d IS TypedDesc THEN 
           output.WriteTypeDecl(d.name); 
         ELSE
           output.WriteIdent(d.name);
@@ -2297,7 +2465,7 @@ END WriteLinefold;
         WITH d : ConstDesc DO
             output.WriteString(" = ");
             d.val.Print();
-        | d : TypeDesc DO
+        | d : TypedDesc DO
           IF d IS VarDesc THEN
             output.WriteString(" : ");
           ELSE
@@ -2384,6 +2552,15 @@ END WriteLinefold;
     END;
 
     output.WriteStart(mod);
+    IF mod.comment1 # NIL THEN
+      output.WriteComment("(*"); output.WriteLn;
+      output.WriteComment(" *  " + mod.comment1^); output.WriteLn;
+      IF mod.comment2 # NIL THEN 
+        output.WriteComment(" *  " + mod.comment2^); output.WriteLn;
+      END;
+      output.WriteComment(" *)"); output.WriteLn;
+    END;
+
     IF mod.systemMod THEN
       heading := "SYSTEM ";
     ELSIF mod.fName # NIL THEN
@@ -2403,13 +2580,13 @@ END WriteLinefold;
     *)
     IF mod.strongNm # NIL THEN
       output.WriteLn; 
-      output.WriteString("    (* version ");
+      output.WriteComment("    (* version ");
       output.WriteInt(mod.strongNm[0]); output.Write(":");
       output.WriteInt(mod.strongNm[1]); output.Write(":");
       output.WriteInt(mod.strongNm[2]); output.Write(":");
       output.WriteInt(mod.strongNm[3]); 
       PrintDigest(mod.strongNm[4], mod.strongNm[5]);
-      output.WriteString(" *)");
+      output.WriteComment(" *)");
     END;
    (*  end optional strong name.  *)
     output.WriteLn; output.WriteLn;
@@ -2553,7 +2730,7 @@ BEGIN
     Console.WriteLn;
     Console.WriteString(" /verbatim ==> display anonymous public type names");
     Console.WriteLn;
-  ELSE			(* RTS.defaultTarget = "jvm" *)
+  ELSE (* RTS.defaultTarget = "jvm" *)
     Console.WriteString("Usage: browse [options] <ModuleNames>");
     Console.WriteLn;
     Console.WriteString("Browse Options ... ");
@@ -2733,7 +2910,7 @@ END ParseOptions;
             Console.WriteLn;
           END;
         END;
-        PrintModule(modList.list[i]); 
+        PrintModule(modList.list[i]);
         IF output IS FileOutput THEN
           GPTextFiles.CloseFile(output(FileOutput).file);
         END;
@@ -2762,6 +2939,7 @@ END ParseOptions;
 (* ============================================================ *)
 
 BEGIN
+  NameHash.InitNameHash(32000);
   NEW(fileName, 256);
   NEW(modName, 256);
   InitTypes();

gpcp/BrowseLookup.cp

@@ -0,0 +1,117 @@
+
+(* ================================================= *) 
+(*   This module provides symbol tables for Browse   *)
+(*   Copyright (c) John Gough 2018                   *)
+(* ================================================= *)
+
+MODULE BrowseLookup;
+  IMPORT
+    RTS,
+    Nh := NameHash;
+    
+
+(* ============================================================ *)
+
+  TYPE  
+    DescBase* = POINTER TO ABSTRACT RECORD name* : RTS.CharOpen END;
+
+  TYPE  (* Symbol tables are implemented by a binary tree *)
+    SymInfo = POINTER TO RECORD         (* private stuff  *)
+                key : INTEGER;          (* hash key value *)
+                val : DescBase;         (* descriptor obj *)
+                lOp : SymInfo;          (* left child     *)
+                rOp : SymInfo;          (* right child    *)
+              END;
+
+    SymbolTable* = RECORD
+                     root : SymInfo;
+                   END;
+
+(* ============================================================ *)
+(*  Private methods of the symbol-table info-blocks             *)
+(* ============================================================ *)
+
+  PROCEDURE mkSymInfo(h : INTEGER; d : DescBase) : SymInfo;
+    VAR rtrn : SymInfo;
+  BEGIN
+    NEW(rtrn); rtrn.key := h; rtrn.val := d; RETURN rtrn;
+  END mkSymInfo;
+
+(* -------------------------------------------- *)
+
+  PROCEDURE (i : SymInfo)lookup(key : INTEGER) : DescBase,NEW;
+  BEGIN
+    IF key < i.key THEN
+      IF i.lOp = NIL THEN RETURN NIL ELSE RETURN i.lOp.lookup(key) END;
+    ELSIF key > i.key THEN
+      IF i.rOp = NIL THEN RETURN NIL ELSE RETURN i.rOp.lookup(key) END;
+    ELSE (* key must equal i.key *)
+      RETURN i.val;
+    END;
+  END lookup;
+
+(* -------------------------------------------- *)
+
+  PROCEDURE (i : SymInfo)enter(h : INTEGER; d : DescBase) : BOOLEAN,NEW;
+  BEGIN
+    IF h < i.key THEN
+      IF i.lOp = NIL THEN i.lOp := mkSymInfo(h,d); RETURN TRUE;
+      ELSE RETURN i.lOp.enter(h,d);
+      END;
+    ELSIF h > i.key THEN
+      IF i.rOp = NIL THEN i.rOp := mkSymInfo(h,d); RETURN TRUE;
+      ELSE RETURN i.rOp.enter(h,d);
+      END;
+    ELSE (* h must equal i.key *) RETURN FALSE;
+    END;
+  END enter;
+
+(* -------------------------------------------- *)
+
+  PROCEDURE (i : SymInfo)write(h : INTEGER; d : DescBase) : SymInfo,NEW;
+    VAR rtrn : SymInfo;
+  BEGIN
+    rtrn := i;      (* default: return self *)
+    IF    h < i.key THEN i.lOp := i.lOp.write(h,d);
+    ELSIF h > i.key THEN i.rOp := i.rOp.write(h,d);
+    ELSE  rtrn.val := d;
+    END;
+    RETURN rtrn;
+  END write;
+
+(* -------------------------------------------- *)
+(*              Exported Procedures             *)
+(* -------------------------------------------- *)
+
+  PROCEDURE (IN tbl : SymbolTable)lookup*(str : RTS.CharOpen) : DescBase,NEW;
+  BEGIN
+    IF tbl.root = NIL THEN 
+      RETURN NIL;
+    ELSE 
+      RETURN tbl.root.lookup(Nh.enterStr(str));
+    END;
+  END lookup;
+
+(* -------------------------------------------- *)
+
+  PROCEDURE (VAR tbl : SymbolTable)Overwrite*(str : RTS.CharOpen; new : DescBase),NEW;
+  BEGIN
+    tbl.root := tbl.root.write(Nh.enterStr(str), new);
+  END Overwrite;
+
+(* -------------------------------------------- *)
+
+  PROCEDURE (VAR s : SymbolTable)enter*(str : RTS.CharOpen; v : DescBase) : BOOLEAN,NEW;
+  (* Enter value in SymbolTable; Return value signals successful insertion. *)
+  BEGIN
+    IF s.root = NIL THEN
+      s.root := mkSymInfo(Nh.enterStr(str), v); RETURN TRUE;
+    ELSE
+      RETURN s.root.enter(Nh.enterStr(str), v);
+    END;
+  END enter;
+
+(* -------------------------------------------- *)
+END BrowseLookup.
+(* -------------------------------------------- *)
+

gpcp/BrowsePopups.cp

@@ -0,0 +1,117 @@
+(* ==================================================================== *)
+(*									*)
+(*  Utility Module for the Gardens Point Component Symbol File Browser  *)
+(*	Copyright (c) John Gough 2018.                                  *)
+(*      This module defines the CSS prefix and JavaScript suffix        *)
+(*									*)
+(* ==================================================================== *)
+
+MODULE BrowsePopups;
+  IMPORT RTS;
+
+  CONST stylePrefix* =
+!"<style>\n" +
+!"<!-- BEGIN Inline CSS -->\n" +
+!"/* Popup container */\n" +
+!".popup {\n" +
+!"    position: relative;\n" +
+!"    display: inline-block;\n" +
+!"    cursor: pointer;\n" +
+!"}\n\n" +
+!"/* The actual popup (appears on top) */\n" +
+!".popup .popuptext {\n" +
+!"    visibility: hidden;\n" +
+!"    width: 430px;\n" +
+!"    background-color: white;\n" +
+!"    color: black;\n" +
+!"    text-align: left;\n" +
+!"    border-radius: 6px;\n" +
+!"    border-style: solid;\n" +
+!"    border-color: black;\n" +
+!"    padding: 8px 8px 8px 8px;\n" +
+!"    position: absolute;\n" +
+!"    z-index: 1;\n" +
+!"    margin-top: 30px;\n" +
+!"}\n\n" + 
+!"/* Toggle this class when clicking on the popup container (hide and show the popup) */\n" +
+!".popup .show {\n" +
+!"    visibility: visible;\n" +
+!"    opacity: 1;\n" +
+!"}\n\n" +
+!"</style>\n" +
+!"<!-- END Inline CSS -->";
+
+  CONST ecmaScript* =
+!"<!-- BEGIN JavaScript -->\n" +
+!"<script>\n" +
+!"function toggle(node) {\n" +
+!"    node.classList.toggle(\"show\"); \n" +
+!"  }\n\n" +
+!"function cls(node) {\n" +
+!"    var prnt = node.parentNode;\n" +
+!"    var next = prnt.previousSibling;\n" +
+!"    var text = next.lastChild;\n" +
+!"    text.innerHTML = \n" +
+!"        \"The <b>class</b> property asserts that this type will be<br>\" +\n" +
+!"        \"implemented as a reference class in the underlying framework.\";\n" +
+!"    text.classList.toggle(\"show\");\n" +
+!"  }\n\n" +
+!"function newOk(node) {\n" +
+!"    var popuptext = node.parentNode.previousSibling.lastChild;\n" +
+!"    popuptext.innerHTML = \n" +
+!"        \"The <b>has noArg-ctor</b> property asserts that this reference<br>\" +\n" +
+!"        \"class has a no-arg constructor, and thus objects of this<br>\" +\n" +
+!"        \"type can be allocated with NEW(). Component Pascal types<br>\" +\n" +
+!"        \"derived from this type can also be allocated using NEW().\";\n" +
+!"    popuptext.classList.toggle(\"show\"); \n" +
+!"  }\n\n" +
+!"function noNew(node) { \n" +
+!"    var prnt = node.parentNode; \n" +
+!"    var next = prnt.previousSibling; \n" +
+!"    var text = next.lastChild; \n" +
+!"    text.innerHTML =  \n" +
+!"        \"The <b>no noArg-ctor</b> property asserts that this reference<br>\" +\n" +
+!"        \"class does not have a noArg constructor. Objects of this<br>\" +\n" +
+!"        \"type cannot be allocated using NEW(), and Component<br>\" +\n" +
+!"        \"Pascal types  derived from this type also cannot be<br>\" +\n" +
+!"        \"allocated using NEW().\";\n" +
+!"    text.classList.toggle(\"show\");\n" +
+!"  }\n\n" +
+!"function noCpy(node) {\n" +
+!"    var popuptext = node.parentNode.previousSibling.lastChild;\n" +
+!"    popuptext.innerHTML = \n" +
+!"        \"The <b>no value-assign</b> property asserts that this reference<br>\" + \n" +
+!"        \"class does not have a value copy method. Therefore, it<br>\" +\n" +
+!"        \"is not possible to perform value assignments using<br>\" +\n" +
+!"        \"statements like <i>dst^</i> := <i>src^</i>\";\n" +
+!"    popuptext.classList.toggle(\"show\");\n" +
+!"  }\n\n" +
+!"function valueclass(node) { \n" +
+!"        var popuptext = node.parentNode.previousSibling.lastChild; \n" +
+!"    popuptext.innerHTML =  \n" +
+!"        \"The <b>valueclass</b> property asserts that this RECORD type is<br>\" + \n" +
+!"        \"implemented as a value class in the CLR. It follows that<br>\" +  \n" +
+!"        \"value assignments can be made of these types. They can<br>\" + \n" +
+!"        \"also be passed by value. Even pointers to records of<br>\" + \n" +
+!"        \"such types may be dereferenced and copied using syntax<br>\" + \n" +
+!"        \"such as  <i>dst^</i> := <i>src^</i>\"; \n" +
+!"    popuptext.classList.toggle(\"show\"); \n" +
+!"  } \n\n" +
+!"function argCtor(node) { \n" +
+!"    var popuptext = node.parentNode.previousSibling.lastChild; \n" +
+!"    popuptext.innerHTML =  \n" +
+!"        \"The <b>has arg-ctor</b> property asserts that this reference<br>\" +  \n" +
+!"        \"class has one or more constructors that take arguments.<br>\" + \n" +
+!"        \"These constructors can be called from Component Pascal<br>\" + \n" +
+!"        \"by calling an <i>init</i>(...) method from the static list<br>\" + \n" +
+!"        \"here. Component Pascal types derived from this type<br>\" + \n" +
+!"        \"can define constructors with arguments which call the<br>\" + \n" +
+!"        \"super-type constructor.<br>\" + \n" +
+!"        \"See <i>'Interfacing to constructors'</i> in the Release Notes.\"; \n" +
+!"    popuptext.classList.toggle(\"show\"); \n" +
+!"  } \n\n" +
+!"</script>\n" +
+!"<!-- END JavaScript --> \n";
+
+END BrowsePopups.
+    

gpcp/ClsToType.cp

@@ -58,6 +58,26 @@ MODULE ClsToType;
         (* method attribute enumeration bits *)
         stMth = 4; fnMth = 5; vrMth = 6; nwMth = 8; abMth = 10;
 
+ CONST  (* Binding Flags *)
+        staticBF = 
+		  Rfl.BindingFlags.Static + 
+		  Rfl.BindingFlags.DeclaredOnly +
+		  Rfl.BindingFlags.NonPublic +
+		  Rfl.BindingFlags.Public;
+
+        instanceBF = 
+		  Rfl.BindingFlags.Instance + 
+		  Rfl.BindingFlags.DeclaredOnly +
+		  Rfl.BindingFlags.NonPublic +
+		  Rfl.BindingFlags.Public;
+
+		bothBF =
+		  Rfl.BindingFlags.Instance + 
+		  Rfl.BindingFlags.Static + 
+		  Rfl.BindingFlags.DeclaredOnly +
+		  Rfl.BindingFlags.NonPublic +
+		  Rfl.BindingFlags.Public;
+
  (* ------------------------------------------------------------ *)
 
   TYPE  Namespace*    = POINTER TO ABSTRACT RECORD
@@ -596,9 +616,10 @@ MODULE ClsToType;
 
   PROCEDURE modeFromMbrAtt(att : SET) : INTEGER;
   BEGIN
-    CASE ORD(att * {0,1,2}) OF
+    CASE ORD(att * {0,1,2,5}) OF
     | 4, 5 : RETURN Sy.protect;
     | 6    : RETURN Sy.pubMode;
+	| 26H  : RETURN Sy.rdoMode; (* Actually InitOnly for static fields *)
     ELSE     RETURN Sy.prvMode;
     END;
   END modeFromMbrAtt;
@@ -1084,18 +1105,16 @@ MODULE ClsToType;
     *  First we must add resolved base and interface types.
     *)
     FixBaseAndInterfaces(spc, cls, rec);
+	IF cls.get_IsValueType() THEN INCL(rec.xAttr, Sy.valTp);
+	ELSIF cls.get_IsClass() THEN INCL(rec.xAttr, Sy.clsTp);
+	END;
    (*
     *  Now fill in record fields ...
     *)
-    flds := cls.GetFields();
+	flds := cls.GetFields(bothBF);
     FOR indx := 0 TO LEN(flds) - 1 DO
       fldI := flds[indx];
-     (*
-      *  Don't emit inherited fields.
-      *)
-      IF fldI.get_DeclaringType() = cls THEN 
-        spc.AddRecFld(rec, fldI);
-      END;
+      spc.AddRecFld(rec, fldI);
     END;
    (*
     *  Now fill in record events ...
@@ -1107,18 +1126,16 @@ MODULE ClsToType;
    (*
     *  Now fill in record methods ...
     *)
-    mths := cls.GetMethods();
+    mths := cls.GetMethods(bothBF);
     FOR indx := 0 TO LEN(mths) - 1 DO
       mthI := mths[indx];
-      IF cls = mthI.get_DeclaringType() THEN (* ONLY IF NOT GENERIC ARGUMENTS *)
-        spc.AddRecMth(rec, mths[indx]);
-      END;
+      spc.AddRecMth(rec, mths[indx]);
     END;
    (*
     *  Now fill in constructors ...
     *  even if there are no instance members.
     *)
-    cons := cls.GetConstructors();
+    cons := cls.GetConstructors(instanceBF);
     FOR indx := 0 TO LEN(cons) - 1 DO 
       spc.AddRecMth(rec, cons[indx]);
     END;

gpcp/CompState.cp

@@ -98,7 +98,7 @@ MODULE CompState;
     doDWC-,       (* Legacy class file emitter in v1.3.19 *)
     doJsmn-,
     forceIlasm,
-    forcePerwapi,
+    forceRflEmt,
     doIlasm-,
     doAsm-,
     doCode-,
@@ -237,6 +237,14 @@ MODULE CompState;
       Console.WriteLn;
     END TimeMsg;
 
+	(* Filename to NativeString *)
+	PROCEDURE fn2ns*(IN fn : FileNames.NameString) : RTS.NativeString;
+	BEGIN
+	  IF fn = "" THEN RETURN NIL
+	  ELSE RETURN MKSTR(fn$)
+	  END
+	END fn2ns;
+
 (* ==================================================================== *)
 
     PROCEDURE Usage;
@@ -276,6 +284,7 @@ PrintLn("       /quiet       ==> Compile silently if possible");
 PrintLn("       /symdir=XXX  ==> Place symbol files in directory XXX");
 PrintLn("  Code Generation Options ---");
 PrintLn("       /ilasm       ==> (default) Force compilation via ILASM emitter");
+PrintLn("       /rflemit     ==> Use prototype System.Reflection.Emit emitter");
 PrintLn("       /target=XXX  ==> Emit (jvm|net) assembly");
 PrintLn("       /unsafe      ==> Allow unsafe code generation");
 PrintLn("       /vserror     ==> Print error messages in Visual Studio format");
@@ -539,16 +548,6 @@ PrintLn("       -DCPSYM=%CPSYM%   pass value of CPSYM environment variable to JR
           ELSE 
             Unknown(opt);
           END;
-      | "p" :
-          IF copy = "perwapi" THEN
-           (*
-            * forcePerwapi := TRUE;
-            * expectedNet := TRUE;
-            *)
-            Message("PERWAPI is not supported for this build");
-          ELSE
-            Unknown(opt);
-          END;
       | "q" :
           IF copy = "quiet" THEN
             quiet := TRUE;
@@ -556,6 +555,13 @@ PrintLn("       -DCPSYM=%CPSYM%   pass value of CPSYM environment variable to JR
           ELSE
             Unknown(opt);
           END;
+      | "r" :
+          IF copy = "rflemit" THEN
+            forceRflEmt := TRUE;
+            expectedNet := TRUE;
+          ELSE
+            Unknown(opt);
+          END;
       | "s" :
           IF copy = "special" THEN
             doAsm      := FALSE;
@@ -684,13 +690,11 @@ PrintLn("       -DCPSYM=%CPSYM%   pass value of CPSYM environment variable to JR
       END;
      (* 
       *  If debug is set, for this version, ILASM is used unless /perwapi is explicit
-      *  If debug is clar, for this versin, PERWAPI is used unless /ilasm is explicit
+      *  If debug is clear, for this versin, PERWAPI is used unless /ilasm is explicit
       *)
-      IF forceIlasm THEN      doIlasm := TRUE;
-      ELSIF forcePerwapi THEN doIlasm := FALSE;
-      ELSE                    
-        (* In version 1.4.0* doIlasm is always true, even with /nodebug *)
-                              doIlasm := TRUE; (* debug; *)
+      IF forceIlasm THEN     doIlasm := TRUE;
+      ELSIF forceRflEmt THEN doIlasm := FALSE;
+      ELSE                   doIlasm := TRUE; (* debug; *)
       END;
     END CheckOptionsOK;
 
@@ -768,7 +772,7 @@ PrintLn("       -DCPSYM=%CPSYM%   pass value of CPSYM environment variable to JR
     doJsmn      := FALSE;
     doIlasm     := TRUE;   (* doIlasm is the default currently *)
     forceIlasm  := FALSE;
-    forcePerwapi := FALSE; (* and stays false in 1.4.04 *)
+    forceRflEmt := FALSE; (* and stays false in 1.4.04 *)
     doCode      := TRUE;
     doAsm       := TRUE;
     doAsm5      := (RTS.defaultTarget = "jvm");

gpcp/GPCPcopyright.cp

@@ -55,7 +55,8 @@ MODULE GPCPcopyright;
      (* 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.06 of 18 February 2018"; 
+     (* VERSION    = "1.4.06 of 18 February 2018"; *)
+        VERSION    = "1.4.07 of 04 March 2018"; 
 	verStr*    = " version " + VERSION;
 
   CONST	prefix     = "#gpcp: ";

gpcp/Hello.cp

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

gpcp/IdDesc.cp

@@ -276,7 +276,7 @@ MODULE IdDesc;
               * locals*  : IdSeq;       (* varId sequence *)
               * scopeNm* : L.CharOpen   (* external name  *)
               * ----------------------------------------- *)
-			    aliasMod* : BlkId;
+                aliasMod* : BlkId;
                 modBody*  : D.Stmt;     (* mod init-stmts *)
                 modClose* : D.Stmt;     (* mod finaliz'n  *)
                 impOrd*   : INTEGER;    (* implement ord. *)

gpcp/JavaTarget.cp

@@ -1,14 +1,16 @@
+
 (* ============================================================ *)
-(*  Target is the module which selects the target ClassMaker.	*)
-(*  Copyright (c) John Gough 1999, 2017.			*)
+(*  Target is the module which selects the target ClassMaker.   *)
+(*  Copyright (c) John Gough 1999, 2017.                        *)
 (* ============================================================ *)
 
-MODULE JavaTarget; (* JavaTargetForCLR.cp *)
+MODULE JavaTarget; (* JavaTargetForJVM.cp *)
 
   IMPORT 
         RTS,
-	GPCPcopyright,
-	CompState,
+        GPCPcopyright,
+        CompState,
+        AsmUtil,
         JavaUtil,
         ClassUtil;
 
@@ -16,7 +18,11 @@ MODULE JavaTarget; (* JavaTargetForCLR.cp *)
 
   PROCEDURE NewJavaEmitter*(IN fileName : ARRAY OF CHAR) : JavaUtil.JavaFile;
   BEGIN
-    IF CompState.doDWC THEN 
+    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" );
@@ -25,8 +31,8 @@ MODULE JavaTarget; (* JavaTargetForCLR.cp *)
 
 (* ============================================================ *)
 BEGIN
-  IF RTS.defaultTarget = "jvm" THEN
-    CompState.Abort("Wrong JavaTarget implementation: Use JavaTargetForJVM.cp");
+  IF RTS.defaultTarget # "jvm" THEN
+    CompState.Abort("Wrong JavaTarget implementation: Use JavaTargetForCLR.cp");
   END;
 END JavaTarget.
 (* ============================================================ *)

gpcp/JavaTargetForJVM.cp

@@ -1,15 +1,15 @@
 
 (* ============================================================ *)
-(*  Target is the module which selects the target ClassMaker.	*)
-(*  Copyright (c) John Gough 1999, 2017.			*)
+(*  Target is the module which selects the target ClassMaker.   *)
+(*  Copyright (c) John Gough 1999, 2017.                        *)
 (* ============================================================ *)
 
 MODULE JavaTarget; (* JavaTargetForJVM.cp *)
 
   IMPORT 
         RTS,
-	GPCPcopyright,
-	CompState,
+        GPCPcopyright,
+        CompState,
         AsmUtil,
         JavaUtil,
         ClassUtil;

gpcp/JsmnUtil.cp

@@ -824,6 +824,7 @@ MODULE JsmnUtil;
     os.Prefix(code);
     os.RefLab(i2);
     os.Suffix(code);
+	INCL(i2.attr, J.jumpSeen);
   END CodeLb;
 
 (* -------------------------------------------- *)

gpcp/MkNetDistro.bat

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

gpcp/MsilMaker.cp

@@ -20,7 +20,7 @@ MODULE MsilMaker;
         GPFiles,
         GPBinFiles,
         GPTextFiles,
-        (* PeUtil, *)
+        PeTarget,
         IlasmUtil,
         Nh  := NameHash,
         Scn := CPascalS,
@@ -534,8 +534,8 @@ MODULE MsilMaker;
     | Ty.limit : attSet := Asm.att_empty;
     | Ty.extns : attSet := Asm.att_empty;
     | Ty.iFace : attSet := Asm.att_interface;
-     mkInit := FALSE;
-     mkCopy := FALSE;
+                 mkInit := FALSE;
+                 mkCopy := FALSE;
     END;
    (*
     *   Account for the identifier visibility.
@@ -760,13 +760,11 @@ MODULE MsilMaker;
     callApi := CSt.doCode & ~CSt.doIlasm;
     Mu.MkBlkName(this.mod);
     IF callApi THEN
-      ASSERT(FALSE);
-      out := NIL;
-     (*
-      * CSt.emitNam := BOX("PERWAPI");
-      * out := PeUtil.newPeFile(this.mod.pkgNm, ~this.mod.main);
-      * this.outF := out;
-      *)
+     (* ------------------- *)
+      CSt.emitNam := BOX("Reflection-emit");
+      out := PeTarget.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);
@@ -779,7 +777,7 @@ MODULE MsilMaker;
       Error.WriteLn;
       RETURN;
     END;
-    IF CSt.verbose THEN CSt.Message("Created "+ out.outN^) END;
+    IF CSt.verbose THEN CSt.Message("Creating "+ out.outN^) END;
     out.Header(CSt.srcNam);
     IF this.mod.main THEN out.Comment("This module implements CPmain") END;
     out.Blank();

gpcp/NameHash.cp

@@ -75,7 +75,6 @@ MODULE NameHash;
 	idx : INTEGER;
 	len : INTEGER;
   BEGIN [UNCHECKED_ARITHMETIC]
-
     (* need to turn off overflow checking *)
     len := LEN(str$);
     tot := 0;
@@ -146,6 +145,7 @@ MODULE NameHash;
     val  := name[key];
 
     WHILE (val # NIL) & ~equalStr(val,str) DO
+	 (* hash table collision, find new slot *)
       INC(key, step);
       INC(step,2); 
       IF step >= size THEN HashtableOverflow() END;

gpcp/NewSymFileRW.cp

@@ -112,6 +112,7 @@ MODULE NewSymFileRW;
         arrSy = ORD('['); endAr = ORD(']'); pTpSy = ORD('%');
         ptrSy = ORD('^'); basSy = ORD('+'); eTpSy = ORD('e');
         iFcSy = ORD('~'); evtSy = ORD('v'); vecSy = ORD('*');
+        eofSy = -1;
 
   CONST
         magic   = 0DEADD0D0H;
@@ -720,7 +721,7 @@ MODULE NewSymFileRW;
     IF ~f.isImportedRecord(t) THEN
       f.Write(recSy);
       index := t.recAtt; 
-      IF D.noNew IN t.xAttr THEN INC(index, Ty.noNew) END;
+      IF D.valTp IN t.xAttr THEN INC(index, Ty.valRc) END;
       IF D.clsTp IN t.xAttr THEN INC(index, Ty.clsRc) END;
       f.Write(index);
    (* ########## *)
@@ -851,8 +852,8 @@ MODULE NewSymFileRW;
 
 (* ======================================= *)
 
-  PROCEDURE EmitSymfile*(m : Id.BlkId);
 
+  PROCEDURE EmitSymfileAndComment*(m : Id.BlkId; cmnt1, cmnt2 : Lt.CharOpen);
     VAR symVisit : SymFileSFA;
         symfile  : SymFile;
         marker   : INTEGER;
@@ -945,8 +946,16 @@ MODULE NewSymFileRW;
       symfile.Write(keySy);
       lastKey := symfile.cSum;
       IF CSt.special THEN symfile.Write4B(0) ELSE symfile.Write4B(lastKey) END;
+      IF cmnt1 # NIL THEN symfile.WriteStringForLit(cmnt1);
+		IF cmnt2 # NIL THEN symfile.WriteStringForLit(cmnt2) END;
+      END;
       BF.CloseFile(symfile.file);
     END;
+  END EmitSymfileAndComment;
+
+  PROCEDURE EmitSymfile*(m : Id.BlkId);
+  BEGIN
+    EmitSymfileAndComment(m, NIL, NIL);
   END EmitSymfile;
 
 (* ============================================================ *)
@@ -1461,18 +1470,23 @@ MODULE NewSymFileRW;
     *  and is stripped off here.  The valRc field is used to lock
     *  in foreign value classes, even though they have basTp # NIL.
     *)
-    IF attr >= Ty.clsRc THEN DEC(attr,Ty.clsRc); INCL(rslt.xAttr,D.clsTp) END;
-    IF attr >= Ty.noNew THEN DEC(attr,Ty.noNew); INCL(rslt.xAttr,D.noNew) END;
+    IF attr >= Ty.clsRc THEN 
+      DEC(attr,Ty.clsRc); INCL(rslt.xAttr,D.clsTp);
+    ELSIF attr >= Ty.valRc THEN 
+      DEC(attr,Ty.valRc); INCL(rslt.xAttr,D.valTp);
+    END;
 
-    rslt.recAtt := attr;
+    rslt.recAtt := attr MOD 8;
     f.GetSym();                (* Get past recSy rAtt    *)
     IF f.sSym = falSy THEN
       INCL(rslt.xAttr, D.isFn);  (* This record type is foreign *)
+      INCL(rslt.xAttr, D.noNew); (* Remove if ctor found later  *)
       f.GetSym();
     ELSIF f.sSym = truSy THEN
       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   *)
+      INCL(rslt.xAttr, D.noCpy); (* Record has no __copy__      *)
+      INCL(rslt.xAttr, D.noNew); (* Record has no constructor   *)
       f.GetSym();
     END;
    (* 
@@ -1490,7 +1504,9 @@ MODULE NewSymFileRW;
       *)
       IF rslt.baseTp = NIL THEN
         rslt.baseTp := f.typeOf(f.iAtt);
-        IF f.iAtt # Ty.anyRec THEN INCL(rslt.xAttr, D.clsTp) END;
+        IF (f.iAtt # Ty.anyRec) & ~(D.valTp IN rslt.xAttr) THEN 
+		    INCL(rslt.xAttr, D.clsTp);
+		END;
       END;
       f.GetSym();
     END;
@@ -1532,6 +1548,13 @@ MODULE NewSymFileRW;
         prcD.bndType := rslt;
         InsertInRec(prcD,rslt,f);
         D.AppendIdnt(rslt.statics, prcD);
+	    IF prcD.kind = Id.ctorP THEN
+	      IF prcD.type(Ty.Procedure).formals.tide = 0 THEN 
+	        EXCL(rslt.xAttr, D.noNew);
+	      ELSE
+	        INCL(rslt.xAttr, D.xCtor);
+	     END;
+	    END;
       ELSIF oldS = varSy THEN
         varD := f.variable();
         varD.recTyp := rslt;
@@ -1545,13 +1568,8 @@ MODULE NewSymFileRW;
         Abandon(f);
       END;
     END;
-(* #### *)
-    IF attr >= Ty.valRc THEN 
-      DEC(attr, Ty.valRc); 
-      EXCL(rslt.xAttr, D.clsTp);
-      EXCL(rslt.xAttr, D.noCpy);
-    END;
-(* #### *)
+(* #### *
+ * #### *)
     f.ReadPast(endRc); 
     RETURN rslt;
   END recordType;
@@ -1593,6 +1611,7 @@ MODULE NewSymFileRW;
     newI := Id.newTypId(NIL);
     newI.SetMode(f.iAtt);
     newI.hash := Nh.enterStr(f.strAtt);
+	newI.SetNameFromHash(newI.hash);
     newI.type := f.getTypeFromOrd(); 
     newI.dfScp := f.impS;
     oldI := testInsert(newI, f.impS);
@@ -2056,6 +2075,13 @@ MODULE NewSymFileRW;
       END;
     ELSE RTS.Throw("Missing keySy");
     END; 
+    (* FIXME -- parse optional comment 
+    f.GetSym();
+    IF f.sSym = strSy THEN
+      Console.WriteString(f.strAtt);
+      Console.WriteLn;
+    END;
+	*)
   END SymFile;
 
 (* ============================================================ *)

gpcp/PeTarget.cp

@@ -0,0 +1,34 @@
+
+
+(* ============================================================ *)
+(*  Return the PE-file target emitter. .JVM version             *)
+(*  Copyright (c) John Gough 2018.                              *)
+(* ============================================================ *)
+(* ============================================================ *)
+
+MODULE PeTarget;
+
+  IMPORT 
+        RTS,
+        GPCPcopyright,
+        MsilUtil;
+
+(* ============================================================ *)
+(*                       Factory Method                         *)
+(* ============================================================ *)
+
+  PROCEDURE newPeFile*(
+     IN nam : ARRAY OF CHAR; isDll : BOOLEAN) : MsilUtil.MsilFile;
+  BEGIN
+    IF RTS.defaultTarget = "net" THEN
+      THROW("Wrong version of PeTarget compiled");
+    ELSE
+      THROW("Reflection Emit emitter not available on JVM"); 
+    END;
+  END newPeFile;
+
+(* ============================================================ *)
+(* ============================================================ *)
+END PeTarget.
+(* ============================================================ *)
+(* ============================================================ *)

gpcp/PeTargetForJVM.cp

@@ -0,0 +1,34 @@
+
+
+(* ============================================================ *)
+(*  Return the PE-file target emitter. .JVM version             *)
+(*  Copyright (c) John Gough 2018.                              *)
+(* ============================================================ *)
+(* ============================================================ *)
+
+MODULE PeTarget;
+
+  IMPORT 
+        RTS,
+        GPCPcopyright,
+        MsilUtil;
+
+(* ============================================================ *)
+(*                       Factory Method                         *)
+(* ============================================================ *)
+
+  PROCEDURE newPeFile*(
+     IN nam : ARRAY OF CHAR; isDll : BOOLEAN) : MsilUtil.MsilFile;
+  BEGIN
+    IF RTS.defaultTarget = "net" THEN
+      THROW("Wrong version of PeTarget compiled");
+    ELSE
+      THROW("Reflection Emit emitter not available on JVM"); 
+    END;
+  END newPeFile;
+
+(* ============================================================ *)
+(* ============================================================ *)
+END PeTarget.
+(* ============================================================ *)
+(* ============================================================ *)

gpcp/PeTargetForNET.cp

@@ -0,0 +1,34 @@
+
+
+(* ============================================================ *)
+(*  Return the PE-file target emitter. .NET version             *)
+(*  Copyright (c) John Gough 2018.                              *)
+(* ============================================================ *)
+(* ============================================================ *)
+
+MODULE PeTarget;
+
+  IMPORT 
+        RTS,
+        GPCPcopyright,
+        MsilUtil,
+        RefEmitUtil;
+
+(* ============================================================ *)
+(*                       Factory Method                         *)
+(* ============================================================ *)
+
+  PROCEDURE newPeFile*(
+     IN nam : ARRAY OF CHAR; isDll : BOOLEAN) : MsilUtil.MsilFile;
+  BEGIN
+    IF RTS.defaultTarget # "net" THEN
+      THROW("Wrong version of PeTarget compiled");
+    END;
+    RETURN RefEmitUtil.newPeFile(nam, isDll);
+  END newPeFile;
+
+(* ============================================================ *)
+(* ============================================================ *)
+END PeTarget.
+(* ============================================================ *)
+(* ============================================================ *)

gpcp/RefEmitHelpers.cp

@@ -0,0 +1,44 @@
+
+
+(* ============================================================ *)
+(*  RefEmitHelpers is the module which helps write PE files     *)
+(*  using the System.Reflection.Emit library.                   *)
+(*  Copyright (c) John Gough 2018.                              *)
+(* ============================================================ *)
+(* ============================================================ *)
+
+MODULE RefEmitHelpers;
+
+  IMPORT 
+        GPCPcopyright,
+        Mu  := MsilUtil,
+        Id  := IdDesc,
+        Lv  := LitValue,
+        Sy  := Symbols,
+        Ty  := TypeDesc,
+        Cs  := CompState,
+		Fn  := FileNames,
+
+        Sys    := "[mscorlib]System",
+        SysRfl := "[mscorlib]System.Reflection",
+        RflEmt := "[mscorlib]System.Reflection.Emit";
+
+(* ============================================================ *)
+
+  PROCEDURE binDir*() : Sys.String;
+  BEGIN
+    IF Cs.binDir = "" THEN RETURN NIL ELSE RETURN MKSTR(Cs.binDir$) END;
+  END binDir;
+
+(* ============================================================ *)
+
+  PROCEDURE CPtypeToCLRtype*(cpTp : Sy.Type) : Sys.Type;
+  BEGIN
+    RETURN NIL;
+  END CPtypeToCLRtype;
+
+(* ============================================================ *)
+(* ============================================================ *)
+END RefEmitHelpers.
+(* ============================================================ *)
+(* ============================================================ *)

gpcp/RefEmitUtil.cp

@@ -0,0 +1,451 @@
+
+(* ============================================================ *)
+(*  RefEmitUtil is the module which writes PE files using the   *)
+(*  System.Reflection.Emit library                              *)
+(*  Copyright (c) John Gough 2018.                              *)
+(* ============================================================ *)
+(* ============================================================ *)
+
+MODULE RefEmitUtil;
+
+  IMPORT 
+        GPCPcopyright,
+        Mu  := MsilUtil,
+        Id  := IdDesc,
+        Lv  := LitValue,
+        Sy  := Symbols,
+        Ty  := TypeDesc,
+        Cs  := CompState,
+
+        RflHlp := RefEmitHelpers,
+
+        Sys    := "[mscorlib]System",
+        SysRfl := "[mscorlib]System.Reflection",
+        RflEmt := "[mscorlib]System.Reflection.Emit";
+
+(* ============================================================ *)
+
+  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;
+                  *)
+                      mBldr  : RflEmt.ModuleBuilder;   (* Private  *)
+                      aBldr- : RflEmt.AssemblyBuilder; (* ReadOnly *)
+                      cBldr- : RflEmt.TypeBuilder;     (* ReadOnly *)
+                      ilGen- : RflEmt.ILGenerator;     (* ReadOnly *)
+                    END;
+
+(* ============================================================ *)
+
+  TYPE PeLabel*   = POINTER TO RECORD (Mu.Label)
+                      labl : RflEmt.Label;
+                    END;
+
+(* ============================================================ *)
+(*                    Constructor Method                        *)
+(* ============================================================ *)
+
+  PROCEDURE newPeFile*(IN nam : ARRAY OF CHAR; isDll : BOOLEAN) : PeFile;
+    VAR bldr : RflEmt.AssemblyBuilder;
+        asNm : SysRfl.AssemblyName;
+        name : Sys.String;          (* simple dst name *)
+        bnDr : Sys.String;          (* binDir, or NIL  *)
+        rslt : PeFile;
+  BEGIN
+   (*
+    *   FIXME Maybe need to check if tgXtn reference need to be zapped?
+    *   FIXME Maybe need to initialize RTS types?
+    *)
+    NEW(rslt);
+    name := MKSTR(nam);
+   (* 
+    *  Make the destination filename and AssemblyName
+    *)
+    IF isDll THEN
+      rslt.outN := BOX(nam + ".dll");
+    ELSE
+      rslt.outN := BOX(nam + ".exe");
+    END;
+    asNm := SysRfl.AssemblyName.init(name);
+   (*
+    *  Create the destination directory 
+    *  name as native string - or NIL.
+    *)
+    bnDr := RflHlp.binDir();
+   (*
+    *  Now the AssemblyBuilder and ModuleBuilder
+    *)
+    rslt.aBldr := Sys.AppDomain.get_CurrentDomain().DefineDynamicAssembly(
+                            asNm, RflEmt.AssemblyBuilderAccess.Save, bnDr);
+    rslt.mBldr := rslt.aBldr.DefineDynamicModule(
+                            name, MKSTR(rslt.outN^), Cs.debug);
+    RETURN rslt;
+  END newPeFile;
+
+(* ============================================================ *)
+
+  PROCEDURE (t : PeFile)fileOk*() : BOOLEAN;
+  BEGIN
+   (* For this emitter file is created at end. *)
+    RETURN TRUE;
+  END fileOk;
+
+(* ============================================================ *)
+
+  PROCEDURE (os : PeFile)MkNewProcInfo*(proc : Sy.Scope);
+  BEGIN
+    NEW(os.proc);
+    Mu.InitProcInfo(os.proc, proc);
+  END MkNewProcInfo;
+
+(* ============================================================ *)
+
+  PROCEDURE (os : PeFile)newLabel*() : Mu.Label;
+    VAR rslt : PeLabel;
+        ilLb : RflEmt.Label;
+  BEGIN
+    RETURN NIL;
+    (*
+    ASSERT(os.ilGen # NIL);
+    NEW(rslt);
+    ilLb := os.ilGen.DefineLabel();
+    *)
+  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 RefEmitUtil.
+(* ============================================================ *)
+(* ============================================================ *)

gpcp/StatDesc.cp

@@ -539,7 +539,7 @@ MODULE StatDesc;
           ELSIF (rTp # lTp) & ~s.rhsX.isProcLit() THEN s.StmtError(191);
           END;
         END;
-      ELSE (* sort out which error to report *)
+      ELSE (* Not assign compatible: which error to report? *)
         IF    rTp.isOpenArrType() THEN eNm := 142;
         ELSIF rTp.isExtnRecType() THEN eNm := 143;
         ELSIF (rTp.kind = T.prcTp) &
@@ -578,8 +578,8 @@ MODULE StatDesc;
         ELSE
           rExp := s.retX.exprAttr();
           s.retX := rExp;
-          xTyp := rExp.type;
           IF rExp # NIL THEN (* fixed 28 July 2001 *)
+            xTyp := rExp.type;
             IF ~rTyp.assignCompat(rExp) THEN
               D.RepTypesErrTok(76, rTyp, xTyp, s.token);
             ELSIF rTyp # xTyp THEN

gpcp/SymbolFile.cp

@@ -1,7 +1,8 @@
 (* ==================================================================== *)
 (*                                                                      *)
 (*  SymFileRW:  Symbol-file reading and writing for GPCP.               *)
-(*      Copyright (c) John Gough 1999, 2000.                            *)
+(*      Currently only used by the CPMake tool.                         *)
+(*      Copyright (c) John Gough 1999, 2018.                            *)
 (*                                                                      *)
 (* ==================================================================== *)
 

gpcp/Symbols.cp

@@ -45,7 +45,7 @@ MODULE Symbols;
     mMsk*  = { 0 ..  7};  main*   =  0; weak*  =  1; need*  =  2;
                           fixd*   =  3; rtsMd* =  4; anon*  =  5;
                           clsTp*  =  6; frnMd* =  7;
-    rMsk*  = { 8 .. 15};  noNew*  =  8; asgnd* =  9; noCpy* = 10;
+    rMsk*  = { 8 .. 15};  noNew*  =  8; valTp* =  9; noCpy* = 10;
                           spshl*  = 11; xCtor* = 12;
     fMsk*  = {16 .. 23};  isFn*   = 16; extFn* = 17; fnInf* = 18;
     dMsk*  = {24 .. 31};  cMain*  = 24; wMain* = 25; sta*   = 26;
@@ -267,7 +267,7 @@ MODULE Symbols;
 	ELSE RETURN MKSTR(NameHash.charOpenOfHash(t.hash)^);
 	END;
   END toString;
- * ============================================================ *) 
+ * ============================================================ *)
 (* ============================================================ *)
 
  

gpcp/TypeDesc.cp

@@ -48,9 +48,13 @@ MODULE TypeDesc;
     metaN*  = 16;
 
   CONST (* record attributes *)
-    noAtt* = 0; isAbs* = 1; limit* = 2;
-    extns* = 3; iFace* = 4;
-    cmpnd* = 5;   (* Marker for Compound Types                  *)
+    noAtt* = 0; 
+    isAbs* = 1;   (* Abstract record type   *)
+    limit* = 2;   (* Limited record type    *)
+    extns* = 3;   (* Extensible record type *)
+    iFace* = 4;   (* Interface record type  *)
+    cmpnd* = 5;   (* Marker for Compound Types      *)
+    (* All of the previous attributes are exclusive *)
     noNew* = 8;   (* These two attributes are really for xAttr, *)
     valRc* = 16;  (* but piggy-back on recAtt in the symbolfile *)
     clsRc* = 32;  (* but piggy-back on recAtt in the symbolfile *)
@@ -718,6 +722,9 @@ MODULE TypeDesc;
 
   PROCEDURE (t : Record)valCopyOK*() : BOOLEAN;
   BEGIN
+  (* Value copies should be allowed for foreign  *)
+  (* value types that are inextensible with      *)
+  (* base type equal to System.ValueType.        *)
     RETURN ~(Sy.noCpy IN t.xAttr);
   END valCopyOK;
 

gpcp/build.xml

@@ -37,6 +37,7 @@
     <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="PeTargetForJVM.cp" tofile="PeTarget.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}"/>
@@ -69,6 +70,8 @@
                 <arg value="-nowarn"/>
                 <arg value="-asm8"/>
 		<arg value="-clsdir:staging/browse"/>
+                <arg value="BrowseLookup.cp"/>
+                <arg value="BrowsePopups.cp"/>
                 <arg value="Browse.cp"/>
 	    </java>
     </target>

gpcp/gpcp.cp

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

gpcp/n2state.cp

@@ -2,7 +2,8 @@
 (* ================================================================ *)
 (*                                                                  *)
 (*  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, originally using the PERWAPI   *)
+(*  interface but since v1.4.06 using System.Reflection library.    *)
 (*                                                                  *)
 (*  Copyright QUT 2004 - 2005.                                      *)
 (*                                                                  *)
@@ -37,6 +38,7 @@ MODULE N2State;
         abtMsg = " ... Aborting";
         usgMsg1 = 'Usage: "PeToCps /mscorlib [options]"';
         usgMsg2 = '       "PeToCps [options] filenames"';
+		comment = "Creator PeToCps " + GPCPcopyright.verStr;
 
  (* ---------------------------------------------------------- *)
 
@@ -308,11 +310,10 @@ MODULE N2State;
  (* ---------------------------------------------------------- *)
 
   PROCEDURE EmitSymbolfile*(blk : Id.BlkId);
+    CONST suffix = "Executable code is found in ";
   BEGIN
-    RW.EmitSymfile(blk);
-    Message(" Output file <" +
-            Nh.charOpenOfHash(blk.hash)^ + 
-            ".cps> created");
+    RW.EmitSymfileAndComment(blk, BOX(comment), BOX(suffix + srcNam^));
+    Message(" Output file <" + Nh.charOpenOfHash(blk.hash)^ + ".cps> created");
   END EmitSymbolfile;
 
  (* ---------------------------------------------------------- *)

libs/csharp/RTS.cs

@@ -519,11 +519,39 @@ public class RTS
 				     char[] str)
 	{
 	 // System.String lls = System.Convert.ToString(num);
-#if BETA1
-            System.String lls = ((System.Single) num).ToString();
-#else //BETA2
             System.String lls = ((System.Single) num).ToString("R");
-#endif
+            int    len = lls.Length;
+            lls.CopyTo(0, str, 0, len);
+            str[len] = '\0';
+	}
+
+/* ------------------------------------------------------------ */
+//  PROCEDURE SRealToStrInvar*(r : SHORTREAL; OUT s : ARRAY OF CHAR);
+//  (** Decode a CP REAL into an array *)
+//  BEGIN END SRealToStr;
+//
+	// Known in ILASM as [RTS]RTS::SRealToStr
+	public static void SRealToStr(float num,
+				     char[] str)
+	{
+	 // System.String lls = System.Convert.ToString(num);
+            System.String lls = ((System.Single) num).ToString("R", invarCulture);
+            int    len = lls.Length;
+            lls.CopyTo(0, str, 0, len);
+            str[len] = '\0';
+	}
+
+/* ------------------------------------------------------------ */
+//  PROCEDURE SRealToStrLocal*(r : SHORTREAL; OUT s : ARRAY OF CHAR);
+//  (** Decode a CP REAL into an array *)
+//  BEGIN END SRealToStr;
+//
+	// Known in ILASM as [RTS]RTS::SRealToStr
+	public static void SRealToStr(float num,
+				     char[] str)
+	{
+	 // System.String lls = System.Convert.ToString(num);
+            System.String lls = ((System.Single) num).ToString("R", currentCulture);
             int    len = lls.Length;
             lls.CopyTo(0, str, 0, len);
             str[len] = '\0';
@@ -553,12 +581,8 @@ public class RTS
 	public static void RealToStrInvar(double num,
 				          char[] str)
 	{
-#if BETA1
-	    System.String lls = System.Convert.ToString(num);
-#else //BETA2
             System.String lls = 
                         ((System.Double) num).ToString("R", invarCulture);
-#endif
             int    len = lls.Length;
             lls.CopyTo(0, str, 0, len);
             str[len] = '\0';
@@ -573,12 +597,8 @@ public class RTS
 	public static void RealToStrLocal(double num,
 				          char[] str)
 	{
-#if BETA1
-	    System.String lls = System.Convert.ToString(num);
-#else //BETA2
             System.String lls = 
                         ((System.Double) num).ToString("R", currentCulture);
-#endif
             int    len = lls.Length;
             lls.CopyTo(0, str, 0, len);
             str[len] = '\0';

libs/java/GPBinFiles.java

@@ -132,7 +132,12 @@ public class GPBinFiles {
   }
 
   public static int readByte(GPBinFiles_FILE cpf) throws IOException {
-    return cpf.rf.readUnsignedByte();
+    try {
+      return cpf.rf.readUnsignedByte();
+    }
+    catch (EOFException x) {
+      return -1; // Compatibility with .NET version.
+    }
   } 
 
   public static int readNBytes(GPBinFiles_FILE cpf, byte[] buff, 

libs/java/RTS.java

@@ -277,7 +277,7 @@ public final class RTS
 //  (* Three versions for different cultures.  *Invar uses invariant culture *)
 //  (*                                         *Local uses current locale    *)
 //  (* StrToReal & RealToStr do not behave the same on JVM and CLR.          *)
-//  (* They is provided for compatability with versions < 1.3.1              *)
+//  (* They are provided for compatability with versions < 1.3.1              *)
 //  (* ------------------- Low-level String Conversions -------------------- *)
 //  
 //    PROCEDURE StrToReal*(IN  s  : ARRAY OF CHAR;