gcc/m2/gm2-compiler/M2SymInit.mod

   1 (* M2SymInit.mod records initialization state for variables.
   2
   3 Copyright (C) 2001-2024 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GNU Modula-2; see the file COPYING3.  If not see
  20 <http://www.gnu.org/licenses/>.  *)
  21
  22 IMPLEMENTATION MODULE M2SymInit ;
  23
  24 FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
  25 FROM M2Debug IMPORT Assert ;
  26 FROM M2Printf IMPORT printf0, printf1, printf2, printf3, printf4 ;
  27 FROM libc IMPORT printf ;
  28 FROM NameKey IMPORT Name, NulName, KeyToCharStar, MakeKey ;
  29 FROM M2Base IMPORT Nil ;
  30
  31 FROM M2Options IMPORT UninitVariableChecking, UninitVariableConditionalChecking,
  32                       CompilerDebugging ;
  33
  34 FROM M2MetaError IMPORT MetaErrorT1, MetaErrorStringT1, MetaErrorStringT2 ;
  35 FROM M2LexBuf IMPORT UnknownTokenNo ;
  36 FROM DynamicStrings IMPORT String, InitString, Mark, ConCat, InitString ;
  37 FROM M2Error IMPORT InternalError ;
  38
  39 FROM M2BasicBlock IMPORT BasicBlock,
  40                          InitBasicBlocks, InitBasicBlocksFromRange,
  41                          KillBasicBlocks, FreeBasicBlocks,
  42                          ForeachBasicBlockDo ;
  43
  44 IMPORT Indexing ;
  45 FROM Indexing IMPORT Index ;
  46
  47 FROM Lists IMPORT List, InitList, GetItemFromList, PutItemIntoList,
  48                   IsItemInList, IncludeItemIntoList, NoOfItemsInList,
  49                   RemoveItemFromList, ForeachItemInListDo, KillList, DuplicateList ;
  50
  51 FROM SymbolTable IMPORT NulSym, ModeOfAddr, IsVar, IsRecord, GetSType,
  52                         GetNth, IsRecordField, IsSet, IsArray, IsProcedure,
  53                         GetVarScope, IsVarAParam, IsComponent, GetMode,
  54                         VarCheckReadInit, VarInitState, PutVarInitialized,
  55                         PutVarFieldInitialized, GetVarFieldInitialized,
  56                         IsConst, IsConstString, NoOfParam, IsVarParam,
  57                         ForeachLocalSymDo, ForeachParamSymDo,
  58                         IsTemporary, ModeOfAddr,
  59                         IsReallyPointer, IsUnbounded,
  60                         IsVarient, IsFieldVarient, GetVarient,
  61                         IsVarArrayRef, GetSymName,
  62                         IsType, IsPointer,
  63                         GetParameterShadowVar, IsParameter, GetLType,
  64                         GetParameterHeapVar ;
  65
  66 FROM M2Quads IMPORT QuadOperator, GetQuadOtok, GetQuad, GetNextQuad,
  67                     IsNewLocalVar, IsReturn, IsKillLocalVar, IsConditional,
  68                     IsUnConditional, IsBackReference, IsCall, IsGoto,
  69                     GetM2OperatorDesc, Opposite, DisplayQuadRange,
  70                     GetQuadTrash ;
  71
  72 FROM M2Printf IMPORT printf0, printf1, printf2 ;
  73 FROM M2GCCDeclare IMPORT PrintSym ;
  74
  75
  76 CONST
  77    Debugging = FALSE ;
  78
  79 TYPE
  80    descType = (scalar, record) ;
  81
  82    InitDesc = POINTER TO RECORD
  83                             sym, type  : CARDINAL ;
  84                             initialized: BOOLEAN ;
  85                             CASE kind: descType OF
  86
  87                             scalar:  |
  88                             record:  rec:  recordDesc |
  89
  90                             END
  91                          END ;
  92
  93    recordDesc = RECORD
  94                    fieldDesc: Indexing.Index ;
  95                 END ;
  96
  97    symAlias = POINTER TO RECORD
  98                             keySym,
  99                             alias : CARDINAL ;
 100                             next  : symAlias ;
 101                          END ;
 102
 103    bbEntry = POINTER TO RECORD
 104                            start, end: CARDINAL ;
 105                            (* Is this the first bb?  *)
 106                            first,
 107                            (* Does it end with a call?  *)
 108                            endCall,
 109                            (* Does it end with a goto?  *)
 110                            endGoto,
 111                            (* Does it end with a conditional?  *)
 112                            endCond,
 113                            (* Does it form part of a loop?  *)
 114                            topOfLoop : BOOLEAN ;
 115                            trashQuad,
 116                            indexBB,
 117                            nextQuad,
 118                            condQuad,
 119                            nextBB,
 120                            condBB    : CARDINAL ;
 121                            next      : bbEntry ;
 122                         END ;
 123
 124 VAR
 125    IndirectArray,
 126    LArray       : Indexing.Index ;
 127    freeList     : symAlias ;
 128    bbArray      : Indexing.Index ;
 129    bbFreeList   : bbEntry ;
 130    ignoreList,
 131    errorList    : List ;   (* Ensure that we only generate one set of warnings per token.  *)
 132
 133
 134 (*
 135    PrintSymInit -
 136 *)
 137
 138 PROCEDURE PrintSymInit (desc: InitDesc) ;
 139 VAR
 140    i, n: CARDINAL ;
 141 BEGIN
 142    printf ("sym %d: type %d ", desc^.sym, desc^.type) ;
 143    IF desc^.kind = scalar
 144    THEN
 145       printf ("scalar")
 146    ELSE
 147       printf ("record")
 148    END ;
 149    IF NOT desc^.initialized
 150    THEN
 151       printf (" not")
 152    END ;
 153    printf (" initialized\n") ;
 154    IF (desc^.type # NulSym) AND IsRecord (desc^.type)
 155    THEN
 156       i := 1 ;
 157       n := Indexing.HighIndice (desc^.rec.fieldDesc) ;
 158       WHILE i <= n DO
 159          PrintSymInit (Indexing.GetIndice (desc^.rec.fieldDesc, i)) ;
 160          INC (i)
 161       END
 162    END
 163 END PrintSymInit ;
 164
 165
 166 PROCEDURE InitSymInit () : InitDesc ;
 167 VAR
 168    id: InitDesc ;
 169 BEGIN
 170    NEW (id) ;
 171    WITH id^ DO
 172       sym := NulSym ;
 173       type := NulSym ;
 174       initialized := TRUE ;
 175       kind := scalar
 176    END ;
 177    RETURN id
 178 END InitSymInit ;
 179
 180
 181 PROCEDURE KillSymInit (VAR desc: InitDesc) ;
 182 BEGIN
 183    WITH desc^ DO
 184       CASE kind OF
 185
 186       record:  KillFieldDesc (rec.fieldDesc)
 187
 188       ELSE
 189       END
 190    END ;
 191    DISPOSE (desc) ;
 192    desc := NIL
 193 END KillSymInit ;
 194
 195
 196 PROCEDURE ConfigSymInit (desc: InitDesc; sym: CARDINAL) ;
 197 BEGIN
 198    IF IsVar (sym) OR IsRecordField (sym)
 199    THEN
 200       desc^.sym := sym ;
 201       desc^.type := GetSType (sym) ;
 202       desc^.initialized := FALSE ;
 203       IF IsRecord (desc^.type)
 204       THEN
 205          desc^.kind := record ;
 206          desc^.rec.fieldDesc := Indexing.InitIndex (1) ;
 207          PopulateFields (desc, desc^.type)
 208       ELSE
 209          desc^.kind := scalar ;
 210          IF IsArray (desc^.type)
 211          THEN
 212             desc^.initialized := TRUE   (* For now we don't attempt to handle array types.  *)
 213          END
 214       END
 215    END
 216 END ConfigSymInit ;
 217
 218
 219 (*
 220    KillFieldDesc -
 221 *)
 222
 223 PROCEDURE KillFieldDesc (VAR fielddesc: Indexing.Index) ;
 224 VAR
 225    i, h: CARDINAL ;
 226    id  : InitDesc ;
 227 BEGIN
 228    i := 1 ;
 229    h := Indexing.HighIndice (fielddesc) ;
 230    WHILE i <= h DO
 231       id := Indexing.GetIndice (fielddesc, i) ;
 232       KillSymInit (id) ;
 233       INC (i)
 234    END ;
 235    fielddesc := Indexing.KillIndex (fielddesc)
 236 END KillFieldDesc ;
 237
 238
 239 (*
 240    PopulateFields -
 241 *)
 242
 243 PROCEDURE PopulateFields (desc: InitDesc; recsym: CARDINAL) ;
 244 VAR
 245    field,
 246    i    : CARDINAL ;
 247    fdesc: InitDesc ;
 248 BEGIN
 249    Assert (IsRecord (recsym)) ;
 250    i := 1 ;
 251    REPEAT
 252       field := GetNth (recsym, i) ;
 253       IF field # NulSym
 254       THEN
 255          fdesc := InitSymInit () ;
 256          ConfigSymInit (fdesc, field) ;
 257          Indexing.IncludeIndiceIntoIndex (desc^.rec.fieldDesc, fdesc) ;
 258          INC (i)
 259       END
 260    UNTIL field = NulSym
 261 END PopulateFields ;
 262
 263
 264 PROCEDURE SetInitialized (desc: InitDesc) ;
 265 BEGIN
 266    desc^.initialized := TRUE
 267 END SetInitialized ;
 268
 269
 270 PROCEDURE GetInitialized (desc: InitDesc) : BOOLEAN ;
 271 BEGIN
 272    IF NOT desc^.initialized
 273    THEN
 274       IF IsRecord (desc^.type)
 275       THEN
 276          TrySetInitialized (desc)
 277       END
 278    END ;
 279    IF Debugging
 280    THEN
 281       PrintSymInit (desc)
 282    END ;
 283    RETURN desc^.initialized
 284 END GetInitialized ;
 285
 286
 287 PROCEDURE GetFieldDesc (desc: InitDesc; field: CARDINAL) : InitDesc ;
 288 VAR
 289    fsym,
 290    i    : CARDINAL ;
 291 BEGIN
 292    IF IsRecord (desc^.type)
 293    THEN
 294       i := 1 ;
 295       REPEAT
 296          fsym := GetNth (desc^.type, i) ;
 297          IF field = fsym
 298          THEN
 299             RETURN Indexing.GetIndice (desc^.rec.fieldDesc, i)
 300          END ;
 301          INC (i)
 302       UNTIL fsym = NulSym
 303    END ;
 304    RETURN NIL
 305 END GetFieldDesc ;
 306
 307
 308 PROCEDURE SetFieldInitialized (desc: InitDesc; fieldlist: List) : BOOLEAN ;
 309 BEGIN
 310    RETURN SetFieldInitializedNo (desc, fieldlist, 1)
 311 END SetFieldInitialized ;
 312
 313
 314 (*
 315    TrySetInitialized -
 316 *)
 317
 318 PROCEDURE TrySetInitialized (desc: InitDesc) ;
 319 VAR
 320    i, h : CARDINAL ;
 321    fdesc: InitDesc ;
 322 BEGIN
 323    h := Indexing.HighIndice (desc^.rec.fieldDesc) ;
 324    i := 1 ;
 325    WHILE i <= h DO
 326       fdesc := Indexing.GetIndice (desc^.rec.fieldDesc, i) ;
 327       IF NOT fdesc^.initialized
 328       THEN
 329          RETURN
 330       END ;
 331       INC (i)
 332    END ;
 333    desc^.initialized := TRUE
 334 END TrySetInitialized ;
 335
 336
 337 (*
 338    SetFieldInitializedNo -
 339 *)
 340
 341 PROCEDURE SetFieldInitializedNo (desc: InitDesc;
 342                                  fieldlist: List; level: CARDINAL) : BOOLEAN ;
 343 VAR
 344    nsym : CARDINAL ;
 345    fdesc: InitDesc ;
 346 BEGIN
 347    IF level > NoOfItemsInList (fieldlist)
 348    THEN
 349       RETURN FALSE
 350    ELSE
 351       nsym := GetItemFromList (fieldlist, level) ;
 352       fdesc := GetFieldDesc (desc, nsym) ;
 353       IF fdesc = NIL
 354       THEN
 355          RETURN FALSE
 356       ELSIF level = NoOfItemsInList (fieldlist)
 357       THEN
 358          SetInitialized (fdesc) ;
 359          TrySetInitialized (desc) ;
 360          RETURN desc^.initialized
 361       ELSE
 362          IF SetFieldInitializedNo (fdesc, fieldlist, level + 1)
 363          THEN
 364          END ;
 365          TrySetInitialized (desc) ;
 366          RETURN desc^.initialized
 367       END
 368    END
 369 END SetFieldInitializedNo ;
 370
 371
 372 PROCEDURE GetFieldInitialized (desc: InitDesc; fieldlist: List) : BOOLEAN ;
 373 BEGIN
 374    RETURN GetFieldInitializedNo (desc, fieldlist, 1)
 375 END GetFieldInitialized ;
 376
 377
 378 PROCEDURE GetFieldInitializedNo (desc: InitDesc;
 379                                  fieldlist: List; level: CARDINAL) : BOOLEAN ;
 380 VAR
 381    nsym : CARDINAL ;
 382    fdesc: InitDesc ;
 383 BEGIN
 384    IF desc^.initialized
 385    THEN
 386       RETURN TRUE
 387    ELSIF level > NoOfItemsInList (fieldlist)
 388    THEN
 389       RETURN FALSE
 390    ELSE
 391       nsym := GetItemFromList (fieldlist, level) ;
 392       fdesc := GetFieldDesc (desc, nsym) ;
 393       IF fdesc = NIL
 394       THEN
 395          (* The pointer variable maybe uninitialized and hence we cannot
 396             find the record variable.  *)
 397          RETURN FALSE
 398       ELSIF fdesc^.initialized
 399       THEN
 400          RETURN TRUE
 401       ELSE
 402          RETURN GetFieldInitializedNo (fdesc, fieldlist, level + 1)
 403       END
 404    END
 405 END GetFieldInitializedNo ;
 406
 407
 408 (*
 409    IsGlobalVar -
 410 *)
 411
 412 PROCEDURE IsGlobalVar (sym: CARDINAL) : BOOLEAN ;
 413 BEGIN
 414    RETURN IsVar (sym) AND (NOT IsProcedure (GetVarScope (sym)))
 415 END IsGlobalVar ;
 416
 417
 418 (*
 419    IsLocalVar -
 420
 421 PROCEDURE IsLocalVar (procsym, varsym: CARDINAL) : BOOLEAN ;
 422 BEGIN
 423    RETURN IsVar (varsym) AND (GetVarScope (varsym) = procsym)
 424 END IsLocalVar ;
 425 *)
 426
 427
 428 (*
 429    RecordFieldContainsVarient -
 430 *)
 431
 432 PROCEDURE RecordFieldContainsVarient (sym: CARDINAL; visited: List) : BOOLEAN ;
 433 BEGIN
 434    Assert (IsRecordField (sym)) ;
 435    IF doContainsVariant (GetSType (sym), visited)
 436    THEN
 437       RETURN TRUE
 438    END ;
 439    RETURN GetVarient (sym) # NulSym
 440 END RecordFieldContainsVarient ;
 441
 442
 443 (*
 444    RecordContainsVarient -
 445 *)
 446
 447 PROCEDURE RecordContainsVarient (sym: CARDINAL; visited: List) : BOOLEAN ;
 448 VAR
 449    i,
 450    fieldsym: CARDINAL ;
 451 BEGIN
 452    Assert (IsRecord (sym)) ;
 453    i := 1 ;
 454    REPEAT
 455       fieldsym := GetNth (sym, i) ;
 456       IF fieldsym # NulSym
 457       THEN
 458          IF IsRecordField (fieldsym)
 459          THEN
 460             IF RecordFieldContainsVarient (fieldsym, visited)
 461             THEN
 462                RETURN TRUE
 463             END
 464          ELSIF IsVarient (fieldsym)
 465          THEN
 466             RETURN TRUE
 467          END ;
 468          INC (i)
 469       END
 470    UNTIL fieldsym = NulSym ;
 471    RETURN FALSE
 472 END RecordContainsVarient ;
 473
 474
 475 (*
 476    VarContainsVarient -
 477 *)
 478
 479 PROCEDURE VarContainsVarient (sym: CARDINAL; visited: List) : BOOLEAN ;
 480 BEGIN
 481    Assert (IsVar (sym)) ;
 482    RETURN doContainsVariant (GetSType (sym), visited)
 483 END VarContainsVarient ;
 484
 485
 486 (*
 487    TypeContainsVarient -
 488 *)
 489
 490 PROCEDURE TypeContainsVarient (sym: CARDINAL; visited: List) : BOOLEAN ;
 491 BEGIN
 492    Assert (IsType (sym)) ;
 493    RETURN doContainsVariant (GetSType (sym), visited)
 494 END TypeContainsVarient ;
 495
 496
 497 (*
 498    ArrayContainsVarient -
 499 *)
 500
 501 PROCEDURE ArrayContainsVarient (sym: CARDINAL; visited: List) : BOOLEAN ;
 502 BEGIN
 503    Assert (IsArray (sym)) ;
 504    RETURN doContainsVariant (GetSType (sym), visited)
 505 END ArrayContainsVarient ;
 506
 507
 508 (*
 509    PointerContainsVarient -
 510 *)
 511
 512 PROCEDURE PointerContainsVarient (sym: CARDINAL; visited: List) : BOOLEAN ;
 513 BEGIN
 514    Assert (IsPointer (sym)) ;
 515    RETURN doContainsVariant (GetSType (sym), visited)
 516 END PointerContainsVarient ;
 517
 518
 519 (*
 520    doContainsVariant -
 521 *)
 522
 523 PROCEDURE doContainsVariant (sym: CARDINAL; visited: List) : BOOLEAN ;
 524 BEGIN
 525    IF (sym # NulSym) AND (NOT IsItemInList (visited, sym))
 526    THEN
 527       IncludeItemIntoList (visited, sym) ;
 528       IF IsVar (sym)
 529       THEN
 530          RETURN VarContainsVarient (sym, visited)
 531       ELSIF IsRecord (sym)
 532       THEN
 533          RETURN RecordContainsVarient (sym, visited)
 534       ELSIF IsPointer (sym)
 535       THEN
 536          RETURN PointerContainsVarient (sym, visited)
 537       ELSIF IsArray (sym)
 538       THEN
 539          RETURN ArrayContainsVarient (sym, visited)
 540       ELSIF IsType (sym)
 541       THEN
 542          RETURN TypeContainsVarient (sym, visited)
 543       END
 544    END ;
 545    RETURN FALSE
 546 END doContainsVariant ;
 547
 548
 549 (*
 550    ContainsVariant - returns TRUE if type sym contains a variant record.
 551 *)
 552
 553 PROCEDURE ContainsVariant (sym: CARDINAL) : BOOLEAN ;
 554 VAR
 555    visited: List ;
 556    result : BOOLEAN ;
 557 BEGIN
 558    InitList (visited) ;
 559    result := doContainsVariant (sym, visited) ;
 560    KillList (visited) ;
 561    RETURN result
 562 END ContainsVariant ;
 563
 564
 565 (*
 566    IssueConditional -
 567 *)
 568
 569 PROCEDURE IssueConditional (quad: CARDINAL; conditional: BOOLEAN) ;
 570 VAR
 571    op                          : QuadOperator ;
 572    op1, op2, op3               : CARDINAL ;
 573    op1tok, op2tok, op3tok, qtok: CARDINAL ;
 574    constExpr, overflowChecking : BOOLEAN ;
 575    s                           : String ;
 576 BEGIN
 577    GetQuadOtok (quad, qtok, op, op1, op2, op3,
 578                 overflowChecking, constExpr,
 579                 op1tok, op2tok, op3tok) ;
 580    IF IsUniqueWarning (qtok)
 581    THEN
 582       op1tok := DefaultTokPos (op1tok, qtok) ;
 583       op2tok := DefaultTokPos (op2tok, qtok) ;
 584       op3tok := DefaultTokPos (op3tok, qtok) ;
 585       IF NOT conditional
 586       THEN
 587          op := Opposite (op)
 588       END ;
 589       s := InitString ('depending upon the result of {%1Oad} ') ;
 590       s := ConCat (s, Mark (GetM2OperatorDesc (op))) ;
 591       s := ConCat (s, InitString (' {%2ad}')) ;
 592       MetaErrorStringT2 (qtok, s, op1, op2)
 593    END
 594 END IssueConditional ;
 595
 596
 597 (*
 598    GenerateNoteFlow -
 599 *)
 600
 601 PROCEDURE GenerateNoteFlow (n: CARDINAL; warning: BOOLEAN) ;
 602 VAR
 603    i     : CARDINAL ;
 604    ip1Ptr,
 605    iPtr  : bbEntry ;
 606 BEGIN
 607    IF NOT warning
 608    THEN
 609       (* Only issue flow messages for non warnings.  *)
 610       i := 1 ;
 611       WHILE i <= n DO
 612          iPtr := Indexing.GetIndice (bbArray, i) ;
 613          IF iPtr^.endCond
 614          THEN
 615             IF i < n
 616             THEN
 617                ip1Ptr := Indexing.GetIndice (bbArray, i+1) ;
 618                IssueConditional (iPtr^.end, iPtr^.condBB = ip1Ptr^.indexBB)
 619             END
 620          END ;
 621          INC (i)
 622       END
 623    END
 624 END GenerateNoteFlow ;
 625
 626
 627 (*
 628    IssueWarning - issue a warning or note at tok location.
 629 *)
 630
 631 PROCEDURE IssueWarning (tok: CARDINAL;
 632                         before, after: ARRAY OF CHAR;
 633                         sym: CARDINAL; warning: BOOLEAN) ;
 634 VAR
 635    s: String ;
 636 BEGIN
 637    s := InitString (before) ;
 638    IF warning
 639    THEN
 640       s := ConCat (s, Mark (InitString ('{%1Wad}')))
 641    ELSE
 642       s := ConCat (s, Mark (InitString ('{%1Oad}')))
 643    END ;
 644    s := ConCat (s, Mark (InitString (after))) ;
 645    MetaErrorStringT1 (tok, s, sym)
 646 END IssueWarning ;
 647
 648
 649 (*
 650    IsUniqueWarning - return TRUE if a warning has not been issued at tok.
 651                      It remembers tok and subsequent calls will always return FALSE.
 652 *)
 653
 654 PROCEDURE IsUniqueWarning (tok: CARDINAL) : BOOLEAN ;
 655 BEGIN
 656    IF NOT IsItemInList (errorList, tok)
 657    THEN
 658       IncludeItemIntoList (errorList, tok) ;
 659       RETURN TRUE
 660    ELSE
 661       RETURN FALSE
 662    END
 663 END IsUniqueWarning ;
 664
 665
 666 (*
 667    CheckDeferredRecordAccess -
 668 *)
 669
 670 PROCEDURE CheckDeferredRecordAccess (tok: CARDINAL;
 671                                      sym: CARDINAL;
 672                                      canDereference, warning: BOOLEAN;
 673                                      i: CARDINAL) ;
 674 VAR
 675    unique: BOOLEAN ;
 676 BEGIN
 677    IF IsVar (sym)
 678    THEN
 679       IF Debugging
 680       THEN
 681          Trace ("CheckDeferredRecordAccess %d\n", sym) ;
 682          PrintSym (sym) ;
 683          IF canDereference
 684          THEN
 685             printf1 ("checkReadInit (%d, true)\n", sym)
 686          ELSE
 687             printf1 ("checkReadInit (%d, false)\n", sym)
 688          END
 689       END ;
 690       IF IsExempt (sym)
 691       THEN
 692          Trace ("checkReadInit sym is a parameter or not a local variable (%d)", sym) ;
 693          (* We assume parameters have been initialized.  *)
 694          PutVarInitialized (sym, LeftValue) ;
 695          PutVarInitialized (sym, RightValue)
 696          (* SetVarInitialized (sym, TRUE) *)
 697       ELSIF IsUnbounded (GetSType (sym))
 698       THEN
 699          SetVarInitialized (sym, TRUE, tok)
 700       ELSIF IsComponent (sym)
 701       THEN
 702          Trace ("checkReadInit IsComponent (%d) is true)", sym) ;
 703          IF (NOT GetVarComponentInitialized (sym, tok)) AND IsUniqueWarning (tok)
 704          THEN
 705             GenerateNoteFlow (i, warning) ;
 706             IssueWarning (tok,
 707                           'attempting to access ',
 708                           ' before it has been initialized',
 709                           sym, warning)
 710          END
 711       ELSIF (GetMode (sym) = LeftValue) AND canDereference
 712       THEN
 713          Trace ("checkReadInit GetMode (%d) = LeftValue and canDereference (LeftValue and RightValue VarCheckReadInit)", sym) ;
 714          unique := TRUE ;
 715          IF NOT VarCheckReadInit (sym, LeftValue)
 716          THEN
 717             unique := IsUniqueWarning (tok) ;
 718             IF unique
 719             THEN
 720                GenerateNoteFlow (i, warning) ;
 721                IssueWarning (tok,
 722                              'attempting to access the address of ',
 723                              ' before it has been initialized',
 724                              sym, warning)
 725             END
 726          END ;
 727          IF NOT VarCheckReadInit (sym, RightValue)
 728          THEN
 729             IF unique
 730             THEN
 731                GenerateNoteFlow (i, warning) ;
 732                IssueWarning (tok,
 733                              'attempting to access ', ' before it has been initialized',
 734                              sym, warning)
 735             END
 736          END
 737       ELSE
 738          Trace ("checkReadInit call VarCheckReadInit using GetMode (%d)", sym) ;
 739          IF (NOT VarCheckReadInit (sym, GetMode (sym))) AND IsUniqueWarning (tok)
 740          THEN
 741             GenerateNoteFlow (i, warning) ;
 742             IssueWarning (tok,
 743                           'attempting to access ',
 744                           ' before it has been initialized',
 745                           sym, warning)
 746          END
 747       END
 748    END
 749 END CheckDeferredRecordAccess ;
 750
 751
 752 (*
 753    SetVarUninitialized - resets variable init state.
 754 *)
 755
 756 PROCEDURE SetVarUninitialized (sym: CARDINAL) ;
 757 BEGIN
 758    IF IsVar (sym)
 759    THEN
 760       IF NOT IsUnbounded (GetSType (sym))
 761       THEN
 762          VarInitState (sym)
 763       END
 764    END
 765 END SetVarUninitialized ;
 766
 767
 768 (*
 769    ComponentFindVar -
 770 *)
 771
 772 PROCEDURE ComponentFindVar (sym: CARDINAL;
 773                             VAR lvalue: BOOLEAN;
 774                             tok: CARDINAL) : CARDINAL ;
 775 VAR
 776    nsym,
 777    i   : CARDINAL ;
 778 BEGIN
 779    i := 1 ;
 780    REPEAT
 781       nsym := GetNth (sym, i) ;
 782       lvalue := GetMode (nsym) = LeftValue ;
 783       nsym := getLAlias (nsym) ;
 784       IF nsym = Nil
 785       THEN
 786          MetaErrorT1 (tok,
 787                       "attempting to dereference {%1Wad} which will be a {%kNIL} pointer",
 788                       sym) ;
 789          RETURN NulSym
 790       ELSIF (nsym # NulSym) AND IsVar (nsym)
 791       THEN
 792          IF (nsym # sym) AND IsComponent (nsym)
 793          THEN
 794             RETURN ComponentFindVar (nsym, lvalue, tok)
 795          ELSE
 796             RETURN nsym
 797          END
 798       END ;
 799       INC (i)
 800    UNTIL nsym = NulSym ;
 801    RETURN NulSym
 802 END ComponentFindVar ;
 803
 804
 805 (*
 806    ComponentCreateFieldList - builds a list of fields accessed by the component var.
 807                               Each item in the list will be a field of incremental levels
 808                               though a nested record.  It is not a list of fields
 809                               at the same level.
 810
 811                               foo = RECORD
 812                                        v: RECORD
 813                                              x, y: CARDINAL ;
 814                                           END ;
 815                                        w: CARDINAL ;
 816                                     END ;
 817
 818                               { v, x } for example and not { v, w }
 819 *)
 820
 821 PROCEDURE ComponentCreateFieldList (sym: CARDINAL) : List ;
 822 VAR
 823    lst: List ;
 824 BEGIN
 825    InitList (lst) ;
 826    IF IsVar (sym) AND IsComponent (sym)
 827    THEN
 828       ComponentBuildFieldList (lst, sym)
 829    END ;
 830    RETURN lst
 831 END ComponentCreateFieldList ;
 832
 833
 834 PROCEDURE ComponentBuildFieldList (lst: List; sym: CARDINAL) ;
 835 VAR
 836    i, nsym: CARDINAL ;
 837 BEGIN
 838    i := 1 ;
 839    REPEAT
 840       nsym := GetNth (sym, i) ;
 841       IF nsym # NulSym
 842       THEN
 843          IF IsComponent (nsym)
 844          THEN
 845             ComponentBuildFieldList (lst, nsym)
 846          ELSIF IsRecordField (nsym)
 847          THEN
 848             IncludeItemIntoList (lst, nsym)
 849          END ;
 850          INC (i)
 851       END
 852    UNTIL nsym = NulSym
 853 END ComponentBuildFieldList ;
 854
 855
 856 (*
 857    deRefComponent -
 858 *)
 859
 860 PROCEDURE deRefComponent (component: CARDINAL; lvalue: BOOLEAN;
 861                           sym: CARDINAL; tok: CARDINAL) : CARDINAL ;
 862 BEGIN
 863    IF lvalue
 864    THEN
 865       RETURN getContent (component, sym, tok)
 866    ELSE
 867       RETURN component
 868    END
 869 END deRefComponent ;
 870
 871
 872 (*
 873    SetVarComponentInitialized -
 874 *)
 875
 876 PROCEDURE SetVarComponentInitialized (sym: CARDINAL; tok: CARDINAL) ;
 877 VAR
 878    lvalue: BOOLEAN ;
 879    i, n,
 880    fsym,
 881    vsym  : CARDINAL ;
 882    lst   : List ;
 883 BEGIN
 884    vsym := ComponentFindVar (sym, lvalue, tok) ;
 885    vsym := deRefComponent (vsym, lvalue, sym, tok) ;
 886    IF vsym # NulSym
 887    THEN
 888       IF Debugging
 889       THEN
 890          printf0 ("*************** vsym is: ") ;
 891          PrintSym (vsym)
 892       END ;
 893       (* Build list accessing the field.  *)
 894       lst := ComponentCreateFieldList (sym) ;
 895       IF Debugging
 896       THEN
 897          printf2 ("sym = %d, vsym = %d, fields:", sym, vsym)
 898       END ;
 899       (* Now mark this field in the record variable as initialized.  *)
 900       IF PutVarFieldInitialized (vsym, RightValue, lst)
 901       THEN
 902          IF Debugging
 903          THEN
 904             i := 1 ;
 905             n := NoOfItemsInList (lst) ;
 906             WHILE i <= n DO
 907                fsym := GetItemFromList (lst, i) ;
 908                printf1 (" %d", fsym) ;
 909                INC (i)
 910             END ;
 911             printf0 (" is initialized\n")
 912          END
 913       ELSIF Debugging
 914       THEN
 915          printf0 (" vsym is not a var\n")
 916       END ;
 917       KillList (lst)
 918    END
 919 END SetVarComponentInitialized ;
 920
 921
 922 (*
 923    GetVarComponentInitialized -
 924 *)
 925
 926 PROCEDURE GetVarComponentInitialized (sym: CARDINAL; tok: CARDINAL) : BOOLEAN ;
 927 VAR
 928    lvalue,
 929    init     : BOOLEAN ;
 930    component,
 931    vsym     : CARDINAL ;
 932    lst      : List ;
 933 BEGIN
 934    component := ComponentFindVar (sym, lvalue, tok) ;
 935    IF IsItemInList (ignoreList, component) OR IsExempt (component)
 936    THEN
 937       RETURN TRUE
 938    ELSE
 939       init := FALSE ;
 940       vsym := deRefComponent (component, lvalue, sym, tok) ;
 941       IF vsym # NulSym
 942       THEN
 943          IF IsExempt (vsym)
 944          THEN
 945             init := TRUE
 946          ELSE
 947             (* Create list representing how the field is accessed.  *)
 948             lst := ComponentCreateFieldList (sym) ;
 949             (* Now obtain the mark indicating whether this field was initialized.  *)
 950             init := GetVarFieldInitialized (vsym, RightValue, lst) ;
 951             KillList (lst)
 952          END
 953       END ;
 954       RETURN init
 955    END
 956 END GetVarComponentInitialized ;
 957
 958
 959 (*
 960    Trace -
 961 *)
 962
 963 PROCEDURE Trace (message: ARRAY OF CHAR; sym: CARDINAL) ;
 964 BEGIN
 965    IF Debugging
 966    THEN
 967       printf1 (message, sym) ;
 968       printf0 ("\n")
 969    END
 970 END Trace ;
 971
 972
 973 (*
 974    SetVarInitialized - if the variable has a left mode and can be dereferenced
 975                        then set the left and right initialization state.
 976 *)
 977
 978 PROCEDURE SetVarInitialized (sym: CARDINAL; canDereference: BOOLEAN;
 979                              tok: CARDINAL) ;
 980 BEGIN
 981    IF IsVar (sym)
 982    THEN
 983       RemoveItemFromList (ignoreList, sym) ;
 984       IF IsComponent (sym)
 985       THEN
 986          Trace ("SetVarInitialized sym %d is a component and calling SetVarComponentInitialized", sym);
 987          SetVarComponentInitialized (sym, tok)
 988       ELSIF (GetMode (sym) = LeftValue) AND canDereference
 989       THEN
 990          Trace ("SetVarInitialized sym %d is LeftValue and canDeference and calling PutVarInitialized LeftValue and RightValue", sym);
 991          PutVarInitialized (sym, LeftValue) ;
 992          PutVarInitialized (sym, RightValue)
 993       ELSE
 994          Trace ("SetVarInitialized sym %d calling PutVarInitialized with its mode", sym);
 995          PutVarInitialized (sym, GetMode (sym))
 996       END ;
 997       IF Debugging
 998       THEN
 999          PrintSym (sym)
1000       END
1001    END
1002 END SetVarInitialized ;
1003
1004
1005 (*
1006    doGetVarInitialized -
1007 *)
1008
1009 PROCEDURE doGetVarInitialized (sym: CARDINAL; tok: CARDINAL) : BOOLEAN ;
1010 BEGIN
1011    IF IsVar (sym)
1012    THEN
1013       IF IsUnbounded (GetSType (sym))
1014       THEN
1015          RETURN TRUE
1016       ELSIF IsComponent (sym)
1017       THEN
1018          RETURN GetVarComponentInitialized (sym, tok)
1019       END ;
1020       RETURN VarCheckReadInit (sym, GetMode (sym))
1021    END ;
1022    RETURN IsConst (sym) AND IsConstString (sym)
1023 END doGetVarInitialized ;
1024
1025
1026 (*
1027    GetVarInitialized -
1028 *)
1029
1030 PROCEDURE GetVarInitialized (sym: CARDINAL; tok: CARDINAL) : BOOLEAN ;
1031 VAR
1032    init: BOOLEAN ;
1033 BEGIN
1034    init := doGetVarInitialized (sym, tok) ;
1035    IF Debugging
1036    THEN
1037       IF init
1038       THEN
1039          Trace ("GetVarInitialized (sym = %d) returning TRUE", sym)
1040       ELSE
1041          Trace ("GetVarInitialized (sym = %d) returning FALSE", sym)
1042       END
1043    END ;
1044    RETURN init
1045 END GetVarInitialized ;
1046
1047
1048 (*
1049    IsExempt - returns TRUE if sym is a global variable or a parameter or
1050               a variable with a variant record type.
1051 *)
1052
1053 PROCEDURE IsExempt (sym: CARDINAL) : BOOLEAN ;
1054 BEGIN
1055    RETURN (sym # NulSym) AND IsVar (sym) AND
1056           (IsGlobalVar (sym) OR
1057            (* (IsVarAParam (sym) AND (GetMode (sym) = LeftValue)) OR *)
1058            ContainsVariant (sym) OR
1059            IsArray (GetSType (sym)) OR IsSet (GetSType (sym)) OR
1060            IsUnbounded (GetSType (sym)) OR IsVarArrayRef (sym) OR
1061            IsItemInList (ignoreList, sym))
1062 END IsExempt ;
1063
1064
1065 (*
1066    CheckBinary -
1067 *)
1068
1069 PROCEDURE CheckBinary (op1tok, op1,
1070                        op2tok, op2,
1071                        op3tok, op3: CARDINAL; warning: BOOLEAN;
1072                        i: CARDINAL) ;
1073 BEGIN
1074    CheckDeferredRecordAccess (op2tok, op2, FALSE, warning, i) ;
1075    CheckDeferredRecordAccess (op3tok, op3, FALSE, warning, i) ;
1076    SetVarInitialized (op1, FALSE, op1tok)
1077 END CheckBinary ;
1078
1079
1080 (*
1081    CheckUnary -
1082 *)
1083
1084 PROCEDURE CheckUnary (lhstok, lhs,
1085                       rhstok, rhs: CARDINAL; warning: BOOLEAN;
1086                       i: CARDINAL) ;
1087 BEGIN
1088    CheckDeferredRecordAccess (rhstok, rhs, FALSE, warning, i) ;
1089    SetVarInitialized (lhs, FALSE, lhstok)
1090 END CheckUnary ;
1091
1092
1093 (*
1094    CheckXIndr -
1095 *)
1096
1097 PROCEDURE CheckXIndr (lhstok, lhs, type,
1098                       rhstok, rhs: CARDINAL; warning: BOOLEAN;
1099                       i: CARDINAL) ;
1100 VAR
1101    lst    : List ;
1102    content: CARDINAL ;
1103 BEGIN
1104    CheckDeferredRecordAccess (rhstok, rhs, FALSE, warning, i) ;
1105    CheckDeferredRecordAccess (lhstok, lhs, FALSE, warning, i) ;
1106    (* Now see if we know what lhs is pointing to and set fields if necessary.  *)
1107    content := getContent (getLAlias (lhs), lhs, lhstok) ;
1108    IF (content # NulSym) AND (content # lhs) AND (GetSType (content) = type)
1109    THEN
1110       IF IsReallyPointer (rhs)
1111       THEN
1112          SetupLAlias (content, rhs)
1113       END ;
1114       IF IsRecord (type)
1115       THEN
1116          (* Set all fields of content as initialized.  *)
1117          SetVarInitialized (content, FALSE, lhstok)
1118       ELSE
1119          (* Set only the field assigned in vsym as initialized.  *)
1120          lst := ComponentCreateFieldList (rhs) ;
1121          IF PutVarFieldInitialized (content, RightValue, lst)
1122          THEN
1123          END ;
1124          KillList (lst)
1125       END
1126    END
1127 END CheckXIndr ;
1128
1129
1130 (*
1131    CheckIndrX -
1132 *)
1133
1134 PROCEDURE CheckIndrX (lhstok, lhs, rhstok, rhs: CARDINAL;
1135                       warning: BOOLEAN;
1136                       i: CARDINAL) ;
1137 VAR
1138    content: CARDINAL ;
1139 BEGIN
1140    CheckDeferredRecordAccess (rhstok, rhs, FALSE, warning, i) ;
1141    content := getContent (getLAlias (rhs), rhs, rhstok) ;
1142    IF content = NulSym
1143    THEN
1144       IncludeItemIntoList (ignoreList, lhs)
1145    ELSE
1146       CheckDeferredRecordAccess (rhstok, content, TRUE, warning, i) ;
1147       SetVarInitialized (lhs, VarCheckReadInit (content, RightValue), lhstok) ;
1148       IF IsReallyPointer (content)
1149       THEN
1150          SetupLAlias (lhs, content)
1151       END
1152    END
1153 END CheckIndrX ;
1154
1155
1156 (*
1157    CheckRecordField -
1158 *)
1159
1160 PROCEDURE CheckRecordField (op1: CARDINAL) ;
1161 BEGIN
1162    PutVarInitialized (op1, LeftValue)
1163 END CheckRecordField ;
1164
1165
1166 (*
1167    CheckBecomes -
1168 *)
1169
1170 PROCEDURE CheckBecomes (destok, des, exprtok, expr: CARDINAL;
1171                         warning: BOOLEAN; i: CARDINAL) ;
1172 VAR
1173    lvalue: BOOLEAN ;
1174    lst   : List ;
1175    vsym  : CARDINAL ;
1176 BEGIN
1177    CheckDeferredRecordAccess (exprtok, expr, FALSE, warning, i) ;
1178    SetupLAlias (des, expr) ;
1179    SetVarInitialized (des, FALSE, destok) ;
1180    (* Now see if we know what lhs is pointing to and set fields if necessary.  *)
1181    IF IsComponent (des)
1182    THEN
1183       vsym := ComponentFindVar (des, lvalue, destok) ;
1184       vsym := deRefComponent (vsym, lvalue, des, destok) ;
1185       IF vsym # NulSym
1186       THEN
1187          (* Set only the field assigned in vsym as initialized.  *)
1188          lst := ComponentCreateFieldList (des) ;
1189          IF PutVarFieldInitialized (vsym, RightValue, lst)
1190          THEN
1191          END ;
1192          KillList (lst)
1193       END
1194    END
1195 END CheckBecomes ;
1196
1197
1198 (*
1199    CheckComparison -
1200 *)
1201
1202 PROCEDURE CheckComparison (op1tok, op1, op2tok, op2: CARDINAL;
1203                            warning: BOOLEAN; i: CARDINAL) ;
1204 BEGIN
1205    CheckDeferredRecordAccess (op1tok, op1, FALSE, warning, i) ;
1206    CheckDeferredRecordAccess (op2tok, op2, FALSE, warning, i)
1207 END CheckComparison ;
1208
1209
1210 (*
1211    CheckAddr -
1212 *)
1213
1214 PROCEDURE CheckAddr (ptrtok, ptr, contenttok, content: CARDINAL) ;
1215 BEGIN
1216    SetVarInitialized (ptr, GetVarInitialized (content, contenttok), ptrtok) ;
1217    SetupIndr (ptr, content)
1218 END CheckAddr ;
1219
1220
1221 (*
1222    DefaultTokPos -
1223 *)
1224
1225 PROCEDURE DefaultTokPos (preferredPos, defaultPos: CARDINAL) : CARDINAL ;
1226 BEGIN
1227    IF preferredPos = UnknownTokenNo
1228    THEN
1229       RETURN defaultPos
1230    END ;
1231    RETURN preferredPos
1232 END DefaultTokPos ;
1233
1234
1235 (*
1236    stop -
1237 *)
1238
1239 PROCEDURE stop ;
1240 END stop ;
1241
1242
1243 (*
1244    CheckReadBeforeInitQuad -
1245 *)
1246
1247 PROCEDURE CheckReadBeforeInitQuad (procSym: CARDINAL; quad: CARDINAL;
1248                                    warning: BOOLEAN; i: CARDINAL) : BOOLEAN ;
1249 VAR
1250    op                          : QuadOperator ;
1251    op1, op2, op3               : CARDINAL ;
1252    op1tok, op2tok, op3tok, qtok: CARDINAL ;
1253    constExpr, overflowChecking : BOOLEAN ;
1254 BEGIN
1255    IF quad = 3140
1256    THEN
1257       stop
1258    END ;
1259    IF Debugging
1260    THEN
1261       printf1 ("CheckReadBeforeInitQuad (quad %d)\n", quad) ;
1262       DumpAliases ;
1263       ForeachLocalSymDo (procSym, PrintSym) ;
1264       printf0 ("***********************************\n")
1265    END ;
1266    GetQuadOtok (quad, qtok, op, op1, op2, op3,
1267                 overflowChecking, constExpr,
1268                 op1tok, op2tok, op3tok) ;
1269    op1tok := DefaultTokPos (op1tok, qtok) ;
1270    op2tok := DefaultTokPos (op2tok, qtok) ;
1271    op3tok := DefaultTokPos (op3tok, qtok) ;
1272    CASE op OF
1273
1274    (* Jumps, calls and branches.  *)
1275    IfInOp,
1276    IfNotInOp,
1277    IfEquOp,
1278    IfNotEquOp,
1279    IfLessOp,
1280    IfLessEquOp,
1281    IfGreOp,
1282    IfGreEquOp        : CheckComparison (op1tok, op1, op2tok, op2, warning, i) |
1283    TryOp,
1284    ReturnOp,
1285    CallOp,
1286    KillLocalVarOp,
1287    RetryOp,
1288    GotoOp            : RETURN TRUE |   (* End of basic block.  *)
1289
1290    (* Variable references.  *)
1291
1292    InclOp,
1293    ExclOp            : CheckDeferredRecordAccess (op1tok, op1, FALSE, warning, i) ;
1294                        CheckDeferredRecordAccess (op1tok, op1, TRUE, warning, i) ;
1295                        CheckDeferredRecordAccess (op3tok, op3, FALSE, warning, i) |
1296    NegateOp          : CheckUnary (op1tok, op1, op3tok, op3, warning, i) |
1297    BecomesOp         : CheckBecomes (op1tok, op1, op3tok, op3, warning, i) |
1298    UnboundedOp,
1299    FunctValueOp,
1300    StandardFunctionOp,
1301    HighOp,
1302    SizeOp            : SetVarInitialized (op1, FALSE, op1tok) |
1303    AddrOp            : CheckAddr (op1tok, op1, op3tok, op3) |
1304    ReturnValueOp     : SetVarInitialized (op1, FALSE, op1tok) |
1305    NewLocalVarOp     : |
1306    ParamOp           : CheckDeferredRecordAccess (op2tok, op2, FALSE, warning, i) ;
1307                        CheckDeferredRecordAccess (op3tok, op3, FALSE, warning, i) ;
1308                        IF (op1 > 0) AND (op1 <= NoOfParam (op2)) AND
1309                           IsVarParam (op2, op1)
1310                        THEN
1311                           SetVarInitialized (op3, TRUE, op3tok)
1312                        END |
1313    ArrayOp           : CheckDeferredRecordAccess (op3tok, op3, FALSE, warning, i) ;
1314                        SetVarInitialized (op1, TRUE, op1tok) |
1315    RecordFieldOp     : CheckRecordField (op1) |
1316    LogicalShiftOp,
1317    LogicalRotateOp,
1318    LogicalOrOp,
1319    LogicalAndOp,
1320    LogicalXorOp,
1321    LogicalDiffOp,
1322    CoerceOp,
1323    ConvertOp,
1324    CastOp,
1325    AddOp,
1326    ArithAddOp,
1327    SubOp,
1328    MultOp,
1329    DivM2Op,
1330    ModM2Op,
1331    ModFloorOp,
1332    DivCeilOp,
1333    ModCeilOp,
1334    DivFloorOp,
1335    ModTruncOp,
1336    DivTruncOp        : CheckBinary (op1tok, op1, op2tok, op2, op3tok, op3, warning, i) |
1337    XIndrOp           : CheckXIndr (op1tok, op1, op2, op3tok, op3, warning, i) |
1338    IndrXOp           : CheckIndrX (op1tok, op1, op3tok, op3, warning, i) |
1339    SaveExceptionOp   : SetVarInitialized (op1, FALSE, op1tok) |
1340    RestoreExceptionOp: CheckDeferredRecordAccess (op1tok, op1, FALSE, warning, i) |
1341
1342    SubrangeLowOp,
1343    SubrangeHighOp    : InternalError ('quadruples should have been resolved') |
1344    ElementSizeOp,
1345    BuiltinConstOp,  (* Nothing to do, it is assigning a constant to op1 (also a const).  *)
1346    BuiltinTypeInfoOp,  (* Likewise assigning op1 (const) with a type.  *)
1347    StringConvertCnulOp,
1348    StringConvertM2nulOp,
1349    StringLengthOp,
1350    ProcedureScopeOp,
1351    InitEndOp,
1352    InitStartOp,
1353    FinallyStartOp,
1354    FinallyEndOp,
1355    CatchBeginOp,
1356    CatchEndOp,
1357    ThrowOp,
1358    StartDefFileOp,
1359    StartModFileOp,
1360    EndFileOp,
1361    CodeOnOp,
1362    CodeOffOp,
1363    ProfileOnOp,
1364    ProfileOffOp,
1365    OptimizeOnOp,
1366    OptimizeOffOp,
1367    InlineOp,
1368    LineNumberOp,
1369    StatementNoteOp,
1370    SavePriorityOp,
1371    RestorePriorityOp,
1372    RangeCheckOp,
1373    ModuleScopeOp,
1374    ErrorOp,
1375    DummyOp,
1376    OptParamOp,
1377    InitAddressOp   : |
1378
1379    END ;
1380    RETURN FALSE
1381 END CheckReadBeforeInitQuad ;
1382
1383
1384 (*
1385    FilterCheckReadBeforeInitQuad -
1386 *)
1387
1388 PROCEDURE FilterCheckReadBeforeInitQuad (procSym: CARDINAL; start: CARDINAL;
1389                                          warning: BOOLEAN;
1390                                          i: CARDINAL) : BOOLEAN ;
1391 VAR
1392    Op           : QuadOperator ;
1393    Op1, Op2, Op3: CARDINAL ;
1394 BEGIN
1395    GetQuad (start, Op, Op1, Op2, Op3) ;
1396    IF (Op # RangeCheckOp) AND (Op # StatementNoteOp)
1397    THEN
1398       RETURN CheckReadBeforeInitQuad (procSym, start, warning, i)
1399    END ;
1400    RETURN FALSE
1401 END FilterCheckReadBeforeInitQuad ;
1402
1403
1404 (*
1405    CheckReadBeforeInitFirstBasicBlock -
1406 *)
1407
1408 PROCEDURE CheckReadBeforeInitFirstBasicBlock (procSym: CARDINAL;
1409                                               start, end: CARDINAL;
1410                                               warning: BOOLEAN;
1411                                               i: CARDINAL) ;
1412 BEGIN
1413    LOOP
1414       IF FilterCheckReadBeforeInitQuad (procSym, start, warning, i)
1415       THEN
1416       END ;
1417       IF start = end
1418       THEN
1419          RETURN
1420       ELSE
1421          start := GetNextQuad (start)
1422       END
1423    END
1424 END CheckReadBeforeInitFirstBasicBlock ;
1425
1426
1427 (*
1428    bbArrayKill -
1429 *)
1430
1431 PROCEDURE bbArrayKill ;
1432 VAR
1433    i, h : CARDINAL ;
1434    bbPtr: bbEntry ;
1435 BEGIN
1436    h := Indexing.HighIndice (bbArray) ;
1437    i := 1 ;
1438    WHILE i <= h DO
1439       bbPtr := Indexing.GetIndice (bbArray, i) ;
1440       bbPtr^.next := bbFreeList ;
1441       bbFreeList := bbPtr ;
1442       INC (i)
1443    END ;
1444    bbArray := Indexing.KillIndex (bbArray)
1445 END bbArrayKill ;
1446
1447
1448 (*
1449    DumpBBEntry -
1450 *)
1451
1452 PROCEDURE DumpBBEntry (bbPtr: bbEntry; procSym: CARDINAL) ;
1453 BEGIN
1454    printf4 ("bb %d: scope %d:  quads: %d .. %d",
1455             bbPtr^.indexBB, procSym, bbPtr^.start, bbPtr^.end) ;
1456    IF bbPtr^.first
1457    THEN
1458       printf0 (" first")
1459    END ;
1460    IF bbPtr^.endCall
1461    THEN
1462       printf0 (" endcall")
1463    END ;
1464    IF bbPtr^.endGoto
1465    THEN
1466       printf0 (" endgoto")
1467    END ;
1468    IF bbPtr^.endCond
1469    THEN
1470       printf0 (" endcond")
1471    END ;
1472    IF bbPtr^.topOfLoop
1473    THEN
1474       printf0 (" topofloop")
1475    END ;
1476    IF bbPtr^.condBB # 0
1477    THEN
1478       printf1 (" cond %d", bbPtr^.condBB)
1479    END ;
1480    IF bbPtr^.nextBB # 0
1481    THEN
1482       printf1 (" next %d", bbPtr^.nextBB)
1483    END ;
1484    printf0 ("\n")
1485 END DumpBBEntry ;
1486
1487
1488 (*
1489    DumpBBArray -
1490 *)
1491
1492 PROCEDURE DumpBBArray (procSym: CARDINAL) ;
1493 VAR
1494    bbPtr: bbEntry ;
1495    i, n : CARDINAL ;
1496 BEGIN
1497    i := 1 ;
1498    n := Indexing.HighIndice (bbArray) ;
1499    WHILE i <= n DO
1500       bbPtr := Indexing.GetIndice (bbArray, i) ;
1501       DumpBBEntry (bbPtr, procSym) ;
1502       INC (i)
1503    END ;
1504    i := 1 ;
1505    WHILE i <= n DO
1506       bbPtr := Indexing.GetIndice (bbArray, i) ;
1507       printf4 ("bb %d: scope %d:  quads: %d .. %d\n",
1508                bbPtr^.indexBB, procSym, bbPtr^.start, bbPtr^.end) ;
1509       DisplayQuadRange (procSym, bbPtr^.start, bbPtr^.end) ;
1510       INC (i)
1511    END
1512 END DumpBBArray ;
1513
1514
1515 (*
1516    DumpBBSequence -
1517 *)
1518
1519 PROCEDURE DumpBBSequence (lst: List) ;
1520 VAR
1521    arrayindex,
1522    listindex, n: CARDINAL ;
1523 BEGIN
1524    n := NoOfItemsInList (lst) ;
1525    listindex := 1 ;
1526    printf0 ("=============\n");
1527    printf0 (" checking sequence:");
1528    WHILE listindex <= n DO
1529       arrayindex := GetItemFromList (lst, listindex) ;
1530       printf2 (" lst[%d] -> %d", listindex, arrayindex) ;
1531       INC (listindex)
1532    END ;
1533    printf0 ("\n")
1534 END DumpBBSequence ;
1535
1536
1537 (*
1538    trashParam -
1539 *)
1540
1541 PROCEDURE trashParam (trashQuad: CARDINAL) ;
1542 VAR
1543    op                            : QuadOperator ;
1544    op1, proc, param, paramValue  : CARDINAL ;
1545    op1tok, op2tok, paramtok, qtok: CARDINAL ;
1546    constExpr, overflowChecking   : BOOLEAN ;
1547    heapValue, ptrToHeap          : CARDINAL ;
1548 BEGIN
1549    IF trashQuad # 0
1550    THEN
1551       GetQuadOtok (trashQuad, qtok, op, op1, proc, param,
1552                    overflowChecking, constExpr,
1553                    op1tok, op2tok, paramtok) ;
1554       heapValue := GetQuadTrash (trashQuad) ;
1555       IF Debugging
1556       THEN
1557          printf1 ("heapValue = %d\n", heapValue)
1558       END ;
1559       IF heapValue # NulSym
1560       THEN
1561          SetVarInitialized (param, FALSE, paramtok) ;
1562          paramValue := getLAlias (param) ;
1563          ptrToHeap := getContent (paramValue, param, paramtok) ;
1564          IF ptrToHeap # NulSym
1565          THEN
1566             IF IsDeallocate (proc)
1567             THEN
1568                SetupLAlias (ptrToHeap, Nil) ;
1569                SetVarInitialized (ptrToHeap, FALSE, paramtok)
1570             ELSE
1571                SetupIndr (ptrToHeap, heapValue) ;
1572                SetVarInitialized (ptrToHeap, TRUE, paramtok)
1573             END
1574          END
1575       END
1576    END ;
1577    DumpAliases
1578 END trashParam ;
1579
1580
1581 (*
1582    SetVarLRInitialized - this sets up an alias between the parameter
1583                          value and the pointer for the case:
1584
1585                          procedure foo (var shadow: PtrToType) ;
1586
1587                          which allows shadow to be statically analyzed
1588                          once it is re-assigned.
1589 *)
1590
1591 PROCEDURE SetVarLRInitialized (param: CARDINAL) ;
1592 VAR
1593    heap,
1594    shadow: CARDINAL ;
1595 BEGIN
1596    Assert (IsParameter (param)) ;
1597    shadow := GetParameterShadowVar (param) ;
1598    IF shadow # NulSym
1599    THEN
1600       IncludeItemIntoList (ignoreList, shadow)
1601    END ;
1602    heap := GetParameterHeapVar (param) ;
1603    IF (shadow # NulSym) AND (heap # NulSym)
1604    THEN
1605       PutVarInitialized (shadow, GetMode (shadow)) ;
1606       PutVarInitialized (heap, GetMode (heap)) ;
1607       SetupIndr (shadow, heap) ;
1608       IncludeItemIntoList (ignoreList, heap)
1609    END
1610 END SetVarLRInitialized ;
1611
1612
1613 (*
1614    TestBBSequence -
1615 *)
1616
1617 PROCEDURE TestBBSequence (procSym: CARDINAL; lst: List) ;
1618 VAR
1619    bbPtr  : bbEntry ;
1620    bbi,
1621    i, n   : CARDINAL ;
1622    warning: BOOLEAN ;  (* Should we issue a warning rather than a note?  *)
1623 BEGIN
1624    IF Debugging
1625    THEN
1626       DumpBBSequence (lst)
1627    END ;
1628    initBlock ;
1629    ForeachLocalSymDo (procSym, SetVarUninitialized) ;
1630    ForeachParamSymDo (procSym, SetVarLRInitialized) ;
1631    n := NoOfItemsInList (lst) ;
1632    i := 1 ;
1633    warning := TRUE ;
1634    WHILE i <= n DO
1635       bbi := GetItemFromList (lst, i) ;
1636       bbPtr := Indexing.GetIndice (bbArray, bbi) ;
1637       CheckReadBeforeInitFirstBasicBlock (procSym,
1638                                           bbPtr^.start, bbPtr^.end,
1639                                           warning, i) ;
1640       IF bbPtr^.endCond
1641       THEN
1642          (* Check to see if we are moving into an conditional block in which case
1643             we will issue a note.  *)
1644          warning := FALSE
1645       ELSIF bbPtr^.endCall AND (bbPtr^.trashQuad # 0)
1646       THEN
1647          trashParam (bbPtr^.trashQuad)
1648       END ;
1649       INC (i)
1650    END ;
1651    killBlock
1652 END TestBBSequence ;
1653
1654
1655 (*
1656    CreateBBPermultations -
1657 *)
1658
1659 PROCEDURE CreateBBPermultations (procSym: CARDINAL; i: CARDINAL; lst: List) ;
1660 VAR
1661    duplst: List ;
1662    iPtr  : bbEntry ;
1663 BEGIN
1664    IF i = 0
1665    THEN
1666       TestBBSequence (procSym, lst)
1667    ELSE
1668       iPtr := Indexing.GetIndice (bbArray, i) ;
1669       IF iPtr^.topOfLoop
1670       THEN
1671          TestBBSequence (procSym, lst)
1672       ELSE
1673          duplst := DuplicateList (lst) ;
1674          IncludeItemIntoList (duplst, i) ;
1675          IF iPtr^.endCall AND (iPtr^.trashQuad = 0)
1676          THEN
1677             TestBBSequence (procSym, duplst)
1678          ELSIF iPtr^.endGoto
1679          THEN
1680             CreateBBPermultations (procSym, iPtr^.nextBB, duplst)
1681          ELSIF UninitVariableConditionalChecking AND iPtr^.endCond
1682          THEN
1683             CreateBBPermultations (procSym, iPtr^.nextBB, duplst) ;
1684             CreateBBPermultations (procSym, iPtr^.condBB, duplst)
1685          ELSIF iPtr^.endCond
1686          THEN
1687             TestBBSequence (procSym, duplst)
1688          ELSE
1689             (* Fall through.  *)
1690             CreateBBPermultations (procSym, iPtr^.nextBB, duplst)
1691          END ;
1692          KillList (duplst)
1693       END
1694    END
1695 END CreateBBPermultations ;
1696
1697
1698 (*
1699    ScopeBlockVariableAnalysis - checks to see whether a variable is
1700                                 read before it has been initialized.
1701 *)
1702
1703 PROCEDURE ScopeBlockVariableAnalysis (Scope: CARDINAL;
1704                                       Start, End: CARDINAL) ;
1705 VAR
1706    bb : BasicBlock ;
1707    lst: List ;
1708 BEGIN
1709    IF UninitVariableChecking
1710    THEN
1711       bbArray := Indexing.InitIndex (1) ;
1712       bb := InitBasicBlocksFromRange (Scope, Start, End) ;
1713       ForeachBasicBlockDo (bb, AppendEntry) ;
1714       KillBasicBlocks (bb) ;
1715       GenerateCFG ;
1716       IF Scope # NulSym
1717       THEN
1718          InitList (lst) ;
1719          IF Debugging
1720          THEN
1721             DumpBBArray (Scope) ;
1722             IF UninitVariableConditionalChecking
1723             THEN
1724                printf0 ("UninitVariableConditionalChecking is TRUE\n")
1725             END
1726          END ;
1727          CreateBBPermultations (Scope, 1, lst) ;
1728          KillList (lst)
1729       END ;
1730       bbArrayKill
1731    END
1732 END ScopeBlockVariableAnalysis ;
1733
1734
1735 (*
1736    GetOp3 -
1737 *)
1738
1739 PROCEDURE GetOp3 (quad: CARDINAL) : CARDINAL ;
1740 VAR
1741    op: QuadOperator ;
1742    op1, op2, op3: CARDINAL ;
1743 BEGIN
1744    GetQuad (quad, op, op1, op2, op3) ;
1745    RETURN op3
1746 END GetOp3 ;
1747
1748
1749 (*
1750    getBBindex - return the basic block index which starts with quad.
1751 *)
1752
1753 PROCEDURE getBBindex (quad: CARDINAL) : CARDINAL ;
1754 VAR
1755    iPtr   : bbEntry ;
1756    i, high: CARDINAL ;
1757 BEGIN
1758    i := 1 ;
1759    high := Indexing.HighIndice (bbArray) ;
1760    WHILE i <= high DO
1761       iPtr := Indexing.GetIndice (bbArray, i) ;
1762       IF iPtr^.start = quad
1763       THEN
1764          RETURN iPtr^.indexBB
1765       END ;
1766       INC (i)
1767    END ;
1768    RETURN 0
1769 END getBBindex ;
1770
1771
1772 (*
1773    GenerateCFG -
1774 *)
1775
1776 PROCEDURE GenerateCFG ;
1777 VAR
1778    iPtr   : bbEntry ;
1779    next,
1780    i, high: CARDINAL ;
1781 BEGIN
1782    i := 1 ;
1783    high := Indexing.HighIndice (bbArray) ;
1784    WHILE i <= high DO
1785       iPtr := Indexing.GetIndice (bbArray, i) ;
1786       IF IsKillLocalVar (iPtr^.end) OR IsReturn (iPtr^.end)
1787       THEN
1788          (* Nothing to do as we have reached the end of this scope.  *)
1789       ELSE
1790          next := GetNextQuad (iPtr^.end) ;
1791          iPtr^.nextQuad := next ;
1792          iPtr^.nextBB := getBBindex (next) ;
1793          IF iPtr^.endCond
1794          THEN
1795             iPtr^.condQuad := GetOp3 (iPtr^.end) ;
1796             iPtr^.condBB := getBBindex (iPtr^.condQuad)
1797          END
1798       END ;
1799       INC (i)
1800    END
1801 END GenerateCFG ;
1802
1803
1804 (*
1805    NewEntry -
1806 *)
1807
1808 PROCEDURE NewEntry () : bbEntry ;
1809 VAR
1810    bbPtr: bbEntry ;
1811 BEGIN
1812    IF bbFreeList = NIL
1813    THEN
1814       NEW (bbPtr)
1815    ELSE
1816       bbPtr := bbFreeList ;
1817       bbFreeList := bbFreeList^.next
1818    END ;
1819    RETURN bbPtr
1820 END NewEntry ;
1821
1822
1823 (*
1824    IsAllocate - return TRUE is sym is ALLOCATE.
1825 *)
1826
1827 PROCEDURE IsAllocate (sym: CARDINAL) : BOOLEAN ;
1828 BEGIN
1829    RETURN IsProcedure (sym) AND (GetSymName (sym) = MakeKey('ALLOCATE'))
1830 END IsAllocate ;
1831
1832
1833 (*
1834    IsDeallocate - return TRUE is sym is DEALLOCATE.
1835 *)
1836
1837 PROCEDURE IsDeallocate (sym: CARDINAL) : BOOLEAN ;
1838 BEGIN
1839    RETURN IsProcedure (sym) AND (GetSymName (sym) = MakeKey('DEALLOCATE'))
1840 END IsDeallocate ;
1841
1842
1843 (*
1844    DetectTrash -
1845 *)
1846
1847 PROCEDURE DetectTrash (bbPtr: bbEntry) ;
1848 VAR
1849    i            : CARDINAL ;
1850    op           : QuadOperator ;
1851    op1, op2, op3: CARDINAL ;
1852 BEGIN
1853    IF bbPtr^.endCall
1854    THEN
1855       i := bbPtr^.start ;
1856       LOOP
1857          GetQuad (i, op, op1, op2, op3) ;
1858          IF (op = ParamOp) AND (op1 = 1) AND (IsAllocate (op2) OR IsDeallocate (op2))
1859          THEN
1860             bbPtr^.trashQuad := i
1861          END ;
1862          IF i = bbPtr^.end
1863          THEN
1864             RETURN
1865          END ;
1866          i := GetNextQuad (i)
1867       END
1868    END
1869 END DetectTrash ;
1870
1871
1872 (*
1873    AppendEntry -
1874 *)
1875
1876 PROCEDURE AppendEntry (Start, End: CARDINAL) ;
1877 VAR
1878    bbPtr: bbEntry ;
1879    high : CARDINAL ;
1880 BEGIN
1881    high := Indexing.HighIndice (bbArray) ;
1882    bbPtr := NewEntry () ;
1883    WITH bbPtr^ DO
1884       start := Start ;
1885       end := End ;
1886       first := high = 0 ;
1887       endCall := IsCall (End) ;
1888       endGoto := IsGoto (End) ;
1889       endCond := IsConditional (End) ;
1890       topOfLoop := IsBackReference (Start) ;
1891       trashQuad := 0 ;
1892       indexBB := high + 1 ;
1893       nextQuad := 0 ;
1894       condQuad := 0 ;
1895       nextBB := 0 ;
1896       condBB := 0 ;
1897       next := NIL
1898    END ;
1899    DetectTrash (bbPtr) ;
1900    Indexing.PutIndice (bbArray, high + 1, bbPtr)
1901 END AppendEntry ;
1902
1903
1904 (*
1905    DumpAlias -
1906 *)
1907
1908 PROCEDURE DumpAlias (array: Index; aliasIndex: CARDINAL) ;
1909 VAR
1910    sa: symAlias ;
1911 BEGIN
1912    sa := Indexing.GetIndice (array, aliasIndex) ;
1913    printf2 ("keySym = %d: alias = %d\n", sa^.keySym, sa^.alias)
1914 END DumpAlias ;
1915
1916
1917 (*
1918    doDumpAliases -
1919 *)
1920
1921 PROCEDURE doDumpAliases (array: Index) ;
1922 VAR
1923    i, n: CARDINAL ;
1924 BEGIN
1925    i := 1 ;
1926    n := Indexing.HighIndice (array) ;
1927    WHILE i <= n DO
1928       DumpAlias (array, i) ;
1929       INC (i)
1930    END
1931 END doDumpAliases ;
1932
1933
1934 (*
1935    DumpAliases -
1936 *)
1937
1938 PROCEDURE DumpAliases ;
1939 BEGIN
1940    IF Debugging
1941    THEN
1942       printf0 ("LArray\n") ;
1943       doDumpAliases (LArray) ;
1944       printf0 ("IndirectArray\n") ;
1945       doDumpAliases (IndirectArray)
1946    END
1947 END DumpAliases ;
1948
1949
1950 (*
1951    newAlias -
1952 *)
1953
1954 PROCEDURE newAlias () : symAlias ;
1955 VAR
1956    sa: symAlias ;
1957 BEGIN
1958    IF freeList = NIL
1959    THEN
1960       NEW (sa)
1961    ELSE
1962       sa := freeList ;
1963       freeList := freeList^.next
1964    END ;
1965    RETURN sa
1966 END newAlias ;
1967
1968
1969 (*
1970    initAlias -
1971 *)
1972
1973 PROCEDURE initAlias (sym: CARDINAL) : symAlias ;
1974 VAR
1975    sa: symAlias ;
1976 BEGIN
1977    sa := newAlias () ;
1978    WITH sa^ DO
1979       keySym := sym ;
1980       alias := NulSym ;
1981       next := NIL
1982    END ;
1983    RETURN sa
1984 END initAlias ;
1985
1986
1987 (*
1988    killAlias -
1989 *)
1990
1991 PROCEDURE killAlias (sa: symAlias) ;
1992 BEGIN
1993    sa^.next := freeList ;
1994    freeList := sa
1995 END killAlias ;
1996
1997
1998 (*
1999    initBlock -
2000 *)
2001
2002 PROCEDURE initBlock ;
2003 BEGIN
2004    LArray := Indexing.InitIndex (1) ;
2005    IndirectArray := Indexing.InitIndex (1) ;
2006    InitList (ignoreList)
2007 END initBlock ;
2008
2009
2010 (*
2011    killBlock -
2012 *)
2013
2014 PROCEDURE killBlock ;
2015 BEGIN
2016    doKillBlock (LArray) ;
2017    doKillBlock (IndirectArray) ;
2018    KillList (ignoreList)
2019 END killBlock ;
2020
2021
2022 PROCEDURE doKillBlock (VAR array: Index) ;
2023 VAR
2024    i, n: CARDINAL ;
2025 BEGIN
2026    i := 1 ;
2027    n := Indexing.HighIndice (array) ;
2028    WHILE i <= n DO
2029       killAlias (Indexing.GetIndice (array, i)) ;
2030       INC (i)
2031    END ;
2032    array := Indexing.KillIndex (array)
2033 END doKillBlock ;
2034
2035
2036 (*
2037    addAlias -
2038 *)
2039
2040 PROCEDURE addAlias (array: Index; sym: CARDINAL; aliased: CARDINAL) ;
2041 VAR
2042    i, n: CARDINAL ;
2043    sa  : symAlias ;
2044 BEGIN
2045    i := 1 ;
2046    n := Indexing.HighIndice (array) ;
2047    WHILE i <= n DO
2048       sa := Indexing.GetIndice (array, i) ;
2049       IF sa^.keySym = sym
2050       THEN
2051          sa^.alias := aliased ;
2052          RETURN
2053       END ;
2054       INC (i)
2055    END ;
2056    sa := initAlias (sym) ;
2057    Indexing.IncludeIndiceIntoIndex (array, sa) ;
2058    sa^.alias := aliased
2059 END addAlias ;
2060
2061
2062 (*
2063    lookupAlias -
2064 *)
2065
2066 PROCEDURE lookupAlias (array: Index; sym: CARDINAL) : symAlias ;
2067 VAR
2068    i, n: CARDINAL ;
2069    sa  : symAlias ;
2070 BEGIN
2071    i := 1 ;
2072    n := Indexing.HighIndice (array) ;
2073    WHILE i <= n DO
2074       sa := Indexing.GetIndice (array, i) ;
2075       IF sa^.keySym = sym
2076       THEN
2077          RETURN sa
2078       END ;
2079       INC (i)
2080    END ;
2081    RETURN NIL
2082 END lookupAlias ;
2083
2084
2085 (*
2086    doGetAlias -
2087 *)
2088
2089 PROCEDURE doGetAlias (array: Index; sym: CARDINAL) : CARDINAL ;
2090 VAR
2091    sa: symAlias ;
2092 BEGIN
2093    sa := lookupAlias (array, sym) ;
2094    IF (sa # NIL) AND (sa^.alias # NulSym)
2095    THEN
2096       RETURN sa^.alias
2097    END ;
2098    RETURN NulSym
2099 END doGetAlias ;
2100
2101
2102 (*
2103    getLAlias - attempts to looks up an alias which is not a temporary variable.
2104 *)
2105
2106 PROCEDURE getLAlias (sym: CARDINAL) : CARDINAL ;
2107 VAR
2108    type,
2109    nsym: CARDINAL ;
2110 BEGIN
2111    nsym := sym ;
2112    REPEAT
2113       sym := nsym ;
2114       type := GetSType (sym) ;
2115       IF (IsTemporary (sym) AND (GetMode (sym) = LeftValue)) OR
2116          ((type # NulSym) AND IsReallyPointer (type))
2117       THEN
2118          nsym := doGetAlias (LArray, sym)
2119       ELSE
2120          RETURN sym
2121       END
2122    UNTIL nsym = NulSym ;
2123    RETURN sym
2124 END getLAlias ;
2125
2126
2127 (*
2128    SetupLAlias -
2129 *)
2130
2131 PROCEDURE SetupLAlias (des, exp: CARDINAL) ;
2132 BEGIN
2133    IF (exp = Nil) OR
2134       (IsVar (exp) AND
2135        ((GetMode (des) = LeftValue) OR IsReallyPointer (GetSType (des))))
2136    THEN
2137       addAlias (LArray, des, exp) ;
2138       DumpAliases
2139    END
2140 END SetupLAlias ;
2141
2142
2143 (*
2144    SetupIndr -
2145 *)
2146
2147 PROCEDURE SetupIndr (ptr, content: CARDINAL) ;
2148 BEGIN
2149    addAlias (IndirectArray, ptr, content) ;
2150 END SetupIndr ;
2151
2152
2153 (*
2154    getContent - attempts to return the content pointed to by ptr.
2155                 sym is the original symbol and ptr will be the equivalent lvalue.
2156 *)
2157
2158 PROCEDURE getContent (ptr: CARDINAL; sym: CARDINAL; tok: CARDINAL) : CARDINAL ;
2159 BEGIN
2160    IF ptr = Nil
2161    THEN
2162       MetaErrorT1 (tok,
2163                    "attempting to dereference {%1Wad} which will be a {%kNIL} pointer",
2164                    sym) ;
2165       RETURN NulSym
2166    ELSE
2167       RETURN doGetAlias (IndirectArray, ptr)
2168    END
2169 END getContent ;
2170
2171
2172 (*
2173    init -
2174 *)
2175
2176 PROCEDURE init ;
2177 BEGIN
2178    freeList := NIL ;
2179    bbFreeList := NIL ;
2180    InitList (errorList)
2181 END init ;
2182
2183
2184 BEGIN
2185    init
2186 END M2SymInit.