k_john_gough_cp 13 anni fa
parent
commit
2e681545b9
80 ha cambiato i file con 6121 aggiunte e 548 eliminazioni
  1. 110 0
      J2CPS/ArrayDesc.java
  2. 27 0
      J2CPS/CPWords.java
  3. 522 0
      J2CPS/ClassDesc.java
  4. 59 0
      J2CPS/ClassRef.java
  5. 210 0
      J2CPS/ConstantPool.java
  6. 65 0
      J2CPS/FieldInfo.java
  7. 19 0
      J2CPS/FieldRef.java
  8. 24 0
      J2CPS/InterfaceMethodRef.java
  9. 79 0
      J2CPS/J2CPS.java
  10. 198 0
      J2CPS/J2CPSFiles.java
  11. 88 0
      J2CPS/MemberInfo.java
  12. 75 0
      J2CPS/MethodInfo.java
  13. 24 0
      J2CPS/MethodRef.java
  14. 43 0
      J2CPS/NameAndType.java
  15. 178 0
      J2CPS/PackageDesc.java
  16. 53 0
      J2CPS/PtrDesc.java
  17. 43 0
      J2CPS/Reference.java
  18. 36 0
      J2CPS/StringRef.java
  19. 894 0
      J2CPS/SymbolFile.java
  20. 154 0
      J2CPS/TypeDesc.java
  21. 209 205
      gpcp/Browse.cp
  22. 1 3
      gpcp/Builtin.cp
  23. 22 30
      gpcp/CPMake.cp
  24. 6 3
      gpcp/CPascalErrors.cp
  25. 2 1
      gpcp/CPascalG.cp
  26. 67 3
      gpcp/CPascalP.cp
  27. 119 46
      gpcp/CPascalS.cp
  28. 20 24
      gpcp/ClassUtil.cp
  29. 2 1
      gpcp/ClsToType.cp
  30. 10 0
      gpcp/CompState.cp
  31. 40 2
      gpcp/ExprDesc.cp
  32. 1 1
      gpcp/GPCPcopyright.cp
  33. 82 43
      gpcp/IlasmUtil.cp
  34. 16 7
      gpcp/JavaMaker.cp
  35. 1 0
      gpcp/JavaUtil.cp
  36. 104 7
      gpcp/LitValue.cp
  37. 5 4
      gpcp/ModuleHandler.cp
  38. 58 6
      gpcp/MsilMaker.cp
  39. 1 1
      gpcp/MsilUtil.cp
  40. 2 0
      gpcp/NameHash.cp
  41. 159 102
      gpcp/NewSymFileRW.cp
  42. 6 5
      gpcp/PeUtil.cp
  43. 6 5
      gpcp/PeUtilForNET.cp
  44. 11 1
      gpcp/RTS.cp
  45. 38 25
      gpcp/SymbolFile.cp
  46. 20 1
      gpcp/Symbols.cp
  47. 1 1
      gpcp/Target.cp
  48. 1 7
      gpcp/TypeDesc.cp
  49. 1 0
      gpcp/csharp/MsilAsm.cs
  50. 43 0
      gpcp/java/MsilAsm.java
  51. 25 0
      libs/cpascal/JvmMakeAll.bat
  52. 2 0
      libs/cpascal/MakeAll.bat
  53. 21 0
      libs/cpascal/ProgArgs.cp
  54. 19 2
      libs/cpascal/RTS.cp
  55. 15 0
      libs/cpascal/STA.cp
  56. 32 12
      libs/csharp/RTS.cs
  57. 180 0
      libs/java/CPJ.java
  58. 289 0
      libs/java/CPJrts.java
  59. 39 0
      libs/java/CPmain.java
  60. 105 0
      libs/java/Console.java
  61. 105 0
      libs/java/Error.java
  62. 149 0
      libs/java/GPBinFiles.java
  63. 15 0
      libs/java/GPBinFiles_FILE.java
  64. 38 0
      libs/java/GPFiles.java
  65. 16 0
      libs/java/GPFiles_FILE.java
  66. 146 0
      libs/java/GPTextFiles.java
  67. 15 0
      libs/java/GPTextFiles_FILE.java
  68. 26 0
      libs/java/MakeAll.bat
  69. 13 0
      libs/java/ProcType.java
  70. 57 0
      libs/java/ProgArgs.java
  71. 633 0
      libs/java/RTS.java
  72. 43 0
      libs/java/StdIn.java
  73. 17 0
      libs/java/VecBase.java
  74. 25 0
      libs/java/VecChr.java
  75. 24 0
      libs/java/VecI32.java
  76. 25 0
      libs/java/VecI64.java
  77. 25 0
      libs/java/VecR32.java
  78. 26 0
      libs/java/VecR64.java
  79. 24 0
      libs/java/VecRef.java
  80. 17 0
      libs/java/XHR.java

+ 110 - 0
J2CPS/ArrayDesc.java

@@ -0,0 +1,110 @@
+/**********************************************************************/
+/*                Array Descriptor class for J2CPS                    */
+/*                                                                    */   
+/*                      (c) copyright QUT                             */ 
+/**********************************************************************/
+package J2CPS;
+
+import java.io.*;
+
+public class ArrayDesc extends TypeDesc {
+  
+  static ArrayDesc[] arrayTypes = new ArrayDesc[10];
+  static int numArrayTypes = 0;
+
+  TypeDesc elemType;
+  PtrDesc ptrType;
+  int dim = 1;
+  TypeDesc ultimateElemType;
+  public int elemTypeFixUp = 0;
+
+  public ArrayDesc(int eF) {
+    typeOrd = TypeDesc.arrT;
+    name = "ARRAY OF " + eF;
+    elemTypeFixUp = eF;
+    writeDetails = true;
+  }
+
+  public ArrayDesc (int dimNum,TypeDesc eType,boolean makePtr) {
+    name = "ARRAY OF ";
+    writeDetails = true;
+    for (int i=1; i < dimNum; i++) {
+      name = name + "ARRAY OF ";
+    }
+    name = name + eType.name;
+    typeOrd = TypeDesc.arrT;
+    dim = dimNum;
+    ultimateElemType = eType; 
+    if (makePtr) {
+      ptrType = new PtrDesc(this);
+    }
+  }
+
+  public void SetPtrType(PtrDesc ptrTy) {
+    ptrType = ptrTy;
+  }
+
+  public static TypeDesc GetArrayType(String sig,int start,boolean getPtr) {
+    TypeDesc uEType;
+    if (sig.charAt(start) != '[') {
+      System.out.println(sig.substring(start) + " is not an array type!");
+      System.exit(1);
+    }
+    int dimCount = 0, ix = start;
+    while (sig.charAt(ix) == '[') { ix++; dimCount++; }
+    uEType = TypeDesc.GetType(sig,ix);
+    ArrayDesc thisArr = FindArrayType(dimCount,uEType,getPtr);
+    dimCount--;
+    ArrayDesc arrD = thisArr;
+    while (dimCount > 1) {
+      arrD.elemType = FindArrayType(dimCount,uEType,true);
+      if (arrD.elemType instanceof ArrayDesc) {
+        arrD = (ArrayDesc)arrD.elemType;
+      }
+      dimCount--; 
+    }
+    arrD.elemType = uEType;
+    if (getPtr) { return thisArr.ptrType; } else { return thisArr; }
+  }
+
+  public static ArrayDesc FindArrayType(int dimNum, TypeDesc eType,
+                                                               boolean mkPtr) {
+    for (int i=0; i < numArrayTypes; i++) {
+      if ((arrayTypes[i].dim == dimNum) && 
+          (arrayTypes[i].ultimateElemType == eType))  {
+        if (mkPtr && arrayTypes[i].ptrType == null) { 
+          arrayTypes[i].ptrType = new PtrDesc(arrayTypes[i]);
+        }
+        return arrayTypes[i];
+      }
+    }
+    arrayTypes[numArrayTypes++] = new ArrayDesc(dimNum,eType,mkPtr);
+    if (numArrayTypes == arrayTypes.length) {
+      ArrayDesc[] temp = arrayTypes;
+      arrayTypes = new ArrayDesc[numArrayTypes * 2];
+      for (int i=0; i < numArrayTypes; i++) {
+        arrayTypes[i] = temp[i];
+      } 
+    }
+    return arrayTypes[numArrayTypes-1];
+  }
+
+  public String getTypeMneumonic() {
+    return 'a' + elemType.getTypeMneumonic();
+  }
+
+  public void writeType(DataOutputStream out, PackageDesc thisPack) 
+                                                          throws IOException {
+    // Array = TypeHeader arrSy TypeOrd (Byte | Number | ) endAr.
+    out.writeByte(SymbolFile.arrSy);
+    SymbolFile.writeTypeOrd(out,elemType);
+    out.writeByte(SymbolFile.endAr); 
+  }
+
+  public void AddImport(ClassDesc thisClass) {
+    if (ultimateElemType instanceof ClassDesc) {
+      thisClass.AddImport((ClassDesc)ultimateElemType);
+    }
+  }
+
+}

+ 27 - 0
J2CPS/CPWords.java

@@ -0,0 +1,27 @@
+/**********************************************************************/
+/*      Class defining the Component Pascal reserved words            */ 
+/*                                                                    */
+/*                    (c) copyright QUT                               */
+/**********************************************************************/
+package J2CPS;
+
+import java.util.*;
+
+public class CPWords {
+
+  private static final String[] reservedWords = 
+    {"ARRAY","BEGIN","BY","CASE","CLOSE","CONST","DIV","DO","ELSE",
+     "ELSIF","END","EXIT","FOR","IF","IMPORT","IN","IS","LOOP","MOD",
+     "MODULE","NIL","OF","OR","OUT","POINTER","PROCEDURE","RECORD",
+     "REPEAT","RETURN","THEN","TO","TYPE","UNTIL","VAR","WHILE","WITH"};
+
+  public static HashMap<String,String> InitResWords() {
+    HashMap<String,String> hTable = new HashMap<String,String>();
+    for (int i=0; i < reservedWords.length; i++) {
+      hTable.put(reservedWords[i],reservedWords[i]);
+    }
+    return hTable;
+  }
+
+
+}

+ 522 - 0
J2CPS/ClassDesc.java

@@ -0,0 +1,522 @@
+/**********************************************************************/
+/*                Class Descriptor class for J2CPS                    */
+/*                                                                    */   
+/*                      (c) copyright QUT                             */ 
+/**********************************************************************/
+package J2CPS;
+
+import java.io.*;
+import java.util.*;
+
+public class ClassDesc extends TypeDesc  {
+
+  private static final int MAJOR_VERSION = 45;
+  private static final int MINOR_VERSION = 3;
+  private static final char qSepCh = '/';
+  private static final char jSepCh = '.';
+  private static final char nSepCh = '_';
+  private static HashMap<String,ClassDesc> classList = new HashMap<String,ClassDesc>();
+  private static final String jlString = "java.lang.String";
+  private static final String jlObject = "java.lang.Object";
+
+  private static final int noAtt = 0;  // no record attribute in cp
+  private static final int absR  = 1;  // ABSTRACT record in cp
+  private static final int limR  = 2;  // LIMITED record in cp
+  private static final int extR  = 3;  // EXTENSIBLE record in cp
+  private static final int iFace = 4;  // JAVA interface 
+  private static HashMap<String,String> resWords = CPWords.InitResWords();
+
+  public static boolean verbose = false;
+  public static boolean overloadedNames = true;
+
+
+  ConstantPool cp;
+  ClassDesc superClass;
+  int access, outBaseTypeNum=0, superNum=0, numInts=0, intNums[];
+  public String qualName, javaName, objName;
+  ClassDesc interfaces[];
+  FieldInfo fields[];
+  MethodInfo methods[];
+  boolean isInterface = false, read = false, done = false;
+  public boolean hasNoArgConstructor = false;
+  public ArrayList imports = new ArrayList();
+  public ArrayList fieldList = new ArrayList();
+  public ArrayList methodList = new ArrayList();
+  HashMap scope = new HashMap();
+
+  public ClassDesc() {
+    typeOrd = TypeDesc.classT;
+  }
+
+  public ClassDesc(String thisName, PackageDesc pack) {
+    typeOrd = TypeDesc.classT;
+    qualName = thisName;
+    MakeJavaName();
+    classList.put(qualName,this);
+    if (pack == null) {
+      packageDesc = PackageDesc.getClassPackage(qualName);
+    } else { packageDesc = pack; }
+  }
+
+  public ClassDesc(int inNum) {
+    inBaseTypeNum = inNum; 
+  }
+
+  public String getTypeMneumonic() {
+    if (javaName.equals(jlString)) {
+      return "S";
+    } else if (javaName.equals(jlObject)) {
+      return "O";
+    } else {
+      return "o";
+    }
+  }
+
+  private boolean ReadClassFileDetails(DataInputStream stream)
+                                                       throws IOException {
+    read = true;
+    int count;
+    ClassRef tmp;
+    /* read and check the magic number */
+    if (stream.readInt() != 0xCAFEBABE) {
+      System.out.println("Bad magic number");
+      System.exit(0);
+    }
+    /* read and check the minor and major version numbers  */
+    int minorVersion = stream.readUnsignedShort();
+   /* if (minorVersion > MINOR_VERSION) {
+	System.out.println("Unsupported Java minor version " +
+				String.valueOf(minorVersion));
+	System.exit(0);
+    }
+*/
+    int majorVersion = stream.readUnsignedShort();
+ /*   if (majorVersion != MAJOR_VERSION) {
+      System.out.println("Unsupported Java major version " + 
+			 String.valueOf(majorVersion));
+      System.exit(0);
+    }
+*/
+    cp = new ConstantPool(stream);
+    access = stream.readUnsignedShort(); 
+    ClassRef thisClass = (ClassRef) cp.Get(stream.readUnsignedShort());
+    String clName = thisClass.GetName();
+    if (!qualName.equals(clName)) {
+      if (clName.startsWith(packageDesc.name)) {
+        if (verbose) { System.out.println(clName + " IS PART OF PACKAGE " + 
+                                          packageDesc.name + " but name is not "
+                                          + qualName); }
+      } else {
+        if (verbose) { System.out.println(clName + " IS NOT PART OF PACKAGE " + 
+                         packageDesc.name + "  qualName = " + qualName); }
+        packageDesc = PackageDesc.getClassPackage(qualName);
+        return false;
+      } 
+      classList.remove(qualName);
+      qualName = clName;
+      MakeJavaName();
+      classList.put(qualName,this);
+    }
+    isInterface = cp.isInterface(access);
+    int superIx = stream.readUnsignedShort();
+    if (superIx > 0) {
+      tmp = (ClassRef) cp.Get(superIx);
+      superClass = tmp.GetClassDesc();
+    }
+    /* get the interfaces implemented by this class */
+    count = stream.readUnsignedShort();
+    interfaces = new ClassDesc[count];
+    for (int i = 0; i < count; i++) {
+      tmp = (ClassRef) cp.Get(stream.readUnsignedShort());
+      interfaces[i] = tmp.GetClassDesc();
+      AddImport(interfaces[i]);
+    }
+    /* get the fields for this class */ 
+    count = stream.readUnsignedShort();
+    if (verbose) {System.out.println("There are " + count + " fields");}
+    fields = new FieldInfo[count];
+    for (int i = 0; i < count; i++) {
+      fields[i] = new FieldInfo(cp,stream,this);
+    }
+    /* get the methods for this class */ 
+    count = stream.readUnsignedShort();
+    if (verbose) { System.out.println("There are " + count + " methods"); }
+    methods = new MethodInfo[count];
+    for (int i = 0; i < count; i++) {
+      methods[i] = new MethodInfo(cp,stream,this);
+    }
+    /* ignore the rest of the classfile (ie. the attributes) */ 
+    if (verbose) { System.out.println("Finished reading class file"); }
+    if (verbose) { PrintClassFile(); Diag(); }
+    cp.EmptyConstantPool();
+    cp = null;
+    return true;
+  }
+
+  public void AddImport(ClassDesc aClass) {
+   if ((aClass != this) && (aClass.packageDesc != this.packageDesc) &&
+        (!imports.contains(aClass.packageDesc))) {
+      imports.add(aClass.packageDesc);
+    }
+  }
+
+/*
+ *public boolean ReadClassFile(File cFile) throws IOException {
+ *  DataInputStream in = new DataInputStream(new FileInputStream(cFile));
+ *  if (verbose) { System.out.println("Reading Class File <"+qualName+">"); }
+ *  return ReadClassFileDetails(in);
+ *}
+ */
+
+  public boolean ReadClassFile(File cFile) throws IOException {
+    boolean result;
+    DataInputStream in = new DataInputStream(new FileInputStream(cFile));
+    if (verbose) { System.out.println("Reading Class File <"+qualName+">"); }
+    result = ReadClassFileDetails(in);
+    // close the file or run out of file handles!
+    in.close();
+    return result;
+  }
+
+  public static ClassDesc GetClassDesc(String name, PackageDesc pack) {
+    if (name.indexOf(jSepCh) != -1) { name = name.replace(jSepCh,qSepCh); }
+    ClassDesc aClass = (ClassDesc)classList.get(name);
+    if (aClass == null) { aClass = new ClassDesc(name,pack); }
+    return aClass;
+  }
+
+  public void PrintClassFile() {
+    int i;
+    System.out.println("ClassFile for " + qualName);
+    cp.PrintConstantPool();
+    System.out.print("THIS CLASS = ");
+    System.out.print(ConstantPool.GetAccessString(access));
+    System.out.println(qualName);      
+    if (superClass != null) { 
+      System.out.println("SUPERCLASS = " + superClass.qualName); 
+    }
+    System.out.println("INTERFACES IMPLEMENTED");
+    for (i = 0; i < interfaces.length; i++) {
+      System.out.println("  " + interfaces[i].qualName);
+    }
+    System.out.println("FIELDS");
+    for (i=0; i < fields.length; i++) {
+      System.out.println("  " + fields[i].toString() + ";");
+    }
+    System.out.println("METHODS");
+    for (i=0; i < methods.length; i++) {
+      System.out.println("  " + methods[i].toString());
+    }
+    System.out.println();
+  }
+
+  public void Diag() {
+    System.out.println("CLASSDESC");
+    System.out.println("name = " + name);
+    System.out.println("javaName = " + javaName);
+    System.out.println("qualName = " + qualName);
+    System.out.println();
+  }
+
+  private static void AddField(FieldInfo f,HashMap scope) throws IOException {
+    int fNo = 1;
+    String origName = f.name;
+    while (scope.containsKey(f.name)) {
+      f.name = origName + String.valueOf(fNo);
+      fNo++;
+    }
+    scope.put(f.name,f);
+  }
+
+  private static int HashSignature(MethodInfo meth) {
+    int tot=0, sum=0, parNum = 1, end = meth.signature.indexOf(')');
+    boolean inPar = false;
+    for (int i=1; i < end; i++) {
+      char c = meth.signature.charAt(i);
+      sum += sum;
+      if (sum < 0) { sum++; }
+      sum += parNum * (int)c;
+      if (!inPar) {
+        if (c == 'L') { inPar = true; }
+        else if (c != '[')  { parNum++; tot += sum; } 
+      } else if (c == ';')  { inPar = false; parNum++; tot += sum; }
+    }
+    int hash = tot % 4099;
+    if (hash < 0) { hash = -hash; }
+    return hash;
+  }
+
+  private static void MakeMethodName(MethodInfo meth) {
+    boolean needHash = false;
+    if (meth.isInitProc) { meth.userName = "Init";
+    } else {
+      meth.userName = meth.name;
+    }
+    if (overloadedNames) { return; }
+    if (meth.parTypes.length > 0) { meth.userName += "_"; }
+    for (int i=0; i < meth.parTypes.length; i++) {
+      String next = meth.parTypes[i].getTypeMneumonic();
+      if (next.endsWith("o")) { needHash = true; }
+      meth.userName += next;
+    }
+    if (needHash) {
+      int hash = HashSignature(meth);
+      meth.userName += ("_" + String.valueOf(hash)); 
+    }
+  }
+
+  private static void AddMethod(MethodInfo meth, HashMap<String,MethodInfo> scope) 
+                                                          throws IOException {
+    int methNo = 1;
+    if (meth.userName == null) { MakeMethodName(meth); }
+    String origName = meth.userName;
+    while (scope.containsKey(meth.userName)) {
+      meth.userName = origName + String.valueOf(methNo);
+      methNo++;
+    }
+    scope.put(meth.userName,meth);
+  }
+
+  public void MakeJavaName() {
+    javaName = qualName.replace(qSepCh,jSepCh);
+    objName = javaName.substring(javaName.lastIndexOf(jSepCh)+1);
+    name = javaName.replace(jSepCh,nSepCh);
+  }
+
+  private void AddInterfaceImports(ClassDesc aClass) {
+    // if (interfaces.length > 0) {
+    if (interfaces != null && interfaces.length > 0) {
+      for (int i=0; i < interfaces.length; i++) {
+        aClass.AddImport(interfaces[i]);
+        interfaces[i].AddInterfaceImports(aClass);
+      }
+    }
+  }
+
+  public void GetSuperImports() {
+    if (done) { return; }
+    if (verbose) { System.out.println("GetSuperImports of " + javaName); }
+    if (isInterface) { AddInterfaceImports(this); }
+    if (superClass != null) {
+      if (!superClass.done) { superClass.GetSuperImports(); }
+    }
+    if (methods != null) { // guard added
+      for (int i=0; i < methods.length; i++) {
+        MethodInfo mth = methods[i];
+        MakeMethodName(mth);
+        if (mth.isExported() && !mth.deprecated) {
+          if ((!mth.isInitProc) && (!mth.isStatic())) {
+            MethodInfo meth = GetOverridden(mth,mth.owner);
+            if (meth != null) { mth.overridding = true; }
+          }
+        }
+      }
+    }
+    done = true;
+  }
+
+  public void GetSuperFields(HashMap jScope) throws IOException {
+    if (done) { return; }
+    if (verbose) { System.out.println("GetSuperFields of " + javaName); }
+    if (isInterface) { AddInterfaceImports(this); }
+    if (superClass != null) {
+      if (!superClass.done) { superClass.GetSuperFields(jScope); }
+      Iterator<String> enum1 = superClass.scope.keySet().iterator();
+      while (enum1.hasNext()) {
+        String methName = (String)enum1.next();
+        scope.put(methName, superClass.scope.get(methName));
+      }
+    }
+    for (int i=0; i < fields.length; i++) {
+      FieldInfo f = fields[i];
+      if (f.isExported()) { 
+        AddField(f,scope); 
+      }
+    } 
+    HashMap<String,MethodInfo> iScope = new HashMap<String,MethodInfo>();
+    for (int i=0; i < methods.length; i++) {
+      MethodInfo mth = methods[i];
+      MakeMethodName(mth);
+      if (mth.isExported() && !mth.deprecated) {
+        if (mth.isInitProc) {
+          AddMethod(mth,iScope); 
+        } else if (mth.isStatic()) {
+          AddMethod(mth,scope);
+        } else {
+          //if (scope.containsKey(mth.name)) {
+          if (scope.containsKey(mth.userName)) {
+            MethodInfo meth = GetOverridden(mth,mth.owner);
+            if (meth != null) {
+              mth.overridding = true;
+              mth.userName = meth.userName;
+              scope.remove(mth.userName);
+              scope.put(mth.userName,mth); 
+            } else {
+              AddMethod(mth,scope);
+            }
+          } else { 
+            AddMethod(mth,scope); 
+          }
+        }
+      }
+    } 
+    done = true;
+  }
+
+  private static MethodInfo GetOverridden(MethodInfo meth,ClassDesc thisClass) {
+    ClassDesc aClass = thisClass;
+    while (aClass.superClass != null) {
+      aClass = aClass.superClass;
+      if (aClass.methods != null) { // new guard
+        for (int i=0; i < aClass.methods.length; i++) {
+          if (aClass.methods[i].name.equals(meth.name)) {
+            if ((aClass.methods[i].signature != null)&&(meth.signature != null)){
+              if (aClass.methods[i].signature.equals(meth.signature)) {
+                return aClass.methods[i];
+              }
+            } else if (aClass.methods[i].parTypes.length == meth.parTypes.length){
+              boolean ok = true;
+              for (int j=0; (j < aClass.methods[i].parTypes.length)& ok; j++){
+                ok = aClass.methods[i].parTypes[j] == meth.parTypes[j]; 
+              }
+              if (ok) { return aClass.methods[i]; }
+            }
+          }
+        }
+      }
+    }  
+    return null;
+  }
+
+  public void CheckAccess() {
+    if (ConstantPool.isAbstract(access)) {
+      System.out.println(" is abstract ");
+    } else if (ConstantPool.isFinal(access)) {
+      System.out.println(" is final ");
+    } else {
+      System.out.println(" is default");
+    }
+  }
+
+  public void setRecAtt(int recAtt) {
+    if (recAtt >= 8) { recAtt -= 8; } else { hasNoArgConstructor = true; }
+    if (recAtt == absR) {
+      if (!ConstantPool.isAbstract(access)) {
+        access = access + ConstantPool.ACC_ABSTRACT;
+      }
+    } else if (recAtt == noAtt) {
+      if (!ConstantPool.isFinal(access)) {
+        access = access + ConstantPool.ACC_FINAL;
+      }
+    }
+  }
+
+  public void writeType(DataOutputStream out,PackageDesc thisPack) 
+                                                           throws IOException {
+    if (objName == null)  { this.MakeJavaName(); }
+    if (this.packageDesc != thisPack) {
+      out.writeByte(SymbolFile.fromS);
+// ------------
+      if (this.packageDesc.impNum < 0) {
+        System.out.println("impNum is " + this.packageDesc.impNum);
+        System.out.println("packageDesc " + this.packageDesc.javaName);
+        System.out.println("objName " + objName);
+        this.packageDesc.impNum = 0;
+      }
+// ------------
+      SymbolFile.writeOrd(out,this.packageDesc.impNum);
+      SymbolFile.writeName(out,access,objName);
+    } else if (!ConstantPool.isPublic(access)) {
+      out.writeByte(SymbolFile.fromS);
+      SymbolFile.writeOrd(out,0);
+      SymbolFile.writeName(out,access,objName);
+    }
+    if (!writeDetails) { return; }
+    out.writeByte(SymbolFile.ptrSy);
+    SymbolFile.writeOrd(out,outBaseTypeNum);
+    out.writeByte(SymbolFile.tDefS);
+    SymbolFile.writeOrd(out,outBaseTypeNum);
+    out.writeByte(SymbolFile.recSy);
+    int recAtt = 0;
+    if (!hasNoArgConstructor) { recAtt = 8; } 
+    if (ConstantPool.isFinal(access)) { 
+      out.writeByte(noAtt+recAtt); }
+    else if (isInterface) { 
+      out.writeByte(iFace+recAtt); }
+    else if (ConstantPool.isAbstract(access)) { 
+      out.writeByte(absR+recAtt); }
+    else { 
+      out.writeByte(extR+recAtt); }
+    if (isInterface) { out.writeByte(SymbolFile.truSy); } 
+    else { out.writeByte(SymbolFile.falSy); }
+    if (superClass != null) { 
+      out.writeByte(SymbolFile.basSy);
+      SymbolFile.writeTypeOrd(out,superClass); 
+    }
+    //if (interfaces.length > 0) {
+    if (interfaces != null && interfaces.length > 0) {
+      out.writeByte(SymbolFile.iFcSy);
+      for (int i = 0; i < interfaces.length; i++) {
+        out.writeByte(SymbolFile.basSy);
+        SymbolFile.writeTypeOrd(out,interfaces[i]); 
+      }
+    }
+    for (int i=0; i < fields.length; i++) {
+      if (fields[i].isExported() && !fields[i].isStatic()) {
+        SymbolFile.writeName(out,fields[i].accessFlags,fields[i].name);
+        SymbolFile.writeTypeOrd(out,fields[i].type);
+      }
+    }
+    for (int i=0; i < methods.length; i++) {
+      if (methods[i].isExported() && !methods[i].deprecated &&
+         !methods[i].isStatic() && !methods[i].isInitProc &&
+         !methods[i].isCLInitProc) {
+        out.writeByte(SymbolFile.mthSy);
+// --------------------
+        if (methods[i].userName == null) {
+          System.out.println("packageDesc " + this.packageDesc.javaName);
+          System.out.println("objName " + objName);
+          for (int j=0; j < methods.length; j++) {
+            System.out.println("Method " + j +  
+                (methods[i].userName == null ? " null" : methods[j].userName));
+          }
+        }
+// --------------------
+        SymbolFile.writeName(out,methods[i].accessFlags,methods[i].userName);
+        int attr = 0;
+        if (!methods[i].overridding) { attr = 1; }
+        if (methods[i].isAbstract()) { attr += 2; }
+        else if (!methods[i].isFinal()){ attr += 6; } 
+        out.writeByte(attr); 
+        out.writeByte(0); /* all java receivers are value mode */
+        SymbolFile.writeOrd(out,outTypeNum);
+        SymbolFile.writeString(out,methods[i].name);
+        SymbolFile.WriteFormalType(methods[i],out);
+      }
+    } 
+    for (int i=0; i < fields.length; i++) {
+      if (fields[i].isConstant()) {
+        out.writeByte(SymbolFile.conSy);
+        SymbolFile.writeName(out,fields[i].accessFlags,fields[i].name);
+        SymbolFile.writeLiteral(out,fields[i].GetConstVal());
+      } else if (fields[i].isExported() && fields[i].isStatic()) {
+        out.writeByte(SymbolFile.varSy);
+        SymbolFile.writeName(out,fields[i].accessFlags,fields[i].name);
+        SymbolFile.writeTypeOrd(out,fields[i].type);
+      }
+    }
+    for (int i=0; i < methods.length; i++) {
+      if (methods[i].isExported() && !methods[i].deprecated &&
+          methods[i].isStatic() && !methods[i].isCLInitProc) {
+        out.writeByte(SymbolFile.prcSy);
+        SymbolFile.writeName(out,methods[i].accessFlags,methods[i].userName);
+        SymbolFile.writeString(out,methods[i].name);
+        if (methods[i].isInitProc) { out.writeByte(SymbolFile.truSy); }
+        SymbolFile.WriteFormalType(methods[i],out);
+      }
+    }
+    out.writeByte(SymbolFile.endRc);
+  }
+
+
+}

+ 59 - 0
J2CPS/ClassRef.java

@@ -0,0 +1,59 @@
+/*************************************************************************/
+/*                Class Reference class for J2CPS                        */
+/* Represents the class references in the constant pool of a class file  */   
+/*                      (c) copyright QUT                                */ 
+/*************************************************************************/
+package J2CPS;
+
+import java.io.*;
+
+public class ClassRef {
+
+  ConstantPool cp;  /* the constant pool containing this class ref */
+  String name;      /* the name of this class */
+  int nameIndex;    /* the index into the constant pool */
+                    /* for the name of this class       */
+  ClassDesc info;   /* this class info for this class ref */
+  
+  public ClassRef(ConstantPool thisCp, int nameIndex) {
+    this.cp = thisCp;
+    this.nameIndex = nameIndex;
+  }
+ 
+  public String GetName() {
+    if (name == null) { name = (String) cp.Get(nameIndex); }
+    return name;
+  }
+  
+  public ClassDesc GetClassDesc() {
+    if (info == null) {
+      if (name == null) { name = (String) this.cp.Get(nameIndex); }
+      info = ClassDesc.GetClassDesc(name,null);
+    }
+    return info;
+  }
+
+  public boolean equals(ClassRef anotherClass) {
+    return this.GetName().equals(anotherClass.GetName());
+  }
+  
+  public void Resolve() {
+    if (name == null) { this.name = (String) this.cp.Get(nameIndex); }
+  }
+
+  public String toString() {
+    this.Resolve();
+    return ("<ClassReference> " + nameIndex + " " + name);
+  }
+
+}
+
+
+
+
+
+
+
+
+
+

+ 210 - 0
J2CPS/ConstantPool.java

@@ -0,0 +1,210 @@
+/**********************************************************************/
+/*                  ConstantPool class for J2CPS                      */
+/*                                                                    */   
+/*                      (c) copyright QUT                             */ 
+/**********************************************************************/
+package J2CPS;
+
+import java.io.*;
+
+/* The constant pool from the ClassFile */
+
+public class ConstantPool {
+
+  Object pool[];       /* the constant pool */
+
+  /* Tags for constant pool entries */
+  public final static int CONSTANT_Utf8               = 1;
+  public static final int CONSTANT_Unicode            = 2;
+  public final static int CONSTANT_Integer            = 3;
+  public final static int CONSTANT_Float              = 4;
+  public final static int CONSTANT_Long               = 5;
+  public final static int CONSTANT_Double             = 6;
+  public final static int CONSTANT_Class              = 7;
+  public final static int CONSTANT_String             = 8;
+  public final static int CONSTANT_Fieldref           = 9;
+  public final static int CONSTANT_Methodref          = 10;
+  public final static int CONSTANT_InterfaceMethodref = 11;
+  public final static int CONSTANT_NameAndType        = 12;
+  public final static int CONSTANT_Unknown            = 13;
+
+  /* access flags */
+  public static final int ACC_PUBLIC       = 0x0001;
+  public static final int ACC_PRIVATE      = 0x0002;
+  public static final int ACC_PROTECTED    = 0x0004;
+  public static final int ACC_STATIC       = 0x0008;
+  public static final int ACC_FINAL        = 0x0010;
+  public static final int ACC_SYNCHRONIZED = 0x0020;
+  public static final int ACC_VOLATILE     = 0x0040;
+  public static final int ACC_TRANSIENT    = 0x0080;
+  public static final int ACC_NATIVE       = 0x0100;
+  public static final int ACC_INTERFACE    = 0x0200;
+  public static final int ACC_ABSTRACT     = 0x0400;
+
+  public ConstantPool(DataInputStream stream) throws IOException {
+    /* read the number of entries in the constant pool */
+    int count = stream.readUnsignedShort();
+    /* read in the constant pool */ 
+    pool = new Object[count];
+    for (int i = 1; i < count; i++) {
+      Object c = ReadConstant(stream, i);
+      pool[i] = c;
+      /* note that Long and Double constant occupies two entries */
+      if (c instanceof Long || c instanceof Double) { i++; }
+    }
+    for (int i = 1; i < pool.length; i++) {
+      if (pool[i] instanceof Reference) { 
+        ((Reference)pool[i]).Resolve(); 
+      } else if (pool[i] instanceof ClassRef) {
+        ((ClassRef)pool[i]).Resolve();
+      }
+    }
+  }
+
+  public void EmptyConstantPool() {
+    for (int i = 1; i < pool.length; i++) {
+      pool[i] = null; 
+    }
+    pool = null;
+  }
+
+  private Object ReadConstant(DataInputStream stream, int index) 
+                                                            throws IOException {
+    int tag = stream.readUnsignedByte();
+    switch (tag) {
+    case CONSTANT_Utf8:
+      return new String(stream.readUTF());
+    case CONSTANT_Integer: 
+      return new Integer(stream.readInt());
+    case CONSTANT_Float: 
+      return new Float(stream.readFloat());
+    case CONSTANT_Long: 
+      return new Long(stream.readLong());
+    case CONSTANT_Double: 
+      return new Double(stream.readDouble());
+    case CONSTANT_Class: 
+      return new ClassRef(this,stream.readUnsignedShort());
+    case CONSTANT_String:
+      return new StringRef(this,stream.readUnsignedShort());
+    case CONSTANT_Fieldref:
+      return new FieldRef(this,stream.readUnsignedShort(),
+                               stream.readUnsignedShort());
+    case CONSTANT_Methodref:
+      return new MethodRef(this,stream.readUnsignedShort(), 
+                                      stream.readUnsignedShort());
+    case CONSTANT_InterfaceMethodref:
+      return new InterfaceMethodRef(this,stream.readUnsignedShort(),
+                                         stream.readUnsignedShort());
+    case CONSTANT_NameAndType:
+      return new NameAndType(this,stream.readUnsignedShort(), 
+                             stream.readUnsignedShort());
+    default:
+      System.out.println("Unrecognized constant type: "+String.valueOf(tag));
+	return null;
+    }
+  }
+  
+  public final Object Get(int index) {
+    return pool[index];
+  }
+
+  public int GetNumEntries() {
+    return pool.length;
+  }
+
+  /** Returns a String representing the Constant Pool */
+  public void PrintConstantPool() {
+    System.out.println(" CONSTANT POOL ENTRIES (" + pool.length + ")");
+    for (int i = 1; i < pool.length; i++) {
+      System.out.print(i + " ");
+      if (pool[i] instanceof String) { 
+        System.out.println("<String> " + pool[i]);
+      } else if (pool[i] instanceof Integer) {
+        System.out.println("<Integer> " + pool[i].toString());
+      } else if (pool[i] instanceof Float) {
+        System.out.println("<Float  > " + pool[i].toString());
+      } else if (pool[i] instanceof Long) {
+        System.out.println("<Long   > " + pool[i].toString());
+      } else if (pool[i] instanceof Double) {
+        System.out.println("<Double>  " + pool[i].toString());
+      } else {
+        System.out.println(pool[i].toString());
+      }
+      if (pool[i] instanceof Long || pool[i] instanceof Double) i++;
+    }
+    System.out.println();
+  }
+
+  /** Constructs a string from a set of access flags */
+  public static String GetAccessString(int flags) {
+    StringBuffer result = new StringBuffer();
+    if ((flags & ACC_PUBLIC) != 0) result.append("public ");
+    if ((flags & ACC_PRIVATE) != 0) result.append("private ");
+    if ((flags & ACC_PROTECTED) != 0) result.append("protected ");
+    if ((flags & ACC_STATIC) != 0) result.append("static ");
+    if ((flags & ACC_FINAL) != 0) result.append("final ");
+    if ((flags & ACC_SYNCHRONIZED) != 0) result.append("synchronized ");
+    if ((flags & ACC_VOLATILE) != 0) result.append("volatile ");
+    if ((flags & ACC_TRANSIENT) != 0) result.append("transient ");
+    if ((flags & ACC_NATIVE) != 0) result.append("native ");
+    if ((flags & ACC_INTERFACE) != 0) result.append("interface ");
+    if ((flags & ACC_ABSTRACT) != 0) result.append("abstract ");
+    return result.toString();
+  }
+
+  /** Check if a flag has the public bit set */
+  public static boolean isPublic(int flags) {
+    return (flags & ACC_PUBLIC) != 0;
+  }
+
+  /** Check if a flag has the private bit set */
+  public static boolean isPrivate(int flags) {
+    return (flags & ACC_PRIVATE) != 0;
+  }
+
+  /** Check if a flag has the protected bit set */
+  public static boolean isProtected(int flags) {
+    return (flags & ACC_PROTECTED) != 0;
+  }
+
+  /** Check if a flag has the final bit set */
+  public static boolean isFinal(int flags) {
+    return (flags & ACC_FINAL) != 0;
+  }
+
+  /** Check if a flag has the static bit set */
+  public static boolean isStatic(int flags) {
+    return (flags & ACC_STATIC) != 0;
+  } 
+
+  /** Check if a flag has the native bit set */
+  public static boolean isNative(int flags) {
+    return (flags & ACC_NATIVE) != 0;
+  }
+
+  /** Check if a flag has the interface bit set */
+  public static boolean isInterface(int flags) {
+    return (flags & ACC_INTERFACE) != 0;
+  }
+
+  /** Check if a flag has the abstract bit set */
+  public static boolean isAbstract(int flags) {
+    return (flags & ACC_ABSTRACT) != 0;
+  }
+
+  /** Check if a flag has the synchronized bit set */
+  public static boolean isSynchronized(int flags) {
+    return (flags & ACC_SYNCHRONIZED) != 0;
+  }
+
+  /** Check if a flag has the volatile bit set */
+  public static boolean isVolatile(int flags) {
+    return (flags & ACC_VOLATILE) != 0;
+  }
+
+  /** Check if a flag has the transient bit set */
+  public static boolean isTransient(int flags) {
+    return (flags & ACC_TRANSIENT) != 0;
+  }
+
+}

+ 65 - 0
J2CPS/FieldInfo.java

@@ -0,0 +1,65 @@
+/**********************************************************************/
+/*                    FieldInfo class for J2CPS                       */
+/*                                                                    */   
+/*                      (c) copyright QUT                             */ 
+/**********************************************************************/
+package J2CPS;
+
+import java.io.*;
+import java.util.*;
+
+public class FieldInfo extends MemberInfo {
+  
+  Object constVal;
+  public TypeDesc type;
+  public int typeFixUp = 0;
+
+  public FieldInfo(ConstantPool cp, DataInputStream stream,
+                   ClassDesc thisClass) throws IOException {
+    
+    super(cp,stream,thisClass);
+    type = TypeDesc.GetType(signature,0);
+    if (type instanceof ClassDesc) { thisClass.AddImport((ClassDesc)type); }
+  }
+
+  public FieldInfo(ClassDesc cl,int acc,String nam,TypeDesc typ,Object cVal) {
+    super(cl,acc,nam);
+    type = typ;
+    constVal = cVal;
+  }
+
+  public void AddImport(ClassDesc thisClass) {
+    if (type instanceof ClassDesc) { thisClass.AddImport((ClassDesc)type); }
+  }
+
+  public void GetConstValueAttribute (ConstantPool cp, DataInputStream stream) 
+                                                            throws IOException {
+    int attLen = stream.readInt();
+    constVal = cp.Get(stream.readUnsignedShort()); 
+    if (constVal instanceof StringRef) {
+      constVal = ((StringRef)constVal).GetString();
+    }
+  }
+
+  public Object GetConstVal() {
+    return constVal;
+  }
+
+  public boolean isConstant() {
+    return ((constVal != null) && ConstantPool.isFinal(accessFlags) &&
+            ConstantPool.isStatic(accessFlags) && 
+            (ConstantPool.isPublic(accessFlags) ||
+             ConstantPool.isProtected(accessFlags)));
+  }
+
+  public String toString() {
+    if (constVal == null) {
+      return ConstantPool.GetAccessString(accessFlags) + " " + 
+             signature + " " + name;
+    } else {
+      return ConstantPool.GetAccessString(accessFlags) + " " + 
+             signature + " " + name + " = " + constVal.toString();
+    }
+  }
+
+}

+ 19 - 0
J2CPS/FieldRef.java

@@ -0,0 +1,19 @@
+package J2CPS;
+
+public class FieldRef extends Reference {
+
+  public FieldRef(ConstantPool thisCp, int classIndex, int ntIndex) {
+    super(thisCp,classIndex,ntIndex);
+  }
+
+  public String getFieldName() {
+    return (classRef.GetName() + "." + name);
+  }
+
+  public String toString() {
+    this.Resolve();
+    return ("<FieldReference> " + classIndex + " " + nameAndTypeIndex + " " +
+            classRef.GetName() + "." + name + " : " + type);
+  }
+
+}

+ 24 - 0
J2CPS/InterfaceMethodRef.java

@@ -0,0 +1,24 @@
+/**********************************************************************/
+/*          Interface Method Reference class for J2CPS                */
+/*                                                                    */   
+/*                      (c) copyright QUT                             */ 
+/**********************************************************************/
+package J2CPS;
+
+public class InterfaceMethodRef extends Reference {
+
+  public InterfaceMethodRef(ConstantPool thisCp, int classIndex, int ntIndex) {
+    super(thisCp,classIndex,ntIndex);
+  }
+
+  public String getIntMethName() {
+    return (classRef.GetName() + "." + name + type);
+  }
+
+  public String toString() {
+    this.Resolve();
+    return ("<InterfaceMethReference>  Class " + classIndex + 
+            "  NameAndType " + nameAndTypeIndex);
+  }
+
+}

+ 79 - 0
J2CPS/J2CPS.java

@@ -0,0 +1,79 @@
+/**********************************************************************/
+/*                      Main class for J2CPS                          */
+/*                                                                    */   
+/*                      (c) copyright QUT                             */ 
+/**********************************************************************/
+package J2CPS;
+
+import java.util.*;
+import java.io.*;
+
+public class J2CPS {
+
+  /**
+   * Main program. Takes a package name as a parameter, produces the 
+   * component pascal symbol file.
+   */
+  public static void main(String args[]) { 
+    int argLen = args.length;
+    boolean anonPack = false;
+    J2CPSFiles.GetPaths();
+    String filename = null;
+    TypeDesc.InitTypes();
+    if (argLen == 0) {
+      System.err.println("J2CPS version 1.3.12 (Nov. 2011)");
+      System.err.println("Usage: java J2CPS [options] packagename");
+      System.err.println("Options may be in any order.");
+      System.err.println("  -d dir  symbol file directory");
+      System.err.println("  -u      use unique names");
+      System.err.println("  -v      verbose diagnostic messages");
+      System.exit(0);
+    }
+    else {
+      int argIx = 0;
+      filename = args[argIx];
+      while (filename.startsWith("-")) { 
+        /* parse options here */
+        if (filename.charAt(1) == 'v') { 
+          ClassDesc.verbose = true; 
+        } else if (filename.charAt(1) == 'f') { 
+          System.out.println("Class not package");
+          anonPack = true; 
+        } else if (filename.charAt(1) == 'u') { 
+          System.out.println("Using unique names");
+          ClassDesc.overloadedNames = false; 
+        } else if (filename.charAt(1) == 'd') {
+          if (argIx + 1 < argLen) {
+            filename = args[++argIx];
+            J2CPSFiles.SetSymDir(filename); 
+          } else {
+            System.err.println("-d option is missing directory name");
+          }
+        } else { 
+          System.err.println("Unknown option " + filename); 
+        }
+        if (argIx + 1 < argLen) {
+          filename = args[++argIx]; 
+        } else {
+          System.err.println("No package name given, terminating");
+          System.exit(1);
+        }
+      }
+    }
+    try {
+      PackageDesc thisPackage = new PackageDesc(filename, anonPack);
+      PackageDesc.ReadPackages();
+      PackageDesc.WriteSymbolFiles();
+    }
+    catch (IOException e) {
+	System.err.println("IOException occurs while reading input file.");
+	System.err.println("Aborting...");
+	System.exit(1);
+    }
+  } 
+
+
+}
+
+
+

+ 198 - 0
J2CPS/J2CPSFiles.java

@@ -0,0 +1,198 @@
+/**********************************************************************/
+/*                  J2CPS Files class for J2CPS                       */
+/*                                                                    */   
+/*                      (c) copyright QUT                             */ 
+/**********************************************************************/
+package J2CPS;
+
+import java.io.*;
+
+public class J2CPSFiles implements FilenameFilter {
+
+  private static final String classExt = ".class";
+  private static final String symExt = ".cps";
+  private static final String intExt = ".cp";
+  private static final String dbName = "index.dbi";
+  private static final String sepCh = System.getProperty("file.separator");
+  private static final char EOF = '\0';
+  private static final char CR  = '\r';
+  private static final char LF  = '\n';
+  private static final char SP  = ' ';
+  private static final char TAB  = '\t';
+  private static String currDir = System.getProperty("user.dir");
+  private static String symDir;
+  private static String[] classPath;
+  private static String[] symPath;
+  private static final char pathSep = 
+                            System.getProperty("path.separator").charAt(0);
+
+
+/* 
+ * Method for FilenameFilter
+ */
+
+  @Override
+  public boolean accept (File dir, String name) {
+    return name.endsWith(classExt); 
+  }
+
+  public static void SetSymDir(String sDir) {
+    symDir = sDir;
+    if (symDir == null) {
+      symDir = symPath[0];
+    }
+  }
+
+  public static void GetPaths() {
+    classPath = GetPath("java.class.path");
+    symPath = GetPath("CPSYM");
+  }
+
+  private static String GetPathFromProperty(String str) {
+    String path = System.getProperty(str);
+    //if (path != null)
+    //  System.out.println("Property " + str + " = " + path); 
+    return path;
+  }
+
+  private static String GetPathFromEnvVar(String str) {
+    String path = System.getenv(str);
+    //if (path != null)
+    //  System.out.println("Env. variable " + str + " = " + path); 
+    return path;
+  }
+
+  private static String[] GetPath(String prop) {
+    String paths[];
+    // First look for the system property (preferred source)
+    String cPath = GetPathFromProperty(prop);
+    if (cPath == null)
+      cPath = GetPathFromEnvVar(prop);
+
+    if (cPath == null) {
+      System.out.println("No variable for \"" + prop + "\", using \".\""); 
+      cPath = ".";
+    } else 
+      System.out.println("Using \"" + prop + "\" path \"" + cPath + "\""); 
+      
+    int i,count=1,start,end;
+    for (i=0; i > -1 ; i++ ) {
+      i = cPath.indexOf(pathSep,i); 
+      if (i > -1) { count++; } else { i--; } 
+    }
+    paths = new String[count+1];
+    paths[0] = currDir;
+    start = 0; i = 1; 
+    while (start < cPath.length()) {
+      end = cPath.indexOf(pathSep,start);
+      if (end == -1) { 
+        end = cPath.length()+1; 
+        paths[i] = cPath.substring(start);
+      } else {
+        paths[i] = cPath.substring(start,end);
+      }
+      if (paths[i].equals(".")) { paths[i] = currDir; }
+      i++;
+      start = end+1;
+    }
+    return paths;
+  }
+
+  public static File getPackageFile(String name) {
+    File inFile = new File(currDir,name);
+    if (!inFile.exists()) {
+      boolean found = false;
+      for (int i=0; (i < classPath.length) && (!found); i++) {
+        if (ClassDesc.verbose) {
+          System.out.println("<" + classPath[i] + sepCh + name + ">");
+        }
+        inFile = new File(classPath[i],name);
+        found = inFile.exists();
+      }
+      if (!found) {
+        System.err.println("Cannot open class directory <" + name + ">");
+        System.exit(0);
+      }
+    }
+    return inFile;
+  }
+
+  public static File OpenClassFile(String name) {
+    if (!name.endsWith(classExt)) { name = name.concat(classExt); }
+    File inFile = new File(currDir,name);
+    if (!inFile.exists()) {
+      inFile = FindClassFile(name);
+    }
+    if (!inFile.exists()) {
+      System.err.println("Cannot open class file <" + name + ">");
+      System.exit(0);
+    }
+    return inFile;
+  }
+
+
+  public static File OpenClassFile(File dir, String fName) {
+    File inFile = new File(dir,fName);
+    if (!inFile.exists()) {
+      System.err.println("Cannot open class file <" + dir.getName() +
+                                                 sepCh + fName + ">");
+      System.exit(0);
+    }
+    return inFile;
+  }
+  
+
+  public static File FindClassFile(String name) {
+    File inFile = null;
+    boolean found = false;
+    if (!name.endsWith(classExt)) { name = name.concat(classExt); }
+    for (int i=0; (i < classPath.length) && (!found); i++) {
+      if (ClassDesc.verbose) {
+        System.out.println("<" + classPath[i] + sepCh + name + ">");
+      }
+      inFile = new File(classPath[i],name);
+      found = inFile.exists();
+    }
+    if (!found) {
+      System.err.println("Cannot open class file <" + name + ">");
+      System.exit(0);
+    }
+    return inFile;
+  }
+
+  public static File FindSymbolFile(String name) 
+                                    throws FileNotFoundException, IOException {
+    File inFile = null;
+    boolean found = false;
+    if (!name.endsWith(symExt)) { name = name.concat(symExt); }
+    for (int i=0; (i < symPath.length) && (!found); i++) {
+      if (ClassDesc.verbose) {
+        System.out.println("<" + symPath[i] + sepCh + name + ">");
+      }
+      inFile = new File(symPath[i],name);
+      found = inFile.exists();
+    }
+    if (!found) {
+      if (ClassDesc.verbose) 
+        { System.out.println("Cannot find symbol file <" + name + ">"); }
+      return null;
+    }
+    return inFile;
+  }
+
+  public static DataOutputStream CreateSymFile(String fileName) 
+                                                          throws IOException {
+    String dirName;
+    if (symDir == null) { dirName = currDir; } else { dirName = symDir; }
+    if (ClassDesc.verbose) {  
+      System.out.println("Creating symbolfile " + fileName + symExt +
+                         " in directory " + dirName);
+    }
+    return new DataOutputStream(new FileOutputStream(
+                                new File(dirName,fileName + symExt)));
+  }
+
+}
+
+
+

+ 88 - 0
J2CPS/MemberInfo.java

@@ -0,0 +1,88 @@
+/**********************************************************************/
+/*                  Member Info class for J2CPS                       */
+/*                                                                    */   
+/*                      (c) copyright QUT                             */ 
+/**********************************************************************/
+package J2CPS;
+
+import java.io.*;
+import java.util.*;
+
+public class MemberInfo {
+
+  public ClassDesc owner;
+  public int accessFlags;
+  public String name;
+  public String signature;
+  
+  public MemberInfo(ConstantPool cp,DataInputStream stream,ClassDesc own) 
+                                                            throws IOException {
+    owner = own;
+    accessFlags = stream.readUnsignedShort();
+    name = (String) cp.Get(stream.readUnsignedShort());
+    signature = (String) cp.Get(stream.readUnsignedShort());
+    /* skip the attributes */
+    int attrCount = stream.readUnsignedShort();
+    for (int i = 0; i < attrCount; i++) {  
+      int attNameIx = stream.readUnsignedShort();
+      if ("ConstantValue".equals((String)cp.Get(attNameIx)) &&
+         (this instanceof FieldInfo)) {
+        ((FieldInfo)this).GetConstValueAttribute(cp,stream);
+      } else {
+        if ("Deprecated".equals((String)cp.Get(attNameIx)) &&
+         (this instanceof MethodInfo)) { ((MethodInfo)this).deprecated = true; }
+        int attrLength = stream.readInt();
+        for (int j = 0; j < attrLength; j++) {
+          int tmp = stream.readByte();
+        }
+      }
+    }
+  }
+
+  public MemberInfo(ClassDesc own,int acc,String nam) {
+    owner = own;
+    accessFlags = acc;
+    name = nam;
+  }
+
+  public boolean isPublicStatic() {
+    return ConstantPool.isStatic(accessFlags) && 
+           ConstantPool.isPublic(accessFlags);
+  }
+
+  public boolean isExported() {
+    return (ConstantPool.isPublic(accessFlags) ||
+            ConstantPool.isProtected(accessFlags)); 
+  }
+
+  public boolean isPublic() {
+    return ConstantPool.isPublic(accessFlags); 
+  }
+
+  public boolean isStatic() {
+    return ConstantPool.isStatic(accessFlags); 
+  }
+
+  public boolean isPrivate() {
+    return ConstantPool.isPrivate(accessFlags); 
+  }
+
+  public boolean isProtected() {
+    return ConstantPool.isProtected(accessFlags); 
+  }
+
+  public boolean isAbstract() {
+    return ConstantPool.isAbstract(accessFlags); 
+  }
+
+  public boolean isFinal() {
+    return ConstantPool.isFinal(accessFlags); 
+  }
+
+  public void AddImport(ClassDesc thisClass) {
+  }
+
+  public String toString() { return ""; };
+
+  
+}

+ 75 - 0
J2CPS/MethodInfo.java

@@ -0,0 +1,75 @@
+/**********************************************************************/
+/*                  Method Info class for J2CPS                       */
+/*                                                                    */   
+/*                      (c) copyright QUT                             */ 
+/**********************************************************************/
+package J2CPS;
+
+import java.io.*;
+// import java.util.*;
+
+public class MethodInfo extends MemberInfo {
+
+  public TypeDesc[] parTypes;
+  public TypeDesc retType;
+  public String userName;
+  public boolean deprecated = false;
+  public int retTypeFixUp = 0;
+  public int[] parFixUps;
+  public boolean overridding = false;
+  public boolean isInitProc = false;
+  public boolean isCLInitProc = false;
+
+  public MethodInfo(ConstantPool cp,DataInputStream stream,
+                    ClassDesc thisClass) throws IOException {
+    super(cp,stream,thisClass);
+    parTypes = TypeDesc.GetParTypes(signature);
+    retType = TypeDesc.GetType(signature,signature.indexOf(')')+1);
+    if (name.equals("<init>")) { 
+      userName = "Init"; 
+      isInitProc = true;
+      if (!ConstantPool.isStatic(accessFlags)) {
+        accessFlags = (accessFlags + ConstantPool.ACC_STATIC);
+      }
+      if ((parTypes.length == 0) && (!ConstantPool.isPrivate(accessFlags))) { 
+        thisClass.hasNoArgConstructor = true; 
+      }
+      retType = thisClass;
+    } else if (name.equals("<clinit>")) {
+      userName="CLInit"; 
+      isCLInitProc = true;
+    }
+    if (ClassDesc.verbose) { 
+      System.out.println("Method has " + parTypes.length + " parameters");
+    }
+    AddImport(thisClass);
+  }
+
+  public MethodInfo(ClassDesc thisClass,String name,String jName,int acc) {
+    super(thisClass,acc,jName);
+    userName = name;
+    if (name.equals("<init>")) { 
+      if (userName == null) { userName = "Init";}
+      isInitProc = true; 
+    }
+  }
+
+  public void AddImport(ClassDesc thisClass) {
+    for (int i=0; i < parTypes.length; i++) {
+      if (parTypes[i] instanceof ClassDesc) { 
+        thisClass.AddImport((ClassDesc)parTypes[i]);
+      }
+    }
+    if (retType instanceof ClassDesc) { 
+      thisClass.AddImport((ClassDesc)retType); 
+    } else if (retType instanceof PtrDesc) {
+      ((PtrDesc)retType).AddImport(thisClass); 
+    }
+  }
+
+  public String toString() {
+    return ConstantPool.GetAccessString(accessFlags) + " " + name + " " + 
+           signature;
+  }
+
+}

+ 24 - 0
J2CPS/MethodRef.java

@@ -0,0 +1,24 @@
+/**********************************************************************/
+/*                Method Reference class for J2CPS                    */
+/*                                                                    */   
+/*                      (c) copyright QUT                             */ 
+/**********************************************************************/
+package J2CPS;
+
+public class MethodRef extends Reference {
+
+  public MethodRef(ConstantPool thisCp, int classIndex, int ntIndex) {
+    super(thisCp,classIndex,ntIndex);
+  }
+
+  public String getMethodName() {
+    return (classRef.GetName() + "." + name + type);
+  }
+
+  public String toString() {
+    this.Resolve();
+    return ("<MethodReference> " + classIndex + " " + nameAndTypeIndex + " " +
+            classRef.GetName() + "." + name + " " + type);
+  }
+
+}

+ 43 - 0
J2CPS/NameAndType.java

@@ -0,0 +1,43 @@
+/**********************************************************************/
+/*               NameAndType Reference class for J2CPS                */
+/*                                                                    */   
+/*                      (c) copyright QUT                             */ 
+/**********************************************************************/
+package J2CPS;
+
+public class NameAndType {
+
+  ConstantPool cp;          /* The constant pool containing this N & T */
+  int nameIndex;            /* CP index for this N & T's name          */
+  int typeIndex;            /* CP index for this N & T'x type          */
+  String name;
+  String type;
+
+  public NameAndType(ConstantPool thisCp, int nameIx, int typeIx) {
+    this.cp = thisCp;
+    this.nameIndex = nameIx;
+    this.typeIndex = typeIx;
+  }
+
+  public String GetName() {
+    if (this.name == null) { this.name = (String) this.cp.Get(nameIndex); }
+    return this.name;
+  }
+
+  public String GetType() {
+    if (this.type == null) { this.type = (String) this.cp.Get(typeIndex); }
+    return this.type;
+  }
+
+  public void Resolve() {
+    if (this.name == null) { this.name = (String) this.cp.Get(nameIndex); }
+    if (this.type == null) { this.type = (String) this.cp.Get(typeIndex); }
+  }
+
+  public String toString() {
+    this.Resolve();
+    return "<NameAndType> " + nameIndex + " " + this.name + 
+           "              " + typeIndex + " " + this.type;
+  }
+
+}

+ 178 - 0
J2CPS/PackageDesc.java

@@ -0,0 +1,178 @@
+/**********************************************************************/
+/*                Package Desscriptor class for J2CPS                 */
+/*                                                                    */   
+/*                      (c) copyright QUT                             */ 
+/**********************************************************************/
+package J2CPS;
+
+import java.io.*;
+import java.util.*;
+
+public class PackageDesc {
+
+  private static final char qSepCh = '/';
+  private static final char fSepCh = 
+                             System.getProperty("file.separator").charAt(0);
+  private static final char jSepCh = '.';
+  private static final char nSepCh = '_';
+  private static ArrayList<PackageDesc> toDo = new ArrayList<PackageDesc>(2);
+  private static ArrayList<PackageDesc> syms = new ArrayList<PackageDesc>(2);
+  private static HashMap<String,PackageDesc> packageList = new HashMap<String,PackageDesc>();
+  private File packageFile;
+
+  public ClassDesc[] classes;
+  public String name, cpName, javaName, dirName;
+  public ArrayList<PackageDesc> imports = new ArrayList<PackageDesc>();
+  public int impNum = -1;
+  public boolean anonPackage = false;
+
+  public PackageDesc(String pName, boolean anon) {
+    if (anon) {
+      name = pName;
+      cpName = pName;
+      javaName = pName;
+      anonPackage = true;
+    } else {
+      MakeName(pName);
+      packageList.put(name,this); 
+    }
+    boolean ok = toDo.add(this); 
+  }
+
+  private void MakeName(String pName) {
+    name = pName.replace(jSepCh,qSepCh);
+    name = name.replace(fSepCh,qSepCh);  /* name is now .../... */
+    cpName = name.replace(qSepCh,nSepCh);
+    javaName = name.replace(qSepCh,jSepCh);
+    if (qSepCh != fSepCh) {
+      dirName = name.replace(qSepCh,fSepCh);
+    } else {
+      dirName = name;
+    }
+  }
+ 
+  public static PackageDesc getPackage(String packName) {
+    packName = packName.replace(jSepCh,qSepCh); 
+    PackageDesc pack = (PackageDesc)packageList.get(packName);
+    if (pack == null) { pack = new PackageDesc(packName,false); }
+    return pack;
+  }
+
+  public static PackageDesc getClassPackage(String className) {
+    className = className.replace(jSepCh,qSepCh); 
+    String pName = className.substring(0,className.lastIndexOf(qSepCh));
+    PackageDesc pack = (PackageDesc)packageList.get(pName);
+    if (pack == null) { pack = new PackageDesc(pName,false); }
+    return pack;
+  }
+
+  public void AddImport(TypeDesc ty) {
+    if (ty instanceof ClassDesc) {
+      ClassDesc aClass = (ClassDesc)ty;
+      if (aClass.packageDesc == null) {
+        System.err.println("ERROR: Class "+aClass.qualName+" has no package");
+        System.exit(0);
+      } 
+      if ((this!=aClass.packageDesc)&&(!imports.contains(aClass.packageDesc))){ 
+        imports.add(aClass.packageDesc); 
+      }
+    } 
+  }
+ 
+  public void AddImport(PackageDesc pack) {
+    if ((this != pack) && (!imports.contains(pack))){ 
+      boolean ok = imports.add(pack); 
+    }
+  }
+
+  public void ResetImports() {
+    for (int i=0; i < imports.size(); i++) {
+      imports.get(i).impNum = -1;
+    }
+  }
+
+  private void AddImportList(ArrayList impList) {
+    for (int i=0; i < impList.size(); i++) {
+      AddImport((PackageDesc)impList.get(i));
+    }
+  }
+
+  public void ReadPackage() throws IOException, FileNotFoundException {
+    boolean ok = syms.add(this);
+    if (anonPackage) {
+      classes = new ClassDesc[1];
+      classes[0] = ClassDesc.GetClassDesc(name,this);
+      boolean ok2 = classes[0].ReadClassFile(J2CPSFiles.OpenClassFile(name));
+      return;
+    } 
+    packageFile = J2CPSFiles.getPackageFile(dirName);
+    String[] classFiles = packageFile.list(new J2CPSFiles());
+    classes = new ClassDesc[classFiles.length];
+    for (int i = 0; i < classFiles.length; i++) {
+      String cName = name + qSepCh + 
+                     classFiles[i].substring(0,classFiles[i].lastIndexOf('.'));
+      ClassDesc nextClass = ClassDesc.GetClassDesc(cName,this);
+      if (nextClass.ReadClassFile(J2CPSFiles.OpenClassFile(packageFile, 
+                                                        classFiles[i]))) {
+        classes[i] = nextClass;
+      }
+    } 
+  }
+
+  public static void ReadPackages() throws IOException, FileNotFoundException {
+    int j = 0;
+    toDo.get(0).ReadPackage();
+
+    if (!ClassDesc.verbose)      // Lightweight progress indicator ...
+      System.out.println("INFO: reading dependents ");
+
+    for (int i=1; i < toDo.size(); i++) {
+      PackageDesc pack = toDo.get(i);
+      /* look for symbol file first */
+      pack.packageFile = J2CPSFiles.FindSymbolFile(pack.cpName);
+      if (pack.packageFile == null) {
+        pack.ReadPackage();
+        if (!ClassDesc.verbose) { System.out.print('+'); j++; }
+      } else {
+        if (ClassDesc.verbose)  {
+          System.out.println("Reading Symbol File <" + 
+                                             pack.packageFile.getPath() + ">");
+        }
+        SymbolFile.ReadSymbolFile(pack.packageFile,pack);
+        if (!ClassDesc.verbose) { System.out.print('-'); j++; }
+      }
+      if (j >= 79) { System.out.println(); j = 0; }
+    }
+    if (!ClassDesc.verbose && j > 0) System.out.println();
+  }
+
+  public static void WriteSymbolFiles() throws IOException {
+    for (int i=0; i < syms.size(); i++) {
+      HashMap<String,MethodInfo> pScope = new HashMap<String,MethodInfo>();
+      PackageDesc nextPack = syms.get(i);
+      for (int j=0; j < nextPack.classes.length; j++) {
+        if (nextPack.classes[j] != null) {
+          if (ClassDesc.overloadedNames) {
+            nextPack.classes[j].GetSuperImports(); 
+          } else {
+            nextPack.classes[j].GetSuperFields(pScope); 
+          }
+          nextPack.AddImportList(nextPack.classes[j].imports);
+          ClassDesc superCl = nextPack.classes[j].superClass;
+          while (superCl != null) {
+            nextPack.AddImport(superCl);
+            nextPack.AddImportList(superCl.imports);
+            superCl = superCl.superClass;
+          }
+        }
+      }
+    }
+    for (int i=0; i < syms.size(); i++) {
+      PackageDesc nextPack = syms.get(i);
+      SymbolFile.WriteSymbolFile(nextPack);
+    }
+  }
+
+
+
+}

+ 53 - 0
J2CPS/PtrDesc.java

@@ -0,0 +1,53 @@
+/**********************************************************************/
+/*                Pointer Descriptor class for J2CPS                  */
+/*                                                                    */   
+/*                      (c) copyright QUT                             */ 
+/**********************************************************************/
+package J2CPS;
+
+import java.io.*;
+import java.util.*;
+
+public class PtrDesc extends TypeDesc {
+
+  TypeDesc boundType;
+
+  public PtrDesc(TypeDesc baseType) {
+    typeOrd = TypeDesc.arrPtr;
+    boundType = baseType;
+    if (boundType != null) { setName(); }
+  }
+
+  public PtrDesc(int inNum, int baseNum) {
+    typeOrd = TypeDesc.arrPtr;
+    inTypeNum = inNum;
+    inBaseTypeNum = baseNum;
+  }
+  
+  public void Init(TypeDesc baseType) {
+    boundType = baseType;
+    if (boundType != null) { setName(); }
+  }
+
+  public void AddImport(ClassDesc thisClass) {
+    if (boundType instanceof ClassDesc) {
+      thisClass.AddImport((ClassDesc)boundType);
+    } else if (boundType instanceof ArrayDesc) {
+      ((ArrayDesc)boundType).AddImport(thisClass);
+    }
+  }
+
+  public void setName() {
+    name = "POINTER TO " + boundType.name;
+  }
+
+  public void writeType(DataOutputStream out, PackageDesc thisPack) 
+                                                           throws IOException {
+    out.writeByte(SymbolFile.ptrSy);
+    SymbolFile.writeTypeOrd(out,boundType); 
+  }
+
+
+}
+
+

+ 43 - 0
J2CPS/Reference.java

@@ -0,0 +1,43 @@
+/**********************************************************************/
+/*                   Reference class for J2CPS                        */
+/*                                                                    */   
+/*                      (c) copyright QUT                             */ 
+/**********************************************************************/
+package J2CPS;
+
+public class Reference {
+
+  ConstantPool cp;          /* The constant pool containing this ref */
+  int classIndex;           /* CP index for this reference's class   */
+  int nameAndTypeIndex;     /* CP index for this ref's name and type */
+  ClassRef classRef;
+  NameAndType nAndt;
+  String name;
+  String type;
+
+  public Reference(ConstantPool thisCp, int classIndex, int ntIndex) {
+    this.cp = thisCp;
+    this.classIndex = classIndex;
+    this.nameAndTypeIndex = ntIndex;
+  }
+
+  public String GetClassName() {
+    if (this.classRef == null) { 
+      this.classRef = (ClassRef) this.cp.Get(classIndex); 
+    }
+    return classRef.GetName();
+  }
+
+  public void Resolve() {
+    this.classRef = (ClassRef) this.cp.Get(classIndex); 
+    this.nAndt = (NameAndType) this.cp.Get(nameAndTypeIndex); 
+    this.name = nAndt.GetName();
+    this.type = nAndt.GetType();
+  }
+
+  public String toString() {
+    this.Resolve();
+    return ("Class " + classIndex + "  NameAndType " + nameAndTypeIndex);
+  }
+
+}

+ 36 - 0
J2CPS/StringRef.java

@@ -0,0 +1,36 @@
+/**********************************************************************/
+/*                 String Reference class for J2CPS                   */
+/*                                                                    */   
+/*                      (c) copyright QUT                             */ 
+/**********************************************************************/
+package J2CPS;
+
+import java.io.*;
+
+public class StringRef {
+
+  ConstantPool cp;  /* the constant pool containing this string ref */
+  String str;       /* the string this ref refers to                */
+  int strIndex;     /* the CP index for this string                 */
+  
+  public StringRef(ConstantPool thisCp, int strIx) {
+    this.cp = thisCp;
+    this.strIndex = strIx;
+  }
+ 
+  public String GetString() {
+    if (this.str == null) { this.str = (String) cp.Get(strIndex); }
+    return str;
+  }
+
+  public void Resolve() {
+    this.str = (String) this.cp.Get(strIndex);
+  }
+
+  public String toString() {
+    this.Resolve();
+    return ("<StringRef>  " + this.strIndex + " " + str);
+  }
+
+}
+

+ 894 - 0
J2CPS/SymbolFile.java

@@ -0,0 +1,894 @@
+/**********************************************************************/
+/*                  Symbol File class for J2CPS                       */
+/*                                                                    */   
+/*                      (c) copyright QUT                             */ 
+/**********************************************************************/
+package J2CPS;
+
+import java.io.*;
+import java.util.*;
+
+class SymbolFile {
+ 
+/************************************************************************/
+/*             Symbol file reading/writing                              */
+/************************************************************************/
+  // Collected syntax ---
+  // 
+  // SymFile    = Header [String (falSy | truSy)]
+  //		{Import | Constant | Variable | Type | Procedure} 
+  //		TypeList Key.
+  // Header     = magic modSy Name.
+  // Import     = impSy Name [String] Key.
+  // Constant   = conSy Name Literal.
+  // Variable   = varSy Name TypeOrd.
+  // Type       = typSy Name TypeOrd.
+  // Procedure  = prcSy Name [String] [truSy] FormalType.
+  // Method     = mthSy Name Byte Byte TypeOrd [String] FormalType.
+  // FormalType = [retSy TypeOrd] frmSy {parSy Byte TypeOrd} endFm.
+  // TypeOrd    = ordinal.
+  // TypeHeader = tDefS Ord [fromS Ord Name].
+  // TypeList   = start {Array | Record | Pointer | ProcType | 
+  //                     NamedType | Enum} close.
+  // Array      = TypeHeader arrSy TypeOrd (Byte | Number | ) endAr.
+  // Pointer    = TypeHeader ptrSy TypeOrd.
+  // ProcType   = TypeHeader pTpSy FormalType.
+  // EventType  = TypeHeader evtSy FormalType.
+  // Record     = TypeHeader recSy recAtt [truSy | falSy] [basSy TypeOrd] 
+  //              [iFcSy basSy TypeOrd {basSy TypeOrd}]
+  //              {Name TypeOrd} {Method} {Statics} endRc.
+  // Statics    = ( Constant | Variable | Procedure ).
+  // Enum       = TypeHeader eTpSy { Constant } endRc.
+  // NamedType  = TypeHeader. 
+  // Name       = namSy byte UTFstring.
+  // Literal    = Number | String | Set | Char | Real | falSy | truSy.
+  // Byte       = bytSy byte.
+  // String     = strSy UTFstring.
+  // Number     = numSy java.lang.long.
+  // Real       = fltSy java.lang.double.
+  // Set        = setSy java.lang.int.
+  // Key        = keySy java.lang.int.
+  // Char       = chrSy java.lang.char.
+  //
+  // Notes on the syntax:
+  // All record types must have a Name field, even though this is often
+  // redundant.  The issue is that every record type (including those that
+  // are anonymous in CP) corresponds to a Java class, and the definer 
+  // and the user of the class _must_ agree on the JVM name of the class.
+  // The same reasoning applies to procedure types, which must have equal
+  // interface names in all modules.
+  //
+
+  static final String[] mthAtt = {"", ",NEW", ",ABSTRACT", ",NEW,ABSTRACT",
+                                  ",EMPTY", ",NEW,EMPTY",
+                                  ",EXTENSIBLE", ",NEW,EXTENSIBLE"};
+  static final String[] recAtt = {"RECORD ", "ABSTRACT RECORD ",
+                                  "LIMITED RECORD ", "EXTENSIBLE RECORD "};
+  static final String[] mark = {"", "*", "-", "!"};
+  static final String[] varMark = {"", "IN", "OUT", "VAR"};
+
+  private static final String spaces = "         ";
+  private static final String recEndSpace = "      "; 
+  private static final char qSepCh = '/';
+
+  static final int modSy = (int) 'H';
+  static final int namSy = (int) '$';
+  static final int bytSy = (int) '\\';
+  static final int numSy = (int) '#';
+  static final int chrSy = (int) 'c';
+  static final int strSy = (int) 's';
+  static final int fltSy = (int) 'r';
+  static final int falSy = (int) '0';
+  static final int truSy = (int) '1';
+  static final int impSy = (int) 'I';
+  static final int setSy = (int) 'S';
+  static final int keySy = (int) 'K';
+  static final int conSy = (int) 'C';
+  static final int typSy = (int) 'T';
+  static final int tDefS = (int) 't';
+  static final int prcSy = (int) 'P';
+  static final int retSy = (int) 'R';
+  static final int mthSy = (int) 'M';
+  static final int varSy = (int) 'V';
+  static final int parSy = (int) 'p';
+  static final int iFcSy = (int) '~';
+  
+  static final int start = (int) '&';
+  static final int close = (int) '!';
+  
+  static final int recSy = (int) '{';
+  static final int endRc = (int) '}';
+  static final int frmSy = (int) '(';
+  static final int fromS = (int) '@';
+  static final int endFm = (int) ')';
+  static final int arrSy = (int) '[';
+  static final int endAr = (int) ']';
+  static final int pTpSy = (int) '%';
+  static final int evtSy = (int) 'v';
+  static final int ptrSy = (int) '^';
+  static final int basSy = (int) '+';
+  static final int eTpSy = (int) 'e';
+  
+  static final int magic = 0xdeadd0d0;
+
+  static final int prvMode = 0;
+  static final int pubMode = 1;
+  static final int rdoMode = 2;
+  static final int protect = 3;
+
+  private static final int initTypeListSize = 128;
+  public static TypeDesc[] typeList = new TypeDesc[initTypeListSize];
+  private static int nextType = TypeDesc.ordT;
+  private static int tListIx = 0;
+  private static int sSym = 0;
+  private static int acc = 0;
+  private static String name;
+  private static int iVal;
+  private static long lVal;
+  private static int tOrd;
+  private static char cVal;
+  private static double dVal;
+  private static DataInputStream in;
+
+// Symbol file writing 
+
+  static void writeName(DataOutputStream out,int access, String name) 
+                                                            throws IOException{
+    out.writeByte(namSy);
+    if (ConstantPool.isPublic(access))   { out.writeByte(pubMode); }
+    else if (ConstantPool.isProtected(access)) { out.writeByte(protect); }
+    else /* if (ConstantPool.isPrivate(access)) */ { out.writeByte(prvMode); }
+    out.writeUTF(name);
+  }
+
+  static void writeString(DataOutputStream out,String str) throws IOException {
+    out.writeByte(strSy);
+    out.writeUTF(str);
+  }
+
+  static void writeLiteral(DataOutputStream out,Object val) throws IOException {
+    if (val instanceof String) {
+      writeString(out,(String) val);
+    } else if (val instanceof Integer) {
+      out.writeByte(numSy);
+      out.writeLong(((Integer)val).longValue());
+    } else if (val instanceof Long) {
+      out.writeByte(numSy);
+      out.writeLong(((Long)val).longValue());
+    } else if (val instanceof Float) {
+      out.writeByte(fltSy);
+      out.writeDouble(((Float)val).doubleValue());
+    } else if (val instanceof Double) {
+      out.writeByte(fltSy);
+      out.writeDouble(((Double)val).doubleValue());
+    } else {
+      System.out.println("Unknown constant type");
+      System.exit(1);
+    }
+  }
+
+  public static void writeOrd(DataOutputStream out,int i) throws IOException {
+    // DIAGNOSTIC
+    if (i < 0)
+      throw new IOException(); 
+    // DIAGNOSTIC
+    if (i <= 0x7f) {
+      out.writeByte(i);
+    } else if (i <= 0x7fff) {
+      out.writeByte(128 + i % 128);  
+      out.writeByte(i / 128);
+    } else {
+      throw new IOException(); 
+    }
+  }
+
+  private static void InsertType(TypeDesc ty) {
+    if (ty.outTypeNum > 0) { return; }
+    ty.outTypeNum = nextType++;
+    if (tListIx >= typeList.length) {
+      TypeDesc[] tmp = new TypeDesc[typeList.length + initTypeListSize];
+      System.arraycopy(typeList, 0, tmp, 0, typeList.length);
+      typeList = tmp;
+    }
+    typeList[tListIx++] = ty;
+  }
+
+  public static void AddType(TypeDesc ty) {
+    InsertType(ty); 
+    if (!ty.writeDetails) { return; }
+    if (ty instanceof ClassDesc) {
+      ClassDesc aClass = (ClassDesc)ty;
+      if (aClass.outBaseTypeNum > 0) { return; }
+      aClass.outBaseTypeNum = nextType++;
+      if (aClass.superClass != null) {
+        aClass.superClass.writeDetails = true; 
+        AddType(aClass.superClass); 
+      }
+      if (aClass.isInterface) {
+        for (int i=0; i < aClass.interfaces.length; i++) {
+          aClass.interfaces[i].writeDetails = true;
+          AddType(aClass.interfaces[i]);
+        }
+      }
+    } else if (ty instanceof PtrDesc) { 
+        ty = ((PtrDesc)ty).boundType; 
+        if (ty.outTypeNum == 0) { AddType(ty); }
+    } else if (ty instanceof ArrayDesc) {
+      ty = ((ArrayDesc)ty).elemType;
+      while (ty instanceof ArrayDesc) {
+        ArrayDesc aTy = (ArrayDesc)ty;
+        if (aTy.ptrType.outTypeNum == 0) { InsertType(aTy.ptrType); }
+        if (aTy.outTypeNum == 0) { InsertType(aTy); }
+        ty = aTy.elemType;
+      }                   
+      if (ty.outTypeNum == 0) { InsertType(ty); }
+    }
+  }
+
+  static void writeTypeOrd(DataOutputStream out,TypeDesc ty)throws IOException {
+    if (ty.typeOrd < TypeDesc.ordT) { 
+      out.writeByte(ty.typeOrd); 
+    } else {
+      if (ty.outTypeNum == 0) { AddType(ty); }
+      if (ty.outTypeNum == 0) { 
+        System.out.println("ERROR: type has number 0 for type " + ty.name); 
+        System.exit(1); 
+      }
+      writeOrd(out,ty.outTypeNum);
+    }
+  }
+
+  public static void WriteFormalType(MethodInfo m,DataOutputStream out) 
+                                                     throws IOException {
+    if ((m.retType != null) && (m.retType.typeOrd != 0)) {
+      out.writeByte(retSy);
+      writeTypeOrd(out,m.retType);
+    } 
+    out.writeByte(frmSy);
+    for (int i=0; i < m.parTypes.length; i++) {
+      out.writeByte(parSy);
+      if (m.parTypes[i] instanceof ArrayDesc) {
+        out.writeByte(1);   // array params are IN
+      } else {
+        out.writeByte(0);   // all other java parameters are value 
+      }
+      writeTypeOrd(out,m.parTypes[i]);
+    }
+    out.writeByte(endFm);
+  }
+
+  public static void WriteSymbolFile(PackageDesc thisPack) throws IOException{
+    ClearTypeList();
+    DataOutputStream out = J2CPSFiles.CreateSymFile(thisPack.cpName);
+
+    System.out.println("INFO:  Creating symbol file " + thisPack.cpName);
+
+    out.writeInt(magic);
+    out.writeByte(modSy);
+    writeName(out,0,thisPack.cpName);
+    writeString(out,thisPack.javaName);
+    out.writeByte(falSy); /* package is not an interface */
+    for (int i=0; i < thisPack.imports.size(); i++) {
+      out.writeByte(impSy);
+      PackageDesc imp = (PackageDesc)thisPack.imports.get(i);
+      imp.impNum = i+1;
+      writeName(out,0,imp.cpName);
+      writeString(out,imp.javaName);
+      out.writeByte(keySy);
+      out.writeInt(0);
+    }
+    for (int cNum=0; cNum < thisPack.classes.length; cNum++) {
+      ClassDesc thisClass = thisPack.classes[cNum];
+      if ((thisClass != null) && ConstantPool.isPublic(thisClass.access)) {
+        thisClass.writeDetails = true;
+        out.writeByte(typSy);
+        writeName(out,thisClass.access,thisClass.objName);
+        writeTypeOrd(out,thisClass);
+      }
+    }
+    out.writeByte(start);
+    for (int i=0; i < tListIx; i++) {
+      out.writeByte(tDefS);
+      writeOrd(out,typeList[i].outTypeNum);
+      typeList[i].writeType(out,thisPack);
+    }
+    out.writeByte(close);
+    out.writeByte(keySy);
+    out.writeInt(0);
+    thisPack.ResetImports();
+  }
+
+// Symbol file reading 
+
+  private static void InsertType(int tNum,TypeDesc ty) {
+    if (tNum >= typeList.length) {
+      int newLen = 2 * typeList.length;
+      while (tNum >= newLen) { newLen += typeList.length; }
+      TypeDesc[] tmp = new TypeDesc[newLen];
+      System.arraycopy(typeList, 0, tmp, 0, typeList.length);
+      typeList = tmp;
+    }
+    typeList[tNum] = ty;
+  }
+
+
+  private static int readOrd() throws IOException {
+    int b1 = in.readUnsignedByte();
+    if (b1 <= 0x7f) { return b1; }
+    else { int b2 = in.readByte();
+           return b1 - 128 + b2 * 128; }
+  }
+
+  private static void GetSym() throws IOException {
+    sSym = in.readByte();
+    switch (sSym) {
+      case namSy : acc = in.readByte();         // fall through 
+      case strSy : name = in.readUTF(); break;
+
+      case arrSy :
+      case ptrSy :
+      case retSy : 
+      case fromS : 
+      case tDefS : 
+      case basSy : tOrd = readOrd(); break;
+
+      case bytSy : iVal = in.readByte(); break;
+
+      case keySy : 
+      case setSy : iVal = in.readInt(); break;
+
+      case numSy : lVal = in.readLong(); break;
+
+      case fltSy : dVal = in.readDouble(); break;
+
+      case chrSy : cVal = in.readChar(); break;
+
+      case modSy : 
+      case impSy : 
+      case conSy : 
+      case varSy : 
+      case typSy : 
+      case prcSy : 
+      case mthSy : 
+      case parSy : 
+      case start : 
+      case close : 
+      case falSy : 
+      case truSy : 
+      case frmSy : 
+      case endFm : 
+      case recSy : 
+      case endRc : 
+      case endAr : 
+      case eTpSy :
+      case iFcSy :
+      case evtSy :
+      case pTpSy : break;
+  
+      default:  char ch = (char) sSym;
+                System.out.println("Bad symbol file format." +ch+"  "+sSym);
+                System.exit(1);
+    }
+  }
+
+  private static void Expect(int expSym) throws IOException {
+    if (expSym != sSym) {
+      System.out.println("Error in symbol file:  expecting " + 
+      String.valueOf((char) expSym) + " got " +
+      String.valueOf((char) sSym));
+      System.exit(1);
+    }
+    GetSym();
+  }
+
+  private static void Check(int expSym) {
+    if (expSym != sSym) {
+      System.out.println("Error in symbol file:  checking " + 
+      String.valueOf((char) expSym) + " got " +
+      String.valueOf((char) sSym));
+      System.exit(1);
+    }
+  }
+
+  private static void SkipToEndRec(DataInputStream in) throws IOException {
+    while (sSym != endRc) { 
+      if (sSym == mthSy) {
+        GetSym(); // name
+        in.readByte(); 
+        in.readByte();
+        readOrd();
+      } else if (sSym == varSy) {
+        GetSym(); // name
+        readOrd();
+      } else if (sSym == conSy) {
+        GetSym(); // name
+        GetSym(); // Literal
+      } else if (sSym == prcSy) {
+        GetSym(); // name
+      } else if (sSym == parSy) {
+        in.readByte();
+        readOrd();
+      } else if (sSym == namSy) {
+        readOrd();
+      } else {
+      }
+      GetSym(); 
+    }
+  }
+
+  private static int GetAccess() {
+    if (acc == prvMode) { return ConstantPool.ACC_PRIVATE; }
+    else if (acc == pubMode) { return ConstantPool.ACC_PUBLIC; }
+    else if (acc == protect) { return ConstantPool.ACC_PROTECTED; }
+    return 0;
+  }
+
+  private static ClassDesc GetClassDesc(PackageDesc thisPack,String className) {
+    ClassDesc aClass = ClassDesc.GetClassDesc(thisPack.name + qSepCh + 
+                                              className,thisPack);
+    if (aClass.fieldList == null){ aClass.fieldList = new ArrayList(); }
+    if (aClass.methodList == null){ aClass.methodList = new ArrayList(); }
+    return aClass;
+  }
+
+  private static void GetConstant(ClassDesc cClass) throws IOException {
+  // Constant = conSy Name Literal.
+  // Literal  = Number | String | Set | Char | Real | falSy | truSy.
+    TypeDesc typ = null;
+    Object val = null;
+    Expect(conSy);
+    String constName = name; 
+    int fAcc = GetAccess();
+    fAcc = fAcc + ConstantPool.ACC_STATIC + ConstantPool.ACC_FINAL;
+    Expect(namSy); 
+    switch (sSym) {
+      case numSy : typ = TypeDesc.GetBasicType(TypeDesc.longT); 
+                   val = new Long(lVal); break;
+      case strSy : typ = TypeDesc.GetBasicType(TypeDesc.strT);
+                   val = name; 
+      case setSy : typ = TypeDesc.GetBasicType(TypeDesc.setT);
+                   val = new Integer(iVal); break;
+      case chrSy : typ = TypeDesc.GetBasicType(TypeDesc.charT);
+                   val = new Character(cVal); break;
+      case fltSy : typ = TypeDesc.GetBasicType(TypeDesc.dbleT);
+                   val = new Double(dVal); break;
+      case falSy : typ = TypeDesc.GetBasicType(TypeDesc.boolT);
+                   val = false; break;
+      case truSy : typ = TypeDesc.GetBasicType(TypeDesc.boolT);
+                   val = true; break;
+    }
+    boolean ok = cClass.fieldList.add(new FieldInfo(cClass,fAcc,constName,typ,val));
+    GetSym();
+  }
+
+  private static void GetVar(ClassDesc vClass) throws IOException {
+  // Variable = varSy Name TypeOrd.
+    Expect(varSy);
+    String varName = name; 
+    int fAcc = GetAccess();
+    Check(namSy);
+    FieldInfo f = new FieldInfo(vClass,fAcc,varName,null,null);
+    f.typeFixUp = readOrd();
+    vClass.fieldList.add(f);
+    GetSym();
+  }
+
+  private static void GetType(PackageDesc thisPack) throws IOException {
+  // Type = typSy Name TypeOrd.
+    Expect(typSy);
+    ClassDesc thisClass = GetClassDesc(thisPack,name); 
+    thisClass.access = GetAccess();
+    Check(namSy);
+    int tNum = readOrd();
+    thisClass.inTypeNum = tNum;
+    InsertType(tNum,thisClass);
+    GetSym();
+  }
+
+  private static void GetFormalType(ClassDesc thisClass,MethodInfo thisMethod) 
+                                                           throws IOException {
+  // FormalType = [retSy TypeOrd] frmSy {parSy Byte TypeOrd} endFm.
+    int [] pars = new int[20];
+    int numPars = 0;
+    TypeDesc retType = TypeDesc.GetBasicType(TypeDesc.noTyp);
+    if (sSym == retSy) { thisMethod.retTypeFixUp = tOrd; GetSym();} 
+    Expect(frmSy);
+    while (sSym != endFm) {
+      Check(parSy);
+      in.readByte();   /* ignore par mode */
+      pars[numPars++] = readOrd(); 
+      GetSym();
+    }  
+    Expect(endFm);
+    thisMethod.parFixUps = new int[numPars];
+    System.arraycopy(pars, 0, thisMethod.parFixUps, 0, numPars);
+  }
+
+
+  private static void GetMethod(ClassDesc thisClass) throws IOException {
+  // Method = mthSy Name Byte Byte TypeOrd [String] FormalType.
+    String jName = null;
+    Expect(mthSy);
+    Check(namSy);
+    String nam = name; 
+    int pAcc = GetAccess();
+    int attr = in.readByte();
+    int recMode = in.readByte();  
+    int cNum = readOrd();
+    if (cNum != thisClass.inTypeNum) {
+      System.err.println("Method not part of THIS class!");
+      System.exit(1);
+    }  
+    GetSym();
+    if (sSym == strSy) { jName = name; GetSym();  }
+    MethodInfo m = new MethodInfo(thisClass,nam,jName,pAcc); 
+    switch (attr) {
+      case 1 : if (!m.isInitProc) {
+                 m.accessFlags += ConstantPool.ACC_FINAL; 
+               }
+               break;
+      case 2 : m.overridding = true;
+               m.accessFlags += (ConstantPool.ACC_ABSTRACT + 
+                                 ConstantPool.ACC_FINAL); 
+               break;
+      case 3 : m.accessFlags += (ConstantPool.ACC_ABSTRACT +
+                                 ConstantPool.ACC_FINAL); 
+               break;
+      case 6 : m.overridding = true;
+               break;
+      case 7 : break; 
+    }
+    GetFormalType(thisClass,m);
+    thisClass.methodList.add(m);
+    thisClass.scope.put(m.name,m);
+  }
+
+  private static void GetProc(ClassDesc pClass) throws IOException {
+  // Proc = prcSy Name [String] [truSy] FormalType.
+    String jName = null;
+    Expect(prcSy);
+    String procName = name; 
+    int pAcc = GetAccess();
+    pAcc = pAcc + ConstantPool.ACC_STATIC;
+    Expect(namSy); 
+    if (sSym == strSy) { jName = name; GetSym();  }
+    MethodInfo m = new MethodInfo(pClass,procName,jName,pAcc); 
+    if (sSym == truSy) { m.isInitProc = true; GetSym();  }
+    GetFormalType(pClass,m);
+    pClass.methodList.add(m);
+  }
+
+  private static void ClearTypeList() {
+    for (int i=0; i < typeList.length; i++) {
+      if (typeList[i] != null) {
+        if (typeList[i].typeOrd >= TypeDesc.specT) {
+          typeList[i].inTypeNum = 0; 
+          typeList[i].outTypeNum = 0; 
+        }
+        if (typeList[i] instanceof ClassDesc) {
+          ((ClassDesc)typeList[i]).inBaseTypeNum = 0;
+          ((ClassDesc)typeList[i]).outBaseTypeNum = 0;
+          ((ClassDesc)typeList[i]).writeDetails = false;
+        } else if (typeList[i] instanceof ArrayDesc) {
+          ((ArrayDesc)typeList[i]).elemTypeFixUp = 0;
+        }
+      }
+      typeList[i] = null; 
+    }
+    tListIx = 0;
+    nextType = TypeDesc.ordT;
+  }
+
+  private static void FixArrayElemType(ArrayDesc arr) {
+    if (arr.elemTypeFixUp == 0) { return; }
+    TypeDesc elem = GetFixUpType(arr.elemTypeFixUp);
+    if (elem instanceof ArrayDesc) {
+      FixArrayElemType((ArrayDesc)elem); 
+      arr.dim = ((ArrayDesc)elem).dim + 1;
+      arr.ultimateElemType = ((ArrayDesc)elem).ultimateElemType;
+    } else {
+      arr.ultimateElemType = elem;
+    }
+    arr.elemType = elem;
+  }
+
+  private static TypeDesc GetFixUpType (int num) {
+    if (num < TypeDesc.specT) { return TypeDesc.GetBasicType(num); }
+    if (typeList[num] instanceof PtrDesc) { 
+      return ((PtrDesc)typeList[num]).boundType;
+    }
+    return typeList[num];
+  } 
+
+  public static void ReadSymbolFile(File symFile,PackageDesc thisPack) 
+                                     throws FileNotFoundException, IOException {
+
+    if (ClassDesc.verbose)
+      System.out.println("INFO:  Reading symbol file " + symFile.getName());
+
+    ClearTypeList();
+    ClassDesc aClass, impClass;
+    PackageDesc impPack;
+    int maxInNum = 0;
+    FileInputStream fIn = new FileInputStream(symFile);
+    in = new DataInputStream(fIn);
+    if (in.readInt() != magic) {
+      System.out.println(symFile.getName() + " is not a valid symbol file.");
+      System.exit(1);
+    }
+    GetSym();
+    Expect(modSy);
+    if (!thisPack.cpName.equals(name)) {
+      System.out.println("ERROR:  Symbol file " + symFile.getName() + 
+      " does not contain MODULE " + thisPack.cpName + ", it contains MODULE " +
+      name);
+      System.exit(1);
+    }
+    Expect(namSy);
+    if (sSym == strSy) { 
+      if (!name.equals(thisPack.javaName)) { 
+        System.out.println("Wrong name in symbol file.");
+        System.exit(1); 
+      }
+      GetSym();
+      if (sSym == truSy) {  
+        System.out.println("ERROR:  Java Package cannot be an interface.");
+        System.exit(1);
+      }
+      GetSym();
+    } else {
+      System.err.println("<" + symFile.getName() + 
+                         "> NOT A SYMBOL FILE FOR A JAVA PACKAGE!");
+      System.exit(1);
+    }
+    while (sSym != start) {
+      switch (sSym) {
+        case impSy : GetSym(); // name
+                     String iName = name;
+                     GetSym(); 
+                     if (sSym == strSy) { 
+                       PackageDesc pack = PackageDesc.getPackage(name);
+                       thisPack.imports.add(pack);
+                       GetSym(); 
+                     }
+                     Expect(keySy);  
+                     break;
+        case conSy : 
+        case varSy : 
+        case prcSy : System.out.println("Symbol File is not from a java class");
+                     System.exit(1);
+                     break;
+        case typSy : GetType(thisPack); break;
+      }
+    }
+    Expect(start);
+    while (sSym != close) {
+      int impNum = -1;
+      impPack = null;
+      impClass = null;
+      String impName = null, impModName = null;
+      int impAcc = 0, impModAcc = 0;
+      Check(tDefS); 
+      int tNum = tOrd; GetSym(); 
+      if (tNum > maxInNum) { maxInNum = tNum; }
+      if (sSym == fromS) { 
+        impNum = tOrd - 1;
+        GetSym(); 
+        Check(namSy);
+        impName = name;
+        impAcc = acc; 
+        if (impNum < 0) {
+          impPack = thisPack;
+        } else {
+          impPack = (PackageDesc)thisPack.imports.get(impNum);
+        }
+        impClass = GetClassDesc(impPack,impName);
+        GetSym(); 
+      }
+      switch (sSym) { 
+        case arrSy : ArrayDesc newArr = null;
+                     int elemOrd = tOrd;
+                     GetSym();
+                     Expect(endAr);
+                     TypeDesc eTy = null;
+                     if (elemOrd < typeList.length) {
+                       if (elemOrd < TypeDesc.specT) { 
+                         eTy = TypeDesc.GetBasicType(elemOrd); 
+                       } else { 
+                         eTy = typeList[elemOrd]; 
+                       }
+                       if ((eTy != null) && (eTy instanceof PtrDesc) &&
+                          (((PtrDesc)eTy).boundType != null) && 
+                          (((PtrDesc)eTy).boundType instanceof ClassDesc)) {
+                         eTy = ((PtrDesc)eTy).boundType;   
+                       } 
+                     }
+                     if (eTy != null) {
+                       newArr = ArrayDesc.FindArrayType(1,eTy,true); 
+                     } else {
+                       newArr = new ArrayDesc(elemOrd); 
+                     }
+                     if ((tNum < typeList.length) && (typeList[tNum] != null)) {
+                       PtrDesc desc = (PtrDesc) typeList[tNum];
+                       if (desc.inBaseTypeNum != tNum) {
+                         System.out.println("WRONG BASE TYPE FOR POINTER!");
+                         System.exit(1);
+                       }
+                       desc.Init(newArr);
+                       newArr.SetPtrType(desc);
+                     }
+                     InsertType(tNum,newArr);
+                     break; 
+        case ptrSy : TypeDesc ty = null;
+                     if (impClass != null) { 
+                       InsertType(tNum,impClass);
+                       ty = impClass;
+                       ty.inTypeNum = tNum;
+                       ty.inBaseTypeNum = tOrd;
+                       InsertType(tOrd,ty);
+                     } else if ((tNum < typeList.length) && 
+                                (typeList[tNum] != null) &&
+                                (typeList[tNum] instanceof ClassDesc)) { 
+                       ty = typeList[tNum];
+                       ty.inTypeNum = tNum;
+                       ty.inBaseTypeNum = tOrd;
+                       InsertType(tOrd,ty);
+                     } else {
+                       ty = new PtrDesc(tNum,tOrd);
+                       InsertType(tNum,ty);
+                       if ((tOrd < typeList.length) && 
+                                (typeList[tOrd] != null)) { 
+                         ((PtrDesc)ty).Init(typeList[tOrd]);
+                       }
+                     }
+                     GetSym();
+                     break; 
+        case recSy : if ((tNum >= typeList.length) || (typeList[tNum] == null)||
+                         (!(typeList[tNum] instanceof ClassDesc))) {
+                     /* cannot have record type that is not a base type
+                        of a pointer in a java file                     */
+                       System.err.println(
+                         "RECORD TYPE " + tNum + " IS NOT POINTER BASE TYPE!");
+                       System.exit(1);
+                     }
+                     aClass = (ClassDesc) typeList[tNum];
+                     acc = in.readByte();
+                     aClass.setRecAtt(acc);
+                     if (aClass.read) { 
+                       GetSym();
+                       SkipToEndRec(in); 
+                       GetSym();
+                     } else {
+                       GetSym();
+                       if (sSym == truSy) { 
+                         aClass.isInterface = true; 
+                         GetSym();
+                       } else if (sSym == falSy) { 
+                         GetSym(); 
+                       }
+                       if (sSym == basSy) { 
+                         aClass.superNum = tOrd; 
+                         GetSym(); 
+                       }
+                       if (sSym == iFcSy) {
+                         GetSym();
+                         aClass.intNums = new int[10];
+                         aClass.numInts = 0;
+                         while (sSym == basSy) {
+                           if (aClass.numInts >= aClass.intNums.length) {
+                             int tmp[] = new int[aClass.intNums.length*2];
+                             System.arraycopy(aClass.intNums, 0, tmp, 0, aClass.intNums.length);
+                             aClass.intNums = tmp;
+                           }
+                           aClass.intNums[aClass.numInts] = tOrd;
+                           aClass.numInts++;
+                           GetSym();
+                         }
+                       }
+                       while (sSym == namSy) {
+                         FieldInfo f = new FieldInfo(aClass,GetAccess(),name,
+                                       null,null); 
+                         f.typeFixUp = readOrd(); 
+                         GetSym();
+                         boolean ok = aClass.fieldList.add(f);
+                         aClass.scope.put(f.name,f);
+                       } 
+                       while ((sSym == mthSy) || (sSym == prcSy) ||
+                              (sSym == varSy) || (sSym == conSy)) { 
+                         switch (sSym) {
+                           case mthSy : GetMethod(aClass); break; 
+                           case prcSy : GetProc(aClass); break;
+                           case varSy : GetVar(aClass); break;
+                           case conSy : GetConstant(aClass); break;
+                         }
+                       }
+                       Expect(endRc);
+                     }
+                     break; 
+        case pTpSy : System.out.println("CANNOT HAVE PROC TYPE IN JAVA FILE!"); 
+                     break;
+        case evtSy :System.out.println("CANNOT HAVE EVENT TYPE IN JAVA FILE!"); 
+                     break;
+        case eTpSy : System.out.println("CANNOT HAVE ENUM TYPE IN JAVA FILE!"); 
+                     break;
+        case tDefS : 
+        case close : InsertType(tNum,impClass);
+                     break;
+        default : char ch = (char) sSym; 
+                  System.out.println("UNRECOGNISED TYPE!" + sSym + "  " + ch); 
+                  System.exit(1);
+      }
+    }
+    Expect(close);
+    Check(keySy); 
+    fIn.close();
+    // do fix ups...
+    for (int i = TypeDesc.specT; i <= maxInNum; i++) {
+      int size = 0;
+      if ((typeList[i] != null) && (typeList[i] instanceof ClassDesc)) {
+        aClass = (ClassDesc)typeList[i];
+        if (!((ClassDesc)typeList[i]).read) {
+          aClass = (ClassDesc)typeList[i];
+          if (aClass.superNum != 0) {
+            aClass.superClass = (ClassDesc)typeList[aClass.superNum];
+          }
+          aClass.interfaces = new ClassDesc[aClass.numInts];
+          for (int j=0; j < aClass.numInts; j++) {
+            aClass.interfaces[j] = (ClassDesc) GetFixUpType(aClass.intNums[j]); 
+          }
+          if (aClass.fieldList == null) { size = 0; 
+          } else {
+            size = aClass.fieldList.size(); 
+          }
+          aClass.fields = new FieldInfo[size];
+          for (int j=0; j < size; j++) {
+            aClass.fields[j] = (FieldInfo)aClass.fieldList.get(j);
+            aClass.fields[j].type = GetFixUpType(aClass.fields[j].typeFixUp); 
+            if (aClass.fields[j].type instanceof ClassDesc) {
+              aClass.AddImport((ClassDesc)aClass.fields[j].type);
+            }  
+          }
+          aClass.fieldList = null;
+          if (aClass.methodList == null) { size = 0;
+          } else { size = aClass.methodList.size(); }
+          aClass.methods = new MethodInfo[size];
+          for (int k=0; k < size; k++) {
+            aClass.methods[k] = (MethodInfo)aClass.methodList.get(k);
+            aClass.methods[k].retType = GetFixUpType(
+                                        aClass.methods[k].retTypeFixUp); 
+            if (aClass.methods[k].retType instanceof ClassDesc) {
+              aClass.AddImport((ClassDesc)aClass.methods[k].retType);
+            }  
+            aClass.methods[k].parTypes = new TypeDesc[
+                                         aClass.methods[k].parFixUps.length];
+            for (int j=0; j < aClass.methods[k].parFixUps.length; j++) {
+              aClass.methods[k].parTypes[j] = GetFixUpType(
+                                              aClass.methods[k].parFixUps[j]);
+              if (aClass.methods[k].parTypes[j] instanceof ClassDesc) {
+                aClass.AddImport((ClassDesc)aClass.methods[k].parTypes[j]);
+              }  
+            }
+          }
+          aClass.methodList = null;
+          aClass.read = true;
+          aClass.done = true;
+        }
+      } else if ((typeList[i] != null) && (typeList[i] instanceof ArrayDesc)) {
+        FixArrayElemType((ArrayDesc)typeList[i]);
+      } else if ((typeList[i] != null) && (typeList[i] instanceof PtrDesc)) {
+        PtrDesc ptr = (PtrDesc)typeList[i];
+        if (ptr.typeOrd == TypeDesc.arrPtr) { 
+          ptr.Init(typeList[ptr.inBaseTypeNum]);
+        }
+      } else if (typeList[i] != null) { 
+        System.out.println("Type " + i + " " + typeList[i].name + 
+                           " is NOT array or class"); 
+        System.exit(0);
+      }
+    }
+  }
+
+
+}
+
+

+ 154 - 0
J2CPS/TypeDesc.java

@@ -0,0 +1,154 @@
+/**********************************************************************/
+/*                 Type Descriptor class for J2CPS                    */
+/*                                                                    */   
+/*                      (c) copyright QUT                             */ 
+/**********************************************************************/
+package J2CPS;
+
+import java.io.*;
+import java.util.*;
+
+public class TypeDesc {
+
+  public static final int noTyp  = 0;
+  public static final int boolT  = 1;
+  public static final int sCharT = 2;
+  public static final int charT  = 3;
+  public static final int byteT  = 4;
+  public static final int shortT = 5;
+  public static final int intT   = 6;
+  public static final int longT  = 7;
+  public static final int floatT = 8;
+  public static final int dbleT  = 9;
+  public static final int setT   = 10;
+  public static final int anyRT  = 11;
+  public static final int anyPT  = 12;
+  public static final int strT   = 13;
+  public static final int sStrT  = 14;
+  public static final int specT  = 15;
+  public static final int ordT   = 16;
+  public static final int arrT   = 17;
+  public static final int classT = 18;
+  public static final int arrPtr = 19;
+  public int typeFixUp = 0;
+
+  private static final String[] typeStrArr = 
+                              { "?","B","c","C","b","i","I","L","r","R",
+                                "?","?","?","?","?","?","?","a","O","?"};
+  public String name;
+  public boolean writeDetails = false;
+  public PackageDesc packageDesc = null;
+
+  private static TypeDesc[] basicTypes = new TypeDesc[specT];
+
+  int inTypeNum=0, outTypeNum=0, inBaseTypeNum = 0;
+  int typeOrd = 0;
+  static ArrayList<TypeDesc> types = new ArrayList<TypeDesc>();
+
+  public TypeDesc() {
+    inTypeNum = 0;
+    outTypeNum = 0;
+    typeOrd = 0;
+  }
+
+  private TypeDesc(int ix) {
+  /* ONLY used for basic types */
+    inTypeNum = ix;
+    outTypeNum = ix;
+    typeOrd = ix;
+  }
+
+  public String getTypeMneumonic() {
+    return typeStrArr[typeOrd];
+  }
+
+  public static TypeDesc GetBasicType(int index) {
+    return basicTypes[index];
+  }
+
+  public static TypeDesc GetType(String sig,int start) {
+    int tOrd = GetTypeOrd(sig,start);
+    if (tOrd == classT) {
+      return ClassDesc.GetClassDesc(GetClassName(sig,start),null);
+    } else if (tOrd == arrT) {
+      return ArrayDesc.GetArrayType(sig,start,true);
+    } else {
+      return basicTypes[tOrd]; 
+    }
+  }
+  
+  private static String GetClassName(String sig,int start) {
+    if (sig.charAt(start) != 'L') { 
+      System.out.println(sig.substring(0) + " is not a class name string!");
+      System.exit(1);
+    }
+    int endCName = sig.indexOf(';',start);
+    if (endCName == -1) {
+      return sig.substring(start+1);
+    } else {
+      return sig.substring(start+1,endCName);
+    }
+  }
+
+  private static int GetTypeOrd(String sig,int start) {
+    switch (sig.charAt(start)) {
+      case 'B' : return byteT; 
+      case 'C' : return charT; 
+      case 'D' : return dbleT;
+      case 'F' : return floatT; 
+      case 'I' : return intT; 
+      case 'J' : return longT; 
+      case 'S' : return shortT; 
+      case 'Z' : return boolT; 
+      case 'V' : return noTyp;
+      case 'L' : return classT;
+      case '[' : return arrT;
+    }
+    return 0;
+  }
+
+  public static TypeDesc[] GetParTypes(String sig) {
+    types.clear();
+    TypeDesc[] typeArr;
+    if (sig.charAt(0) != '(') {
+      System.out.println(sig + " is not a parameter list!");
+      System.exit(1);
+    }
+    int index = 1;
+    while (sig.charAt(index) != ')') {
+      if (sig.charAt(index) == '[') { 
+        types.add(ArrayDesc.GetArrayType(sig,index,false));  
+      } else {
+        types.add(GetType(sig,index));
+      }
+      if (sig.charAt(index) == 'L') { 
+        index = sig.indexOf(';',index) + 1; 
+      } else if (sig.charAt(index) == '[') {
+        while (sig.charAt(index) == '[') { index++; }
+        if (sig.charAt(index) == 'L') { index = sig.indexOf(';',index) + 1;  
+        } else { index++; }
+      } else { index++; }
+    } 
+    typeArr = new TypeDesc[types.size()]; 
+    for (int i=0; i < types.size(); i++) {
+      typeArr[i] = types.get(i);
+    }
+    return typeArr; 
+  }
+
+  public static final void InitTypes() {
+    for (int i=0; i < specT; i++) {
+      basicTypes[i] = new TypeDesc(i);
+      basicTypes[i].name = "BasicType" + i;
+      SymbolFile.typeList[i] = basicTypes[i];
+    }
+  }
+
+  public void writeType (DataOutputStream out, PackageDesc thisPack) 
+                                                           throws IOException {
+    System.err.println("TRYING TO WRITE A TYPEDESC! with ord " + typeOrd);
+    System.exit(1);
+  }
+
+}
+

+ 209 - 205
gpcp/Browse.cp

@@ -6,14 +6,15 @@ MODULE Browse;
         Error,
         CPmain,
         GPFiles,
-	GPBinFiles,
+        GPBinFiles,
+        LitValue,
         ProgArgs,
-	Symbols,
+        Symbols,
         IdDesc,
         GPText,
         GPTextFiles,
         GPCPcopyright,
-	FileNames;
+        FileNames;
 
 (* ========================================================================= *
 // Collected syntax ---
@@ -75,6 +76,12 @@ MODULE Browse;
 // and the user of the class _must_ agree on the IR name of the class.
 // The same reasoning applies to procedure types, which must have equal
 // interface names in all modules.
+//
+// Notes on the fine print about UTFstring --- November 2011 clarification.
+// The character sequence in the symbol file is modified UTF-8, that is
+// it may represent CHR(0), U+0000, by the bytes 0xC0, 0x80. String
+// constants may thus contain embedded nulls. 
+// 
 // ======================================================================== *)
 
   CONST
@@ -103,9 +110,13 @@ MODULE Browse;
 (* ============================================================ *)
 
   TYPE
+    CharOpen = POINTER TO ARRAY OF CHAR;
+
+(* ============================================================ *)
 
+  TYPE
     Desc = POINTER TO ABSTRACT RECORD
-             name : FileNames.NameString;
+             name   : CharOpen;
              access : INTEGER;
            END;
 
@@ -114,37 +125,37 @@ MODULE Browse;
                  tide : INTEGER;
                END;
 
-    LitValue = POINTER TO ABSTRACT RECORD
+    AbsValue = POINTER TO ABSTRACT RECORD
                END;
 
-    NumValue = POINTER TO RECORD (LitValue)
+    NumValue = POINTER TO RECORD (AbsValue)
                  numVal : LONGINT;
                END;
 
-    SetValue = POINTER TO RECORD (LitValue)
+    SetValue = POINTER TO RECORD (AbsValue)
                  setVal : SET;
                END;
 
-    StrValue = POINTER TO RECORD (LitValue)
-                 strVal : FileNames.NameString;
+    StrValue = POINTER TO RECORD (AbsValue)
+                 strVal : CharOpen;
                END;
 
-    FltValue = POINTER TO RECORD (LitValue)
+    FltValue = POINTER TO RECORD (AbsValue)
                  fltVal : REAL;
                END;
 
-    BoolValue = POINTER TO RECORD (LitValue)
+    BoolValue = POINTER TO RECORD (AbsValue)
                   boolVal : BOOLEAN;
                 END;
 
-    ChrValue = POINTER TO RECORD (LitValue)
+    ChrValue = POINTER TO RECORD (AbsValue)
                  chrVal : CHAR;
                END;
 
     Type = POINTER TO ABSTRACT RECORD
              declarer : Desc;             
              importedFrom : Module;
-             importedName : FileNames.NameString;
+             importedName : CharOpen;
            END;
 
     TypeList = POINTER TO ARRAY OF Type;
@@ -153,7 +164,7 @@ MODULE Browse;
             END;
 
     Basic = POINTER TO EXTENSIBLE RECORD (Type)
-              name : FileNames.NameString;
+              name : CharOpen;
             END;
 
     Enum = POINTER TO EXTENSIBLE RECORD (Type)
@@ -202,7 +213,7 @@ MODULE Browse;
               END;
 
     Proc = POINTER TO EXTENSIBLE RECORD (Type)
-             fName         : FileNames.NameString;
+             fName         : CharOpen;
              retType       : Type;
              retTypeNum    : INTEGER;
              noModes       : BOOLEAN;
@@ -225,7 +236,7 @@ MODULE Browse;
                  END;
                  
     ConstDesc = POINTER TO RECORD  (Desc)
-                  val : LitValue;
+                  val : AbsValue;
                 END;
 
     TypeDesc = POINTER TO EXTENSIBLE RECORD (Desc)
@@ -249,9 +260,9 @@ MODULE Browse;
               END;
 
     Module = POINTER TO RECORD
-               name      : FileNames.NameString;
-               symName   : FileNames.NameString;
-               fName     : FileNames.NameString;
+               name      : CharOpen;
+               symName   : CharOpen;
+               fName     : CharOpen;
                pathName  : GPFiles.FileNameArray;
                imports   : ModList;
                consts    : DescList;
@@ -279,25 +290,19 @@ MODULE Browse;
     HtmlOutput = POINTER TO RECORD (FileOutput)
                  END;
                     
-(* ============================================================ *)
-
-  TYPE
-
-    CharOpen = POINTER TO ARRAY OF CHAR;
-
 (* ============================================================ *)
 
   VAR
     args, argNo  : INTEGER;
-    fileName, modName  : FileNames.NameString;
-    printFNames, doAll, verbatim, hexCon, alpha : BOOLEAN;
+    fileName, modName  : CharOpen;
+    printFNames, doAll, verbatim, verbose, hexCon, alpha : BOOLEAN;
     file  : GPBinFiles.FILE;
     sSym  : INTEGER;
     cAtt  : CHAR;
     iAtt  : INTEGER;
     lAtt  : LONGINT;
     rAtt  : REAL;
-    sAtt  : FileNames.NameString;
+    sAtt  : CharOpen;
     typeList : TypeList;
     accArray : ARRAY 4 OF CHAR;
     outExt  : ARRAY 6 OF CHAR;
@@ -352,7 +357,7 @@ MODULE Browse;
 (* ============================================================ *)
 (* ============================================================ *)
 
-  PROCEDURE GetModule(name : FileNames.NameString) : Module;
+  PROCEDURE GetModule(name : CharOpen) : Module;
   VAR
     i : INTEGER;
     tmp : POINTER TO ARRAY OF Module;
@@ -360,7 +365,7 @@ MODULE Browse;
   BEGIN
     ASSERT(modList.list # NIL);
     FOR i := 0 TO modList.tide-1 DO
-      IF modList.list[i].name = name THEN RETURN modList.list[i] END;
+      IF modList.list[i].name^ = name^ THEN RETURN modList.list[i] END;
     END;
     IF modList.tide >= LEN(modList.list) THEN
       tmp := modList.list;
@@ -373,7 +378,7 @@ MODULE Browse;
     mod.systemMod := FALSE;
     mod.progArg := FALSE;
     mod.name := name;
-    mod.symName := name + symExt;
+    mod.symName := BOX(name^ + symExt);
     modList.list[modList.tide] := mod;
     INC(modList.tide);
     RETURN mod;
@@ -465,94 +470,60 @@ MODULE Browse;
 
 (* ======================================= *)
 
-  PROCEDURE ReadUTF(OUT nam : ARRAY OF CHAR);
+  PROCEDURE readUTF() : CharOpen; 
     CONST
-	bad = "Bad UTF-8 string";
+      bad = "Bad UTF-8 string";
     VAR num : INTEGER;
-	bNm : INTEGER;
-	idx : INTEGER;
-	chr : INTEGER;
+      bNm : INTEGER;
+      len : INTEGER;
+      idx : INTEGER;
+      chr : INTEGER;
+      buff : CharOpen;
   BEGIN
     num := 0;
-    bNm := read() * 256 + read();
-    FOR idx := 0 TO bNm-1 DO
-      chr := read();
+   (* 
+    *  bNm is the length in bytes of the UTF8 representation 
+    *)
+    len := read() * 256 + read();  (* max length 65k *)
+   (* 
+    *  Worst case the number of chars will equal byte-number.
+    *)
+    NEW(buff, len + 1); 
+    idx := 0;
+    WHILE idx < len DO
+      chr := read(); INC(idx);
       IF chr <= 07FH THEN		(* [0xxxxxxx] *)
-	nam[num] := CHR(chr); INC(num);
+        buff[num] := CHR(chr); INC(num);
       ELSIF chr DIV 32 = 06H THEN	(* [110xxxxx,10xxxxxx] *)
-	bNm := chr MOD 32 * 64;
-	chr := read();
-	IF chr DIV 64 = 02H THEN
-	  nam[num] := CHR(bNm + chr MOD 64); INC(num);
-	ELSE
-	  RTS.Throw(bad);
-	END;
+        bNm := chr MOD 32 * 64;
+        chr := read(); INC(idx);
+        IF chr DIV 64 = 02H THEN
+          buff[num] := CHR(bNm + chr MOD 64); INC(num);
+        ELSE
+          RTS.Throw(bad);
+        END;
       ELSIF chr DIV 16 = 0EH THEN	(* [1110xxxx,10xxxxxx,10xxxxxxx] *)
-	bNm := chr MOD 16 * 64;
-	chr := read();
-	IF chr DIV 64 = 02H THEN
-	  bNm := (bNm + chr MOD 64) * 64; 
-	  chr := read();
-	  IF chr DIV 64 = 02H THEN
-	    nam[num] := CHR(bNm + chr MOD 64); INC(num);
-	  ELSE 
-	    RTS.Throw(bad);
-	  END;
-	ELSE
-	  RTS.Throw(bad);
-	END;
+        bNm := chr MOD 16 * 64;
+        chr := read(); INC(idx);
+        IF chr DIV 64 = 02H THEN
+          bNm := (bNm + chr MOD 64) * 64; 
+          chr := read(); INC(idx);
+          IF chr DIV 64 = 02H THEN
+            buff[num] := CHR(bNm + chr MOD 64); INC(num);
+          ELSE 
+            RTS.Throw(bad);
+          END;
+        ELSE
+          RTS.Throw(bad);
+        END;
       ELSE
-	RTS.Throw(bad);
+        RTS.Throw(bad);
       END;
     END;
-    nam[num] := 0X;
-  END ReadUTF;
+    buff[num] := 0X;
+    RETURN LitValue.arrToCharOpen(buff, num);
+  END readUTF;
 
-(* ======================================= *)
-(*
- * PROCEDURE ReadUTF(OUT nam : ARRAY OF CHAR);
- *   CONST
- *	bad = "Bad UTF-8 string";
- *   VAR num : INTEGER;
- *	bNm : INTEGER;
- *	idx : INTEGER;
- *	chr : INTEGER;
- * BEGIN
- *   num := 0;
- *   bNm := read() * 256 + read();
- *   FOR idx := 0 TO bNm-1 DO
- *     chr := read();
- *     IF chr <= 07FH THEN
- *	nam[num] := CHR(chr); INC(num);
- *     ELSIF chr DIV 32 = 06H THEN
- *	bNm := chr MOD 32 * 64;
- *	chr := read();
- *	IF chr DIV 64 = 02H THEN
- *	  nam[num] := CHR(bNm + chr DIV 64); INC(num);
- *	ELSE
- *	  RTS.Throw(bad);
- *	END;
- *     ELSIF chr DIV 16 = 0EH THEN
- *	bNm := chr MOD 16 * 64;
- *	chr := read();
- *	IF chr DIV 64 = 02H THEN
- *	  bNm := bNm + chr DIV 64; 
- *	  chr := read();
- *	  IF chr DIV 64 = 02H THEN
- *	    nam[num] := CHR(bNm + chr DIV 64); INC(num);
- *	  ELSE 
- *	    RTS.Throw(bad);
- *	  END;
- *	ELSE
- *	  RTS.Throw(bad);
- *	END;
- *     ELSE
- *	RTS.Throw(bad);
- *     END;
- *   END;
- *   nam[num] := 0X;
- * END ReadUTF;
- *)
 (* ======================================= *)
 
   PROCEDURE readChar() : CHAR;
@@ -613,9 +584,10 @@ MODULE Browse;
     sSym := read();
     CASE sSym OF
     | namSy : 
-	iAtt := read(); ReadUTF(sAtt);
+	iAtt := read(); 
+        sAtt := readUTF();
     | strSy : 
-	ReadUTF(sAtt);
+        sAtt := readUTF();
     | retSy, fromS, tDefS, basSy :
 	iAtt := readOrd();
     | bytSy :
@@ -649,7 +621,7 @@ MODULE Browse;
 
 (* ============================================ *)
 
-  PROCEDURE GetLiteral(VAR lit : LitValue);
+  PROCEDURE GetLiteral(VAR lit : AbsValue);
   VAR
     b : BoolValue;
     n : NumValue;
@@ -696,7 +668,7 @@ MODULE Browse;
       par.typeNum := readOrd();
       GetSym();
       IF sSym = strSy THEN
-        par.opNm := BOX(sAtt);
+        par.opNm := sAtt;
         GetSym();
       END;
       AddPar(p.pars,par);
@@ -824,9 +796,6 @@ MODULE Browse;
   BEGIN
     NEW(rec);
     rec.recAtt := read();
-(*
-    IF rec.recAtt >=8 THEN rec.recAtt := rec.recAtt - 8; END;
-*)
     rec.isAnonRec := FALSE;
     GetSym();				(* Get past recSy rAtt	*)
     IF (sSym = falSy) OR (sSym = truSy) THEN
@@ -883,10 +852,10 @@ MODULE Browse;
         mth.fName := sAtt;
         GetSym(); 
       ELSE
-        mth.fName[0] := 0X;
+        mth.fName := NIL;
       END;
       IF sSym = namSy THEN 
-        mth.recName := BOX(sAtt);
+        mth.recName := sAtt;
         GetSym(); 
       END;
       GetFormalType(mth);
@@ -933,7 +902,7 @@ MODULE Browse;
         namedType : Named;
         f : VarDesc;
         rec : Record;
-        impName : FileNames.NameString;
+        impName : CharOpen;
         i,j : INTEGER;
   BEGIN
     GetSym();
@@ -943,7 +912,7 @@ MODULE Browse;
       ASSERT(typOrd # 0);
       ReadPast(tDefS);
       modOrd := -1;
-      impName := "";
+      impName := BOX("");
      (*
       *  The fromS symbol appears if the type is imported.
       *)
@@ -1023,9 +992,6 @@ MODULE Browse;
         ch0 := typ.declarer.name[0];
         IF (ch0 = "@") OR (ch0 = "$") THEN typ.declarer := NIL END;
       END;
-(*
-      IF (typ IS Record) & (typ.declarer = NIL) THEN (* anon record *)
- *)
       IF typ IS Record THEN 
 	r := typ(Record);
 	FOR j := 0 TO r.intrFaces.tide - 1 DO
@@ -1033,32 +999,14 @@ MODULE Browse;
 	  r.intrFaces.list[j](TypeDesc).type := typeList[k];
 	END;
 	IF typ.declarer = NIL THEN (* anon record *)
-(*
-          Console.WriteString("Type ");
-          Console.WriteInt(i,1);
-          Console.WriteString(" is an AnonRecord ");
-          Console.WriteLn;
- *)
           typ(Record).isAnonRec := TRUE;
 	END;
       ELSIF (typ IS Pointer) & (typ(Pointer).baseType IS Record) THEN
         IF (typ.declarer = NIL) & (typ.importedFrom = NIL) THEN 
-(*
-        Console.WriteString("Type ");
-        Console.WriteInt(i,1);
-        Console.WriteString(" is an AnonPointer ");
-        Console.WriteLn;
- *)
           typ(Pointer).isAnonPointer := TRUE; 
         END;
         r := typ(Pointer).baseType(Record);
         IF (r.declarer = NIL) THEN  (* anon record *)
-(*
-        Console.WriteString("Type ");
-        Console.WriteInt(i,1);
-        Console.WriteString(" is an Pointer to anon record - fixing");
-        Console.WriteLn;
- *)
           r.isAnonRec := TRUE;
           r.ptrType := typ(Pointer);
         END;
@@ -1150,14 +1098,14 @@ MODULE Browse;
     GetSym();
     NEW(procDesc.pType);
     IF sSym = strSy THEN 
-      IF sAtt = "<init>" THEN
-        procDesc.pType.fName := "< init >";  
+      IF sAtt^ = "<init>" THEN
+        procDesc.pType.fName := BOX("< init >");  
       ELSE
         procDesc.pType.fName := sAtt;
       END;
       GetSym(); 
     ELSE
-      procDesc.pType.fName[0] := 0X;
+      procDesc.pType.fName := NIL;
     END;
     IF sSym = truSy THEN
       procDesc.pType.isConstructor := TRUE;
@@ -1192,11 +1140,11 @@ MODULE Browse;
     AddMod(mod.imports,mod);
     ReadPast(modSy);
     IF sSym = namSy THEN (* do something with f.sAtt *)
-      IF mod.name # sAtt THEN
+      IF mod.name^ # sAtt^ THEN
         Error.WriteString("Wrong name in symbol file. Expected <");
-        Error.WriteString(mod.name + ">, found <");
-        Error.WriteString(sAtt + ">"); 
-	Error.WriteLn;
+        Error.WriteString(mod.name^ + ">, found <");
+        Error.WriteString(sAtt^ + ">"); 
+	    Error.WriteLn;
         HALT(1);
       END;
       GetSym();
@@ -1206,11 +1154,11 @@ MODULE Browse;
       mod.fName := sAtt;
       GetSym();
       IF (sSym = falSy) OR (sSym = truSy) THEN 
-	GetSym();
+        GetSym();
       ELSE RTS.Throw("Bad explicit name");
       END; 
     ELSE
-      mod.fName[0] := 0X;
+      mod.fName := NIL;
     END; 
    (*
     *  Optional strong name info.
@@ -1262,23 +1210,23 @@ MODULE Browse;
 
 (* ============================================================ *)
 
-  PROCEDURE GetSymAndModNames*(VAR symName : FileNames.NameString;
-                               OUT modName : FileNames.NameString);
+  PROCEDURE GetSymAndModNames(VAR symName : CharOpen;
+                              OUT modName : CharOpen);
   VAR i,j : INTEGER;
       ok : BOOLEAN; 
   BEGIN
-    modName := symName;
+    modName := BOX(symName^);
     i := 0;
     WHILE ((i < LEN(symName)) & (symName[i] # '.') & 
            (symName[i] # 0X)) DO INC(i); END;
     IF (i >= LEN(symName)) OR (symName[i] # '.') THEN 
-      symName := symName + symExt;
+      symName := BOX(symName^ + symExt);
     ELSE
       modName[i] := 0X;
     END;
   END GetSymAndModNames;
 
-  PROCEDURE Parse*();
+  PROCEDURE Parse();
   VAR 
     marker,modIx,i   : INTEGER;
     mod : Module;
@@ -1292,9 +1240,9 @@ MODULE Browse;
       IF file = NIL THEN
         file := GPBinFiles.findOnPath("CPSYM", mod.symName);
         IF (file = NIL) OR (mod.progArg) THEN
-          Error.WriteString("File <" + mod.symName + "> not found"); 
+          Error.WriteString("File <" + mod.symName^ + "> not found"); 
           Error.WriteLn;
-	  HALT(1);
+          HALT(1);
         END;
         mod.pathName := GPBinFiles.getFullPathName(file);
         i := 0;
@@ -1307,12 +1255,15 @@ MODULE Browse;
         ELSIF marker = RTS.loInt(syMag) THEN
           mod.systemMod := TRUE;
         ELSE
-          Error.WriteString("File <"+fileName+"> is not a valid symbol file"); 
+          Error.WriteString("File <" + fileName^ + "> is not a valid symbol file"); 
           Error.WriteLn;
           RETURN;
         END;
         mod.print := TRUE;
         GetSym();
+        IF verbose THEN
+          Error.WriteString("Reading " + mod.name^); Error.WriteLn;
+        END;
         SymFile(mod);
         GPBinFiles.CloseFile(file);
       END;
@@ -1384,9 +1335,9 @@ BEGIN
 END Indent;
 
 PROCEDURE (o : Output) WriteImportedTypeName(impMod : Module;
-                                        tName : ARRAY OF CHAR),NEW,EXTENSIBLE;
+                                             tName : ARRAY OF CHAR),NEW,EXTENSIBLE;
 BEGIN
-  Console.WriteString(impMod.name + "." + tName);
+  Console.WriteString(impMod.name^ + "." + tName);
 END WriteImportedTypeName;
 
 PROCEDURE (o : Output) WriteTypeName(tName : ARRAY OF CHAR),NEW,EXTENSIBLE;
@@ -1455,9 +1406,9 @@ BEGIN
 END Indent;
 
 PROCEDURE (f : FileOutput) WriteImportedTypeName(impMod : Module;
-                                              tName : ARRAY OF CHAR),EXTENSIBLE;
+                                                 tName : ARRAY OF CHAR),EXTENSIBLE;
 BEGIN
-  GPText.WriteString(f.file,impMod.name + "." + tName);
+  GPText.WriteString(f.file,impMod.name^ + "." + tName);
 END WriteImportedTypeName;
 
 PROCEDURE (f : FileOutput) WriteTypeName(tName : ARRAY OF CHAR),EXTENSIBLE;
@@ -1560,7 +1511,7 @@ BEGIN
   GPText.WriteString(h.file,'.html#type-');;
   GPText.WriteString(h.file,tName);
   GPText.WriteString(h.file,'">');
-  GPText.WriteString(h.file,impMod.name + "." + tName);
+  GPText.WriteString(h.file,impMod.name^ + "." + tName);
   GPText.WriteString(h.file,'</a>');
 END WriteImportedTypeName;
 
@@ -1607,23 +1558,68 @@ END MethAnchor;
 (*				Format Helpers				*)
 (* ==================================================================== *)
 
-  PROCEDURE qStrOf(str : FileNames.NameString) : CharOpen;
+  PROCEDURE qStrOf(str : CharOpen) : CharOpen;
     VAR len : INTEGER;
-	res : CharOpen;
 	idx : INTEGER;
-	dQt : BOOLEAN;
+	ord : INTEGER;
+        rslt : LitValue.CharVector;
+    (* -------------------------------------- *)
+    PROCEDURE hexDigit(d : INTEGER) : CHAR;
+    BEGIN
+      IF d < 10 THEN RETURN CHR(d + ORD('0')) 
+      ELSE RETURN CHR(d-10 + ORD('a'));
+      END;
+    END hexDigit;
+    (* -------------------------------------- *)
+    PROCEDURE AppendHex2D(r : LitValue.CharVector; o : INTEGER);
+    BEGIN
+      APPEND(r, '\');
+      APPEND(r, 'x');
+      APPEND(r, hexDigit(o DIV 16 MOD 16));
+      APPEND(r, hexDigit(o        MOD 16));
+    END AppendHex2D;
+    (* -------------------------------------- *)
+    PROCEDURE AppendUnicode(r : LitValue.CharVector; o : INTEGER);
+    BEGIN
+      APPEND(r, '\');
+      APPEND(r, 'u');
+      APPEND(r, hexDigit(o DIV 1000H MOD 16));
+      APPEND(r, hexDigit(o DIV  100H MOD 16));
+      APPEND(r, hexDigit(o DIV   10H MOD 16));
+      APPEND(r, hexDigit(o           MOD 16));
+    END AppendUnicode;
+    (* -------------------------------------- *)
   BEGIN
-    dQt := FALSE;
-    len := LEN(str$);
-    FOR idx := 0 TO len-1 DO
-      IF str[idx] = '"' THEN dQt := TRUE END;
-    END;
-    NEW(res, len+3);
-    IF dQt THEN res[0] := "'" ELSE res[0] := '"' END;
-    FOR idx := 1 TO len DO res[idx] := str[idx-1] END;
-    IF dQt THEN res[len+1] := "'" ELSE res[len+1] := '"' END;
-    res[len+2] := 0X;
-    RETURN res;
+   (*
+    *  Translate the string into ANSI-C like
+    *  for human, rather than machine consumption.
+    *)
+    NEW(rslt, LEN(str) * 2);
+    APPEND(rslt, '"');
+    FOR idx := 0 TO LEN(str) - 2 DO
+      ord := ORD(str[idx]);
+      CASE ord OF
+      |  0 : APPEND(rslt, '\');
+             APPEND(rslt, '0');
+      |  9 : APPEND(rslt, '\');
+             APPEND(rslt, 't');
+      | 10 : APPEND(rslt, '\');
+             APPEND(rslt, 'n');
+      | 12 : APPEND(rslt, '\');
+             APPEND(rslt, 'r');
+      | ORD('"') :
+             APPEND(rslt, '/');
+             APPEND(rslt, '"');
+      ELSE
+        IF ord > 0FFH THEN AppendUnicode(rslt, ord);
+        ELSIF (ord > 07EH) OR (ord < ORD(' ')) THEN AppendHex2D(rslt, ord);
+        ELSE APPEND(rslt, CHR(ord));
+        END;
+      END;
+    END;
+    APPEND(rslt, '"');
+    APPEND(rslt, 0X);
+    RETURN LitValue.chrVecToCharOpen(rslt);
   END qStrOf;
 
   PROCEDURE hexOf(ch : CHAR) : CharOpen;
@@ -1709,7 +1705,7 @@ END MethAnchor;
     RETURN i; 
   END Length;
 
-  PROCEDURE (v : LitValue) Print(),NEW,EMPTY;
+  PROCEDURE (v : AbsValue) Print(),NEW,EMPTY;
 
   PROCEDURE (n : NumValue) Print();
   BEGIN
@@ -2052,8 +2048,8 @@ END MethAnchor;
     output.WriteKeyword("PROCEDURE ");
     output.WriteIdent(p.declarer.name);
     output.Write(accArray[p.declarer.access]);
-    IF printFNames & (p.fName[0] # 0X) THEN
-      output.WriteString('["' + p.fName + '"]');
+    IF printFNames & (p.fName # NIL) THEN
+      output.WriteString('["' + p.fName^ + '"]');
       INC(indent,Length(p.fName)+4);
     END; 
     PrintFormals(p,indent+11+Length(p.declarer.name));
@@ -2088,8 +2084,8 @@ END MethAnchor;
     output.WriteString(") ");
     output.WriteIdent(m.declarer.name);
     output.Write(accArray[m.declarer.access]);
-    IF printFNames & (m.fName[0] # 0X) THEN
-      output.WriteString('["' + m.fName + '"]');
+    IF printFNames & (m.fName # NIL) THEN
+      output.WriteString('["' + m.fName^ + '"]');
       INC(indent,Length(m.fName)+4);
     END; 
     PrintFormals(m, indent + 15 + 
@@ -2224,11 +2220,11 @@ END MethAnchor;
     (* --------------------------- *)
     PROCEDURE WriteOptionalExtras(impMod : Module);
     BEGIN
-      IF impMod.fName[0] # 0X THEN
+      IF impMod.fName # NIL THEN
         IF printFNames THEN
-          output.WriteString(' (* "' + impMod.fName + '" *)');
+          output.WriteString(' (* "' + impMod.fName^ + '" *)');
         ELSE
-          output.WriteString(' := "' + impMod.fName + '"');
+          output.WriteString(' := "' + impMod.fName^ + '"');
         END; 
       END; 
     END WriteOptionalExtras;
@@ -2242,7 +2238,7 @@ END MethAnchor;
     output.WriteStart(mod);
     IF mod.systemMod THEN
       heading := "SYSTEM ";
-    ELSIF mod.fName[0] # 0X THEN
+    ELSIF mod.fName # NIL THEN
       heading := "FOREIGN ";
     ELSE
       heading := "";
@@ -2250,8 +2246,8 @@ END MethAnchor;
     heading := heading + "MODULE ";
     output.WriteKeyword(heading);
     output.WriteIdent(mod.name);
-    IF printFNames & (mod.fName[0] # 0X) THEN 
-      output.WriteString(' ["' + mod.fName + '"]'); 
+    IF printFNames & (mod.fName # NIL) THEN 
+      output.WriteString(' ["' + mod.fName^ + '"]'); 
     END;
     output.Write(';'); 
    (*
@@ -2344,21 +2340,21 @@ END MethAnchor;
   BEGIN
     NEW(typeList,50);
     typeList[0] := NIL;
-    NEW(t); t.name := "BOOLEAN"; typeList[1] := t;
-    NEW(t); t.name := "SHORTCHAR"; typeList[2] := t;
-    NEW(t); t.name := "CHAR"; typeList[3] := t;
-    NEW(t); t.name := "BYTE"; typeList[4] := t;
-    NEW(t); t.name := "SHORTINT"; typeList[5] := t;
-    NEW(t); t.name := "INTEGER"; typeList[6] := t;
-    NEW(t); t.name := "LONGINT"; typeList[7] := t;
-    NEW(t); t.name := "SHORTREAL"; typeList[8] := t;
-    NEW(t); t.name := "REAL"; typeList[9] := t;
-    NEW(t); t.name := "SET"; typeList[10] := t;
-    NEW(t); t.name := "ANYREC"; typeList[11] := t;
-    NEW(t); t.name := "ANYPTR"; typeList[12] := t;
-    NEW(t); t.name := "ARRAY OF CHAR"; typeList[13] := t;
-    NEW(t); t.name := "ARRAY OF SHORTCHAR"; typeList[14] := t;
-    NEW(t); t.name := "UBYTE"; typeList[15] := t;
+    NEW(t); t.name := BOX("BOOLEAN"); typeList[1] := t;
+    NEW(t); t.name := BOX("SHORTCHAR"); typeList[2] := t;
+    NEW(t); t.name := BOX("CHAR"); typeList[3] := t;
+    NEW(t); t.name := BOX("BYTE"); typeList[4] := t;
+    NEW(t); t.name := BOX("SHORTINT"); typeList[5] := t;
+    NEW(t); t.name := BOX("INTEGER"); typeList[6] := t;
+    NEW(t); t.name := BOX("LONGINT"); typeList[7] := t;
+    NEW(t); t.name := BOX("SHORTREAL"); typeList[8] := t;
+    NEW(t); t.name := BOX("REAL"); typeList[9] := t;
+    NEW(t); t.name := BOX("SET"); typeList[10] := t;
+    NEW(t); t.name := BOX("ANYREC"); typeList[11] := t;
+    NEW(t); t.name := BOX("ANYPTR"); typeList[12] := t;
+    NEW(t); t.name := BOX("ARRAY OF CHAR"); typeList[13] := t;
+    NEW(t); t.name := BOX("ARRAY OF SHORTCHAR"); typeList[14] := t;
+    NEW(t); t.name := BOX("UBYTE"); typeList[15] := t;
 (*
  *  NEW(t); t.name := "SPECIAL"; typeList[16] := t;
  *)
@@ -2467,8 +2463,14 @@ BEGIN
       ELSE
         BadOption(option);
       END;
-    ELSIF option = "-verbatim" THEN
-      verbatim := TRUE;
+    ELSIF option[1] = 'v' THEN
+      IF option = "-verbatim" THEN
+        verbatim := TRUE;
+      ELSIF option = "-verbose" THEN
+        verbose := TRUE;
+      ELSE
+        BadOption(option);
+      END;
     ELSIF option = "-all" THEN
       doAll := TRUE;
     ELSIF option = "-hex" THEN
@@ -2503,7 +2505,7 @@ BEGIN
       output.thisMod := modList.list[i];
       IF output IS FileOutput THEN
         output(FileOutput).file := 
-            GPTextFiles.createFile(modList.list[i].name + outExt);
+            GPTextFiles.createFile(modList.list[i].name^ + outExt);
       END;
       PrintModule(modList.list[i]); 
       IF output IS FileOutput THEN
@@ -2517,6 +2519,8 @@ RESCUE (x)
 END Print;
 
 BEGIN
+  NEW(fileName, 256);
+  NEW(modName, 256);
   InitTypes();
   InitAccArray();
   modList.tide := 0;

+ 1 - 3
gpcp/Builtin.cp

@@ -159,9 +159,6 @@ MODULE Builtin;
     rec.extrnNm := blk.scopeNm;
     rec.recAtt  := att;
     INCL(rec.xAttr, Symbols.clsTp);		(* new 04.jun.01 *)
-(*
- *  INCL(rec.xAttr, Symbols.noNew);		(* new 04.aug.01 *)
- *)
     tId.SetMode(Symbols.pubMode);
     tId.dfScp := blk;
     tId.hash  := NameHash.enterStr(nam);
@@ -303,6 +300,7 @@ MODULE Builtin;
     hash := NameHash.enterStr(str);
     var.hash := hash;
     var.dfScp := NIL;
+    var.SetNameFromString(BOX(str$));
     ASSERT(CompState.thisMod.symTb.enter(hash, var));
   END BindName;
 

+ 22 - 30
gpcp/CPMake.cp

@@ -145,25 +145,16 @@ BEGIN
     GPBinFiles.CloseFile(S.src);
     CPascal.FixListing();
     CPascal.Finalize();
-    Chuck("Parse error(s) in module <" + mod.name + ">");
+    Chuck("Parse error(s) in module <" + mod.name^ + ">");
   END;
 END Check;
 
 PROCEDURE DoImport(mod : MH.ModInfo; VAR mainImported : BOOLEAN);
 VAR
-  mName : FileNames.NameString;
+  mName : MH.ModName;
   aMod  : MH.ModInfo;
   last  : S.Token;
-  strng, impNm : POINTER TO ARRAY OF CHAR;
-  (* ----------------------------------------------------------- *)
-  PROCEDURE AssignOpen(src : LitValue.CharOpen; 
-                   OUT dst : FileNames.NameString);
-    VAR idx, max : INTEGER;
-  BEGIN
-    max := MIN(LEN(src), LEN(FileNames.NameString));
-    FOR idx := 0 TO max-1 DO dst[idx] := src[idx] END;
-  END AssignOpen;
-  (* ----------------------------------------------------------- *)
+  strng, impNm : MH.ModName;
 BEGIN
   Check(G.identSym,mod);
   last := token;
@@ -173,12 +164,13 @@ BEGIN
     token := S.get();			(* read past ident *)
   END;
   IF last.sym = G.identSym THEN
-    S.GetString(last.pos, last.len, mName);
+    mName := LitValue.subStrToCharOpen(last.pos, last.len);
   ELSIF last.sym = G.stringSym THEN
     strng := LitValue.subStrToCharOpen(last.pos+1, last.len-2);
     ForeignName.ParseModuleString(strng, impNm);
-    AssignOpen(impNm, mName);
+    mName := impNm;
   ELSE
+    mName := NIL;
     Chuck("Bad module name for alias import");
   END;
   IF (NameHash.enterSubStr(last.pos, last.len) = NameHash.mainBkt) OR 
@@ -198,7 +190,7 @@ VAR
   cpmainImported : BOOLEAN;
   hsh : INTEGER;
 BEGIN
-  CompState.InitCompState(mod.name + ".cp");
+  CompState.InitCompState(mod.name^ + ".cp");
   mod.importsLinked := TRUE;
   cpmainImported := FALSE;
   S.Reset;
@@ -213,8 +205,8 @@ BEGIN
   Check(G.MODULESym,mod); token := S.get();
   Check(G.identSym,mod);
   S.GetString(token.pos,token.len,mName);
-  IF (mName # mod.name) THEN 
-    Chuck("File " + mod.name + ".cp does not contain MODULE " + mName);
+  IF (mName # mod.name^) THEN 
+    Chuck("File " + mod.name^ + ".cp does not contain MODULE " + mName);
   END;
   token := S.get();
   IF token.sym = G.lbrackSym THEN
@@ -233,9 +225,9 @@ BEGIN
     END;
   END;
   IF (mod = graph) & ~cpmainImported THEN
-    Warn("WARNING: " + mod.name + " is not a base module.");
-    Warn("Modules that " + mod.name + " depends on will be checked for consistency");
-    Warn("Modules that depend on " + mod.name + " will not be checked or recompiled");
+    Warn("WARNING: " + mod.name^ + " is not a base module.");
+    Warn("Modules that " + mod.name^ + " depends on will be checked for consistency");
+    Warn("Modules that depend on " + mod.name^ + " will not be checked or recompiled");
   END;
 END LinkImports;
 
@@ -248,10 +240,10 @@ VAR
 BEGIN
   NEW(graph); 
   ReadModuleName(name);
-  graph := MH.GetModule(name);
-  S.src := GPBinFiles.findLocal(graph.name + ".cp");
+  graph := MH.GetModule(BOX(name$));
+  S.src := GPBinFiles.findLocal(graph.name^ + ".cp");
   IF S.src = NIL THEN
-    Chuck("Could not find base file <" + graph.name + ".cp>");
+    Chuck("Could not find base file <" + graph.name^ + ".cp>");
   ELSE
     GPBinFiles.CloseFile(S.src);
   END;
@@ -259,12 +251,12 @@ BEGIN
   nextIx := 0; 
   WHILE (nextIx < toDoList.tide) DO
     nextModule := toDoList.list[nextIx]; INC(nextIx);
-    S.src := GPBinFiles.findLocal(nextModule.name + ".cp");
+    S.src := GPBinFiles.findLocal(nextModule.name^ + ".cp");
     SF.OpenSymbolFile(nextModule.name, S.src = NIL);
     IF S.src = NIL THEN
       IF SF.file = NIL THEN 
-        Chuck("Cannot find source file <" + nextModule.name + 
-                  ".cp> or symbol file <" + nextModule.name + 
+        Chuck("Cannot find source file <" + nextModule.name^ + 
+                  ".cp> or symbol file <" + nextModule.name^ + 
                   ".cps> on CPSYM path.");
       ELSE 
         SF.ReadSymbolFile(nextModule,FALSE); 
@@ -313,7 +305,7 @@ BEGIN
   IF mod.isForeign THEN
     IF ~CompState.quiet THEN
       Console.WriteString(
-	  "#cpmake:  "+mod.name+" is foreign, compiling with -special.");
+	  "#cpmake:  " + mod.name^ + " is foreign, compiling with -special.");
       Console.WriteLn;
       Console.WriteString(
 	  "#cpmake:  Foreign implementation may need recompilation.");
@@ -321,10 +313,10 @@ BEGIN
     END;
     CPascal.DoOption("-special");
   ELSIF ~CompState.quiet THEN
-    Console.WriteString("#cpmake:  compiling " + mod.name);
+    Console.WriteString("#cpmake:  compiling " + mod.name^);
     Console.WriteLn;
   END;
-  CPascal.Compile(mod.name+".cp",retVal); 
+  CPascal.Compile(mod.name^ + ".cp",retVal); 
   mod.key := NewSymFileRW.GetLastKeyVal(); 
   INC(compCount);
 END CompileModule;
@@ -343,7 +335,7 @@ BEGIN
       retVal := 0;
       CompileModule(node,retVal);
       IF retVal # 0 THEN
-        Chuck("Compile errors in module <" + node.name + ">");
+        Chuck("Compile errors in module <" + node.name^ + ">");
       END;
     END;
     FOR ix := 0 TO node.importedBy.tide-1 DO

+ 6 - 3
gpcp/CPascalErrors.cp

@@ -507,6 +507,8 @@ MODULE CPascalErrors;
     | 234: str := "Extension of LIMITED type must be limited";
     | 235: str := "LIMITED types can only be extended in the same module";
     | 236: str := "Cannot resolve CLR name of this type";
+    | 237: str := "Invalid hex escape sequence in this string";
+    | 238: str := "STA is illegal unless target is NET";
 
     | 298: str := "ILASM failed to assemble IL file";
     | 299: str := "Compiler raised an internal exception";
@@ -532,6 +534,7 @@ MODULE CPascalErrors;
     | 316: str := "This pointer type may still have its default NIL value";
     | 317: str := "Empty CASE statement will trap if control reaches here";
     | 318: str := "Empty WITH statement will trap if control reaches here";
+    | 319: str := "STA has no effect without CPmain or WinMain";
     (* ==================== END WARNINGS ====================== *)
     ELSE
       str := "Semantic error: " + LitValue.intToCharOpen(num)^;	
@@ -542,12 +545,12 @@ MODULE CPascalErrors;
       msg[idx] := str[idx];
     END;
     msg[len] := 0X;
-    IF num < 300 THEN 
+    IF num < 300 THEN
       INC(Scnr.errors); 
       StoreError(num,lin,col,msg); 
-    ELSE 
+    ELSIF ~nowarn THEN 
       INC(Scnr.warnings); 
-      IF ~nowarn THEN StoreError(num,lin,col,msg); END; 
+      StoreError(num,lin,col,msg);
     END;
 
     IF prompt THEN

+ 2 - 1
gpcp/CPascalG.cp

@@ -22,5 +22,6 @@ CONST
   IMPORTSym* = 72; MODULESym* = 73;  CLOSESym* = 74;  
   INTERFACESym* = 75;  RESCUESym* = 76; 
   STATICSym* = 77; ENUMSym* = 78; DIV0Sym* = 79; REM0Sym* = 80;
-  EVENTSym* = 81; VECTORSym* = 82; NOSYM* = 83; idVariant* = 84; 
+  EVENTSym* = 81; VECTORSym* = 82; NOSYM* = 83; idVariant* = 84;
+  bangStrSym* = 85; 
 END CPascalG.

+ 67 - 3
gpcp/CPascalP.cp

@@ -34,7 +34,7 @@ MODULE CPascalP;
 (* ==================================================================== *)
 
 CONST
-  maxT       = 82;
+  maxT       = 85;
   minErrDist =  2;  (* minimal distance (good tokens) between two errors *)
   setsize    = 32;
   noError    = -1;
@@ -341,6 +341,8 @@ VAR
     ident.dfScp := ident;
     ident.hash  := idHsh;
 
+	IF G.verbose THEN ident.SetNameFromHash(idHsh) END;
+
     IF ident.hash = Bi.sysBkt THEN
       dummy := CompState.thisMod.symTb.enter(Bi.sysBkt, CompState.sysMod);
       IF G.verbose THEN G.Message("imports unsafe SYSTEM module") END;
@@ -362,6 +364,7 @@ VAR
       *  there are already references to it in the structure.
       *)
       clash.token := ident.token;   (* to help error reports  *)
+	  IF G.verbose THEN clash.SetNameFromHash(clash.hash) END;
       ident := clash(Id.BlkId);
       IF ~ident.isWeak() & 
          (ident.hash # Bi.sysBkt) THEN SemError(170) END; (* imported twice  *)
@@ -377,6 +380,9 @@ VAR
       modScope.main := TRUE;      (* the import is "CPmain" *)
       INCL(modScope.xAttr, Sy.wMain); (* Windows Main *)
       IF G.verbose THEN G.Message("contains WinMain entry point") END;
+    ELSIF ident.hash = NameHash.staBkt THEN
+      INCL(modScope.xAttr, Sy.sta);
+      IF G.verbose THEN G.Message("sets Single Thread Apartment") END;
     END;
 
     IF Sy.weak IN ident.xAttr THEN
@@ -391,11 +397,26 @@ VAR
         alias.dfScp  := ident;    (* AFTER clash resolved. *)
         Sy.AppendScope(impSeq, alias);
       END;
-
+      
       EXCL(ident.xAttr, Sy.weak); (* ==> directly imported *)
       INCL(ident.xAttr, Sy.need); (* ==> needed in symfile *)
     END;
   END Import;
+  
+  PROCEDURE ImportThreading(modScope : Id.BlkId; VAR impSeq : Sy.ScpSeq);
+    VAR hash : INTEGER;
+        idnt : Id.BlkId;
+  BEGIN
+    hash := NameHash.enterStr("mscorlib_System_Threading");
+    idnt := Id.newImpId();
+    idnt.dfScp := idnt;
+    idnt.hash := hash;
+    IF ~Sy.refused(idnt, modScope) THEN
+      EXCL(idnt.xAttr, Sy.weak);
+      INCL(idnt.xAttr, Sy.need);
+      Sy.AppendScope(impSeq, idnt);
+    END;
+  END ImportThreading;
 
 (* ==================================================================== *)
 
@@ -410,6 +431,21 @@ VAR
       Import(modScope, G.impSeq);
     END;
     Expect(T.semicolonSym);
+	(*
+	 * Now some STA-specific tests.
+	 *)
+	IF Sy.sta IN modScope.xAttr THEN
+      IF Sy.trgtNET THEN
+        ImportThreading(modScope, G.impSeq);
+       ELSE
+         SemError(238);
+      END;
+      IF ~modScope.main THEN 
+        SemError(319); 
+        EXCL(modScope.xAttr, Sy.sta);
+      END;	  
+    END;
+    
     G.import1 := RTS.GetMillis();
 IF G.legacy THEN
     OldSymFileRW.WalkImports(G.impSeq, modScope);
@@ -1329,6 +1365,9 @@ END;
     | T.stringSym :
         Get;
         xSyn := Xp.tokToStrLt(token.pos, token.len);
+    | T.bangStrSym :
+        Get;
+        xSyn := Xp.translateStrLt(token.pos, token.len);
     | T.NILSym :
         Get;
         xSyn := Xp.mkNilX();
@@ -3320,6 +3359,7 @@ END;
     IF iSyn IS Sy.Scope THEN iSyn(Sy.Scope).ovfChk := G.ovfCheck END;
     iSyn.token := nextT;
     iSyn.hash  := NameHash.enterSubStr(nextT.pos, nextT.len);
+    IF G.verbose THEN iSyn.SetNameFromHash(iSyn.hash) END;
     iSyn.dfScp := inhScp;
     IF nextT.dlr & ~G.special THEN SemErrorT(186, nextT) END;
     Expect(T.identSym);
@@ -3391,6 +3431,30 @@ END;
     G.parseS := RTS.GetMillis();
     Module;
   END Parse;
+  
+(* ==================================================================== *)
+
+  PROCEDURE parseTextAsStatement*(text : ARRAY OF LitValue.CharOpen; encScp : Sy.Scope) : Sy.Stmt;
+    VAR result : Sy.Stmt;
+  BEGIN
+    G.SetQuiet;
+    NEW(nextT);
+    S.NewReadBuffer(text); Get;
+    result := statementSequence(NIL, encScp);
+    S.RestoreFileBuffer();
+    G.RestoreQuiet;
+    RETURN result;
+  END parseTextAsStatement;
+
+  PROCEDURE ParseDeclarationText*(text : ARRAY OF LitValue.CharOpen; encScp : Sy.Scope);
+  BEGIN
+    G.SetQuiet;
+    NEW(nextT);
+    S.NewReadBuffer(text); Get;
+    DeclarationSequence(encScp);
+    S.RestoreFileBuffer();
+    G.RestoreQuiet;
+  END ParseDeclarationText;
 
 (* ==================================================================== *)
 
@@ -3422,7 +3486,7 @@ BEGIN
   symSet[ 3, 0] := {T.identSym, T.integerSym, T.realSym, T.CharConstantSym,
                     T.stringSym, T.minusSym, T.lparenSym, T.plusSym};
   symSet[ 3, 1] := {T.NILSym-32, T.tildeSym-32, T.lbraceSym-32};
-  symSet[ 3, 2] := {};
+  symSet[ 3, 2] := {T.bangStrSym-64};
   (* ------------------------------------------------------------ *)
 
   (* lookahead of optional statement *)

+ 119 - 46
gpcp/CPascalS.cp

@@ -14,12 +14,13 @@ MODULE CPascalS;
 (* Scanner generated by Coco/R *)
 
 IMPORT	
-	GPCPcopyright,
-	RTS,
-	Console,
-	Tok := CPascalG,
-	GPBinFiles,
-	GPTextFiles;
+    GPCPcopyright,
+    RTS,
+    ASCII,
+    Console,
+    Tok := CPascalG,
+    GPBinFiles,
+    GPTextFiles;
 
 CONST
   noSym   = Tok.NOSYM; (*error token code*)
@@ -28,6 +29,7 @@ CONST
   eofByt  = 0;
   EOL     = 0AX;
   BlkSize = 32768;
+  BlkNmbr = 32;
   asciiHT = 9X;
   asciiLF = EOL;
 
@@ -38,7 +40,7 @@ CONST
 
 TYPE
   BufBlk     = ARRAY BlkSize OF UBYTE;
-  Buffer     = ARRAY 32  OF POINTER TO BufBlk;
+  Buffer     = ARRAY BlkNmbr OF POINTER TO BufBlk;
   StartTable = ARRAY 256 OF INTEGER;
 
 (* ======================== EXPORTS ========================= *)
@@ -71,6 +73,8 @@ VAR
   LBlkSize:  INTEGER;    (*BlkSize*)
   inputLen:  INTEGER;    (*source file size*)
   buf:       Buffer;     (*source buffer for low-level access*)
+  savedBuf:  Buffer;
+  bufSaved:  BOOLEAN;
   start:     StartTable; (*start state for every character*)
   nextLine:  INTEGER;    (*line of lookahead symbol*)
   nextCol:   INTEGER;    (*column of lookahead symbol*)
@@ -184,6 +188,23 @@ PROCEDURE^ SkipAndGetLine*(i : INTEGER;		(* indent to skip *)
     END;
   END digitAt;
 
+  PROCEDURE getHex*(pos, len : INTEGER) : INTEGER;
+    VAR ch : CHAR;
+        ix : INTEGER;
+        rslt : INTEGER;
+  BEGIN
+    rslt := 0;
+    FOR ix := pos TO pos + len - 1 DO
+      ch := charAt(ix);
+      IF (ch >= '0') & (ch <= '9')    THEN rslt := rslt * 16 + ORD(ch) - ORD('0');
+      ELSIF (ch >= 'a') & (ch <= 'f') THEN rslt := rslt * 16 + ORD(ch) + (10 - ORD('a'));
+      ELSIF (ch >= 'A') & (ch <= 'F') THEN rslt := rslt * 16 + ORD(ch) + (10 - ORD('A'));
+      ELSE RETURN -237;
+      END;
+    END;
+    RETURN rslt;
+  END getHex;
+
 PROCEDURE tokToLong*(t : Token) : LONGINT;
   VAR long : LONGINT;
       last : LONGINT;
@@ -407,7 +428,7 @@ END tokToChar;
         VAR new : Token;
       BEGIN
         NEW(new);
-	IF kind = Tok.idVariant THEN kind := Tok.identSym; new.dlr := TRUE END;
+        IF kind = Tok.idVariant THEN kind := Tok.identSym; new.dlr := TRUE END;
         new.sym := kind; 
         new.lin := nextLine; new.col := nextCol;
         new.len := nextLen;  new.pos := nextPos;
@@ -429,67 +450,75 @@ END tokToChar;
       CASE state OF
       (* ---------------------------------- *)
          1: (* start of ordinary identifier *)
-	    IF (ch >= "0") & (ch <= "9") OR
+	        IF (ch >= "0") & (ch <= "9") OR
                (ch >= "A") & (ch <= "Z") OR
                (ch >= "a") & (ch <= "z") OR
                (ch >= 0C0X) & (ch <= 0D6X) OR
                (ch >= 0D8X) & (ch <= 0F6X) OR
                (ch >= 0F8X) & (ch <= 0FFX) OR
-	       (ch = "_")                THEN (* skip *)
-	    ELSIF ch = "@" THEN state := 45;
-	    ELSIF ch = "$" THEN state := 46; 
+               (ch = "_")                THEN (* skip *)
+            ELSIF ch = "@" THEN state := 45;
+			ELSIF ch = "$" THEN state := 46; 
             ELSE sym := Tok.identSym; CheckLiteral(sym); RETURN mkToken(sym);
             END;
       (* ---------------------------------- *)
       | 44:(* start of ` escaped identifier *)
-	    IF (ch >= "0") & (ch <= "9") OR
-               (ch >= "A") & (ch <= "Z") OR
-               (ch >= "a") & (ch <= "z") OR
-               (ch >= 0C0X) & (ch <= 0D6X) OR
-               (ch >= 0D8X) & (ch <= 0F6X) OR
-               (ch >= 0F8X) & (ch <= 0FFX) OR
-               (ch = "_")                THEN (* skip *)
-	    ELSE 
-	      SemError.Report(187, nextLine, spaces); 
-	      RETURN mkToken(noSym);
-	    END;
-	    (* throw away the escape char *)
-	    INC(nextPos); INC(nextCol); DEC(nextLen);
-	    state := 45;
+			IF (ch >= "0") & (ch <= "9") OR
+				   (ch >= "A") & (ch <= "Z") OR
+				   (ch >= "a") & (ch <= "z") OR
+				   (ch >= 0C0X) & (ch <= 0D6X) OR
+				   (ch >= 0D8X) & (ch <= 0F6X) OR
+				   (ch >= 0F8X) & (ch <= 0FFX) OR
+				   (ch = "_")                THEN (* skip *)
+			ELSE 
+			  SemError.Report(187, nextLine, spaces); 
+			  RETURN mkToken(noSym);
+			END;
+			(* throw away the escape char *)
+			INC(nextPos); INC(nextCol); DEC(nextLen);
+			state := 45;
       (* ---------------------------------- *)
       | 45:(* rest of ` escaped identifier  *)
-	    IF (ch >= "0") & (ch <= "9") OR
-               (ch >= "A") & (ch <= "Z") OR
-               (ch >= "a") & (ch <= "z") OR
-	       (ch = "@")                OR 
-	       (ch = "_")                THEN (* skip *)
-	    ELSIF ch = "$" THEN state := 47; 
-            ELSE RETURN mkToken(Tok.idVariant); (* No check for reserved words *)
-            END;
+			IF (ch >= "0") & (ch <= "9") OR
+			   (ch >= "A") & (ch <= "Z") OR
+			   (ch >= "a") & (ch <= "z") OR
+			   (ch = "@")                OR 
+			   (ch = "_")                THEN (* skip *) 
+			ELSIF ch = "$" THEN state := 47; 
+			ELSE RETURN mkToken(Tok.idVariant); (* No check for reserved words *)
+			END;
       (* ---------------------------------- *)
       | 46:(* check for $ at end of ident.  *)
-	    IF (ch >= "0") & (ch <= "9") OR
+	        IF (ch >= "0") & (ch <= "9") OR
                (ch >= "A") & (ch <= "Z") OR
                (ch >= "a") & (ch <= "z") OR
-	       (ch = "_")                THEN state := 45; (* embedded "$" *)
+               (ch = "_")                THEN state := 45; (* embedded "$" *)
             ELSE 
               DEC(bp, 2); DEC(nextLen); NextCh; 
               sym := Tok.identSym; CheckLiteral(sym); RETURN mkToken(sym);
             END;
       (* ---------------------------------- *)
       | 47:(* check for $ at end of idVar't *)
-	    IF (ch >= "0") & (ch <= "9") OR
+            IF (ch >= "0") & (ch <= "9") OR
                (ch >= "A") & (ch <= "Z") OR
                (ch >= "a") & (ch <= "z") OR
-	       (ch = "_")                THEN state := 45; (* embedded "$" *)
+               (ch = "_")                THEN state := 45; (* embedded "$" *)
             ELSE 
               DEC(bp, 2); DEC(nextLen); NextCh; 
               RETURN mkToken(Tok.idVariant); (* No check for reserved words *)
             END;
+      (* ---------------------------------- *)
+	  | 49: (* !" ..." format string *)
+	        IF ch = '"' THEN state := 51;
+			ELSIF ch = '\' THEN state := 50;
+			END;
+	  | 50: (* Last char was '\' inside bangStr *)
+	        state := 49;
+	  | 51: RETURN mkToken(Tok.bangStrSym);
       (* ---------------------------------- *)
       |  2: RETURN mkToken(Tok.integerSym);
       |  3: DEC(bp, apx+1); DEC(nextLen, apx);
-	    NextCh; RETURN mkToken(Tok.integerSym);
+	        NextCh; RETURN mkToken(Tok.integerSym);
       |  4: IF (ch >= "0") & (ch <= "9") THEN 
             ELSIF (ch = "E") THEN state := 5; 
             ELSE RETURN mkToken(Tok.realSym);
@@ -509,7 +538,7 @@ END tokToChar;
       |  9: IF (ch <= CHR(9)) OR
                (ch >= CHR(11)) & (ch <= CHR(12)) OR
                (ch >= CHR(14)) & (ch <= "!") OR
-               (ch>="#") THEN 
+               (ch >= "#") THEN 
             ELSIF (ch = '"') THEN state := 10; 
             ELSE RETURN mkToken(noSym);
             END;
@@ -543,7 +572,9 @@ END tokToChar;
             END;
       | 15: RETURN mkToken(Tok.starSym);
       | 16: RETURN mkToken(Tok.minusSym);
-      | 17: RETURN mkToken(Tok.bangSym);
+      | 17: IF (ch = '"') THEN state := 49;
+	        ELSE RETURN mkToken(Tok.bangSym);
+			END; 
       | 18: IF (ch = ".") THEN state := 40; 
             ELSE RETURN mkToken(Tok.pointSym);
             END;
@@ -646,6 +677,7 @@ END tokToChar;
     len: INTEGER;
     i, read: INTEGER;
   BEGIN (*assert: src has been opened*)
+    FOR i := 0 TO BlkNmbr - 1 DO savedBuf[i] := NIL END; bufSaved := FALSE;
     i := -1;
     inputLen := 0;
     REPEAT
@@ -655,9 +687,6 @@ END tokToChar;
       *  Reuse for later compilation, expanding if necessary.
       *)
       IF buf[i] = NIL THEN NEW(buf[i]) END;
-(*
-      read := GPTextFiles.readNChars(src, buf[i]^, BlkSize);
- *)
       read := GPBinFiles.readNBytes(src, buf[i]^, BlkSize);
       INC(inputLen, read);
     UNTIL read < BlkSize;
@@ -668,6 +697,50 @@ END tokToChar;
     spaces := 0; (* # new # *)
     NextCh;
   END Reset;
+  
+  PROCEDURE NewReadBuffer*(source : ARRAY OF POINTER TO ARRAY OF CHAR);
+    VAR count, linIx, chrIx, index : INTEGER;
+        lineP : POINTER TO ARRAY OF CHAR;
+        theCh : CHAR;
+  BEGIN
+    IF ~bufSaved THEN
+      count := 0;
+      WHILE (count < BlkNmbr) & (buf[count] # NIL) DO
+        savedBuf[count] := buf[count]; INC(count);
+      END;
+    END;
+    bufSaved := TRUE;
+    NEW(buf[0]);
+    index := 0;
+    FOR linIx := 0 TO LEN(source) - 1 DO
+      lineP := source[linIx];
+      chrIx := 0;
+      theCh := lineP[0]; 
+      WHILE theCh # 0X DO
+        buf[0][index] := USHORT(ORD(theCh)); INC(index); INC(chrIx);
+        theCh := lineP[chrIx];
+      END;
+      buf[0][index] := ORD(ASCII.LF); INC(index);
+    END;
+    buf[0][index] := eofByt;
+   (*
+    *  Initialize the scanner state.
+    *)
+    curLine := 1; lineStart := -2; bp := -1;
+    oldEols := 0; apx := 0;
+    spaces := 0; (* # new # *)
+    NextCh;
+      
+  END NewReadBuffer;
+  
+  PROCEDURE RestoreFileBuffer*();
+    VAR count : INTEGER;
+  BEGIN
+    count := 0;
+    WHILE (count < BlkNmbr) & (savedBuf[count] # NIL) DO
+      buf[count] := savedBuf[count]; INC(count);
+    END;
+  END RestoreFileBuffer;
 
 (* ==================================================================== *)
 
@@ -680,8 +753,8 @@ BEGIN
   start[ 20] := 48; start[ 21] := 48; start[ 22] := 48; start[ 23] := 48; 
   start[ 24] := 48; start[ 25] := 48; start[ 26] := 48; start[ 27] := 48; 
   start[ 28] := 48; start[ 29] := 48; start[ 30] := 48; start[ 31] := 48; 
-  start[ 32] := 48; start[ 33] := 17; start[ 34] :=  9; start[ 35] := 30; 
-  start[ 36] := 29; start[ 37] := 48; start[ 38] := 36; start[ 39] := 11; 
+  start[ 32] := 48; start[ 33] := 17; start[ 34] :=  9; start[ 35] := 30; (* '!' = 33 => state 17 *)
+  start[ 36] := 29; start[ 37] := 48; start[ 38] := 36; start[ 39] := 11; (* '%' = 37 => state 48 *)
   start[ 40] := 21; start[ 41] := 23; start[ 42] := 15; start[ 43] := 22; 
   start[ 44] := 20; start[ 45] := 16; start[ 46] := 18; start[ 47] := 35; 
   start[ 48] := 12; start[ 49] := 12; start[ 50] := 12; start[ 51] := 12; 

+ 20 - 24
gpcp/ClassUtil.cp

@@ -312,21 +312,14 @@ MODULE ClassUtil;
     i : INTEGER;
     str1 : L.CharOpen;
   BEGIN
-    IF utf.val = str2 THEN RETURN TRUE; END;
+    IF utf.val = str2 THEN RETURN TRUE END;
     str1 := utf.val;
-    IF str1[0] # str2[0] THEN RETURN FALSE; END;
-    i := 1;
-    WHILE (i < LEN(str1)) & (i < LEN(str2)) &
-          (str1[i] = str2[i]) & (str1[i] # 0X) DO 
-      INC(i); 
-    END; 
-    IF (i = LEN(str1)) THEN
-      RETURN (i = LEN(str2)) OR (str2[i] = 0X);
-    ELSIF (i = LEN(str2)) THEN
-      RETURN (str1[i] = 0X);
-    ELSE
-      RETURN ((str1[i] = 0X) & (str2[i] = 0X));
+    IF (str1[0] # str2[0]) OR 
+       (LEN(str1) # LEN(str2)) THEN RETURN FALSE END;
+    FOR i := 1 TO LEN(str1) - 1 DO
+      IF str1[i] # str2[i] THEN RETURN FALSE END;
     END;
+    RETURN TRUE;
   END Equal;
 
   PROCEDURE AddUTF(VAR cp : ConstantPool; str : L.CharOpen) : INTEGER;
@@ -336,7 +329,7 @@ MODULE ClassUtil;
   BEGIN
     FOR i := 1 TO cp.tide-1 DO
       IF (cp.pool[i] # NIL) & (cp.pool[i] IS UTF8) & 
-         (Equal(cp.pool[i](UTF8),str)) THEN
+         Equal(cp.pool[i](UTF8), str) THEN
         RETURN i;
       END;
     END; 
@@ -581,7 +574,7 @@ MODULE ClassUtil;
       VAR ps : L.CharOpen;
           ch : CHAR;
     BEGIN
-      ps := BOX(CSt.binDir);
+      ps := BOX(CSt.binDir$);
       ch := ps[LEN(ps) - 2];
       IF (ch # "/") & (ch # "\") THEN
         ps := BOX(ps^ + genSep + fn);
@@ -595,7 +588,7 @@ MODULE ClassUtil;
     IF CSt.binDir # "" THEN
       ptr := GetFullPath(fileName);
     ELSE
-      ptr := BOX(fileName);
+      ptr := BOX(fileName$);
     END;
     Warp(ptr);
 (*
@@ -606,7 +599,7 @@ MODULE ClassUtil;
  *
  *  f.file := GPBinFiles.createPath(fileName);
  *)
-    srcFileName := BOX(CSt.srcNam); 
+    srcFileName := BOX(CSt.srcNam$); 
     NEW(fil);
     fil.file := GPBinFiles.createPath(ptr);
 
@@ -2117,14 +2110,19 @@ MODULE ClassUtil;
     END Expand;
    (* ================================= *)
   BEGIN
-    NEW(buf, 256);
+    NEW(buf, 128);
     num := 0;
     idx := 0;
-    chr := ORD(u.val[0]);
-    WHILE chr # 0H DO
-      IF num > LEN(buf)-3 THEN Expand(buf) END;
+    FOR idx := 0 TO LEN(u.val) - 2 DO
+      chr := ORD(u.val[idx]);
+      IF num > LEN(buf) - 3 THEN Expand(buf) END;
       IF chr <= 7FH THEN
-        buf[num] := chr; INC(num);
+        IF chr = 0H THEN (* Modified UTF8! *)
+          buf[num] := 0C0H; INC(num);
+          buf[num] := 080H; INC(num);
+        ELSE
+          buf[num] := chr;  INC(num);
+        END;
       ELSIF chr <= 7FFH THEN
         buf[num+1] := 080H + chr MOD 64; chr := chr DIV 64;
         buf[num  ] := 0C0H + chr; INC(num, 2);
@@ -2133,8 +2131,6 @@ MODULE ClassUtil;
         buf[num+1] := 080H + chr MOD 64; chr := chr DIV 64;
         buf[num  ] := 0E0H + chr; INC(num, 3);
       END;
-      INC(idx);
-      chr := ORD(u.val[idx]);
     END;
     F.WriteByte(file,Jvm.const_utf8);
     u2(file,num);

+ 2 - 1
gpcp/ClsToType.cp

@@ -613,7 +613,8 @@ MODULE ClsToType;
           FOR indx := 0 TO (LEN(byts) DIV 2)-1 DO
             chrs[indx] := CHR(byts[indx*2] + byts[indx*2 + 1] * 256);
           END;
-          RETURN Xp.mkStrLt(chrs);
+          (* RETURN Xp.mkStrLt(chrs); *)
+          RETURN Xp.mkStrLenLt(chrs, LEN(chrs) - 1); (* CHECK THIS! *)
       END;
     END conExp;
    (* ------------------------------------ *)

+ 10 - 0
gpcp/CompState.cp

@@ -127,6 +127,16 @@ MODULE CompState;
 (*				Utilities				*)
 (* ==================================================================== *)
 
+    PROCEDURE SetQuiet*(); 
+    BEGIN
+      CPascalErrors.nowarn := TRUE;
+    END SetQuiet;
+    
+    PROCEDURE RestoreQuiet*();
+    BEGIN
+      CPascalErrors.nowarn := ~warning;
+    END RestoreQuiet;
+
     PROCEDURE targetIsNET*() : BOOLEAN;
     BEGIN
       RETURN target = "net";

+ 40 - 2
gpcp/ExprDesc.cp

@@ -320,6 +320,18 @@ MODULE ExprDesc;
     l.value := L.newStrVal(sv); RETURN l;
   END mkStrLt;
 
+(* -------------------------------------------- *)
+
+  PROCEDURE mkStrLenLt*(str : L.CharOpen; len : INTEGER) : LeafX;
+    VAR l : LeafX;
+  BEGIN
+    NEW(l);
+    l.token := S.prevTok;
+    l.SetKind(strLt);
+    l.type := Builtin.strTp;
+    l.value := L.newStrLenVal(str, len); RETURN l;
+  END mkStrLenLt;
+
 (* -------------------------------------------- *)
 
   PROCEDURE tokToStrLt*(pos,len : INTEGER) : LeafX;
@@ -334,6 +346,20 @@ MODULE ExprDesc;
     l.value := L.newBufVal(pos+1,len-2); RETURN l;
   END tokToStrLt;
 
+(* -------------------------------------------- *)
+
+  PROCEDURE translateStrLt*(pos,len : INTEGER) : LeafX;
+  (** Generate a LeafX for this string, stripping off the quote *
+    * characters which surround it in the scanner buffer. *)
+    VAR l : LeafX;
+  BEGIN
+    NEW(l);
+    l.token := S.prevTok;
+    l.SetKind(strLt);
+    l.type := Builtin.strTp;
+    l.value := L.escapedString(pos+2,len-3); RETURN l;
+  END translateStrLt;
+
 (* ============================================================ *)
 (*         UnaryX Constructor methods     *)
 (* ============================================================ *)
@@ -1278,6 +1304,7 @@ MODULE ExprDesc;
           funI : I.PrcId;
           funN : INTEGER;
           argN : INTEGER;
+          errN : INTEGER;
           arg0 : D.Expr;
           arg1 : D.Expr;
           argT : D.Type;
@@ -1395,8 +1422,19 @@ MODULE ExprDesc;
             argT := arg0.type;
             arg0.CheckWriteable();
             WITH argT : T.Vector DO
-              IF ~argT.elemTp.equalType(arg1.type) THEN 
-                D.RepTypesErrTok(230, argT.elemTp, arg1.type, arg1.token);
+              IF ~argT.elemTp.assignCompat(arg1) THEN
+                IF    arg1.type.isOpenArrType() THEN errN := 142;
+                ELSIF arg1.type.isExtnRecType() THEN errN := 143;
+                ELSIF (arg1.type.kind = T.prcTp) &
+                      (arg1.kind = qualId) &
+                      ~arg1.isProcVar() THEN errN := 165;
+                ELSIF argT.elemTp.isCharArrayType() &
+                      arg1.type.isStringType() THEN  errN :=  27;
+                ELSE             errN :=  83;
+                END;
+                IF errN # 83 THEN arg1.ExprError(errN);
+                ELSE D.RepTypesErrTok(83, argT.elemTp, arg1.type, arg1.token);
+                END;
               END;
             ELSE 
               arg0.ExprError(229);

+ 1 - 1
gpcp/GPCPcopyright.cp

@@ -43,7 +43,7 @@ MODULE GPCPcopyright;
      (* VERSION    = "1.3.8 of 18 November 2007"; *)
      (* VERSION    = "1.3.9 of 15 January 2008"; *)
      (* VERSION    = "1.3.10 of 15 November 2010"; *)
-        VERSION    = "1.3.11 of 1 April 2011";
+        VERSION    = "1.3.12 of 17 November 2011"; 
 	verStr*    = " version " + VERSION;
 
   CONST	prefix     = "#gpcp: ";

+ 82 - 43
gpcp/IlasmUtil.cp

@@ -39,7 +39,6 @@ MODULE IlasmUtil;
         winString   = "public static void '.WinMain'($S[]) il managed";
         subSysStr   = "  .subsystem 0x00000002";
         copyHead    = "public void __copy__(";
-        valueType* = "[mscorlib]System.ValueType";
 
    CONST
         putArgStr   = "$S[] [RTS]ProgArgs::argList";
@@ -85,12 +84,12 @@ MODULE IlasmUtil;
         cmma,                           (* ","      *)
         brsz,                           (* "{} etc" *)
         vFld,                           (* "v$"     *)
-        inVd : Lv.CharOpen;       (* "in.v "  *)
+        inVd : Lv.CharOpen;             (* "in.v "  *)
 
   VAR   evtAdd, evtRem : Lv.CharOpen;
         pVarSuffix     : Lv.CharOpen;
         xhrMk          : Lv.CharOpen;
-
+  
   VAR   boxedObj       : Lv.CharOpen;
 
 (* ============================================================ *)
@@ -141,16 +140,6 @@ MODULE IlasmUtil;
   PROCEDURE^ (os : IlasmFile)CodeLb*(code : INTEGER; i2 : Mu.Label);
   PROCEDURE^ (os : IlasmFile)DefLabC*(l : Mu.Label; IN c : ARRAY OF CHAR);
 
-(* ------------------------------------------------------------ *)
-(*
-  PROCEDURE (os : IlasmFile)newProcInfo*(proc : Sy.Scope) : Mu.ProcInfo;
-    VAR p : Mu.ProcInfo;
-  BEGIN
-    NEW(p);
-    Mu.InitProcInfo(p, proc);
-    RETURN p;
-  END newProcInfo;
- *)
 (* ============================================================ *)
 
   PROCEDURE (os : IlasmFile)MkNewProcInfo*(proc : Sy.Scope);
@@ -300,6 +289,24 @@ MODULE IlasmUtil;
     os.CatStr(RTS.eol);
   END CatEOL;
 
+(* ============================================================ *)
+
+  PROCEDURE (os : IlasmFile)WriteHex(int : INTEGER),NEW;
+    VAR ord : INTEGER;
+  BEGIN
+    IF int <= 9 THEN ord := ORD('0') + int ELSE ord := (ORD('A')-10)+int END;
+    os.CatChar(CHR(ord));
+  END WriteHex;
+
+(* ============================================================ *)
+
+  PROCEDURE (os : IlasmFile)WriteHexByte(int : INTEGER),NEW;
+  BEGIN
+    os.WriteHex(int DIV 16);
+    os.WriteHex(int MOD 16);
+    os.CatChar(' ');
+  END WriteHexByte;
+
 (* ============================================================ *)
 
   PROCEDURE (os : IlasmFile)Tstring(IN str : ARRAY OF CHAR),NEW;
@@ -333,38 +340,69 @@ MODULE IlasmUtil;
   END Tlong;
 
 (* ============================================================ *)
-
+  
   PROCEDURE (os : IlasmFile)QuoteStr(IN str : ARRAY OF CHAR),NEW;
-    VAR idx : INTEGER;
-        chr : CHAR;
-        ord : INTEGER;
-  BEGIN
-    idx := 0;
-    chr := str[0];
-    os.CatChar('"');
-    WHILE chr # 0X DO
-      CASE chr OF
-      | "\",'"' : os.CatChar("\");
-                  os.CatChar(chr);
-      | 9X      : os.CatChar("\");
-                  os.CatChar("t");
-      | 0AX     : os.CatChar("\");
-                  os.CatChar("n");
-      ELSE
-        IF chr > 07EX THEN
-          ord := ORD(chr);
-          os.CatChar('\');
-          os.CatChar(CHR(ord DIV 64 + ORD('0')));
-          os.CatChar(CHR(ord MOD 64 DIV 8 + ORD('0')));
-          os.CatChar(CHR(ord MOD 8 + ORD('0')));
+   (* ------------------------ *)
+    PROCEDURE EmitQuotedString(os : IlasmFile; IN str : ARRAY OF CHAR);
+      VAR chr : CHAR;
+          idx : INTEGER;
+          ord : INTEGER;
+    BEGIN
+      os.CatChar('"');
+      FOR idx := 0 TO LEN(str) - 2 DO
+        chr := str[idx];
+        CASE chr OF
+        | "\",'"' : os.CatChar("\");
+                    os.CatChar(chr);
+        | 9X      : os.CatChar("\");
+                    os.CatChar("t");
+        | 0AX     : os.CatChar("\");
+                    os.CatChar("n");
         ELSE
-          os.CatChar(chr);
-        END
+          IF chr > 07EX THEN
+            ord := ORD(chr);
+            os.CatChar('\');
+            os.CatChar(CHR(ord DIV 64 + ORD('0')));
+            os.CatChar(CHR(ord MOD 64 DIV 8 + ORD('0')));
+            os.CatChar(CHR(ord MOD 8 + ORD('0')));
+          ELSE
+            os.CatChar(chr);
+          END
+        END;
+      END;
+      os.CatChar('"');
+    END EmitQuotedString;
+   (* ------------------------ *)
+    PROCEDURE EmitByteArray(os : IlasmFile; IN str : ARRAY OF CHAR);
+      VAR idx : INTEGER;
+          ord : INTEGER;
+    BEGIN
+      os.CatStr("bytearray (");
+      FOR idx := 0 TO LEN(str) - 2 DO
+        ord := ORD(str[idx]);
+        os.WriteHexByte(ord MOD 256);
+        os.WriteHexByte(ord DIV 256);
+      END;
+      os.CatStr(")");
+    END EmitByteArray;
+   (* ------------------------ *)
+    PROCEDURE NotASCIIZ(IN str : ARRAY OF CHAR) : BOOLEAN;
+      VAR idx : INTEGER;
+          ord : INTEGER;
+    BEGIN
+      FOR idx := 0 TO LEN(str) - 2 DO
+        ord := ORD(str[idx]);
+        IF (ord = 0) OR (ord > 0FFH) THEN RETURN TRUE END;
       END;
-      INC(idx);
-      chr := str[idx];
+      RETURN FALSE;
+    END NotASCIIZ;
+   (* ------------------------ *)
+  BEGIN
+    IF NotASCIIZ(str) THEN
+      EmitByteArray(os, str);
+    ELSE
+      EmitQuotedString(os, str);
     END;
-    os.CatChar('"');
   END QuoteStr;
 
 (* ============================================================ *)
@@ -1469,7 +1507,9 @@ MODULE IlasmUtil;
     os.CatEOL();
     os.OpenBrace(4);
     os.Directive(Asm.dot_entrypoint);
-    IF Cs.debug THEN os.LineSpan(Scn.mkSpanT(Cs.thisMod.begTok)) END;
+    IF Cs.debug & ~(Sy.sta IN xAtt) THEN 
+      os.LineSpan(Scn.mkSpanT(Cs.thisMod.begTok));
+    END;
    (*
     *  Save the command-line arguments to the RTS.
     *)
@@ -1954,7 +1994,6 @@ BEGIN
   xhrMk := Lv.strToCharOpen("class [RTS]XHR"); 
   boxedObj := Lv.strToCharOpen("Boxed_"); 
   pVarSuffix := Lv.strToCharOpen(".ctor($O, native int) ");
-
 END IlasmUtil.
 (* ============================================================ *)
 (* ============================================================ *)

+ 16 - 7
gpcp/JavaMaker.cp

@@ -8,6 +8,7 @@ MODULE JavaMaker;
 
   IMPORT 
         GPCPcopyright,
+        ASCII,
         Error,
         Console,
         L := LitValue,
@@ -20,7 +21,7 @@ MODULE JavaMaker;
         GPTextFiles,
         Jvm := JVMcodes,
         J := JavaUtil,
-        JasminAsm,
+        (* JasminAsm, jasmin is no longer used! *)
         ClassUtil,
         JsmnUtil,
         G  := Builtin,
@@ -246,11 +247,14 @@ MODULE JavaMaker;
   PROCEDURE (this : JavaAssembler)Assemble*();
     VAR ix : INTEGER;
   BEGIN
-    FOR ix := 0 TO asmList.tide-1 DO
-      IF CompState.verbose THEN
-        CompState.Message("Assembling " + asmList.a[ix]^);
+    IF asmList.tide > 0 THEN
+      CompState.Message("Jasmin Assmbler no longer supported");
+      CompState.Message("The following jasmin text files were created:");
+      FOR ix := 0 TO asmList.tide-1 DO
+        Console.Write(ASCII.HT); 
+        Console.WriteString(asmList.a[ix]^);
+        Console.WriteLn;
       END;
-      JasminAsm.Assemble(asmList.a[ix]);
     END;
   END Assemble;
 
@@ -491,6 +495,9 @@ MODULE JavaMaker;
   BEGIN
    (*
     *  Create the classFile structure, and open the output file.
+    *  The default for the JVM target is to write a class file
+    *  directly.  The -jasmin option writes a jasmin output file
+    *  but does not call the (now unavailable) assembler.
     *)
     IF CompState.doCode & ~CompState.doJsmn THEN
       WITH this : JavaModEmitter DO
@@ -2280,7 +2287,7 @@ MODULE JavaMaker;
 (*
  *      e.PushValue(argX, argX.type);
  *)
-        e.ValueCopy(argX, argX.type);
+        e.ValueCopy(argX, dstT);
         out.PutVecElement(dstT);
         out.LoadLocal(vRef, NIL);
         out.LoadLocal(tide, G.intTp);
@@ -2416,7 +2423,9 @@ MODULE JavaMaker;
     lhTyp := stat.lhsX.type;
     e.PushHandle(stat.lhsX, lhTyp);
     e.PushValue(stat.rhsX, lhTyp);
-    WITH lhTyp : Ty.Array DO 
+    WITH lhTyp : Ty.Vector DO
+        e.ScalarAssign(stat.lhsX);
+    | lhTyp : Ty.Array DO 
         IF stat.rhsX.kind = Xp.mkStr THEN
           e.outF.CallRTS(J.StrVal, 2, 0);
         ELSIF stat.rhsX.type = G.strTp THEN

+ 1 - 0
gpcp/JavaUtil.cp

@@ -1,4 +1,5 @@
 
+(* ============================================================ *)
 (*  JavaUtil is the module which writes java classs file        *)
 (*  structures  						*)
 (*  Copyright (c) John Gough 1999, 2000.			*)

+ 104 - 7
gpcp/LitValue.cp

@@ -8,7 +8,8 @@
 
 MODULE LitValue;
 
-  IMPORT 
+  IMPORT
+    ASCII, 
 	GPCPcopyright,
 	Console,
 	GPText,
@@ -24,6 +25,8 @@ MODULE LitValue;
 		     a-    : POINTER TO ARRAY OF CharOpen;
 		   END;
 
+    CharVector*  = VECTOR OF CHAR;
+
 (* ============================================================ *)
 
   TYPE
@@ -33,10 +36,14 @@ MODULE LitValue;
 		  str : CharOpen;
 		END;
 
-(* ============================================================ *)
+(* ================================================================= *)
+(*                      FORWARD DECLARATIONS                         *)
+(* ================================================================= *)
   PROCEDURE^ strToCharOpen*(IN str : ARRAY OF CHAR) : CharOpen;
+  PROCEDURE^ arrToCharOpen*(str : CharOpen; len : INTEGER) : CharOpen;
   PROCEDURE^ subStrToCharOpen*(pos,len : INTEGER) : CharOpen;
-(* ============================================================ *)
+  PROCEDURE^ chrVecToCharOpen*(vec : CharVector) : CharOpen;
+(* ================================================================= *)
 
   PROCEDURE  newChrVal*(ch : CHAR) : Value;
     VAR val : Value;
@@ -71,6 +78,15 @@ MODULE LitValue;
     RETURN val;
   END newStrVal;
 
+  PROCEDURE  newStrLenVal*(str : CharOpen; len : INTEGER) : Value;
+    VAR val : Value;
+  BEGIN
+    NEW(val); 
+    val.ord := len;
+    val.str := arrToCharOpen(str, len);
+    RETURN val;
+  END newStrLenVal;
+
   PROCEDURE  newBufVal*(p,l : INTEGER) : Value;
     VAR val : Value;
   BEGIN
@@ -80,6 +96,55 @@ MODULE LitValue;
     RETURN val;
   END newBufVal;
 
+  PROCEDURE  escapedString*(pos,len : INTEGER) : Value;
+    VAR value  : Value;
+	    vector : CharVector;
+		count  : INTEGER;
+		theCh  : CHAR;
+		cdPnt  : INTEGER;
+    (* ----------------------- *)
+    PROCEDURE ReportBadHex(code, offset : INTEGER);
+      VAR tok : CPascalS.Token;
+    BEGIN
+      tok := CPascalS.prevTok;
+	  CPascalS.SemError.Report(code, tok.lin, tok.col + offset);
+    END ReportBadHex;
+    (* ----------------------- *)
+  BEGIN
+    count := 0;
+    NEW(value);
+	NEW(vector, len * 2);
+	WHILE count < len DO
+	  theCh :=  CPascalS.charAt(pos+count); INC(count);
+	  IF theCh = '\' THEN
+	    theCh := CPascalS.charAt(pos+count); INC(count);
+		CASE theCh OF
+		|  '0' : APPEND(vector, 0X);
+		|  '\' : APPEND(vector, '\');
+		|  'a' : APPEND(vector, ASCII.BEL);
+		|  'b' : APPEND(vector, ASCII.BS);
+		|  'f' : APPEND(vector, ASCII.FF);
+		|  'n' : APPEND(vector, ASCII.LF);
+		|  'r' : APPEND(vector, ASCII.CR);
+		|  't' : APPEND(vector, ASCII.HT);
+		|  'v' : APPEND(vector, ASCII.VT);
+		|  'u' : cdPnt := CPascalS.getHex(pos+count, 4);
+		         IF cdPnt < 0 THEN ReportBadHex(-cdPnt, count); cdPnt := 0 END;
+				 APPEND(vector, CHR(cdPnt)); INC(count, 4);
+		|  'x' : cdPnt := CPascalS.getHex(pos+count, 2);
+		         IF cdPnt < 0 THEN ReportBadHex(-cdPnt, count); cdPnt := 0 END;
+		         APPEND(vector, CHR(cdPnt)); INC(count, 2);
+		ELSE APPEND(vector, theCh);
+		END;
+      ELSE
+	    APPEND(vector, theCh);
+	  END;
+    END;
+    value.ord := LEN(vector);
+	value.str := chrVecToCharOpen(vector);
+    RETURN value;
+  END escapedString;
+
 (* ============================================================ *)
 
   PROCEDURE (v : Value)char*() : CHAR,NEW;	(* final method *)
@@ -173,21 +238,38 @@ MODULE LitValue;
     seq.a[seq.tide] := elem; INC(seq.tide);
   END AppendCharOpen;
 
-(* -------------------------------------------- *)
-
+ (* -------------------------------------------- *
+  * This function trims the string asciiz style.
+  * -------------------------------------------- *)
   PROCEDURE strToCharOpen*(IN str : ARRAY OF CHAR) : CharOpen;
     VAR i : INTEGER;
         h : INTEGER;
         p : CharOpen;
   BEGIN
-    h := LEN(str$);
-    NEW(p,h+1);
+    h := LEN(str$); (* Length NOT including NUL *)
+    NEW(p,h+1);     (* Including space for NUL *)
     FOR i := 0 TO h DO
       p[i] := str[i];
     END;
     RETURN p;
   END strToCharOpen;
 
+ (* -------------------------------------------- *
+  * This function uses ALL of the characters 
+  * which may include embedded NUL characters.
+  * -------------------------------------------- *)
+  PROCEDURE arrToCharOpen*(str : CharOpen;
+                           len : INTEGER) : CharOpen;
+    VAR i : INTEGER;
+        p : CharOpen;
+  BEGIN
+    NEW(p,len+1);
+    FOR i := 0 TO len DO
+      p[i] := str[i];
+    END;
+    RETURN p;
+  END arrToCharOpen;
+
 (* -------------------------------------------- *)
 
   PROCEDURE subChOToChO*(str : CharOpen;
@@ -215,6 +297,21 @@ MODULE LitValue;
     RETURN LEN(op);
   END posOf;
 
+(* -------------------------------------------- *)
+
+  PROCEDURE chrVecToCharOpen(vec : CharVector) : CharOpen;
+    VAR i, len : INTEGER;
+	    cOpen  : CharOpen;
+  BEGIN
+    len := LEN(vec);
+    NEW(cOpen,len + 1);
+	FOR i := 0 TO len -1 DO
+	  cOpen[i] := vec[i];
+    END;
+	cOpen[len] := 0X;
+	RETURN cOpen;
+  END chrVecToCharOpen;
+
 (* -------------------------------------------- *)
 
   PROCEDURE subStrToCharOpen*(pos,len : INTEGER) : CharOpen;

+ 5 - 4
gpcp/ModuleHandler.cp

@@ -9,6 +9,7 @@
 MODULE ModuleHandler;
 
 IMPORT  GPCPcopyright,
+        LitValue,
 	FileNames;
 
 CONST
@@ -16,7 +17,7 @@ CONST
 
 TYPE
 
-  ModName* = FileNames.NameString;
+  ModName* = LitValue.CharOpen;
 
   ModInfo* = POINTER TO ModInfoRec;
 
@@ -138,10 +139,10 @@ BEGIN
   found := FALSE; 
   WHILE (node # NIL) & (~found) DO
     parent := node;
-    IF node.module.name = modName THEN
+    IF node.module.name^ = modName^ THEN
       found := TRUE;
       mod := node.module;
-    ELSIF modName < node.module.name THEN
+    ELSIF modName^ < node.module.name^ THEN
       node := node.left;
     ELSE
       node := node.right;
@@ -152,7 +153,7 @@ BEGIN
     NEW(node);
     mod := NewModInfo(modName);
     node.module := mod; 
-    IF modName < parent.module.name THEN
+    IF modName^ < parent.module.name^ THEN
       parent.left := node;
     ELSE
       parent.right := node;

+ 58 - 6
gpcp/MsilMaker.cp

@@ -22,7 +22,9 @@ MODULE MsilMaker;
         GPTextFiles,
         PeUtil,
         IlasmUtil,
+        Nh  := NameHash,
         Scn := CPascalS,
+        Psr := CPascalP,
         CSt := CompState,
         Asm := IlasmCodes,
         Mu  := MsilUtil,
@@ -195,6 +197,34 @@ MODULE MsilMaker;
     CSt.prgArg := blk;
   END Init;
 
+(* ============================================================ *)
+
+   PROCEDURE (this : MsilEmitter)mkThreadAssign() : Sy.Stmt,NEW; 
+     VAR stmt : Sy.Stmt;
+         text : ARRAY 3 OF Lv.CharOpen;
+   BEGIN
+     text[0] := BOX("__thread__ := mscorlib_System_Threading.Thread.init(__wrapper__);");
+     text[1] := BOX("__thread__.set_ApartmentState(mscorlib_System_Threading.ApartmentState.STA);");
+     text[2] := BOX("__thread__.Start(); END");
+     stmt := Psr.parseTextAsStatement(text, CSt.thisMod);
+     stmt.StmtAttr(CSt.thisMod);
+     RETURN stmt;
+   END mkThreadAssign;
+   
+(* ============================================================ *)
+
+   PROCEDURE (this : MsilEmitter)AddStaMembers(),NEW; 
+     VAR text : ARRAY 3 OF Lv.CharOpen;
+         proc : Sy.Idnt;
+   BEGIN
+     text[0] := BOX("VAR __thread__ : mscorlib_System_Threading.Thread;");
+     text[1] := BOX("PROCEDURE __wrapper__(); BEGIN END __wrapper__;");
+     text[2] := BOX("END");
+     Psr.ParseDeclarationText(text, CSt.thisMod);
+     proc := Sy.bindLocal(Nh.enterStr("__wrapper__"), CSt.thisMod);
+     proc(Id.PrcId).body := CSt.thisMod.modBody;
+   END AddStaMembers;
+
 (* ============================================================ *)
 
   PROCEDURE (this : MsilAssembler)Assemble*();
@@ -543,9 +573,17 @@ MODULE MsilMaker;
         recT  : Sy.Type;
         varId : Sy.Idnt;
         cfLive : BOOLEAN; (* Control Flow is (still) live *)
+        threadDummy : Sy.Stmt;
+        threadField : Sy.Idnt;
   BEGIN
     out.MkBodyClass(mod);
 
+    threadDummy := NIL; (* to avoid warning *)
+    IF Sy.sta IN this.mod.xAttr THEN
+      this.AddStaMembers();
+      threadDummy := this.mkThreadAssign(); 
+    END;
+
     out.OpenBrace(2);
     FOR index := 0 TO this.mod.procs.tide-1 DO
      (*
@@ -574,24 +612,29 @@ MODULE MsilMaker;
     *  No constructor for the module "class",
     *  there are never any instances created.
     *)
-    out.MkNewProcInfo(this.mod);
     asmExe := this.mod.main;    (* Boolean flag for assembler *)
     IF asmExe THEN
      (*
       *   Emit '<clinit>' with variable initialization
       *)
       out.Blank();
+      out.MkNewProcInfo(this.mod);
       out.ClinitHead();
       out.InitVars(this.mod);
       out.Code(Asm.opc_ret);
       out.ClinitTail();
       out.Blank();
      (*
-      *   Emit module body as 'CPmain()'
+      *   Emit module body as 'CPmain() or WinMain'
       *)
       out.MkNewProcInfo(this.mod);
       out.MainHead(this.mod.xAttr);
-      this.EmitStat(this.mod.modBody, cfLive);
+      IF Sy.sta IN this.mod.xAttr THEN
+        out.Comment("Real entry point for STA");
+        this.EmitStat(threadDummy, cfLive);
+      ELSE
+        this.EmitStat(this.mod.modBody, cfLive);
+      END;
       IF cfLive THEN
         out.Comment("Continuing directly to CLOSE");
         this.EmitStat(this.mod.modClose, cfLive);
@@ -604,6 +647,7 @@ MODULE MsilMaker;
      (*
       *   Emit single <clinit> incorporating module body
       *)
+      out.MkNewProcInfo(this.mod);
       out.ClinitHead();
       out.InitVars(this.mod);
       this.EmitStat(this.mod.modBody, cfLive);
@@ -702,6 +746,9 @@ MODULE MsilMaker;
     ELSIF Sy.cMain IN this.mod.xAttr THEN
       out.Comment("CPmain entry");
     END;
+    IF Sy.sta IN this.mod.xAttr THEN
+      out.Comment("Single Thread Apartment");
+    END;
 
     IF LEN(this.mod.xName$) # 0 THEN
       out.StartNamespace(this.mod.xName);
@@ -2553,9 +2600,11 @@ MODULE MsilMaker;
         out.GetField(Mu.vecArrFld(vecT, out));
         out.PushLocal(cTmp);
         IF Mu.isRefSurrogate(argX.type) THEN 
-          e.ValueCopy(argX, argX.type);
+          (* e.ValueCopy(argX, argX.type); *)
+          e.ValueCopy(argX, vecT.elemTp);
         ELSE
-          e.PushValue(argX, argX.type);
+          (* e.PushValue(argX, argX.type); *)
+          e.PushValue(argX, vecT.elemTp);
         END;
         e.EraseAndAssign(argX.type, vecT);
        (*
@@ -2710,7 +2759,10 @@ MODULE MsilMaker;
     *  This is a value assign in CP.
     *)
     lhTyp := stat.lhsX.type;
-
+   (* 
+    *  Test if the erased type of the vector element
+    *  has to be reconstructed by a type assertion 
+    *)
     erasd := (stat.lhsX.kind = Xp.index) & 
              (stat.lhsX(Xp.BinaryX).lKid.type IS Ty.Vector);
 

+ 1 - 1
gpcp/MsilUtil.cp

@@ -316,7 +316,7 @@ MODULE MsilUtil;
   PROCEDURE (os : MsilFile)MainHead*(xAtt : SET),NEW,ABSTRACT;
 
   PROCEDURE (os : MsilFile)MainTail*(),NEW,ABSTRACT;
-
+  
 (* ------------------------------------------------------------ *)
 
   PROCEDURE (os : MsilFile)ClinitHead*(),NEW,ABSTRACT;

+ 2 - 0
gpcp/NameHash.cp

@@ -24,6 +24,7 @@ MODULE NameHash;
     entries-  : INTEGER;
     mainBkt*  : INTEGER;
     winMain*  : INTEGER;
+    staBkt*   : INTEGER;
 
 (* ============================================================ *)
   PROCEDURE^ enterStr*(IN str : ARRAY OF CHAR) : INTEGER;
@@ -56,6 +57,7 @@ MODULE NameHash;
     entries := 0;
     mainBkt := enterStr("CPmain");
     winMain := enterStr("WinMain");
+    staBkt  := enterStr("STA");
   END InitNameHash;
 
 (* ============================================================ *)

+ 159 - 102
gpcp/NewSymFileRW.cp

@@ -2,7 +2,7 @@
 (* ==================================================================== *)
 (*									*)
 (*  SymFileRW:  Symbol-file reading and writing for GPCP.		*)
-(*	Copyright (c) John Gough 1999, 2000.				*)
+(*	Copyright (c) John Gough 1999 -- 2011.				*)
 (*									*)
 (* ==================================================================== *)
 
@@ -90,6 +90,12 @@ MODULE NewSymFileRW;
 // and the user of the class _must_ agree on the IR name of the class.
 // The same reasoning applies to procedure types, which must have equal
 // interface names in all modules.
+//
+// Notes on the fine print about UTFstring --- November 2011 clarification.
+// The character sequence in the symbol file is modified UTF-8, that is
+// it may represent CHR(0), U+0000, by the bytes 0xC0, 0x80. String
+// constants may thus contain embedded nulls. 
+// 
 // ======================================================================== *)
 
   CONST
@@ -110,6 +116,7 @@ MODULE NewSymFileRW;
         magic   = 0DEADD0D0H;
         syMag   = 0D0D0DEADH;
         dumped* = -1;
+        buffDefault = 1024;
 
 (* ============================================================ *)
 
@@ -121,6 +128,8 @@ MODULE NewSymFileRW;
         	    iNxt : INTEGER;
         	    oNxt : INTEGER;
         	    work : D.TypeSeq;
+                    (* Recycled scratch area *)
+                    buff : POINTER TO ARRAY OF UBYTE; 
         	  END;
 
   TYPE
@@ -133,8 +142,9 @@ MODULE NewSymFileRW;
         	    iAtt  : INTEGER;
         	    lAtt  : LONGINT;
         	    rAtt  : REAL;
-        	    sAtt  : FileNames.NameString;
                     rScp  : ImpResScope;
+        	    strLen : INTEGER;
+        	    strAtt : Lt.CharOpen;
                     oArray : D.IdSeq;
         	    sArray : D.ScpSeq;		(* These two sequences	*)
   		    tArray : D.TypeSeq;		(* must be private as   *)
@@ -173,6 +183,7 @@ MODULE NewSymFileRW;
     VAR new : SymFile;
   BEGIN
     NEW(new);
+    NEW(new.buff, buffDefault);
    (*
     *  Initialization: cSum starts at zero. Since impOrd of
     *  the module is zero, impOrd of the imports starts at 1.
@@ -197,81 +208,107 @@ MODULE NewSymFileRW;
     BF.WriteByte(f.file, chr);
   END Write;
 
-(* ======================================= *)
-
-  PROCEDURE (f : SymFile)WriteStrUTF(IN nam : ARRAY OF CHAR),NEW;
-    VAR buf : ARRAY 256 OF INTEGER;
-        num : INTEGER;
+ (* ======================================= *
+  *  This method writes a UTF-8 byte sequence that
+  *  represents the input string up to but not
+  *  including the terminating null character.
+  *)
+  PROCEDURE (f : SymFile)WriteNameUTF(IN nam : ARRAY OF CHAR),NEW;
+    VAR num : INTEGER;
         idx : INTEGER;
         chr : INTEGER;
   BEGIN
+    IF LEN(nam) * 3 > LEN(f.buff) THEN 
+      NEW(f.buff, LEN(nam) * 3);
+    END;
+
     num := 0;
     idx := 0;
-    chr := ORD(nam[idx]);
+    chr := ORD(nam[0]);
     WHILE chr # 0H DO
       IF    chr <= 7FH THEN 		(* [0xxxxxxx] *)
-        buf[num] := chr; INC(num);
+        f.buff[num] := USHORT(chr); INC(num);
       ELSIF chr <= 7FFH THEN 		(* [110xxxxx,10xxxxxx] *)
-        buf[num+1] := 080H + chr MOD 64; chr := chr DIV 64;
-        buf[num  ] := 0C0H + chr; INC(num, 2);
+        f.buff[num+1] := USHORT(080H + chr MOD 64); chr := chr DIV 64;
+        f.buff[num  ] := USHORT(0C0H + chr); INC(num, 2);
       ELSE 				(* [1110xxxx,10xxxxxx,10xxxxxxx] *)
-        buf[num+2] := 080H + chr MOD 64; chr := chr DIV 64;
-        buf[num+1] := 080H + chr MOD 64; chr := chr DIV 64;
-        buf[num  ] := 0E0H + chr; INC(num, 3);
+        f.buff[num+2] := USHORT(080H + chr MOD 64); chr := chr DIV 64;
+        f.buff[num+1] := USHORT(080H + chr MOD 64); chr := chr DIV 64;
+        f.buff[num  ] := USHORT(0E0H + chr); INC(num, 3);
       END;
       INC(idx); chr := ORD(nam[idx]);
     END;
     f.Write(num DIV 256);
     f.Write(num MOD 256);
-    FOR idx := 0 TO num-1 DO f.Write(buf[idx]) END;
-  END WriteStrUTF;
+    FOR idx := 0 TO num-1 DO f.Write(f.buff[idx]) END;
+  END WriteNameUTF;
 
-(* ======================================= *)
 
-  PROCEDURE (f : SymFile)WriteOpenUTF(chOp : Lt.CharOpen),NEW;
-    VAR buf : ARRAY 256 OF INTEGER;
-        num : INTEGER;
+ (* ======================================= *
+  *  This method writes a UTF-8 byte sequence that
+  *  represents the input string up to but not
+  *  including the final null character. The 
+  *  string may include embedded null characters.
+  *  Thus if the last meaningfull character is null
+  *  there will be two nulls at the end.
+  *)
+  PROCEDURE (f : SymFile)WriteStringUTF(chOp : Lt.CharOpen),NEW;
+    VAR num : INTEGER;
+        len : INTEGER;
         idx : INTEGER;
         chr : INTEGER;
   BEGIN
+    len := LEN(chOp) - 1; (* Discard "terminating" null *)
+    IF len * 3 > LEN(f.buff) THEN 
+      NEW(f.buff, len * 3);
+    END;
+
     num := 0;
-    idx := 0;
-    chr := ORD(chOp[0]);
-    WHILE chr # 0H DO
-      IF    chr <= 7FH THEN 		(* [0xxxxxxx] *)
-        buf[num] := chr; INC(num);
+    FOR idx := 0 TO len - 1 DO
+      chr := ORD(chOp[idx]);
+      IF chr = 0 THEN         (* [11000000, 10000000] *)
+        f.buff[num+1] := 080H; 
+        f.buff[num  ] := 0C0H; INC(num, 2);
+      ELSIF chr <= 7FH THEN 		(* [0xxxxxxx] *)
+        f.buff[num  ] := USHORT(chr); INC(num);
       ELSIF chr <= 7FFH THEN 		(* [110xxxxx,10xxxxxx] *)
-        buf[num+1] := 080H + chr MOD 64; chr := chr DIV 64;
-        buf[num  ] := 0C0H + chr; INC(num, 2);
+        f.buff[num+1] := USHORT(080H + chr MOD 64); chr := chr DIV 64;
+        f.buff[num  ] := USHORT(0C0H + chr); INC(num, 2);
       ELSE 				(* [1110xxxx,10xxxxxx,10xxxxxxx] *)
-        buf[num+2] := 080H + chr MOD 64; chr := chr DIV 64;
-        buf[num+1] := 080H + chr MOD 64; chr := chr DIV 64;
-        buf[num  ] := 0E0H + chr; INC(num, 3);
+        f.buff[num+2] := USHORT(080H + chr MOD 64); chr := chr DIV 64;
+        f.buff[num+1] := USHORT(080H + chr MOD 64); chr := chr DIV 64;
+        f.buff[num  ] := USHORT(0E0H + chr); INC(num, 3);
       END;
-      INC(idx);
-      chr := ORD(chOp[idx]);
     END;
     f.Write(num DIV 256);
     f.Write(num MOD 256);
-    FOR idx := 0 TO num-1 DO f.Write(buf[idx]) END;
-  END WriteOpenUTF;
+    FOR idx := 0 TO num-1 DO f.Write(f.buff[idx]) END;
+  END WriteStringUTF;
 
 (* ======================================= *)
 
-  PROCEDURE (f : SymFile)WriteString(IN nam : ARRAY OF CHAR),NEW;
+  PROCEDURE (f : SymFile)WriteStringForName(nam : Lt.CharOpen),NEW;
   BEGIN
     f.Write(strSy); 
-    f.WriteStrUTF(nam);
-  END WriteString;
+    f.WriteNameUTF(nam);
+  END WriteStringForName;
 
 (* ======================================= *)
 
-  PROCEDURE (f : SymFile)WriteName(idD : D.Idnt),NEW;
+  PROCEDURE (f : SymFile)WriteStringForLit(str : Lt.CharOpen),NEW;
+  BEGIN
+    f.Write(strSy); 
+    f.WriteStringUTF(str);
+  END WriteStringForLit;
+
+(* ======================================= *)
+
+  PROCEDURE (f : SymFile)WriteNameForId(idD : D.Idnt),NEW;
   BEGIN
     f.Write(namSy); 
     f.Write(idD.vMod); 
-    f.WriteOpenUTF(Nh.charOpenOfHash(idD.hash));
-  END WriteName;
+    f.WriteNameUTF(Nh.charOpenOfHash(idD.hash));
+  END WriteNameForId;
 
 (* ======================================= *)
 
@@ -434,7 +471,7 @@ MODULE NewSymFileRW;
       *   Emit Optional Parameter name 
       *)
       IF ~CSt.legacy & (parI.hash # 0) THEN
-        f.WriteString(Nh.charOpenOfHash(parI.hash));
+        f.WriteStringForName(Nh.charOpenOfHash(parI.hash));
       END;
     END;
     f.Write(endFm);
@@ -454,14 +491,14 @@ MODULE NewSymFileRW;
     conX := id.conExp(ExprDesc.LeafX);
     cVal := conX.value;
     f.Write(conSy);
-    f.WriteName(id);
+    f.WriteNameForId(id);
     CASE conX.kind OF
     | ExprDesc.tBool  : f.Write(truSy);
     | ExprDesc.fBool  : f.Write(falSy);
     | ExprDesc.numLt  : f.WriteNum(cVal.long());
     | ExprDesc.charLt : f.WriteChar(cVal.char());
     | ExprDesc.realLt : f.WriteReal(cVal.real());
-    | ExprDesc.strLt  : f.WriteString(cVal.chOpen());
+    | ExprDesc.strLt  : f.WriteStringForLit(cVal.chOpen());
     | ExprDesc.setLt  : 
         f.Write(setSy); 
         IF cVal # NIL THEN sVal := cVal.int() ELSE sVal := 0 END;
@@ -477,7 +514,7 @@ MODULE NewSymFileRW;
   *)
   BEGIN
     f.Write(typSy);
-    f.WriteName(id);
+    f.WriteNameForId(id);
     f.EmitTypeOrd(id.type);
   END EmitTypeId;
 
@@ -489,7 +526,7 @@ MODULE NewSymFileRW;
   *)
   BEGIN
     f.Write(varSy);
-    f.WriteName(id);
+    f.WriteNameForId(id);
     f.EmitTypeOrd(id.type);
   END EmitVariableId;
 
@@ -502,8 +539,8 @@ MODULE NewSymFileRW;
   BEGIN
     IF D.need IN id.xAttr THEN
       f.Write(impSy);
-      f.WriteName(id);
-      IF id.scopeNm # NIL THEN f.WriteString(id.scopeNm) END;
+      f.WriteNameForId(id);
+      IF id.scopeNm # NIL THEN f.WriteStringForName(id.scopeNm) END; 
       f.Write(keySy);
       f.Write4B(id.modKey);
       id.impOrd := f.iNxt; INC(f.iNxt);
@@ -518,8 +555,8 @@ MODULE NewSymFileRW;
   *)
   BEGIN
     f.Write(prcSy);
-    f.WriteName(id);
-    IF id.prcNm # NIL THEN f.WriteString(id.prcNm) END;
+    f.WriteNameForId(id);
+    IF id.prcNm # NIL THEN f.WriteStringForName(id.prcNm) END; 
     IF id.kind = Id.ctorP THEN f.Write(truSy) END;
     f.FormalType(id.type(Ty.Procedure));
   END EmitProcedureId;
@@ -533,12 +570,12 @@ MODULE NewSymFileRW;
   BEGIN
     IF id.kind = Id.fwdMth THEN id := id.resolve(Id.MthId) END;
     f.Write(mthSy);
-    f.WriteName(id);
+    f.WriteNameForId(id);
     f.Write(ORD(id.mthAtt));
     f.Write(id.rcvFrm.parMod);
     f.EmitTypeOrd(id.rcvFrm.type);
-    IF id.prcNm # NIL THEN f.WriteString(id.prcNm) END;
-    IF ~CSt.legacy & (id.rcvFrm.hash # 0) THEN f.WriteName(id.rcvFrm) END;
+    IF id.prcNm # NIL THEN f.WriteStringForName(id.prcNm) END; 
+    IF ~CSt.legacy & (id.rcvFrm.hash # 0) THEN f.WriteNameForId(id.rcvFrm) END;
     f.FormalType(id.type(Ty.Procedure));
   END EmitMethodId;
 
@@ -630,7 +667,7 @@ MODULE NewSymFileRW;
     IF mod # 0 THEN
       f.Write(fromS);
       f.WriteOrd(mod);
-      f.WriteName(idt);
+      f.WriteNameForId(idt);
     END;
   END EmitTypeHeader;
 
@@ -701,7 +738,7 @@ MODULE NewSymFileRW;
       FOR index := 0 TO t.fields.tide-1 DO
         field := t.fields.a[index];
         IF (field.vMod # D.prvMode) & (field.type # NIL) THEN
-          f.WriteName(field);
+          f.WriteNameForId(field);
           f.EmitTypeOrd(field.type);
         END;
       END;
@@ -863,9 +900,9 @@ MODULE NewSymFileRW;
       END;
       symfile.Write4B(RTS.loInt(marker));
       symfile.Write(modSy);
-      symfile.WriteName(m);
+      symfile.WriteNameForId(m);
       IF m.scopeNm # NIL THEN (* explicit name *)
-        symfile.WriteString(m.scopeNm);
+        symfile.WriteStringForName(m.scopeNm); 
         symfile.Write(falSy);
       END;
      (*
@@ -913,36 +950,50 @@ MODULE NewSymFileRW;
 
 (* ======================================= *)
 
-  PROCEDURE ReadUTF(f : BF.FILE; OUT nam : ARRAY OF CHAR);
+  PROCEDURE (rdr : SymFileReader)ReadUTF(), NEW;
     CONST
         bad = "Bad UTF-8 string";
     VAR num : INTEGER;
         bNm : INTEGER;
+        len : INTEGER;
         idx : INTEGER;
         chr : INTEGER;
+        fil : BF.FILE;
   BEGIN
     num := 0;
-    bNm := read(f) * 256 + read(f);
-    FOR idx := 0 TO bNm-1 DO
-      chr := read(f);
+    fil := rdr.file;
+   (* 
+    *  len is the length in bytes of the UTF8 representation 
+    *)
+    len := read(fil) * 256 + read(fil);  (* max length 65k *)
+   (* 
+    *  Worst case the number of chars will equal byte-number.
+    *)
+    IF LEN(rdr.strAtt) <= len THEN 
+      NEW(rdr.strAtt, len + 1);
+    END;
+
+    idx := 0;
+    WHILE idx < len DO
+      chr := read(fil); INC(idx);
       IF chr <= 07FH THEN		(* [0xxxxxxx] *)
-        nam[num] := CHR(chr); INC(num);
+        rdr.strAtt[num] := CHR(chr); INC(num);
       ELSIF chr DIV 32 = 06H THEN	(* [110xxxxx,10xxxxxx] *)
         bNm := chr MOD 32 * 64;
-        chr := read(f);
+        chr := read(fil); INC(idx);
         IF chr DIV 64 = 02H THEN
-          nam[num] := CHR(bNm + chr MOD 64); INC(num);
+          rdr.strAtt[num] := CHR(bNm + chr MOD 64); INC(num);
         ELSE
           RTS.Throw(bad);
         END;
       ELSIF chr DIV 16 = 0EH THEN	(* [1110xxxx,10xxxxxx,10xxxxxxx] *)
         bNm := chr MOD 16 * 64;
-        chr := read(f);
+        chr := read(fil); INC(idx);
         IF chr DIV 64 = 02H THEN
           bNm := (bNm + chr MOD 64) * 64; 
-          chr := read(f);
+          chr := read(fil); INC(idx);
           IF chr DIV 64 = 02H THEN
-            nam[num] := CHR(bNm + chr MOD 64); INC(num);
+            rdr.strAtt[num] := CHR(bNm + chr MOD 64); INC(num);
           ELSE 
             RTS.Throw(bad);
           END;
@@ -953,7 +1004,8 @@ MODULE NewSymFileRW;
         RTS.Throw(bad);
       END;
     END;
-    nam[num] := 0X;
+    rdr.strAtt[num] := 0X;
+    rdr.strLen := num;
   END ReadUTF;
 
 (* ======================================= *)
@@ -1019,6 +1071,7 @@ MODULE NewSymFileRW;
     D.InitIdSeq(new.oArray, 4);
     D.InitTypeSeq(new.tArray, 8);
     D.InitScpSeq(new.sArray, 8);
+    NEW(new.strAtt, buffDefault);
     RETURN new;
   END newSymFileReader;
 
@@ -1041,9 +1094,9 @@ MODULE NewSymFileRW;
     f.sSym := read(file);
     CASE f.sSym OF
     | namSy : 
-        f.iAtt := read(file); ReadUTF(file, f.sAtt);
+        f.iAtt := read(file); f.ReadUTF();
     | strSy : 
-        ReadUTF(file, f.sAtt);
+        f.ReadUTF();
     | retSy, fromS, tDefS, basSy :
         f.iAtt := readOrd(file);
     | bytSy :
@@ -1095,7 +1148,7 @@ MODULE NewSymFileRW;
     token := scope.token;
     IF token = NIL THEN token := S.prevTok END;
     filNm := Nh.charOpenOfHash(scope.hash);
-
+    
     f.impS := scope;
     D.AppendScope(f.sArray, scope);
     fileName := BOX(filNm^ + ".cps");
@@ -1209,9 +1262,6 @@ MODULE NewSymFileRW;
   BEGIN
     Ty.InsertInRec(id,rec,TRUE,oId,ok);
     IF oId # NIL THEN D.AppendIdnt(sfr.oArray,oId); END;
-(*
-    IF ~ok THEN Report(id,rec.idnt); END;
- *)
     IF ~ok THEN Report(id, rec.name()) END;
   END InsertInRec;
 
@@ -1227,7 +1277,7 @@ MODULE NewSymFileRW;
     | chrSy : expr := ExprDesc.mkCharLt(f.cAtt);
     | fltSy : expr := ExprDesc.mkRealLt(f.rAtt);
     | setSy : expr := ExprDesc.mkSetLt(BITS(f.iAtt));
-    | strSy : expr := ExprDesc.mkStrLt(f.sAtt);		(* implicit f.sAtt^ *)
+    | strSy : expr := ExprDesc.mkStrLenLt(f.strAtt, f.strLen);
     END;
     f.GetSym();						(* read past value  *)
     RETURN expr;
@@ -1287,7 +1337,7 @@ MODULE NewSymFileRW;
       parD.varOrd := indx; 
       parD.type := f.getTypeFromOrd();
      (* Skip over optional parameter name string *)
-      IF f.sSym = strSy THEN (* parD.hash := Nh.enterStr(f.sAtt); *)
+      IF f.sSym = strSy THEN (* parD.hash := Nh.enterStr(f.strAtt); *)
         f.GetSym;
       END;
       Id.AppendParam(rslt.formals, parD);
@@ -1435,11 +1485,23 @@ MODULE NewSymFileRW;
       INCL(rslt.xAttr, D.noCpy);
       f.GetSym();
     END;
-    IF f.impS.scopeNm # NIL THEN rslt.extrnNm := f.impS.scopeNm END;
+   (* 
+    *  Do not override extrnNm values set
+    *  by *Maker.Init for Native* types.
+    *)
+    IF (f.impS.scopeNm # NIL) & (rslt.extrnNm = NIL) THEN
+      rslt.extrnNm := f.impS.scopeNm; 
+    END;
 
     IF f.sSym = basSy THEN
-      rslt.baseTp := f.typeOf(f.iAtt);
-      IF f.iAtt # Ty.anyRec THEN INCL(rslt.xAttr, D.clsTp) END;
+     (* 
+      *  Do not override baseTp values set
+      *  by *Maker.Init for Native* types.
+      *)
+      IF rslt.baseTp = NIL THEN
+        rslt.baseTp := f.typeOf(f.iAtt);
+        IF f.iAtt # Ty.anyRec THEN INCL(rslt.xAttr, D.clsTp) END;
+      END;
       f.GetSym();
     END;
     IF f.sSym = iFcSy THEN
@@ -1454,7 +1516,7 @@ MODULE NewSymFileRW;
     WHILE f.sSym = namSy DO
       fldD := Id.newFldId();
       fldD.SetMode(f.iAtt);
-      fldD.hash := Nh.enterStr(f.sAtt);
+      fldD.hash := Nh.enterStr(f.strAtt);
       fldD.type := f.typeOf(readOrd(f.file));
       fldD.recTyp := rslt;
       f.GetSym();
@@ -1539,7 +1601,7 @@ MODULE NewSymFileRW;
     *)
     newI := Id.newTypId(NIL);
     newI.SetMode(f.iAtt);
-    newI.hash := Nh.enterStr(f.sAtt);
+    newI.hash := Nh.enterStr(f.strAtt);
     newI.type := f.getTypeFromOrd(); 
     newI.dfScp := f.impS;
     oldI := testInsert(newI, f.impS);
@@ -1566,7 +1628,7 @@ MODULE NewSymFileRW;
 
     INCL(impD.xAttr, D.weak);
     impD.SetMode(f.iAtt);
-    impD.hash := Nh.enterStr(f.sAtt);
+    impD.hash := Nh.enterStr(f.strAtt);
     f.ReadPast(namSy); 
     IF impD.hash = f.modS.hash THEN	(* Importing own imp indirectly	*)
         				(* Shouldn't this be an error?  *)
@@ -1578,7 +1640,7 @@ MODULE NewSymFileRW;
     ELSE				(* Importing some other module.	*)
       oldD := testInsert(impD, f.modS);
       IF f.sSym = strSy THEN 
-        impD.scopeNm := Lt.strToCharOpen(f.sAtt);
+        impD.scopeNm := Lt.arrToCharOpen(f.strAtt, f.strLen);
         f.GetSym();
       END;
       IF (oldD # impD) & (oldD.kind = Id.impId) THEN
@@ -1600,14 +1662,15 @@ MODULE NewSymFileRW;
 (* ============================================ *)
 
   PROCEDURE (f : SymFileReader)constant() : Id.ConId,NEW;
-  (* Constant   = conSy Name Literal.		*)
+  (* Constant = conSy Name Literal.		*)
+  (* Name     = namSy byte UTFstring.           *)
   (* Assert: f.sSym = namSy.			*)
     VAR newC : Id.ConId;
         anyI : D.Idnt;
   BEGIN
     newC := Id.newConId();
     newC.SetMode(f.iAtt);
-    newC.hash := Nh.enterStr(f.sAtt);
+    newC.hash := Nh.enterStr(f.strAtt);
     newC.dfScp := f.impS;
     f.ReadPast(namSy);
     newC.conExp := f.getLiteral();
@@ -1624,7 +1687,7 @@ MODULE NewSymFileRW;
   BEGIN
     newV := Id.newVarId();
     newV.SetMode(f.iAtt);
-    newV.hash := Nh.enterStr(f.sAtt);
+    newV.hash := Nh.enterStr(f.strAtt);
     newV.type := f.getTypeFromOrd();
     newV.dfScp := f.impS;
     RETURN newV;
@@ -1641,11 +1704,11 @@ MODULE NewSymFileRW;
     newP := Id.newPrcId();
     newP.setPrcKind(Id.conPrc);
     newP.SetMode(f.iAtt);
-    newP.hash := Nh.enterStr(f.sAtt);
+    newP.hash := Nh.enterStr(f.strAtt);
     newP.dfScp := f.impS;
     f.ReadPast(namSy);
     IF f.sSym = strSy THEN 
-      newP.prcNm := Lt.strToCharOpen(f.sAtt);
+      newP.prcNm := Lt.arrToCharOpen(f.strAtt, f.strLen);
      (* and leave scopeNm = NIL *)
       f.GetSym();
     END;
@@ -1671,8 +1734,9 @@ MODULE NewSymFileRW;
     newM := Id.newMthId();
     newM.SetMode(f.iAtt);
     newM.setPrcKind(Id.conMth);
-    newM.hash := Nh.enterStr(f.sAtt);
+    newM.hash := Nh.enterStr(f.strAtt);
     newM.dfScp := f.impS;
+    IF CSt.verbose THEN newM.SetNameFromHash(newM.hash) END;
     rcvD := Id.newParId();
     rcvD.varOrd := 0;
    (* byte1 is the method attributes  *)
@@ -1684,12 +1748,12 @@ MODULE NewSymFileRW;
     f.GetSym();
     rcvD.parMod := rFrm;
     IF f.sSym = strSy THEN 
-      newM.prcNm := Lt.strToCharOpen(f.sAtt);
+      newM.prcNm := Lt.arrToCharOpen(f.strAtt, f.strLen);
      (* and leave scopeNm = NIL *)
       f.GetSym();
     END;
    (* Skip over optional receiver name string *)
-    IF f.sSym = namSy THEN (* rcvD.hash := Nh.enterString(f.sAtt); *)
+    IF f.sSym = namSy THEN (* rcvD.hash := Nh.enterString(f.strAtt); *)
       f.GetSym();
     END;
    (* End skip over optional receiver name *)
@@ -1761,7 +1825,7 @@ MODULE NewSymFileRW;
         f.GetSym();
         tpIdnt := Id.newTypId(NIL);
         tpIdnt.SetMode(f.iAtt);
-        tpIdnt.hash := Nh.enterStr(f.sAtt);
+        tpIdnt.hash := Nh.enterStr(f.strAtt);
         tpIdnt.dfScp := impScp;
         tpIdnt := testInsert(tpIdnt, impScp)(Id.TypId);
         f.ReadPast(namSy);
@@ -1913,11 +1977,11 @@ MODULE NewSymFileRW;
     VAR oldS : INTEGER;
   BEGIN
     f.ReadPast(modSy);
-    IF f.sSym = namSy THEN (* do something with f.sAtt *)
-      IF nm # f.sAtt THEN
+    IF f.sSym = namSy THEN (* do something with f.strAtt *)
+      IF nm # f.strAtt^ THEN
         Error.WriteString("Wrong name in symbol file. Expected <");
         Error.WriteString(nm + ">, found <");
-        Error.WriteString(f.sAtt + ">"); 
+        Error.WriteString(f.strAtt^ + ">"); 
         Error.WriteLn;
         HALT(1);
       END;
@@ -1925,7 +1989,7 @@ MODULE NewSymFileRW;
     ELSE RTS.Throw("Bad symfile header");
     END;
     IF f.sSym = strSy THEN (* optional name *)
-      f.impS.scopeNm := Lt.strToCharOpen(f.sAtt);
+      f.impS.scopeNm := Lt.arrToCharOpen(f.strAtt, f.strLen);
       f.GetSym();
       IF f.sSym = falSy THEN 
         INCL(f.impS.xAttr, D.isFn);
@@ -2059,9 +2123,6 @@ MODULE NewSymFileRW;
         blkI : Id.BlkId;
         fScp : ImpResScope;
         rAll : ResolveAll;
-(*
- *  str : RTS.NativeString;
- *)
   BEGIN
    (*
     *  The list of scopes has been constructed by
@@ -2093,10 +2154,6 @@ MODULE NewSymFileRW;
     END;
     FOR indx := 0 TO fScp.work.tide-1 DO
       blkI := fScp.work.a[indx](Id.BlkId);
-(*
- *    str := MKSTR(Nh.charOpenOfHash(blkI.hash)^);
- *    blkI.symTb.Apply(Visitor.newResolver());
- *)
       NEW(rAll);
       blkI.symTb.Apply(rAll);
     END;

+ 6 - 5
gpcp/PeUtil.cp

@@ -858,7 +858,8 @@ MODULE PeUtil;
   PROCEDURE (os : PeFile)PushStr*(IN str : ARRAY OF CHAR);
   (* Use target quoting conventions for the literal string *)
   BEGIN
-    os.pePI.code.ldstr(MKSTR(str));
+    (* os.pePI.code.ldstr(MKSTR(str)); *)
+    os.pePI.code.ldstr(Sys.String.init(BOX(str), 0, LEN(str) - 1));
     os.Adjust(1);
   END PushStr;
 
@@ -1549,7 +1550,7 @@ MODULE PeUtil;
         *)
         NEW(rthA, 1);
         IF rtTpHdl = NIL THEN
-          rtTpHdl := getOrAddClass(corlib, "System", "RuntimeTypeHandle");
+          rtTpHdl := getOrAddValueClass(corlib, "System", "RuntimeTypeHandle");
         END;
         rthA[0] := rtTpHdl;
        (*
@@ -2458,9 +2459,9 @@ MODULE PeUtil;
     IF tTy.tgXtn = NIL THEN Mu.MkTypeName(tTy, os) END;
     IF (tTy IS TypeDesc.Opaque) & (tTy.tgXtn = NIL) THEN os.RescueOpaque(tTy(TypeDesc.Opaque)) END;
     xtn := tTy.tgXtn;
-    IF xtn = NIL THEN 
-      IF tTy.xName # NIL THEN tTy.TypeErrStr(236, tTy.xName); 
-      ELSE tTy.TypeError(236); 
+    IF xtn = NIL THEN
+      IF tTy.xName # NIL THEN tTy.TypeErrStr(236, tTy.xName);
+      ELSE tTy.TypeError(236);
       END;
       RTS.Throw("Opaque Type Error");
     END;

+ 6 - 5
gpcp/PeUtilForNET.cp

@@ -858,7 +858,8 @@ MODULE PeUtil;
   PROCEDURE (os : PeFile)PushStr*(IN str : ARRAY OF CHAR);
   (* Use target quoting conventions for the literal string *)
   BEGIN
-    os.pePI.code.ldstr(MKSTR(str));
+    (* os.pePI.code.ldstr(MKSTR(str)); *)
+    os.pePI.code.ldstr(Sys.String.init(BOX(str), 0, LEN(str) - 1));
     os.Adjust(1);
   END PushStr;
 
@@ -1549,7 +1550,7 @@ MODULE PeUtil;
         *)
         NEW(rthA, 1);
         IF rtTpHdl = NIL THEN
-          rtTpHdl := getOrAddClass(corlib, "System", "RuntimeTypeHandle");
+          rtTpHdl := getOrAddValueClass(corlib, "System", "RuntimeTypeHandle");
         END;
         rthA[0] := rtTpHdl;
        (*
@@ -2458,9 +2459,9 @@ MODULE PeUtil;
     IF tTy.tgXtn = NIL THEN Mu.MkTypeName(tTy, os) END;
     IF (tTy IS TypeDesc.Opaque) & (tTy.tgXtn = NIL) THEN os.RescueOpaque(tTy(TypeDesc.Opaque)) END;
     xtn := tTy.tgXtn;
-    IF xtn = NIL THEN 
-      IF tTy.xName # NIL THEN tTy.TypeErrStr(236, tTy.xName); 
-      ELSE tTy.TypeError(236); 
+    IF xtn = NIL THEN
+      IF tTy.xName # NIL THEN tTy.TypeErrStr(236, tTy.xName);
+      ELSE tTy.TypeError(236);
       END;
       RTS.Throw("Opaque Type Error");
     END;

+ 11 - 1
gpcp/RTS.cp

@@ -21,7 +21,7 @@ SYSTEM MODULE RTS;
 
   TYPE  CharOpen*       = POINTER TO ARRAY OF CHAR;
 
-  TYPE  NativeType*	= POINTER TO ABSTRACT RECORD END;
+  TYPE  NativeType*	   = POINTER TO ABSTRACT RECORD END;
         NativeObject*   = POINTER TO ABSTRACT RECORD END;  
         NativeString*   = POINTER TO RECORD END;
         NativeException*= POINTER TO EXTENSIBLE RECORD END;
@@ -102,6 +102,16 @@ SYSTEM MODULE RTS;
                         OUT ok : BOOLEAN);
   (** Parse array into a short REAL *)
 
+  (* ========================================================== *)
+  (* ============== Operations on Native Strings ============== *)
+  (* ========================================================== *)
+
+  PROCEDURE CharAtIndex*(str : NativeString; idx : INTEGER) : CHAR;
+  (* Get the character at zero-based index idx *)
+
+  PROCEDURE Length*(str : NativeString) : INTEGER;
+  (* Get the length of the native string *)
+
   (* ========================================================== *)
   (* ============== Conversions TO array of char ============== *)
   (* ========================================================== *)

+ 38 - 25
gpcp/SymbolFile.cp

@@ -13,6 +13,7 @@ MODULE SymbolFile;
         Error,
         GPBinFiles,
         FileNames,
+        LitValue,
         CompState,
         MH := ModuleHandler;
 
@@ -105,7 +106,7 @@ MODULE SymbolFile;
     iAtt : INTEGER;
     lAtt : LONGINT;
     rAtt : REAL;
-    sAtt : FileNames.NameString;
+    sAtt : LitValue.CharOpen;
 
 (* ============================================================ *)
 (* ========     Various reading utility procedures      ======= *)
@@ -118,36 +119,46 @@ MODULE SymbolFile;
 
 (* ======================================= *)
 
-  PROCEDURE ReadUTF(OUT nam : ARRAY OF CHAR);
+  PROCEDURE readUTF() : LitValue.CharOpen; 
     CONST
-        bad = "Bad UTF-8 string";
+      bad = "Bad UTF-8 string";
     VAR num : INTEGER;
-        bNm : INTEGER;
-        idx : INTEGER;
-        chr : INTEGER;
+      bNm : INTEGER;
+      len : INTEGER;
+      idx : INTEGER;
+      chr : INTEGER;
+      buff : LitValue.CharOpen;
   BEGIN
     num := 0;
-    bNm := read() * 256 + read();
-    FOR idx := 0 TO bNm-1 DO
-      chr := read();
-      IF chr <= 07FH THEN
-        nam[num] := CHR(chr); INC(num);
-      ELSIF chr DIV 32 = 06H THEN
+   (* 
+    *  bNm is the length in bytes of the UTF8 representation 
+    *)
+    len := read() * 256 + read();  (* max length 65k *)
+   (* 
+    *  Worst case the number of chars will equal byte-number.
+    *)
+    NEW(buff, len + 1); 
+    idx := 0;
+    WHILE idx < len DO
+      chr := read(); INC(idx);
+      IF chr <= 07FH THEN		(* [0xxxxxxx] *)
+        buff[num] := CHR(chr); INC(num);
+      ELSIF chr DIV 32 = 06H THEN	(* [110xxxxx,10xxxxxx] *)
         bNm := chr MOD 32 * 64;
-        chr := read();
+        chr := read(); INC(idx);
         IF chr DIV 64 = 02H THEN
-          nam[num] := CHR(bNm + chr MOD 64); INC(num);
+          buff[num] := CHR(bNm + chr MOD 64); INC(num);
         ELSE
           RTS.Throw(bad);
         END;
-      ELSIF chr DIV 16 = 0EH THEN
+      ELSIF chr DIV 16 = 0EH THEN	(* [1110xxxx,10xxxxxx,10xxxxxxx] *)
         bNm := chr MOD 16 * 64;
-        chr := read();
+        chr := read(); INC(idx);
         IF chr DIV 64 = 02H THEN
           bNm := (bNm + chr MOD 64) * 64; 
-          chr := read();
+          chr := read(); INC(idx);
           IF chr DIV 64 = 02H THEN
-            nam[num] := CHR(bNm + chr MOD 64); INC(num);
+            buff[num] := CHR(bNm + chr MOD 64); INC(num);
           ELSE 
             RTS.Throw(bad);
           END;
@@ -158,8 +169,9 @@ MODULE SymbolFile;
         RTS.Throw(bad);
       END;
     END;
-    nam[num] := 0X;
-  END ReadUTF;
+    buff[num] := 0X;
+    RETURN LitValue.arrToCharOpen(buff, num);
+  END readUTF;
 
 (* ======================================= *)
 
@@ -229,9 +241,10 @@ MODULE SymbolFile;
     sSym := read();
     CASE sSym OF
     | namSy : 
-        iAtt := read(); ReadUTF(sAtt);
+        iAtt := read(); 
+        sAtt := readUTF();
     | strSy : 
-        ReadUTF(sAtt);
+        sAtt := readUTF();
     | retSy, fromS, tDefS, basSy :
         iAtt := readOrd();
     | bytSy :
@@ -413,9 +426,9 @@ MODULE SymbolFile;
     GetSym();
     CheckAndGet(modSy);
     Check(namSy);
-    IF mod.name # sAtt THEN 
-      SymError("Wrong name in symbol file. Expected <" + mod.name + 
-                ">, found <" + sAtt + ">"); 
+    IF mod.name^ # sAtt^ THEN 
+      SymError("Wrong name in symbol file. Expected <" + mod.name^ + 
+                ">, found <" + sAtt^ + ">"); 
       RETURN;
     END;
     GetSym();

+ 20 - 1
gpcp/Symbols.cp

@@ -9,6 +9,7 @@
 MODULE Symbols;
 
   IMPORT
+        RTS,
         GPCPcopyright,
         GPText,
         Console,
@@ -47,7 +48,7 @@ MODULE Symbols;
     rMsk*  = { 8 .. 15};  noNew*  =  8; asgnd* =  9; noCpy* = 10;
                           spshl*  = 11; xCtor* = 12;
     fMsk*  = {16 .. 23};  isFn*   = 16; extFn* = 17; fnInf* = 18;
-    dMsk*  = {24 .. 31};  cMain*  = 24; wMain* = 25;
+    dMsk*  = {24 .. 31};  cMain*  = 24; wMain* = 25; sta*   = 26;
 
 (* ============================================================ *)
 
@@ -64,6 +65,7 @@ MODULE Symbols;
                 vMod-  : INTEGER;   (* visibility tag *)
                 dfScp* : Scope;     (* defining scope *)
                 tgXtn* : ANYPTR;    (* target stuff   *)
+                namStr- : RTS.NativeString;
               END;   (* For fields: record-decl scope *)
 
     IdSeq*  = RECORD
@@ -225,6 +227,16 @@ MODULE Symbols;
   PROCEDURE (t : Stmt)Diagnose*(i : INTEGER),NEW,ABSTRACT;
   PROCEDURE (t : Type)name*() : L.CharOpen,NEW,ABSTRACT;
   
+  PROCEDURE (t : Idnt)SetNameFromString*(nam : L.CharOpen),NEW;
+  BEGIN
+    t.namStr := MKSTR(nam^);
+  END SetNameFromString;
+
+  PROCEDURE (t : Idnt)SetNameFromHash*(hash : INTEGER),NEW;
+  BEGIN
+    t.namStr := MKSTR(NameHash.charOpenOfHash(hash)^);
+  END SetNameFromHash;
+  
 (* ============================================================ *)
 (*             Base Class text-span method                      *)
 (* ============================================================ *)
@@ -1074,6 +1086,13 @@ MODULE Symbols;
     RETURN NameHash.charOpenOfHash(id.hash);
   END ChPtr;
 
+  PROCEDURE (g : NameFetch)NtStr*(id : Idnt) : RTS.NativeString,NEW;
+  BEGIN
+    IF g.ChPtr(id) = NIL THEN RETURN NIL;
+	ELSE RETURN MKSTR(g.ChPtr(id)^);
+	END;
+  END NtStr;
+
 (* ============================================================ *)
 (*  Private methods of the symbol-table info-blocks             *)
 (* ============================================================ *)

+ 1 - 1
gpcp/Target.cp

@@ -26,7 +26,7 @@ MODULE Target;
 (* ============================================================ *)
 
   PROCEDURE Select*(mod : IdDesc.BlkId; 
-		 IN str : ARRAY OF CHAR);
+                 IN str : ARRAY OF CHAR);
   BEGIN
     IF str = "jvm" THEN
       maker := JavaMaker.newJavaEmitter(mod);

+ 1 - 7
gpcp/TypeDesc.cp

@@ -575,7 +575,7 @@ MODULE TypeDesc;
     VAR ext : Record;
         i   : INTEGER;
   BEGIN
-    e := e.boundRecTp();  (* FIXME? kjg *)
+    e := e.boundRecTp(); 
 
     IF (e = NIL) OR (e.kind # recTp) THEN RETURN FALSE;
     ELSIF e = b THEN RETURN TRUE;               (* Trivially! *)
@@ -1639,12 +1639,6 @@ MODULE TypeDesc;
    (* ----------------------------------------- *)
   BEGIN (* resolve *)
     IF i.depth = initialMark THEN
-(*
- *    IF i.idnt # NIL THEN
- *      recId := i.idnt;
- *      nameS := Sy.getName.ChPtr(recId);
- *    END;
- *)
       i.depth := d;
       e145 := FALSE;
       e137 := FALSE;

+ 1 - 0
gpcp/csharp/MsilAsm.cs

@@ -99,6 +99,7 @@ public class MsilAsm {
 	}
 	optNm = optNm + CP_rts.mkStr(opt) + ' ';
 	if (verbose) {
+	    System.Console.WriteLine("#gpcp: Calling " + asm.StartInfo.FileName);
 #if BETA2
 	    asm.StartInfo.CreateNoWindow = false;
 #endif

+ 43 - 0
gpcp/java/MsilAsm.java

@@ -0,0 +1,43 @@
+// (* ========================================================= *)
+// (**	Interface to the ILASM Byte-code assembler.		*)
+// (*	K John Gough, 10th June 1999				*)
+// (*	Modifications:						*)
+// (*		Version for GPCP V0.3 April 2000 (kjg)		*)
+// (* ========================================================= *)
+// (*	The real code is in MsilAsm.cool			*)	
+// (* ========================================================= *)
+//
+//MODULE MsilAsm;
+//
+//  PROCEDURE Init*(); BEGIN END Init;
+//
+//  PROCEDURE Assemble*(IN fil,opt : ARRAY OF CHAR; main : BOOLEAN); 
+//  BEGIN END Assemble;
+//
+//  PROCEDURE DoAsm*(IN fil,opt : ARRAY OF CHAR; 
+//                    main,vbse : BOOLEAN;
+//                     OUT rslt : INTEGER); 
+//  BEGIN END Assemble;
+//
+//END MsilAsm.
+// 
+package CP.MsilAsm;
+
+public class MsilAsm {
+
+    public static void Init() {
+//	if (main == null) 
+//	    main = new jasmin.Main();
+    }
+
+    public static void Assemble(char[] fil, char[] opt, boolean main) {
+    }
+
+    public static int DoAsm(char[] fil, char[] opt, 
+				boolean main, boolean vrbs) {
+//	String fName = CP.CPJ.CPJ.MkStr(fil);
+//	main.assemble(null, fName, false);
+        return 0;
+    }
+
+}

+ 25 - 0
libs/cpascal/JvmMakeAll.bat

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

+ 2 - 0
libs/cpascal/MakeAll.bat

@@ -9,6 +9,7 @@ gpcp /special ProgArgs.cp
 gpcp /special RTS.cp
 gpcp /special StdIn.cp
 gpcp /special WinMain.cp
+gpcp /special STA.cp
 gpcp RealStr.cp
 gpcp StringLib.cp
 Browse /html /sort ASCII.cps
@@ -17,6 +18,7 @@ Browse /html /sort Error.cps
 Browse /html /sort GPFiles.cps
 Browse /html /sort GPBinFiles.cps
 Browse /html /sort GPTextFiles.cps
+Browse /html /sort ProgArgs.cps
 Browse /html /sort RTS.cps
 Browse /html /sort StdIn.cps
 Browse /html /sort RealStr.cps

+ 21 - 0
libs/cpascal/ProgArgs.cp

@@ -0,0 +1,21 @@
+(* 
+ *  Library module for GP Component Pascal.
+ *  This module allows access to the arguments in programs which
+ *  import CPmain.  It is accessible from modules which do NOT
+ *  import CPmain.
+ *
+ *  Original : kjg December 1999
+ *
+ *  This is a dummy module, it exists only to cause the 
+ *  generation of a corresponding symbol file: ProgArgs.cps
+ *  when compiled with the -nocode flag.
+ *)
+SYSTEM MODULE ProgArgs;
+
+  PROCEDURE ArgNumber*() : INTEGER;
+
+  PROCEDURE GetArg*(num : INTEGER; OUT arg : ARRAY OF CHAR); 
+
+  PROCEDURE GetEnvVar*(IN name : ARRAY OF CHAR; OUT valu : ARRAY OF CHAR); 
+
+END ProgArgs.

+ 19 - 2
libs/cpascal/RTS.cp

@@ -20,9 +20,10 @@ SYSTEM MODULE RTS;
       dblPosInfinity-   : REAL;
 
   TYPE  CharOpen*       = POINTER TO ARRAY OF CHAR;
+        CharVector*     = VECTOR OF CHAR;
 
-  TYPE  NativeType*	= POINTER TO ABSTRACT RECORD END;
-        NativeObject*   = POINTER TO ABSTRACT RECORD END;  
+  TYPE  NativeType*     = POINTER TO ABSTRACT RECORD END;
+        NativeObject*   = POINTER TO EXTENSIBLE RECORD END;  
         NativeString*   = POINTER TO RECORD END;
         NativeException*= POINTER TO EXTENSIBLE RECORD END;
 
@@ -102,6 +103,22 @@ SYSTEM MODULE RTS;
                         OUT ok : BOOLEAN);
   (** Parse array into a short REAL *)
 
+  (* ========================================================== *)
+  (* ==============  Operations on Native Types  ============== *)
+  (* ========================================================== *)
+
+  PROCEDURE TypeName*(typ : NativeType) : CharOpen;
+
+  (* ========================================================== *)
+  (* ============== Operations on Native Strings ============== *)
+  (* ========================================================== *)
+
+  PROCEDURE CharAtIndex*(str : NativeString; idx : INTEGER) : CHAR;
+  (* Get the character at zero-based index idx *)
+
+  PROCEDURE Length*(str : NativeString) : INTEGER;
+  (* Get the length of the native string *)
+
   (* ========================================================== *)
   (* ============== Conversions TO array of char ============== *)
   (* ========================================================== *)

+ 15 - 0
libs/cpascal/STA.cp

@@ -0,0 +1,15 @@
+(* 
+ *  Library module for GP Component Pascal.
+ *  This module name is "magic" in the sense that its name is known
+ *  to the compiler. If it is imported, the module will be compiled
+ *  so that its body is named "WinMain" with no arglist. 
+ *
+ *  Original : kjg CPmain November 1998
+ *  Modified : kjg WinMain February 2004
+ *
+ *  This is a dummy module, it exists only to cause the 
+ *  generation of a corresponding symbol file: WinMain.cps
+ *  when compiled with the -special flag.
+ *)
+SYSTEM MODULE STA;
+END STA.

+ 32 - 12
libs/csharp/RTS.cs

@@ -75,6 +75,26 @@ public class RTS
 	    }
 	}
 
+/* ------------------------------------------------------------ */
+//   PROCEDURE TypeName(typ : NativeType) : CharOpen
+//  (* Get the name of the argument type *)
+//
+    public static char[] TypeName(System.Type t) { 
+      return NativeStrings.mkArr(t.FullName);
+    }
+
+/* ------------------------------------------------------------ */
+//   PROCEDURE CharAtIndex(str : NativeString; idx : INTEGER) : CHAR;
+//  (* Get the character at zero-based index idx *)
+//
+    public static char CharAtIndex( string s, int i ) { return s[i]; }
+
+/* ------------------------------------------------------------ */
+//  PROCEDURE Length(str : NativeString) : INTEGER;
+//  (* Get the length of the native string *)
+//
+    public static int Length( string s ) { return s.Length; }
+
 /* ------------------------------------------------------------ */
 // PROCEDURE StrToByte(IN str : ARRAY OF CHAR;
 //                     OUT b  : BYTE;
@@ -614,7 +634,7 @@ public class RTS
 //  PROCEDURE intBitsToShortReal(l : INTEGER) : SHORTREAL;
 //  (** Convert an int into an ieee float with same bit pattern *)
 //
-  	public static float intBitsToShortReal(int l)
+  	public static double intBitsToShortReal(int l)
   	{
 	    byte[] tmp = System.BitConverter.GetBytes(l);
   	    return System.BitConverter.ToSingle(tmp,0);
@@ -733,7 +753,7 @@ public class ProgArgs
 	// PROCEDURE ArgNumber*() : INTEGER
 	public static int ArgNumber()
 	{
-	    if (ProgArgs.argList == null)
+        if (ProgArgs.argList == null)
 		return 0;
 	    else
 		return argList.Length;
@@ -743,19 +763,19 @@ public class ProgArgs
 	// PROCEDURE GetArg*(num : INTEGER; OUT arg : ARRAY OF CHAR) 
 	public static void GetArg(int num, char[] arr)
 	{
-	    int i;
-	    if (argList == null) {
-		arr[0] = '\0';
+      int i;
+	    if (argList == null && num < argList.Length) {
+		    arr[0] = '\0';
 	    } else {
-		for (i = 0; 
-		     i < arr.Length && i < argList[num].Length;
-		     i++) {
 		    System.String str = argList[num];
-		    arr[i] = str[i];
-		}
-		if (i == arr.Length)
+		    for (i = 0; 
+		      i < arr.Length && i < argList[num].Length;
+		      i++) {
+		        arr[i] = str[i];
+		    }
+		    if (i == arr.Length)
 		    i--;
-		arr[i] = '\0';
+		    arr[i] = '\0';
 	    }
 	}
 

+ 180 - 0
libs/java/CPJ.java

@@ -0,0 +1,180 @@
+
+/** This is part of the body of the GPCP runtime support.
+ *
+ *  Written November 1998, John Gough.
+ *
+ *  CPJ and CPJrts contain the runtime helpers, these classes have
+ *  most of the adapters for hooking into the various Java libraries.
+ *  RTS.java has the user-accessible facilities of the runtime. The
+ *  facilities in CPJrts are known to the compiler, but have no
+ *  CP-accessible functions.  
+ *
+ *  There is a swindle involved here, for the bootstrap version
+ *  of the compiler: any functions with OUT scalars will have
+ *  a different signature in the old and new versions.  This 
+ *  module implements both, by overloading the methods.
+ *  There is also the method for simulating an Exec.
+ */
+
+package CP.CPJ;
+
+import java.io.*;
+
+/* ------------------------------------------------------------ */
+/* 		        Support for CPJ.cp			*/
+/* ------------------------------------------------------------ */
+
+class CopyThread extends Thread
+{  //
+   //  This is a crude adapter to connect two streams together.
+   //  One use of this class is to connect the output and input
+   //  threads of an forked-ed process to the standard input and
+   //  output streams of the parent process.
+   //
+    InputStream in;
+    OutputStream out;
+
+    CopyThread(InputStream i, OutputStream o) {
+	in = i; out = o;
+    }
+
+    public void run() {
+	try {
+	    for (int ch = in.read(); ch != -1; ch = in.read()) {
+		out.write(ch);
+	    }
+	} catch(Exception e) {
+	    return;
+	}
+    }
+}
+
+/* ------------------------------------------------------------ */
+
+public final class CPJ
+{
+	
+	public static final String newLn = "\n";
+
+	public static String MkStr(char[] arr)
+	{
+	    for (int i = 0; i < arr.length; i++) {
+		if (arr[i] == '\0')
+		    return new String(arr, 0, i);
+	    }
+	    return null;
+	}
+
+	public static void MkArr(String str, char[] arr)
+	{
+	    if (str == null) {
+		arr[0] = '\0'; return;
+	    }
+	    int    len = str.length();
+	    if (len >= arr.length)
+		len = arr.length - 1;
+	    str.getChars(0, len, arr, 0);
+	    arr[len] = '\0';
+	}
+
+	public static String JCat(String l, String r)
+	{
+	    return l+r;
+	}
+
+	public static String GetProperty(String key)
+	{
+	    return System.getProperty(key);
+	}
+
+        // OBSOLETE 2011 ?
+	/** Java compiler version */
+	public static void StrToReal(String str,
+					double[] o, 	// OUT param
+					boolean[] r)	// OUT param
+	{
+	    try {
+		o[0] = Double.valueOf(str.trim()).doubleValue();
+		r[0] = true;
+	    } catch(Exception e) {
+		r[0] = false;
+	    }
+	}
+
+        // OBSOLETE 2011 ?
+	/** Component Pascal compiler version */
+	public static double StrToReal(String str,
+					boolean[] r)	// OUT param
+	{
+	    try {
+		r[0] = true;
+		return Double.valueOf(str.trim()).doubleValue();
+	    } catch(Exception e) {
+		r[0] = false;
+		return 0.0;
+	    }
+	}
+
+        // OBSOLETE 2011 ?
+	/** Java compiler version */
+	public static void StrToInt(String str,
+					int[] o,	// OUT param
+					boolean[] r)	// OUT param
+	{
+	    try {
+		o[0] = Integer.parseInt(str.trim());
+		r[0] = true;
+	    } catch(Exception e) {
+		r[0] = false;
+	    }
+	}
+
+        // OBSOLETE 2011 ?
+	/** Component Pascal compiler version */
+	public static int StrToInt(String str,
+					boolean[] r)	// OUT param
+	{
+	    try {
+		r[0] = true;
+		return Integer.parseInt(str.trim());
+	    } catch(Exception e) {
+		r[0] = false;
+		return 0;
+	    }
+	}
+
+
+    public static int ExecResult(String[] args)
+    {
+	try {
+	    Process p = Runtime.getRuntime().exec(args);
+	    CopyThread cOut = new CopyThread(p.getInputStream(), System.out);
+	    cOut.start();
+	    CopyThread cErr = new CopyThread(p.getErrorStream(), System.err);
+	    cErr.start();
+	    CopyThread cIn  = new CopyThread(System.in, p.getOutputStream());
+	    cIn.start();
+	    return p.waitFor();
+	} catch(Exception e) {
+	    System.err.println(e.toString());
+	    return 1;
+	}
+    }
+
+/* ------------------------------------------------------------ */
+
+    public static void DiagProperties()
+    {
+	    System.getProperties().list(System.out);
+    }
+
+    public static void DiagClass(Object o)
+    {
+	    System.out.print(o.getClass().getName());
+    }
+}
+
+/* ------------------------------------------------------------ */
+/* ------------------------------------------------------------ */
+/* ------------------------------------------------------------ */
+

+ 289 - 0
libs/java/CPJrts.java

@@ -0,0 +1,289 @@
+
+/** This is the body of the GPCP runtime support.
+ *
+ *  Written November 1998, John Gough.
+ *
+ *
+ *
+ */
+
+package CP.CPJrts;
+import  java.lang.reflect.*;
+
+public class CPJrts
+{
+
+/* ==================================================================== *
+ *		MOD and DIV helpers. With correction factors		*
+ * ==================================================================== */
+
+	public static int CpModI(int lVal, int rVal)
+	{
+           // A correction is required if the signs of
+           // the two operands are different, but the
+           // remainder is non-zero. Inc rem by rVal.
+	    int rslt = lVal % rVal;
+            if ((lVal < 0 != rVal < 0) && (rslt != 0))
+                            rslt += rVal;
+	    return rslt;
+	}
+
+	public static int CpDivI(int lVal, int rVal)
+	{
+           // A correction is required if the signs of
+           // the two operands are different, but the
+           // remainder is non-zero. Dec quo by 1.
+            int rslt = lVal / rVal;
+            int remV = lVal % rVal;
+            if ((lVal < 0 != rVal < 0) && (remV != 0))
+              rslt--;
+	    return rslt;
+	}
+
+	public static long CpModL(long lVal, long rVal)
+	{
+           // A correction is required if the signs of
+           // the two operands are different, but the
+           // remainder is non-zero. Inc rem by rVal.
+	    long rslt = lVal % rVal;
+            if ((lVal < 0 != rVal < 0) && (rslt != 0))
+                            rslt += rVal;
+	    return rslt;
+	}
+
+	public static long CpDivL(long lVal, long rVal)
+	{
+           // A correction is required if the signs of
+           // the two operands are different, but the
+           // remainder is non-zero. Dec quo by 1.
+            long rslt = lVal / rVal;
+            long remV = lVal % rVal;
+            if ((lVal < 0 != rVal < 0) && (remV != 0))
+              rslt--;
+	    return rslt;
+	}
+
+/* ==================================================================== *
+ *		Various string and char-array helpers			*
+ * ==================================================================== */
+
+	public static String CaseMesg(int i)
+	{
+	    String s = "CASE-trap: selector = " + i;
+	    return s;
+	}
+
+/* -------------------------------------------------------------------- */
+
+	public static String WithMesg(Object o)
+	{
+	    String c = o.getClass().getName();
+	    c = c.substring(c.lastIndexOf('.') + 1);
+	    c = "WITH else-trap: type = " + c;
+	    return c;
+	}
+
+/* -------------------------------------------------------------------- */
+
+	public static int ChrArrLength(char[] src)
+	{
+	    int  ix = 0;
+	    char ch;
+	    do {
+		ch = src[ix];
+		ix++;
+	    } while ((ch != '\0') && (ix < src.length));
+	    return ix-1;
+	}
+
+/* -------------------------------------------------------------------- */
+
+	public static int ChrArrLplus1(char[] src)
+	{
+	    int  ix = 0;
+	    char ch;
+	    do {
+		ch = src[ix];
+		ix++;
+	    } while (ch != '\0');
+	    return ix;
+	}
+
+/* -------------------------------------------------------------------- */
+
+	public static char[] JavaStrToChrOpen(String input)
+	{
+	    int    len = input.length();
+	    char[] str = new char[len+1];
+	    input.getChars(0, len, str, 0);
+	    str[len] = '\0';
+	    return str;
+	}
+
+/* -------------------------------------------------------------------- */
+
+	public static void JavaStrToFixChr(char[] out, String in)
+	{
+	    int    len = in.length();
+	    in.getChars(0, len, out, 0);
+	    out[len] = '\0';
+	}
+
+/* -------------------------------------------------------------------- */
+
+	public static String FixChToJavaStr(char[] arr)
+	{
+            // This truncation makes semantics same as .NET version
+            int len = ChrArrLength(arr);
+	    return new String(arr, 0, len);
+	}
+
+/* -------------------------------------------------------------------- */
+
+	public static void ChrArrStrCopy(char[] dst, char[] src)
+	{
+	    int  ix = 0;
+	    char ch;
+	    do {
+		ch = src[ix];
+		dst[ix] = ch;
+		ix++;
+	    } while (ch != '\0');
+	}
+
+/* -------------------------------------------------------------------- */
+
+	public static void ChrArrCheck(char[] src)
+	{
+	    int  ix = 0;
+	    char ch;
+	    do {
+		ch = src[ix];
+		if (ch > 0xFF) throw new Error("SHORT on array error");
+		ix++;
+	    } while (ch != '\0');
+	}
+
+/* -------------------------------------------------------------------- */
+
+        public static int strCmp(char[] l, char[] r)
+	{
+	    for (int ix = 0; ix < l.length && ix < r.length; ix++) {
+		if (l[ix] < r[ix]) return -1;
+		else if (l[ix] > r[ix]) return 1;
+		else if (l[ix] == '\0') return 0;
+	    }
+	    if (l.length < r.length) return -1;
+	    else if (l.length < r.length) return 1;
+	    else return 0;
+	}
+
+/* ==================================================================== *
+ *	             Class reflection helper methods			*
+ * ==================================================================== */
+
+        static final int boolN  =  1;
+        static final int sChrN  =  2; 
+        static final int charN  =  3;
+        static final int byteN  =  4; 
+        static final int sIntN  =  5;  
+        static final int intN   =  6; 
+        static final int lIntN  =  7;
+        static final int sReaN  =  8; 
+        static final int realN  =  9;
+        static final int setN   = 10;
+        static final int anyRec = 11; 
+        static final int anyPtr = 12;
+        static final int strN   = 13; 
+        static final int sStrN  = 14; 
+        static final int uBytN  = 15;
+        static final int metaN  = 16;
+
+        public static Class getClassByName(String name) {
+            try {
+                return Class.forName(name);
+            } catch(Exception e) {
+		System.out.println("CPJrts.getClassByName: " + e.toString());
+                return null;
+            }
+        }
+
+        public static Class getClassByOrd(int ord) {
+            switch (ord) {
+              case boolN:   return Boolean.TYPE;
+              case uBytN:
+              case byteN:
+              case sChrN:   return Byte.TYPE;
+              case charN:   return Character.TYPE;
+              case sIntN:   return Short.TYPE;
+              case setN: 
+              case intN:    return Integer.TYPE;
+              case lIntN:   return Long.TYPE;
+              case sReaN:   return Float.TYPE;
+              case realN:   return Double.TYPE;
+              case anyRec:
+              case anyPtr:  return getClassByName("java.lang.Object");
+              case strN:    return getClassByName("java.lang.String");
+              case sStrN:   return getClassByName("java.lang.String");
+              case metaN:   return getClassByName("java.lang.Class");
+              default:      return null;
+            }
+        }
+
+
+/* ==================================================================== *
+ *		Procedure variable reflection helper method		*
+ * ==================================================================== */
+
+	public static Method getMth(String mod, String prc)
+	{
+	    Class    mCls = null;
+	    Method[] mths = null;
+	    try {
+		mCls = Class.forName(mod);
+		mths = mCls.getDeclaredMethods();
+		for (int i = 0; i < mths.length; i++) {
+		    if (mths[i].getName().equals(prc))
+			return mths[i];
+		}
+		return null;
+	    } catch(Exception e) {
+		System.out.println("CPJrts.getMth: " + e.toString());
+		return null;
+	    }
+	}
+
+/* ==================================================================== *
+ *		String concatenation helper methods			*
+ * ==================================================================== */
+
+	public static String ArrArrToString(char[] l, char[] r)
+	{
+	    int llen = ChrArrLength(l);
+	    int rlen = ChrArrLength(r);
+	    StringBuffer buff = new StringBuffer(llen + rlen);
+	    return buff.append(l,0,llen).append(r,0,rlen).toString();
+	}
+
+	public static String ArrStrToString(char[] l, String r)
+	{
+	    int llen = ChrArrLength(l);
+	    StringBuffer buff = new StringBuffer(3 * llen);
+	    return buff.append(l,0,llen).append(r).toString();
+	}
+
+	public static String StrArrToString(String l, char[] r)
+	{
+	    int rlen = ChrArrLength(r);
+	    StringBuffer buff = new StringBuffer(3 * rlen);
+	    return buff.append(l).append(r,0,rlen).toString();
+	}
+
+	public static String StrStrToString(String l, String r)
+	{
+	    StringBuffer buff = new StringBuffer(l);
+	    return buff.append(r).toString();
+	}
+
+}
+

+ 39 - 0
libs/java/CPmain.java

@@ -0,0 +1,39 @@
+//
+// Body of CPmain interface.
+// This file implements the code of the CPmain.cp file.
+// kjg November 1998.
+
+package CP.CPmain;
+
+public class CPmain
+{
+/*
+ *  Now empty. Methods have moved to ProgArgs.
+ */
+	public static String[] args;
+
+	public static void PutArgs(String[] a)
+	// This method is known to the CPascal compiler, but is
+	// unknown to CPascal source programs. An initialization
+	// call to this method is the first thing in the synthetic
+	// main method of any module which imports CPmain.
+	{
+	    args = a;
+	}
+
+	public static int ArgNumber()
+	{
+	    return args.length;
+	}
+
+	public static void GetArg(int num, char[] str)
+	{
+	    int i;
+	    for (i = 0; i < str.length && i < args[num].length(); i++) {
+		str[i] = args[num].charAt(i);
+	    }
+	    if (i == str.length)
+		i--;
+	    str[i] = '\0';
+	}
+} // end of public class CPmain

+ 105 - 0
libs/java/Console.java

@@ -0,0 +1,105 @@
+//
+// Body of Console interface.
+// This file implements the code of the Console.cp file.
+// kjg November 1998.
+
+package CP.Console;
+
+public class Console
+{
+	public static void WriteLn()
+	{
+	    System.out.println();
+	}
+
+	public static void Write(char ch)
+	{
+	    System.out.print(ch);
+	}
+
+	private static char[] strRep(int val)
+	{
+	    if (val < 0) { // ==> must be minInt
+		char[] min = {' ',' ','2','1','4','7','4','8','3','6','4','8'};
+		return min;
+	    }
+
+	    char[] str = {' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '};
+	    str[11] = (char) (val % 10 + (int) '0'); val = val / 10;
+	    for (int i = 10; val != 0; i--) {
+		str[i] = (char) (val % 10 + (int) '0'); val = val / 10;
+	    }
+	    return str;
+	}
+
+	public static void WriteInt(int val, int fwd)
+	{
+	    char[] str = (val >= 0 ? strRep(val) : strRep(-val));
+
+	    int blank;
+	    for (blank = 0; str[blank] == ' '; blank++)
+		;
+	    if (val < 0) {
+		str[blank-1] = '-'; blank--;
+	    }
+	    // format ...
+	    // 01...............901
+	    // _________xxxxxxxxxxx
+	    // <-blank->< 12-blank>
+	    //     <-----fwd------>
+	    if (fwd == 0) // magic case, put out exactly one blank
+		System.out.print(new String(str, blank-1, 13-blank));
+	    else if (fwd < (12-blank))
+		System.out.print(new String(str, blank, 12-blank));
+	    else if (fwd <= 12)
+		System.out.print(new String(str, 12-fwd, fwd));
+	    else { // fwd > 12
+		for (int i = fwd-12; i > 0; i--)
+		    System.out.print(" ");
+		System.out.print(new String(str));
+	    }
+	}
+
+	public static void WriteHex(int val, int wid)
+	{
+	    char[] str = new char[9];
+	    String jls;
+	    int j;		// index of last blank
+	    int i = 8;
+	    do {
+		int dig = val & 0xF;
+		val = val >>> 4;
+		if (dig >= 10)
+		    str[i] = (char) (dig + ((int) 'A' - 10));
+		else
+		    str[i] = (char) (dig + (int) '0');
+		i--;
+	    } while (val != 0);
+	    j = i;
+	    while (i >= 0) {
+		str[i] = ' '; i--;
+	    }
+	    if (wid == 0)	// special case, exactly one blank
+		jls = new String(str, j, 9-j);
+	    else if (wid < (8-j))
+		jls = new String(str, j+1, 8-j);
+	    else if (wid <= 9)
+		jls = new String(str, 9-wid, wid);
+	    else {
+		for (i = wid-9; i > 0; i--)
+			System.out.print(" ");
+		jls = new String(str);
+	    }
+	    System.out.print(jls);
+	}
+
+
+	public static void WriteString(char[] str)
+	{
+	   int len = str.length;
+	   for (int i = 0; i < len && str[i] != '\0'; i++)
+		System.out.print(str[i]);
+	}
+
+
+} // end of public class Console

+ 105 - 0
libs/java/Error.java

@@ -0,0 +1,105 @@
+//
+// Body of Error interface.
+// This file implements the code of the Error.cp file.
+// kjg November 1999.
+
+package CP.Error;
+
+public class Error
+{
+	public static void WriteLn()
+	{
+	    System.err.println();
+	}
+
+	public static void Write(char ch)
+	{
+	    System.err.print(ch);
+	}
+
+	private static char[] strRep(int val)
+	{
+	    if (val < 0) { // ==> must be minInt
+		char[] min = {' ',' ','2','1','4','7','4','8','3','6','4','8'};
+		return min;
+	    }
+
+	    char[] str = {' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '};
+	    str[11] = (char) (val % 10 + (int) '0'); val = val / 10;
+	    for (int i = 10; val != 0; i--) {
+		str[i] = (char) (val % 10 + (int) '0'); val = val / 10;
+	    }
+	    return str;
+	}
+
+	public static void WriteInt(int val, int fwd)
+	{
+	    char[] str = (val >= 0 ? strRep(val) : strRep(-val));
+
+	    int blank;
+	    for (blank = 0; str[blank] == ' '; blank++)
+		;
+	    if (val < 0) {
+		str[blank-1] = '-'; blank--;
+	    }
+	    // format ...
+	    // 01...............901
+	    // _________xxxxxxxxxxx
+	    // <-blank->< 12-blank>
+	    //     <-----fwd------>
+	    if (fwd == 0) // magic case, put out exactly one blank
+		System.err.print(new String(str, blank-1, 13-blank));
+	    else if (fwd < (12-blank))
+		System.err.print(new String(str, blank, 12-blank));
+	    else if (fwd <= 12)
+		System.err.print(new String(str, 12-fwd, fwd));
+	    else { // fwd > 12
+		for (int i = fwd-12; i > 0; i--)
+		    System.err.print(" ");
+		System.err.print(new String(str));
+	    }
+	}
+
+	public static void WriteHex(int val, int wid)
+	{
+	    char[] str = new char[9];
+	    String jls;
+	    int j;		// index of last blank
+	    int i = 8;
+	    do {
+		int dig = val & 0xF;
+		val = val >>> 4;
+		if (dig >= 10)
+		    str[i] = (char) (dig + ((int) 'A' - 10));
+		else
+		    str[i] = (char) (dig + (int) '0');
+		i--;
+	    } while (val != 0);
+	    j = i;
+	    while (i >= 0) {
+		str[i] = ' '; i--;
+	    }
+	    if (wid == 0)	// special case, exactly one blank
+		jls = new String(str, j, 9-j);
+	    else if (wid < (8-j))
+		jls = new String(str, j+1, 8-j);
+	    else if (wid <= 9)
+		jls = new String(str, 9-wid, wid);
+	    else {
+		for (i = wid-9; i > 0; i--)
+			System.err.print(" ");
+		jls = new String(str);
+	    }
+	    System.err.print(jls);
+	}
+
+
+	public static void WriteString(char[] str)
+	{
+	   int len = str.length;
+	   for (int i = 0; i < len && str[i] != '\0'; i++)
+		System.err.print(str[i]);
+	}
+
+
+} // end of public class Console

+ 149 - 0
libs/java/GPBinFiles.java

@@ -0,0 +1,149 @@
+//
+// Body of GPFiles interface.
+// This file implements the code of the GPFiles.cp file.
+// dwc August 1999.
+
+
+package CP.GPBinFiles;
+
+import java.io.*;
+import CP.CPJ.CPJ;
+import CP.GPFiles.GPFiles.*;
+
+public class GPBinFiles {
+
+  public static int length(GPBinFiles_FILE cpf) {
+    return (int) cpf.length;
+  }
+
+  public static GPBinFiles_FILE findLocal(char[] fileName) 
+                                                  throws IOException {
+    String currDir = System.getProperty("user.dir");
+    GPBinFiles_FILE cpf = new GPBinFiles_FILE();
+    cpf.f = new File(currDir, CP.CPJ.CPJ.MkStr(fileName));
+    if (!cpf.f.exists()) {
+      return null; 
+    } else {
+      cpf.rf = new RandomAccessFile(cpf.f,"r");
+      cpf.length = cpf.rf.length();
+      return cpf;
+    }
+  }
+                               
+  public static GPBinFiles_FILE findOnPath(char[] pathName, 
+                                   char[] fileName) throws IOException { 
+    //
+    // Use MkStr, to trim space from end of char arrray.
+    //
+    String pName = CP.CPJ.CPJ.MkStr(pathName);
+    String fName = CP.CPJ.CPJ.MkStr(fileName);
+
+    String nextDir;
+    String thisPath = System.getProperty(pName);
+    GPBinFiles_FILE cpf = new GPBinFiles_FILE();
+    boolean found = false; 
+    boolean pathFinished = false;
+    int length = thisPath.length();
+    int nextPathStart = -1, nextPathEnd = -1;
+
+    while (!found && !pathFinished) {
+      nextPathStart = nextPathEnd + 1;
+      nextPathEnd = thisPath.indexOf(CP.GPFiles.GPFiles.pathSep,nextPathStart);
+      if (nextPathEnd < 0)
+	  nextPathEnd = length;
+      nextDir = thisPath.substring(nextPathStart,nextPathEnd);
+      cpf.f = new File(nextDir,fName);
+      found = cpf.f.exists();
+      pathFinished = nextPathEnd >= length; 
+    } 
+    if (found) {
+      cpf.rf = new RandomAccessFile(cpf.f,"r");
+      cpf.length = cpf.rf.length();
+      return cpf;
+    } else {
+      return null;
+    }
+  }
+    
+  public static char[] getFullPathName(GPBinFiles_FILE cpf) {
+    return cpf.f.getPath().toCharArray();
+  }
+
+  public static GPBinFiles_FILE openFile(char[] fileName)throws IOException{
+    GPBinFiles_FILE cpf = new GPBinFiles_FILE();
+    cpf.f = new File(CP.CPJ.CPJ.MkStr(fileName));
+    if (!cpf.f.exists()) {
+      return null;
+    } else {
+      cpf.rf = new RandomAccessFile(cpf.f,"rw");
+      cpf.length = cpf.rf.length();
+      return cpf;
+    }
+  }
+
+  public static GPBinFiles_FILE openFileRO(char[] fileName)throws IOException{
+    GPBinFiles_FILE cpf = new GPBinFiles_FILE();
+    cpf.f = new File(CP.CPJ.CPJ.MkStr(fileName));
+    if (!cpf.f.exists()) {
+      return null;
+    } else {
+      cpf.rf = new RandomAccessFile(cpf.f,"r");
+      cpf.length = cpf.rf.length();
+      return cpf;
+    }
+  }
+
+  public static void CloseFile(GPBinFiles_FILE cpf) throws IOException {
+    cpf.rf.close(); 
+  }
+
+  public static GPBinFiles_FILE createFile(char[] fileName)throws IOException {
+    GPBinFiles_FILE cpf = new GPBinFiles_FILE();
+    cpf.f = new File(CP.CPJ.CPJ.MkStr(fileName));
+    cpf.rf = new RandomAccessFile(cpf.f,"rw");
+    cpf.rf.setLength(0);
+    cpf.length = 0;
+    //  cpf.length = cpf.rf.length();
+    return cpf;
+  } 
+
+  public static GPBinFiles_FILE createPath(char[] fileName)throws IOException {
+    String fName = CP.CPJ.CPJ.MkStr(fileName);
+    int ix = fName.lastIndexOf(File.separatorChar);
+    if (ix > 0) {
+      File path = new File(fName.substring(0,ix));
+      if (!path.exists()) { boolean ok = path.mkdirs(); }
+    } 
+    GPBinFiles_FILE cpf = new GPBinFiles_FILE();
+    cpf.f = new File(fName);
+    cpf.rf = new RandomAccessFile(cpf.f,"rw");
+    cpf.rf.setLength(0);
+    cpf.length = 0;
+    //    cpf.length = cpf.rf.length();
+    return cpf;
+  } 
+
+  public static boolean EOF(GPBinFiles_FILE cpf) throws IOException {
+    return cpf.rf.getFilePointer() >= cpf.length;
+  }
+
+  public static int readByte(GPBinFiles_FILE cpf) throws IOException {
+    return cpf.rf.readUnsignedByte();
+  } 
+
+  public static int readNBytes(GPBinFiles_FILE cpf, byte[] buff, 
+                               int numBytes) throws IOException {
+    return cpf.rf.read(buff,0,numBytes);
+  } 
+
+  public static void WriteByte(GPBinFiles_FILE cpf,int b) throws IOException{
+    cpf.rf.write(b);
+  } 
+
+  public static void WriteNBytes(GPBinFiles_FILE cpf,byte[] buff,
+                                 int numBytes) throws IOException {
+    cpf.rf.write(buff,0,numBytes);
+  } 
+
+  
+}

+ 15 - 0
libs/java/GPBinFiles_FILE.java

@@ -0,0 +1,15 @@
+// File Object for CP
+// dwc August 1999.
+
+
+package CP.GPBinFiles;
+
+import java.io.*;
+import CP.GPFiles.*;
+
+public class GPBinFiles_FILE extends GPFiles_FILE {
+  public RandomAccessFile rf;
+  public long length;
+}
+
+

+ 38 - 0
libs/java/GPFiles.java

@@ -0,0 +1,38 @@
+//
+// Body of GPFiles interface.
+// This file implements the code of the GPFiles.cp file.
+// dwc August 1999.
+
+
+package CP.GPFiles;
+
+import java.io.*;
+
+public class GPFiles {
+
+  public static char pathSep = System.getProperty("path.separator").charAt(0);
+  public static char fileSep = System.getProperty("file.separator").charAt(0);
+  public static char optChar = '-';
+
+  public static boolean isOlder(GPFiles_FILE first, GPFiles_FILE second) {
+    return (first.f.lastModified() < second.f.lastModified());
+  }
+
+  public static void MakeDirectory(char[] dirName) {
+    File path = new File(CP.CPJ.CPJ.MkStr(dirName));
+    if (!path.exists()) {
+      boolean ok = path.mkdirs();
+    }    
+  }
+
+  public static char[] CurrentDirectory() {
+    String curDir = System.getProperty("user.dir");
+    return curDir.toCharArray();
+  }
+  
+  public static boolean exists(char[] dirName) {
+    File path = new File(CP.CPJ.CPJ.MkStr(dirName));
+    return path.exists();
+  }
+  
+}

+ 16 - 0
libs/java/GPFiles_FILE.java

@@ -0,0 +1,16 @@
+// File Object for CP
+// dwc August 1999.
+
+
+package CP.GPFiles;
+
+import java.io.*;
+
+public class GPFiles_FILE {
+
+  public File f;
+
+}
+
+
+

+ 146 - 0
libs/java/GPTextFiles.java

@@ -0,0 +1,146 @@
+//
+// Body of GPTextFiles interface.
+// This file implements the code of the GPTextFiles.cp file.
+// dwc August 1999.
+
+
+package CP.GPTextFiles;
+
+import java.io.*;
+import CP.CPJ.CPJ;
+import CP.GPFiles.GPFiles.*;
+
+public class GPTextFiles {
+
+
+  public static GPTextFiles_FILE findLocal(char[] fileName) 
+                                               throws IOException {
+    String currDir = System.getProperty("user.dir");
+    GPTextFiles_FILE cpf = new GPTextFiles_FILE();
+    cpf.f = new File(currDir, CP.CPJ.CPJ.MkStr(fileName));
+    if (!cpf.f.exists()) {
+      return null;
+    } else {
+      cpf.r = new BufferedReader(new FileReader(cpf.f));
+      return cpf;
+    }
+  }
+                               
+  public static GPTextFiles_FILE findOnPath(char[] pathName, 
+                                 char[] fileName) throws IOException { 
+    //
+    // Use MkStr, to trim space from end of char arrray.
+    //
+    String pName = CP.CPJ.CPJ.MkStr(pathName);
+    String fName = CP.CPJ.CPJ.MkStr(fileName);
+
+    String nextDir;
+    String thisPath = System.getProperty(pName);
+    GPTextFiles_FILE cpf = new GPTextFiles_FILE();
+    boolean found = false; 
+    boolean pathFinished = false;
+    int length = thisPath.length();
+    int nextPathStart = -1, nextPathEnd = -1;
+
+    while (!found && !pathFinished) {
+      nextPathStart = nextPathEnd + 1;
+      nextPathEnd = thisPath.indexOf(CP.GPFiles.GPFiles.pathSep,nextPathStart);
+      if (nextPathEnd < 0)
+	  nextPathEnd = length;
+      nextDir = thisPath.substring(nextPathStart,nextPathEnd);
+      cpf.f = new File(nextDir,fName);
+      found = cpf.f.exists();
+      pathFinished = nextPathEnd >= length; 
+    } 
+    if (found) {
+      cpf.r = new BufferedReader(new FileReader(cpf.f));
+      return cpf;
+    } else {
+      return null;
+    }
+  }
+    
+
+  public static char[] GetFullpathName(GPTextFiles_FILE cpf) {
+    return cpf.f.getPath().toCharArray();
+  }
+
+  public static GPTextFiles_FILE openFile(char[] fileName) 
+                                              throws IOException{
+    GPTextFiles_FILE cpf = new GPTextFiles_FILE();
+    cpf.f = new File(CP.CPJ.CPJ.MkStr(fileName));
+    if (!cpf.f.exists()) {
+      return null;
+    } else {
+      cpf.r = new BufferedReader(new FileReader(cpf.f));
+      return cpf;
+    }
+  }
+
+  public static GPTextFiles_FILE openFileRO(char[] fileName) 
+                                              throws IOException{
+    return openFile(fileName);  // always read only in java?
+  }
+
+  public static void CloseFile(GPTextFiles_FILE cpf) throws IOException {
+    if (cpf.w != null) { cpf.w.flush(); cpf.w.close(); 
+    } else { cpf.r.close(); }
+  }
+
+  public static GPTextFiles_FILE createFile(char[] fileName) 
+  {
+    try {
+	GPTextFiles_FILE cpf = new GPTextFiles_FILE();
+        cpf.f = new File(CP.CPJ.CPJ.MkStr(fileName));
+	cpf.w = new PrintWriter(new FileWriter(cpf.f));
+	return cpf;
+    } catch (IOException e) {
+	return null;
+    }
+  } 
+
+  public static GPTextFiles_FILE createPath(char[] fileName) 
+  {
+    try {
+        String fName = CP.CPJ.CPJ.MkStr(fileName);
+        int ix = fName.lastIndexOf(File.separatorChar);
+        if (ix > 0) {
+          File path = new File(fName.substring(0,ix));
+          if (!path.exists()) { boolean ok = path.mkdirs(); }
+        }
+	GPTextFiles_FILE cpf = new GPTextFiles_FILE();
+        cpf.f = new File(fName);
+	cpf.w = new PrintWriter(new FileWriter(cpf.f));
+	return cpf;
+    } catch (IOException e) {
+	return null;
+    }
+  } 
+
+  public static char readChar(GPTextFiles_FILE cpf) throws IOException {
+    if (cpf.r.ready()) { return (char) cpf.r.read(); }
+    return (char) 0;
+  } 
+
+  public static int readNChars(GPTextFiles_FILE cpf, char[] buff, 
+                               int numChars) throws IOException {
+    return cpf.r.read(buff,0,numChars);
+  } 
+
+  public static void WriteChar(GPTextFiles_FILE cpf,char ch) 
+                                                       throws IOException { 
+    cpf.w.write(ch);
+  } 
+
+  public static void WriteEOL(GPTextFiles_FILE cpf) 
+                     throws IOException {
+    cpf.w.write('\n');
+  } 
+
+  public static void WriteNChars(GPTextFiles_FILE cpf, char[] buff, 
+                     int numChars) throws IOException {
+    cpf.w.write(buff,0,numChars);
+  } 
+
+  
+}

+ 15 - 0
libs/java/GPTextFiles_FILE.java

@@ -0,0 +1,15 @@
+// File Object for CP
+// dwc August 1999.
+
+
+package CP.GPTextFiles;
+
+import java.io.*;
+import CP.GPFiles.*;
+
+public class GPTextFiles_FILE extends GPFiles_FILE {
+  public BufferedReader r;
+  public PrintWriter w;
+}
+
+

+ 26 - 0
libs/java/MakeAll.bat

@@ -0,0 +1,26 @@
+@echo off
+REM this compiles all of the standard java-sourced libraries for GPCP
+javac -d . Console.java
+javac -d . CPJ.java
+javac -d . CPJrts.java
+javac -d . XHR.java
+javac -d . CPmain.java
+javac -d . Error.java
+javac -d . GPFiles_FILE.java
+javac -d . GPFiles.java
+javac -d . GPBinFiles_FILE.java
+javac -d . GPBinFiles.java
+javac -d . GPTextFiles_FILE.java
+javac -d . GPTextFiles.java
+javac -d . ProcType.java
+javac -d . ProgArgs.java
+javac -d . RTS.java
+javac -d . StdIn.java
+javac -d . VecBase.java
+javac -d . VecChr.java
+javac -d . VecI32.java
+javac -d . VecI64.java
+javac -d . VecR32.java
+javac -d . VecR64.java
+javac -d . VecBase.java
+javac -d . VecRef.java

+ 13 - 0
libs/java/ProcType.java

@@ -0,0 +1,13 @@
+//
+// Supertype of all procedure variable classes
+//
+package CP.CPlib;
+
+public abstract class ProcType 
+{
+	public final java.lang.reflect.Method theMethod;
+
+	public ProcType(java.lang.reflect.Method m) {
+		theMethod = m;
+	}
+}

+ 57 - 0
libs/java/ProgArgs.java

@@ -0,0 +1,57 @@
+//
+// Body of ProgArgs interface.
+// This file implements the code of the ProgArgs.cp file.
+// kjg December 1999.
+//
+// The reason that this module is implemented as a Java class is
+// that the name CPmain has special meaning to the compiler, so
+// it must be imported secretly in the implementation.
+//
+
+package CP.ProgArgs;
+import  CP.CPmain.CPmain;
+
+public class ProgArgs
+{
+
+	public static int ArgNumber()
+	{
+	    if (CP.CPmain.CPmain.args == null)
+		return 0;
+	    else
+		return CP.CPmain.CPmain.args.length;
+	}
+
+	public static void GetArg(int num, char[] str)
+	{
+	    int i;
+	    if (CP.CPmain.CPmain.args == null) {
+		str[0] = '\0';
+	    } else {
+		for (i = 0; 
+		     i < str.length && i < CP.CPmain.CPmain.args[num].length();
+		     i++) {
+		    str[i] = CP.CPmain.CPmain.args[num].charAt(i);
+		}
+		if (i == str.length)
+		    i--;
+		str[i] = '\0';
+	    }
+	}
+
+        public static void GetEnvVar(char[] ss, char[] ds) 
+        {
+            String path = CP.CPJ.CPJ.MkStr(ss);
+            String valu = System.getProperty(path);
+            int i;
+            for (i = 0; 
+                 i < valu.length() && i < ds.length;
+                 i++) {
+                ds[i] = valu.charAt(i);
+            }
+            if (i == ds.length)
+                i--;
+            ds[i] = '\0';
+        }
+
+} // end of public class ProgArgs

+ 633 - 0
libs/java/RTS.java

@@ -0,0 +1,633 @@
+
+/** This is part of the body of the GPCP runtime support.
+ *
+ *  Written November 1998, John Gough.
+ *
+ *  CP*rts contains the runtime helpers, this class has 
+ *  adapters for hooking into the various Native libraries.
+ *  These are the user accessible parts of the runtime.  The 
+ *  facilities in CP*rts are known to each code-emitter, but 
+ *  have no CP-accessible functions.  The interface to the 
+ *  user-accessible functions are defined in RTS.cp, and the 
+ *  code is defined in this file.
+ *
+ *  Version of 29 March 2000 (kjg) --
+ *  There is a swindle involved here, for the bootstrap version
+ *  of the compiler: any functions with OUT scalars will have
+ *  a different signature in the old and new versions.  This 
+ *  module implements both, by overloading the methods.
+ *
+ *  Version of October 2011 -- JVM version brought into line
+ *  with the CP definition used by the current .NET version.
+ *  Only the required methods are defined, the bootstrap 
+ *  versions have been removed.
+ */
+
+package CP.RTS;
+
+import java.io.*;
+import CP.CPJ.*;
+import CP.CPJrts.*;
+import java.text.NumberFormat;
+
+/* ------------------------------------------------------------ */
+/* 		        Support for RTS.cp			*/
+/* ------------------------------------------------------------ */
+/*  The text of RTS.cp is interleaved here to associate the     */
+/*  java with the promises of the Component Pascal source.      */
+/* ------------------------------------------------------------ */
+//
+//  SYSTEM MODULE RTS;
+
+public final class RTS
+{
+      /* Some Initializations ... */
+      private static NumberFormat localFormat = NumberFormat.getInstance();
+	
+//  
+//    VAR defaultTarget- : ARRAY 4 OF CHAR;
+//        fltNegInfinity-   : SHORTREAL;
+//        fltPosInfinity-   : SHORTREAL;
+//        dblNegInfinity-   : REAL;
+//        dblPosInfinity-   : REAL;
+
+	public static char[] defaultTarget = {'j','v','m','\0'};
+        public static float fltNegInfinity = Float.NEGATIVE_INFINITY;
+        public static float fltPosInfinity = Float.POSITIVE_INFINITY;
+        public static double dblNegInfinity = Double.NEGATIVE_INFINITY;
+        public static double dblPosInfinity = Double.POSITIVE_INFINITY;
+//  
+//    TYPE  CharOpen*       = POINTER TO ARRAY OF CHAR;
+//  
+//    TYPE  NativeType*	= POINTER TO ABSTRACT RECORD END;
+//          NativeObject*   = POINTER TO ABSTRACT RECORD END;  
+//          NativeString*   = POINTER TO RECORD END;
+//          NativeException*= POINTER TO EXTENSIBLE RECORD END;
+//  
+//    VAR   eol- : POINTER TO ARRAY OF CHAR; (* OS-specific end of line string *)
+//
+        public static char[] eol = { '\n', '\0' };
+//  
+//    (* ========================================================== *)
+//    (* ============= Support for native exceptions ==============	*)
+//    (* ========================================================== *)
+//    PROCEDURE getStr*(x : NativeException) : CharOpen; 
+
+	public static char[] getStr(java.lang.Exception x) {
+	    String str = x.toString();
+	    return CPJrts.JavaStrToChrOpen(str);
+	}
+
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE Throw*(IN s : ARRAY OF CHAR);
+//    (** Abort execution with an error *)
+
+	public static void Throw(char[] s) throws Exception {
+		throw new Exception(new String(s));
+	}
+
+/* ------------------------------------------------------------ */
+//   PROCEDURE TypeName*(str : NativeType) : CharOpen;
+//  (* Get the character at zero-based index idx *)
+//
+    public static char[] TypeName(java.lang.Class t) {
+      return CPJrts.JavaStrToChrOpen(t.getSimpleName());
+    }
+
+/* ------------------------------------------------------------ */
+//   PROCEDURE CharAtIndex*(str : NativeString; idx : INTEGER) : CHAR;
+//  (* Get the character at zero-based index idx *)
+//
+    public static char CharAtIndex( String s, int i ) { return s.charAt(i); }
+
+/* ------------------------------------------------------------ */
+//  PROCEDURE Length*(str : NativeString) : INTEGER;
+//  (* Get the length of the native string *)
+//
+    public static int Length( String s ) { return s.length(); }
+
+
+
+//  
+//    (* ========================================================== *)
+//    (* ============= Conversions FROM array of char ============= *)
+//    (* ========================================================== *)
+//    PROCEDURE StrToBool*(IN s : ARRAY OF CHAR; OUT b : BOOLEAN; OUT ok : BOOLEAN);
+//    (** Parse array into a BOOLEAN TRUE/FALSE *)
+//
+	public static boolean StrToBool(char[] str,
+				        boolean[] r)	// OUT param
+	{
+	    try {
+		r[0] = true;
+		return Boolean.parseBoolean(CPJ.MkStr(str));
+	    } catch(Exception e) {
+		r[0] = false;
+	        return false;
+	    }
+        }
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE StrToByte*(IN s : ARRAY OF CHAR; OUT b : BYTE; OUT ok : BOOLEAN);
+//    (** Parse array into a BYTE integer (unsigned byte in CP *)
+//
+	public static byte StrToByte(char[] str,
+				     boolean[] r)	// OUT param
+	{
+	    try {
+		r[0] = true;
+                int value = Integer.parseInt(CPJ.MkStr(str));
+                if (value >= -128 && value < 128)
+                    return (byte)value;
+	    } catch(Exception e) {
+	    }
+            r[0] = false;
+	    return 0;
+        }
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE StrToUByte*(IN s : ARRAY OF CHAR; OUT b : BYTE; OUT ok : BOOLEAN);
+//    (** Parse array into a BYTE integer *)
+//
+	public static byte StrToUByte(char[] str,
+				      boolean[] r)	// OUT param
+	{
+	    try {
+		r[0] = true;
+                int value = Integer.parseInt(CPJ.MkStr(str));
+                if (value >= 0 && value < 256)
+                    return (byte)value;
+	    } catch(Exception e) {
+	    }
+            r[0] = false;
+	    return 0;
+        }
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE StrToShort*(IN s : ARRAY OF CHAR; OUT si : SHORTINT; OUT ok : BOOLEAN);
+//    (** Parse an array into a CP SHORTINT *)
+//
+	public static short StrToShort(char[] str,
+				       boolean[] r)	// OUT param
+	{
+	    try {
+		r[0] = true;
+                int value = Integer.parseInt(CPJ.MkStr(str));
+                if (value >= -0x8000 && value < 0x7fff)
+                    return (short)value;
+	    } catch(Exception e) {
+	    }
+            r[0] = false;
+	    return 0;
+        }
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE StrToUShort*(IN s:ARRAY OF CHAR; OUT si:SHORTINT; OUT ok:BOOLEAN);
+//    (** Parse an array into a CP Unsigned SHORTINT *)
+//
+	public static short StrToUShort(char[] str,
+				        boolean[] r)	// OUT param
+	{
+	    try {
+		r[0] = true;
+                int value = Integer.parseInt(CPJ.MkStr(str));
+                if (value > 0 && value < 0xffff)
+                    return (short)value;
+	    } catch(Exception e) {
+	    }
+            r[0] = false;
+	    return 0;
+        }
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE StrToInt*(IN s:ARRAY OF CHAR; OUT i:INTEGER; OUT ok:BOOLEAN);
+//    (** Parse an array into a CP INTEGER *)
+//    (*  Note that first OUT or VAR scalar becomes return value if a pure procedure *)
+//  
+	public static int StrToInt(char[] str,
+				   boolean[] r)	// OUT param
+	{
+	    try {
+		r[0] = true;
+		return Integer.parseInt(CPJ.MkStr(str));
+	    } catch(Exception e) {
+		r[0] = false;
+	        return 0;
+	    }
+	}
+//
+//  --------------------------------------------------------------
+//    PROCEDURE StrToUInt*(IN s:ARRAY OF CHAR; OUT i:INTEGER; OUT ok:BOOLEAN);
+//    (** Parse an array into a CP INTEGER *)
+//
+	public static int StrToUInt(char[] str,
+				    boolean[] r) // OUT param
+	{
+	    try {
+		r[0] = true;
+                long value = Long.parseLong(CPJ.MkStr(str));
+                if (value > 0 && value < 0xffffffff)
+                    return (int)value;
+	    } catch(Exception e) {
+            }
+	    r[0] = false;
+	    return 0;
+	}
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE StrToLong*(IN s:ARRAY OF CHAR; OUT i:LONGINT; OUT ok:BOOLEAN);
+//    (** Parse an array into a CP LONGINT *)
+//
+	public static long StrToLong(char[] str,
+				     boolean[] r) // OUT param
+	{
+	    try {
+		r[0] = true;
+		return Long.parseLong(CPJ.MkStr(str));
+	    } catch(Exception e) {
+		r[0] = false;
+	        return 0;
+	    }
+	}
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE StrToULong*(IN s:ARRAY OF CHAR; OUT i:LONGINT; OUT ok:BOOLEAN);
+//    (** Parse an array into a CP LONGINT *)
+//
+      // Throw method not found exception.
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE HexStrToUByte*(IN s:ARRAY OF CHAR; OUT b:BYTE; OUT ok:BOOLEAN);
+//    (** Parse hexadecimal array into a BYTE integer *)
+//
+	public static byte HexStrToUByte(char[] str,
+				 	 boolean[] r)	// OUT param
+        {
+	    try {
+		r[0] = true;
+		return Byte.decode(CPJ.MkStr(str)).byteValue();
+	    } catch(Exception e) {
+		r[0] = false;
+	        return 0;
+	    }
+        }
+//  
+//  (* ------------------- Low-level String Conversions -------------------- *)
+//  (* 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              *)
+//  (* ------------------- Low-level String Conversions -------------------- *)
+//  
+//    PROCEDURE StrToReal*(IN  s  : ARRAY OF CHAR; 
+//                         OUT r  : REAL; 
+//                         OUT ok : BOOLEAN);
+//    (** Parse array into an ieee double REAL *)
+//
+	public static double StrToReal(char[] str,
+				       boolean[] r) // OUT param
+	{
+	    try {
+		r[0] = true;
+		return Double.valueOf(CPJ.MkStr(str)).doubleValue();
+	    } catch(Exception e) {
+		r[0] = false;
+		return 0.0;
+	    }
+	}
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE StrToRealInvar*(IN  s  : ARRAY OF CHAR; 
+//                              OUT r  : REAL; 
+//                              OUT ok : BOOLEAN);
+//    (** Parse array using invariant culture, into an ieee double REAL *)
+//
+	public static double StrToRealInvar(char[] str,
+				            boolean[] r) // OUT param
+	{
+	    try {
+		r[0] = true;
+		return Double.valueOf(CPJ.MkStr(str)).doubleValue();
+	    } catch(Exception e) {
+		r[0] = false;
+		return 0.0;
+	    }
+	}
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE StrToRealLocal*(IN  s  : ARRAY OF CHAR; 
+//                              OUT r  : REAL; 
+//                              OUT ok : BOOLEAN);
+//    (** Parse array using current locale, into an ieee double REAL *)
+//
+	public static double StrToRealLocal(char[] str,
+					    boolean[] r) // OUT param
+	{
+	    try {
+		r[0] = true;
+		return localFormat.parse(CPJ.MkStr(str)).doubleValue();
+	    } catch(Exception e) {
+		r[0] = false;
+		return 0.0;
+	    }
+	}
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE StrToSReal*(IN  s  : ARRAY OF CHAR; 
+//                          OUT r  : SHORTREAL; 
+//                          OUT ok : BOOLEAN);
+//
+	public static float StrToSReal(char[] str,
+				       boolean[] r) // OUT param
+	{
+	    try {
+		r[0] = true;
+		return Float.valueOf(CPJ.MkStr(str)).floatValue();
+	    } catch(Exception e) {
+		r[0] = false;
+		return 0.0F;
+	    }
+	}
+//
+//  --------------------------------------------------------------
+//    PROCEDURE StrToSRealInvar*(IN  s  : ARRAY OF CHAR; 
+//                               OUT r  : SHORTREAL; 
+//                               OUT ok : BOOLEAN);
+//
+	public static float StrToSRealInvar(char[] str,
+				            boolean[] r) // OUT param
+	{
+	    try {
+		r[0] = true;
+		return Float.valueOf(CPJ.MkStr(str)).floatValue();
+	    } catch(Exception e) {
+		r[0] = false;
+		return 0.0F;
+	    }
+	}
+//
+//  --------------------------------------------------------------
+//    PROCEDURE StrToSRealLocal*(IN  s  : ARRAY OF CHAR; 
+//                          OUT r  : SHORTREAL; 
+//                          OUT ok : BOOLEAN);
+//    (** Parse array into a short REAL *)
+//  
+	public static float StrToSRealLocal(char[] str,
+					     boolean[] r) // OUT param
+	{
+	    try {
+		r[0] = true;
+		return localFormat.parse(CPJ.MkStr(str)).floatValue();
+	    } catch(Exception e) {
+		r[0] = false;
+		return 0.0F;
+	    }
+	}
+//
+//    (* ========================================================== *)
+//    (* ============== Conversions TO array of char ============== *)
+//    (* ========================================================== *)
+//    PROCEDURE RealToStr*(r : REAL; OUT s : ARRAY OF CHAR);
+//    (** Decode a CP REAL into an array *)
+//  
+	public static void RealToStr(double num,
+				     char[] str)
+	{
+	    String jls = String.valueOf(num);
+            int    len = jls.length();
+            if (len >= str.length)
+                len = str.length - 1;
+            jls.getChars(0, len, str, 0);
+            str[len] = '\0';
+	}
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE RealToStrInvar*(r : REAL; OUT s : ARRAY OF CHAR);
+//    (** Decode a CP REAL into an array in invariant culture *)
+//  
+	public static void RealToStrInvar(double num,
+				          char[] str)
+	{
+	    String jls = String.valueOf(num);
+            int    len = jls.length();
+            if (len >= str.length)
+                len = str.length - 1;
+            jls.getChars(0, len, str, 0);
+            str[len] = '\0';
+	}
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE RealToStrLocal*(r : REAL; OUT s : ARRAY OF CHAR);
+//    (** Decode a CP REAL into an array in the current locale *)
+//  
+	public static void RealToStrLocal(double num,
+				          char[] str)
+	{
+	    String jls = localFormat.format(num);
+            int    len = jls.length();
+            if (len >= str.length)
+                len = str.length - 1;
+            jls.getChars(0, len, str, 0);
+            str[len] = '\0';
+	}
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE SRealToStr*(r : SHORTREAL; OUT s : ARRAY OF CHAR);
+//  
+	public static void SRealToStr(float num,
+				      char[] str)
+	{
+	    String jls = Float.toString(num);
+            int    len = jls.length();
+            if (len >= str.length)
+                len = str.length - 1;
+            jls.getChars(0, len, str, 0);
+            str[len] = '\0';
+	}
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE SRealToStrInvar*(r : SHORTREAL; OUT s : ARRAY OF CHAR);
+//  
+	public static void SRealToStrInvar(float num,
+				           char[] str)
+	{
+	    String jls = Float.toString(num);
+            int    len = jls.length();
+            if (len >= str.length)
+                len = str.length - 1;
+            jls.getChars(0, len, str, 0);
+            str[len] = '\0';
+	}
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE SRealToStrLocal*(r : SHORTREAL; OUT s : ARRAY OF CHAR);
+//    (** Decode a CP SHORTREAL into an array *)
+//  
+	public static void SRealToStrLocal(float num,
+				           char[] str)
+	{
+	    String jls = localFormat.format(num);
+            int    len = jls.length();
+            if (len >= str.length)
+                len = str.length - 1;
+            jls.getChars(0, len, str, 0);
+            str[len] = '\0';
+	}
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE IntToStr*(i : INTEGER; OUT s : ARRAY OF CHAR);
+//    (** Decode a CP INTEGER into an array *)
+//  
+	public static void IntToStr(int num,
+				    char[] str)
+	{
+	    String jls = String.valueOf(num);
+            int    len = jls.length();
+            if (len >= str.length)
+                len = str.length - 1;
+            jls.getChars(0, len, str, 0);
+            str[len] = '\0';
+	}
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE ObjToStr*(obj : ANYPTR; OUT s : ARRAY OF CHAR);
+//    (** Decode a CP INTEGER into an array *)
+//  
+        public static void ObjToStr(Object obj, char[] str) {
+            CPJ.MkArr(obj.getClass().getName(), str);
+        }
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE LongToStr*(i : LONGINT; OUT s : ARRAY OF CHAR);
+//    (** Decode a CP INTEGER into an array *)
+//  
+	public static void LongToStr(long num,
+				    char[] str)
+	{
+	    String jls = String.valueOf(num);
+            int    len = jls.length();
+            if (len >= str.length)
+                len = str.length - 1;
+            jls.getChars(0, len, str, 0);
+            str[len] = '\0';
+	}
+//  
+//    (* ========================================================== *)
+//    (* ========== Casts with no representation change =========== *)
+//    (* ========================================================== *)
+//    PROCEDURE realToLongBits*(r : REAL) : LONGINT;
+//    (** Convert an ieee double into a longint with same bit pattern *)
+//
+	public static long realToLongBits(double r) {
+	    return java.lang.Double.doubleToLongBits(r);
+	}
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE longBitsToReal*(l : LONGINT) : REAL;
+//    (** Convert an ieee double into a longint with same bit pattern *)
+//  
+	public static double longBitsToReal(long l) {
+	    return java.lang.Double.longBitsToDouble(l);
+	}
+//
+//  --------------------------------------------------------------
+//    PROCEDURE shortRealToIntBits*(r : SHORTREAL) : INTEGER;
+//    (** Convert an ieee float into an int with same bit pattern *)
+//  
+	public static int shortRealToIntBits(float f) {
+	    return Float.floatToIntBits(f);
+	}
+//
+//  --------------------------------------------------------------
+//    PROCEDURE intBitsToShortReal*(i : INTEGER) : SHORTREAL;
+//    (** Convert an int into an ieee float with same bit pattern *)
+//  
+	public static float intBitsToShortReal(int i) {
+	    return Float.intBitsToFloat(i);
+	}
+//
+//  --------------------------------------------------------------
+//    PROCEDURE hiByte*(i : SHORTINT) : BYTE;
+//    (** Get hi-significant word of short *)
+//  
+	public static byte hiByte(short s) {
+	    return (byte) (s >> 8);
+	}
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE loByte*(i : SHORTINT) : BYTE;
+//    (** Get lo-significant word of short *)
+//  
+	public static byte loByte(short s) {
+	    return (byte) s;
+	}
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE hiShort*(i : INTEGER) : SHORTINT;
+//    (** Get hi-significant word of integer *)
+//  
+	public static short hiShort(int i) {
+	    return (short) (i >> 16);
+	}
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE loShort*(i : INTEGER) : SHORTINT;
+//    (** Get lo-significant word of integer *)
+//  
+	public static short loShort(int i) {
+	    return (short) i;
+	}
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE hiInt*(l : LONGINT) : INTEGER;
+//    (** Get hi-significant word of long integer *)
+//  
+	public static int hiInt(long l) {
+	    return (int) (l >> 32);
+	}
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE loInt*(l : LONGINT) : INTEGER;
+//    (** Get lo-significant word of long integer *)
+//  
+	public static int loInt(long l) {
+	    return (int) l;
+	}
+//  
+//    (* ========================================================== *)
+//    (* ============= Various utility procedures ================= *)
+//    (* ========================================================== *)
+//
+//    PROCEDURE GetMillis*() : LONGINT;
+//    (** Get time in milliseconds *)
+
+	public static long GetMillis() {
+	    return System.currentTimeMillis();
+	}
+//
+//  --------------------------------------------------------------
+//    PROCEDURE GetDateString*(OUT str : ARRAY OF CHAR);
+//    (** Get a date string in some native format *)
+//
+	public static void GetDateString(char[] str) {
+	    String date = new java.util.Date().toString();
+	    int len = date.length();
+	    date.getChars(0, len, str, 0);
+	    str[len] = '\0';
+	}
+//  
+//  --------------------------------------------------------------
+//    PROCEDURE ClassMarker*(o : ANYPTR);
+//    (** Write class name to standard output *)
+//
+	public static void ClassMarker(Object o) {
+	    System.out.print(o.getClass().getName());
+	}
+//  
+//  END RTS.
+  /* ------------------------------------------------------------ */
+  /* ------------------------------------------------------------ */
+  /* ------------------------------------------------------------ */
+}
+

+ 43 - 0
libs/java/StdIn.java

@@ -0,0 +1,43 @@
+//
+// Body of StdIn interface.
+// This file implements the code of the StdIn.cp file.
+// kjg June 2004.
+
+package CP.StdIn;
+
+import java.io.*;
+
+public class StdIn
+{
+        private static BufferedReader rdr = 
+               new BufferedReader(new InputStreamReader(System.in));
+
+	public static void ReadLn(char[] arr) throws IOException {
+            String str = rdr.readLine();
+            if (str == null) {
+                arr[0] = '\0'; return;
+            }
+            int len = arr.length;
+            int sLn = str.length();
+            len = (sLn < len ? sLn : len-1);
+            str.getChars(0, len, arr, 0);
+            arr[len] = '\0';
+        }
+
+        public static char Read() throws IOException 
+	{
+	    return (char)rdr.read();
+	}
+
+        public static boolean More() throws IOException
+	{
+	    return true;         // temporary fix until we figure out
+	 // return rdr.ready();  // how to get the same semantics for
+	}                        // .NET and the JVM (kjg Sep. 2004)
+
+	public static void SkipLn() throws IOException
+	{
+            String str = rdr.readLine(); // and discard str
+	}
+
+} // end of public class StdIn

+ 17 - 0
libs/java/VecBase.java

@@ -0,0 +1,17 @@
+
+/** This is the runtime support for generic vectors.
+ *
+ *  Written August 2004, John Gough.
+ *
+ *
+ *
+ */
+
+package CP.CPJvec;
+
+public abstract class VecBase
+{
+    public int tide;
+    public abstract void expand();
+}
+

+ 25 - 0
libs/java/VecChr.java

@@ -0,0 +1,25 @@
+
+
+/** This is the runtime support for generic vectors.
+ *
+ *  Written August 2004, John Gough.
+ *
+ *
+ *
+ */
+
+package CP.CPJvec;
+
+public class VecChr extends VecBase
+{
+    public char[] elms;
+
+    public void expand() {
+        char[] tmp = new char[this.elms.length * 2];
+        for (int i = 0; i < this.tide; i++) {
+            tmp[i] = this.elms[i];
+        }
+        this.elms = tmp;
+    }
+}
+

+ 24 - 0
libs/java/VecI32.java

@@ -0,0 +1,24 @@
+
+/** This is the runtime support for generic vectors.
+ *
+ *  Written August 2004, John Gough.
+ *
+ *
+ *
+ */
+
+package CP.CPJvec;
+
+public class VecI32 extends VecBase
+{
+    public int[] elms;
+
+    public void expand() {
+        int[] tmp = new int[this.elms.length * 2];
+        for (int i = 0; i < this.tide; i++) {
+            tmp[i] = this.elms[i];
+        }
+        this.elms = tmp;
+    }
+}
+

+ 25 - 0
libs/java/VecI64.java

@@ -0,0 +1,25 @@
+
+
+/** This is the runtime support for generic vectors.
+ *
+ *  Written August 2004, John Gough.
+ *
+ *
+ *
+ */
+
+package CP.CPJvec;
+
+public class VecI64 extends VecBase
+{
+    public long[] elms;
+
+    public void expand() {
+        long[] tmp = new long[this.elms.length * 2];
+        for (int i = 0; i < this.tide; i++) {
+            tmp[i] = this.elms[i];
+        }
+        this.elms = tmp;
+    }
+}
+

+ 25 - 0
libs/java/VecR32.java

@@ -0,0 +1,25 @@
+
+
+/** This is the runtime support for generic vectors.
+ *
+ *  Written August 2004, John Gough.
+ *
+ *
+ *
+ */
+
+package CP.CPJvec;
+
+public class VecR32 extends VecBase
+{
+    public float[] elms;
+
+    public void expand() {
+        float[] tmp = new float[this.elms.length * 2];
+        for (int i = 0; i < this.tide; i++) {
+            tmp[i] = this.elms[i];
+        }
+        this.elms = tmp;
+    }
+}
+

+ 26 - 0
libs/java/VecR64.java

@@ -0,0 +1,26 @@
+
+
+
+/** This is the runtime support for generic vectors.
+ *
+ *  Written August 2004, John Gough.
+ *
+ *
+ *
+ */
+
+package CP.CPJvec;
+
+public class VecR64 extends VecBase
+{
+    public double[] elms;
+
+    public void expand() {
+        double[] tmp = new double[this.elms.length * 2];
+        for (int i = 0; i < this.tide; i++) {
+            tmp[i] = this.elms[i];
+        }
+        this.elms = tmp;
+    }
+}
+

+ 24 - 0
libs/java/VecRef.java

@@ -0,0 +1,24 @@
+
+/** This is the runtime support for generic vectors.
+ *
+ *  Written August 2004, John Gough.
+ *
+ *
+ *
+ */
+
+package CP.CPJvec;
+
+public class VecRef extends VecBase
+{
+    public Object[] elms;
+
+    public void expand() {
+        Object[] tmp = new Object[this.elms.length * 2];
+        for (int i = 0; i < this.tide; i++) {
+            tmp[i] = this.elms[i];
+        }
+        this.elms = tmp;
+    }
+}
+

+ 17 - 0
libs/java/XHR.java

@@ -0,0 +1,17 @@
+
+/** This is an addition to the GPCP runtime support.
+ *
+ *  Written August 2001, John Gough.
+ */
+
+package CP.CPJrts;
+
+/* ==================================================================== *
+ *		Abstract base type for uplevel addressing		*
+ * ==================================================================== */
+public abstract class XHR
+{
+	public XHR prev;
+}
+/* ==================================================================== */
+