gpcp/IdDesc.cp

   1 (* ==================================================================== *)
   2 (*                                                                      *)
   3 (*  IdDesc Module for the Gardens Point Component Pascal Compiler.      *)
   4 (*  Implements identifier descriptors that are extensions of            *)
   5 (*  Symbols.Idnt                                                        *)
   6 (*                                                                      *)
   7 (*  Copyright (c) John Gough 1999, 2000.                                *)
   8 (*                                                                      *)
   9 (* ==================================================================== *)
  10
  11 MODULE IdDesc;
  12
  13   IMPORT
  14         GPCPcopyright,
  15         GPText,
  16         Console,
  17         V := VarSets,
  18         S := CPascalS,
  19         D := Symbols,
  20         L := LitValue,
  21         H := DiagHelper,
  22         N := NameHash,
  23         FileNames;
  24
  25 (* ============================================================ *)
  26
  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;
  31     ctorP*  = 15;
  32
  33   CONST (* method attributes *)
  34     newBit* = 0;
  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.      *)
  43
  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 *)
  50
  51 (* ============================================================ *)
  52
  53   TYPE
  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 *)
  62               * tgXtn* : ANYPTR;
  63               * ----------------------------------------- *)
  64               END;  (* ------------------------------ *)
  65
  66 (* ============================================================ *)
  67
  68   TYPE
  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 *)
  77               * tgXtn* : ANYPTR;
  78               * ----------------------------------------- *)
  79                 recTyp* : D.Type;
  80                 conExp* : D.Expr;
  81                 isStd-  : BOOLEAN;  (* false if ~std  *)
  82               END;  (* ------------------------------ *)
  83
  84 (* ============================================================ *)
  85
  86   TYPE
  87     AbVar*  = POINTER TO ABSTRACT RECORD (D.Idnt)
  88               (* Abstract Variables ... *)
  89                 varOrd* : INTEGER;  (* local var ord. *)
  90               END;
  91
  92 (* ============================================================ *)
  93
  94   TYPE
  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 *)
 103               * tgXtn* : ANYPTR;
 104               * ---- ... inherited from AbVar ... ------- *
 105               * varOrd* : INTEGER;      (* local var ord. *)
 106               * ----------------------------------------- *)
 107                 recTyp* : D.Type;
 108                 clsNm*  : L.CharOpen;   (* external name  *)
 109                 varNm*  : L.CharOpen;   (* external name  *)
 110               END;      (* ------------------------------ *)
 111
 112 (* ============================================================ *)
 113
 114   TYPE
 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 *)
 123               * tgXtn* : ANYPTR;
 124               * ---- ... inherited from AbVar ... ------- *
 125               * varOrd* : INTEGER;      (* local var ord. *)
 126               * ----------------------------------------- *)
 127                 recTyp* : D.Type;
 128                 fldNm*  : L.CharOpen;   (* external name  *)
 129               END;      (* ------------------------------ *)
 130
 131 (* ============================================================ *)
 132
 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!  *)
 141
 142   TYPE
 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 *)
 152               * tgXtn* : ANYPTR;
 153               * ---- ... inherited from AbVar ... ------- *
 154               * varOrd* : INTEGER;      (* local var ord. *)
 155               * ----------------------------------------- *)
 156                 locAtt* : SET;
 157                 boxOrd* : INTEGER;      (* if boxd in RTS *)
 158               END;      (* ------------------------------ *)
 159
 160 (* ============================================================ *)
 161
 162   TYPE
 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 *)
 171               * tgXtn* : ANYPTR;
 172               * ---- ... inherited from AbVar ... ------- *
 173               * varOrd* : INTEGER;      (* local var ord. *)
 174               * ---- ... inherited from LocId ... ------- *
 175               * locAtt* : SET;
 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;      (* ------------------------------ *)
 183
 184     ParSeq* = RECORD
 185                 tide-, high : INTEGER;
 186                 a- : POINTER TO ARRAY OF ParId;
 187               END;
 188
 189 (* ============================================================ *)
 190
 191   TYPE
 192     BaseCall* = POINTER TO RECORD
 193                   actuals* : D.ExprSeq;
 194                   sprCtor* : Procs;
 195                   empty*   : BOOLEAN;
 196                 END;
 197
 198 (* ============================================================ *)
 199
 200   TYPE
 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 *)
 209               * tgXtn* : ANYPTR;
 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;      (* ------------------------------ *)
 231
 232     PrcSeq*  = RECORD
 233                 tide-, high : INTEGER;
 234                 a- : POINTER TO ARRAY OF Procs;
 235               END;
 236
 237     PrcId*  = POINTER TO EXTENSIBLE RECORD (Procs)
 238                 clsNm*  : L.CharOpen;   (* external name  *)
 239                 stdOrd* : INTEGER;
 240               END;      (* ------------------------------ *)
 241
 242     MthId*  = POINTER TO RECORD (Procs)
 243                 mthAtt*  : SET;         (* mth attributes *)
 244                 rcvFrm*  : ParId;       (* receiver frmal *)
 245               END;      (* ------------------------------ *)
 246
 247 (* ============================================================ *)
 248
 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)
 255                 list* : PrcSeq;
 256                 rec*  : D.Type;
 257                 fld*  : D.Idnt;
 258               END;
 259
 260 (* ============================================================ *)
 261
 262   TYPE
 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 *)
 271               * tgXtn* : ANYPTR;
 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               * ----------------------------------------- *)
 279                             aliasMod* : BlkId;
 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;
 292                 begTok*   : S.Token;
 293                 endTok*   : S.Token;
 294               END;      (* ------------------------------ *)
 295
 296 (* ============================================================ *)
 297 (*               Append for the PrcSeq, ParSeq types.   *)
 298 (* ============================================================ *)
 299
 300   PROCEDURE InitPrcSeq*(VAR seq : PrcSeq; capacity : INTEGER);
 301   BEGIN
 302     NEW(seq.a, capacity); seq.tide := 0; seq.high := capacity-1;
 303   END InitPrcSeq;
 304
 305   PROCEDURE ResetPrcSeq*(VAR seq : PrcSeq);
 306   BEGIN
 307     seq.tide := 0;
 308     IF seq.a = NIL THEN InitPrcSeq(seq, 2) END;
 309     seq.a[0] := NIL;
 310   END ResetPrcSeq;
 311
 312   PROCEDURE AppendProc*(VAR seq : PrcSeq; elem : Procs);
 313     VAR temp : POINTER TO ARRAY OF Procs;
 314         i    : INTEGER;
 315   BEGIN
 316     IF seq.a = NIL THEN
 317       InitPrcSeq(seq, 2);
 318     ELSIF seq.tide > seq.high THEN (* must expand *)
 319       temp := seq.a;
 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;
 323     END;
 324     seq.a[seq.tide] := elem; INC(seq.tide);
 325   END AppendProc;
 326
 327   PROCEDURE RemoveProc*(VAR seq : PrcSeq; elemPos : INTEGER);
 328   VAR
 329     ix : INTEGER;
 330   BEGIN
 331     FOR ix := elemPos TO seq.tide-2 DO
 332       seq.a[ix] := seq.a[ix+1];
 333     END;
 334     DEC(seq.tide);
 335   END RemoveProc;
 336
 337 (* -------------------------------------------- *)
 338
 339   PROCEDURE InitParSeq*(VAR seq : ParSeq; capacity : INTEGER);
 340   BEGIN
 341     NEW(seq.a, capacity); seq.tide := 0; seq.high := capacity-1;
 342   END InitParSeq;
 343
 344   PROCEDURE ResetParSeq*(VAR seq : ParSeq);
 345   BEGIN
 346     seq.tide := 0;
 347     IF seq.a = NIL THEN InitParSeq(seq, 2) END;
 348     seq.a[0] := NIL;
 349   END ResetParSeq;
 350
 351   PROCEDURE AppendParam*(VAR seq : ParSeq; elem : ParId);
 352     VAR temp : POINTER TO ARRAY OF ParId;
 353         i    : INTEGER;
 354   BEGIN
 355     IF seq.a = NIL THEN
 356       InitParSeq(seq, 2);
 357     ELSIF seq.tide > seq.high THEN (* must expand *)
 358       temp := seq.a;
 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;
 362     END;
 363     seq.a[seq.tide] := elem; INC(seq.tide);
 364   END AppendParam;
 365
 366 (* ============================================================ *)
 367 (*        Predicate implementations     *)
 368 (* ============================================================ *)
 369
 370   PROCEDURE (s : AbVar)mutable*() : BOOLEAN,EXTENSIBLE;
 371   (** Determine if this variable is mutable in this scope.  *
 372    *  Overrides mutable() for Symbols.Idnt      *)
 373   BEGIN
 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));
 380     END;
 381   END mutable;
 382
 383 (* -------------------------------------------- *)
 384
 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     *)
 388   BEGIN
 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);
 394     END;
 395   END CheckMutable;
 396
 397 (* -------------------------------------------- *)
 398
 399   PROCEDURE (s : ParId)mutable*() : BOOLEAN;
 400   (** Determine if this variable is mutable in this scope.  *
 401    *  Overrides mutable() for IdDesc.AbVar      *)
 402   BEGIN
 403     RETURN (s.parMod # D.in)    (* ok if param not IN *)
 404   END mutable;
 405
 406 (* -------------------------------------------- *)
 407
 408   PROCEDURE (s : ParId)CheckMutable*(x : D.Expr);
 409   (** Determine if this variable is mutable in this scope.  *
 410    *  Overrides CheckMutable() for IdDesc.AbVar     *)
 411   BEGIN
 412     IF s.parMod = D.in THEN x.ExprError(179) END;
 413   END CheckMutable;
 414
 415 (* -------------------------------------------- *)
 416
 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;
 421
 422 (* -------------------------------------------- *)
 423
 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;
 428
 429 (* -------------------------------------------- *)
 430
 431   PROCEDURE (s : AbVar)isStatic*() : BOOLEAN;
 432   (** Determine if this variable is a static variable.    *
 433    *  Overrides isStatic() for Symbols.Idnt.      *)
 434   BEGIN
 435     RETURN (s.dfScp # NIL)    (* Var is static iff: *)
 436          & (s.dfScp IS BlkId);    (* parent is a BlkId.   *)
 437   END isStatic;
 438
 439 (* -------------------------------------------- *)
 440
 441   PROCEDURE (s : Procs)isStatic*() : BOOLEAN;
 442   (** Determine if this procedure is a static procedure.  *
 443    *  Overrides isStatic() for Symbols.Idnt.      *)
 444   BEGIN
 445     RETURN (s.kind = conPrc)    (* Proc is static iff:  *)
 446         OR (s.kind = fwdPrc);   (* it is not a method.  *)
 447   END isStatic;
 448
 449 (* -------------------------------------------- *)
 450
 451   PROCEDURE (s : LocId)isLocalVar*() : BOOLEAN;
 452   (** Determine if this variable is a local var or parameter.   *
 453    *  Overrides isLocalVar() for Symbols.Idnt.                  *
 454    *
 455    *  This predicate is called by JavaMaker.  It should return  *
 456    *  FALSE if the variable is in an XHR (non-locally accessed)   *)
 457   BEGIN
 458     RETURN ~(uplevA IN s.locAtt);
 459   (*
 460     RETURN TRUE;
 461    *)
 462   END isLocalVar;
 463
 464 (* -------------------------------------------- *)
 465
 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.     *)
 470   BEGIN
 471     RETURN (s.type # NIL) & s.type.isDynamicType();
 472   END isDynamic;
 473
 474 (* -------------------------------------------- *)
 475
 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.     *)
 481     VAR sTp : D.Type;
 482   BEGIN
 483     sTp := s.type;
 484     IF sTp # NIL THEN
 485       RETURN sTp.isDynamicType()
 486           OR sTp.isRecordType() & ((s.parMod = D.var) OR (s.parMod = D.in));
 487     END;
 488     RETURN FALSE;
 489   END isDynamic;
 490
 491 (* -------------------------------------------- *)
 492
 493   PROCEDURE (s : MthId)isAbstract*() : BOOLEAN;
 494   (** Determine if this method is an abstract method.   *
 495    *  Overrides isAbstract() for Symbols.IdDesc.    *)
 496   BEGIN
 497     RETURN s.mthAtt * mask = isAbs;
 498   END isAbstract;
 499
 500 (* -------------------------------------------- *)
 501
 502   PROCEDURE (s : MthId)isImported*() : BOOLEAN;
 503    (*  Overrides isImported() for Symbols.IdDesc.   *)
 504   BEGIN
 505     RETURN (s.bndType # NIL) & s.bndType.isImportedType();
 506   END isImported;
 507
 508 (* -------------------------------------------- *)
 509
 510   PROCEDURE (s : MthId)callForbidden*() : BOOLEAN,NEW;
 511    (*
 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
 515     *)
 516   BEGIN
 517     RETURN (noCall IN s.mthAtt) OR
 518            (s.vMod = D.rdoMode) & s.bndType.isImportedType();
 519   END callForbidden;
 520
 521 (* -------------------------------------------- *)
 522
 523   PROCEDURE (s : MthId)isEmpty*() : BOOLEAN;
 524   (** Determine if this method is an abstract method.   *
 525    *  Overrides isEmpty() for Symbols.IdDesc.     *)
 526     VAR set : SET;
 527   BEGIN
 528     set := s.mthAtt * mask;
 529     RETURN (set = empty) OR (set = isAbs);
 530   END isEmpty;
 531
 532 (* -------------------------------------------- *)
 533
 534   PROCEDURE (s : PrcId)isEmpty*() : BOOLEAN,EXTENSIBLE;
 535   (** Determine if this procedure is a .ctor method.    *
 536    *  Overrides isEmpty() for Symbols.IdDesc.     *)
 537   BEGIN
 538     RETURN (s.kind = ctorP) &
 539            ((s.basCll = NIL) OR s.basCll.empty);
 540   END isEmpty;
 541
 542 (* -------------------------------------------- *)
 543
 544   PROCEDURE (s : ParId)parMode*() : INTEGER;
 545   (** Return the parameter mode.    *
 546    *  Overrides pMode() for Symbols.IdDesc. *)
 547   BEGIN
 548     RETURN s.parMod;
 549   END parMode;
 550
 551 (* -------------------------------------------- *)
 552
 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.              *)
 556   BEGIN
 557     RETURN set.includes(s.varOrd);
 558   END isIn;
 559
 560 (* -------------------------------------------- *)
 561
 562   PROCEDURE (id : OvlId)findProc*(p : Procs) : Procs, NEW;
 563   VAR
 564     index : INTEGER;
 565   BEGIN
 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];
 570       END;
 571     END;
 572     RETURN NIL;
 573   END findProc;
 574
 575 (* ============================================================ *)
 576 (*     Constructor procedures for Subtypes    *)
 577 (* ============================================================ *)
 578
 579   PROCEDURE newConId*() : ConId;
 580     VAR rslt : ConId;
 581   BEGIN
 582     NEW(rslt);
 583     rslt.isStd := FALSE;
 584     rslt.SetKind(conId);
 585     RETURN rslt;
 586   END newConId;
 587
 588 (* -------------------------------------------- *)
 589
 590   PROCEDURE newTypId*(type : D.Type) : TypId;
 591     VAR rslt : TypId;
 592   BEGIN
 593     NEW(rslt);
 594     rslt.type  := type;
 595     rslt.SetKind(typId);
 596     RETURN rslt;
 597   END newTypId;
 598
 599 (* -------------------------------------------- *)
 600
 601   PROCEDURE newDerefId*(ptrId : D.Idnt) : TypId;
 602     VAR rslt : TypId;
 603   BEGIN
 604     rslt := newTypId(NIL);
 605 (*
 606  *  rslt.hash  := N.enterStr(N.charOpenOfHash(ptrId.hash)^ + '^');
 607  *)
 608     rslt.hash  := ptrId.hash;
 609     rslt.dfScp := ptrId.dfScp;
 610     RETURN rslt;
 611   END newDerefId;
 612
 613
 614 (* -------------------------------------------- *)
 615
 616   PROCEDURE newAnonId*(ord : INTEGER) : TypId;
 617     VAR rslt : TypId;
 618         iStr : ARRAY 16 OF CHAR;
 619   BEGIN
 620     rslt := newTypId(NIL);
 621     GPText.IntToStr(ord, iStr);
 622     rslt.hash  := N.enterStr(D.anonMrk + iStr);
 623     RETURN rslt;
 624   END newAnonId;
 625
 626 (* -------------------------------------------- *)
 627
 628   PROCEDURE newSfAnonId*(ord : INTEGER) : TypId;
 629     VAR rslt : TypId;
 630         iStr : ARRAY 16 OF CHAR;
 631   BEGIN
 632     rslt := newTypId(NIL);
 633     GPText.IntToStr(ord, iStr);
 634     rslt.hash  := N.enterStr("__t" + iStr);
 635     RETURN rslt;
 636   END newSfAnonId;
 637
 638 (* -------------------------------------------- *)
 639
 640   PROCEDURE newVarId*() : VarId;
 641     VAR rslt : VarId;
 642   BEGIN
 643     NEW(rslt); rslt.SetKind(varId); RETURN rslt;
 644   END newVarId;
 645
 646 (* -------------------------------------------- *)
 647
 648   PROCEDURE newLocId*() : LocId;
 649     VAR rslt : LocId;
 650   BEGIN
 651     NEW(rslt); rslt.SetKind(varId); RETURN rslt;
 652   END newLocId;
 653
 654 (* -------------------------------------------- *)
 655
 656   PROCEDURE newFldId*() : FldId;
 657     VAR rslt : FldId;
 658   BEGIN
 659     NEW(rslt); rslt.SetKind(fldId); RETURN rslt;
 660   END newFldId;
 661
 662 (* -------------------------------------------- *)
 663
 664   PROCEDURE newParId*() : ParId;
 665     VAR rslt : ParId;
 666   BEGIN
 667     NEW(rslt); rslt.SetKind(parId); RETURN rslt;
 668   END newParId;
 669
 670 (* -------------------------------------------- *)
 671
 672   PROCEDURE cloneParInScope*(par : ParId; scope : D.Scope) : ParId;
 673     VAR rslt : ParId;
 674   BEGIN
 675     rslt := newParId();
 676         rslt^ := par^;
 677     rslt.dfScp  := scope;
 678     RETURN rslt;
 679   END cloneParInScope;
 680
 681 (* -------------------------------------------- *)
 682
 683   PROCEDURE newQuaId*() : ParId;
 684     VAR rslt : ParId;
 685   BEGIN
 686     NEW(rslt); rslt.SetKind(quaId); RETURN rslt;
 687   END newQuaId;
 688
 689 (* -------------------------------------------- *)
 690
 691   PROCEDURE newOvlId*() : OvlId;
 692     VAR rslt : OvlId;
 693   BEGIN
 694     NEW(rslt);
 695     rslt.SetKind(errId);
 696     InitPrcSeq(rslt.list, 2);
 697     RETURN rslt;
 698   END newOvlId;
 699
 700 (* -------------------------------------------- *)
 701
 702   PROCEDURE newPrcId*() : PrcId;
 703     VAR rslt : PrcId;
 704   BEGIN
 705     NEW(rslt);
 706     rslt.SetKind(errId);
 707     rslt.stdOrd := 0;
 708     RETURN rslt;
 709   END newPrcId;
 710
 711 (* -------------------------------------------- *)
 712
 713   PROCEDURE newMthId*() : MthId;
 714     VAR rslt : MthId;
 715   BEGIN
 716     NEW(rslt);
 717     rslt.SetKind(errId);
 718     rslt.mthAtt := {};
 719     RETURN rslt;
 720   END newMthId;
 721
 722 (* -------------------------------------------- *)
 723
 724   PROCEDURE newImpId*() : BlkId;
 725     VAR rslt : BlkId;
 726   BEGIN
 727     NEW(rslt);
 728     INCL(rslt.xAttr, D.weak);
 729     rslt.SetKind(impId);
 730     RETURN rslt;
 731   END newImpId;
 732
 733 (* -------------------------------------------- *)
 734
 735   PROCEDURE newAlias*() : BlkId;
 736     VAR rslt : BlkId;
 737   BEGIN
 738     NEW(rslt); rslt.SetKind(alias); RETURN rslt;
 739   END newAlias;
 740
 741 (* -------------------------------------------- *)
 742
 743   PROCEDURE newModId*() : BlkId;
 744     VAR rslt : BlkId;
 745   BEGIN
 746     NEW(rslt); rslt.SetKind(modId); RETURN rslt;
 747   END newModId;
 748
 749 (* ============================================================ *)
 750 (*    Set procedures for ReadOnly fields    *)
 751 (* ============================================================ *)
 752
 753   PROCEDURE (c : ConId)SetStd*(),NEW;
 754   BEGIN
 755     c.isStd := TRUE;
 756   END SetStd;
 757
 758 (* -------------------------------------------- *)
 759
 760   PROCEDURE (c : PrcId)SetOrd*(n : INTEGER),NEW;
 761   BEGIN
 762     c.stdOrd := n;
 763   END SetOrd;
 764
 765 (* -------------------------------------------- *)
 766
 767   PROCEDURE (p : Procs)setPrcKind*(kind : INTEGER),NEW;
 768   BEGIN
 769     ASSERT((kind = conMth) OR (kind = conPrc) OR
 770            (kind = fwdMth) OR (kind = fwdPrc) OR
 771            (kind = ctorP));
 772     p.SetKind(kind);
 773   END setPrcKind;
 774
 775 (* ============================================================ *)
 776 (*   Methods on PrcId type, for procedure/method entry. *)
 777 (* ============================================================ *)
 778
 779   PROCEDURE (desc : Procs)CheckElab*(fwd : D.Idnt),NEW,EMPTY;
 780
 781 (* -------------------------------------------- *)
 782
 783   PROCEDURE (desc : PrcId)CheckElab*(fwd : D.Idnt);
 784     VAR fwdD : PrcId;
 785   BEGIN
 786     fwdD := fwd(PrcId);
 787     IF (fwdD.type # NIL) & (desc.type # NIL) THEN
 788       IF ~desc.type.procMatch(fwdD.type) THEN
 789         desc.IdError(65);
 790       ELSIF ~desc.type.namesMatch(fwdD.type) THEN
 791         desc.IdError(70);
 792       ELSIF fwdD.pAttr * useMsk # {} THEN
 793         desc.pAttr := desc.pAttr + fwdD.pAttr;
 794       END;
 795       IF desc.vMod = D.prvMode THEN desc.SetMode(fwd.vMod) END; (* copy *)
 796       fwdD.resolve := desc;
 797       (* ### *)
 798       fwdD.type := desc.type;
 799     END;
 800   END CheckElab;
 801
 802 (* -------------------------------------------- *)
 803
 804   PROCEDURE (desc : MthId)CheckElab*(fwd : D.Idnt);
 805     VAR fwdD : MthId;
 806   BEGIN
 807     fwdD := fwd(MthId);
 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;
 813     END;
 814     IF (fwdD.type # NIL) & (desc.type # NIL) THEN
 815       IF ~desc.type.procMatch(fwdD.type) THEN
 816         desc.IdError(65);
 817       ELSIF ~desc.type.namesMatch(fwdD.type) THEN
 818         desc.IdError(70);
 819       ELSIF fwdD.pAttr * useMsk # {} THEN
 820         desc.pAttr := desc.pAttr + fwdD.pAttr;
 821       END;
 822       IF desc.vMod = D.prvMode THEN desc.SetMode(fwd.vMod) END; (* copy *)
 823       fwdD.resolve := desc;
 824       (* ### *)
 825       fwdD.type := desc.type;
 826     END;
 827   END CheckElab;
 828
 829 (* -------------------------------------------- *)
 830
 831   PROCEDURE (desc : Procs)EnterProc*(rcv : ParId; scp : D.Scope),NEW,EMPTY;
 832
 833 (* -------------------------------------------- *)
 834
 835   PROCEDURE (desc : PrcId)EnterProc*(rcv : ParId; scp : D.Scope);
 836     VAR fwd : D.Idnt;
 837   BEGIN
 838     ASSERT(rcv = NIL);
 839     IF D.refused(desc, scp) THEN
 840       fwd := scp.symTb.lookup(desc.hash);
 841       IF fwd.kind = fwdPrc THEN (* check the elaboration *)
 842         desc.CheckElab(fwd);
 843         scp.symTb.Overwrite(desc.hash, desc);
 844       ELSIF fwd.kind = fwdMth THEN
 845         fwd.IdError(62);
 846       ELSE
 847         desc.IdError(4);
 848       END;
 849     ELSE
 850     END;
 851   END EnterProc;
 852
 853 (* -------------------------------------------- *)
 854
 855   PROCEDURE (desc : MthId)EnterProc*(rcv : ParId; scp : D.Scope);
 856     VAR fwd : D.Idnt;
 857         rTp : D.Type;
 858   BEGIN
 859     rTp := NIL;
 860     ASSERT(rcv # NIL);
 861     IF desc.dfScp.kind # modId THEN
 862        desc.IdError(122); RETURN;     (* PREMATURE RETURN *)
 863     END;
 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 *)
 870       END;
 871     ELSIF (rcv.type # NIL) & rcv.type.isRecordType() THEN
 872       desc.IdError(107); RETURN;      (* PREMATURE RETURN *)
 873     ELSE
 874       desc.IdError(104); RETURN;      (* PREMATURE RETURN *)
 875     END;
 876     IF rTp # NIL THEN       (* insert in rec. scope *)
 877       rTp.InsertMethod(desc);
 878       desc.bndType := rTp;
 879     END;
 880   END EnterProc;
 881
 882 (* -------------------------------------------- *)
 883
 884   PROCEDURE (desc : Procs)MethodAttr(),NEW,EMPTY;
 885
 886 (* -------------------------------------------- *)
 887
 888   PROCEDURE (mDesc : MthId)MethodAttr();
 889     VAR rcvTp : D.Type;
 890         bndTp : D.Type;
 891         inhId : D.Idnt;
 892         prevM : MthId;
 893         mMask, pMask : SET;
 894   BEGIN
 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;
 900     END;
 901    (*
 902     *  Check #1: is there an equally named method inherited?
 903     *)
 904     inhId := bndTp.inheritedFeature(mDesc);
 905    (*
 906     *  Check #2: are the method attributes consistent
 907     *)
 908     IF inhId = NIL THEN
 909      (*
 910       *  2.0 If not an override, then must be NEW
 911       *)
 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);
 915       END;
 916     ELSIF inhId.kind = conMth THEN
 917       prevM := inhId(MthId);
 918       pMask := prevM.mthAtt * mask;
 919      (*
 920       *  2.1 Formals must match, with retType covariant maybe
 921       *)
 922       prevM.type.CheckCovariance(mDesc);
 923      (*
 924       *  2.2 If an override, then must not be NEW
 925       *)
 926       IF newBit IN mDesc.mthAtt THEN mDesc.IdError(106) END;
 927      (*
 928       *  2.3 Super method must be extensible
 929       *)
 930       IF pMask = final THEN mDesc.IdError(108) END;
 931      (*
 932       *  2.4 If this is abstract, so must be the super method
 933       *)
 934       IF (mMask = isAbs) & (pMask # isAbs) THEN mDesc.IdError(109) END;
 935      (*
 936       *  2.5 If empty, the super method must be abstract or empty
 937       *)
 938       IF (mMask = empty) &
 939          (pMask # isAbs) & (pMask # empty) THEN mDesc.IdError(112) END;
 940      (*
 941       *  2.6 If inherited method is exported, then so must this method
 942       *)
 943
 944      (*
 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.
 948       *
 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 ...
 952       *                                      (kjg 17-Dec-2001)
 953       *  ... and this is the implemented semantics from gpcp 1.1.5
 954       *                                      (kjg 10-Jan-2002)
 955       *)
 956       IF (prevM.vMod = D.pubMode) &
 957          (mDesc.vMod # D.pubMode) THEN
 958         IF rcvTp.idnt.vMod = D.pubMode THEN
 959           mDesc.IdError(113);
 960         ELSE
 961           INCL(mDesc.mthAtt, widen);
 962         END;
 963       ELSIF (prevM.vMod = D.rdoMode) &
 964             (mDesc.vMod # D.rdoMode) THEN
 965         IF rcvTp.idnt.vMod = D.pubMode THEN
 966           mDesc.IdError(223);
 967         ELSIF rcvTp.idnt.vMod = D.prvMode THEN
 968           INCL(mDesc.mthAtt, widen);
 969         END;
 970       END;
 971      (*
 972       *  If inherited method is overloaded, then so must this be.
 973       *)
 974       IF prevM.prcNm # NIL THEN mDesc.prcNm := prevM.prcNm END;
 975     ELSE
 976       mDesc.IdError(4);
 977     END;
 978     IF (mMask = isAbs) & ~bndTp.isAbsRecType() THEN
 979      (*
 980       *  Check #3: if method is abstract bndTp must be abstract
 981       *)
 982       rcvTp.TypeError(110);
 983     ELSIF mMask = empty THEN
 984      (*
 985       *  Check #4: if method is empty then no-ret and no OUTpars
 986       *)
 987       mDesc.type.CheckEmptyOK();
 988       IF (newBit IN mDesc.mthAtt) & ~bndTp.isExtnRecType() THEN
 989        (*
 990         *  Check #5: if mth is empty and new, rcv must be extensible
 991         *)
 992         rcvTp.TypeError(111);
 993       END;
 994     ELSIF (mMask = extns) & ~bndTp.isExtnRecType() THEN
 995      (*
 996       *  Check #6: if mth is ext. rcv must be abs. or extensible
 997       *)
 998       S.SemError.RepSt1(117,
 999                         D.getName.ChPtr(rcvTp.idnt),
1000                         mDesc.token.lin, mDesc.token.col);
1001     END;
1002   END MethodAttr;
1003
1004 (* -------------------------------------------- *)
1005
1006   PROCEDURE (desc : Procs)retTypBound*() : D.Type,NEW,EXTENSIBLE;
1007   BEGIN RETURN NIL END retTypBound;
1008
1009 (* -------------------------------------------- *)
1010
1011   PROCEDURE (mDesc : MthId)retTypBound*() : D.Type;
1012     VAR bndTp : D.Type;
1013         prevM : MthId;
1014   BEGIN
1015     bndTp := mDesc.bndType;
1016     prevM := bndTp.inheritedFeature(mDesc)(MthId);
1017     IF covar IN prevM.mthAtt THEN
1018       RETURN prevM.retTypBound();
1019     ELSE
1020       RETURN prevM.type.returnType();
1021     END;
1022   END retTypBound;
1023
1024 (* -------------------------------------------- *)
1025
1026   PROCEDURE (prc : Procs)RetCheck(fin : V.VarSet; eNm : INTEGER),NEW;
1027   BEGIN
1028     IF ~prc.type.isProperProcType() & (* ==> function procedure *)
1029        ~prc.isAbstract() &    (* ==> concrete procedure *)
1030        ~fin.isUniv() THEN   (* ==> flow missed RETURN *)
1031       prc.IdError(136);
1032       prc.IdError(eNm);
1033     END;
1034   END RetCheck;
1035
1036 (* -------------------------------------------- *)
1037
1038   PROCEDURE (var : AbVar)VarInit(ini : V.VarSet),NEW;
1039   BEGIN
1040     WITH var : ParId DO
1041         IF (var.parMod # D.out) OR
1042            ~var.type.isScalarType() THEN ini.Incl(var.varOrd) END;
1043     | var : LocId DO
1044         IF ~var.type.isScalarType() THEN ini.Incl(var.varOrd) END;
1045     | var : VarId DO
1046         IF ~var.type.isScalarType() THEN ini.Incl(var.varOrd) END;
1047     ELSE
1048     END;
1049   END VarInit;
1050
1051 (* -------------------------------------------- *)
1052
1053   PROCEDURE (mod : BlkId)LiveInitialize*(ini : V.VarSet);
1054     VAR var : D.Idnt;
1055         ix  : INTEGER;
1056   BEGIN
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);
1061     END;
1062   END LiveInitialize;
1063
1064 (* -------------------------------------------- *)
1065
1066   PROCEDURE (prc : Procs)LiveInitialize*(ini : V.VarSet);
1067     VAR var : D.Idnt;
1068         ix  : INTEGER;
1069   BEGIN
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);
1077     END;
1078   END LiveInitialize;
1079
1080 (* -------------------------------------------- *)
1081
1082   PROCEDURE (prc : Procs)UplevelInitialize*(ini : V.VarSet);
1083     VAR var : LocId;
1084         ix  : INTEGER;
1085   BEGIN
1086     FOR ix := 0 TO prc.locals.tide-1 DO
1087      (*
1088       *  If we were setting uplevR and uplevW separately, we
1089       *  could be less conservative and test uplevW only.
1090       *)
1091       var := prc.locals.a[ix](LocId);
1092       IF uplevA IN var.locAtt THEN ini.Incl(var.varOrd) END;
1093     END;
1094   END UplevelInitialize;
1095
1096 (* ============================================================ *)
1097 (*    Methods on BlkId type, for mainline computation *)
1098 (* ============================================================ *)
1099
1100   PROCEDURE (b : BlkId)EmitCode*(),NEW;
1101   BEGIN
1102   END EmitCode;
1103
1104 (* -------------------------------------------- *)
1105
1106   PROCEDURE (b : BlkId)TypeErasure*(sfa : D.SymForAll), NEW;
1107     VAR prcIx : INTEGER;
1108         iDesc : D.Idnt;
1109         pDesc : Procs;
1110   BEGIN
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;
1119       END;
1120     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 *)
1124     b.symTb.Apply(sfa);
1125   END TypeErasure;
1126
1127 (* -------------------------------------------- *)
1128
1129   PROCEDURE (b : BlkId)StatementAttribution*(sfa : D.SymForAll),NEW;
1130     VAR prcIx : INTEGER;
1131         iDesc : D.Idnt;
1132         pDesc : Procs;
1133         bType : D.Type;
1134         dName : L.CharOpen;
1135    (* ---------------------------------------- *)
1136     PROCEDURE parentIsCalled(mthd : MthId) : BOOLEAN;
1137       VAR prId : D.Idnt;
1138     BEGIN
1139      (*
1140       *  Invariant : ~(called IN mthd.pAttr)
1141       *)
1142       LOOP
1143         IF newBit IN mthd.mthAtt THEN RETURN FALSE;
1144         ELSE
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;
1151         END;
1152       END;
1153     END parentIsCalled;
1154    (* ---------------------------------------- *)
1155   BEGIN
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;
1164         IF bType = NIL THEN
1165           pDesc.IdError(201);
1166         ELSIF bType.isImportedType() THEN
1167           pDesc.IdError(200);
1168         ELSE (* remainder of semantic checks in AppendCtor *)
1169           bType.AppendCtor(pDesc);
1170         END;
1171       ELSE
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;;
1175        (*
1176         *  Now we generate warnings for useless procedures.
1177         *)
1178         IF pDesc.pAttr * useMsk = {} THEN
1179           WITH pDesc : MthId DO
1180            (*
1181             *  The test here is tricky: if an overridden
1182             *  method is called, then this method might
1183             *  be dynamically dispatched.  We check this.
1184             *)
1185             IF ~parentIsCalled(pDesc) THEN pDesc.IdError(304) END;
1186           ELSE
1187            (*
1188             *  On the other hand, if it is static, not exported
1189             *  and is not called then it definitely is useless.
1190             *)
1191             pDesc.IdError(304);
1192           END;
1193         END;
1194       END;
1195     END;
1196     b.symTb.Apply(sfa);
1197    (*
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.
1202     *)
1203     IF D.trgtNET &
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);
1210     END;
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;
1214
1215 (* -------------------------------------------- *)
1216
1217   PROCEDURE (b : BlkId)DataflowAttribution*(),NEW;
1218     VAR prcIx : INTEGER;
1219         iDesc : D.Idnt;
1220         pDesc : Procs;
1221         initL : V.VarSet;
1222   BEGIN
1223    (*
1224     *  Fix up the modes of quasi parameters here ...
1225     *)
1226
1227    (*
1228     *  Now do dataflow analysis on each procedure ...
1229     *)
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
1236        (*
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.
1240         *
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.
1244         *)
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);
1257         END;
1258       END;
1259     END;
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;
1265
1266 (* ============================================================ *)
1267 (*      Diagnostic methods      *)
1268 (* ============================================================ *)
1269
1270   PROCEDURE PType(t : D.Type);
1271   BEGIN
1272     IF t # NIL THEN Console.WriteString(t.name()) END;
1273   END PType;
1274
1275   (* ------------------------------- *)
1276
1277   PROCEDURE KType*(i : INTEGER);
1278   BEGIN
1279     CASE i OF
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 ");
1297     END;
1298   END KType;
1299
1300   (* ------------------------------- *)
1301
1302   PROCEDURE (s : ConId)Diagnose*(i : INTEGER);
1303   BEGIN
1304     s.SuperDiag(i);
1305     H.Indent(i+2); KType(s.kind); Console.WriteLn;
1306     IF s.conExp # NIL THEN s.conExp.Diagnose(i+4) END;
1307   END Diagnose;
1308
1309   PROCEDURE (s : FldId)Diagnose*(i : INTEGER);
1310   BEGIN
1311     s.SuperDiag(i);
1312     H.Indent(i+2); KType(s.kind);
1313     IF s.type # NIL THEN PType(s.type) END;
1314     Console.WriteLn;
1315   END Diagnose;
1316
1317   PROCEDURE (s : TypId)Diagnose*(i : INTEGER);
1318   BEGIN
1319     s.SuperDiag(i);
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);
1324     END;
1325     Console.WriteLn;
1326   END Diagnose;
1327
1328   PROCEDURE (s : AbVar)Diagnose*(i : INTEGER),EXTENSIBLE;
1329   BEGIN
1330     s.SuperDiag(i);
1331     H.Indent(i+2); KType(s.kind);
1332     IF s.type # NIL THEN PType(s.type) END;
1333     Console.WriteLn;
1334   END Diagnose;
1335
1336   PROCEDURE (s : ParId)Diagnose*(i : INTEGER);
1337   BEGIN
1338     s.SuperDiag(i);
1339     H.Indent(i+2); KType(s.kind);
1340     IF s.type # NIL THEN PType(s.type) END;
1341     Console.WriteLn;
1342   END Diagnose;
1343
1344   PROCEDURE (s : ParId)DiagPar*(),NEW;
1345     VAR str : L.CharOpen;
1346   BEGIN
1347     Console.WriteString(D.modStr[s.parMod]);
1348     str := D.getName.ChPtr(s);
1349     IF str # NIL THEN
1350       Console.WriteString(str);
1351     ELSE
1352       Console.WriteString("(p#");
1353       Console.WriteInt(s.varOrd,1);
1354       Console.Write(")");
1355     END;
1356     Console.WriteString(" : ");
1357     Console.WriteString(s.type.name());
1358   END DiagPar;
1359
1360   PROCEDURE (s : LocId)DiagVar*(),NEW;
1361   BEGIN
1362     Console.WriteString(D.getName.ChPtr(s));
1363     Console.WriteString(" (#");
1364     Console.WriteInt(s.varOrd,1);
1365     Console.Write(")");
1366     Console.WriteString(" : ");
1367     Console.WriteString(s.type.name());
1368     Console.Write(";");
1369   END DiagVar;
1370
1371   PROCEDURE (s : Procs)DiagVars(i : INTEGER),NEW;
1372     VAR var : D.Idnt;
1373         ix  : INTEGER;
1374   BEGIN
1375     H.Indent(i); Console.Write("{");
1376     IF s.locals.tide = 0 THEN
1377       Console.Write("}");
1378     ELSE
1379       Console.WriteLn;
1380       FOR ix := 0 TO s.locals.tide-1 DO
1381         H.Indent(i+4);
1382         var := s.locals.a[ix];
1383         var(LocId).DiagVar();
1384         Console.WriteLn;
1385       END;
1386       H.Indent(i); Console.Write("}");
1387     END;
1388     Console.WriteLn;
1389   END DiagVars;
1390
1391   PROCEDURE (s : PrcId)Diagnose*(i : INTEGER);
1392   BEGIN
1393     H.Indent(i); Console.WriteString("PROCEDURE");
1394     IF s.kind = fwdPrc THEN Console.Write("^") END;
1395     Console.Write(" ");
1396     Console.WriteString(D.getName.ChPtr(s));
1397     s.type.DiagFormalType(i+4);
1398     IF s.kind = ctorP THEN Console.WriteString(",CONSTRUCTOR") END;
1399     Console.WriteLn;
1400     s.DiagVars(i);
1401     D.DoXName(i, s.prcNm);
1402     D.DoXName(i, s.clsNm);
1403     D.DoXName(i, s.scopeNm);
1404   END Diagnose;
1405
1406   PROCEDURE (s : MthId)Diagnose*(i : INTEGER);
1407   BEGIN
1408     H.Indent(i); Console.WriteString("PROCEDURE");
1409     IF s.kind = fwdMth THEN Console.Write("^") END;
1410     Console.Write(" ");
1411     Console.Write("(");
1412     s.rcvFrm.DiagPar();
1413     Console.Write(")");
1414     Console.WriteString(D.getName.ChPtr(s));
1415     s.type.DiagFormalType(i+4);
1416     Console.WriteLn;
1417     s.DiagVars(i);
1418     D.DoXName(i, s.prcNm);
1419   END Diagnose;
1420
1421   PROCEDURE (s : OvlId)Diagnose*(i : INTEGER);
1422   VAR
1423     index : INTEGER;
1424   BEGIN
1425     H.Indent(i); Console.WriteString("OVERLOADED PROCS with name <");
1426     Console.WriteString(D.getName.ChPtr(s));
1427     Console.WriteString(">");
1428     Console.WriteLn;
1429     FOR index := 0 TO s.list.tide-1 DO
1430       s.list.a[index].Diagnose(i+2);
1431     END;
1432     H.Indent(i); Console.WriteString("END OVERLOADED PROCS with name ");
1433     Console.WriteString(D.getName.ChPtr(s));
1434     Console.WriteString(">");
1435     Console.WriteLn;
1436   END Diagnose;
1437
1438   PROCEDURE (s : BlkId)Diagnose*(i : INTEGER);
1439   BEGIN
1440     s.SuperDiag(i);
1441     H.Indent(i+2); KType(s.kind);
1442     IF D.weak IN s.xAttr THEN Console.WriteString(" (weak)") END;
1443     Console.WriteLn;
1444     s.symTb.Dump(i+4);
1445     D.DoXName(i, s.scopeNm);
1446     D.DoXName(i, s.xName);
1447   END Diagnose;
1448
1449 (* ============================================================ *)
1450 BEGIN (* ====================================================== *)
1451 END IdDesc.   (* ============================================== *)
1452 (* ============================================================ *)
1453