gpcp/Browse.cp

   1 MODULE Browse;
   2
   3   IMPORT
   4         RTS,
   5         Console,
   6         Error,
   7         CPmain,
   8         GPFiles,
   9         GPBinFiles,
  10         LitValue,
  11         ProgArgs,
  12         Symbols,
  13         IdDesc,
  14         GPText,
  15         GPTextFiles,
  16         GPCPcopyright,
  17         FileNames;
  18
  19 (* ========================================================================= *
  20 // Collected syntax ---
  21 //
  22 // SymFile    = Header [String (falSy | truSy | <other attribute>)]
  23 //              {Import | Constant | Variable | Type | Procedure}
  24 //              TypeList Key.
  25 //      -- optional String is external name.
  26 //      -- falSy ==> Java class
  27 //      -- truSy ==> Java interface
  28 //      -- others ...
  29 // Header     = magic modSy Name.
  30 // Import     = impSy Name [String] Key.
  31 //      -- optional string is explicit external name of class
  32 // Constant   = conSy Name Literal.
  33 // Variable   = varSy Name TypeOrd.
  34 // Type       = typSy Name TypeOrd.
  35 // Procedure  = prcSy Name [String] FormalType.
  36 //      -- optional string is explicit external name of procedure
  37 // Method     = mthSy Name byte byte TypeOrd [String][Name] FormalType.
  38 //      -- optional string is explicit external name of method
  39 // FormalType = [retSy TypeOrd] frmSy {parSy byte TypeOrd [String]} endFm.
  40 //      -- optional phrase is return type for proper procedures
  41 // TypeOrd    = ordinal.
  42 // TypeHeader = tDefS Ord [fromS Ord Name].
  43 //      -- optional phrase occurs if:
  44 //      -- type not from this module, i.e. indirect export
  45 // TypeList   = start { Array | Record | Pointer | ProcType |
  46 //                      NamedType | Enum | Vector } close.
  47 // Array      = TypeHeader arrSy TypeOrd (Byte | Number | <empty>) endAr.
  48 //      -- nullable phrase is array length for fixed length arrays
  49 // Vector     = TypeHeader arrSy basSy TypeOrd endAr.
  50 // Pointer    = TypeHeader ptrSy TypeOrd.
  51 // Event      = TypeHeader evtSy FormalType.
  52 // ProcType   = TypeHeader pTpSy FormalType.
  53 // Record     = TypeHeader recSy recAtt [truSy | falSy]
  54 //              [basSy TypeOrd] [iFcSy {basSy TypeOrd}]
  55 //              {Name TypeOrd} {Method} {Statics} endRc.
  56 //      -- truSy ==> is an extension of external interface
  57 //      -- falSy ==> is an extension of external class
  58 //      -- basSy option defines base type, if not ANY / j.l.Object
  59 // NamedType  = TypeHeader.
  60 // Statics    = ( Constant | Variable | Procedure ).
  61 // Enum       = TypeHeader eTpSy { Constant } endRc.
  62 // Name       = namSy byte UTFstring.
  63 // Literal    = Number | String | Set | Char | Real | falSy | truSy.
  64 // Byte       = bytSy byte.
  65 // String     = strSy UTFstring.
  66 // Number     = numSy longint.
  67 // Real       = fltSy ieee-double.
  68 // Set        = setSy integer.
  69 // Key        = keySy integer..
  70 // Char       = chrSy unicode character.
  71 //
  72 // Notes on the syntax:
  73 // All record types must have a Name field, even though this is often
  74 // redundant.  The issue is that every record type (including those that
  75 // are anonymous in CP) corresponds to a IR class, and the definer
  76 // and the user of the class _must_ agree on the IR name of the class.
  77 // The same reasoning applies to procedure types, which must have equal
  78 // interface names in all modules.
  79 //
  80 // Notes on the fine print about UTFstring --- November 2011 clarification.
  81 // The character sequence in the symbol file is modified UTF-8, that is
  82 // it may represent CHR(0), U+0000, by the bytes 0xC0, 0x80. String
  83 // constants may thus contain embedded nulls.
  84 //
  85 // ======================================================================== *)
  86
  87   CONST
  88         modSy = ORD('H'); namSy = ORD('$'); bytSy = ORD('\');
  89         numSy = ORD('#'); chrSy = ORD('c'); strSy = ORD('s');
  90         fltSy = ORD('r'); falSy = ORD('0'); truSy = ORD('1');
  91         impSy = ORD('I'); setSy = ORD('S'); keySy = ORD('K');
  92         conSy = ORD('C'); typSy = ORD('T'); tDefS = ORD('t');
  93         prcSy = ORD('P'); retSy = ORD('R'); mthSy = ORD('M');
  94         varSy = ORD('V'); parSy = ORD('p'); start = ORD('&');
  95         close = ORD('!'); recSy = ORD('{'); endRc = ORD('}');
  96         frmSy = ORD('('); fromS = ORD('@'); endFm = ORD(')');
  97         arrSy = ORD('['); endAr = ORD(']'); pTpSy = ORD('%');
  98         ptrSy = ORD('^'); basSy = ORD('+'); eTpSy = ORD('e');
  99         iFcSy = ORD('~'); evtSy = ORD('v'); vecSy = ORD('*');
 100
 101   CONST
 102         magic   = 0DEADD0D0H;
 103         syMag   = 0D0D0DEADH;
 104         dumped* = -1;
 105         symExt  = ".cps";
 106         broExt  = ".bro";
 107         htmlExt = ".html";
 108
 109
 110 (* ============================================================ *)
 111
 112   TYPE
 113     CharOpen = POINTER TO ARRAY OF CHAR;
 114
 115 (* ============================================================ *)
 116
 117   TYPE
 118     Desc = POINTER TO ABSTRACT RECORD
 119              name   : CharOpen;
 120              access : INTEGER;
 121            END;
 122
 123     DescList = RECORD
 124                  list : POINTER TO ARRAY OF Desc;
 125                  tide : INTEGER;
 126                END;
 127
 128     AbsValue = POINTER TO ABSTRACT RECORD
 129                END;
 130
 131     NumValue = POINTER TO RECORD (AbsValue)
 132                  numVal : LONGINT;
 133                END;
 134
 135     SetValue = POINTER TO RECORD (AbsValue)
 136                  setVal : SET;
 137                END;
 138
 139     StrValue = POINTER TO RECORD (AbsValue)
 140                  strVal : CharOpen;
 141                END;
 142
 143     FltValue = POINTER TO RECORD (AbsValue)
 144                  fltVal : REAL;
 145                END;
 146
 147     BoolValue = POINTER TO RECORD (AbsValue)
 148                   boolVal : BOOLEAN;
 149                 END;
 150
 151     ChrValue = POINTER TO RECORD (AbsValue)
 152                  chrVal : CHAR;
 153                END;
 154
 155     Type = POINTER TO ABSTRACT RECORD
 156              declarer : Desc;
 157              importedFrom : Module;
 158              importedName : CharOpen;
 159            END;
 160
 161     TypeList = POINTER TO ARRAY OF Type;
 162
 163     Named = POINTER TO RECORD (Type)
 164             END;
 165
 166     Basic = POINTER TO EXTENSIBLE RECORD (Type)
 167               name : CharOpen;
 168             END;
 169
 170     Enum = POINTER TO EXTENSIBLE RECORD (Type)
 171              ids : DescList;
 172            END;
 173
 174     Pointer = POINTER TO EXTENSIBLE RECORD (Type)
 175                 baseNum : INTEGER;
 176                 isAnonPointer : BOOLEAN;
 177                 baseType : Type;
 178               END;
 179
 180     Record = POINTER TO EXTENSIBLE RECORD (Type)
 181                recAtt    : INTEGER;
 182                baseType  : Type;
 183                ptrType   : Pointer;
 184                isAnonRec : BOOLEAN;
 185                baseNum   : INTEGER;
 186                intrFaces : DescList;
 187                fields    : DescList;
 188                methods   : DescList;
 189                statics   : DescList;
 190              END;
 191
 192     Array = POINTER TO EXTENSIBLE RECORD (Type)
 193               size : INTEGER;
 194               elemType : Type;
 195               elemTypeNum : INTEGER;
 196             END;
 197
 198     Vector = POINTER TO EXTENSIBLE RECORD (Type)
 199                elemType : Type;
 200                elemTypeNum : INTEGER;
 201              END;
 202
 203     Par = POINTER TO RECORD
 204             typeNum : INTEGER;
 205             type    : Type;
 206             opNm    : CharOpen; (* Optional *)
 207             mode    : INTEGER;
 208            END;
 209
 210     ParList = RECORD
 211                 list : POINTER TO ARRAY OF Par;
 212                 tide : INTEGER;
 213               END;
 214
 215     Proc = POINTER TO EXTENSIBLE RECORD (Type)
 216              fName         : CharOpen;
 217              retType       : Type;
 218              retTypeNum    : INTEGER;
 219              noModes       : BOOLEAN;
 220              isConstructor : BOOLEAN;
 221              pars          : ParList;
 222            END;
 223
 224     Event   = POINTER TO RECORD (Proc) END;
 225
 226     Meth = POINTER TO EXTENSIBLE RECORD (Proc)
 227              receiver   : Type;
 228              recName    : CharOpen; (* Optional *)
 229              recTypeNum : INTEGER;
 230              attr       : INTEGER;
 231              recMode    : INTEGER;
 232            END;
 233
 234
 235     ImportDesc = POINTER TO RECORD (Desc)
 236                  END;
 237
 238     ConstDesc = POINTER TO RECORD  (Desc)
 239                   val : AbsValue;
 240                 END;
 241
 242     TypeDesc = POINTER TO EXTENSIBLE RECORD (Desc)
 243                 type : Type;
 244                 typeNum : INTEGER;
 245               END;
 246
 247     UserTypeDesc = POINTER TO RECORD (TypeDesc)
 248                    END;
 249
 250     VarDesc = POINTER TO RECORD (TypeDesc)
 251               END;
 252
 253     ProcDesc = POINTER TO RECORD (Desc)
 254                  pType : Proc;
 255                END;
 256
 257     ModList = RECORD
 258                 tide : INTEGER;
 259                 list : POINTER TO ARRAY OF Module;
 260               END;
 261
 262     Module = POINTER TO RECORD
 263                name      : CharOpen;
 264                symName   : CharOpen;
 265                fName     : CharOpen;
 266                pathName  : GPFiles.FileNameArray;
 267                imports   : ModList;
 268                consts    : DescList;
 269                vars      : DescList;
 270                types     : DescList;
 271                procs     : DescList;
 272                systemMod : BOOLEAN;
 273                progArg   : BOOLEAN;
 274                print     : BOOLEAN;
 275                strongNm  : POINTER TO ARRAY 6 OF INTEGER;
 276              END;
 277
 278 (* ============================================================ *)
 279
 280   TYPE
 281
 282     Output = POINTER TO EXTENSIBLE RECORD
 283                thisMod : Module;
 284              END;
 285
 286     FileOutput = POINTER TO EXTENSIBLE RECORD (Output)
 287                    file : GPTextFiles.FILE;
 288                  END;
 289
 290     HtmlOutput = POINTER TO RECORD (FileOutput)
 291                  END;
 292
 293 (* ============================================================ *)
 294
 295   VAR
 296     args, argNo  : INTEGER;
 297     fileName, modName  : CharOpen;
 298     printFNames, doAll, verbatim, verbose, hexCon, alpha : BOOLEAN;
 299     file  : GPBinFiles.FILE;
 300     sSym  : INTEGER;
 301     cAtt  : CHAR;
 302     iAtt  : INTEGER;
 303     lAtt  : LONGINT;
 304     rAtt  : REAL;
 305     sAtt  : CharOpen;
 306     typeList : TypeList;
 307     accArray : ARRAY 4 OF CHAR;
 308     outExt  : ARRAY 6 OF CHAR;
 309     output : Output;
 310     module : Module;
 311     modList : ModList;
 312
 313 (* ============================================================ *)
 314 (* ============================================================ *)
 315
 316   PROCEDURE QuickSortDescs(lo, hi : INTEGER; dLst : DescList);
 317     VAR i,j : INTEGER;
 318         dsc : Desc;
 319         tmp : Desc;
 320    (* -------------------------------------------------- *)
 321     PROCEDURE canonLT(l,r : ARRAY OF CHAR) : BOOLEAN;
 322       VAR i : INTEGER;
 323     BEGIN
 324       FOR i := 0 TO LEN(l) - 1 DO l[i] := CAP(l[i]) END;
 325       FOR i := 0 TO LEN(r) - 1 DO r[i] := CAP(r[i]) END;
 326       RETURN l < r;
 327     END canonLT;
 328    (* -------------------------------------------------- *)
 329    (* -------------------------------------------------- *)
 330     PROCEDURE canonGT(l,r : ARRAY OF CHAR) : BOOLEAN;
 331       VAR i : INTEGER;
 332     BEGIN
 333       FOR i := 0 TO LEN(l) - 1 DO l[i] := CAP(l[i]) END;
 334       FOR i := 0 TO LEN(r) - 1 DO r[i] := CAP(r[i]) END;
 335       RETURN l > r;
 336     END canonGT;
 337    (* -------------------------------------------------- *)
 338   BEGIN
 339     i := lo; j := hi;
 340     dsc := dLst.list[(lo+hi) DIV 2];
 341     REPEAT
 342    (*
 343     * WHILE dLst.list[i].name < dsc.name DO INC(i) END;
 344     * WHILE dLst.list[j].name > dsc.name DO DEC(j) END;
 345     *)
 346       WHILE canonLT(dLst.list[i].name$, dsc.name$) DO INC(i) END;
 347       WHILE canonGT(dLst.list[j].name$, dsc.name$) DO DEC(j) END;
 348       IF i <= j THEN
 349         tmp := dLst.list[i]; dLst.list[i] := dLst.list[j]; dLst.list[j] := tmp;
 350         INC(i); DEC(j);
 351       END;
 352     UNTIL i > j;
 353     IF lo < j THEN QuickSortDescs(lo, j,  dLst) END;
 354     IF i < hi THEN QuickSortDescs(i,  hi, dLst) END;
 355   END QuickSortDescs;
 356
 357 (* ============================================================ *)
 358 (* ============================================================ *)
 359
 360   PROCEDURE GetModule(name : CharOpen) : Module;
 361   VAR
 362     i : INTEGER;
 363     tmp : POINTER TO ARRAY OF Module;
 364     mod : Module;
 365   BEGIN
 366     ASSERT(modList.list # NIL);
 367     FOR i := 0 TO modList.tide-1 DO
 368       IF modList.list[i].name^ = name^ THEN RETURN modList.list[i] END;
 369     END;
 370     IF modList.tide >= LEN(modList.list) THEN
 371       tmp := modList.list;
 372       NEW(modList.list,modList.tide*2);
 373       FOR i := 0 TO modList.tide-1 DO
 374         modList.list[i] := tmp[i];
 375       END;
 376     END;
 377     NEW(mod);
 378     mod.systemMod := FALSE;
 379     mod.progArg := FALSE;
 380     mod.name := name;
 381     mod.symName := BOX(name^ + symExt);
 382     modList.list[modList.tide] := mod;
 383     INC(modList.tide);
 384     RETURN mod;
 385   END GetModule;
 386
 387   PROCEDURE AddMod (VAR mList : ModList; m : Module);
 388   VAR
 389     tmp : POINTER TO ARRAY OF Module;
 390     i : INTEGER;
 391   BEGIN
 392     IF mList.list = NIL THEN
 393       NEW(mList.list,10);
 394       mList.tide := 0;
 395     ELSIF mList.tide >= LEN(mList.list) THEN
 396       tmp := mList.list;
 397       NEW(mList.list,LEN(tmp)*2);
 398       FOR i := 0 TO mList.tide-1 DO
 399         mList.list[i] := tmp[i];
 400       END;
 401     END;
 402     mList.list[mList.tide] := m;
 403     INC(mList.tide);
 404   END AddMod;
 405
 406 (* ============================================================ *)
 407
 408   PROCEDURE AddDesc (VAR dList : DescList; d : Desc);
 409   VAR
 410     tmp : POINTER TO ARRAY OF Desc;
 411     i : INTEGER;
 412   BEGIN
 413     IF dList.list = NIL THEN
 414       NEW(dList.list,10);
 415       dList.tide := 0;
 416     ELSIF dList.tide >= LEN(dList.list) THEN
 417       tmp := dList.list;
 418       NEW(dList.list,LEN(tmp)*2);
 419       FOR i := 0 TO dList.tide-1 DO
 420         dList.list[i] := tmp[i];
 421       END;
 422     END;
 423     dList.list[dList.tide] := d;
 424     INC(dList.tide);
 425   END AddDesc;
 426
 427   PROCEDURE AddPar (VAR pList : ParList; p : Par);
 428   VAR
 429     tmp : POINTER TO ARRAY OF Par;
 430     i : INTEGER;
 431   BEGIN
 432     IF pList.list = NIL THEN
 433       NEW(pList.list,10);
 434       pList.tide := 0;
 435     ELSIF pList.tide >= LEN(pList.list) THEN
 436       tmp := pList.list;
 437       NEW(pList.list,LEN(tmp)*2);
 438       FOR i := 0 TO pList.tide-1 DO
 439         pList.list[i] := tmp[i];
 440       END;
 441     END;
 442     pList.list[pList.tide] := p;
 443     INC(pList.tide);
 444   END AddPar;
 445
 446   PROCEDURE AddType (VAR tList : TypeList; t : Type; pos : INTEGER);
 447   VAR
 448     tmp : POINTER TO ARRAY OF Type;
 449     i : INTEGER;
 450   BEGIN
 451     ASSERT(tList # NIL);
 452     IF pos >= LEN(tList) THEN
 453       tmp := tList;
 454       NEW(tList,LEN(tmp)*2);
 455       FOR i := 0 TO LEN(tmp)-1 DO
 456         tList[i] := tmp[i];
 457       END;
 458     END;
 459     tList[pos] := t;
 460   END AddType;
 461
 462 (* ============================================================ *)
 463 (* ========     Various reading utility procedures      ======= *)
 464 (* ============================================================ *)
 465
 466   PROCEDURE read() : INTEGER;
 467   BEGIN
 468     RETURN GPBinFiles.readByte(file);
 469   END read;
 470
 471 (* ======================================= *)
 472
 473   PROCEDURE readUTF() : CharOpen;
 474     CONST
 475       bad = "Bad UTF-8 string";
 476     VAR num : INTEGER;
 477       bNm : INTEGER;
 478       len : INTEGER;
 479       idx : INTEGER;
 480       chr : INTEGER;
 481       buff : CharOpen;
 482   BEGIN
 483     num := 0;
 484    (*
 485     *  bNm is the length in bytes of the UTF8 representation
 486     *)
 487     len := read() * 256 + read();  (* max length 65k *)
 488    (*
 489     *  Worst case the number of chars will equal byte-number.
 490     *)
 491     NEW(buff, len + 1);
 492     idx := 0;
 493     WHILE idx < len DO
 494       chr := read(); INC(idx);
 495       IF chr <= 07FH THEN               (* [0xxxxxxx] *)
 496         buff[num] := CHR(chr); INC(num);
 497       ELSIF chr DIV 32 = 06H THEN       (* [110xxxxx,10xxxxxx] *)
 498         bNm := chr MOD 32 * 64;
 499         chr := read(); INC(idx);
 500         IF chr DIV 64 = 02H THEN
 501           buff[num] := CHR(bNm + chr MOD 64); INC(num);
 502         ELSE
 503           RTS.Throw(bad);
 504         END;
 505       ELSIF chr DIV 16 = 0EH THEN       (* [1110xxxx,10xxxxxx,10xxxxxxx] *)
 506         bNm := chr MOD 16 * 64;
 507         chr := read(); INC(idx);
 508         IF chr DIV 64 = 02H THEN
 509           bNm := (bNm + chr MOD 64) * 64;
 510           chr := read(); INC(idx);
 511           IF chr DIV 64 = 02H THEN
 512             buff[num] := CHR(bNm + chr MOD 64); INC(num);
 513           ELSE
 514             RTS.Throw(bad);
 515           END;
 516         ELSE
 517           RTS.Throw(bad);
 518         END;
 519       ELSE
 520         RTS.Throw(bad);
 521       END;
 522     END;
 523     buff[num] := 0X;
 524     RETURN LitValue.arrToCharOpen(buff, num);
 525   END readUTF;
 526
 527 (* ======================================= *)
 528
 529   PROCEDURE readChar() : CHAR;
 530   BEGIN
 531     RETURN CHR(read() * 256 + read());
 532   END readChar;
 533
 534 (* ======================================= *)
 535
 536   PROCEDURE readInt() : INTEGER;
 537   BEGIN [UNCHECKED_ARITHMETIC]
 538     (* overflow checking off here *)
 539     RETURN ((read() * 256 + read()) * 256 + read()) * 256 + read();
 540   END readInt;
 541
 542 (* ======================================= *)
 543
 544   PROCEDURE readLong() : LONGINT;
 545     VAR result : LONGINT;
 546         index  : INTEGER;
 547   BEGIN [UNCHECKED_ARITHMETIC]
 548     (* overflow checking off here *)
 549     result := read();
 550     FOR index := 1 TO 7 DO
 551       result := result * 256 + read();
 552     END;
 553     RETURN result;
 554   END readLong;
 555
 556 (* ======================================= *)
 557
 558   PROCEDURE readReal() : REAL;
 559     VAR result : LONGINT;
 560   BEGIN
 561     result := readLong();
 562     RETURN RTS.longBitsToReal(result);
 563   END readReal;
 564
 565 (* ======================================= *)
 566
 567   PROCEDURE readOrd() : INTEGER;
 568     VAR chr : INTEGER;
 569   BEGIN
 570     chr := read();
 571     IF chr <= 07FH THEN RETURN chr;
 572     ELSE
 573       DEC(chr, 128);
 574       RETURN chr + read() * 128;
 575     END;
 576   END readOrd;
 577
 578 (* ============================================================ *)
 579 (* ========             Symbol File Reader              ======= *)
 580 (* ============================================================ *)
 581 (*
 582   PROCEDURE DiagnoseSymbol();
 583     VAR arg : ARRAY 24 OF CHAR;
 584   BEGIN
 585     CASE sSym OF
 586     | ORD('H') : Console.WriteString("MODULE "); RETURN;
 587     | ORD('0') : Console.WriteString("FALSE");
 588     | ORD('1') : Console.WriteString("TRUE");
 589     | ORD('I') : Console.WriteString("IMPORT "); RETURN;
 590     | ORD('C') : Console.WriteString("CONST");
 591     | ORD('T') : Console.WriteString("TYPE "); RETURN;
 592     | ORD('P') : Console.WriteString("PROCEDURE "); RETURN;
 593     | ORD('M') : Console.WriteString("MethodSymbol");
 594     | ORD('V') : Console.WriteString("VAR "); RETURN;
 595     | ORD('p') : Console.WriteString("ParamSymbol");
 596     | ORD('&') : Console.WriteString("StartSymbol");
 597     | ORD('!') : Console.WriteString("CloseSymbol");
 598     | ORD('{') : Console.WriteString("StartRecord");
 599     | ORD('}') : Console.WriteString("EndRecord");
 600     | ORD('(') : Console.WriteString("StartFormals");
 601     | ORD('@') : Console.WriteString("FROM "); RETURN;
 602     | ORD(')') : Console.WriteString("EndFormals");
 603     | ORD('[') : Console.WriteString("StartArray");
 604     | ORD(']') : Console.WriteString("EndArray");
 605     | ORD('%') : Console.WriteString("ProcType");
 606     | ORD('^') : Console.WriteString("POINTER");
 607     | ORD('e') : Console.WriteString("EnumType");
 608     | ORD('~') : Console.WriteString("InterfaceType");
 609     | ORD('v') : Console.WriteString("EventType");
 610     | ORD('*') : Console.WriteString("VectorType");
 611     | ORD('\') : Console.WriteString("BYTE "); Console.WriteInt(iAtt,1);
 612     | ORD('c') : Console.WriteString("CHAR "); Console.Write(cAtt);
 613     | ORD('S') : Console.WriteString("SetSymbol 0x"); Console.WriteHex(iAtt,1);
 614     | ORD('K') : Console.WriteString("KeySymbol 0x"); Console.WriteHex(iAtt,1);
 615     | ORD('t') : Console.WriteString("TypeDef t#"); Console.WriteInt(iAtt,1);
 616     | ORD('+') : Console.WriteString("BaseType t#"); Console.WriteInt(iAtt,1);
 617     | ORD('R') : Console.WriteString("RETURN t#"); Console.WriteInt(iAtt,1);
 618     | ORD('#') :
 619             RTS.LongToStr(lAtt, arg);
 620             Console.WriteString("Number ");
 621                 Console.WriteString(arg$);
 622     | ORD('$') :
 623         Console.WriteString("NameSymbol #");
 624         Console.WriteInt(iAtt,1);
 625         Console.Write(' ');
 626         Console.WriteString(sAtt);
 627     | ORD('s') :
 628         Console.WriteString("String '");
 629         Console.WriteString(sAtt);
 630         Console.Write("'");
 631     | ORD('r') :
 632         RTS.RealToStrInvar(rAtt, arg);
 633         Console.WriteString("Real ");
 634         Console.WriteString(arg$);
 635     ELSE
 636             Console.WriteString("Bad Symbol ");
 637                 Console.WriteInt(sSym, 1);
 638             Console.WriteString(" in File");
 639     END;
 640     Console.WriteLn;
 641   END DiagnoseSymbol;
 642 *)
 643 (* ============================================================ *)
 644
 645   PROCEDURE GetSym();
 646   BEGIN
 647     sSym := read();
 648     CASE sSym OF
 649     | namSy :
 650         iAtt := read();
 651         sAtt := readUTF();
 652     | strSy :
 653         sAtt := readUTF();
 654     | retSy, fromS, tDefS, basSy :
 655         iAtt := readOrd();
 656     | bytSy :
 657         iAtt := read();
 658     | keySy, setSy :
 659         iAtt := readInt();
 660     | numSy :
 661         lAtt := readLong();
 662     | fltSy :
 663         rAtt := readReal();
 664     | chrSy :
 665         cAtt := readChar();
 666     ELSE (* nothing to do *)
 667     END;
 668     (* DiagnoseSymbol(); *)
 669   END GetSym;
 670
 671 (* ======================================= *)
 672
 673   PROCEDURE ReadPast(sym : INTEGER);
 674   BEGIN
 675     IF sSym # sym THEN
 676       Console.WriteString("Expected ");
 677       Console.Write(CHR(sym));
 678       Console.WriteString(" got ");
 679       Console.Write(CHR(sSym));
 680       Console.WriteLn;
 681       RTS.Throw("Bad symbol file format");
 682     END;
 683     GetSym();
 684   END ReadPast;
 685
 686 (* ============================================ *)
 687
 688   PROCEDURE GetLiteral(VAR lit : AbsValue);
 689   VAR
 690     b : BoolValue;
 691     n : NumValue;
 692     c : ChrValue;
 693     f : FltValue;
 694     s : SetValue;
 695     st : StrValue;
 696   BEGIN
 697     CASE sSym OF
 698     | truSy : NEW(b); b.boolVal := TRUE; lit := b;
 699     | falSy : NEW(b); b.boolVal := FALSE; lit := b;
 700     | numSy : NEW(n); n.numVal := lAtt; lit := n;
 701     | chrSy : NEW(c); c.chrVal := cAtt; lit := c;
 702     | fltSy : NEW(f); f.fltVal := rAtt; lit := f;
 703     | setSy : NEW(s); s.setVal := BITS(iAtt); lit := s;
 704     | strSy : NEW(st); st.strVal := sAtt; lit := st;
 705     END;
 706     GetSym();                                           (* read past value  *)
 707   END GetLiteral;
 708
 709 (* ============================================ *)
 710
 711   PROCEDURE GetFormalType(p : Proc);
 712   (*
 713   // FormalType = [retSy TypeOrd] frmSy {parSy byte TypeOrd} endFm.
 714   //    -- optional phrase is return type for proper procedures
 715   *)
 716     VAR
 717          par : Par;
 718         byte : INTEGER;
 719   BEGIN
 720     p.noModes := TRUE;
 721     IF sSym = retSy THEN
 722       p.retTypeNum := iAtt;
 723       GetSym();
 724     ELSE
 725       p.retTypeNum := 0;
 726     END;
 727     ReadPast(frmSy);
 728     WHILE sSym = parSy DO
 729       NEW(par);
 730       par.mode := read();
 731       IF par.mode > 0 THEN p.noModes := FALSE; END;
 732       par.typeNum := readOrd();
 733       GetSym();
 734       IF sSym = strSy THEN
 735         par.opNm := sAtt;
 736         GetSym();
 737       END;
 738       AddPar(p.pars,par);
 739     END;
 740     ReadPast(endFm);
 741   END GetFormalType;
 742
 743 (* ============================================ *)
 744
 745   PROCEDURE pointerType() : Pointer;
 746   (* Assert: the current symbol is ptrSy.       *)
 747   (* Pointer   = TypeHeader ptrSy TypeOrd.      *)
 748     VAR
 749       ptr : Pointer;
 750   BEGIN
 751     NEW(ptr);
 752     ptr.baseNum := readOrd();
 753     ptr.isAnonPointer := FALSE;
 754     GetSym();
 755     RETURN ptr;
 756   END pointerType;
 757
 758 (* ============================================ *)
 759
 760   PROCEDURE eventType() : Proc;
 761   (* Assert: the current symbol is evtSy.       *)
 762   (* Event   = TypeHeader evtSy FormalType.     *)
 763     VAR p : Event;
 764   BEGIN
 765     NEW(p);
 766     GetSym();           (* read past evtSy *)
 767     GetFormalType(p);
 768     RETURN p;
 769   END eventType;
 770
 771 (* ============================================ *)
 772
 773   PROCEDURE procedureType() : Proc;
 774   (* Assert: the current symbol is pTpSy.       *)
 775   (* ProcType  = TypeHeader pTpSy FormalType.   *)
 776   VAR
 777     p : Proc;
 778   BEGIN
 779     NEW(p);
 780     GetSym();           (* read past pTpSy *)
 781     GetFormalType(p);
 782     RETURN p;
 783   END procedureType;
 784
 785 (* ============================================ *)
 786
 787   PROCEDURE^ GetConstant() : ConstDesc;
 788
 789   PROCEDURE enumType() : Enum;
 790   (* Assert: the current symbol is eTpSy.         *)
 791   (* Enum  = TypeHeader eTpSy { Constant } endRc. *)
 792   VAR
 793     e : Enum;
 794   BEGIN
 795     NEW(e);
 796     GetSym();
 797     WHILE (sSym = conSy) DO
 798       AddDesc(e.ids,GetConstant());
 799     END;
 800     ReadPast(endRc);
 801     RETURN e;
 802   END enumType;
 803
 804 (* ============================================ *)
 805
 806   PROCEDURE arrayType() : Type;
 807   (* Assert: at entry the current symbol is arrSy.                   *)
 808   (* Array      = TypeHeader arrSy TypeOrd (Byte | Number | ) endAr. *)
 809   (*    -- nullable phrase is array length for fixed length arrays   *)
 810     VAR
 811         arr : Array;
 812   BEGIN
 813     NEW(arr);
 814     arr.elemTypeNum := readOrd();
 815     GetSym();
 816     IF sSym = bytSy THEN
 817       arr.size := iAtt;
 818       GetSym();
 819     ELSIF sSym = numSy THEN
 820       arr.size := SHORT(lAtt);
 821       GetSym();
 822     ELSE
 823       arr.size := 0
 824     END;
 825     ReadPast(endAr);
 826     RETURN arr;
 827   END arrayType;
 828
 829 (* ============================================ *)
 830
 831   PROCEDURE vectorType() : Type;
 832   (* Assert: at entry the current symbol is vecSy.                   *)
 833   (* Vector   = TypeHeader vecSy TypeOrd endAr.                      *)
 834     VAR
 835         vec : Vector;
 836   BEGIN
 837     NEW(vec);
 838     vec.elemTypeNum := readOrd();
 839     GetSym();
 840     ReadPast(endAr);
 841     RETURN vec;
 842   END vectorType;
 843
 844 (* ============================================ *)
 845
 846   PROCEDURE^ GetProc() : ProcDesc;
 847   PROCEDURE^ GetVar() : VarDesc;
 848
 849   PROCEDURE recordType(recNum : INTEGER) : Record;
 850   (* Assert: at entry the current symbol is recSy.                      *)
 851   (* Record     = TypeHeader recSy recAtt [truSy | falSy | <others>]    *)
 852   (*    [basSy TypeOrd] [iFcSy {basSy TypeOrd}]                         *)
 853   (*    {Name TypeOrd} {Method} {Statics} endRc.                        *)
 854     VAR
 855         rec  : Record;
 856         f : VarDesc;
 857         t : TypeDesc;
 858         m : ProcDesc;
 859         mth : Meth;
 860   BEGIN
 861     NEW(rec);
 862     rec.recAtt := read();
 863     rec.isAnonRec := FALSE;
 864     GetSym();                           (* Get past recSy rAtt  *)
 865     IF (sSym = falSy) OR (sSym = truSy) THEN
 866       GetSym();
 867     END;
 868     IF sSym = basSy THEN
 869       rec.baseNum := iAtt;
 870       GetSym();
 871     ELSE
 872       rec.baseNum := 0;
 873     END;
 874     IF sSym = iFcSy THEN
 875       GetSym();
 876       WHILE sSym = basSy DO
 877 (* *
 878  * *    Console.WriteString("got interface $T");
 879  * *    Console.WriteInt(iAtt,1);
 880  * *    Console.WriteLn;
 881  * *)
 882         NEW(t);
 883         t.typeNum := iAtt;
 884         GetSym();
 885         AddDesc(rec.intrFaces,t);
 886       END;
 887     END;
 888     WHILE sSym = namSy DO
 889       NEW(f);
 890       f.name := sAtt;
 891       f.access := iAtt;
 892       f.typeNum := readOrd();
 893       GetSym();
 894       AddDesc(rec.fields,f);
 895     END;
 896    (* Method     = mthSy Name byte byte TypeOrd [String] FormalType. *)
 897     WHILE sSym = mthSy DO
 898       NEW(m);
 899       NEW(mth);
 900       mth.importedFrom := NIL;
 901       mth.isConstructor := FALSE;
 902       m.pType := mth;
 903       GetSym();
 904       IF (sSym # namSy) THEN RTS.Throw("Bad symbol file format"); END;
 905       m.name := sAtt;
 906       m.access := iAtt;
 907       mth.declarer := m;
 908      (* byte1 is the method attributes  *)
 909       mth.attr := read();
 910      (* byte2 is param form of receiver *)
 911       mth.recMode := read();
 912      (* next 1 or 2 bytes are rcv-type  *)
 913       mth.recTypeNum := readOrd();
 914       GetSym();
 915       IF sSym = strSy THEN
 916         mth.fName := sAtt;
 917         GetSym();
 918       ELSE
 919         mth.fName := NIL;
 920       END;
 921       IF sSym = namSy THEN
 922         mth.recName := sAtt;
 923         GetSym();
 924       END;
 925       GetFormalType(mth);
 926       AddDesc(rec.methods,m);
 927     END;
 928     WHILE (sSym = conSy) OR (sSym = prcSy) OR (sSym = varSy) DO
 929       IF sSym = conSy THEN
 930         AddDesc(rec.statics,GetConstant());
 931       ELSIF sSym = prcSy THEN
 932         AddDesc(rec.statics,GetProc());
 933       ELSE
 934         AddDesc(rec.statics,GetVar());
 935       END;
 936     END;
 937     ReadPast(endRc);
 938     RETURN rec;
 939   END recordType;
 940
 941 (* ============================================ *)
 942
 943   PROCEDURE ResolveProc(p : Proc);
 944   VAR
 945     i : INTEGER;
 946   BEGIN
 947     p.retType := typeList[p.retTypeNum];
 948     IF p.retTypeNum = 0 THEN ASSERT(p.retType = NIL); END;
 949     IF p IS Meth THEN
 950       p(Meth).receiver := typeList[p(Meth).recTypeNum];
 951     END;
 952     FOR i := 0 TO p.pars.tide-1 DO
 953       p.pars.list[i].type := typeList[p.pars.list[i].typeNum];
 954     END;
 955   END ResolveProc;
 956
 957 (* ============================================ *)
 958
 959   PROCEDURE ReadTypeList(mod : Module);
 960   (* TypeList   = start { Array | Record | Pointer      *)
 961   (*            | ProcType | NamedType | Enum } close.  *)
 962   (* TypeHeader = tDefS Ord [fromS Ord Name].           *)
 963     VAR modOrd : INTEGER;
 964         typOrd : INTEGER;
 965         typ    : Type;
 966         namedType : Named;
 967         f : VarDesc;
 968         rec : Record;
 969         impName : CharOpen;
 970         i,j : INTEGER;
 971   BEGIN
 972     GetSym();
 973     typOrd := 0;
 974     WHILE sSym = tDefS DO
 975       typOrd := iAtt;
 976       ASSERT(typOrd # 0);
 977       ReadPast(tDefS);
 978       modOrd := -1;
 979       impName := BOX("");
 980      (*
 981       *  The fromS symbol appears if the type is imported.
 982       *)
 983       IF sSym = fromS THEN
 984         modOrd := iAtt;
 985         GetSym();
 986         impName := sAtt;
 987         ReadPast(namSy);
 988       END;
 989      (* Get type info. *)
 990       CASE sSym OF
 991       | arrSy : typ := arrayType();
 992       | vecSy : typ := vectorType();
 993       | recSy : typ := recordType(typOrd);
 994       | ptrSy : typ := pointerType();
 995       | evtSy : typ := eventType();
 996       | pTpSy : typ := procedureType();
 997       | eTpSy : typ := enumType();
 998       ELSE
 999         NEW(namedType);
1000         typ := namedType;
1001       END;
1002       IF typ # NIL THEN
1003         AddType(typeList,typ,typOrd);
1004         IF modOrd > -1 THEN
1005           typ.importedFrom := mod.imports.list[modOrd];
1006           typ.importedName := impName;
1007         END;
1008       END;
1009     END;
1010     ReadPast(close);
1011     FOR i := Symbols.tOffset TO typOrd DO
1012       typ := typeList[i];
1013       IF typ IS Array THEN
1014         typ(Array).elemType := typeList[typ(Array).elemTypeNum];
1015       ELSIF typ IS Vector THEN
1016         typ(Vector).elemType := typeList[typ(Vector).elemTypeNum];
1017       ELSIF typ IS Record THEN
1018         rec := typ(Record);
1019         IF (rec.baseNum > 0) THEN
1020           rec.baseType := typeList[rec.baseNum];
1021         END;
1022         FOR j := 0 TO rec.fields.tide-1 DO
1023           f := rec.fields.list[j](VarDesc);
1024           f.type := typeList[f.typeNum];
1025         END;
1026         FOR j := 0 TO rec.methods.tide-1 DO
1027           ResolveProc(rec.methods.list[j](ProcDesc).pType);
1028         END;
1029         FOR j := 0 TO rec.statics.tide-1 DO
1030           IF rec.statics.list[j] IS ProcDesc THEN
1031             ResolveProc(rec.statics.list[j](ProcDesc).pType);
1032           ELSIF rec.statics.list[j] IS VarDesc THEN
1033             f := rec.statics.list[j](VarDesc);
1034             f.type := typeList[f.typeNum];
1035           END;
1036         END;
1037       ELSIF typ IS Pointer THEN
1038         typ(Pointer).baseType := typeList[typ(Pointer).baseNum];
1039       ELSIF typ IS Proc THEN
1040         ResolveProc(typ(Proc));
1041       END;
1042     END;
1043   END ReadTypeList;
1044
1045 (* ============================================ *)
1046
1047   PROCEDURE ResolveAnonRecs();
1048   VAR r : Record;
1049       typ : Type;
1050       ch0 : CHAR;
1051       i,j,k : INTEGER;
1052   BEGIN
1053     FOR i := Symbols.tOffset TO LEN(typeList)-1 DO
1054       typ := typeList[i];
1055       IF ~verbatim & (typ # NIL) & (typ.declarer # NIL) THEN
1056         ch0 := typ.declarer.name[0];
1057         IF (ch0 = "@") OR (ch0 = "$") THEN typ.declarer := NIL END;
1058       END;
1059       IF typ IS Record THEN
1060         r := typ(Record);
1061         FOR j := 0 TO r.intrFaces.tide - 1 DO
1062           k := r.intrFaces.list[j](TypeDesc).typeNum;
1063           r.intrFaces.list[j](TypeDesc).type := typeList[k];
1064         END;
1065         IF typ.declarer = NIL THEN (* anon record *)
1066           typ(Record).isAnonRec := TRUE;
1067         END;
1068       ELSIF (typ IS Pointer) & (typ(Pointer).baseType IS Record) THEN
1069         IF (typ.declarer = NIL) & (typ.importedFrom = NIL) THEN
1070           typ(Pointer).isAnonPointer := TRUE;
1071         END;
1072         r := typ(Pointer).baseType(Record);
1073         IF (r.declarer = NIL) THEN  (* anon record *)
1074           r.isAnonRec := TRUE;
1075           r.ptrType := typ(Pointer);
1076         END;
1077       END;
1078     END;
1079   END ResolveAnonRecs;
1080
1081 (* ============================================ *)
1082
1083   PROCEDURE GetType() : UserTypeDesc;
1084   (* Type       = typSy Name TypeOrd. *)
1085   VAR
1086     typeDesc : UserTypeDesc;
1087   BEGIN
1088     GetSym();
1089     NEW (typeDesc);
1090     typeDesc.name := sAtt;
1091     typeDesc.access := iAtt;
1092     typeDesc.typeNum := readOrd();
1093     GetSym();
1094     RETURN typeDesc;
1095   END GetType;
1096
1097 (* ============================================ *)
1098
1099   PROCEDURE GetImport() : Module;
1100   (* Import     = impSy Name [String] Key.  *)
1101   VAR
1102     impMod : Module;
1103   BEGIN
1104     GetSym();
1105     IF doAll THEN
1106       impMod := GetModule(sAtt);
1107     ELSE
1108       NEW(impMod);
1109       impMod.name := sAtt;
1110       impMod.systemMod := FALSE;
1111       impMod.progArg := FALSE;
1112     END;
1113     GetSym();
1114     IF sSym = strSy THEN impMod.fName := sAtt; GetSym(); END;
1115     ReadPast(keySy);
1116     RETURN impMod;
1117   END GetImport;
1118
1119 (* ============================================ *)
1120
1121   PROCEDURE GetConstant() : ConstDesc;
1122   (*  Constant   = conSy Name Literal.  *)
1123   VAR
1124     constDesc : ConstDesc;
1125   BEGIN
1126     GetSym();
1127     NEW(constDesc);
1128     constDesc.name := sAtt;
1129     constDesc.access := iAtt;
1130     GetSym();
1131     GetLiteral(constDesc.val);
1132     RETURN constDesc;
1133   END GetConstant;
1134
1135 (* ============================================ *)
1136
1137   PROCEDURE GetVar() : VarDesc;
1138   (*  Variable   = varSy Name TypeOrd.  *)
1139   VAR
1140     varDesc : VarDesc;
1141   BEGIN
1142     GetSym();
1143     NEW(varDesc);
1144     varDesc.name := sAtt;
1145     varDesc.access := iAtt;
1146     varDesc.typeNum := readOrd();
1147     GetSym();
1148     RETURN varDesc;
1149   END GetVar;
1150
1151 (* ============================================ *)
1152
1153   PROCEDURE GetProc() : ProcDesc;
1154   (* Procedure  = prcSy Name [String] [trySy] FormalType.  *)
1155   VAR
1156     procDesc : ProcDesc;
1157   BEGIN
1158     GetSym();
1159     NEW(procDesc);
1160     procDesc.name := sAtt;
1161     procDesc.access := iAtt;
1162     GetSym();
1163     NEW(procDesc.pType);
1164     IF sSym = strSy THEN
1165       IF sAtt^ = "<init>" THEN
1166         procDesc.pType.fName := BOX("< init >");
1167       ELSE
1168         procDesc.pType.fName := sAtt;
1169       END;
1170       GetSym();
1171     ELSE
1172       procDesc.pType.fName := NIL;
1173     END;
1174     IF sSym = truSy THEN
1175       procDesc.pType.isConstructor := TRUE;
1176       GetSym();
1177     ELSE
1178       procDesc.pType.isConstructor := FALSE;
1179     END;
1180     procDesc.pType.importedFrom := NIL;
1181     procDesc.pType.declarer := procDesc;
1182     GetFormalType(procDesc.pType);
1183     RETURN procDesc;
1184   END GetProc;
1185
1186 (* ============================================ *)
1187
1188   PROCEDURE SymFile(mod : Module);
1189    (*
1190    // SymFile    = Header [String (falSy | truSy | <others>)]
1191    //           {Import | Constant | Variable | Type | Procedure}
1192    //           TypeList Key.
1193    // Header     = magic modSy Name.
1194    //
1195    //  magic has already been recognized.
1196    *)
1197   VAR
1198     i,j,k : INTEGER;
1199     typeDesc : UserTypeDesc;
1200     varDesc  : VarDesc;
1201     procDesc : ProcDesc;
1202     thisType : Type;
1203   BEGIN
1204     AddMod(mod.imports,mod);
1205     ReadPast(modSy);
1206     IF sSym = namSy THEN (* do something with f.sAtt *)
1207       IF mod.name^ # sAtt^ THEN
1208         Error.WriteString("Wrong name in symbol file. Expected <");
1209         Error.WriteString(mod.name^ + ">, found <");
1210         Error.WriteString(sAtt^ + ">");
1211             Error.WriteLn;
1212         HALT(1);
1213       END;
1214       GetSym();
1215     ELSE RTS.Throw("Bad symfile header");
1216     END;
1217     IF sSym = strSy THEN (* optional name *)
1218       mod.fName := sAtt;
1219       GetSym();
1220       IF (sSym = falSy) OR (sSym = truSy) THEN
1221         GetSym();
1222       ELSE RTS.Throw("Bad explicit name");
1223       END;
1224     ELSE
1225       mod.fName := NIL;
1226     END;
1227    (*
1228     *  Optional strong name info.
1229     *)
1230     IF sSym = numSy THEN
1231       NEW(mod.strongNm);   (* POINTER TO ARRAY 6 OF INTEGER *)
1232       mod.strongNm[0] := RTS.hiInt(lAtt);
1233       mod.strongNm[1] := RTS.loInt(lAtt);
1234       GetSym();
1235       mod.strongNm[2] := RTS.hiInt(lAtt);
1236       mod.strongNm[3] := RTS.loInt(lAtt);
1237       GetSym();
1238       mod.strongNm[4] := RTS.hiInt(lAtt);
1239       mod.strongNm[5] := RTS.loInt(lAtt);
1240       GetSym();
1241     END;
1242     (* end optional strong name information *)
1243     LOOP
1244       CASE sSym OF
1245       | start : EXIT;
1246       | typSy : AddDesc(mod.types,GetType());
1247       | impSy : AddMod(mod.imports,GetImport());
1248       | conSy : AddDesc(mod.consts,GetConstant());
1249       | varSy : AddDesc(mod.vars,GetVar());
1250       | prcSy : AddDesc(mod.procs,GetProc());
1251       ELSE RTS.Throw("Bad object");
1252       END;
1253     END;
1254     ReadTypeList(mod);
1255     IF sSym # keySy THEN
1256       RTS.Throw("Missing keySy");
1257     END;
1258     FOR i := 0 TO mod.types.tide-1 DO
1259       typeDesc := mod.types.list[i](UserTypeDesc);
1260       thisType := typeList[typeDesc.typeNum];
1261       typeDesc.type := thisType;
1262       typeDesc.type.declarer := typeDesc;
1263     END;
1264     FOR i := 0 TO mod.vars.tide-1 DO
1265       varDesc := mod.vars.list[i](VarDesc);
1266       varDesc.type := typeList[varDesc.typeNum];
1267     END;
1268     FOR i := 0 TO mod.procs.tide-1 DO
1269       procDesc := mod.procs.list[i](ProcDesc);
1270       ResolveProc(mod.procs.list[i](ProcDesc).pType);
1271     END;
1272     ResolveAnonRecs();
1273   END SymFile;
1274
1275 (* ============================================================ *)
1276
1277   PROCEDURE GetSymAndModNames(VAR symName : CharOpen;
1278                               OUT modName : CharOpen);
1279   VAR i,j : INTEGER;
1280       ok : BOOLEAN;
1281   BEGIN
1282     modName := BOX(symName^);
1283     i := 0;
1284     WHILE ((i < LEN(symName)) & (symName[i] # '.') &
1285            (symName[i] # 0X)) DO INC(i); END;
1286     IF (i >= LEN(symName)) OR (symName[i] # '.') THEN
1287       symName := BOX(symName^ + symExt);
1288     ELSE
1289       modName[i] := 0X;
1290     END;
1291   END GetSymAndModNames;
1292
1293   PROCEDURE Parse();
1294   VAR
1295     marker,modIx,i   : INTEGER;
1296     mod : Module;
1297   BEGIN
1298     modIx := 0;
1299     WHILE (modIx < modList.tide) DO
1300       mod := modList.list[modIx];
1301       INC(modIx);
1302       mod.print := FALSE;
1303       file := GPBinFiles.findLocal(mod.symName);
1304       IF file = NIL THEN
1305         file := GPBinFiles.findOnPath("CPSYM", mod.symName);
1306         IF (file = NIL) OR (mod.progArg) THEN
1307           Error.WriteString("File <" + mod.symName^ + "> not found");
1308           Error.WriteLn;
1309           HALT(1);
1310         END;
1311         mod.pathName := GPBinFiles.getFullPathName(file);
1312         i := 0;
1313         WHILE (i < LEN(mod.pathName)) & (mod.pathName[i] # ".") DO INC(i); END;
1314         mod.pathName[i] := 0X;
1315       ELSE
1316         marker := readInt();
1317         IF marker = RTS.loInt(magic) THEN
1318         (* normal case, nothing to do *)
1319         ELSIF marker = RTS.loInt(syMag) THEN
1320           mod.systemMod := TRUE;
1321         ELSE
1322           Error.WriteString("File <" + fileName^ + "> is not a valid symbol file");
1323           Error.WriteLn;
1324           RETURN;
1325         END;
1326         mod.print := TRUE;
1327         GetSym();
1328         IF verbose THEN
1329           Error.WriteString("Reading " + mod.name^); Error.WriteLn;
1330         END;
1331         SymFile(mod);
1332         GPBinFiles.CloseFile(file);
1333       END;
1334     END;
1335   RESCUE (x)
1336     Error.WriteString("Error in Parse()"); Error.WriteLn;
1337     Error.WriteString(RTS.getStr(x)); Error.WriteLn;
1338   END Parse;
1339
1340 (* ===================================================================== *)
1341
1342 PROCEDURE (o : Output) WriteStart(mod : Module),NEW,EMPTY;
1343
1344 PROCEDURE (o : Output) WriteEnd(),NEW,EMPTY;
1345
1346 PROCEDURE (o : Output) Write(ch : CHAR),NEW,EXTENSIBLE;
1347 BEGIN
1348   Console.Write(ch);
1349 END Write;
1350
1351 PROCEDURE (o : Output) WriteIdent(str : ARRAY OF CHAR),NEW,EXTENSIBLE;
1352 BEGIN
1353   Console.WriteString(str);
1354 END WriteIdent;
1355
1356 PROCEDURE (o : Output) WriteImport(impMod : Module),NEW,EXTENSIBLE;
1357 BEGIN
1358   Console.WriteString(impMod.name);
1359 END WriteImport;
1360
1361 PROCEDURE (o : Output) WriteString(str : ARRAY OF CHAR),NEW,EXTENSIBLE;
1362 BEGIN
1363   Console.WriteString(str);
1364 END WriteString;
1365
1366 PROCEDURE (o : Output) WriteLn(),NEW,EXTENSIBLE;
1367 BEGIN
1368   Console.WriteLn;
1369 END WriteLn;
1370
1371 PROCEDURE (o : Output) WriteInt(i : INTEGER),NEW,EXTENSIBLE;
1372 BEGIN
1373   Console.WriteInt(i,1);
1374 END WriteInt;
1375
1376 PROCEDURE (o : Output) WriteLong(l : LONGINT),NEW,EXTENSIBLE;
1377 VAR
1378   str : ARRAY 30 OF CHAR;
1379 BEGIN
1380   IF (l > MAX(INTEGER)) OR (l < MIN(INTEGER)) THEN
1381     RTS.LongToStr(l,str);
1382     Console.WriteString(str);
1383   ELSE
1384     Console.WriteInt(SHORT(l),1);
1385   END;
1386 END WriteLong;
1387
1388 PROCEDURE (o : Output) WriteKeyword(str : ARRAY OF CHAR),NEW,EXTENSIBLE;
1389 BEGIN
1390   Console.WriteString(str);
1391 END WriteKeyword;
1392
1393 PROCEDURE (o : Output) Indent(i : INTEGER),NEW,EXTENSIBLE;
1394 BEGIN
1395   WHILE i > 0 DO
1396     Console.Write(' ');
1397     DEC(i);
1398   END;
1399 END Indent;
1400
1401 PROCEDURE (o : Output) WriteImportedTypeName(impMod : Module;
1402                                              tName : ARRAY OF CHAR),NEW,EXTENSIBLE;
1403 BEGIN
1404   Console.WriteString(impMod.name^ + "." + tName);
1405 END WriteImportedTypeName;
1406
1407 PROCEDURE (o : Output) WriteTypeName(tName : ARRAY OF CHAR),NEW,EXTENSIBLE;
1408 BEGIN
1409   Console.WriteString(tName);
1410 END WriteTypeName;
1411
1412 PROCEDURE (o : Output) WriteTypeDecl(tName : ARRAY OF CHAR),NEW,EXTENSIBLE;
1413 BEGIN
1414   Console.WriteString(tName);
1415 END WriteTypeDecl;
1416
1417 (* FIXME *)
1418 PROCEDURE (o : Output) MethRef(IN nam : ARRAY OF CHAR),NEW,EMPTY;
1419 PROCEDURE (o : Output) MethAnchor(IN nam : ARRAY OF CHAR),NEW,EMPTY;
1420 (* FIXME *)
1421
1422 (* ------------------------------------------------------------------- *)
1423
1424 PROCEDURE (f : FileOutput) Write(ch : CHAR),EXTENSIBLE;
1425 BEGIN
1426   GPText.Write(f.file,ch);
1427 END Write;
1428
1429 PROCEDURE (f : FileOutput) WriteIdent(str : ARRAY OF CHAR),EXTENSIBLE;
1430 BEGIN
1431   GPText.WriteString(f.file,str);
1432 END WriteIdent;
1433
1434 PROCEDURE (f : FileOutput) WriteImport(impMod : Module),EXTENSIBLE;
1435 BEGIN
1436   GPText.WriteString(f.file,impMod.name);
1437 END WriteImport;
1438
1439 PROCEDURE (f : FileOutput) WriteString(str : ARRAY OF CHAR),EXTENSIBLE;
1440 BEGIN
1441   GPText.WriteString(f.file,str);
1442 END WriteString;
1443
1444 PROCEDURE (f : FileOutput) WriteLn(),EXTENSIBLE;
1445 BEGIN
1446   GPText.WriteLn(f.file);
1447 END WriteLn;
1448
1449 PROCEDURE (f : FileOutput) WriteInt(i : INTEGER),EXTENSIBLE;
1450 BEGIN
1451   GPText.WriteInt(f.file,i,1);
1452 END WriteInt;
1453
1454 PROCEDURE (f : FileOutput) WriteLong(l : LONGINT),EXTENSIBLE;
1455 BEGIN
1456   GPText.WriteLong(f.file,l,1);
1457 END WriteLong;
1458
1459 PROCEDURE (f : FileOutput) WriteKeyword(str : ARRAY OF CHAR),EXTENSIBLE;
1460 BEGIN
1461   GPText.WriteString(f.file,str);
1462 END WriteKeyword;
1463
1464 PROCEDURE (f : FileOutput) Indent(i : INTEGER),EXTENSIBLE;
1465 BEGIN
1466   WHILE i > 0 DO
1467     GPText.Write(f.file,' ');
1468     DEC(i);
1469   END;
1470 END Indent;
1471
1472 PROCEDURE (f : FileOutput) WriteImportedTypeName(impMod : Module;
1473                                                  tName : ARRAY OF CHAR),EXTENSIBLE;
1474 BEGIN
1475   GPText.WriteString(f.file,impMod.name^ + "." + tName);
1476 END WriteImportedTypeName;
1477
1478 PROCEDURE (f : FileOutput) WriteTypeName(tName : ARRAY OF CHAR),EXTENSIBLE;
1479 BEGIN
1480   GPText.WriteString(f.file,tName);
1481 END WriteTypeName;
1482
1483 PROCEDURE (f : FileOutput) WriteTypeDecl(tName : ARRAY OF CHAR),EXTENSIBLE;
1484 BEGIN
1485   GPText.WriteString(f.file,tName);
1486 END WriteTypeDecl;
1487
1488 (* ------------------------------------------------------------------- *)
1489
1490 PROCEDURE (h : HtmlOutput) WriteStart(mod : Module);
1491 BEGIN
1492   GPText.WriteString(h.file,"<html><head><title>");
1493   GPText.WriteString(h.file,mod.name);
1494   GPText.WriteString(h.file,"</title></head>");
1495   GPText.WriteLn(h.file);
1496   GPText.WriteString(h.file,'<body bgcolor="white">');
1497   GPText.WriteLn(h.file);
1498   GPText.WriteString(h.file,"<hr><pre>");
1499   GPText.WriteLn(h.file);
1500 END WriteStart;
1501
1502 PROCEDURE (h : HtmlOutput) WriteEnd();
1503 BEGIN
1504   GPText.WriteString(h.file,"</font></pre></hr></body></html>");
1505   GPText.WriteLn(h.file);
1506 END WriteEnd;
1507
1508 PROCEDURE (h : HtmlOutput) Write(ch : CHAR);
1509 BEGIN
1510   GPText.Write(h.file,ch);
1511 END Write;
1512
1513 PROCEDURE (h : HtmlOutput) WriteImport(impMod : Module);
1514 BEGIN
1515   GPText.WriteString(h.file,'<a href="');
1516   IF impMod.pathName = NIL THEN
1517     GPText.WriteString(h.file,impMod.name);
1518   ELSE
1519     GPText.WriteString(h.file,impMod.pathName);
1520   END;
1521   GPText.WriteString(h.file,'.html">');
1522   GPText.WriteString(h.file,impMod.name);
1523   GPText.WriteString(h.file,'</a>');
1524 END WriteImport;
1525
1526 PROCEDURE (h : HtmlOutput) WriteIdent(str : ARRAY OF CHAR);
1527 BEGIN
1528   GPText.WriteString(h.file,'<font color="#cc0033">');
1529   GPText.WriteString(h.file,str);
1530   GPText.WriteString(h.file,"</font>");
1531 END WriteIdent;
1532
1533 PROCEDURE (h : HtmlOutput) WriteString(str : ARRAY OF CHAR);
1534 BEGIN
1535   GPText.WriteString(h.file,str);
1536 END WriteString;
1537
1538 PROCEDURE (h : HtmlOutput) WriteLn();
1539 BEGIN
1540   GPText.WriteLn(h.file);
1541 END WriteLn;
1542
1543 PROCEDURE (h : HtmlOutput) WriteInt(i : INTEGER );
1544 BEGIN
1545   GPText.WriteInt(h.file,i,1);
1546 END WriteInt;
1547
1548 PROCEDURE (h : HtmlOutput) WriteLong(l : LONGINT);
1549 BEGIN
1550   GPText.WriteLong(h.file,l,1);
1551 END WriteLong;
1552
1553 PROCEDURE (h : HtmlOutput) WriteKeyword(str : ARRAY OF CHAR);
1554 BEGIN
1555   GPText.WriteString(h.file,"<b>" + str + "</b>");
1556 END WriteKeyword;
1557
1558 PROCEDURE (h : HtmlOutput) Indent(i : INTEGER);
1559 BEGIN
1560   WHILE i > 0 DO
1561     GPText.Write(h.file,' ');
1562     DEC(i);
1563   END;
1564 END Indent;
1565
1566 PROCEDURE (h : HtmlOutput) WriteImportedTypeName(impMod : Module;
1567                                                  tName : ARRAY OF CHAR);
1568 BEGIN
1569   GPText.WriteString(h.file,'<a href="');
1570   IF impMod.pathName = NIL THEN
1571     GPText.WriteString(h.file,impMod.name);
1572   ELSE
1573     GPText.WriteString(h.file,impMod.pathName);
1574   END;
1575   GPText.WriteString(h.file,'.html#type-');;
1576   GPText.WriteString(h.file,tName);
1577   GPText.WriteString(h.file,'">');
1578   GPText.WriteString(h.file,impMod.name^ + "." + tName);
1579   GPText.WriteString(h.file,'</a>');
1580 END WriteImportedTypeName;
1581
1582 PROCEDURE (h : HtmlOutput) WriteTypeName(tName : ARRAY OF CHAR);
1583 BEGIN
1584   GPText.WriteString(h.file,'<a href="#type-');;
1585   GPText.WriteString(h.file,tName);
1586   GPText.WriteString(h.file,'">');
1587   GPText.WriteString(h.file,tName);
1588   GPText.WriteString(h.file,'</a>');
1589 END WriteTypeName;
1590
1591 PROCEDURE (h : HtmlOutput) WriteTypeDecl(tName : ARRAY OF CHAR);
1592 BEGIN
1593   GPText.WriteString(h.file,'<a name="type-');
1594   GPText.WriteString(h.file,tName);
1595   GPText.WriteString(h.file,'"></a>');
1596   GPText.WriteString(h.file,'<font color="#cc0033">');
1597   GPText.WriteString(h.file,tName);
1598   GPText.WriteString(h.file,"</font>");
1599 END WriteTypeDecl;
1600
1601 (* FIXME *)
1602 PROCEDURE (h : HtmlOutput) MethRef(IN nam : ARRAY OF CHAR);
1603 BEGIN
1604   GPText.WriteString(h.file, '    <a href="#meths-');;
1605   GPText.WriteString(h.file, nam);
1606   GPText.WriteString(h.file, '">');
1607   GPText.WriteString(h.file, '<font color="#cc0033">');
1608   GPText.WriteString(h.file, "(* Typebound Procedures *)");
1609   GPText.WriteString(h.file, "</font>");
1610   GPText.WriteString(h.file, '</a>');
1611 END MethRef;
1612
1613 PROCEDURE (h : HtmlOutput) MethAnchor(IN nam : ARRAY OF CHAR);
1614 BEGIN
1615   GPText.WriteString(h.file, '<a name="meths-');
1616   GPText.WriteString(h.file, nam);
1617   GPText.WriteString(h.file, '"></a>');
1618 END MethAnchor;
1619 (* FIXME *)
1620
1621 (* ==================================================================== *)
1622 (*                              Format Helpers                          *)
1623 (* ==================================================================== *)
1624
1625   PROCEDURE qStrOf(str : CharOpen) : CharOpen;
1626     VAR len : INTEGER;
1627         idx : INTEGER;
1628         ord : INTEGER;
1629         rslt : LitValue.CharVector;
1630     (* -------------------------------------- *)
1631     PROCEDURE hexDigit(d : INTEGER) : CHAR;
1632     BEGIN
1633       IF d < 10 THEN RETURN CHR(d + ORD('0'))
1634       ELSE RETURN CHR(d-10 + ORD('a'));
1635       END;
1636     END hexDigit;
1637     (* -------------------------------------- *)
1638     PROCEDURE AppendHex2D(r : LitValue.CharVector; o : INTEGER);
1639     BEGIN
1640       APPEND(r, '\');
1641       APPEND(r, 'x');
1642       APPEND(r, hexDigit(o DIV 16 MOD 16));
1643       APPEND(r, hexDigit(o        MOD 16));
1644     END AppendHex2D;
1645     (* -------------------------------------- *)
1646     PROCEDURE AppendUnicode(r : LitValue.CharVector; o : INTEGER);
1647     BEGIN
1648       APPEND(r, '\');
1649       APPEND(r, 'u');
1650       APPEND(r, hexDigit(o DIV 1000H MOD 16));
1651       APPEND(r, hexDigit(o DIV  100H MOD 16));
1652       APPEND(r, hexDigit(o DIV   10H MOD 16));
1653       APPEND(r, hexDigit(o           MOD 16));
1654     END AppendUnicode;
1655     (* -------------------------------------- *)
1656   BEGIN
1657    (*
1658     *  Translate the string into ANSI-C like
1659     *  for human, rather than machine consumption.
1660     *)
1661     NEW(rslt, LEN(str) * 2);
1662     APPEND(rslt, '"');
1663     FOR idx := 0 TO LEN(str) - 2 DO
1664       ord := ORD(str[idx]);
1665       CASE ord OF
1666       |  0 : APPEND(rslt, '\');
1667              APPEND(rslt, '0');
1668       |  9 : APPEND(rslt, '\');
1669              APPEND(rslt, 't');
1670       | 10 : APPEND(rslt, '\');
1671              APPEND(rslt, 'n');
1672       | 12 : APPEND(rslt, '\');
1673              APPEND(rslt, 'r');
1674       | ORD('"') :
1675              APPEND(rslt, '/');
1676              APPEND(rslt, '"');
1677       ELSE
1678         IF ord > 0FFH THEN AppendUnicode(rslt, ord);
1679         ELSIF (ord > 07EH) OR (ord < ORD(' ')) THEN AppendHex2D(rslt, ord);
1680         ELSE APPEND(rslt, CHR(ord));
1681         END;
1682       END;
1683     END;
1684     APPEND(rslt, '"');
1685     APPEND(rslt, 0X);
1686     RETURN LitValue.chrVecToCharOpen(rslt);
1687   END qStrOf;
1688
1689   PROCEDURE hexOf(ch : CHAR) : CharOpen;
1690     VAR res : CharOpen;
1691         idx : INTEGER;
1692         ord : INTEGER;
1693     (* -------------------------------------- *)
1694     PROCEDURE hexDigit(d : INTEGER) : CHAR;
1695     BEGIN
1696       IF d < 10 THEN RETURN CHR(d + ORD('0'))
1697       ELSE RETURN CHR(d-10 + ORD('A'));
1698       END;
1699     END hexDigit;
1700     (* -------------------------------------- *)
1701   BEGIN
1702     ord := ORD(ch);
1703     IF ord <= 7FH THEN
1704       NEW(res, 4); res[3] := 0X; res[2] := "X";
1705       res[1] := hexDigit(ord MOD 16);
1706       res[0] := hexDigit(ord DIV 16);
1707     ELSIF ord <= 0FFH THEN
1708       NEW(res, 5); res[4] := 0X; res[3] := "X";
1709       res[2] := hexDigit(ord MOD 16);
1710       res[1] := hexDigit(ord DIV 16);
1711       res[0] := "0";
1712     ELSIF ord <= 07FFFH THEN
1713       NEW(res, 10); res[9] := 0X; res[8] := "X";
1714       FOR idx := 7 TO 0 BY -1 DO
1715         res[idx] := hexDigit(ord MOD 16); ord := ord DIV 16;
1716       END;
1717     ELSE
1718       NEW(res, 11); res[10] := 0X; res[9] := "X";
1719       FOR idx := 8 TO 0 BY -1 DO
1720         res[idx] := hexDigit(ord MOD 16); ord := ord DIV 16;
1721       END;
1722     END;
1723     RETURN res;
1724   END hexOf;
1725
1726 (* ==================================================================== *)
1727
1728   PROCEDURE LongToHex(n : LONGINT) : CharOpen;
1729     VAR arr : ARRAY 40 OF CHAR;
1730         idx : INTEGER;
1731    (* -------------------------------------- *)
1732     PROCEDURE hexDigit(d : INTEGER) : CHAR;
1733     BEGIN
1734       IF d < 10 THEN RETURN CHR(d + ORD('0'))
1735       ELSE RETURN CHR(d-10 + ORD('a'));
1736       END;
1737     END hexDigit;
1738    (* -------------------------------------- *)
1739     PROCEDURE DoDigit(n : LONGINT;
1740                   VAR a : ARRAY OF CHAR;
1741                   VAR i : INTEGER);
1742     BEGIN
1743       ASSERT(n >= 0);
1744       IF n > 15 THEN
1745         DoDigit(n DIV 16, a, i);
1746         a[i] := hexDigit(SHORT(n MOD 16)); INC(i);
1747       ELSIF n > 9 THEN
1748         a[0] := '0';
1749         a[1] := hexDigit(SHORT(n)); i := 2;
1750       ELSE
1751         a[0] := hexDigit(SHORT(n)); i := 1;
1752       END;
1753     END DoDigit;
1754    (* -------------------------------------- *)
1755   BEGIN
1756     idx := 0;
1757     DoDigit(n, arr, idx);
1758     arr[idx] := 'H'; INC(idx); arr[idx] := 0X;
1759     RETURN BOX(arr);
1760   END LongToHex;
1761
1762 (* ==================================================================== *)
1763
1764   PROCEDURE Length(a : ARRAY OF CHAR) : INTEGER;
1765   VAR i : INTEGER;
1766   BEGIN
1767     i := 0;
1768     WHILE (a[i] # 0X) & (i < LEN(a)) DO INC(i); END;
1769     RETURN i;
1770   END Length;
1771
1772   PROCEDURE (v : AbsValue) Print(),NEW,EMPTY;
1773
1774   PROCEDURE (n : NumValue) Print();
1775   BEGIN
1776     IF hexCon & (n.numVal >= 0) THEN
1777       output.WriteString(LongToHex(n.numVal));
1778     ELSE
1779       output.WriteLong(n.numVal);
1780     END;
1781   END Print;
1782
1783   PROCEDURE (f : FltValue) Print();
1784   VAR
1785     str : ARRAY 30 OF CHAR;
1786   BEGIN
1787     RTS.RealToStr(f.fltVal,str);
1788     output.WriteString(str);
1789   END Print;
1790
1791   PROCEDURE (s : SetValue) Print();
1792   VAR
1793     i,j,k : INTEGER;
1794     first : BOOLEAN;
1795     inSet : BOOLEAN;
1796    (* ----------------------------------- *)
1797     PROCEDURE WriteRange(j,k:INTEGER; VAR f : BOOLEAN);
1798     BEGIN
1799       IF f THEN f := FALSE ELSE output.Write(',') END;
1800       output.WriteInt(j);
1801       CASE k-j OF
1802       | 0 : (* skip *)
1803       | 1 : output.Write(',');
1804             output.WriteInt(k);
1805       ELSE  output.WriteString('..');
1806             output.WriteInt(k);
1807       END;
1808     END WriteRange;
1809    (* ----------------------------------- *)
1810   BEGIN  (* this is an FSA with two states *)
1811     output.Write("{");
1812     first := TRUE;  inSet := FALSE; j := 0; k := 0;
1813     FOR i := 0 TO MAX(SET) DO
1814       IF inSet THEN
1815         IF i IN s.setVal THEN k := i;
1816         ELSE inSet := FALSE; WriteRange(j,k,first);
1817         END;
1818       ELSE
1819         IF i IN s.setVal THEN inSet := TRUE; j := i; k := i END;
1820       END;
1821     END;
1822     IF k = MAX(SET) THEN WriteRange(j,k,first) END;
1823     output.Write("}");
1824   END Print;
1825
1826   PROCEDURE (c : ChrValue) Print();
1827   BEGIN
1828     IF (c.chrVal <= " ") OR (c.chrVal > 7EX) THEN
1829       output.WriteString(hexOf(c.chrVal));
1830     ELSE
1831       output.Write("'");
1832       output.Write(c.chrVal);
1833       output.Write("'");
1834     END;
1835   END Print;
1836
1837   PROCEDURE (s : StrValue) Print();
1838   BEGIN
1839     output.WriteString(qStrOf(s.strVal));
1840   END Print;
1841
1842   PROCEDURE (b : BoolValue) Print();
1843   BEGIN
1844     IF b.boolVal THEN
1845       output.WriteString("TRUE");
1846     ELSE
1847       output.WriteString("FALSE");
1848     END;
1849   END Print;
1850
1851   PROCEDURE (t : Type) PrintType(indent : INTEGER),NEW,EMPTY;
1852
1853   PROCEDURE (t : Type) Print(indent : INTEGER;details : BOOLEAN),NEW,EXTENSIBLE;
1854   BEGIN
1855     IF t.importedFrom # NIL THEN
1856       IF t.importedFrom = output.thisMod THEN
1857         output.WriteKeyword(t.importedName);
1858       ELSE
1859         output.WriteImportedTypeName(t.importedFrom, t.importedName);
1860       END;
1861       RETURN;
1862     END;
1863
1864     IF ~details & (t.declarer # NIL) THEN
1865       output.WriteTypeName(t.declarer.name);
1866     ELSE
1867       t.PrintType(indent);
1868     END;
1869   END Print;
1870
1871   PROCEDURE (b : Basic) Print(indent : INTEGER; details : BOOLEAN);
1872   BEGIN
1873     output.WriteString(b.name);
1874   END Print;
1875
1876   PROCEDURE^ PrintList(indent : INTEGER; dl : DescList; xLine : BOOLEAN);
1877
1878   PROCEDURE (e : Enum) PrintType(indent : INTEGER),EXTENSIBLE;
1879   VAR
1880     i : INTEGER;
1881   BEGIN
1882     output.WriteKeyword("ENUM");  output.WriteLn;
1883     PrintList(indent+2,e.ids,FALSE);
1884     output.Indent(indent);
1885     output.WriteKeyword("END");
1886   END PrintType;
1887
1888   PROCEDURE printBaseType(r : Record) : BOOLEAN;
1889   VAR
1890     pType : Pointer;
1891   BEGIN
1892     IF r.intrFaces.tide # 0 THEN RETURN TRUE END;
1893     IF (r.baseType # NIL) & ~(r.baseType IS Basic) THEN
1894       IF (r.baseType IS Pointer) THEN
1895         RETURN ~r.baseType(Pointer).isAnonPointer;
1896       END;
1897       IF (r.baseType IS Record) & (r.baseType(Record).isAnonRec) THEN
1898         pType := r.baseType(Record).ptrType;
1899         IF (pType = NIL) OR (pType.isAnonPointer) THEN
1900           RETURN FALSE;
1901         END;
1902       END;
1903       RETURN TRUE;
1904     ELSE RETURN FALSE;
1905     END;
1906   END printBaseType;
1907
1908   PROCEDURE (r : Record) PrintType(indent : INTEGER),EXTENSIBLE;
1909   CONST
1910     eStr = "EXTENSIBLE ";
1911     aStr = "ABSTRACT ";
1912     lStr = "LIMITED ";
1913     iStr = "INTERFACE ";
1914     vStr = "(* vlCls *) ";
1915     nStr = "(* noNew *) ";
1916   VAR
1917     rStr : ARRAY 12 OF CHAR;
1918     iTyp : Type;
1919     i    : INTEGER;
1920     fLen : INTEGER;
1921     fNum : INTEGER;
1922     sLen : INTEGER;
1923
1924     PROCEDURE maxFldLen(r : Record) : INTEGER;
1925       VAR j,l,m : INTEGER;
1926     BEGIN
1927       m := 0;
1928       FOR j := 0 TO r.fields.tide-1 DO
1929         l := LEN(r.fields.list[j].name$);
1930         m := MAX(l,m);
1931       END;
1932       RETURN m;
1933     END maxFldLen;
1934
1935     PROCEDURE fieldNumber(VAR lst : DescList) : INTEGER;
1936       VAR count : INTEGER;
1937     BEGIN
1938       count := 0;
1939       FOR count := 0 TO lst.tide - 1 DO
1940         IF lst.list[count] IS ProcDesc THEN RETURN count END;
1941       END;
1942       RETURN lst.tide;
1943     END fieldNumber;
1944
1945   BEGIN
1946     CASE r.recAtt MOD 8 OF
1947     | 1 : rStr := aStr;
1948     | 2 : rStr := lStr;
1949     | 3 : rStr := eStr;
1950     | 4 : rStr := iStr;
1951     ELSE  rStr := "";
1952     END;
1953     IF printFNames THEN
1954       IF r.recAtt DIV 8 = 1 THEN output.WriteString(nStr);
1955       ELSIF r.recAtt DIV 16 = 1 THEN output.WriteString(vStr);
1956       END;
1957     END;
1958     output.WriteKeyword(rStr + "RECORD");
1959     IF printBaseType(r) THEN
1960       output.WriteString(" (");
1961       IF (r.baseType IS Record) & (r.baseType(Record).ptrType # NIL) THEN
1962         r.baseType(Record).ptrType.Print(0,FALSE);
1963       ELSIF r.baseType = NIL THEN
1964         output.WriteString("ANYPTR");
1965       ELSE
1966         r.baseType.Print(0,FALSE);
1967       END;
1968      (* ##### *)
1969       FOR i := 0 TO r.intrFaces.tide-1 DO
1970         output.WriteString(" + ");
1971         iTyp := r.intrFaces.list[i](TypeDesc).type;
1972         IF (iTyp IS Record) & (iTyp(Record).ptrType # NIL) THEN
1973           iTyp(Record).ptrType.Print(0,FALSE);
1974         ELSE
1975           iTyp.Print(0,FALSE);
1976         END;
1977       END;
1978      (* ##### *)
1979       output.WriteString(")");
1980     END;
1981
1982 (* FIXME *)
1983     IF r.methods.tide > 0 THEN
1984       IF r.declarer # NIL THEN
1985         output.MethRef(r.declarer.name);
1986       ELSIF (r.ptrType # NIL) & (r.ptrType.declarer # NIL) THEN
1987         output.MethRef(r.ptrType.declarer.name);
1988       END;
1989     END;
1990 (* FIXME *)
1991
1992     output.WriteLn;
1993     fLen := maxFldLen(r);
1994     FOR i := 0 TO r.fields.tide-1 DO
1995       output.Indent(indent+2);
1996       output.WriteIdent(r.fields.list[i].name);
1997       output.Write(accArray[r.fields.list[i].access]);
1998       output.Indent(fLen - LEN(r.fields.list[i].name$));
1999       output.WriteString(" : ");
2000       r.fields.list[i](VarDesc).type.Print(indent + fLen + 6, FALSE);
2001       output.Write(';'); output.WriteLn;
2002     END;
2003     IF r.statics.tide > 0 THEN
2004       IF alpha THEN
2005         sLen := r.statics.tide - 1;
2006         fNum := fieldNumber(r.statics);
2007         IF fNum > 1    THEN QuickSortDescs(0, fNum-1, r.statics) END;
2008         IF fNum < sLen THEN QuickSortDescs(fNum, sLen, r.statics) END;
2009       END;
2010       output.Indent(indent);
2011       output.WriteKeyword("STATIC"); output.WriteLn;
2012       PrintList(indent+2, r.statics, FALSE);
2013     END;
2014     output.Indent(indent);
2015     output.WriteKeyword("END");
2016   END PrintType;
2017
2018   PROCEDURE (a : Array) PrintType(indent : INTEGER),EXTENSIBLE;
2019   BEGIN
2020     output.WriteKeyword("ARRAY ");
2021     IF a.size > 0 THEN output.WriteInt(a.size);  output.Write(' '); END;
2022     output.WriteKeyword("OF ");
2023     a.elemType.Print(indent,FALSE);
2024   END PrintType;
2025
2026   PROCEDURE (a : Vector) PrintType(indent : INTEGER),EXTENSIBLE;
2027   BEGIN
2028     output.WriteKeyword("VECTOR ");
2029     output.WriteKeyword("OF ");
2030     a.elemType.Print(indent,FALSE);
2031   END PrintType;
2032
2033   PROCEDURE PrintPar(p : Par; num, indent, pLen : INTEGER; noModes : BOOLEAN);
2034     VAR extra : INTEGER;
2035   BEGIN
2036     extra := pLen+3;
2037     output.Indent(indent);
2038     IF ~noModes THEN
2039       INC(extra, 4);
2040       CASE p.mode OF
2041       | 1 : output.WriteString("IN  ");
2042       | 2 : output.WriteString("OUT ");
2043       | 3 : output.WriteString("VAR ");
2044       ELSE  output.WriteString("    ");
2045       END;
2046     END;
2047     IF p.opNm = NIL THEN
2048       output.WriteString("p");
2049       output.WriteInt(num);
2050       IF num > 9 THEN output.Indent(pLen-3) ELSE output.Indent(pLen-2) END;
2051     ELSE
2052       output.WriteString(p.opNm);
2053       output.Indent(pLen - LEN(p.opNm$));
2054     END;
2055     output.WriteString(" : ");
2056     p.type.Print(indent+extra,FALSE);
2057   END PrintPar;
2058
2059   PROCEDURE PrintFormals(p : Proc; indent : INTEGER);
2060   VAR
2061     i    : INTEGER;
2062     pLen : INTEGER;
2063
2064     PROCEDURE maxParLen(p : Proc) : INTEGER;
2065       VAR j,l,m : INTEGER;
2066     BEGIN
2067       m := 0;
2068       FOR j := 0 TO p.pars.tide-1 DO
2069         IF p.pars.list[j].opNm # NIL THEN
2070           l := LEN(p.pars.list[j].opNm$);
2071         ELSIF j > 9 THEN
2072           l := 3;
2073         ELSE
2074           l := 2;
2075         END;
2076         m := MAX(m,l);
2077       END;
2078       RETURN m;
2079     END maxParLen;
2080
2081   BEGIN
2082     output.Write('(');
2083     IF p.pars.tide > 0 THEN
2084       pLen := maxParLen(p);
2085       PrintPar(p.pars.list[0],0,0, pLen, p.noModes);
2086       FOR i := 1 TO p.pars.tide-1 DO
2087         output.Write(';');
2088         output.WriteLn;
2089         PrintPar(p.pars.list[i], i, indent+1, pLen, p.noModes);
2090       END;
2091     END;
2092     output.Write(')');
2093     IF p.retType # NIL THEN
2094       output.WriteString(' : ');
2095       p.retType.Print(indent,FALSE);
2096     END;
2097   END PrintFormals;
2098
2099  (* ----------------------------------------------------------- *)
2100
2101   PROCEDURE (p : Proc) PrintType(indent : INTEGER),EXTENSIBLE;
2102   BEGIN
2103     output.WriteKeyword("PROCEDURE");
2104     PrintFormals(p, indent+9);
2105   END PrintType;
2106
2107  (* ----------------------------------------------------------- *)
2108
2109   PROCEDURE (p : Proc) PrintProc(indent : INTEGER),NEW;
2110   BEGIN
2111     output.Indent(indent);
2112     output.WriteKeyword("PROCEDURE ");
2113     output.WriteIdent(p.declarer.name);
2114     output.Write(accArray[p.declarer.access]);
2115     IF printFNames & (p.fName # NIL) THEN
2116       output.WriteString('["' + p.fName^ + '"]');
2117       INC(indent,Length(p.fName)+4);
2118     END;
2119     PrintFormals(p,indent+11+Length(p.declarer.name));
2120     IF p.isConstructor THEN output.WriteKeyword(",CONSTRUCTOR"); END;
2121     output.WriteString(";"); output.WriteLn;
2122   END PrintProc;
2123
2124  (* ----------------------------------------------------------- *)
2125
2126   PROCEDURE (m : Meth) PrintType(indent : INTEGER),EXTENSIBLE;
2127   BEGIN
2128     output.WriteLn;
2129     output.WriteKeyword("PROCEDURE ");
2130     output.Write("(");
2131     IF m.recMode = 1 THEN
2132       output.WriteString("IN ");
2133       INC(indent,3);
2134     ELSIF m.recMode = 3 THEN
2135       output.WriteString("VAR ");
2136       INC(indent,4);
2137     END;
2138     IF m.recName = NIL THEN
2139       output.WriteString("self");
2140       INC(indent,4);
2141     ELSE
2142       output.WriteString(m.recName);
2143       INC(indent,LEN(m.recName$));
2144     END;
2145     output.WriteString(":");
2146     ASSERT(m.receiver.importedFrom = NIL);
2147     output.WriteString(m.receiver.declarer.name);
2148     output.WriteString(") ");
2149     output.WriteIdent(m.declarer.name);
2150     output.Write(accArray[m.declarer.access]);
2151     IF printFNames & (m.fName # NIL) THEN
2152       output.WriteString('["' + m.fName^ + '"]');
2153       INC(indent,Length(m.fName)+4);
2154     END;
2155     PrintFormals(m, indent + 15 +
2156                     Length(m.declarer.name)+
2157                     Length(m.receiver.declarer.name));
2158
2159     CASE m.attr OF
2160     | 1 : output.WriteKeyword(",NEW");
2161     | 2 : output.WriteKeyword(",ABSTRACT");
2162     | 3 : output.WriteKeyword(",NEW,ABSTRACT");
2163     | 4 : output.WriteKeyword(",EMPTY");
2164     | 5 : output.WriteKeyword(",NEW,EMPTY");
2165     | 6 : output.WriteKeyword(",EXTENSIBLE");
2166     | 7 : output.WriteKeyword(",NEW,EXTENSIBLE");
2167     ELSE  (* nothing *)
2168     END;
2169     output.WriteString(";"); output.WriteLn;
2170   END PrintType;
2171
2172   PROCEDURE (p : Pointer) PrintType(indent : INTEGER),EXTENSIBLE;
2173   BEGIN
2174     output.WriteKeyword("POINTER TO ");
2175     p.baseType.Print(indent,FALSE);
2176   END PrintType;
2177
2178   PROCEDURE (p : Event) PrintType(indent : INTEGER);
2179   BEGIN
2180     output.WriteKeyword("EVENT");
2181     PrintFormals(p, indent+5);
2182   END PrintType;
2183
2184   PROCEDURE PrintList(indent : INTEGER; dl : DescList; xLine : BOOLEAN);
2185   VAR
2186     i : INTEGER;
2187     d : Desc;
2188     m : INTEGER;
2189    (* ----------------------------------------------- *)
2190     PROCEDURE notHidden(d : Desc) : BOOLEAN;
2191     BEGIN
2192       RETURN verbatim OR ((d.name[0] # "@") & (d.name[0] # "$"));
2193     END notHidden;
2194    (* ----------------------------------------------- *)
2195     PROCEDURE maxNamLen(dl : DescList) : INTEGER;
2196       VAR j,l,m : INTEGER;
2197           d     : Desc;
2198     BEGIN
2199       m := 0;
2200       FOR j := 0 TO dl.tide-1 DO
2201         d := dl.list[j];
2202         IF notHidden(d) THEN m := MAX(m, LEN(d.name$)) END;
2203       END;
2204       RETURN m;
2205     END maxNamLen;
2206    (* ----------------------------------------------- *)
2207   BEGIN
2208     m := maxNamLen(dl);
2209     FOR i := 0 TO dl.tide -1 DO
2210       d := dl.list[i];
2211       IF ~notHidden(d) THEN
2212         (* skip *)
2213       ELSIF d IS ProcDesc THEN
2214         d(ProcDesc).pType.PrintProc(indent);
2215         IF xLine THEN output.WriteLn; END;
2216       ELSE
2217         output.Indent(indent);
2218         IF d IS TypeDesc THEN
2219           output.WriteTypeDecl(d.name);
2220         ELSE
2221           output.WriteIdent(d.name);
2222         END;
2223         output.Write(accArray[d.access]);
2224
2225         IF (d IS VarDesc) OR (d IS ConstDesc) THEN
2226           output.Indent(m - LEN(d.name$));
2227         END;
2228
2229         WITH d : ConstDesc DO
2230             output.WriteString(" = ");
2231             d.val.Print();
2232         | d : TypeDesc DO
2233           IF d IS VarDesc THEN
2234             output.WriteString(" : ");
2235           ELSE
2236             output.WriteString(" = ");
2237           END;
2238           d.type.Print(Length(d.name)+6, d IS UserTypeDesc);
2239         END;
2240         output.Write(";");
2241         output.WriteLn;
2242         IF xLine THEN output.WriteLn; END;
2243       END;
2244     END;
2245   END PrintList;
2246
2247 (* ==================================================================== *)
2248
2249   PROCEDURE PrintDigest(i0,i1 : INTEGER);
2250     VAR buffer : ARRAY 17 OF CHAR;
2251         index  : INTEGER;
2252    (* ------------------------------------ *)
2253     PROCEDURE hexRep(i : INTEGER) : CHAR;
2254     BEGIN
2255       i := ORD(BITS(i) * {0..3});
2256       IF i <= 9 THEN RETURN CHR(ORD("0") + i);
2257       ELSE RETURN CHR(ORD("A") - 10 + i);
2258       END;
2259     END hexRep;
2260    (* ------------------------------------ *)
2261   BEGIN
2262     IF (i0 = 0) & (i1 = 0) THEN RETURN END;
2263     output.Write(" "); output.Write("[");
2264     FOR index := 7 TO 0 BY -1 DO
2265       buffer[index] := hexRep(i0); i0 := i0 DIV 16;
2266     END;
2267     FOR index := 15 TO 8 BY -1 DO
2268       buffer[index] := hexRep(i1); i1 := i1 DIV 16;
2269     END;
2270     buffer[16] := 0X;
2271     output.WriteString(buffer);
2272     output.Write("]");
2273   END PrintDigest;
2274
2275 (* ==================================================================== *)
2276
2277   PROCEDURE PrintModule(mod : Module);
2278   VAR
2279     i,j : INTEGER;
2280     ty : Type;
2281     rec : Record;
2282     first : BOOLEAN;
2283     heading : ARRAY 20 OF CHAR;
2284     (* --------------------------- *)
2285     PROCEDURE WriteOptionalExtras(impMod : Module);
2286     BEGIN
2287       IF impMod.fName # NIL THEN
2288         IF printFNames THEN
2289           output.WriteString(' (* "' + impMod.fName^ + '" *)');
2290         ELSE
2291           output.WriteString(' := "' + impMod.fName^ + '"');
2292         END;
2293       END;
2294     END WriteOptionalExtras;
2295     (* --------------------------- *)
2296   BEGIN
2297
2298     IF (mod.types.tide > 0) & alpha THEN
2299       QuickSortDescs(0, mod.types.tide-1, mod.types);
2300     END;
2301
2302     output.WriteStart(mod);
2303     IF mod.systemMod THEN
2304       heading := "SYSTEM ";
2305     ELSIF mod.fName # NIL THEN
2306       heading := "FOREIGN ";
2307     ELSE
2308       heading := "";
2309     END;
2310     heading := heading + "MODULE ";
2311     output.WriteKeyword(heading);
2312     output.WriteIdent(mod.name);
2313     IF printFNames & (mod.fName # NIL) THEN
2314       output.WriteString(' ["' + mod.fName^ + '"]');
2315     END;
2316     output.Write(';');
2317    (*
2318     *  Optional strong name goes here.
2319     *)
2320     IF mod.strongNm # NIL THEN
2321       output.WriteLn;
2322       output.WriteString("    (* version ");
2323       output.WriteInt(mod.strongNm[0]); output.Write(":");
2324       output.WriteInt(mod.strongNm[1]); output.Write(":");
2325       output.WriteInt(mod.strongNm[2]); output.Write(":");
2326       output.WriteInt(mod.strongNm[3]);
2327       PrintDigest(mod.strongNm[4], mod.strongNm[5]);
2328       output.WriteString(" *)");
2329     END;
2330    (*  end optional strong name.  *)
2331     output.WriteLn; output.WriteLn;
2332     IF mod.imports.tide > 1 THEN
2333       output.WriteKeyword("IMPORT"); output.WriteLn;
2334       output.Indent(4);
2335       output.WriteImport(mod.imports.list[1]);
2336       WriteOptionalExtras(mod.imports.list[1]);
2337       FOR i := 2 TO mod.imports.tide -1 DO
2338         output.Write(','); output.WriteLn;
2339         output.Indent(4);
2340         output.WriteImport(mod.imports.list[i]);
2341         WriteOptionalExtras(mod.imports.list[i]);
2342       END;
2343       output.Write(';'); output.WriteLn;
2344       output.WriteLn;
2345     END;
2346     IF mod.consts.tide > 0 THEN
2347       output.WriteKeyword("CONST"); output.WriteLn;
2348       PrintList(2,mod.consts,FALSE);
2349       output.WriteLn;
2350     END;
2351     IF mod.types.tide > 0 THEN
2352       output.WriteKeyword("TYPE");
2353       output.WriteLn; output.WriteLn;
2354       PrintList(2,mod.types,TRUE);
2355       output.WriteLn;
2356     END;
2357     IF mod.vars.tide > 0 THEN
2358       output.WriteKeyword("VAR"); output.WriteLn;
2359       PrintList(2,mod.vars,FALSE);
2360       output.WriteLn;
2361     END;
2362     FOR i := 0 TO mod.procs.tide -1 DO
2363       output.WriteLn;
2364       mod.procs.list[i](ProcDesc).pType.PrintProc(0);
2365     END;
2366     output.WriteLn;
2367     FOR i := 0 TO mod.types.tide -1 DO
2368       ty := mod.types.list[i](UserTypeDesc).type;
2369       IF ty IS Pointer THEN ty := ty(Pointer).baseType; END;
2370       IF ty IS Record THEN
2371         rec := ty(Record);
2372
2373         IF (rec.methods.tide > 0) & alpha THEN
2374           QuickSortDescs(0, rec.methods.tide-1, rec.methods);
2375         END;
2376
2377 (* FIXME *)
2378         IF rec.methods.tide > 0 THEN
2379           IF rec.declarer # NIL THEN
2380             output.MethAnchor(rec.declarer.name);
2381           ELSIF (rec.ptrType # NIL) & (rec.ptrType.declarer # NIL) THEN
2382             output.MethAnchor(rec.ptrType.declarer.name);
2383           END;
2384         END;
2385 (* FIXME *)
2386
2387         FOR j := 0 TO rec.methods.tide -1 DO
2388           rec.methods.list[j](ProcDesc).pType.PrintType(0);
2389         END;
2390       END;
2391     END;
2392     output.WriteLn;
2393     output.WriteKeyword("END ");
2394     output.WriteIdent(mod.name);
2395     output.Write("."); output.WriteLn;
2396     output.WriteEnd();
2397   END PrintModule;
2398
2399 (* ============================================================ *)
2400
2401   PROCEDURE InitTypes();
2402   VAR
2403     t : Basic;
2404   BEGIN
2405     NEW(typeList,50);
2406     typeList[0] := NIL;
2407     NEW(t); t.name := BOX("BOOLEAN"); typeList[1] := t;
2408     NEW(t); t.name := BOX("SHORTCHAR"); typeList[2] := t;
2409     NEW(t); t.name := BOX("CHAR"); typeList[3] := t;
2410     NEW(t); t.name := BOX("BYTE"); typeList[4] := t;
2411     NEW(t); t.name := BOX("SHORTINT"); typeList[5] := t;
2412     NEW(t); t.name := BOX("INTEGER"); typeList[6] := t;
2413     NEW(t); t.name := BOX("LONGINT"); typeList[7] := t;
2414     NEW(t); t.name := BOX("SHORTREAL"); typeList[8] := t;
2415     NEW(t); t.name := BOX("REAL"); typeList[9] := t;
2416     NEW(t); t.name := BOX("SET"); typeList[10] := t;
2417     NEW(t); t.name := BOX("ANYREC"); typeList[11] := t;
2418     NEW(t); t.name := BOX("ANYPTR"); typeList[12] := t;
2419     NEW(t); t.name := BOX("ARRAY OF CHAR"); typeList[13] := t;
2420     NEW(t); t.name := BOX("ARRAY OF SHORTCHAR"); typeList[14] := t;
2421     NEW(t); t.name := BOX("UBYTE"); typeList[15] := t;
2422 (*
2423  *  NEW(t); t.name := "SPECIAL"; typeList[16] := t;
2424  *)
2425   END InitTypes;
2426
2427   PROCEDURE InitAccArray();
2428   BEGIN
2429     accArray[0] := ' ';
2430     accArray[1] := '*';
2431     accArray[2] := '-';
2432     accArray[3] := '!';
2433   END InitAccArray;
2434
2435 (* ============================================================ *)
2436
2437 PROCEDURE Usage();
2438 BEGIN
2439   Console.WriteString("gardens point Browse: " + GPCPcopyright.verStr);
2440   Console.WriteLn;
2441   IF RTS.defaultTarget = "net" THEN
2442     Console.WriteString("Usage:  Browse [options] <ModuleName>");
2443     Console.WriteLn;
2444     Console.WriteString("Browse Options ... ");
2445     Console.WriteLn;
2446     Console.WriteString(" /all ==> browse this and all imported modules");
2447     Console.WriteLn;
2448     Console.WriteString(" /file ==> write output to a file <ModuleName>.bro ");
2449     Console.WriteLn;
2450     Console.WriteString(" /full ==> display explicit foreign names ");
2451     Console.WriteLn;
2452     Console.WriteString(" /help ==> display this usage message");
2453     Console.WriteLn;
2454     Console.WriteString(" /hex  ==> use hexadecimal for short literals");
2455     Console.WriteLn;
2456     Console.WriteString(
2457                     " /html ==> write html output to file <ModuleName>.html");
2458     Console.WriteLn;
2459     Console.WriteString(" /sort ==> sort procedures and types alphabetically");
2460     Console.WriteLn;
2461     Console.WriteString(" /verbatim ==> display anonymous public type names");
2462     Console.WriteLn;
2463   ELSE                  (* RTS.defaultTarget = "jvm" *)
2464     Console.WriteString("Usage: cprun Browse [options] <ModuleName>");
2465     Console.WriteLn;
2466     Console.WriteString("Browse Options ... ");
2467     Console.WriteLn;
2468     Console.WriteString(" -all ==> browse this and all imported modules");
2469     Console.WriteLn;
2470     Console.WriteString(" -file ==> write output to a file <ModuleName>.bro ");
2471     Console.WriteLn;
2472     Console.WriteString(" -full ==> display explicit foreign names ");
2473     Console.WriteLn;
2474     Console.WriteString(" -help ==> display this usage message");
2475     Console.WriteLn;
2476     Console.WriteString(" -hex  ==> use hexadecimal for short literals");
2477     Console.WriteLn;
2478     Console.WriteString(
2479         " -html ==> write html output to file <ModuleName>.html");
2480     Console.WriteLn;
2481     Console.WriteString(" -sort ==> sort procedures and types alphabetically");
2482     Console.WriteLn;
2483     Console.WriteString(" -verbatim ==> display anonymous public type names");
2484     Console.WriteLn;
2485   END;
2486   HALT(1);
2487 END Usage;
2488
2489 PROCEDURE BadOption(optStr : ARRAY OF CHAR);
2490 BEGIN
2491   Console.WriteString("Unrecognised option: " + optStr);
2492   Console.WriteLn;
2493 END BadOption;
2494
2495 PROCEDURE ParseOptions() : INTEGER;
2496 VAR
2497   argNo : INTEGER;
2498   option : FileNames.NameString;
2499   fOutput : FileOutput;
2500   hOutput : HtmlOutput;
2501   fileOutput, htmlOutput : BOOLEAN;
2502 BEGIN
2503   printFNames := FALSE;
2504   fileOutput := FALSE;
2505   htmlOutput := FALSE;
2506   verbatim := FALSE;
2507   hexCon := FALSE;
2508   doAll := FALSE;
2509   alpha := FALSE;
2510   argNo := 0;
2511   ProgArgs.GetArg(argNo,option);
2512   WHILE (option[0] = '-') OR (option[0] = GPFiles.optChar) DO
2513     INC(argNo);
2514     option[0] := '-';
2515     IF option[1] = 'f' THEN
2516       IF option = "-full" THEN
2517         printFNames := TRUE;
2518       ELSIF option = "-file" THEN
2519         IF htmlOutput THEN
2520           Console.WriteString("Cannot have html and file output");
2521           Console.WriteLn;
2522         ELSE
2523           fileOutput := TRUE;
2524           NEW(fOutput);
2525           output := fOutput;
2526         END;
2527       ELSE
2528         BadOption(option);
2529       END;
2530     ELSIF option[1] = 'v' THEN
2531       IF option = "-verbatim" THEN
2532         verbatim := TRUE;
2533       ELSIF option = "-verbose" THEN
2534         verbose := TRUE;
2535       ELSE
2536         BadOption(option);
2537       END;
2538     ELSIF option = "-all" THEN
2539       doAll := TRUE;
2540     ELSIF option = "-hex" THEN
2541       hexCon := TRUE;
2542     ELSIF option = "-html" THEN
2543       IF fileOutput THEN
2544         Console.WriteString("Cannot have html and file output");
2545         Console.WriteLn;
2546       ELSE
2547         htmlOutput := TRUE;
2548         NEW(hOutput);
2549         output := hOutput;
2550       END;
2551     ELSIF option = "-sort" THEN
2552       alpha := TRUE;
2553     ELSIF option = "-help" THEN
2554       Usage();
2555     ELSE
2556       BadOption(option);
2557     END;
2558     IF argNo < args THEN ProgArgs.GetArg(argNo,option) ELSE RETURN argNo END;
2559   END;
2560   RETURN argNo;
2561 END ParseOptions;
2562
2563 PROCEDURE Print();
2564 VAR
2565   i : INTEGER;
2566 BEGIN
2567   FOR i := 0 TO modList.tide-1 DO
2568     IF modList.list[i].print THEN
2569       output.thisMod := modList.list[i];
2570       IF output IS FileOutput THEN
2571         output(FileOutput).file :=
2572             GPTextFiles.createFile(modList.list[i].name^ + outExt);
2573       END;
2574       PrintModule(modList.list[i]);
2575       IF output IS FileOutput THEN
2576         GPTextFiles.CloseFile(output(FileOutput).file);
2577       END;
2578     END;
2579   END;
2580 RESCUE (x)
2581   Error.WriteString("Error in Parse()"); Error.WriteLn;
2582   Error.WriteString(RTS.getStr(x)); Error.WriteLn;
2583 END Print;
2584
2585 BEGIN
2586   NEW(fileName, 256);
2587   NEW(modName, 256);
2588   InitTypes();
2589   InitAccArray();
2590   modList.tide := 0;
2591   NEW(modList.list,5);
2592   NEW(output);
2593   args := ProgArgs.ArgNumber();
2594   IF (args < 1) THEN Usage(); END;
2595   argNo := ParseOptions();
2596   IF (output IS FileOutput) THEN
2597     IF (output IS HtmlOutput) THEN
2598       outExt := htmlExt;
2599     ELSE
2600       outExt := broExt;
2601     END;
2602   END;
2603   WHILE (argNo < args) DO
2604     ProgArgs.GetArg(argNo,fileName);
2605     GetSymAndModNames(fileName,modName);
2606     module := GetModule(modName);
2607     module.symName := fileName;
2608     module.progArg := TRUE;
2609     INC(argNo);
2610   END;
2611   Parse();
2612   Print();
2613 END Browse.
2614
2615 (* ============================================================ *)