DEADSOFTWARE

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