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    overflowChecking            : BOOLEAN ;
 575    s                           : String ;
 576 BEGIN
 577    GetQuadOtok (quad, qtok, op, op1, op2, op3, overflowChecking,
 578                 op1tok, op2tok, op3tok) ;
 579    IF IsUniqueWarning (qtok)
 580    THEN
 581       op1tok := DefaultTokPos (op1tok, qtok) ;
 582       op2tok := DefaultTokPos (op2tok, qtok) ;
 583       op3tok := DefaultTokPos (op3tok, qtok) ;
 584       IF NOT conditional
 585       THEN
 586          op := Opposite (op)
 587       END ;
 588       s := InitString ('depending upon the result of {%1Oad} ') ;
 589       s := ConCat (s, Mark (GetM2OperatorDesc (op))) ;
 590       s := ConCat (s, InitString (' {%2ad}')) ;
 591       MetaErrorStringT2 (qtok, s, op1, op2)
 592    END
 593 END IssueConditional ;
 594
 595
 596 (*
 597    GenerateNoteFlow -
 598 *)
 599
 600 PROCEDURE GenerateNoteFlow (n: CARDINAL; warning: BOOLEAN) ;
 601 VAR
 602    i     : CARDINAL ;
 603    ip1Ptr,
 604    iPtr  : bbEntry ;
 605 BEGIN
 606    IF NOT warning
 607    THEN
 608       (* Only issue flow messages for non warnings.  *)
 609       i := 1 ;
 610       WHILE i <= n DO
 611          iPtr := Indexing.GetIndice (bbArray, i) ;
 612          IF iPtr^.endCond
 613          THEN
 614             IF i < n
 615             THEN
 616                ip1Ptr := Indexing.GetIndice (bbArray, i+1) ;
 617                IssueConditional (iPtr^.end, iPtr^.condBB = ip1Ptr^.indexBB)
 618             END
 619          END ;
 620          INC (i)
 621       END
 622    END
 623 END GenerateNoteFlow ;
 624
 625
 626 (*
 627    IssueWarning - issue a warning or note at tok location.
 628 *)
 629
 630 PROCEDURE IssueWarning (tok: CARDINAL;
 631                         before, after: ARRAY OF CHAR;
 632                         sym: CARDINAL; warning: BOOLEAN) ;
 633 VAR
 634    s: String ;
 635 BEGIN
 636    s := InitString (before) ;
 637    IF warning
 638    THEN
 639       s := ConCat (s, Mark (InitString ('{%1Wad}')))
 640    ELSE
 641       s := ConCat (s, Mark (InitString ('{%1Oad}')))
 642    END ;
 643    s := ConCat (s, Mark (InitString (after))) ;
 644    MetaErrorStringT1 (tok, s, sym)
 645 END IssueWarning ;
 646
 647
 648 (*
 649    IsUniqueWarning - return TRUE if a warning has not been issued at tok.
 650                      It remembers tok and subsequent calls will always return FALSE.
 651 *)
 652
 653 PROCEDURE IsUniqueWarning (tok: CARDINAL) : BOOLEAN ;
 654 BEGIN
 655    IF NOT IsItemInList (errorList, tok)
 656    THEN
 657       IncludeItemIntoList (errorList, tok) ;
 658       RETURN TRUE
 659    ELSE
 660       RETURN FALSE
 661    END
 662 END IsUniqueWarning ;
 663
 664
 665 (*
 666    CheckDeferredRecordAccess -
 667 *)
 668
 669 PROCEDURE CheckDeferredRecordAccess (tok: CARDINAL;
 670                                      sym: CARDINAL;
 671                                      canDereference, warning: BOOLEAN;
 672                                      i: CARDINAL) ;
 673 VAR
 674    unique: BOOLEAN ;
 675 BEGIN
 676    IF IsVar (sym)
 677    THEN
 678       IF Debugging
 679       THEN
 680          Trace ("CheckDeferredRecordAccess %d\n", sym) ;
 681          PrintSym (sym) ;
 682          IF canDereference
 683          THEN
 684             printf1 ("checkReadInit (%d, true)\n", sym)
 685          ELSE
 686             printf1 ("checkReadInit (%d, false)\n", sym)
 687          END
 688       END ;
 689       IF IsExempt (sym)
 690       THEN
 691          Trace ("checkReadInit sym is a parameter or not a local variable (%d)", sym) ;
 692          (* We assume parameters have been initialized.  *)
 693          PutVarInitialized (sym, LeftValue) ;
 694          PutVarInitialized (sym, RightValue)
 695          (* SetVarInitialized (sym, TRUE) *)
 696       ELSIF IsUnbounded (GetSType (sym))
 697       THEN
 698          SetVarInitialized (sym, TRUE, tok)
 699       ELSIF IsComponent (sym)
 700       THEN
 701          Trace ("checkReadInit IsComponent (%d) is true)", sym) ;
 702          IF (NOT GetVarComponentInitialized (sym, tok)) AND IsUniqueWarning (tok)
 703          THEN
 704             GenerateNoteFlow (i, warning) ;
 705             IssueWarning (tok,
 706                           'attempting to access ',
 707                           ' before it has been initialized',
 708                           sym, warning)
 709          END
 710       ELSIF (GetMode (sym) = LeftValue) AND canDereference
 711       THEN
 712          Trace ("checkReadInit GetMode (%d) = LeftValue and canDereference (LeftValue and RightValue VarCheckReadInit)", sym) ;
 713          unique := TRUE ;
 714          IF NOT VarCheckReadInit (sym, LeftValue)
 715          THEN
 716             unique := IsUniqueWarning (tok) ;
 717             IF unique
 718             THEN
 719                GenerateNoteFlow (i, warning) ;
 720                IssueWarning (tok,
 721                              'attempting to access the address of ',
 722                              ' before it has been initialized',
 723                              sym, warning)
 724             END
 725          END ;
 726          IF NOT VarCheckReadInit (sym, RightValue)
 727          THEN
 728             IF unique
 729             THEN
 730                GenerateNoteFlow (i, warning) ;
 731                IssueWarning (tok,
 732                              'attempting to access ', ' before it has been initialized',
 733                              sym, warning)
 734             END
 735          END
 736       ELSE
 737          Trace ("checkReadInit call VarCheckReadInit using GetMode (%d)", sym) ;
 738          IF (NOT VarCheckReadInit (sym, GetMode (sym))) AND IsUniqueWarning (tok)
 739          THEN
 740             GenerateNoteFlow (i, warning) ;
 741             IssueWarning (tok,
 742                           'attempting to access ',
 743                           ' before it has been initialized',
 744                           sym, warning)
 745          END
 746       END
 747    END
 748 END CheckDeferredRecordAccess ;
 749
 750
 751 (*
 752    SetVarUninitialized - resets variable init state.
 753 *)
 754
 755 PROCEDURE SetVarUninitialized (sym: CARDINAL) ;
 756 BEGIN
 757    IF IsVar (sym)
 758    THEN
 759       IF NOT IsUnbounded (GetSType (sym))
 760       THEN
 761          VarInitState (sym)
 762       END
 763    END
 764 END SetVarUninitialized ;
 765
 766
 767 (*
 768    ComponentFindVar -
 769 *)
 770
 771 PROCEDURE ComponentFindVar (sym: CARDINAL;
 772                             VAR lvalue: BOOLEAN;
 773                             tok: CARDINAL) : CARDINAL ;
 774 VAR
 775    nsym,
 776    i   : CARDINAL ;
 777 BEGIN
 778    i := 1 ;
 779    REPEAT
 780       nsym := GetNth (sym, i) ;
 781       lvalue := GetMode (nsym) = LeftValue ;
 782       nsym := getLAlias (nsym) ;
 783       IF nsym = Nil
 784       THEN
 785          MetaErrorT1 (tok,
 786                       "attempting to dereference {%1Wad} which will be a {%kNIL} pointer",
 787                       sym) ;
 788          RETURN NulSym
 789       ELSIF (nsym # NulSym) AND IsVar (nsym)
 790       THEN
 791          IF (nsym # sym) AND IsComponent (nsym)
 792          THEN
 793             RETURN ComponentFindVar (nsym, lvalue, tok)
 794          ELSE
 795             RETURN nsym
 796          END
 797       END ;
 798       INC (i)
 799    UNTIL nsym = NulSym ;
 800    RETURN NulSym
 801 END ComponentFindVar ;
 802
 803
 804 (*
 805    ComponentCreateFieldList - builds a list of fields accessed by the component var.
 806                               Each item in the list will be a field of incremental levels
 807                               though a nested record.  It is not a list of fields
 808                               at the same level.
 809
 810                               foo = RECORD
 811                                        v: RECORD
 812                                              x, y: CARDINAL ;
 813                                           END ;
 814                                        w: CARDINAL ;
 815                                     END ;
 816
 817                               { v, x } for example and not { v, w }
 818 *)
 819
 820 PROCEDURE ComponentCreateFieldList (sym: CARDINAL) : List ;
 821 VAR
 822    lst: List ;
 823 BEGIN
 824    InitList (lst) ;
 825    IF IsVar (sym) AND IsComponent (sym)
 826    THEN
 827       ComponentBuildFieldList (lst, sym)
 828    END ;
 829    RETURN lst
 830 END ComponentCreateFieldList ;
 831
 832
 833 PROCEDURE ComponentBuildFieldList (lst: List; sym: CARDINAL) ;
 834 VAR
 835    i, nsym: CARDINAL ;
 836 BEGIN
 837    i := 1 ;
 838    REPEAT
 839       nsym := GetNth (sym, i) ;
 840       IF nsym # NulSym
 841       THEN
 842          IF IsComponent (nsym)
 843          THEN
 844             ComponentBuildFieldList (lst, nsym)
 845          ELSIF IsRecordField (nsym)
 846          THEN
 847             IncludeItemIntoList (lst, nsym)
 848          END ;
 849          INC (i)
 850       END
 851    UNTIL nsym = NulSym
 852 END ComponentBuildFieldList ;
 853
 854
 855 (*
 856    deRefComponent -
 857 *)
 858
 859 PROCEDURE deRefComponent (component: CARDINAL; lvalue: BOOLEAN;
 860                           sym: CARDINAL; tok: CARDINAL) : CARDINAL ;
 861 BEGIN
 862    IF lvalue
 863    THEN
 864       RETURN getContent (component, sym, tok)
 865    ELSE
 866       RETURN component
 867    END
 868 END deRefComponent ;
 869
 870
 871 (*
 872    SetVarComponentInitialized -
 873 *)
 874
 875 PROCEDURE SetVarComponentInitialized (sym: CARDINAL; tok: CARDINAL) ;
 876 VAR
 877    lvalue: BOOLEAN ;
 878    i, n,
 879    fsym,
 880    vsym  : CARDINAL ;
 881    lst   : List ;
 882 BEGIN
 883    vsym := ComponentFindVar (sym, lvalue, tok) ;
 884    vsym := deRefComponent (vsym, lvalue, sym, tok) ;
 885    IF vsym # NulSym
 886    THEN
 887       IF Debugging
 888       THEN
 889          printf0 ("*************** vsym is: ") ;
 890          PrintSym (vsym)
 891       END ;
 892       (* Build list accessing the field.  *)
 893       lst := ComponentCreateFieldList (sym) ;
 894       IF Debugging
 895       THEN
 896          printf2 ("sym = %d, vsym = %d, fields:", sym, vsym)
 897       END ;
 898       (* Now mark this field in the record variable as initialized.  *)
 899       IF PutVarFieldInitialized (vsym, RightValue, lst)
 900       THEN
 901          IF Debugging
 902          THEN
 903             i := 1 ;
 904             n := NoOfItemsInList (lst) ;
 905             WHILE i <= n DO
 906                fsym := GetItemFromList (lst, i) ;
 907                printf1 (" %d", fsym) ;
 908                INC (i)
 909             END ;
 910             printf0 (" is initialized\n")
 911          END
 912       ELSIF Debugging
 913       THEN
 914          printf0 (" vsym is not a var\n")
 915       END ;
 916       KillList (lst)
 917    END
 918 END SetVarComponentInitialized ;
 919
 920
 921 (*
 922    GetVarComponentInitialized -
 923 *)
 924
 925 PROCEDURE GetVarComponentInitialized (sym: CARDINAL; tok: CARDINAL) : BOOLEAN ;
 926 VAR
 927    lvalue,
 928    init     : BOOLEAN ;
 929    component,
 930    vsym     : CARDINAL ;
 931    lst      : List ;
 932 BEGIN
 933    component := ComponentFindVar (sym, lvalue, tok) ;
 934    IF IsItemInList (ignoreList, component) OR IsExempt (component)
 935    THEN
 936       RETURN TRUE
 937    ELSE
 938       init := FALSE ;
 939       vsym := deRefComponent (component, lvalue, sym, tok) ;
 940       IF vsym # NulSym
 941       THEN
 942          IF IsExempt (vsym)
 943          THEN
 944             init := TRUE
 945          ELSE
 946             (* Create list representing how the field is accessed.  *)
 947             lst := ComponentCreateFieldList (sym) ;
 948             (* Now obtain the mark indicating whether this field was initialized.  *)
 949             init := GetVarFieldInitialized (vsym, RightValue, lst) ;
 950             KillList (lst)
 951          END
 952       END ;
 953       RETURN init
 954    END
 955 END GetVarComponentInitialized ;
 956
 957
 958 (*
 959    Trace -
 960 *)
 961
 962 PROCEDURE Trace (message: ARRAY OF CHAR; sym: CARDINAL) ;
 963 BEGIN
 964    IF Debugging
 965    THEN
 966       printf1 (message, sym) ;
 967       printf0 ("\n")
 968    END
 969 END Trace ;
 970
 971
 972 (*
 973    SetVarInitialized - if the variable has a left mode and can be dereferenced
 974                        then set the left and right initialization state.
 975 *)
 976
 977 PROCEDURE SetVarInitialized (sym: CARDINAL; canDereference: BOOLEAN;
 978                              tok: CARDINAL) ;
 979 BEGIN
 980    IF IsVar (sym)
 981    THEN
 982       RemoveItemFromList (ignoreList, sym) ;
 983       IF IsComponent (sym)
 984       THEN
 985          Trace ("SetVarInitialized sym %d is a component and calling SetVarComponentInitialized", sym);
 986          SetVarComponentInitialized (sym, tok)
 987       ELSIF (GetMode (sym) = LeftValue) AND canDereference
 988       THEN
 989          Trace ("SetVarInitialized sym %d is LeftValue and canDeference and calling PutVarInitialized LeftValue and RightValue", sym);
 990          PutVarInitialized (sym, LeftValue) ;
 991          PutVarInitialized (sym, RightValue)
 992       ELSE
 993          Trace ("SetVarInitialized sym %d calling PutVarInitialized with its mode", sym);
 994          PutVarInitialized (sym, GetMode (sym))
 995       END ;
 996       IF Debugging
 997       THEN
 998          PrintSym (sym)
 999       END
1000    END
1001 END SetVarInitialized ;
1002
1003
1004 (*
1005    doGetVarInitialized -
1006 *)
1007
1008 PROCEDURE doGetVarInitialized (sym: CARDINAL; tok: CARDINAL) : BOOLEAN ;
1009 BEGIN
1010    IF IsVar (sym)
1011    THEN
1012       IF IsUnbounded (GetSType (sym))
1013       THEN
1014          RETURN TRUE
1015       ELSIF IsComponent (sym)
1016       THEN
1017          RETURN GetVarComponentInitialized (sym, tok)
1018       END ;
1019       RETURN VarCheckReadInit (sym, GetMode (sym))
1020    END ;
1021    RETURN IsConst (sym) AND IsConstString (sym)
1022 END doGetVarInitialized ;
1023
1024
1025 (*
1026    GetVarInitialized -
1027 *)
1028
1029 PROCEDURE GetVarInitialized (sym: CARDINAL; tok: CARDINAL) : BOOLEAN ;
1030 VAR
1031    init: BOOLEAN ;
1032 BEGIN
1033    init := doGetVarInitialized (sym, tok) ;
1034    IF Debugging
1035    THEN
1036       IF init
1037       THEN
1038          Trace ("GetVarInitialized (sym = %d) returning TRUE", sym)
1039       ELSE
1040          Trace ("GetVarInitialized (sym = %d) returning FALSE", sym)
1041       END
1042    END ;
1043    RETURN init
1044 END GetVarInitialized ;
1045
1046
1047 (*
1048    IsExempt - returns TRUE if sym is a global variable or a parameter or
1049               a variable with a variant record type.
1050 *)
1051
1052 PROCEDURE IsExempt (sym: CARDINAL) : BOOLEAN ;
1053 BEGIN
1054    RETURN (sym # NulSym) AND IsVar (sym) AND
1055           (IsGlobalVar (sym) OR
1056            (* (IsVarAParam (sym) AND (GetMode (sym) = LeftValue)) OR *)
1057            ContainsVariant (sym) OR
1058            IsArray (GetSType (sym)) OR IsSet (GetSType (sym)) OR
1059            IsUnbounded (GetSType (sym)) OR IsVarArrayRef (sym) OR
1060            IsItemInList (ignoreList, sym))
1061 END IsExempt ;
1062
1063
1064 (*
1065    CheckBinary -
1066 *)
1067
1068 PROCEDURE CheckBinary (op1tok, op1,
1069                        op2tok, op2,
1070                        op3tok, op3: CARDINAL; warning: BOOLEAN;
1071                        i: CARDINAL) ;
1072 BEGIN
1073    CheckDeferredRecordAccess (op2tok, op2, FALSE, warning, i) ;
1074    CheckDeferredRecordAccess (op3tok, op3, FALSE, warning, i) ;
1075    SetVarInitialized (op1, FALSE, op1tok)
1076 END CheckBinary ;
1077
1078
1079 (*
1080    CheckUnary -
1081 *)
1082
1083 PROCEDURE CheckUnary (lhstok, lhs,
1084                       rhstok, rhs: CARDINAL; warning: BOOLEAN;
1085                       i: CARDINAL) ;
1086 BEGIN
1087    CheckDeferredRecordAccess (rhstok, rhs, FALSE, warning, i) ;
1088    SetVarInitialized (lhs, FALSE, lhstok)
1089 END CheckUnary ;
1090
1091
1092 (*
1093    CheckXIndr -
1094 *)
1095
1096 PROCEDURE CheckXIndr (lhstok, lhs, type,
1097                       rhstok, rhs: CARDINAL; warning: BOOLEAN;
1098                       i: CARDINAL) ;
1099 VAR
1100    lst    : List ;
1101    content: CARDINAL ;
1102 BEGIN
1103    CheckDeferredRecordAccess (rhstok, rhs, FALSE, warning, i) ;
1104    CheckDeferredRecordAccess (lhstok, lhs, FALSE, warning, i) ;
1105    (* Now see if we know what lhs is pointing to and set fields if necessary.  *)
1106    content := getContent (getLAlias (lhs), lhs, lhstok) ;
1107    IF (content # NulSym) AND (content # lhs) AND (GetSType (content) = type)
1108    THEN
1109       IF IsReallyPointer (rhs)
1110       THEN
1111          SetupLAlias (content, rhs)
1112       END ;
1113       IF IsRecord (type)
1114       THEN
1115          (* Set all fields of content as initialized.  *)
1116          SetVarInitialized (content, FALSE, lhstok)
1117       ELSE
1118          (* Set only the field assigned in vsym as initialized.  *)
1119          lst := ComponentCreateFieldList (rhs) ;
1120          IF PutVarFieldInitialized (content, RightValue, lst)
1121          THEN
1122          END ;
1123          KillList (lst)
1124       END
1125    END
1126 END CheckXIndr ;
1127
1128
1129 (*
1130    CheckIndrX -
1131 *)
1132
1133 PROCEDURE CheckIndrX (lhstok, lhs, rhstok, rhs: CARDINAL;
1134                       warning: BOOLEAN;
1135                       i: CARDINAL) ;
1136 VAR
1137    content: CARDINAL ;
1138 BEGIN
1139    CheckDeferredRecordAccess (rhstok, rhs, FALSE, warning, i) ;
1140    content := getContent (getLAlias (rhs), rhs, rhstok) ;
1141    IF content = NulSym
1142    THEN
1143       IncludeItemIntoList (ignoreList, lhs)
1144    ELSE
1145       CheckDeferredRecordAccess (rhstok, content, TRUE, warning, i) ;
1146       SetVarInitialized (lhs, VarCheckReadInit (content, RightValue), lhstok) ;
1147       IF IsReallyPointer (content)
1148       THEN
1149          SetupLAlias (lhs, content)
1150       END
1151    END
1152 END CheckIndrX ;
1153
1154
1155 (*
1156    CheckRecordField -
1157 *)
1158
1159 PROCEDURE CheckRecordField (op1: CARDINAL) ;
1160 BEGIN
1161    PutVarInitialized (op1, LeftValue)
1162 END CheckRecordField ;
1163
1164
1165 (*
1166    CheckBecomes -
1167 *)
1168
1169 PROCEDURE CheckBecomes (destok, des, exprtok, expr: CARDINAL;
1170                         warning: BOOLEAN; i: CARDINAL) ;
1171 VAR
1172    lvalue: BOOLEAN ;
1173    lst   : List ;
1174    vsym  : CARDINAL ;
1175 BEGIN
1176    CheckDeferredRecordAccess (exprtok, expr, FALSE, warning, i) ;
1177    SetupLAlias (des, expr) ;
1178    SetVarInitialized (des, FALSE, destok) ;
1179    (* Now see if we know what lhs is pointing to and set fields if necessary.  *)
1180    IF IsComponent (des)
1181    THEN
1182       vsym := ComponentFindVar (des, lvalue, destok) ;
1183       vsym := deRefComponent (vsym, lvalue, des, destok) ;
1184       IF vsym # NulSym
1185       THEN
1186          (* Set only the field assigned in vsym as initialized.  *)
1187          lst := ComponentCreateFieldList (des) ;
1188          IF PutVarFieldInitialized (vsym, RightValue, lst)
1189          THEN
1190          END ;
1191          KillList (lst)
1192       END
1193    END
1194 END CheckBecomes ;
1195
1196
1197 (*
1198    CheckComparison -
1199 *)
1200
1201 PROCEDURE CheckComparison (op1tok, op1, op2tok, op2: CARDINAL;
1202                            warning: BOOLEAN; i: CARDINAL) ;
1203 BEGIN
1204    CheckDeferredRecordAccess (op1tok, op1, FALSE, warning, i) ;
1205    CheckDeferredRecordAccess (op2tok, op2, FALSE, warning, i)
1206 END CheckComparison ;
1207
1208
1209 (*
1210    CheckAddr -
1211 *)
1212
1213 PROCEDURE CheckAddr (ptrtok, ptr, contenttok, content: CARDINAL) ;
1214 BEGIN
1215    SetVarInitialized (ptr, GetVarInitialized (content, contenttok), ptrtok) ;
1216    SetupIndr (ptr, content)
1217 END CheckAddr ;
1218
1219
1220 (*
1221    DefaultTokPos -
1222 *)
1223
1224 PROCEDURE DefaultTokPos (preferredPos, defaultPos: CARDINAL) : CARDINAL ;
1225 BEGIN
1226    IF preferredPos = UnknownTokenNo
1227    THEN
1228       RETURN defaultPos
1229    END ;
1230    RETURN preferredPos
1231 END DefaultTokPos ;
1232
1233
1234 (*
1235    stop -
1236 *)
1237
1238 PROCEDURE stop ;
1239 END stop ;
1240
1241
1242 (*
1243    CheckReadBeforeInitQuad -
1244 *)
1245
1246 PROCEDURE CheckReadBeforeInitQuad (procSym: CARDINAL; quad: CARDINAL;
1247                                    warning: BOOLEAN; i: CARDINAL) : BOOLEAN ;
1248 VAR
1249    op                          : QuadOperator ;
1250    op1, op2, op3               : CARDINAL ;
1251    op1tok, op2tok, op3tok, qtok: CARDINAL ;
1252    overflowChecking            : BOOLEAN ;
1253 BEGIN
1254    IF quad = 3140
1255    THEN
1256       stop
1257    END ;
1258    IF Debugging
1259    THEN
1260       printf1 ("CheckReadBeforeInitQuad (quad %d)\n", quad) ;
1261       DumpAliases ;
1262       ForeachLocalSymDo (procSym, PrintSym) ;
1263       printf0 ("***********************************\n")
1264    END ;
1265    GetQuadOtok (quad, qtok, op, op1, op2, op3, overflowChecking,
1266                 op1tok, op2tok, op3tok) ;
1267    op1tok := DefaultTokPos (op1tok, qtok) ;
1268    op2tok := DefaultTokPos (op2tok, qtok) ;
1269    op3tok := DefaultTokPos (op3tok, qtok) ;
1270    CASE op OF
1271
1272    (* Jumps, calls and branches.  *)
1273    IfInOp,
1274    IfNotInOp,
1275    IfEquOp,
1276    IfNotEquOp,
1277    IfLessOp,
1278    IfLessEquOp,
1279    IfGreOp,
1280    IfGreEquOp        : CheckComparison (op1tok, op1, op2tok, op2, warning, i) |
1281    TryOp,
1282    ReturnOp,
1283    CallOp,
1284    KillLocalVarOp,
1285    RetryOp,
1286    GotoOp            : RETURN TRUE |   (* End of basic block.  *)
1287
1288    (* Variable references.  *)
1289
1290    InclOp,
1291    ExclOp            : CheckDeferredRecordAccess (op1tok, op1, FALSE, warning, i) ;
1292                        CheckDeferredRecordAccess (op1tok, op1, TRUE, warning, i) ;
1293                        CheckDeferredRecordAccess (op3tok, op3, FALSE, warning, i) |
1294    NegateOp          : CheckUnary (op1tok, op1, op3tok, op3, warning, i) |
1295    BecomesOp         : CheckBecomes (op1tok, op1, op3tok, op3, warning, i) |
1296    UnboundedOp,
1297    FunctValueOp,
1298    StandardFunctionOp,
1299    HighOp,
1300    SizeOp            : SetVarInitialized (op1, FALSE, op1tok) |
1301    AddrOp            : CheckAddr (op1tok, op1, op3tok, op3) |
1302    ReturnValueOp     : SetVarInitialized (op1, FALSE, op1tok) |
1303    NewLocalVarOp     : |
1304    ParamOp           : CheckDeferredRecordAccess (op2tok, op2, FALSE, warning, i) ;
1305                        CheckDeferredRecordAccess (op3tok, op3, FALSE, warning, i) ;
1306                        IF (op1 > 0) AND (op1 <= NoOfParam (op2)) AND
1307                           IsVarParam (op2, op1)
1308                        THEN
1309                           SetVarInitialized (op3, TRUE, op3tok)
1310                        END |
1311    ArrayOp           : CheckDeferredRecordAccess (op3tok, op3, FALSE, warning, i) ;
1312                        SetVarInitialized (op1, TRUE, op1tok) |
1313    RecordFieldOp     : CheckRecordField (op1) |
1314    LogicalShiftOp,
1315    LogicalRotateOp,
1316    LogicalOrOp,
1317    LogicalAndOp,
1318    LogicalXorOp,
1319    LogicalDiffOp,
1320    CoerceOp,
1321    ConvertOp,
1322    CastOp,
1323    AddOp,
1324    ArithAddOp,
1325    SubOp,
1326    MultOp,
1327    DivM2Op,
1328    ModM2Op,
1329    ModFloorOp,
1330    DivCeilOp,
1331    ModCeilOp,
1332    DivFloorOp,
1333    ModTruncOp,
1334    DivTruncOp        : CheckBinary (op1tok, op1, op2tok, op2, op3tok, op3, warning, i) |
1335    XIndrOp           : CheckXIndr (op1tok, op1, op2, op3tok, op3, warning, i) |
1336    IndrXOp           : CheckIndrX (op1tok, op1, op3tok, op3, warning, i) |
1337    SaveExceptionOp   : SetVarInitialized (op1, FALSE, op1tok) |
1338    RestoreExceptionOp: CheckDeferredRecordAccess (op1tok, op1, FALSE, warning, i) |
1339
1340    SubrangeLowOp,
1341    SubrangeHighOp    : InternalError ('quadruples should have been resolved') |
1342    ElementSizeOp,
1343    BuiltinConstOp,  (* Nothing to do, it is assigning a constant to op1 (also a const).  *)
1344    BuiltinTypeInfoOp,  (* Likewise assigning op1 (const) with a type.  *)
1345    ProcedureScopeOp,
1346    InitEndOp,
1347    InitStartOp,
1348    FinallyStartOp,
1349    FinallyEndOp,
1350    CatchBeginOp,
1351    CatchEndOp,
1352    ThrowOp,
1353    StartDefFileOp,
1354    StartModFileOp,
1355    EndFileOp,
1356    CodeOnOp,
1357    CodeOffOp,
1358    ProfileOnOp,
1359    ProfileOffOp,
1360    OptimizeOnOp,
1361    OptimizeOffOp,
1362    InlineOp,
1363    LineNumberOp,
1364    StatementNoteOp,
1365    SavePriorityOp,
1366    RestorePriorityOp,
1367    RangeCheckOp,
1368    ModuleScopeOp,
1369    ErrorOp,
1370    DummyOp,
1371    OptParamOp,
1372    InitAddressOp   : |
1373
1374    END ;
1375    RETURN FALSE
1376 END CheckReadBeforeInitQuad ;
1377
1378
1379 (*
1380    FilterCheckReadBeforeInitQuad -
1381 *)
1382
1383 PROCEDURE FilterCheckReadBeforeInitQuad (procSym: CARDINAL; start: CARDINAL;
1384                                          warning: BOOLEAN;
1385                                          i: CARDINAL) : BOOLEAN ;
1386 VAR
1387    Op           : QuadOperator ;
1388    Op1, Op2, Op3: CARDINAL ;
1389 BEGIN
1390    GetQuad (start, Op, Op1, Op2, Op3) ;
1391    IF (Op # RangeCheckOp) AND (Op # StatementNoteOp)
1392    THEN
1393       RETURN CheckReadBeforeInitQuad (procSym, start, warning, i)
1394    END ;
1395    RETURN FALSE
1396 END FilterCheckReadBeforeInitQuad ;
1397
1398
1399 (*
1400    CheckReadBeforeInitFirstBasicBlock -
1401 *)
1402
1403 PROCEDURE CheckReadBeforeInitFirstBasicBlock (procSym: CARDINAL;
1404                                               start, end: CARDINAL;
1405                                               warning: BOOLEAN;
1406                                               i: CARDINAL) ;
1407 BEGIN
1408    LOOP
1409       IF FilterCheckReadBeforeInitQuad (procSym, start, warning, i)
1410       THEN
1411       END ;
1412       IF start = end
1413       THEN
1414          RETURN
1415       ELSE
1416          start := GetNextQuad (start)
1417       END
1418    END
1419 END CheckReadBeforeInitFirstBasicBlock ;
1420
1421
1422 (*
1423    bbArrayKill -
1424 *)
1425
1426 PROCEDURE bbArrayKill ;
1427 VAR
1428    i, h : CARDINAL ;
1429    bbPtr: bbEntry ;
1430 BEGIN
1431    h := Indexing.HighIndice (bbArray) ;
1432    i := 1 ;
1433    WHILE i <= h DO
1434       bbPtr := Indexing.GetIndice (bbArray, i) ;
1435       bbPtr^.next := bbFreeList ;
1436       bbFreeList := bbPtr ;
1437       INC (i)
1438    END ;
1439    bbArray := Indexing.KillIndex (bbArray)
1440 END bbArrayKill ;
1441
1442
1443 (*
1444    DumpBBEntry -
1445 *)
1446
1447 PROCEDURE DumpBBEntry (bbPtr: bbEntry; procSym: CARDINAL) ;
1448 BEGIN
1449    printf4 ("bb %d: scope %d:  quads: %d .. %d",
1450             bbPtr^.indexBB, procSym, bbPtr^.start, bbPtr^.end) ;
1451    IF bbPtr^.first
1452    THEN
1453       printf0 (" first")
1454    END ;
1455    IF bbPtr^.endCall
1456    THEN
1457       printf0 (" endcall")
1458    END ;
1459    IF bbPtr^.endGoto
1460    THEN
1461       printf0 (" endgoto")
1462    END ;
1463    IF bbPtr^.endCond
1464    THEN
1465       printf0 (" endcond")
1466    END ;
1467    IF bbPtr^.topOfLoop
1468    THEN
1469       printf0 (" topofloop")
1470    END ;
1471    IF bbPtr^.condBB # 0
1472    THEN
1473       printf1 (" cond %d", bbPtr^.condBB)
1474    END ;
1475    IF bbPtr^.nextBB # 0
1476    THEN
1477       printf1 (" next %d", bbPtr^.nextBB)
1478    END ;
1479    printf0 ("\n")
1480 END DumpBBEntry ;
1481
1482
1483 (*
1484    DumpBBArray -
1485 *)
1486
1487 PROCEDURE DumpBBArray (procSym: CARDINAL) ;
1488 VAR
1489    bbPtr: bbEntry ;
1490    i, n : CARDINAL ;
1491 BEGIN
1492    i := 1 ;
1493    n := Indexing.HighIndice (bbArray) ;
1494    WHILE i <= n DO
1495       bbPtr := Indexing.GetIndice (bbArray, i) ;
1496       DumpBBEntry (bbPtr, procSym) ;
1497       INC (i)
1498    END ;
1499    i := 1 ;
1500    WHILE i <= n DO
1501       bbPtr := Indexing.GetIndice (bbArray, i) ;
1502       printf4 ("bb %d: scope %d:  quads: %d .. %d\n",
1503                bbPtr^.indexBB, procSym, bbPtr^.start, bbPtr^.end) ;
1504       DisplayQuadRange (procSym, bbPtr^.start, bbPtr^.end) ;
1505       INC (i)
1506    END
1507 END DumpBBArray ;
1508
1509
1510 (*
1511    DumpBBSequence -
1512 *)
1513
1514 PROCEDURE DumpBBSequence (lst: List) ;
1515 VAR
1516    arrayindex,
1517    listindex, n: CARDINAL ;
1518 BEGIN
1519    n := NoOfItemsInList (lst) ;
1520    listindex := 1 ;
1521    printf0 ("=============\n");
1522    printf0 (" checking sequence:");
1523    WHILE listindex <= n DO
1524       arrayindex := GetItemFromList (lst, listindex) ;
1525       printf2 (" lst[%d] -> %d", listindex, arrayindex) ;
1526       INC (listindex)
1527    END ;
1528    printf0 ("\n")
1529 END DumpBBSequence ;
1530
1531
1532 (*
1533    trashParam -
1534 *)
1535
1536 PROCEDURE trashParam (trashQuad: CARDINAL) ;
1537 VAR
1538    op                            : QuadOperator ;
1539    op1, proc, param, paramValue  : CARDINAL ;
1540    op1tok, op2tok, paramtok, qtok: CARDINAL ;
1541    overflowChecking              : BOOLEAN ;
1542    heapValue, ptrToHeap          : CARDINAL ;
1543 BEGIN
1544    IF trashQuad # 0
1545    THEN
1546       GetQuadOtok (trashQuad, qtok, op, op1, proc, param, overflowChecking,
1547                    op1tok, op2tok, paramtok) ;
1548       heapValue := GetQuadTrash (trashQuad) ;
1549       IF Debugging
1550       THEN
1551          printf1 ("heapValue = %d\n", heapValue)
1552       END ;
1553       IF heapValue # NulSym
1554       THEN
1555          SetVarInitialized (param, FALSE, paramtok) ;
1556          paramValue := getLAlias (param) ;
1557          ptrToHeap := getContent (paramValue, param, paramtok) ;
1558          IF ptrToHeap # NulSym
1559          THEN
1560             IF IsDeallocate (proc)
1561             THEN
1562                SetupLAlias (ptrToHeap, Nil) ;
1563                SetVarInitialized (ptrToHeap, FALSE, paramtok)
1564             ELSE
1565                SetupIndr (ptrToHeap, heapValue) ;
1566                SetVarInitialized (ptrToHeap, TRUE, paramtok)
1567             END
1568          END
1569       END
1570    END ;
1571    DumpAliases
1572 END trashParam ;
1573
1574
1575 (*
1576    SetVarLRInitialized - this sets up an alias between the parameter
1577                          value and the pointer for the case:
1578
1579                          procedure foo (var shadow: PtrToType) ;
1580
1581                          which allows shadow to be statically analyzed
1582                          once it is re-assigned.
1583 *)
1584
1585 PROCEDURE SetVarLRInitialized (param: CARDINAL) ;
1586 VAR
1587    heap,
1588    shadow: CARDINAL ;
1589 BEGIN
1590    Assert (IsParameter (param)) ;
1591    shadow := GetParameterShadowVar (param) ;
1592    IF shadow # NulSym
1593    THEN
1594       IncludeItemIntoList (ignoreList, shadow)
1595    END ;
1596    heap := GetParameterHeapVar (param) ;
1597    IF (shadow # NulSym) AND (heap # NulSym)
1598    THEN
1599       PutVarInitialized (shadow, GetMode (shadow)) ;
1600       PutVarInitialized (heap, GetMode (heap)) ;
1601       SetupIndr (shadow, heap) ;
1602       IncludeItemIntoList (ignoreList, heap)
1603    END
1604 END SetVarLRInitialized ;
1605
1606
1607 (*
1608    TestBBSequence -
1609 *)
1610
1611 PROCEDURE TestBBSequence (procSym: CARDINAL; lst: List) ;
1612 VAR
1613    bbPtr  : bbEntry ;
1614    bbi,
1615    i, n   : CARDINAL ;
1616    warning: BOOLEAN ;  (* Should we issue a warning rather than a note?  *)
1617 BEGIN
1618    IF Debugging
1619    THEN
1620       DumpBBSequence (lst)
1621    END ;
1622    initBlock ;
1623    ForeachLocalSymDo (procSym, SetVarUninitialized) ;
1624    ForeachParamSymDo (procSym, SetVarLRInitialized) ;
1625    n := NoOfItemsInList (lst) ;
1626    i := 1 ;
1627    warning := TRUE ;
1628    WHILE i <= n DO
1629       bbi := GetItemFromList (lst, i) ;
1630       bbPtr := Indexing.GetIndice (bbArray, bbi) ;
1631       CheckReadBeforeInitFirstBasicBlock (procSym,
1632                                           bbPtr^.start, bbPtr^.end,
1633                                           warning, i) ;
1634       IF bbPtr^.endCond
1635       THEN
1636          (* Check to see if we are moving into an conditional block in which case
1637             we will issue a note.  *)
1638          warning := FALSE
1639       ELSIF bbPtr^.endCall AND (bbPtr^.trashQuad # 0)
1640       THEN
1641          trashParam (bbPtr^.trashQuad)
1642       END ;
1643       INC (i)
1644    END ;
1645    killBlock
1646 END TestBBSequence ;
1647
1648
1649 (*
1650    CreateBBPermultations -
1651 *)
1652
1653 PROCEDURE CreateBBPermultations (procSym: CARDINAL; i: CARDINAL; lst: List) ;
1654 VAR
1655    duplst: List ;
1656    iPtr  : bbEntry ;
1657 BEGIN
1658    IF i = 0
1659    THEN
1660       TestBBSequence (procSym, lst)
1661    ELSE
1662       iPtr := Indexing.GetIndice (bbArray, i) ;
1663       IF iPtr^.topOfLoop
1664       THEN
1665          TestBBSequence (procSym, lst)
1666       ELSE
1667          duplst := DuplicateList (lst) ;
1668          IncludeItemIntoList (duplst, i) ;
1669          IF iPtr^.endCall AND (iPtr^.trashQuad = 0)
1670          THEN
1671             TestBBSequence (procSym, duplst)
1672          ELSIF iPtr^.endGoto
1673          THEN
1674             CreateBBPermultations (procSym, iPtr^.nextBB, duplst)
1675          ELSIF UninitVariableConditionalChecking AND iPtr^.endCond
1676          THEN
1677             CreateBBPermultations (procSym, iPtr^.nextBB, duplst) ;
1678             CreateBBPermultations (procSym, iPtr^.condBB, duplst)
1679          ELSIF iPtr^.endCond
1680          THEN
1681             TestBBSequence (procSym, duplst)
1682          ELSE
1683             (* Fall through.  *)
1684             CreateBBPermultations (procSym, iPtr^.nextBB, duplst)
1685          END ;
1686          KillList (duplst)
1687       END
1688    END
1689 END CreateBBPermultations ;
1690
1691
1692 (*
1693    ScopeBlockVariableAnalysis - checks to see whether a variable is
1694                                 read before it has been initialized.
1695 *)
1696
1697 PROCEDURE ScopeBlockVariableAnalysis (Scope: CARDINAL;
1698                                       Start, End: CARDINAL) ;
1699 VAR
1700    bb : BasicBlock ;
1701    lst: List ;
1702 BEGIN
1703    IF UninitVariableChecking
1704    THEN
1705       bbArray := Indexing.InitIndex (1) ;
1706       bb := InitBasicBlocksFromRange (Scope, Start, End) ;
1707       ForeachBasicBlockDo (bb, AppendEntry) ;
1708       KillBasicBlocks (bb) ;
1709       GenerateCFG ;
1710       IF Scope # NulSym
1711       THEN
1712          InitList (lst) ;
1713          IF Debugging
1714          THEN
1715             DumpBBArray (Scope) ;
1716             IF UninitVariableConditionalChecking
1717             THEN
1718                printf0 ("UninitVariableConditionalChecking is TRUE\n")
1719             END
1720          END ;
1721          CreateBBPermultations (Scope, 1, lst) ;
1722          KillList (lst)
1723       END ;
1724       bbArrayKill
1725    END
1726 END ScopeBlockVariableAnalysis ;
1727
1728
1729 (*
1730    GetOp3 -
1731 *)
1732
1733 PROCEDURE GetOp3 (quad: CARDINAL) : CARDINAL ;
1734 VAR
1735    op: QuadOperator ;
1736    op1, op2, op3: CARDINAL ;
1737 BEGIN
1738    GetQuad (quad, op, op1, op2, op3) ;
1739    RETURN op3
1740 END GetOp3 ;
1741
1742
1743 (*
1744    getBBindex - return the basic block index which starts with quad.
1745 *)
1746
1747 PROCEDURE getBBindex (quad: CARDINAL) : CARDINAL ;
1748 VAR
1749    iPtr   : bbEntry ;
1750    i, high: CARDINAL ;
1751 BEGIN
1752    i := 1 ;
1753    high := Indexing.HighIndice (bbArray) ;
1754    WHILE i <= high DO
1755       iPtr := Indexing.GetIndice (bbArray, i) ;
1756       IF iPtr^.start = quad
1757       THEN
1758          RETURN iPtr^.indexBB
1759       END ;
1760       INC (i)
1761    END ;
1762    RETURN 0
1763 END getBBindex ;
1764
1765
1766 (*
1767    GenerateCFG -
1768 *)
1769
1770 PROCEDURE GenerateCFG ;
1771 VAR
1772    iPtr   : bbEntry ;
1773    next,
1774    i, high: CARDINAL ;
1775 BEGIN
1776    i := 1 ;
1777    high := Indexing.HighIndice (bbArray) ;
1778    WHILE i <= high DO
1779       iPtr := Indexing.GetIndice (bbArray, i) ;
1780       IF IsKillLocalVar (iPtr^.end) OR IsReturn (iPtr^.end)
1781       THEN
1782          (* Nothing to do as we have reached the end of this scope.  *)
1783       ELSE
1784          next := GetNextQuad (iPtr^.end) ;
1785          iPtr^.nextQuad := next ;
1786          iPtr^.nextBB := getBBindex (next) ;
1787          IF iPtr^.endCond
1788          THEN
1789             iPtr^.condQuad := GetOp3 (iPtr^.end) ;
1790             iPtr^.condBB := getBBindex (iPtr^.condQuad)
1791          END
1792       END ;
1793       INC (i)
1794    END
1795 END GenerateCFG ;
1796
1797
1798 (*
1799    NewEntry -
1800 *)
1801
1802 PROCEDURE NewEntry () : bbEntry ;
1803 VAR
1804    bbPtr: bbEntry ;
1805 BEGIN
1806    IF bbFreeList = NIL
1807    THEN
1808       NEW (bbPtr)
1809    ELSE
1810       bbPtr := bbFreeList ;
1811       bbFreeList := bbFreeList^.next
1812    END ;
1813    RETURN bbPtr
1814 END NewEntry ;
1815
1816
1817 (*
1818    IsAllocate - return TRUE is sym is ALLOCATE.
1819 *)
1820
1821 PROCEDURE IsAllocate (sym: CARDINAL) : BOOLEAN ;
1822 BEGIN
1823    RETURN IsProcedure (sym) AND (GetSymName (sym) = MakeKey('ALLOCATE'))
1824 END IsAllocate ;
1825
1826
1827 (*
1828    IsDeallocate - return TRUE is sym is DEALLOCATE.
1829 *)
1830
1831 PROCEDURE IsDeallocate (sym: CARDINAL) : BOOLEAN ;
1832 BEGIN
1833    RETURN IsProcedure (sym) AND (GetSymName (sym) = MakeKey('DEALLOCATE'))
1834 END IsDeallocate ;
1835
1836
1837 (*
1838    DetectTrash -
1839 *)
1840
1841 PROCEDURE DetectTrash (bbPtr: bbEntry) ;
1842 VAR
1843    i            : CARDINAL ;
1844    op           : QuadOperator ;
1845    op1, op2, op3: CARDINAL ;
1846 BEGIN
1847    IF bbPtr^.endCall
1848    THEN
1849       i := bbPtr^.start ;
1850       LOOP
1851          GetQuad (i, op, op1, op2, op3) ;
1852          IF (op = ParamOp) AND (op1 = 1) AND (IsAllocate (op2) OR IsDeallocate (op2))
1853          THEN
1854             bbPtr^.trashQuad := i
1855          END ;
1856          IF i = bbPtr^.end
1857          THEN
1858             RETURN
1859          END ;
1860          i := GetNextQuad (i)
1861       END
1862    END
1863 END DetectTrash ;
1864
1865
1866 (*
1867    AppendEntry -
1868 *)
1869
1870 PROCEDURE AppendEntry (Start, End: CARDINAL) ;
1871 VAR
1872    bbPtr: bbEntry ;
1873    high : CARDINAL ;
1874 BEGIN
1875    high := Indexing.HighIndice (bbArray) ;
1876    bbPtr := NewEntry () ;
1877    WITH bbPtr^ DO
1878       start := Start ;
1879       end := End ;
1880       first := high = 0 ;
1881       endCall := IsCall (End) ;
1882       endGoto := IsGoto (End) ;
1883       endCond := IsConditional (End) ;
1884       topOfLoop := IsBackReference (Start) ;
1885       trashQuad := 0 ;
1886       indexBB := high + 1 ;
1887       nextQuad := 0 ;
1888       condQuad := 0 ;
1889       nextBB := 0 ;
1890       condBB := 0 ;
1891       next := NIL
1892    END ;
1893    DetectTrash (bbPtr) ;
1894    Indexing.PutIndice (bbArray, high + 1, bbPtr)
1895 END AppendEntry ;
1896
1897
1898 (*
1899    DumpAlias -
1900 *)
1901
1902 PROCEDURE DumpAlias (array: Index; aliasIndex: CARDINAL) ;
1903 VAR
1904    sa: symAlias ;
1905 BEGIN
1906    sa := Indexing.GetIndice (array, aliasIndex) ;
1907    printf2 ("keySym = %d: alias = %d\n", sa^.keySym, sa^.alias)
1908 END DumpAlias ;
1909
1910
1911 (*
1912    doDumpAliases -
1913 *)
1914
1915 PROCEDURE doDumpAliases (array: Index) ;
1916 VAR
1917    i, n: CARDINAL ;
1918 BEGIN
1919    i := 1 ;
1920    n := Indexing.HighIndice (array) ;
1921    WHILE i <= n DO
1922       DumpAlias (array, i) ;
1923       INC (i)
1924    END
1925 END doDumpAliases ;
1926
1927
1928 (*
1929    DumpAliases -
1930 *)
1931
1932 PROCEDURE DumpAliases ;
1933 BEGIN
1934    IF Debugging
1935    THEN
1936       printf0 ("LArray\n") ;
1937       doDumpAliases (LArray) ;
1938       printf0 ("IndirectArray\n") ;
1939       doDumpAliases (IndirectArray)
1940    END
1941 END DumpAliases ;
1942
1943
1944 (*
1945    newAlias -
1946 *)
1947
1948 PROCEDURE newAlias () : symAlias ;
1949 VAR
1950    sa: symAlias ;
1951 BEGIN
1952    IF freeList = NIL
1953    THEN
1954       NEW (sa)
1955    ELSE
1956       sa := freeList ;
1957       freeList := freeList^.next
1958    END ;
1959    RETURN sa
1960 END newAlias ;
1961
1962
1963 (*
1964    initAlias -
1965 *)
1966
1967 PROCEDURE initAlias (sym: CARDINAL) : symAlias ;
1968 VAR
1969    sa: symAlias ;
1970 BEGIN
1971    sa := newAlias () ;
1972    WITH sa^ DO
1973       keySym := sym ;
1974       alias := NulSym ;
1975       next := NIL
1976    END ;
1977    RETURN sa
1978 END initAlias ;
1979
1980
1981 (*
1982    killAlias -
1983 *)
1984
1985 PROCEDURE killAlias (sa: symAlias) ;
1986 BEGIN
1987    sa^.next := freeList ;
1988    freeList := sa
1989 END killAlias ;
1990
1991
1992 (*
1993    initBlock -
1994 *)
1995
1996 PROCEDURE initBlock ;
1997 BEGIN
1998    LArray := Indexing.InitIndex (1) ;
1999    IndirectArray := Indexing.InitIndex (1) ;
2000    InitList (ignoreList)
2001 END initBlock ;
2002
2003
2004 (*
2005    killBlock -
2006 *)
2007
2008 PROCEDURE killBlock ;
2009 BEGIN
2010    doKillBlock (LArray) ;
2011    doKillBlock (IndirectArray) ;
2012    KillList (ignoreList)
2013 END killBlock ;
2014
2015
2016 PROCEDURE doKillBlock (VAR array: Index) ;
2017 VAR
2018    i, n: CARDINAL ;
2019 BEGIN
2020    i := 1 ;
2021    n := Indexing.HighIndice (array) ;
2022    WHILE i <= n DO
2023       killAlias (Indexing.GetIndice (array, i)) ;
2024       INC (i)
2025    END ;
2026    array := Indexing.KillIndex (array)
2027 END doKillBlock ;
2028
2029
2030 (*
2031    addAlias -
2032 *)
2033
2034 PROCEDURE addAlias (array: Index; sym: CARDINAL; aliased: CARDINAL) ;
2035 VAR
2036    i, n: CARDINAL ;
2037    sa  : symAlias ;
2038 BEGIN
2039    i := 1 ;
2040    n := Indexing.HighIndice (array) ;
2041    WHILE i <= n DO
2042       sa := Indexing.GetIndice (array, i) ;
2043       IF sa^.keySym = sym
2044       THEN
2045          sa^.alias := aliased ;
2046          RETURN
2047       END ;
2048       INC (i)
2049    END ;
2050    sa := initAlias (sym) ;
2051    Indexing.IncludeIndiceIntoIndex (array, sa) ;
2052    sa^.alias := aliased
2053 END addAlias ;
2054
2055
2056 (*
2057    lookupAlias -
2058 *)
2059
2060 PROCEDURE lookupAlias (array: Index; sym: CARDINAL) : symAlias ;
2061 VAR
2062    i, n: CARDINAL ;
2063    sa  : symAlias ;
2064 BEGIN
2065    i := 1 ;
2066    n := Indexing.HighIndice (array) ;
2067    WHILE i <= n DO
2068       sa := Indexing.GetIndice (array, i) ;
2069       IF sa^.keySym = sym
2070       THEN
2071          RETURN sa
2072       END ;
2073       INC (i)
2074    END ;
2075    RETURN NIL
2076 END lookupAlias ;
2077
2078
2079 (*
2080    doGetAlias -
2081 *)
2082
2083 PROCEDURE doGetAlias (array: Index; sym: CARDINAL) : CARDINAL ;
2084 VAR
2085    sa: symAlias ;
2086 BEGIN
2087    sa := lookupAlias (array, sym) ;
2088    IF (sa # NIL) AND (sa^.alias # NulSym)
2089    THEN
2090       RETURN sa^.alias
2091    END ;
2092    RETURN NulSym
2093 END doGetAlias ;
2094
2095
2096 (*
2097    getLAlias - attempts to looks up an alias which is not a temporary variable.
2098 *)
2099
2100 PROCEDURE getLAlias (sym: CARDINAL) : CARDINAL ;
2101 VAR
2102    type,
2103    nsym: CARDINAL ;
2104 BEGIN
2105    nsym := sym ;
2106    REPEAT
2107       sym := nsym ;
2108       type := GetSType (sym) ;
2109       IF (IsTemporary (sym) AND (GetMode (sym) = LeftValue)) OR
2110          ((type # NulSym) AND IsReallyPointer (type))
2111       THEN
2112          nsym := doGetAlias (LArray, sym)
2113       ELSE
2114          RETURN sym
2115       END
2116    UNTIL nsym = NulSym ;
2117    RETURN sym
2118 END getLAlias ;
2119
2120
2121 (*
2122    SetupLAlias -
2123 *)
2124
2125 PROCEDURE SetupLAlias (des, exp: CARDINAL) ;
2126 BEGIN
2127    IF (exp = Nil) OR
2128       (IsVar (exp) AND
2129        ((GetMode (des) = LeftValue) OR IsReallyPointer (GetSType (des))))
2130    THEN
2131       addAlias (LArray, des, exp) ;
2132       DumpAliases
2133    END
2134 END SetupLAlias ;
2135
2136
2137 (*
2138    SetupIndr -
2139 *)
2140
2141 PROCEDURE SetupIndr (ptr, content: CARDINAL) ;
2142 BEGIN
2143    addAlias (IndirectArray, ptr, content) ;
2144 END SetupIndr ;
2145
2146
2147 (*
2148    getContent - attempts to return the content pointed to by ptr.
2149                 sym is the original symbol and ptr will be the equivalent lvalue.
2150 *)
2151
2152 PROCEDURE getContent (ptr: CARDINAL; sym: CARDINAL; tok: CARDINAL) : CARDINAL ;
2153 BEGIN
2154    IF ptr = Nil
2155    THEN
2156       MetaErrorT1 (tok,
2157                    "attempting to dereference {%1Wad} which will be a {%kNIL} pointer",
2158                    sym) ;
2159       RETURN NulSym
2160    ELSE
2161       RETURN doGetAlias (IndirectArray, ptr)
2162    END
2163 END getContent ;
2164
2165
2166 (*
2167    init -
2168 *)
2169
2170 PROCEDURE init ;
2171 BEGIN
2172    freeList := NIL ;
2173    bbFreeList := NIL ;
2174    InitList (errorList)
2175 END init ;
2176
2177
2178 BEGIN
2179    init
2180 END M2SymInit.