gpcp/OldSymFileRW.cp

   1 (* ==================================================================== *)
   2 (*                                                                      *)
   3 (*  SymFileRW:  Symbol-file reading and writing for GPCP.               *)
   4 (*      Copyright (c) John Gough 1999, 2000.                            *)
   5 (*                                                                      *)
   6 (* ==================================================================== *)
   7
   8 MODULE OldSymFileRW;
   9
  10   IMPORT
  11         GPCPcopyright,
  12         RTS,
  13         Error,
  14         Console,
  15         GF := GPFiles,
  16         BF := GPBinFiles,
  17         Id := IdDesc,
  18         D  := Symbols,
  19         LitValue,
  20         Visitor,
  21         ExprDesc,
  22         Ty := TypeDesc,
  23         B  := Builtin,
  24         S  := CPascalS,
  25         G  := CompState,
  26         Nh := NameHash,
  27         FileNames;
  28
  29 (* ========================================================================= *
  30 // Collected syntax ---
  31 //
  32 // SymFile    = Header [String (falSy | truSy | <other attribute>)]
  33 //              [ VersionName ]
  34 //              {Import | Constant | Variable | Type | Procedure}
  35 //              TypeList Key.
  36 //      -- optional String is external name.
  37 //      -- falSy ==> Java class
  38 //      -- truSy ==> Java interface
  39 //      -- others ...
  40 // Header     = magic modSy Name.
  41 // VersionName= numSy longint numSy longint numSy longint.
  42 //      --            mj# mn#       bld rv#    8xbyte extract
  43 // Import     = impSy Name [String] Key.
  44 //      -- optional string is explicit external name of class
  45 // Constant   = conSy Name Literal.
  46 // Variable   = varSy Name TypeOrd.
  47 // Type       = typSy Name TypeOrd.
  48 // Procedure  = prcSy Name [String] FormalType.
  49 //      -- optional string is explicit external name of procedure
  50 // Method     = mthSy Name byte byte TypeOrd [String] [Name] FormalType.
  51 //      -- optional string is explicit external name of method
  52 // FormalType = [retSy TypeOrd] frmSy {parSy byte TypeOrd [String]} endFm.
  53 //      -- optional phrase is return type for proper procedures
  54 // TypeOrd    = ordinal.
  55 // TypeHeader = tDefS Ord [fromS Ord Name].
  56 //      -- optional phrase occurs if:
  57 //      -- type not from this module, i.e. indirect export
  58 // TypeList   = start { Array | Record | Pointer | ProcType |
  59 //                Enum | Vector | NamedType } close.
  60 // Array      = TypeHeader arrSy TypeOrd (Byte | Number | <empty>) endAr.
  61 //      -- nullable phrase is array length for fixed length arrays
  62 // Vector     = TypeHeader vecSy TypeOrd endAr.
  63 // Pointer    = TypeHeader ptrSy TypeOrd.
  64 // Event      = TypeHeader evtSy FormalType.
  65 // ProcType   = TypeHeader pTpSy FormalType.
  66 // Record     = TypeHeader recSy recAtt [truSy | falSy]
  67 //              [basSy TypeOrd] [iFcSy {basSy TypeOrd}]
  68 //              {Name TypeOrd} {Method} {Statics} endRc.
  69 //      -- truSy ==> is an extension of external interface
  70 //      -- falSy ==> is an extension of external class
  71 //      -- basSy option defines base type, if not ANY / j.l.Object
  72 // Statics    = ( Constant | Variable | Procedure ).
  73 // Enum       = TypeHeader eTpSy { Constant } endRc.
  74 // NamedType  = TypeHeader.
  75 // Name       = namSy byte UTFstring.
  76 // Literal    = Number | String | Set | Char | Real | falSy | truSy.
  77 // Byte       = bytSy byte.
  78 // String     = strSy UTFstring.
  79 // Number     = numSy longint.
  80 // Real       = fltSy ieee-double.
  81 // Set        = setSy integer.
  82 // Key        = keySy integer..
  83 // Char       = chrSy unicode character.
  84 //
  85 // Notes on the syntax:
  86 // All record types must have a Name field, even though this is often
  87 // redundant.  The issue is that every record type (including those that
  88 // are anonymous in CP) corresponds to a IR class, and the definer
  89 // and the user of the class _must_ agree on the IR name of the class.
  90 // The same reasoning applies to procedure types, which must have equal
  91 // interface names in all modules.
  92 // ======================================================================== *)
  93
  94   CONST
  95         modSy = ORD('H'); namSy = ORD('$'); bytSy = ORD('\');
  96         numSy = ORD('#'); chrSy = ORD('c'); strSy = ORD('s');
  97         fltSy = ORD('r'); falSy = ORD('0'); truSy = ORD('1');
  98         impSy = ORD('I'); setSy = ORD('S'); keySy = ORD('K');
  99         conSy = ORD('C'); typSy = ORD('T'); tDefS = ORD('t');
 100         prcSy = ORD('P'); retSy = ORD('R'); mthSy = ORD('M');
 101         varSy = ORD('V'); parSy = ORD('p'); start = ORD('&');
 102         close = ORD('!'); recSy = ORD('{'); endRc = ORD('}');
 103         frmSy = ORD('('); fromS = ORD('@'); endFm = ORD(')');
 104         arrSy = ORD('['); endAr = ORD(']'); pTpSy = ORD('%');
 105         ptrSy = ORD('^'); basSy = ORD('+'); eTpSy = ORD('e');
 106         iFcSy = ORD('~'); evtSy = ORD('v'); vecSy = ORD('*');
 107
 108   CONST
 109         magic   = 0DEADD0D0H;
 110         syMag   = 0D0D0DEADH;
 111         dumped* = -1;
 112
 113 (* ============================================================ *)
 114
 115   TYPE
 116         SymFile = POINTER TO RECORD
 117                     file : BF.FILE;
 118                     cSum : INTEGER;
 119                     modS : Id.BlkId;
 120                     iNxt : INTEGER;
 121                     oNxt : INTEGER;
 122                     work : D.TypeSeq;
 123                   END;
 124
 125   TYPE
 126         SymFileReader* = POINTER TO RECORD
 127                     file  : BF.FILE;
 128                     modS  : Id.BlkId;
 129                     impS  : Id.BlkId;
 130                     sSym  : INTEGER;
 131                     cAtt  : CHAR;
 132                     iAtt  : INTEGER;
 133                     lAtt  : LONGINT;
 134                     rAtt  : REAL;
 135                     sAtt  : FileNames.NameString;
 136                     oArray : D.IdSeq;
 137                     sArray : D.ScpSeq;          (* These two sequences  *)
 138                     tArray : D.TypeSeq;         (* must be private as   *)
 139                   END;                          (* file parses overlap. *)
 140
 141 (* ============================================================ *)
 142
 143   TYPE  TypeLinker*  = POINTER TO RECORD (D.SymForAll) sym : SymFileReader END;
 144   TYPE  SymFileSFA*  = POINTER TO RECORD (D.SymForAll) sym : SymFile END;
 145
 146 (* ============================================================ *)
 147
 148   VAR   lastKey : INTEGER;      (* private state for CPMake *)
 149         fSepArr : ARRAY 2 OF CHAR;
 150
 151 (* ============================================================ *)
 152 (* ========          Import Stack Implementation        ======= *)
 153 (* ============================================================ *)
 154
 155    VAR  stack   : ARRAY 32 OF Id.BlkId;
 156         topIx   : INTEGER;
 157
 158    PROCEDURE InitStack;
 159    BEGIN
 160      topIx := 0; G.impMax := 0;
 161    END InitStack;
 162
 163    PROCEDURE PushStack(b : Id.BlkId);
 164    BEGIN
 165      stack[topIx] := b;
 166      INC(topIx);
 167      IF topIx > G.impMax THEN G.impMax := topIx END;
 168    END PushStack;
 169
 170    PROCEDURE PopStack;
 171    BEGIN
 172      DEC(topIx);
 173    END PopStack;
 174
 175 (* ============================================================ *)
 176
 177   PROCEDURE GetLastKeyVal*() : INTEGER;
 178   BEGIN
 179     RETURN lastKey;
 180   END GetLastKeyVal;
 181
 182 (* ============================================================ *)
 183 (* ========     Various writing utility procedures      ======= *)
 184 (* ============================================================ *)
 185
 186   PROCEDURE newSymFile(mod : Id.BlkId) : SymFile;
 187     VAR new : SymFile;
 188   BEGIN
 189     NEW(new);
 190    (*
 191     *  Initialization: cSum starts at zero. Since impOrd of
 192     *  the module is zero, impOrd of the imports starts at 1.
 193     *)
 194     new.cSum := 0;
 195     new.iNxt := 1;
 196     new.oNxt := D.tOffset;
 197     new.modS := mod;
 198     D.InitTypeSeq(new.work, 32);
 199     RETURN new;
 200   END newSymFile;
 201
 202 (* ======================================= *)
 203
 204   PROCEDURE (f : SymFile)Write(chr : INTEGER),NEW;
 205     VAR tmp : INTEGER;
 206   BEGIN [UNCHECKED_ARITHMETIC]
 207    (* need to turn off overflow checking here *)
 208     tmp := f.cSum * 2 + chr;
 209     IF f.cSum < 0 THEN INC(tmp) END;
 210     f.cSum := tmp;
 211     BF.WriteByte(f.file, chr);
 212   END Write;
 213
 214 (* ======================================= *)
 215
 216   PROCEDURE (f : SymFile)WriteStrUTF(IN nam : ARRAY OF CHAR),NEW;
 217     VAR buf : ARRAY 256 OF INTEGER;
 218         num : INTEGER;
 219         idx : INTEGER;
 220         chr : INTEGER;
 221   BEGIN
 222     num := 0;
 223     idx := 0;
 224     chr := ORD(nam[idx]);
 225     WHILE chr # 0H DO
 226       IF    chr <= 7FH THEN             (* [0xxxxxxx] *)
 227         buf[num] := chr; INC(num);
 228       ELSIF chr <= 7FFH THEN            (* [110xxxxx,10xxxxxx] *)
 229         buf[num+1] := 080H + chr MOD 64; chr := chr DIV 64;
 230         buf[num  ] := 0C0H + chr; INC(num, 2);
 231       ELSE                              (* [1110xxxx,10xxxxxx,10xxxxxxx] *)
 232         buf[num+2] := 080H + chr MOD 64; chr := chr DIV 64;
 233         buf[num+1] := 080H + chr MOD 64; chr := chr DIV 64;
 234         buf[num  ] := 0E0H + chr; INC(num, 3);
 235       END;
 236       INC(idx); chr := ORD(nam[idx]);
 237     END;
 238     f.Write(num DIV 256);
 239     f.Write(num MOD 256);
 240     FOR idx := 0 TO num-1 DO f.Write(buf[idx]) END;
 241   END WriteStrUTF;
 242
 243 (* ======================================= *)
 244
 245   PROCEDURE (f : SymFile)WriteOpenUTF(chOp : LitValue.CharOpen),NEW;
 246     VAR buf : ARRAY 256 OF INTEGER;
 247         num : INTEGER;
 248         idx : INTEGER;
 249         chr : INTEGER;
 250   BEGIN
 251     num := 0;
 252     idx := 0;
 253     chr := ORD(chOp[0]);
 254     WHILE chr # 0H DO
 255       IF    chr <= 7FH THEN             (* [0xxxxxxx] *)
 256         buf[num] := chr; INC(num);
 257       ELSIF chr <= 7FFH THEN            (* [110xxxxx,10xxxxxx] *)
 258         buf[num+1] := 080H + chr MOD 64; chr := chr DIV 64;
 259         buf[num  ] := 0C0H + chr; INC(num, 2);
 260       ELSE                              (* [1110xxxx,10xxxxxx,10xxxxxxx] *)
 261         buf[num+2] := 080H + chr MOD 64; chr := chr DIV 64;
 262         buf[num+1] := 080H + chr MOD 64; chr := chr DIV 64;
 263         buf[num  ] := 0E0H + chr; INC(num, 3);
 264       END;
 265       INC(idx);
 266       chr := ORD(chOp[idx]);
 267     END;
 268     f.Write(num DIV 256);
 269     f.Write(num MOD 256);
 270     FOR idx := 0 TO num-1 DO f.Write(buf[idx]) END;
 271   END WriteOpenUTF;
 272
 273 (* ======================================= *)
 274
 275   PROCEDURE (f : SymFile)WriteString(IN nam : ARRAY OF CHAR),NEW;
 276   BEGIN
 277     f.Write(strSy);
 278     f.WriteStrUTF(nam);
 279   END WriteString;
 280
 281 (* ======================================= *)
 282
 283   PROCEDURE (f : SymFile)WriteName(idD : D.Idnt),NEW;
 284   BEGIN
 285     f.Write(namSy);
 286     f.Write(idD.vMod);
 287     f.WriteOpenUTF(Nh.charOpenOfHash(idD.hash));
 288   END WriteName;
 289
 290 (* ======================================= *)
 291
 292   PROCEDURE (f : SymFile)WriteChar(chr : CHAR),NEW;
 293     CONST mask = {0 .. 7};
 294     VAR   a,b,int : INTEGER;
 295   BEGIN
 296     f.Write(chrSy);
 297     int := ORD(chr);
 298     b := ORD(BITS(int) * mask); int := ASH(int, -8);
 299     a := ORD(BITS(int) * mask);
 300     f.Write(a);
 301     f.Write(b);
 302   END WriteChar;
 303
 304 (* ======================================= *)
 305
 306   PROCEDURE (f : SymFile)Write4B(int : INTEGER),NEW;
 307     CONST mask = {0 .. 7};
 308     VAR   a,b,c,d : INTEGER;
 309   BEGIN
 310     d := ORD(BITS(int) * mask); int := ASH(int, -8);
 311     c := ORD(BITS(int) * mask); int := ASH(int, -8);
 312     b := ORD(BITS(int) * mask); int := ASH(int, -8);
 313     a := ORD(BITS(int) * mask);
 314     f.Write(a);
 315     f.Write(b);
 316     f.Write(c);
 317     f.Write(d);
 318   END Write4B;
 319
 320 (* ======================================= *)
 321
 322   PROCEDURE (f : SymFile)Write8B(val : LONGINT),NEW;
 323   BEGIN
 324     f.Write4B(RTS.hiInt(val));
 325     f.Write4B(RTS.loInt(val));
 326   END Write8B;
 327
 328 (* ======================================= *)
 329
 330   PROCEDURE (f : SymFile)WriteNum(val : LONGINT),NEW;
 331   BEGIN
 332     f.Write(numSy);
 333     f.Write8B(val);
 334   END WriteNum;
 335
 336 (* ======================================= *)
 337
 338   PROCEDURE (f : SymFile)WriteReal(flt : REAL),NEW;
 339     VAR rslt : LONGINT;
 340   BEGIN
 341     f.Write(fltSy);
 342     rslt := RTS.realToLongBits(flt);
 343     f.Write8B(rslt);
 344   END WriteReal;
 345
 346 (* ======================================= *)
 347
 348   PROCEDURE (f : SymFile)WriteOrd(ord : INTEGER),NEW;
 349   BEGIN
 350     IF ord <= 7FH THEN
 351       f.Write(ord);
 352     ELSIF ord <= 7FFFH THEN
 353       f.Write(128 + ord MOD 128);       (* LS7-bits first *)
 354       f.Write(ord DIV 128);             (* MS8-bits next  *)
 355     ELSE
 356       ASSERT(FALSE);
 357     END;
 358   END WriteOrd;
 359
 360 (* ======================================= *)
 361
 362   PROCEDURE (f : SymFile)EmitTypeOrd(t : D.Type),NEW;
 363   (*
 364    *  This proceedure facilitates the naming rules
 365    *  for records and (runtime) classes: -
 366    *
 367    *  (1)  Classes derived from named record types have
 368    *       names synthesized from the record typename.
 369    *  (2)  If a named pointer is bound to an anon record
 370    *       the class takes its name from the pointer name.
 371    *  (3)  If both the pointer and the record types have
 372    *       names, the class is named from the record.
 373    *)
 374     VAR recT : Ty.Record;
 375    (* ------------------------------------ *)
 376     PROCEDURE AddToWorklist(syF :SymFile; tyD : D.Type);
 377     BEGIN
 378       tyD.dump := syF.oNxt; INC(syF.oNxt);
 379       D.AppendType(syF.work, tyD);
 380       IF tyD.idnt = NIL THEN
 381         tyD.idnt := Id.newSfAnonId(tyD.dump);
 382         tyD.idnt.type := tyD;
 383       END;
 384     END AddToWorklist;
 385    (* ------------------------------------ *)
 386   BEGIN
 387     IF t.dump = 0 THEN (* type is not dumped yet *)
 388       WITH t : Ty.Record DO
 389        (*
 390         *   We wish to ensure that anonymous records are
 391         *   never emitted before their binding pointer
 392         *   types.  This ensures that we do not need to
 393         *   merge types when reading the files.
 394         *)
 395         IF (t.bindTp # NIL) &
 396            (t.bindTp.dump = 0) THEN
 397           AddToWorklist(f, t.bindTp);           (* First the pointer...  *)
 398         END;
 399         AddToWorklist(f, t);                    (* Then this record type *)
 400       | t : Ty.Pointer DO
 401        (*
 402         *  If a pointer to record is being emitted, and
 403         *  the pointer is NOT anonymous, then the class
 404         *  is known by the name of the record.  Thus the
 405         *  record name must be emitted, at least opaquely.
 406         *  Furthermore, we must indicate the binding
 407         *  relationship between the pointer and record.
 408         *  (It is possible that DCode need record size.)
 409         *)
 410         AddToWorklist(f, t);                    (* First this pointer... *)
 411         IF (t.boundTp # NIL) &
 412            (t.boundTp.dump = 0) &
 413            (t.boundTp IS Ty.Record) THEN
 414           recT := t.boundTp(Ty.Record);
 415           IF recT.bindTp = NIL THEN
 416             t.force := D.forced;
 417             AddToWorklist(f, t.boundTp);        (* Then the record type  *)
 418           END;
 419         END;
 420       ELSE (* All others *)
 421         AddToWorklist(f, t);                    (* Just add the type.    *)
 422       END;
 423     END;
 424     f.WriteOrd(t.dump);
 425   END EmitTypeOrd;
 426
 427 (* ============================================================ *)
 428 (* ========         Various writing procedures          ======= *)
 429 (* ============================================================ *)
 430
 431   PROCEDURE (f : SymFile)FormalType(t : Ty.Procedure),NEW;
 432   (*
 433   ** FormalType = [retSy TypeOrd] frmSy {parSy Byte TypeOrd [String]} endFm.
 434   *)
 435     VAR indx : INTEGER;
 436         parI : Id.ParId;
 437   BEGIN
 438     IF t.retType # NIL THEN
 439       f.Write(retSy);
 440       f.EmitTypeOrd(t.retType);
 441      (*
 442       *   The structure of this type must be
 443       *   emitted, unless it is an imported type.
 444       *)
 445       t.retType.ConditionalMark();
 446     END;
 447     f.Write(frmSy);
 448     FOR indx := 0 TO t.formals.tide-1 DO
 449       parI := t.formals.a[indx];
 450       f.Write(parSy);
 451       f.Write(parI.parMod);
 452       f.EmitTypeOrd(parI.type);
 453      (*
 454       *   Emit Optional Parameter name
 455       *)
 456       IF ~G.legacy & (parI.hash # 0) THEN
 457         f.WriteString(Nh.charOpenOfHash(parI.hash));
 458       END;
 459      (*
 460       *   The structure of this type must be
 461       *   emitted, unless it is an imported type.
 462       *)
 463       parI.type.ConditionalMark();
 464     END;
 465     f.Write(endFm);
 466   END FormalType;
 467
 468 (* ======================================= *)
 469
 470   PROCEDURE (f : SymFile)EmitConstId(id : Id.ConId),NEW;
 471     VAR conX : ExprDesc.LeafX;
 472         cVal : LitValue.Value;
 473         sVal : INTEGER;
 474   (*
 475   ** Constant = conSy Name Literal.
 476   ** Literal  = Number | String | Set | Char | Real | falSy | truSy.
 477   *)
 478   BEGIN
 479     conX := id.conExp(ExprDesc.LeafX);
 480     cVal := conX.value;
 481     f.Write(conSy);
 482     f.WriteName(id);
 483     CASE conX.kind OF
 484     | ExprDesc.tBool  : f.Write(truSy);
 485     | ExprDesc.fBool  : f.Write(falSy);
 486     | ExprDesc.numLt  : f.WriteNum(cVal.long());
 487     | ExprDesc.charLt : f.WriteChar(cVal.char());
 488     | ExprDesc.realLt : f.WriteReal(cVal.real());
 489     | ExprDesc.strLt  : f.WriteString(cVal.chOpen());
 490     | ExprDesc.setLt  :
 491         f.Write(setSy);
 492         IF cVal # NIL THEN sVal := cVal.int() ELSE sVal := 0 END;
 493         f.Write4B(sVal);
 494     END;
 495   END EmitConstId;
 496
 497 (* ======================================= *)
 498
 499   PROCEDURE (f : SymFile)EmitTypeId(id : Id.TypId),NEW;
 500   (*
 501   **  Type = TypeSy Name TypeOrd.
 502   *)
 503   BEGIN
 504     f.Write(typSy);
 505     f.WriteName(id);
 506     f.EmitTypeOrd(id.type);
 507    (*
 508     *   The structure of this type must be
 509     *   emitted, even if it is an imported type.
 510     *)
 511     id.type.UnconditionalMark();
 512   END EmitTypeId;
 513
 514 (* ======================================= *)
 515
 516   PROCEDURE (f : SymFile)EmitVariableId(id : Id.VarId),NEW;
 517   (*
 518   ** Variable = varSy Name TypeOrd.
 519   *)
 520   BEGIN
 521     f.Write(varSy);
 522     f.WriteName(id);
 523     f.EmitTypeOrd(id.type);
 524    (*
 525     *   The structure of this type must be
 526     *   emitted, unless it is an imported type.
 527     *)
 528     id.type.ConditionalMark();
 529   END EmitVariableId;
 530
 531 (* ======================================= *)
 532
 533   PROCEDURE (f : SymFile)EmitImportId(id : Id.BlkId),NEW;
 534   (*
 535   ** Import = impSy Name.
 536   *)
 537   BEGIN
 538     IF D.need IN id.xAttr THEN
 539       f.Write(impSy);
 540       f.WriteName(id);
 541       IF id.scopeNm # NIL THEN f.WriteString(id.scopeNm) END;
 542       f.Write(keySy);
 543       f.Write4B(id.modKey);
 544       id.impOrd := f.iNxt; INC(f.iNxt);
 545     END;
 546   END EmitImportId;
 547
 548 (* ======================================= *)
 549
 550   PROCEDURE (f : SymFile)EmitProcedureId(id : Id.PrcId),NEW;
 551   (*
 552   ** Procedure = prcSy Name FormalType.
 553   *)
 554   BEGIN
 555     f.Write(prcSy);
 556     f.WriteName(id);
 557     IF id.prcNm # NIL THEN f.WriteString(id.prcNm) END;
 558     IF id.kind = Id.ctorP THEN f.Write(truSy) END;
 559     f.FormalType(id.type(Ty.Procedure));
 560   END EmitProcedureId;
 561
 562 (* ======================================= *)
 563
 564   PROCEDURE (f : SymFile)EmitMethodId(id : Id.MthId),NEW;
 565   (*
 566   ** Method = mthSy Name Byte Byte TypeOrd [strSy ] FormalType.
 567   *)
 568   BEGIN
 569     IF id.kind = Id.fwdMth THEN id := id.resolve(Id.MthId) END;
 570     f.Write(mthSy);
 571     f.WriteName(id);
 572     f.Write(ORD(id.mthAtt));
 573     f.Write(id.rcvFrm.parMod);
 574     f.EmitTypeOrd(id.rcvFrm.type);
 575     IF id.prcNm # NIL THEN f.WriteString(id.prcNm) END;
 576     IF ~G.legacy & (id.rcvFrm.hash # 0) THEN f.WriteName(id.rcvFrm) END;
 577     f.FormalType(id.type(Ty.Procedure));
 578   END EmitMethodId;
 579
 580 (* ======================================= *)
 581
 582   PROCEDURE moduleOrd(tpId : D.Idnt) : INTEGER;
 583     VAR impM : Id.BlkId;
 584   BEGIN
 585     IF  (tpId = NIL) OR
 586         (tpId.dfScp = NIL) OR
 587         (tpId.dfScp.kind = Id.modId) THEN
 588       RETURN 0;
 589     ELSE
 590       impM := tpId.dfScp(Id.BlkId);
 591       IF impM.impOrd = 0 THEN RETURN -1 ELSE RETURN impM.impOrd END;
 592     END;
 593   END moduleOrd;
 594
 595 (* ======================================= *)
 596
 597   PROCEDURE (f : SymFile)EmitTypeHeader(t : D.Type),NEW;
 598   (*
 599   **  TypeHeader = typSy Ord [fromS Ord Name].
 600   *)
 601     VAR mod : INTEGER;
 602         idt : D.Idnt;
 603    (* =================================== *)
 604     PROCEDURE warp(id : D.Idnt) : D.Idnt;
 605     BEGIN
 606       IF    id.type = G.ntvObj THEN RETURN G.objId;
 607       ELSIF id.type = G.ntvStr THEN RETURN G.strId;
 608       ELSIF id.type = G.ntvExc THEN RETURN G.excId;
 609       ELSIF id.type = G.ntvTyp THEN RETURN G.clsId;
 610       ELSE  RETURN NIL;
 611       END;
 612     END warp;
 613    (* =================================== *)
 614   BEGIN
 615     WITH t : Ty.Record DO
 616       IF t.bindTp = NIL THEN
 617         idt := t.idnt;
 618       ELSIF t.bindTp.dump = 0 THEN
 619         ASSERT(FALSE);
 620         idt := NIL;
 621       ELSE
 622         idt := t.bindTp.idnt;
 623       END;
 624     ELSE
 625       idt := t.idnt;
 626     END;
 627     mod := moduleOrd(t.idnt);
 628     f.Write(tDefS);
 629     f.WriteOrd(t.dump);
 630    (*
 631     *  Convert native types back to RTS.nativeXXX, if necessary.
 632     *  That is ... if the native module is not explicitly imported.
 633     *)
 634     IF mod = -1 THEN idt := warp(idt); mod := moduleOrd(idt) END;
 635     IF mod # 0 THEN
 636       f.Write(fromS);
 637       f.WriteOrd(mod);
 638       f.WriteName(idt);
 639     END;
 640   END EmitTypeHeader;
 641
 642 (* ======================================= *)
 643
 644   PROCEDURE (f : SymFile)EmitArrOrVecType(t : Ty.Array),NEW;
 645   BEGIN
 646     f.EmitTypeHeader(t);
 647     IF t.force # D.noEmit THEN  (* Don't emit structure unless forced *)
 648       IF t.kind = Ty.vecTp THEN f.Write(vecSy) ELSE f.Write(arrSy) END;
 649       f.EmitTypeOrd(t.elemTp);
 650       IF t.length > 127 THEN
 651         f.Write(numSy);
 652         f.Write8B(t.length);
 653       ELSIF t.length > 0 THEN
 654         f.Write(bytSy);
 655         f.Write(t.length);
 656       END;
 657       f.Write(endAr);
 658     END;
 659   END EmitArrOrVecType;
 660
 661 (* ======================================= *)
 662
 663   PROCEDURE (f : SymFile)EmitRecordType(t : Ty.Record),NEW;
 664     VAR index  : INTEGER;
 665         field  : D.Idnt;
 666         method : D.Idnt;
 667   (*
 668   **  Record = TypeHeader recSy recAtt [truSy | falSy | <others>]
 669   **            [basSy TypeOrd] [iFcSy {basSy TypeOrd}]
 670   **            {Name TypeOrd} {Method} {Statics} endRc.
 671   *)
 672   BEGIN
 673     f.EmitTypeHeader(t);
 674     IF t.force # D.noEmit THEN  (* Don't emit structure unless forced *)
 675       f.Write(recSy);
 676       index := t.recAtt;
 677       IF D.noNew IN t.xAttr THEN INC(index, Ty.noNew) END;
 678       IF D.clsTp IN t.xAttr THEN INC(index, Ty.clsRc) END;
 679       f.Write(index);
 680    (* ########## *)
 681       IF t.recAtt = Ty.iFace THEN
 682         f.Write(truSy);
 683       ELSIF G.special OR (D.isFn IN t.xAttr) THEN
 684         f.Write(falSy);
 685       END;
 686    (* ########## *)
 687       IF t.baseTp # NIL THEN                    (* this is the parent type *)
 688         f.Write(basSy);
 689         f.EmitTypeOrd(t.baseTp);
 690       END;
 691    (* ########## *)
 692       IF t.interfaces.tide > 0 THEN
 693         f.Write(iFcSy);
 694         FOR index := 0 TO t.interfaces.tide-1 DO        (* any interfaces  *)
 695           f.Write(basSy);
 696           f.EmitTypeOrd(t.interfaces.a[index]);
 697         END;
 698       END;
 699    (* ########## *)
 700       FOR index := 0 TO t.fields.tide-1 DO
 701         field := t.fields.a[index];
 702         IF field.vMod # D.prvMode THEN
 703           f.WriteName(field);
 704           f.EmitTypeOrd(field.type);
 705         END;
 706       END;
 707       IF t.force = D.forced THEN  (* Don't emit methods unless forced *)
 708         FOR index := 0 TO t.methods.tide-1 DO
 709           method := t.methods.a[index];
 710           IF method.vMod # D.prvMode THEN
 711             f.EmitMethodId(method(Id.MthId));
 712           END;
 713         END;
 714 (*
 715  *      IF G.special THEN  (* we might need to emit static stuff *)
 716  *
 717  *  From 1.2.0 this provides for contructors that do not
 718  *  extend imported foreign record types.
 719  *)
 720           FOR index := 0 TO t.statics.tide-1 DO
 721             field := t.statics.a[index];
 722             IF field.vMod # D.prvMode THEN
 723               CASE field.kind OF
 724               | Id.conId  : f.EmitConstId(field(Id.ConId));
 725               | Id.varId  : f.EmitVariableId(field(Id.VarId));
 726               | Id.ctorP,
 727                 Id.conPrc : f.EmitProcedureId(field(Id.PrcId));
 728               END;
 729             END;
 730           END;
 731         END;
 732 (*
 733  *    END;
 734  *)
 735       f.Write(endRc);
 736     END;
 737     D.AppendType(f.modS.expRecs, t);
 738   END EmitRecordType;
 739
 740 (* ======================================= *)
 741
 742   PROCEDURE (f : SymFile)EmitEnumType(t : Ty.Enum),NEW;
 743     VAR index  : INTEGER;
 744         const  : D.Idnt;
 745   (*
 746   **  Enum = TypeHeader eTpSy { constant } endRc.
 747   *)
 748   BEGIN
 749     f.EmitTypeHeader(t);
 750     f.Write(eTpSy);
 751     FOR index := 0 TO t.statics.tide-1 DO
 752       const := t.statics.a[index];
 753       IF const.vMod # D.prvMode THEN f.EmitConstId(const(Id.ConId)) END;
 754     END;
 755     f.Write(endRc);
 756     (* D.AppendType(f.modS.expRecs, t); *)
 757   END EmitEnumType;
 758
 759 (* ======================================= *)
 760
 761   PROCEDURE (f : SymFile)EmitOpaqueType(t : Ty.Opaque),NEW;
 762   BEGIN
 763     f.EmitTypeHeader(t);
 764   END EmitOpaqueType;
 765
 766 (* ======================================= *)
 767
 768   PROCEDURE (f : SymFile)EmitPointerType(t : Ty.Pointer),NEW;
 769   BEGIN
 770     f.EmitTypeHeader(t);
 771     IF (t.force # D.noEmit) OR                  (* Only emit structure if *)
 772        (t.boundTp.force # D.noEmit) THEN        (* ptr or boundTp forced. *)
 773       f.Write(ptrSy);
 774       f.EmitTypeOrd(t.boundTp);
 775     END;
 776   END EmitPointerType;
 777
 778 (* ======================================= *)
 779
 780   PROCEDURE (f : SymFile)EmitProcedureType(t : Ty.Procedure),NEW;
 781   BEGIN
 782     f.EmitTypeHeader(t);
 783     IF t.isEventType() THEN f.Write(evtSy) ELSE f.Write(pTpSy) END;
 784     f.FormalType(t);
 785     D.AppendType(f.modS.expRecs, t);
 786   END EmitProcedureType;
 787
 788 (* ======================================= *)
 789
 790   PROCEDURE (f : SymFile)EmitTypeList(),NEW;
 791     VAR indx : INTEGER;
 792         type : D.Type;
 793   BEGIN
 794    (*
 795     *   We cannot use a FOR loop here, as the tide changes
 796     *   during evaluation, as a result of reaching new types.
 797     *)
 798     indx := 0;
 799     WHILE indx < f.work.tide DO
 800       type := f.work.a[indx];
 801
 802       WITH type : Ty.Array     DO f.EmitArrOrVecType(type);
 803       |    type : Ty.Record    DO f.EmitRecordType(type);
 804       |    type : Ty.Opaque    DO f.EmitOpaqueType(type);
 805       |    type : Ty.Pointer   DO f.EmitPointerType(type);
 806       |    type : Ty.Procedure DO f.EmitProcedureType(type);
 807       |    type : Ty.Enum      DO f.EmitEnumType(type);
 808       END;
 809       INC(indx);
 810     END;
 811   END EmitTypeList;
 812
 813 (* ======================================= *)
 814
 815   PROCEDURE EmitSymfile*(m : Id.BlkId);
 816
 817     VAR symVisit : SymFileSFA;
 818         symfile  : SymFile;
 819         marker   : INTEGER;
 820 (*
 821  *      fileName : FileNames.NameString;
 822  *)
 823         fNamePtr : LitValue.CharOpen;
 824   (* ----------------------------------- *)
 825     PROCEDURE mkPathName(m : D.Idnt) : LitValue.CharOpen;
 826       VAR str : LitValue.CharOpen;
 827     BEGIN
 828       str := BOX(G.symDir);
 829       IF str[LEN(str) - 2] = GF.fileSep THEN
 830         str := BOX(str^ + D.getName.ChPtr(m)^ + ".cps");
 831       ELSE
 832         str := BOX(str^ + fSepArr + D.getName.ChPtr(m)^ + ".cps");
 833       END;
 834       RETURN str;
 835     END mkPathName;
 836   (* ----------------------------------- *)
 837   (*
 838   ** SymFile = Header [String (falSy | truSy | <others>)]
 839   **            [ VersionName]
 840   **            {Import | Constant | Variable
 841   **                 | Type | Procedure | Method} TypeList.
 842   ** Header = magic modSy Name.
 843   ** VersionName= numSy longint numSy longint numSy longint.
 844   **      --            mj# mn#       bld rv#        8xbyte extract
 845   *)
 846   BEGIN
 847    (*
 848     *  Create the SymFile structure, and open the output file.
 849     *)
 850     symfile := newSymFile(m);
 851    (* Start of alternative gpcp1.2 code *)
 852     IF G.symDir # "" THEN
 853       fNamePtr := mkPathName(m);
 854       symfile.file := BF.createPath(fNamePtr);
 855     ELSE
 856       fNamePtr := BOX(D.getName.ChPtr(m)^ + ".cps");
 857       symfile.file := BF.createFile(fNamePtr);
 858     END;
 859     IF symfile.file = NIL THEN
 860       S.SemError.Report(177, 0, 0);
 861       Error.WriteString("Cannot create file <" + fNamePtr^ + ">");
 862       Error.WriteLn;
 863       RETURN;
 864     ELSE
 865      (*
 866       *  Emit the symbol file header
 867       *)
 868       IF G.verbose THEN G.Message("Created " + fNamePtr^) END;
 869      (* End of alternative gpcp1.2 code *)
 870       IF D.rtsMd IN m.xAttr THEN
 871         marker := RTS.loInt(syMag);     (* ==> a system module *)
 872       ELSE
 873         marker := RTS.loInt(magic);     (* ==> a normal module *)
 874       END;
 875       symfile.Write4B(RTS.loInt(marker));
 876       symfile.Write(modSy);
 877       symfile.WriteName(m);
 878       IF m.scopeNm # NIL THEN (* explicit name *)
 879         symfile.WriteString(m.scopeNm);
 880         symfile.Write(falSy);
 881       END;
 882      (*
 883       *  Emit the optional TypeName, if required.
 884       *
 885       *  VersionName= numSy longint numSy longint numSy longint.
 886       *       --            mj# mn#       bld rv#        8xbyte extract
 887       *)
 888       IF m.verNm # NIL THEN
 889         symfile.WriteNum(m.verNm[0] * 100000000L + m.verNm[1]);
 890         symfile.WriteNum(m.verNm[2] * 100000000L + m.verNm[3]);
 891         symfile.WriteNum(m.verNm[4] * 100000000L + m.verNm[5]);
 892       END;
 893      (*
 894       *  Create the symbol table visitor, an extension of
 895       *  Symbols.SymForAll type.  Emit symbols from the scope.
 896       *)
 897       NEW(symVisit);
 898       symVisit.sym := symfile;
 899       symfile.modS.symTb.Apply(symVisit);
 900      (*
 901       *  Now emit the types on the worklist.
 902       *)
 903       symfile.Write(start);
 904       symfile.EmitTypeList();
 905       symfile.Write(close);
 906      (*
 907       *  Now emit the accumulated checksum key symbol.
 908       *)
 909       symfile.Write(keySy);
 910       lastKey := symfile.cSum;
 911       IF G.special THEN symfile.Write4B(0) ELSE symfile.Write4B(lastKey) END;
 912       BF.CloseFile(symfile.file);
 913     END;
 914   END EmitSymfile;
 915
 916 (* ============================================================ *)
 917 (* ========     Various reading utility procedures      ======= *)
 918 (* ============================================================ *)
 919
 920   PROCEDURE read(f : BF.FILE) : INTEGER;
 921   BEGIN
 922     RETURN BF.readByte(f);
 923   END read;
 924
 925 (* ======================================= *)
 926
 927   PROCEDURE ReadUTF(f : BF.FILE; OUT nam : ARRAY OF CHAR);
 928     CONST
 929         bad = "Bad UTF-8 string";
 930     VAR num : INTEGER;
 931         bNm : INTEGER;
 932         idx : INTEGER;
 933         chr : INTEGER;
 934   BEGIN
 935     num := 0;
 936     bNm := read(f) * 256 + read(f);
 937     FOR idx := 0 TO bNm-1 DO
 938       chr := read(f);
 939       IF chr <= 07FH THEN               (* [0xxxxxxx] *)
 940         nam[num] := CHR(chr); INC(num);
 941       ELSIF chr DIV 32 = 06H THEN       (* [110xxxxx,10xxxxxx] *)
 942         bNm := chr MOD 32 * 64;
 943         chr := read(f);
 944         IF chr DIV 64 = 02H THEN
 945           nam[num] := CHR(bNm + chr MOD 64); INC(num);
 946         ELSE
 947           RTS.Throw(bad);
 948         END;
 949       ELSIF chr DIV 16 = 0EH THEN       (* [1110xxxx,10xxxxxx,10xxxxxxx] *)
 950         bNm := chr MOD 16 * 64;
 951         chr := read(f);
 952         IF chr DIV 64 = 02H THEN
 953           bNm := (bNm + chr MOD 64) * 64;
 954           chr := read(f);
 955           IF chr DIV 64 = 02H THEN
 956             nam[num] := CHR(bNm + chr MOD 64); INC(num);
 957           ELSE
 958             RTS.Throw(bad);
 959           END;
 960         ELSE
 961           RTS.Throw(bad);
 962         END;
 963       ELSE
 964         RTS.Throw(bad);
 965       END;
 966     END;
 967     nam[num] := 0X;
 968   END ReadUTF;
 969
 970 (* ======================================= *)
 971
 972   PROCEDURE readChar(f : BF.FILE) : CHAR;
 973   BEGIN
 974     RETURN CHR(read(f) * 256 + read(f));
 975   END readChar;
 976
 977 (* ======================================= *)
 978
 979   PROCEDURE readInt(f : BF.FILE) : INTEGER;
 980   BEGIN [UNCHECKED_ARITHMETIC]
 981     (* overflow checking off here *)
 982     RETURN ((read(f) * 256 + read(f)) * 256 + read(f)) * 256 + read(f);
 983   END readInt;
 984
 985 (* ======================================= *)
 986
 987   PROCEDURE readLong(f : BF.FILE) : LONGINT;
 988     VAR result : LONGINT;
 989         index  : INTEGER;
 990   BEGIN [UNCHECKED_ARITHMETIC]
 991     (* overflow checking off here *)
 992     result := read(f);
 993     FOR index := 1 TO 7 DO
 994       result := result * 256 + read(f);
 995     END;
 996     RETURN result;
 997   END readLong;
 998
 999 (* ======================================= *)
1000
1001   PROCEDURE readReal(f : BF.FILE) : REAL;
1002     VAR result : LONGINT;
1003   BEGIN
1004     result := readLong(f);
1005     RETURN RTS.longBitsToReal(result);
1006   END readReal;
1007
1008 (* ======================================= *)
1009
1010   PROCEDURE readOrd(f : BF.FILE) : INTEGER;
1011     VAR chr : INTEGER;
1012   BEGIN
1013     chr := read(f);
1014     IF chr <= 07FH THEN RETURN chr;
1015     ELSE
1016       DEC(chr, 128);
1017       RETURN chr + read(f) * 128;
1018     END;
1019   END readOrd;
1020
1021 (* ============================================================ *)
1022 (* ========             Symbol File Reader              ======= *)
1023 (* ============================================================ *)
1024
1025   PROCEDURE newSymFileReader*(mod : Id.BlkId) : SymFileReader;
1026     VAR new : SymFileReader;
1027   BEGIN
1028     NEW(new);
1029     new.modS := mod;
1030     D.InitIdSeq(new.oArray, 4);
1031     D.InitTypeSeq(new.tArray, 8);
1032     D.InitScpSeq(new.sArray, 8);
1033     RETURN new;
1034   END newSymFileReader;
1035
1036 (* ======================================= *)
1037   PROCEDURE^ (f : SymFileReader)SymFile(IN nm : ARRAY OF CHAR),NEW;
1038   PROCEDURE^ WalkThisImport(imp, mod : Id.BlkId);
1039 (* ======================================= *)
1040
1041   PROCEDURE Abandon(f : SymFileReader);
1042   BEGIN
1043     RTS.Throw("Bad symbol file format" +
1044               Nh.charOpenOfHash(f.impS.hash)^);
1045   END Abandon;
1046
1047 (* ======================================= *)
1048
1049   PROCEDURE (f : SymFileReader)GetSym(),NEW;
1050     VAR file : BF.FILE;
1051   BEGIN
1052     file := f.file;
1053     f.sSym := read(file);
1054     CASE f.sSym OF
1055     | namSy :
1056         f.iAtt := read(file); ReadUTF(file, f.sAtt);
1057     | strSy :
1058         ReadUTF(file, f.sAtt);
1059     | retSy, fromS, tDefS, basSy :
1060         f.iAtt := readOrd(file);
1061     | bytSy :
1062         f.iAtt := read(file);
1063     | keySy, setSy :
1064         f.iAtt := readInt(file);
1065     | numSy :
1066         f.lAtt := readLong(file);
1067     | fltSy :
1068         f.rAtt := readReal(file);
1069     | chrSy :
1070         f.cAtt := readChar(file);
1071     ELSE (* nothing to do *)
1072     END;
1073   END GetSym;
1074
1075 (* ======================================= *)
1076
1077   PROCEDURE (f : SymFileReader)ReadPast(sym : INTEGER),NEW;
1078   BEGIN
1079     IF f.sSym # sym THEN Abandon(f) END;
1080     f.GetSym();
1081   END ReadPast;
1082
1083 (* ======================================= *)
1084
1085   PROCEDURE (f : SymFileReader)Parse*(scope : Id.BlkId;
1086                                       filNm : FileNames.NameString),NEW;
1087     VAR fileName : FileNames.NameString;
1088         marker   : INTEGER;
1089         token    : S.Token;
1090   BEGIN
1091     token := scope.token;
1092
1093     f.impS := scope;
1094     D.AppendScope(f.sArray, scope);
1095     fileName := filNm + ".cps";
1096     f.file := BF.findOnPath("CPSYM", fileName);
1097    (* #### *)
1098     IF f.file = NIL THEN
1099       fileName := "__" + fileName;
1100       f.file := BF.findOnPath("CPSYM", fileName);
1101       IF f.file # NIL THEN
1102         S.SemError.RepSt2(309, filNm, fileName, token.lin, token.col);
1103         filNm := "__" + filNm;
1104         scope.clsNm := LitValue.strToCharOpen(filNm);
1105       END;
1106     END;
1107    (* #### *)
1108     IF f.file = NIL THEN
1109       S.SemError.Report(129, token.lin, token.col); RETURN;
1110     ELSE
1111       IF G.verbose THEN G.Message("Opened " + fileName) END;
1112       marker := readInt(f.file);
1113       IF marker = RTS.loInt(magic) THEN
1114         (* normal case, nothing to do *)
1115       ELSIF marker = RTS.loInt(syMag) THEN
1116         INCL(scope.xAttr, D.rtsMd);
1117       ELSE
1118         S.SemError.Report(130, token.lin, token.col); RETURN;
1119       END;
1120       f.GetSym();
1121       f.SymFile(filNm);
1122       IF G.verbose THEN
1123         G.Message("Ended " + fileName + ", Key: "
1124                         + LitValue.intToCharOpen(f.impS.modKey)^);
1125       END;
1126       BF.CloseFile(f.file);
1127     END;
1128   END Parse;
1129
1130 (* ============================================ *)
1131
1132   PROCEDURE testInsert(id : D.Idnt; sc : D.Scope) : D.Idnt;
1133     VAR ident : D.Idnt;
1134
1135     PROCEDURE Report(i,s : D.Idnt);
1136       VAR iS, sS : FileNames.NameString;
1137     BEGIN
1138       D.getName.Of(i, iS);
1139       D.getName.Of(s, sS);
1140       S.SemError.RepSt2(172, iS, sS, S.line, S.col);
1141     END Report;
1142
1143   BEGIN
1144     IF sc.symTb.enter(id.hash, id) THEN
1145       ident := id;
1146     ELSE
1147       ident := sc.symTb.lookup(id.hash);        (* Warp the return Idnt *)
1148       IF ident.kind # id.kind THEN Report(id, sc); ident := id END;
1149     END;
1150     RETURN ident;
1151   END testInsert;
1152
1153 (* ============================================ *)
1154
1155   PROCEDURE Insert(id : D.Idnt; VAR tb : D.SymbolTable);
1156     VAR ident : D.Idnt;
1157
1158     PROCEDURE Report(i : D.Idnt);
1159       VAR iS : FileNames.NameString;
1160     BEGIN
1161       D.getName.Of(i, iS);
1162       S.SemError.RepSt1(172, iS, 1, 1);
1163     END Report;
1164
1165   BEGIN
1166     IF ~tb.enter(id.hash, id) THEN
1167       ident := tb.lookup(id.hash);              (* and test isForeign? *)
1168       IF ident.kind # id.kind THEN Report(id) END;
1169     END;
1170   END Insert;
1171
1172 (* ============================================ *)
1173
1174   PROCEDURE InsertInRec(id : D.Idnt; rec : Ty.Record; sfr : SymFileReader);
1175   (* insert, taking into account possible overloaded methods. *)
1176   VAR
1177     ok : BOOLEAN;
1178     oId : Id.OvlId;
1179
1180     PROCEDURE Report(i : D.Idnt; IN s : ARRAY OF CHAR);
1181       VAR iS, sS : FileNames.NameString;
1182     BEGIN
1183       D.getName.Of(i, iS);
1184 (*
1185  *    D.getName.Of(s, sS);
1186  *    S.SemError.RepSt2(172, iS, sS, S.line, S.col);
1187  *)
1188       S.SemError.RepSt2(172, iS, s, S.line, S.col);
1189     END Report;
1190
1191   BEGIN
1192     Ty.InsertInRec(id,rec,TRUE,oId,ok);
1193     IF oId # NIL THEN D.AppendIdnt(sfr.oArray,oId); END;
1194 (*
1195     IF ~ok THEN Report(id,rec.idnt); END;
1196  *)
1197     IF ~ok THEN Report(id, rec.name()) END;
1198   END InsertInRec;
1199
1200 (* ============================================ *)
1201
1202   PROCEDURE (f : SymFileReader)getLiteral() : D.Expr,NEW;
1203     VAR expr : D.Expr;
1204   BEGIN
1205     CASE f.sSym OF
1206     | truSy : expr := ExprDesc.mkTrueX();
1207     | falSy : expr := ExprDesc.mkFalseX();
1208     | numSy : expr := ExprDesc.mkNumLt(f.lAtt);
1209     | chrSy : expr := ExprDesc.mkCharLt(f.cAtt);
1210     | fltSy : expr := ExprDesc.mkRealLt(f.rAtt);
1211     | setSy : expr := ExprDesc.mkSetLt(BITS(f.iAtt));
1212     | strSy : expr := ExprDesc.mkStrLt(f.sAtt);         (* implicit f.sAtt^ *)
1213     END;
1214     f.GetSym();                                         (* read past value  *)
1215     RETURN expr;
1216   END getLiteral;
1217
1218 (* ============================================ *)
1219
1220   PROCEDURE (f : SymFileReader)typeOf(ord : INTEGER) : D.Type,NEW;
1221     VAR newT : D.Type;
1222         indx : INTEGER;
1223   BEGIN
1224     IF ord < D.tOffset THEN                             (* builtin type *)
1225       RETURN B.baseTypeArray[ord];
1226     ELSIF ord - D.tOffset < f.tArray.tide THEN
1227       RETURN f.tArray.a[ord - D.tOffset];
1228     ELSE
1229       indx := f.tArray.tide + D.tOffset;
1230       REPEAT
1231         newT := Ty.newTmpTp();
1232         newT.dump := indx; INC(indx);
1233         D.AppendType(f.tArray, newT);
1234       UNTIL indx > ord;
1235       RETURN newT;
1236     END;
1237   END typeOf;
1238
1239 (* ============================================ *)
1240
1241   PROCEDURE (f : SymFileReader)getTypeFromOrd() : D.Type,NEW;
1242     VAR ord : INTEGER;
1243   BEGIN
1244     ord := readOrd(f.file);
1245     f.GetSym();
1246     RETURN f.typeOf(ord);
1247   END getTypeFromOrd;
1248
1249 (* ============================================ *)
1250
1251   PROCEDURE (f : SymFileReader)getFormalType(rslt : Ty.Procedure;
1252                                              indx : INTEGER) : D.Type,NEW;
1253   (*
1254   ** FormalType = [retSy TypeOrd] frmSy {parSy Byte TypeOrd [String]} endFm.
1255   //    -- optional phrase is return type for proper procedures
1256   *)
1257     VAR parD : Id.ParId;
1258         byte : INTEGER;
1259   BEGIN
1260     IF f.sSym = retSy THEN
1261       rslt.retType := f.typeOf(f.iAtt);
1262       f.GetSym();
1263     END;
1264     f.ReadPast(frmSy);
1265     WHILE f.sSym = parSy DO
1266       byte := read(f.file);
1267       parD := Id.newParId();
1268       parD.parMod := byte;
1269       parD.varOrd := indx;
1270       parD.type := f.getTypeFromOrd();
1271      (* Skip over optional parameter name string *)
1272       IF f.sSym = strSy THEN (* parD.hash := Nh.enterStr(f.sAtt); *)
1273         f.GetSym;
1274       END;
1275       Id.AppendParam(rslt.formals, parD);
1276       INC(indx);
1277     END;
1278     f.ReadPast(endFm);
1279     RETURN rslt;
1280   END getFormalType;
1281
1282 (* ============================================ *)
1283
1284   PROCEDURE (f : SymFileReader)pointerType(old : D.Type) : D.Type,NEW;
1285   (* Assert: the current symbol ptrSy           *)
1286   (* Pointer   = TypeHeader ptrSy TypeOrd.      *)
1287     VAR rslt : Ty.Pointer;
1288         indx : INTEGER;
1289         junk : D.Type;
1290         isEvt: BOOLEAN;
1291   BEGIN
1292     isEvt := (f.sSym = evtSy);
1293     indx := readOrd(f.file);
1294     WITH old : Ty.Pointer DO
1295       rslt := old;
1296      (*
1297       *  Check if there is space in the tArray for this
1298       *  element, otherwise expand using typeOf().
1299       *)
1300       IF indx - D.tOffset >= f.tArray.tide THEN
1301         junk := f.typeOf(indx);
1302       END;
1303       f.tArray.a[indx - D.tOffset] := rslt.boundTp;
1304     ELSE
1305       rslt := Ty.newPtrTp();
1306       rslt.boundTp := f.typeOf(indx);
1307       IF isEvt THEN rslt.SetKind(Ty.evtTp) END;
1308     END;
1309     f.GetSym();
1310     RETURN rslt;
1311   END pointerType;
1312
1313 (* ============================================ *)
1314
1315   PROCEDURE (f : SymFileReader)procedureType() : D.Type,NEW;
1316   (* Assert: the current symbol is pTpSy.       *)
1317   (* ProcType  = TypeHeader pTpSy FormalType.   *)
1318   BEGIN
1319     f.GetSym();         (* read past pTpSy *)
1320     RETURN f.getFormalType(Ty.newPrcTp(), 0);
1321   END procedureType;
1322
1323 (* ============================================ *)
1324
1325   PROCEDURE (f : SymFileReader)eventType() : D.Type,NEW;
1326   (* Assert: the current symbol is evtSy.       *)
1327   (* EventType = TypeHeader evtSy FormalType.   *)
1328   BEGIN
1329     f.GetSym();         (* read past evtSy *)
1330     RETURN f.getFormalType(Ty.newEvtTp(), 0);
1331   END eventType;
1332
1333 (* ============================================ *)
1334
1335   PROCEDURE (f : SymFileReader)arrayType() : Ty.Array,NEW;
1336   (* Assert: at entry the current symbol is arrSy.                   *)
1337   (* Array      = TypeHeader arrSy TypeOrd (Byte | Number | ) endAr. *)
1338   (*    -- nullable phrase is array length for fixed length arrays   *)
1339     VAR rslt : Ty.Array;
1340         eTyp : D.Type;
1341   BEGIN
1342     rslt := Ty.newArrTp();
1343     rslt.elemTp := f.typeOf(readOrd(f.file));
1344     f.GetSym();
1345     IF f.sSym = bytSy THEN
1346       rslt.length := f.iAtt;
1347       f.GetSym();
1348     ELSIF f.sSym = numSy THEN
1349       rslt.length := SHORT(f.lAtt);
1350       f.GetSym();
1351     (* ELSE length := 0 *)
1352     END;
1353     f.ReadPast(endAr);
1354     RETURN rslt;
1355   END arrayType;
1356
1357 (* ============================================ *)
1358
1359   PROCEDURE (f : SymFileReader)vectorType() : Ty.Vector,NEW;
1360   (* Assert: at entry the current symbol is vecSy.                   *)
1361   (* Vector     = TypeHeader vecSy TypeOrd endAr.                    *)
1362     VAR rslt : Ty.Vector;
1363         eTyp : D.Type;
1364   BEGIN
1365     rslt := Ty.newVecTp();
1366     rslt.elemTp := f.typeOf(readOrd(f.file));
1367     f.GetSym();
1368     f.ReadPast(endAr);
1369     RETURN rslt;
1370   END vectorType;
1371
1372 (* ============================================ *)
1373   PROCEDURE^ (f : SymFileReader)procedure() : Id.PrcId,NEW;
1374   PROCEDURE^ (f : SymFileReader)method()    : Id.MthId,NEW;
1375   PROCEDURE^ (f : SymFileReader)constant()  : Id.ConId,NEW;
1376   PROCEDURE^ (f : SymFileReader)variable()  : Id.VarId,NEW;
1377 (* ============================================ *)
1378
1379   PROCEDURE (f : SymFileReader)recordType(old  : D.Type) : D.Type,NEW;
1380   (* Assert: at entry the current symbol is recSy.                      *)
1381   (* Record     = TypeHeader recSy recAtt [truSy | falSy | <others>]    *)
1382   (*    [basSy TypeOrd] [iFcSy {basSy TypeOrd}]                         *)
1383   (*    {Name TypeOrd} {Method} {Statics} endRc.                        *)
1384     CONST
1385         vlTp = Ty.valRc;
1386     VAR rslt : Ty.Record;
1387         fldD : Id.FldId;
1388         varD : Id.VarId;
1389         mthD : Id.MthId;
1390         conD : Id.ConId;
1391         prcD : Id.PrcId;
1392         typD : Id.TypId;
1393         oldS : INTEGER;
1394         attr : INTEGER;
1395         mskd : INTEGER;
1396   BEGIN
1397     WITH old : Ty.Record DO rslt := old ELSE rslt := Ty.newRecTp() END;
1398     attr := read(f.file);
1399     mskd := attr MOD 8;
1400    (*
1401     *  The recAtt field has two other bits piggy-backed onto it.
1402     *  The noNew Field of xAttr is just added on in the writing
1403     *  and is stripped off here.  The valRc field is used to lock
1404     *  in foreign value classes, even though they have basTp # NIL.
1405     *)
1406 (*
1407  *  IF mskd # Ty.noAtt THEN INCL(rslt.xAttr, D.clsTp) END;
1408  *  IF attr >= noNw THEN DEC(attr, noNw); INCL(rslt.xAttr, D.noNew) END;
1409  *)
1410     IF attr >= Ty.clsRc THEN DEC(attr,Ty.clsRc); INCL(rslt.xAttr,D.clsTp) END;
1411     IF attr >= Ty.noNew THEN DEC(attr,Ty.noNew); INCL(rslt.xAttr,D.noNew) END;
1412
1413     rslt.recAtt := attr;
1414     f.GetSym();                         (* Get past recSy rAtt  *)
1415     IF f.sSym = falSy THEN
1416       INCL(rslt.xAttr, D.isFn);
1417       f.GetSym();
1418     ELSIF f.sSym = truSy THEN
1419       INCL(rslt.xAttr, D.isFn);
1420       INCL(rslt.xAttr, D.fnInf);
1421       INCL(rslt.xAttr, D.noCpy);
1422       f.GetSym();
1423     END;
1424     IF f.impS.scopeNm # NIL THEN rslt.extrnNm := f.impS.scopeNm END;
1425
1426     IF f.sSym = basSy THEN
1427       rslt.baseTp := f.typeOf(f.iAtt);
1428       IF f.iAtt # Ty.anyRec THEN INCL(rslt.xAttr, D.clsTp) END;
1429       f.GetSym();
1430     END;
1431     IF f.sSym = iFcSy THEN
1432       f.GetSym();
1433       WHILE f.sSym = basSy DO
1434         typD := Id.newSfAnonId(f.iAtt);
1435         typD.type := f.typeOf(f.iAtt);
1436         D.AppendType(rslt.interfaces, typD.type);
1437         f.GetSym();
1438       END;
1439     END;
1440     WHILE f.sSym = namSy DO
1441       fldD := Id.newFldId();
1442       fldD.SetMode(f.iAtt);
1443       fldD.hash := Nh.enterStr(f.sAtt);
1444       fldD.type := f.typeOf(readOrd(f.file));
1445       fldD.recTyp := rslt;
1446       f.GetSym();
1447       IF rslt.symTb.enter(fldD.hash, fldD) THEN
1448         D.AppendIdnt(rslt.fields, fldD);
1449       END;
1450     END;
1451
1452     WHILE (f.sSym = mthSy) OR
1453           (f.sSym = prcSy) OR
1454           (f.sSym = varSy) OR
1455           (f.sSym = conSy) DO
1456       oldS := f.sSym; f.GetSym();
1457       IF oldS = mthSy THEN
1458         mthD := f.method();
1459         mthD.bndType := rslt;
1460         mthD.type(Ty.Procedure).receiver := rslt;
1461         InsertInRec(mthD,rslt,f);
1462         D.AppendIdnt(rslt.methods, mthD);
1463       ELSIF oldS = prcSy THEN
1464         prcD := f.procedure();
1465         prcD.bndType := rslt;
1466         InsertInRec(prcD,rslt,f);
1467         D.AppendIdnt(rslt.statics, prcD);
1468       ELSIF oldS = varSy THEN
1469         varD := f.variable();
1470         varD.recTyp := rslt;
1471         InsertInRec(varD,rslt,f);
1472         D.AppendIdnt(rslt.statics, varD);
1473       ELSIF oldS = conSy THEN
1474         conD := f.constant();
1475         conD.recTyp := rslt;
1476         InsertInRec(conD,rslt,f);
1477       ELSE
1478         Abandon(f);
1479       END;
1480     END;
1481 (* #### *)
1482     IF attr >= Ty.valRc THEN
1483       DEC(attr, Ty.valRc);
1484       EXCL(rslt.xAttr, D.clsTp);
1485       EXCL(rslt.xAttr, D.noCpy);
1486     END;
1487 (* #### *)
1488     f.ReadPast(endRc);
1489     RETURN rslt;
1490   END recordType;
1491
1492 (* ============================================ *)
1493
1494   PROCEDURE (f : SymFileReader)enumType() : D.Type,NEW;
1495   (* Assert: at entry the current symbol is eTpSy.                      *)
1496   (* Enum  = TypeHeader eTpSy { Constant} endRc.                        *)
1497     VAR rslt : Ty.Enum;
1498         cnst : D.Idnt;
1499   BEGIN
1500     rslt := Ty.newEnuTp();
1501     f.GetSym();                         (* Get past recSy       *)
1502     WHILE f.sSym = conSy DO
1503       f.GetSym();
1504       cnst := f.constant();
1505       Insert(cnst, rslt.symTb);
1506       D.AppendIdnt(rslt.statics, cnst);
1507     END;
1508     f.ReadPast(endRc);
1509     RETURN rslt;
1510   END enumType;
1511
1512 (* ============================================ *)
1513
1514   PROCEDURE (f : SymFileReader)Type(),NEW;
1515   (* Type       = typSy Name TypeOrd.           *)
1516     VAR newI : Id.TypId;
1517         oldI : D.Idnt;
1518         type : D.Type;
1519   BEGIN
1520    (*
1521     * Post: every previously unknown typId id
1522     *   has the property:  id.type.idnt = id.
1523     *   If oldI # newT, then the new typId has
1524     *   newT.type.idnt = oldI.
1525     *)
1526     newI := Id.newTypId(NIL);
1527     newI.SetMode(f.iAtt);
1528     newI.hash := Nh.enterStr(f.sAtt);
1529     newI.type := f.getTypeFromOrd();
1530     newI.dfScp := f.impS;
1531     oldI := testInsert(newI, f.impS);
1532
1533     IF oldI # newI THEN
1534       f.tArray.a[newI.type.dump - D.tOffset] := oldI.type;
1535     END;
1536
1537     IF newI.type.idnt = NIL THEN newI.type.idnt := oldI END;
1538   END Type;
1539
1540 (* ============================================ *)
1541
1542   PROCEDURE (f : SymFileReader)Import(),NEW;
1543   (* Import     = impSy Name [String] Key.      *)
1544   (*    -- optional string is external name     *)
1545   (* first symbol should be namSy here.         *)
1546     VAR impD : Id.BlkId;
1547         oldS : Id.BlkId;
1548         oldD : D.Idnt;
1549   BEGIN
1550     impD := Id.newImpId();
1551     impD.dfScp := impD;                 (* ImpId define their own scope *)
1552
1553     INCL(impD.xAttr, D.weak);
1554     impD.SetMode(f.iAtt);
1555     impD.hash := Nh.enterStr(f.sAtt);
1556     f.ReadPast(namSy);
1557     IF impD.hash = f.modS.hash THEN     (* Importing own imp indirectly *)
1558                                         (* Shouldn't this be an error?  *)
1559       D.AppendScope(f.sArray, f.modS);
1560       IF f.sSym = strSy THEN
1561         (* probably don't need to do anything here ... *)
1562         f.GetSym();
1563       END;
1564     ELSE                                (* Importing some other module. *)
1565       oldD := testInsert(impD, f.modS);
1566       IF f.sSym = strSy THEN
1567         impD.scopeNm := LitValue.strToCharOpen(f.sAtt);
1568         f.GetSym();
1569       END;
1570       IF (oldD # impD) & (oldD.kind = Id.impId) THEN
1571         oldS := oldD(Id.BlkId);
1572         D.AppendScope(f.sArray, oldS);
1573         IF (oldS.modKey # 0) & (f.iAtt # oldS.modKey) THEN
1574           S.SemError.RepSt1(133,                (* Detected bad KeyVal  *)
1575                 Nh.charOpenOfHash(impD.hash)^,
1576                 S.line, S.col);
1577         END;
1578 (* should not be necessary anymore *)
1579         IF ~(D.weak IN oldS.xAttr) &
1580            ~(D.fixd IN oldS.xAttr) THEN
1581          (*
1582           *   This recursively reads the symbol files for
1583           *   any imports of this file which are on the
1584           *   list to be imported later anyhow.
1585           *)
1586           WalkThisImport(oldS, f.modS);
1587         END;
1588       ELSE
1589         D.AppendScope(f.sArray, impD);
1590       END;
1591       impD.modKey := f.iAtt;
1592     END;
1593     f.ReadPast(keySy);
1594   END Import;
1595
1596 (* ============================================ *)
1597
1598   PROCEDURE (f : SymFileReader)constant() : Id.ConId,NEW;
1599   (* Constant   = conSy Name Literal.           *)
1600   (* Assert: f.sSym = namSy.                    *)
1601     VAR newC : Id.ConId;
1602         anyI : D.Idnt;
1603   BEGIN
1604     newC := Id.newConId();
1605     newC.SetMode(f.iAtt);
1606     newC.hash := Nh.enterStr(f.sAtt);
1607     newC.dfScp := f.impS;
1608     f.ReadPast(namSy);
1609     newC.conExp := f.getLiteral();
1610     newC.type := newC.conExp.type;
1611     RETURN newC;
1612   END constant;
1613
1614 (* ============================================ *)
1615
1616   PROCEDURE (f : SymFileReader)variable() : Id.VarId,NEW;
1617   (* Variable   = varSy Name TypeOrd.           *)
1618     VAR newV : Id.VarId;
1619         anyI : D.Idnt;
1620   BEGIN
1621     newV := Id.newVarId();
1622     newV.SetMode(f.iAtt);
1623     newV.hash := Nh.enterStr(f.sAtt);
1624     newV.type := f.getTypeFromOrd();
1625     newV.dfScp := f.impS;
1626     RETURN newV;
1627   END variable;
1628
1629 (* ============================================ *)
1630
1631   PROCEDURE (f : SymFileReader)procedure() : Id.PrcId,NEW;
1632   (* Procedure  = prcSy Name[String]FormalType. *)
1633   (* This is a static proc, mths come with Recs *)
1634     VAR newP : Id.PrcId;
1635         anyI : D.Idnt;
1636   BEGIN
1637     newP := Id.newPrcId();
1638     newP.setPrcKind(Id.conPrc);
1639     newP.SetMode(f.iAtt);
1640     newP.hash := Nh.enterStr(f.sAtt);
1641     newP.dfScp := f.impS;
1642     f.ReadPast(namSy);
1643     IF f.sSym = strSy THEN
1644       newP.prcNm := LitValue.strToCharOpen(f.sAtt);
1645      (* and leave scopeNm = NIL *)
1646       f.GetSym();
1647     END;
1648     IF f.sSym = truSy THEN      (* ### this is a constructor ### *)
1649       f.GetSym();
1650       newP.setPrcKind(Id.ctorP);
1651     END;                        (* ### this is a constructor ### *)
1652     newP.type := f.getFormalType(Ty.newPrcTp(), 0);
1653     (* IF this is a java module, do some semantic checks *)
1654     (* ... *)
1655     RETURN newP;
1656   END procedure;
1657
1658 (* ============================================ *)
1659
1660   PROCEDURE (f : SymFileReader)method() : Id.MthId,NEW;
1661   (* Method     = mthSy Name byte byte TypeOrd [String][Name] FormalType. *)
1662     VAR newM : Id.MthId;
1663         rcvD : Id.ParId;
1664         rFrm : INTEGER;
1665         mAtt : SET;
1666   BEGIN
1667     newM := Id.newMthId();
1668     newM.SetMode(f.iAtt);
1669     newM.setPrcKind(Id.conMth);
1670     newM.hash := Nh.enterStr(f.sAtt);
1671     newM.dfScp := f.impS;
1672     rcvD := Id.newParId();
1673     rcvD.varOrd := 0;
1674    (* byte1 is the method attributes  *)
1675     mAtt := BITS(read(f.file));
1676    (* byte2 is param form of receiver *)
1677     rFrm := read(f.file);
1678    (* next 1 or 2 bytes are rcv-type  *)
1679     rcvD.type := f.typeOf(readOrd(f.file));
1680     f.GetSym();
1681     rcvD.parMod := rFrm;
1682     IF f.sSym = strSy THEN
1683       newM.prcNm := LitValue.strToCharOpen(f.sAtt);
1684      (* and leave scopeNm = NIL *)
1685       f.GetSym();
1686     END;
1687    (* Skip over optional receiver name string *)
1688     IF f.sSym = namSy THEN (* rcvD.hash := Nh.enterString(f.sAtt); *)
1689       f.GetSym();
1690     END;
1691    (* End skip over optional receiver name *)
1692     newM.type := f.getFormalType(Ty.newPrcTp(), 1);
1693     newM.mthAtt := mAtt;
1694     newM.rcvFrm := rcvD;
1695    (* IF this is a java module, do some semantic checks *)
1696     RETURN newM;
1697   END method;
1698
1699 (* ============================================ *)
1700
1701   PROCEDURE (f : SymFileReader)TypeList(),NEW;
1702   (* TypeList   = start { Array | Record | Pointer      *)
1703   (*              | ProcType | Vector} close.           *)
1704   (* TypeHeader = tDefS Ord [fromS Ord Name].           *)
1705     VAR modOrd : INTEGER;
1706         typOrd : INTEGER;
1707         typIdx : INTEGER;
1708         tpDesc : D.Type;
1709         tpTemp : D.Type;
1710         tpIdnt : Id.TypId;
1711         prevId : D.Idnt;
1712         prevTp : D.Type;
1713         impScp : D.Scope;
1714         linkIx : INTEGER;
1715         bndTyp : D.Type;
1716         typeFA : TypeLinker;
1717   BEGIN
1718     WHILE f.sSym = tDefS DO
1719       linkIx := 0;
1720       tpIdnt := NIL;
1721      (* Do type header *)
1722       typOrd := f.iAtt;
1723       typIdx := typOrd - D.tOffset;
1724       tpTemp := f.tArray.a[typIdx];
1725       impScp := NIL;
1726       f.ReadPast(tDefS);
1727      (*
1728       *  The [fromS modOrd typNam] appears if the type is imported.
1729       *  There are two cases:
1730       *     this is the first time that "mod.typNam" has been
1731       *     seen during this compilation
1732       *                   ==> insert a new typId descriptor in mod.symTb
1733       *     this name is already in the mod.symTb table
1734       *                   ==> fetch the previous descriptor
1735       *)
1736       IF f.sSym = fromS THEN
1737         modOrd := f.iAtt;
1738         impScp := f.sArray.a[modOrd];
1739         f.GetSym();
1740         tpIdnt := Id.newTypId(NIL);
1741         tpIdnt.SetMode(f.iAtt);
1742         tpIdnt.hash := Nh.enterStr(f.sAtt);
1743         tpIdnt.dfScp := impScp;
1744         tpIdnt := testInsert(tpIdnt, impScp)(Id.TypId);
1745         f.ReadPast(namSy);
1746       END;
1747
1748      (* Get type info. *)
1749       CASE f.sSym OF
1750       | arrSy : tpDesc := f.arrayType();
1751       | vecSy : tpDesc := f.vectorType();
1752       | recSy : tpDesc := f.recordType(tpTemp);
1753       | pTpSy : tpDesc := f.procedureType();
1754       | evtSy : tpDesc := f.eventType();
1755       | eTpSy : tpDesc := f.enumType();
1756       | ptrSy : tpDesc := f.pointerType(tpTemp);
1757                 IF tpDesc # NIL THEN
1758                   bndTyp := tpDesc(Ty.Pointer).boundTp;
1759                   IF (bndTyp # NIL) &
1760                      (bndTyp.kind = Ty.tmpTp) THEN
1761                     linkIx := bndTyp.dump - D.tOffset;
1762                   END;
1763                 END;
1764       ELSE
1765         tpDesc := Ty.newNamTp();
1766       END;
1767       IF tpIdnt # NIL THEN
1768        (*
1769         *  A name has been declared for this type, tpIdnt is
1770         *  the (possibly previously known) id descriptor, and
1771         *  tpDesc is the newly parsed descriptor of the type.
1772         *)
1773         IF  tpIdnt.type = NIL THEN
1774          (*
1775           *  Case #1: no previous type.
1776           *  This is the first time the compiler has seen this type
1777           *)
1778           tpIdnt.type := tpDesc;
1779           tpDesc.idnt := tpIdnt;
1780         ELSIF tpDesc IS Ty.Opaque THEN
1781          (*
1782           *  Case #2: previous type exists, new type is opaque.
1783           *  Throw away the newly parsed opaque type desc, and
1784           *  use the previously known type *even* if it is opaque!
1785           *)
1786           tpDesc := tpIdnt.type;
1787         ELSIF tpIdnt.type IS Ty.Opaque THEN
1788          (*
1789           *  Case #3: previous type is opaque, new type is non-opaque.
1790           *  This type had been seen opaquely, but now has a
1791           *  non-opaque definition
1792           *)
1793           tpIdnt.type(Ty.Opaque).resolved := tpDesc;
1794           tpIdnt.type := tpDesc;
1795           tpDesc.idnt := tpIdnt;
1796         ELSE
1797          (*
1798           *  Case #4: previous type is non-opaque, new type is non-opaque.
1799           *  This type already has a non-opaque descriptor.
1800           *  We shall keep the original copy.
1801           *)
1802           tpDesc := tpIdnt.type;
1803         END;
1804        (*
1805         *  Normally, imported types cannot be anonymous.
1806         *  However, there is one special case here. Anon
1807         *  records can be record base types, but are always
1808         *  preceeded by the binding pointer type. A typical
1809         *  format of output from SymDec might be ---
1810         *
1811         *       T18 = SomeMod.BasePtr
1812         *             POINTER TO T19;
1813         *       T19 = EXTENSIBLE RECORD  (T11) ... END;
1814         *
1815         *  in this case T19 is an anon record from SomeMod,
1816         *  not the current module.
1817         *
1818         *  Thus we pre-override the future record declaration
1819         *  by the bound type of the pointer.  This ensures
1820         *  uniqueness of the record descriptor, even if it is
1821         *  imported indirectly multiple times.
1822         *)
1823         WITH tpDesc : Ty.Pointer DO
1824           IF linkIx # 0 THEN f.tArray.a[linkIx] := tpDesc.boundTp END;
1825         ELSE (* skip *)
1826         END;
1827         f.tArray.a[typIdx] := tpDesc;
1828       ELSE
1829        (*
1830         *  tpIdnt is NIL ==> type is from this import,
1831         *  except for the special case above.  In the usual
1832         *  case we replace the tmpTp by tpDesc. In the special
1833         *  case the tmpTp has been already been overridden by
1834         *  the previously imported bound type.
1835         *)
1836         prevTp := f.tArray.a[typIdx];
1837         prevId := prevTp.idnt;
1838         IF (prevId # NIL) &
1839            (prevId.type.kind = Ty.namTp) THEN
1840           prevId.type(Ty.Opaque).resolved := tpDesc;
1841           prevId.type := tpDesc;
1842         END;
1843         tpDesc.idnt := prevId;
1844         f.tArray.a[typIdx] := tpDesc;
1845       END;
1846     END; (* while *)
1847    (*
1848     *  First we fix up all symbolic references in the
1849     *  the type array.  Postcondition is : no element
1850     *  of the type array directly or indirectly refers
1851     *  to a temporary type.
1852     *)
1853     FOR linkIx := 0 TO f.tArray.tide - 1 DO
1854       f.tArray.a[linkIx].TypeFix(f.tArray);
1855     END;
1856    (*
1857     *  We now fix up all references in the symbol table
1858     *  that still refer to temporary symbol-file types.
1859     *)
1860     NEW(typeFA);
1861     typeFA.sym := f;
1862     f.impS.symTb.Apply(typeFA);
1863     f.ReadPast(close);
1864    (*
1865     *  Now check that all overloaded ids are necessary
1866     *)
1867     FOR linkIx := 0 TO f.oArray.tide - 1 DO
1868       f.oArray.a[linkIx].OverloadFix();
1869       f.oArray.a[linkIx] := NIL;
1870     END;
1871   END TypeList;
1872
1873 (* ============================================ *)
1874
1875   PROCEDURE (f : SymFileReader)SymFile(IN nm : ARRAY OF CHAR),NEW;
1876    (*
1877    // SymFile    = Header [String (falSy | truSy | <others>)]
1878    //           {Import | Constant | Variable | Type | Procedure}
1879    //           TypeList Key.
1880    // Header     = magic modSy Name.
1881    //
1882    //  magic has already been recognized.
1883    *)
1884     VAR oldS : INTEGER;
1885   BEGIN
1886     f.ReadPast(modSy);
1887     IF f.sSym = namSy THEN (* do something with f.sAtt *)
1888       IF nm # f.sAtt THEN
1889         Error.WriteString("Wrong name in symbol file. Expected <");
1890         Error.WriteString(nm + ">, found <");
1891         Error.WriteString(f.sAtt + ">");
1892         Error.WriteLn;
1893         HALT(1);
1894       END;
1895       f.GetSym();
1896     ELSE RTS.Throw("Bad symfile header");
1897     END;
1898     IF f.sSym = strSy THEN (* optional name *)
1899       f.impS.scopeNm := LitValue.strToCharOpen(f.sAtt);
1900       f.GetSym();
1901       IF f.sSym = falSy THEN
1902         INCL(f.impS.xAttr, D.isFn);
1903         f.GetSym();
1904       ELSIF f.sSym = truSy THEN
1905         INCL(f.impS.xAttr, D.isFn);
1906         INCL(f.impS.xAttr, D.fnInf);
1907         f.GetSym();
1908       ELSE RTS.Throw("Bad explicit name");
1909       END;
1910     END;
1911     IF f.sSym = numSy THEN (* optional strong name info.    *)
1912       NEW(f.impS.verNm);   (* POINTER TO ARRAY 6 OF INTEGER *)
1913       f.impS.verNm[0] := RTS.hiInt(f.lAtt);
1914       f.impS.verNm[1] := RTS.loInt(f.lAtt);
1915       f.GetSym();
1916       f.impS.verNm[2] := RTS.hiInt(f.lAtt);
1917       f.impS.verNm[3] := RTS.loInt(f.lAtt);
1918       f.GetSym();
1919       f.impS.verNm[4] := RTS.hiInt(f.lAtt);
1920       f.impS.verNm[5] := RTS.loInt(f.lAtt);
1921       f.GetSym();
1922       IF G.verbose THEN
1923         Console.WriteString("version:");
1924         Console.WriteInt(f.impS.verNm[0],1); Console.Write(".");
1925         Console.WriteInt(f.impS.verNm[1],1); Console.Write(".");
1926         Console.WriteInt(f.impS.verNm[2],1); Console.Write(".");
1927         Console.WriteInt(f.impS.verNm[3],1);
1928         Console.WriteHex(f.impS.verNm[4],9);
1929         Console.WriteHex(f.impS.verNm[5],9); Console.WriteLn;
1930       END;
1931     END;
1932     LOOP
1933       oldS := f.sSym;
1934       f.GetSym();
1935       CASE oldS OF
1936       | start : EXIT;
1937       | typSy : f.Type();
1938       | impSy : f.Import();
1939       | conSy : Insert(f.constant(),  f.impS.symTb);
1940       | varSy : Insert(f.variable(),  f.impS.symTb);
1941       | prcSy : Insert(f.procedure(), f.impS.symTb);
1942       ELSE RTS.Throw("Bad object");
1943       END;
1944     END;
1945    (* Now read the typelist *)
1946     f.TypeList();
1947     IF f.sSym = keySy THEN
1948       IF f.impS.modKey = 0 THEN
1949         f.impS.modKey := f.iAtt;
1950       ELSIF f.impS.modKey # f.iAtt THEN
1951         S.SemError.Report(173, S.line, S.col);  (* Detected bad KeyVal  *)
1952       END;
1953     ELSE RTS.Throw("Missing keySy");
1954     END;
1955   END SymFile;
1956
1957 (* ============================================================ *)
1958 (* ========          SymFileSFA visitor method          ======= *)
1959 (* ============================================================ *)
1960
1961   PROCEDURE (t : SymFileSFA)Op*(id : D.Idnt);
1962   BEGIN
1963     IF (id.kind = Id.impId) OR (id.vMod # D.prvMode) THEN
1964       CASE id.kind OF
1965       | Id.typId  : t.sym.EmitTypeId(id(Id.TypId));
1966       | Id.conId  : t.sym.EmitConstId(id(Id.ConId));
1967       | Id.impId  : t.sym.EmitImportId(id(Id.BlkId));
1968       | Id.varId  : t.sym.EmitVariableId(id(Id.VarId));
1969 (* new *)
1970       | Id.conPrc : t.sym.EmitProcedureId(id(Id.PrcId));
1971 (*
1972  * old ... we used to emit the constructor as a static method.
1973  *         Now it appears as a static in the bound record decl.
1974  *
1975  *    | Id.ctorP,
1976  *      Id.conPrc : t.sym.EmitProcedureId(id(Id.PrcId));
1977  *)
1978       ELSE (* skip *)
1979       END;
1980     END;
1981   END Op;
1982
1983 (* ============================================================ *)
1984 (* ========          TypeLinker visitor method          ======= *)
1985 (* ============================================================ *)
1986
1987   PROCEDURE (t : TypeLinker)Op*(id : D.Idnt);
1988   BEGIN
1989     IF id.type = NIL THEN RETURN
1990     ELSIF id.type.kind = Ty.tmpTp THEN
1991       id.type := Ty.update(t.sym.tArray, id.type);
1992     ELSE
1993       id.type.TypeFix(t.sym.tArray);
1994     END;
1995     IF  (id IS Id.TypId) &
1996         (id.type.idnt = NIL) THEN id.type.idnt := id END;
1997   END Op;
1998
1999 (* ============================================================ *)
2000 (* ========         Symbol file parser method           ======= *)
2001 (* ============================================================ *)
2002
2003   PROCEDURE WalkThisImport(imp, mod : Id.BlkId);
2004     VAR syFil : SymFileReader;
2005         filNm : FileNames.NameString;
2006   BEGIN
2007     PushStack(imp);
2008     INCL(imp.xAttr, D.fixd);
2009     S.GetString(imp.token.pos, imp.token.len, filNm);
2010     syFil := newSymFileReader(mod);
2011     syFil.Parse(imp, filNm);
2012     PopStack;
2013   END WalkThisImport;
2014
2015 (* ============================================ *)
2016
2017   PROCEDURE WalkImports*(IN imps : D.ScpSeq; modI : Id.BlkId);
2018     VAR indx : INTEGER;
2019         scpI : D.Scope;
2020         blkI : Id.BlkId;
2021   BEGIN
2022    (*
2023     *  The list of scopes has been constructed by
2024     *  the parser, while reading the import list.
2025     *  In the case of already known scopes the list
2026     *  references the original descriptor.
2027     *)
2028     InitStack;
2029     FOR indx := 0 TO imps.tide-1 DO
2030       scpI := imps.a[indx];
2031       blkI := scpI(Id.BlkId);
2032       IF blkI.kind = Id.alias THEN
2033         blkI.symTb  := blkI.dfScp.symTb;
2034       ELSIF ~(D.fixd IN blkI.xAttr) THEN
2035         WalkThisImport(blkI,modI);
2036       END;
2037     END;
2038   END WalkImports;
2039
2040 (* ============================================================ *)
2041 BEGIN
2042   lastKey := 0;
2043   fSepArr[0] := GF.fileSep;
2044 END OldSymFileRW.
2045 (* ============================================================ *)