1 (* ==================================================================== *)
3 (* IdDesc Module for the Gardens Point Component Pascal Compiler. *)
4 (* Implements identifier descriptors that are extensions of *)
7 (* Copyright (c) John Gough 1999, 2000. *)
9 (* ==================================================================== *)
25 (* ============================================================ *)
27 CONST (* idnt-kinds *)
28 errId
* = 0; conId
* = 1; varId
* = 2; parId
* = 3; quaId
* = 4;
29 typId
* = 5; modId
* = 6; impId
* = 7; alias
* = 8; fldId
* = 9;
30 fwdMth
* = 10; conMth
* = 11; fwdPrc
* = 12; conPrc
* = 13; fwdTyp
* = 14;
33 CONST (* method attributes *)
35 final
* = {}; isNew
* = {newBit
}; isAbs
* = {1};
36 empty
* = {2}; extns
* = {1,2}; mask
* = {1,2};
37 covar
* = 3; (* ==> method has covariant type *)
38 boxRcv
* = 4; (* ==> receiver is boxed in .NET *)
39 widen
* = 5; (* ==> visibility must be widened *)
40 (* in the runtime representation. *)
41 noCall
* = 6; (* ==> method is an override of *)
42 (* an implement only method. *)
44 CONST (* procedure and method pAttr attributes *)
45 hasXHR
* = 0; (* ==> has non-locally accessed data *)
46 assgnd
* = 1; (* ==> is assigned as a proc variable *)
47 called
* = 2; (* ==> is directly called in this mod *)
48 public
* = 3; (* ==> is exported from this module *)
49 useMsk
* = {1,2,3}; (* pAttr*useMsk={} ==> a useless proc *)
51 (* ============================================================ *)
54 TypId
* = POINTER TO RECORD (D
.Idnt
)
55 (* ---- ... inherited from Idnt ... ------- *
56 * kind- : INTEGER; (* tag for unions *)
57 * token
* : Scanner
.Token
; (* scanner token *)
58 * type
* : D
.Type
; (* typ-desc | NIL *)
59 * hash
* : INTEGER; (* hash bucket no *)
60 * vMod
- : INTEGER; (* visibility tag *)
61 * dfScp
* : Scope
; (* defining scope *)
63 * ----------------------------------------- *)
64 END; (* ------------------------------ *)
66 (* ============================================================ *)
69 ConId
* = POINTER TO RECORD (D
.Idnt
)
70 (* ---- ... inherited from Idnt ... ------- *
71 * kind- : INTEGER; (* tag for unions *)
72 * token
* : Scanner
.Token
; (* scanner token *)
73 * type
* : D
.Type
; (* typ-desc | NIL *)
74 * hash
* : INTEGER; (* hash bucket no *)
75 * vMod
- : INTEGER; (* visibility tag *)
76 * dfScp
* : Scope
; (* defining scope *)
78 * ----------------------------------------- *)
81 isStd
- : BOOLEAN; (* false if ~std *)
82 END; (* ------------------------------ *)
84 (* ============================================================ *)
87 AbVar
* = POINTER TO ABSTRACT
RECORD (D
.Idnt
)
88 (* Abstract Variables ... *)
89 varOrd
* : INTEGER; (* local var ord. *)
92 (* ============================================================ *)
95 VarId
* = POINTER TO RECORD (AbVar
)
96 (* ---- ... inherited from Idnt ... ------- *
97 * kind- : INTEGER; (* tag for unions *)
98 * token
* : Scanner
.Token
; (* scanner token *)
99 * type
* : D
.Type
; (* typ-desc | NIL *)
100 * hash
* : INTEGER; (* hash bucket no *)
101 * vMod
- : INTEGER; (* visibility tag *)
102 * dfScp
* : Scope
; (* defining scope *)
104 * ---- ... inherited from AbVar
... ------- *
105 * varOrd
* : INTEGER; (* local var ord. *)
106 * ----------------------------------------- *)
108 clsNm
* : L
.CharOpen
; (* external name *)
109 varNm
* : L
.CharOpen
; (* external name *)
110 END; (* ------------------------------ *)
112 (* ============================================================ *)
115 FldId
* = POINTER TO RECORD (AbVar
)
116 (* ---- ... inherited from Idnt ... ------- *
117 * kind- : INTEGER; (* tag for unions *)
118 * token
* : Scanner
.Token
; (* scanner token *)
119 * type
* : D
.Type
; (* typ-desc | NIL *)
120 * hash
* : INTEGER; (* hash bucket no *)
121 * vMod
- : INTEGER; (* visibility tag *)
122 * dfScp
* : Scope
; (* defining scope *)
124 * ---- ... inherited from AbVar
... ------- *
125 * varOrd
* : INTEGER; (* local var ord. *)
126 * ----------------------------------------- *)
128 fldNm
* : L
.CharOpen
; (* external name *)
129 END; (* ------------------------------ *)
131 (* ============================================================ *)
133 CONST (* local variable and arg access attribs *)
134 addrsd
* = 0; (* This bit is set if object has adrs taken *)
135 uplevR
* = 1; (* This bit is set if local is uplevel read *)
136 uplevW
* = 2; (* This bit set if local is uplevel written *)
137 uplevA
* = 3; (* This bit is set if Any uplevel access *)
138 cpVarP
* = 4; (* This bit denotes uplevel access to var-par *)
139 xMark
* = -1; (* varOrd is set to xMark is local is uplevel *)
140 (* BUT ... not until after flow attribution! *)
143 LocId
* = POINTER TO EXTENSIBLE
RECORD (AbVar
)
144 (* NB: LocId sometimes have kind = conId! *
145 * ---- ... inherited from Idnt ... ------- *
146 * kind- : INTEGER; (* tag for unions *)
147 * token
* : D
.Token
; (* scanner token *)
148 * type
* : D
.Type
; (* typ-desc | NIL *)
149 * hash
* : INTEGER; (* hash bucket no *)
150 * vMod
- : INTEGER; (* visibility tag *)
151 * dfScp
* : Scope
; (* defining scope *)
153 * ---- ... inherited from AbVar
... ------- *
154 * varOrd
* : INTEGER; (* local var ord. *)
155 * ----------------------------------------- *)
157 boxOrd
* : INTEGER; (* if boxd in RTS *)
158 END; (* ------------------------------ *)
160 (* ============================================================ *)
163 ParId
* = POINTER TO RECORD (LocId
)
164 (* ---- ... inherited from Idnt ... ------- *
165 * kind- : INTEGER; (* tag for unions *)
166 * token
* : Scanner
.Token
; (* scanner token *)
167 * type
* : D
.Type
; (* typ-desc | NIL *)
168 * hash
* : INTEGER; (* hash bucket no *)
169 * vMod
- : INTEGER; (* visibility tag *)
170 * dfScp
* : Scope
; (* defining scope *)
172 * ---- ... inherited from AbVar
... ------- *
173 * varOrd
* : INTEGER; (* local var ord. *)
174 * ---- ... inherited from LocId
... ------- *
176 * boxOrd
* : INTEGER; (* if boxd in RTS *)
177 * ----------------------------------------- *)
178 parMod
* : INTEGER; (* parameter mode *)
179 isRcv
* : BOOLEAN; (* this is "this" *)
180 rtsTmp
* : INTEGER; (* caller box ref *)
181 rtsSrc
* : VarId
; (* used for quasi *)
182 END; (* ------------------------------ *)
185 tide
-, high
: INTEGER;
186 a
- : POINTER TO ARRAY OF ParId
;
189 (* ============================================================ *)
192 BaseCall
* = POINTER TO RECORD
193 actuals
* : D
.ExprSeq
;
198 (* ============================================================ *)
201 Procs
* = POINTER TO ABSTRACT
RECORD (D
.Scope
)
202 (* ---- ... inherited from Idnt ... ------- *
203 * kind- : INTEGER; (* tag for unions *)
204 * token
* : Scanner
.Token
; (* scanner token *)
205 * type
* : D
.Type
; (* typ-desc | NIL *)
206 * hash
* : INTEGER; (* hash bucket no *)
207 * vMod
- : INTEGER; (* visibility tag *)
208 * dfScp
* : Scope
; (* defining scope *)
210 * ---- ... inherited from Scope
... ------ *
211 * symTb
* : SymbolTable
; (* symbol scope *)
212 * endDecl
* : BOOLEAN; (* can't add more *)
213 * ovfChk
* : BOOLEAN; (* check overflow *)
214 * locals
* : IdSeq
; (* varId sequence *)
215 * scopeNm
* : L
.CharOpen
; (* external name *)
216 * ----------------------------------------- *)
217 prcNm
* : L
.CharOpen
; (* external name *)
218 body
* : D
.Stmt
; (* procedure-code *)
219 except
* : LocId
; (* except-object *)
220 rescue
* : D
.Stmt
; (* except-handler *)
221 resolve
* : Procs
; (* fwd resolution *)
222 rtsFram
* : INTEGER; (* RTS local size *)
223 nestPs
* : PrcSeq
; (* local proclist *)
224 pAttr
* : SET; (* procAttributes *)
225 lxDepth
* : INTEGER; (* lexical depth *)
226 bndType
* : D
.Type
; (* bound RecTp *)
227 xhrType
* : D
.Type
; (* XHR rec. type *)
228 basCll
* : BaseCall
; (* for ctors only *)
229 endSpan
* : S
.Span
; (* END ident span *)
230 END; (* ------------------------------ *)
233 tide
-, high
: INTEGER;
234 a
- : POINTER TO ARRAY OF Procs
;
237 PrcId
* = POINTER TO EXTENSIBLE
RECORD (Procs
)
238 clsNm
* : L
.CharOpen
; (* external name *)
240 END; (* ------------------------------ *)
242 MthId
* = POINTER TO RECORD (Procs
)
243 mthAtt
* : SET; (* mth attributes *)
244 rcvFrm
* : ParId
; (* receiver frmal *)
245 END; (* ------------------------------ *)
247 (* ============================================================ *)
249 (* ------------------------------------------------------- *
250 * OvlIds do not occur in pure Component Pascal. They *
251 * appear transiently as descriptors of identifiers that *
252 * are bound to overloaded names from foreign libraries. *
253 * ------------------------------------------------------- *)
254 OvlId
* = POINTER TO RECORD (D
.Idnt
)
260 (* ============================================================ *)
263 BlkId
* = POINTER TO RECORD (D
.Scope
)
264 (* ---- ... inherited from Idnt ... ------- *
265 * kind- : INTEGER; (* tag for unions *)
266 * token
* : Scanner
.Token
; (* scanner token *)
267 * type
* : D
.Type
; (* typ-desc | NIL *)
268 * hash
* : INTEGER; (* hash bucket no *)
269 * vMod
- : INTEGER; (* visibility tag *)
270 * dfScp
* : D
.Scope
; (* defining scope *)
272 * ---- ... inherited from Scope
... ------ *
273 * symTb
* : SymbolTable
; (* symbol scope *)
274 * endDecl
* : BOOLEAN; (* can't add more *)
275 * ovfChk
* : BOOLEAN; (* check overflow *)
276 * locals
* : IdSeq
; (* varId sequence *)
277 * scopeNm
* : L
.CharOpen (* external name *)
278 * ----------------------------------------- *)
280 modBody
* : D
.Stmt
; (* mod init-stmts *)
281 modClose
* : D
.Stmt
; (* mod finaliz'n *)
282 impOrd
* : INTEGER; (* implement ord. *)
283 modKey
* : INTEGER; (* module magicNm *)
284 main
* : BOOLEAN; (* module is main *)
285 procs
* : PrcSeq
; (* local proclist *)
286 expRecs
* : D
.TypeSeq
; (* exported recs. *)
287 xAttr
* : SET; (* external types *)
288 xName
* : L
.CharOpen
; (* ext module nam *)
289 pkgNm
* : L
.CharOpen
; (* package name *)
290 clsNm
* : L
.CharOpen
; (* dummy class nm *)
291 verNm
* : POINTER TO ARRAY 6 OF INTEGER;
294 END; (* ------------------------------ *)
296 (* ============================================================ *)
297 (* Append for the PrcSeq, ParSeq types. *)
298 (* ============================================================ *)
300 PROCEDURE InitPrcSeq
*(VAR seq
: PrcSeq
; capacity
: INTEGER);
302 NEW(seq
.a
, capacity
); seq
.tide
:= 0; seq
.high
:= capacity
-1;
305 PROCEDURE ResetPrcSeq
*(VAR seq
: PrcSeq
);
308 IF seq
.a
= NIL THEN InitPrcSeq(seq
, 2) END;
312 PROCEDURE AppendProc
*(VAR seq
: PrcSeq
; elem
: Procs
);
313 VAR temp
: POINTER TO ARRAY OF Procs
;
318 ELSIF seq
.tide
> seq
.high
THEN (* must expand *)
320 seq
.high
:= seq
.high
* 2 + 1;
321 NEW(seq
.a
, (seq
.high
+1));
322 FOR i
:= 0 TO seq
.tide
-1 DO seq
.a
[i
] := temp
[i
] END;
324 seq
.a
[seq
.tide
] := elem
; INC(seq
.tide
);
327 PROCEDURE RemoveProc
*(VAR seq
: PrcSeq
; elemPos
: INTEGER);
331 FOR ix
:= elemPos
TO seq
.tide
-2 DO
332 seq
.a
[ix
] := seq
.a
[ix
+1];
337 (* -------------------------------------------- *)
339 PROCEDURE InitParSeq
*(VAR seq
: ParSeq
; capacity
: INTEGER);
341 NEW(seq
.a
, capacity
); seq
.tide
:= 0; seq
.high
:= capacity
-1;
344 PROCEDURE ResetParSeq
*(VAR seq
: ParSeq
);
347 IF seq
.a
= NIL THEN InitParSeq(seq
, 2) END;
351 PROCEDURE AppendParam
*(VAR seq
: ParSeq
; elem
: ParId
);
352 VAR temp
: POINTER TO ARRAY OF ParId
;
357 ELSIF seq
.tide
> seq
.high
THEN (* must expand *)
359 seq
.high
:= seq
.high
* 2 + 1;
360 NEW(seq
.a
, (seq
.high
+1));
361 FOR i
:= 0 TO seq
.tide
-1 DO seq
.a
[i
] := temp
[i
] END;
363 seq
.a
[seq
.tide
] := elem
; INC(seq
.tide
);
366 (* ============================================================ *)
367 (* Predicate implementations *)
368 (* ============================================================ *)
370 PROCEDURE (s
: AbVar
)mutable
*() : BOOLEAN,EXTENSIBLE
;
371 (** Determine if this variable is mutable in this scope. *
372 * Overrides mutable() for Symbols.Idnt *)
374 IF s
.kind
= conId
THEN RETURN FALSE
;
375 ELSE RETURN (s
.vMod
= D
.pubMode
) (* public vars are RW *)
376 OR (s
.vMod
= D
.protect
) (* bad access caught elsewhere *)
377 OR ((s
.dfScp
# NIL) (* or scope not import *)
378 & (s
.dfScp
.kind
# impId
)
379 & (s
.dfScp
.kind
# alias
));
383 (* -------------------------------------------- *)
385 PROCEDURE (s
: AbVar
)CheckMutable
*(x
: D
.Expr
),EXTENSIBLE
;
386 (** Determine if this variable is mutable in this scope. *
387 * Overrides CheckMutable() for Symbols.Idnt *)
389 IF s
.kind
= conId
THEN x
.ExprError(180) END;
390 IF ~
((s
.vMod
= D
.pubMode
) (* public vars are RW *)
391 OR ((s
.dfScp
# NIL) (* or scope not import *)
392 & (s
.dfScp
.kind
# impId
)
393 & (s
.dfScp
.kind
# alias
))) THEN x
.ExprError(180);
397 (* -------------------------------------------- *)
399 PROCEDURE (s
: ParId
)mutable
*() : BOOLEAN;
400 (** Determine if this variable is mutable in this scope. *
401 * Overrides mutable() for IdDesc.AbVar *)
403 RETURN (s
.parMod
# D
.in
) (* ok if param not IN *)
406 (* -------------------------------------------- *)
408 PROCEDURE (s
: ParId
)CheckMutable
*(x
: D
.Expr
);
409 (** Determine if this variable is mutable in this scope. *
410 * Overrides CheckMutable() for IdDesc.AbVar *)
412 IF s
.parMod
= D
.in
THEN x
.ExprError(179) END;
415 (* -------------------------------------------- *)
417 PROCEDURE (s
: BlkId
)isImport
*() : BOOLEAN;
418 (** Determine if this block is an module-import descriptor. *
419 * Overrides isImport() for Symbols.Scope. *)
420 BEGIN RETURN s
.kind
# modId
END isImport
;
422 (* -------------------------------------------- *)
424 PROCEDURE (s
: BlkId
)isWeak
*() : BOOLEAN;
425 (** Determine if this block is an indirect module-import. *
426 * Overrides isWeak() for Symbols.Scope. *)
427 BEGIN RETURN D
.weak
IN s
.xAttr
END isWeak
;
429 (* -------------------------------------------- *)
431 PROCEDURE (s
: AbVar
)isStatic
*() : BOOLEAN;
432 (** Determine if this variable is a static variable. *
433 * Overrides isStatic() for Symbols.Idnt. *)
435 RETURN (s
.dfScp
# NIL) (* Var is static iff: *)
436 & (s
.dfScp
IS BlkId
); (* parent is a BlkId. *)
439 (* -------------------------------------------- *)
441 PROCEDURE (s
: Procs
)isStatic
*() : BOOLEAN;
442 (** Determine if this procedure is a static procedure. *
443 * Overrides isStatic() for Symbols.Idnt. *)
445 RETURN (s
.kind
= conPrc
) (* Proc is static iff: *)
446 OR (s
.kind
= fwdPrc
); (* it is not a method. *)
449 (* -------------------------------------------- *)
451 PROCEDURE (s
: LocId
)isLocalVar
*() : BOOLEAN;
452 (** Determine if this variable is a local var or parameter. *
453 * Overrides isLocalVar() for Symbols.Idnt. *
455 * This predicate is called by JavaMaker. It should return *
456 * FALSE if the variable is in an XHR (non-locally accessed) *)
458 RETURN ~
(uplevA
IN s
.locAtt
);
464 (* -------------------------------------------- *)
466 PROCEDURE (s
: AbVar
)isDynamic
*() : BOOLEAN,EXTENSIBLE
;
467 (** Determine if this variable is of dynamic type. *
468 * A variable is dynamic if it is a pointer to a record. *
469 * Overrides isDynamic() for Symbols.Idnt. *)
471 RETURN (s
.type
# NIL) & s
.type
.isDynamicType();
474 (* -------------------------------------------- *)
476 PROCEDURE (s
: ParId
)isDynamic
*() : BOOLEAN;
477 (** Determine if this parameter is of dynamic type. *
478 * A parameter is dynamic if it is a pointer to a record, *
479 * OR if it is a VAR or IN parameter of record type. *
480 * Overrides isDynamic() for IdDesc.AbVar. *)
485 RETURN sTp
.isDynamicType()
486 OR sTp
.isRecordType() & ((s
.parMod
= D
.var
) OR (s
.parMod
= D
.in
));
491 (* -------------------------------------------- *)
493 PROCEDURE (s
: MthId
)isAbstract
*() : BOOLEAN;
494 (** Determine if this method is an abstract method. *
495 * Overrides isAbstract() for Symbols.IdDesc. *)
497 RETURN s
.mthAtt
* mask
= isAbs
;
500 (* -------------------------------------------- *)
502 PROCEDURE (s
: MthId
)isImported
*() : BOOLEAN;
503 (* Overrides isImported() for Symbols.IdDesc. *)
505 RETURN (s
.bndType
# NIL) & s
.bndType
.isImportedType();
508 (* -------------------------------------------- *)
510 PROCEDURE (s
: MthId
)callForbidden
*() : BOOLEAN,NEW;
512 * A call is forbidden if
513 * (1) this is an override of an implement-only method
514 * (2) this is an imported, implement-only method
517 RETURN (noCall
IN s
.mthAtt
) OR
518 (s
.vMod
= D
.rdoMode
) & s
.bndType
.isImportedType();
521 (* -------------------------------------------- *)
523 PROCEDURE (s
: MthId
)isEmpty
*() : BOOLEAN;
524 (** Determine if this method is an abstract method. *
525 * Overrides isEmpty() for Symbols.IdDesc. *)
528 set
:= s
.mthAtt
* mask
;
529 RETURN (set
= empty
) OR (set
= isAbs
);
532 (* -------------------------------------------- *)
534 PROCEDURE (s
: PrcId
)isEmpty
*() : BOOLEAN,EXTENSIBLE
;
535 (** Determine if this procedure is a .ctor method. *
536 * Overrides isEmpty() for Symbols.IdDesc. *)
538 RETURN (s
.kind
= ctorP
) &
539 ((s
.basCll
= NIL) OR s
.basCll
.empty
);
542 (* -------------------------------------------- *)
544 PROCEDURE (s
: ParId
)parMode
*() : INTEGER;
545 (** Return the parameter mode. *
546 * Overrides pMode() for Symbols.IdDesc. *)
551 (* -------------------------------------------- *)
553 PROCEDURE (s
: LocId
)isIn
*(set
: V
.VarSet
) : BOOLEAN;
554 (** Determine if this variable is in this live set. *
555 * Overrides isIn() for Symbols.IdDesc. *)
557 RETURN set
.includes(s
.varOrd
);
560 (* -------------------------------------------- *)
562 PROCEDURE (id
: OvlId
)findProc
*(p
: Procs
) : Procs
, NEW;
566 ASSERT(id
.hash
= p
.hash
);
567 FOR index
:= 0 TO id
.list
.tide
-1 DO
568 IF p
.type
.sigsMatch(id
.list
.a
[index
].type
) THEN
569 RETURN id
.list
.a
[index
];
575 (* ============================================================ *)
576 (* Constructor procedures for Subtypes *)
577 (* ============================================================ *)
579 PROCEDURE newConId
*() : ConId
;
588 (* -------------------------------------------- *)
590 PROCEDURE newTypId
*(type
: D
.Type
) : TypId
;
599 (* -------------------------------------------- *)
601 PROCEDURE newDerefId
*(ptrId
: D
.Idnt
) : TypId
;
604 rslt
:= newTypId(NIL);
606 * rslt.hash := N.enterStr(N.charOpenOfHash(ptrId.hash)^ + '^');
608 rslt
.hash
:= ptrId
.hash
;
609 rslt
.dfScp
:= ptrId
.dfScp
;
614 (* -------------------------------------------- *)
616 PROCEDURE newAnonId
*(ord
: INTEGER) : TypId
;
618 iStr
: ARRAY 16 OF CHAR;
620 rslt
:= newTypId(NIL);
621 GPText
.IntToStr(ord
, iStr
);
622 rslt
.hash
:= N
.enterStr(D
.anonMrk
+ iStr
);
626 (* -------------------------------------------- *)
628 PROCEDURE newSfAnonId
*(ord
: INTEGER) : TypId
;
630 iStr
: ARRAY 16 OF CHAR;
632 rslt
:= newTypId(NIL);
633 GPText
.IntToStr(ord
, iStr
);
634 rslt
.hash
:= N
.enterStr("__t" + iStr
);
638 (* -------------------------------------------- *)
640 PROCEDURE newVarId
*() : VarId
;
643 NEW(rslt
); rslt
.SetKind(varId
); RETURN rslt
;
646 (* -------------------------------------------- *)
648 PROCEDURE newLocId
*() : LocId
;
651 NEW(rslt
); rslt
.SetKind(varId
); RETURN rslt
;
654 (* -------------------------------------------- *)
656 PROCEDURE newFldId
*() : FldId
;
659 NEW(rslt
); rslt
.SetKind(fldId
); RETURN rslt
;
662 (* -------------------------------------------- *)
664 PROCEDURE newParId
*() : ParId
;
667 NEW(rslt
); rslt
.SetKind(parId
); RETURN rslt
;
670 (* -------------------------------------------- *)
672 PROCEDURE cloneParInScope
*(par
: ParId
; scope
: D
.Scope
) : ParId
;
681 (* -------------------------------------------- *)
683 PROCEDURE newQuaId
*() : ParId
;
686 NEW(rslt
); rslt
.SetKind(quaId
); RETURN rslt
;
689 (* -------------------------------------------- *)
691 PROCEDURE newOvlId
*() : OvlId
;
696 InitPrcSeq(rslt
.list
, 2);
700 (* -------------------------------------------- *)
702 PROCEDURE newPrcId
*() : PrcId
;
711 (* -------------------------------------------- *)
713 PROCEDURE newMthId
*() : MthId
;
722 (* -------------------------------------------- *)
724 PROCEDURE newImpId
*() : BlkId
;
728 INCL(rslt
.xAttr
, D
.weak
);
733 (* -------------------------------------------- *)
735 PROCEDURE newAlias
*() : BlkId
;
738 NEW(rslt
); rslt
.SetKind(alias
); RETURN rslt
;
741 (* -------------------------------------------- *)
743 PROCEDURE newModId
*() : BlkId
;
746 NEW(rslt
); rslt
.SetKind(modId
); RETURN rslt
;
749 (* ============================================================ *)
750 (* Set procedures for ReadOnly fields *)
751 (* ============================================================ *)
753 PROCEDURE (c
: ConId
)SetStd
*(),NEW;
758 (* -------------------------------------------- *)
760 PROCEDURE (c
: PrcId
)SetOrd
*(n
: INTEGER),NEW;
765 (* -------------------------------------------- *)
767 PROCEDURE (p
: Procs
)setPrcKind
*(kind
: INTEGER),NEW;
769 ASSERT((kind
= conMth
) OR (kind
= conPrc
) OR
770 (kind
= fwdMth
) OR (kind
= fwdPrc
) OR
775 (* ============================================================ *)
776 (* Methods on PrcId type, for procedure/method entry. *)
777 (* ============================================================ *)
779 PROCEDURE (desc
: Procs
)CheckElab
*(fwd
: D
.Idnt
),NEW,EMPTY
;
781 (* -------------------------------------------- *)
783 PROCEDURE (desc
: PrcId
)CheckElab
*(fwd
: D
.Idnt
);
787 IF (fwdD
.type
# NIL) & (desc
.type
# NIL) THEN
788 IF ~desc
.type
.procMatch(fwdD
.type
) THEN
790 ELSIF ~desc
.type
.namesMatch(fwdD
.type
) THEN
792 ELSIF fwdD
.pAttr
* useMsk
# {} THEN
793 desc
.pAttr
:= desc
.pAttr
+ fwdD
.pAttr
;
795 IF desc
.vMod
= D
.prvMode
THEN desc
.SetMode(fwd
.vMod
) END; (* copy *)
796 fwdD
.resolve
:= desc
;
798 fwdD
.type
:= desc
.type
;
802 (* -------------------------------------------- *)
804 PROCEDURE (desc
: MthId
)CheckElab
*(fwd
: D
.Idnt
);
808 IF desc
.mthAtt
# fwdD
.mthAtt
THEN desc
.IdError(66) END;
809 IF (desc
.rcvFrm
# NIL) & (fwdD
.rcvFrm
# NIL) THEN
810 IF desc
.rcvFrm
.parMod
# fwdD
.rcvFrm
.parMod
THEN desc
.IdError(64) END;
811 IF desc
.rcvFrm
.hash
# fwdD
.rcvFrm
.hash
THEN desc
.IdError(65) END;
812 IF desc
.rcvFrm
.type
# fwdD
.rcvFrm
.type
THEN desc
.IdError(70) END;
814 IF (fwdD
.type
# NIL) & (desc
.type
# NIL) THEN
815 IF ~desc
.type
.procMatch(fwdD
.type
) THEN
817 ELSIF ~desc
.type
.namesMatch(fwdD
.type
) THEN
819 ELSIF fwdD
.pAttr
* useMsk
# {} THEN
820 desc
.pAttr
:= desc
.pAttr
+ fwdD
.pAttr
;
822 IF desc
.vMod
= D
.prvMode
THEN desc
.SetMode(fwd
.vMod
) END; (* copy *)
823 fwdD
.resolve
:= desc
;
825 fwdD
.type
:= desc
.type
;
829 (* -------------------------------------------- *)
831 PROCEDURE (desc
: Procs
)EnterProc
*(rcv
: ParId
; scp
: D
.Scope
),NEW,EMPTY
;
833 (* -------------------------------------------- *)
835 PROCEDURE (desc
: PrcId
)EnterProc
*(rcv
: ParId
; scp
: D
.Scope
);
839 IF D
.refused(desc
, scp
) THEN
840 fwd
:= scp
.symTb
.lookup(desc
.hash
);
841 IF fwd
.kind
= fwdPrc
THEN (* check the elaboration *)
843 scp
.symTb
.Overwrite(desc
.hash
, desc
);
844 ELSIF fwd
.kind
= fwdMth
THEN
853 (* -------------------------------------------- *)
855 PROCEDURE (desc
: MthId
)EnterProc
*(rcv
: ParId
; scp
: D
.Scope
);
861 IF desc
.dfScp
.kind
# modId
THEN
862 desc
.IdError(122); RETURN; (* PREMATURE RETURN *)
864 IF rcv
.isDynamic() THEN
865 rTp
:= rcv
.type
.boundRecTp();
866 IF (rcv
.parMod
# D
.val
) & rcv
.type
.isPointerType() THEN
867 rcv
.IdError(206); RETURN; (* PREMATURE RETURN *)
868 ELSIF rTp
.isImportedType() THEN
869 rcv
.IdErrorStr(205, rTp
.name()); RETURN; (* PREMATURE RETURN *)
871 ELSIF (rcv
.type
# NIL) & rcv
.type
.isRecordType() THEN
872 desc
.IdError(107); RETURN; (* PREMATURE RETURN *)
874 desc
.IdError(104); RETURN; (* PREMATURE RETURN *)
876 IF rTp
# NIL THEN (* insert in rec. scope *)
877 rTp
.InsertMethod(desc
);
882 (* -------------------------------------------- *)
884 PROCEDURE (desc
: Procs
)MethodAttr(),NEW,EMPTY
;
886 (* -------------------------------------------- *)
888 PROCEDURE (mDesc
: MthId
)MethodAttr();
895 bndTp
:= mDesc
.bndType
;
896 rcvTp
:= mDesc
.rcvFrm
.type
;
897 mMask
:= mDesc
.mthAtt
* mask
;
898 IF (mMask
# isAbs
) & bndTp
.isInterfaceType() THEN
899 mDesc
.IdError(188); RETURN;
902 * Check #1: is there an equally named method inherited?
904 inhId
:= bndTp
.inheritedFeature(mDesc
);
906 * Check #2: are the method attributes consistent
910 * 2.0 If not an override, then must be NEW
912 IF ~
(newBit
IN mDesc
.mthAtt
) THEN mDesc
.IdError(105);
913 ELSIF (rcvTp
.idnt
.vMod
= D
.prvMode
) &
914 (mDesc
.vMod
= D
.pubMode
) THEN mDesc
.IdError(195);
916 ELSIF inhId
.kind
= conMth
THEN
917 prevM
:= inhId(MthId
);
918 pMask
:= prevM
.mthAtt
* mask
;
920 * 2.1 Formals must match, with retType covariant maybe
922 prevM
.type
.CheckCovariance(mDesc
);
924 * 2.2 If an override, then must not be NEW
926 IF newBit
IN mDesc
.mthAtt
THEN mDesc
.IdError(106) END;
928 * 2.3 Super method must be extensible
930 IF pMask
= final
THEN mDesc
.IdError(108) END;
932 * 2.4 If this is abstract, so must be the super method
934 IF (mMask
= isAbs
) & (pMask
# isAbs
) THEN mDesc
.IdError(109) END;
936 * 2.5 If empty, the super method must be abstract or empty
939 (pMask
# isAbs
) & (pMask
# empty
) THEN mDesc
.IdError(112) END;
941 * 2.6 If inherited method is exported, then so must this method
945 * Not clear about the semantics here. The ComPlus2 VOS
946 * (and the JVM) rejects redefined methods that try to
947 * limit access, even if the receiver is not public.
949 * It would be possible to only reject cases where the
950 * receiver is exported, and then secretly mark the method
951 * definition in the IL as public after all ...
953 * ... and this is the implemented semantics from gpcp 1.1.5
956 IF (prevM
.vMod
= D
.pubMode
) &
957 (mDesc
.vMod
# D
.pubMode
) THEN
958 IF rcvTp
.idnt
.vMod
= D
.pubMode
THEN
961 INCL(mDesc
.mthAtt
, widen
);
963 ELSIF (prevM
.vMod
= D
.rdoMode
) &
964 (mDesc
.vMod
# D
.rdoMode
) THEN
965 IF rcvTp
.idnt
.vMod
= D
.pubMode
THEN
967 ELSIF rcvTp
.idnt
.vMod
= D
.prvMode
THEN
968 INCL(mDesc
.mthAtt
, widen
);
972 * If inherited method is overloaded, then so must this be.
974 IF prevM
.prcNm
# NIL THEN mDesc
.prcNm
:= prevM
.prcNm
END;
978 IF (mMask
= isAbs
) & ~bndTp
.isAbsRecType() THEN
980 * Check #3: if method is abstract bndTp must be abstract
982 rcvTp
.TypeError(110);
983 ELSIF mMask
= empty
THEN
985 * Check #4: if method is empty then no-ret and no OUTpars
987 mDesc
.type
.CheckEmptyOK();
988 IF (newBit
IN mDesc
.mthAtt
) & ~bndTp
.isExtnRecType() THEN
990 * Check #5: if mth is empty and new, rcv must be extensible
992 rcvTp
.TypeError(111);
994 ELSIF (mMask
= extns
) & ~bndTp
.isExtnRecType() THEN
996 * Check #6: if mth is ext. rcv must be abs. or extensible
998 S
.SemError
.RepSt1(117,
999 D
.getName
.ChPtr(rcvTp
.idnt
),
1000 mDesc
.token
.lin
, mDesc
.token
.col
);
1004 (* -------------------------------------------- *)
1006 PROCEDURE (desc
: Procs
)retTypBound
*() : D
.Type
,NEW,EXTENSIBLE
;
1007 BEGIN RETURN NIL END retTypBound
;
1009 (* -------------------------------------------- *)
1011 PROCEDURE (mDesc
: MthId
)retTypBound
*() : D
.Type
;
1015 bndTp
:= mDesc
.bndType
;
1016 prevM
:= bndTp
.inheritedFeature(mDesc
)(MthId
);
1017 IF covar
IN prevM
.mthAtt
THEN
1018 RETURN prevM
.retTypBound();
1020 RETURN prevM
.type
.returnType();
1024 (* -------------------------------------------- *)
1026 PROCEDURE (prc
: Procs
)RetCheck(fin
: V
.VarSet
; eNm
: INTEGER),NEW;
1028 IF ~prc
.type
.isProperProcType() & (* ==> function procedure *)
1029 ~prc
.isAbstract() & (* ==> concrete procedure *)
1030 ~fin
.isUniv() THEN (* ==> flow missed RETURN *)
1036 (* -------------------------------------------- *)
1038 PROCEDURE (var
: AbVar
)VarInit(ini
: V
.VarSet
),NEW;
1041 IF (var
.parMod
# D
.out
) OR
1042 ~var
.type
.isScalarType() THEN ini
.Incl(var
.varOrd
) END;
1044 IF ~var
.type
.isScalarType() THEN ini
.Incl(var
.varOrd
) END;
1046 IF ~var
.type
.isScalarType() THEN ini
.Incl(var
.varOrd
) END;
1051 (* -------------------------------------------- *)
1053 PROCEDURE (mod
: BlkId
)LiveInitialize
*(ini
: V
.VarSet
);
1057 (* initialize the local vars *)
1058 FOR ix
:= 0 TO mod
.locals
.tide
-1 DO
1059 var
:= mod
.locals
.a
[ix
];
1060 var(AbVar
).VarInit(ini
);
1064 (* -------------------------------------------- *)
1066 PROCEDURE (prc
: Procs
)LiveInitialize
*(ini
: V
.VarSet
);
1070 (* [initialize the receiver] *)
1071 (* initialize the parameters *)
1072 (* initialize the quasi-pars *)
1073 (* initialize the local vars *)
1074 FOR ix
:= 0 TO prc
.locals
.tide
-1 DO
1075 var
:= prc
.locals
.a
[ix
];
1076 var(AbVar
).VarInit(ini
);
1080 (* -------------------------------------------- *)
1082 PROCEDURE (prc
: Procs
)UplevelInitialize
*(ini
: V
.VarSet
);
1086 FOR ix
:= 0 TO prc
.locals
.tide
-1 DO
1088 * If we were setting uplevR and uplevW separately, we
1089 * could be less conservative and test uplevW only.
1091 var
:= prc
.locals
.a
[ix
](LocId
);
1092 IF uplevA
IN var
.locAtt
THEN ini
.Incl(var
.varOrd
) END;
1094 END UplevelInitialize
;
1096 (* ============================================================ *)
1097 (* Methods on BlkId type, for mainline computation *)
1098 (* ============================================================ *)
1100 PROCEDURE (b
: BlkId
)EmitCode
*(),NEW;
1104 (* -------------------------------------------- *)
1106 PROCEDURE (b
: BlkId
)TypeErasure
*(sfa
: D
.SymForAll
), NEW;
1107 VAR prcIx
: INTEGER;
1111 FOR prcIx
:= 0 TO b
.procs
.tide
- 1 DO
1112 iDesc
:= b
.procs
.a
[prcIx
];
1113 pDesc
:= iDesc(Procs
);
1114 IF (pDesc
.kind
# fwdPrc
) &
1115 (pDesc
.kind
# fwdMth
) &
1116 (pDesc
.body
# NIL) THEN
1117 IF pDesc
.body
# NIL THEN pDesc
.body
.TypeErase(pDesc
) END;
1118 IF pDesc
.rescue
# NIL THEN pDesc
.rescue
.TypeErase(pDesc
) END;
1121 IF b
.modBody
# NIL THEN b
.modBody
.TypeErase(b
) END;
1122 IF b
.modClose
# NIL THEN b
.modClose
.TypeErase(b
) END;
1123 (* Erase types in the symbol table *)
1127 (* -------------------------------------------- *)
1129 PROCEDURE (b
: BlkId
)StatementAttribution
*(sfa
: D
.SymForAll
),NEW;
1130 VAR prcIx
: INTEGER;
1135 (* ---------------------------------------- *)
1136 PROCEDURE parentIsCalled(mthd
: MthId
) : BOOLEAN;
1140 * Invariant : ~(called IN mthd.pAttr)
1143 IF newBit
IN mthd
.mthAtt
THEN RETURN FALSE
;
1145 prId
:= mthd
.bndType
.inheritedFeature(mthd
);
1146 (* This next can never be true for correct programs *)
1147 IF prId
= NIL THEN RETURN FALSE
END;
1148 mthd
:= prId(MthId
);
1149 IF prId
.isImported() OR
1150 (mthd
.pAttr
* useMsk
# {}) THEN RETURN TRUE
END;
1154 (* ---------------------------------------- *)
1156 FOR prcIx
:= 0 TO b
.procs
.tide
- 1 DO
1157 iDesc
:= b
.procs
.a
[prcIx
];
1158 pDesc
:= iDesc(Procs
);
1159 IF (pDesc
.kind
= fwdPrc
) OR (pDesc
.kind
= fwdMth
) THEN
1160 IF pDesc
.resolve
= NIL THEN pDesc
.IdError(72) END;
1161 ELSIF pDesc
.kind
= ctorP
THEN
1162 bType
:= pDesc
.type
.returnType();
1163 IF bType
# NIL THEN bType
:= bType
.boundRecTp() END;
1166 ELSIF bType
.isImportedType() THEN
1168 ELSE (* remainder of semantic checks in AppendCtor *)
1169 bType
.AppendCtor(pDesc
);
1172 IF pDesc
.kind
= conMth
THEN pDesc
.MethodAttr() END;
1173 IF pDesc
.body
# NIL THEN pDesc
.body
.StmtAttr(pDesc
) END;;
1174 IF pDesc
.rescue
# NIL THEN pDesc
.rescue
.StmtAttr(pDesc
) END;;
1176 * Now we generate warnings for useless procedures.
1178 IF pDesc
.pAttr
* useMsk
= {} THEN
1179 WITH pDesc
: MthId
DO
1181 * The test here is tricky: if an overridden
1182 * method is called, then this method might
1183 * be dynamically dispatched. We check this.
1185 IF ~
parentIsCalled(pDesc
) THEN pDesc
.IdError(304) END;
1188 * On the other hand, if it is static, not exported
1189 * and is not called then it definitely is useless.
1198 * Now we must check if the synthetic static class
1199 * in the .NET version will have a name clash with
1200 * any other symbol in the assembly.
1201 * If so, we must mangle the explicit name.
1204 ~
(D
.rtsMd
IN b
.xAttr
) &
1205 (b
.symTb
.lookup(b
.hash
) # NIL) THEN
1206 dName
:= D
.getName
.ChPtr(b
);
1207 b
.scopeNm
:= L
.strToCharOpen("[" + dName^
+ "]" + dName^
);
1208 b
.hash
:= N
.enterStr("__" + dName^
);
1209 S
.SemError
.RepSt1(308, D
.getName
.ChPtr(b
), b
.token
.lin
, b
.token
.col
);
1211 IF b
.modBody
# NIL THEN b
.modBody
.StmtAttr(b
) END;
1212 IF b
.modClose
# NIL THEN b
.modClose
.StmtAttr(b
) END;
1213 END StatementAttribution
;
1215 (* -------------------------------------------- *)
1217 PROCEDURE (b
: BlkId
)DataflowAttribution
*(),NEW;
1218 VAR prcIx
: INTEGER;
1224 * Fix up the modes of quasi parameters here ...
1228 * Now do dataflow analysis on each procedure ...
1230 FOR prcIx
:= 0 TO b
.procs
.tide
- 1 DO
1231 iDesc
:= b
.procs
.a
[prcIx
];
1232 pDesc
:= iDesc(Procs
);
1233 IF (pDesc
.kind
# fwdPrc
) &
1234 (pDesc
.kind
# fwdMth
) &
1235 (pDesc
.body
# NIL) THEN
1237 * We do flow analysis even if there are no local
1238 * variables, in order to diagnose paths that miss
1239 * RETURN in function procedures.
1241 * Note that we throw an extra, dummy variable into
1242 * the set so that the RetCheck will always have a
1243 * missing local if there has been no return stmt.
1245 initL
:= V
.newSet(pDesc
.locals
.tide
+1);
1246 pDesc
.LiveInitialize(initL
);
1247 initL
:= pDesc
.body
.flowAttr(pDesc
, initL
);
1248 pDesc
.RetCheck(initL
, 136);
1249 pDesc
.type
.OutCheck(initL
);
1250 IF (pDesc
.rescue
# NIL) THEN
1251 initL
:= V
.newSet(pDesc
.locals
.tide
+1);
1252 pDesc
.LiveInitialize(initL
);
1253 initL
.Incl(pDesc
.except
.varOrd
);
1254 initL
:= pDesc
.rescue
.flowAttr(pDesc
, initL
);
1255 pDesc
.RetCheck(initL
, 138);
1256 pDesc
.type
.OutCheck(initL
);
1260 initL
:= V
.newSet(b
.locals
.tide
);
1261 b
.LiveInitialize(initL
);
1262 IF b
.modBody
# NIL THEN initL
:= b
.modBody
.flowAttr(b
, initL
) END;
1263 IF b
.modClose
# NIL THEN initL
:= b
.modClose
.flowAttr(b
, initL
) END;
1264 END DataflowAttribution
;
1266 (* ============================================================ *)
1267 (* Diagnostic methods *)
1268 (* ============================================================ *)
1270 PROCEDURE PType(t
: D
.Type
);
1272 IF t
# NIL THEN Console
.WriteString(t
.name()) END;
1275 (* ------------------------------- *)
1277 PROCEDURE KType
*(i
: INTEGER);
1280 | errId
: Console
.WriteString("errId ");
1281 | conId
: Console
.WriteString("conId ");
1282 | varId
: Console
.WriteString("varId ");
1283 | parId
: Console
.WriteString("parId ");
1284 | quaId
: Console
.WriteString("quaId ");
1285 | typId
: Console
.WriteString("typId ");
1286 | modId
: Console
.WriteString("modId ");
1287 | impId
: Console
.WriteString("impId ");
1288 | alias
: Console
.WriteString("alias ");
1289 | fldId
: Console
.WriteString("fldId ");
1290 | fwdMth
: Console
.WriteString("fwdMth ");
1291 | conMth
: Console
.WriteString("conMth ");
1292 | fwdPrc
: Console
.WriteString("fwdPrc ");
1293 | conPrc
: Console
.WriteString("conPrc ");
1294 | fwdTyp
: Console
.WriteString("fwdTyp ");
1295 | ctorP
: Console
.WriteString("ctorP ");
1296 ELSE Console
.WriteString("ERROR ");
1300 (* ------------------------------- *)
1302 PROCEDURE (s
: ConId
)Diagnose
*(i
: INTEGER);
1305 H
.Indent(i
+2); KType(s
.kind
); Console
.WriteLn
;
1306 IF s
.conExp
# NIL THEN s
.conExp
.Diagnose(i
+4) END;
1309 PROCEDURE (s
: FldId
)Diagnose
*(i
: INTEGER);
1312 H
.Indent(i
+2); KType(s
.kind
);
1313 IF s
.type
# NIL THEN PType(s
.type
) END;
1317 PROCEDURE (s
: TypId
)Diagnose
*(i
: INTEGER);
1320 H
.Indent(i
+2); KType(s
.kind
);
1321 IF s
.type
# NIL THEN
1322 PType(s
.type
); Console
.WriteLn
;
1323 s
.type
.SuperDiag(i
+2);
1328 PROCEDURE (s
: AbVar
)Diagnose
*(i
: INTEGER),EXTENSIBLE
;
1331 H
.Indent(i
+2); KType(s
.kind
);
1332 IF s
.type
# NIL THEN PType(s
.type
) END;
1336 PROCEDURE (s
: ParId
)Diagnose
*(i
: INTEGER);
1339 H
.Indent(i
+2); KType(s
.kind
);
1340 IF s
.type
# NIL THEN PType(s
.type
) END;
1344 PROCEDURE (s
: ParId
)DiagPar
*(),NEW;
1345 VAR str
: L
.CharOpen
;
1347 Console
.WriteString(D
.modStr
[s
.parMod
]);
1348 str
:= D
.getName
.ChPtr(s
);
1350 Console
.WriteString(str
);
1352 Console
.WriteString("(p#");
1353 Console
.WriteInt(s
.varOrd
,1);
1356 Console
.WriteString(" : ");
1357 Console
.WriteString(s
.type
.name());
1360 PROCEDURE (s
: LocId
)DiagVar
*(),NEW;
1362 Console
.WriteString(D
.getName
.ChPtr(s
));
1363 Console
.WriteString(" (#");
1364 Console
.WriteInt(s
.varOrd
,1);
1366 Console
.WriteString(" : ");
1367 Console
.WriteString(s
.type
.name());
1371 PROCEDURE (s
: Procs
)DiagVars(i
: INTEGER),NEW;
1375 H
.Indent(i
); Console
.Write("{");
1376 IF s
.locals
.tide
= 0 THEN
1380 FOR ix
:= 0 TO s
.locals
.tide
-1 DO
1382 var
:= s
.locals
.a
[ix
];
1383 var(LocId
).DiagVar();
1386 H
.Indent(i
); Console
.Write("}");
1391 PROCEDURE (s
: PrcId
)Diagnose
*(i
: INTEGER);
1393 H
.Indent(i
); Console
.WriteString("PROCEDURE");
1394 IF s
.kind
= fwdPrc
THEN Console
.Write("^") END;
1396 Console
.WriteString(D
.getName
.ChPtr(s
));
1397 s
.type
.DiagFormalType(i
+4);
1398 IF s
.kind
= ctorP
THEN Console
.WriteString(",CONSTRUCTOR") END;
1401 D
.DoXName(i
, s
.prcNm
);
1402 D
.DoXName(i
, s
.clsNm
);
1403 D
.DoXName(i
, s
.scopeNm
);
1406 PROCEDURE (s
: MthId
)Diagnose
*(i
: INTEGER);
1408 H
.Indent(i
); Console
.WriteString("PROCEDURE");
1409 IF s
.kind
= fwdMth
THEN Console
.Write("^") END;
1414 Console
.WriteString(D
.getName
.ChPtr(s
));
1415 s
.type
.DiagFormalType(i
+4);
1418 D
.DoXName(i
, s
.prcNm
);
1421 PROCEDURE (s
: OvlId
)Diagnose
*(i
: INTEGER);
1425 H
.Indent(i
); Console
.WriteString("OVERLOADED PROCS with name <");
1426 Console
.WriteString(D
.getName
.ChPtr(s
));
1427 Console
.WriteString(">");
1429 FOR index
:= 0 TO s
.list
.tide
-1 DO
1430 s
.list
.a
[index
].Diagnose(i
+2);
1432 H
.Indent(i
); Console
.WriteString("END OVERLOADED PROCS with name ");
1433 Console
.WriteString(D
.getName
.ChPtr(s
));
1434 Console
.WriteString(">");
1438 PROCEDURE (s
: BlkId
)Diagnose
*(i
: INTEGER);
1441 H
.Indent(i
+2); KType(s
.kind
);
1442 IF D
.weak
IN s
.xAttr
THEN Console
.WriteString(" (weak)") END;
1445 D
.DoXName(i
, s
.scopeNm
);
1446 D
.DoXName(i
, s
.xName
);
1449 (* ============================================================ *)
1450 BEGIN (* ====================================================== *)
1451 END IdDesc
. (* ============================================== *)
1452 (* ============================================================ *)