gcc/m2/gm2-compiler/M2LexBuf.mod

   1 (* M2LexBuf.mod provides a buffer for m2.lex.
   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 M2LexBuf ;
  23
  24 IMPORT m2flex ;
  25
  26 FROM libc IMPORT strlen ;
  27 FROM SYSTEM IMPORT ADDRESS ;
  28 FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
  29 FROM DynamicStrings IMPORT string, InitString, InitStringCharStar, Equal, Mark, KillString ;
  30 FROM FormatStrings IMPORT Sprintf1 ;
  31 FROM NameKey IMPORT NulName, Name, makekey, MakeKey, KeyToCharStar ;
  32 FROM M2Reserved IMPORT toktype, tokToTok ;
  33 FROM M2Printf IMPORT printf0, printf1, printf2, printf3 ;
  34 FROM M2Debug IMPORT Assert ;
  35 FROM NameKey IMPORT makekey ;
  36 FROM m2linemap IMPORT location_t, GetLocationBinary ;
  37 FROM M2Emit IMPORT UnknownLocation, BuiltinsLocation ;
  38 FROM M2Error IMPORT WarnStringAt ;
  39
  40 CONST
  41    MaxBucketSize      = 100 ;
  42    Debugging          = FALSE ;
  43    DebugRecover       = FALSE ;
  44    InitialSourceToken = 2 ;   (* 0 is unknown, 1 is builtin.  *)
  45
  46 TYPE
  47    SourceList = POINTER TO RECORD
  48                               left,
  49                               right: SourceList ;
  50                               name : String ;
  51                               line : CARDINAL ;
  52                               col  : CARDINAL ;
  53                            END ;
  54
  55    TokenDesc = RECORD
  56                   token : toktype ;
  57                   str   : Name ;          (* ident name or string literal.  *)
  58                   int   : INTEGER ;
  59                   line  : CARDINAL ;
  60                   col   : CARDINAL ;
  61                   file  : SourceList ;
  62                   loc   : location_t ;
  63                   insert: TokenBucket ;   (* contains any inserted tokens.  *)
  64                END ;
  65
  66    TokenBucket = POINTER TO RECORD
  67                                buf : ARRAY [0..MaxBucketSize] OF TokenDesc ;
  68                                len : CARDINAL ;
  69                                next: TokenBucket ;
  70                             END ;
  71
  72    ListDesc = RECORD
  73                  head,
  74                  tail            : TokenBucket ;
  75                  LastBucketOffset: CARDINAL ;
  76               END ;
  77
  78 VAR
  79    CurrentSource    : SourceList ;
  80    UseBufferedTokens,
  81    CurrentUsed      : BOOLEAN ;
  82    ListOfTokens     : ListDesc ;
  83    CurrentTokNo     : CARDINAL ;
  84    InsertionIndex   : CARDINAL ;
  85    SeenEof          : BOOLEAN ;  (* Have we seen eof since the last call
  86                                     to OpenSource.  *)
  87
  88
  89 (*
  90    InitTokenList - creates an empty token list, which starts the first source token
  91                    at position 2.  This allows position 0 to be for unknown location
  92                    and position 1 for builtin token.
  93 *)
  94
  95 PROCEDURE InitTokenList ;
  96 BEGIN
  97    NEW (ListOfTokens.head) ;
  98    ListOfTokens.tail := ListOfTokens.head ;
  99    WITH ListOfTokens.tail^.buf[0] DO
 100       token := eoftok ;
 101       str := NulName ;
 102       int := 0 ;
 103       line := 0 ;
 104       col := 0 ;
 105       file := NIL ;
 106       loc := UnknownLocation ()
 107    END ;
 108    WITH ListOfTokens.tail^.buf[1] DO
 109       token := eoftok ;
 110       str := NulName ;
 111       int := 0 ;
 112       line := 0 ;
 113       col := 0 ;
 114       file := NIL ;
 115       loc := BuiltinsLocation ()
 116    END ;
 117    ListOfTokens.tail^.len := InitialSourceToken
 118 END InitTokenList ;
 119
 120
 121 (*
 122    Init - initializes the token list and source list.
 123 *)
 124
 125 PROCEDURE Init ;
 126 BEGIN
 127    SeenEof := FALSE ;
 128    InsertionIndex := 0 ;
 129    currenttoken := eoftok ;
 130    CurrentTokNo := InitialSourceToken ;
 131    CurrentSource := NIL ;
 132    ListOfTokens.head := NIL ;
 133    ListOfTokens.tail := NIL ;
 134    UseBufferedTokens := FALSE ;
 135    InitTokenList
 136 END Init ;
 137
 138
 139 (*
 140    AddTo - adds a new element to the end of SourceList, CurrentSource.
 141 *)
 142
 143 PROCEDURE AddTo (l: SourceList) ;
 144 BEGIN
 145    l^.right := CurrentSource ;
 146    l^.left  := CurrentSource^.left ;
 147    CurrentSource^.left^.right := l ;
 148    CurrentSource^.left := l ;
 149    WITH l^.left^ DO
 150       line := m2flex.GetLineNo() ;
 151       col  := m2flex.GetColumnNo()
 152    END
 153 END AddTo ;
 154
 155
 156 (*
 157    SubFrom - subtracts, l, from the source list.
 158 *)
 159
 160 PROCEDURE SubFrom (l: SourceList) ;
 161 BEGIN
 162    l^.left^.right := l^.right ;
 163    l^.right^.left := l^.left
 164 END SubFrom ;
 165
 166
 167 (*
 168    NewElement - returns a new SourceList
 169 *)
 170
 171 PROCEDURE NewElement (s: ADDRESS) : SourceList ;
 172 VAR
 173    l: SourceList ;
 174 BEGIN
 175    NEW (l) ;
 176    IF l = NIL
 177    THEN
 178       HALT
 179    ELSE
 180       WITH l^ DO
 181          name  := InitStringCharStar(s) ;
 182          left  := NIL ;
 183          right := NIL
 184       END
 185    END ;
 186    RETURN l
 187 END NewElement ;
 188
 189
 190 (*
 191    NewList - initializes an empty list with the classic dummy header element.
 192 *)
 193
 194 PROCEDURE NewList () : SourceList ;
 195 VAR
 196    l: SourceList ;
 197 BEGIN
 198    NEW (l) ;
 199    WITH l^ DO
 200       left  := l ;
 201       right := l ;
 202       name  := NIL
 203    END ;
 204    RETURN l
 205 END NewList ;
 206
 207
 208 (*
 209    CheckIfNeedToDuplicate - checks to see whether the CurrentSource has
 210                             been used, if it has then duplicate the list.
 211 *)
 212
 213 PROCEDURE CheckIfNeedToDuplicate ;
 214 VAR
 215    l, h: SourceList ;
 216 BEGIN
 217    IF CurrentUsed
 218    THEN
 219       l := CurrentSource^.right ;
 220       h := CurrentSource ;
 221       CurrentSource := NewList() ;
 222       WHILE l#h DO
 223          AddTo (NewElement (l^.name)) ;
 224          l := l^.right
 225       END
 226    END
 227 END CheckIfNeedToDuplicate ;
 228
 229
 230 (*
 231    PushFile - indicates that, filename, has just been included.
 232 *)
 233
 234 PROCEDURE PushFile (filename: ADDRESS) ;
 235 VAR
 236    l: SourceList ;
 237 BEGIN
 238    CheckIfNeedToDuplicate ;
 239    AddTo (NewElement (filename)) ;
 240    IF Debugging
 241    THEN
 242       IF CurrentSource^.right#CurrentSource
 243       THEN
 244          l := CurrentSource ;
 245          REPEAT
 246             printf3('name = %s, line = %d, col = %d\n', l^.name, l^.line, l^.col) ;
 247             l := l^.right
 248          UNTIL l=CurrentSource
 249       END
 250    END
 251 END PushFile ;
 252
 253
 254 (*
 255    PopFile - indicates that we are returning to, filename, having finished
 256              an include.
 257 *)
 258
 259 PROCEDURE PopFile (filename: ADDRESS) ;
 260 VAR
 261    l: SourceList ;
 262 BEGIN
 263    CheckIfNeedToDuplicate ;
 264    IF (CurrentSource#NIL) AND (CurrentSource^.left#CurrentSource)
 265    THEN
 266       l := CurrentSource^.left ;  (* last element *)
 267       SubFrom (l) ;
 268       DISPOSE (l) ;
 269       IF (CurrentSource^.left#CurrentSource) AND
 270          (NOT Equal(CurrentSource^.name, Mark(InitStringCharStar(filename))))
 271       THEN
 272          (* mismatch in source file names after preprocessing files *)
 273       END
 274    ELSE
 275       (* source file list is empty, cannot pop an include.. *)
 276    END
 277 END PopFile ;
 278
 279
 280 (*
 281    KillList - kills the SourceList providing that it has not been used.
 282 *)
 283
 284 PROCEDURE KillList ;
 285 VAR
 286    l, k: SourceList ;
 287 BEGIN
 288    IF (NOT CurrentUsed) AND (CurrentSource#NIL)
 289    THEN
 290       l := CurrentSource ;
 291       REPEAT
 292          k := l ;
 293          l := l^.right ;
 294          DISPOSE(k)
 295       UNTIL l=CurrentSource
 296    END
 297 END KillList ;
 298
 299
 300 (*
 301    ReInitialize - re-initialize the all the data structures.
 302 *)
 303
 304 PROCEDURE ReInitialize ;
 305 VAR
 306    s, t: TokenBucket ;
 307 BEGIN
 308    IF ListOfTokens.head#NIL
 309    THEN
 310       t := ListOfTokens.head ;
 311       REPEAT
 312          s := t ;
 313          t := t^.next ;
 314          DISPOSE(s) ;
 315       UNTIL t=NIL ;
 316       CurrentUsed := FALSE ;
 317       KillList
 318    END ;
 319    Init
 320 END ReInitialize ;
 321
 322
 323 (*
 324    SetFile - sets the current filename to, filename.
 325 *)
 326
 327 PROCEDURE SetFile (filename: ADDRESS) ;
 328 BEGIN
 329    KillList ;
 330    CurrentUsed   := FALSE ;
 331    CurrentSource := NewList () ;
 332    AddTo (NewElement (filename))
 333 END SetFile ;
 334
 335
 336 (*
 337    OpenSource - Attempts to open the source file, s.
 338                 The success of the operation is returned.
 339 *)
 340
 341 PROCEDURE OpenSource (s: String) : BOOLEAN ;
 342 BEGIN
 343    SeenEof := FALSE ;
 344    IF UseBufferedTokens
 345    THEN
 346       GetToken ;
 347       RETURN TRUE
 348    ELSE
 349       IF m2flex.OpenSource (string (s))
 350       THEN
 351          SetFile (string (s)) ;
 352          SyncOpenWithBuffer ;
 353          GetToken ;
 354          RETURN TRUE
 355       ELSE
 356          RETURN FALSE
 357       END
 358    END
 359 END OpenSource ;
 360
 361
 362 (*
 363    CloseSource - closes the current open file.
 364 *)
 365
 366 PROCEDURE CloseSource ;
 367 BEGIN
 368    IF UseBufferedTokens
 369    THEN
 370       WHILE currenttoken#eoftok DO
 371          GetToken
 372       END
 373    ELSE
 374       (* a subsequent call to m2flex.OpenSource will really close the file *)
 375    END
 376 END CloseSource ;
 377
 378
 379 (*
 380    ResetForNewPass - reset the buffer pointers to the beginning ready for
 381                      a new pass
 382 *)
 383
 384 PROCEDURE ResetForNewPass ;
 385 BEGIN
 386    InsertionIndex := 0 ;
 387    CurrentTokNo := InitialSourceToken ;
 388    UseBufferedTokens := TRUE
 389 END ResetForNewPass ;
 390
 391
 392 (*
 393    DisplayToken - display the token name using printf0 no newline is emitted.
 394 *)
 395
 396 PROCEDURE DisplayToken (tok: toktype) ;
 397 BEGIN
 398    CASE tok OF
 399
 400    eoftok: printf0('eoftok') |
 401    plustok: printf0('plustok') |
 402    minustok: printf0('minustok') |
 403    timestok: printf0('timestok') |
 404    dividetok: printf0('dividetok') |
 405    becomestok: printf0('becomestok') |
 406    ambersandtok: printf0('ambersandtok') |
 407    periodtok: printf0('periodtok') |
 408    commatok: printf0('commatok') |
 409    semicolontok: printf0('semicolontok') |
 410    lparatok: printf0('lparatok') |
 411    rparatok: printf0('rparatok') |
 412    lsbratok: printf0('lsbratok') |
 413    rsbratok: printf0('rsbratok') |
 414    lcbratok: printf0('lcbratok') |
 415    rcbratok: printf0('rcbratok') |
 416    uparrowtok: printf0('uparrowtok') |
 417    singlequotetok: printf0('singlequotetok') |
 418    equaltok: printf0('equaltok') |
 419    hashtok: printf0('hashtok') |
 420    lesstok: printf0('lesstok') |
 421    greatertok: printf0('greatertok') |
 422    lessgreatertok: printf0('lessgreatertok') |
 423    lessequaltok: printf0('lessequaltok') |
 424    greaterequaltok: printf0('greaterequaltok') |
 425    periodperiodtok: printf0('periodperiodtok') |
 426    colontok: printf0('colontok') |
 427    doublequotestok: printf0('doublequotestok') |
 428    bartok: printf0('bartok') |
 429    andtok: printf0('andtok') |
 430    arraytok: printf0('arraytok') |
 431    begintok: printf0('begintok') |
 432    bytok: printf0('bytok') |
 433    casetok: printf0('casetok') |
 434    consttok: printf0('consttok') |
 435    definitiontok: printf0('definitiontok') |
 436    divtok: printf0('divtok') |
 437    dotok: printf0('dotok') |
 438    elsetok: printf0('elsetok') |
 439    elsiftok: printf0('elsiftok') |
 440    endtok: printf0('endtok') |
 441    exittok: printf0('exittok') |
 442    exporttok: printf0('exporttok') |
 443    fortok: printf0('fortok') |
 444    fromtok: printf0('fromtok') |
 445    iftok: printf0('iftok') |
 446    implementationtok: printf0('implementationtok') |
 447    importtok: printf0('importtok') |
 448    intok: printf0('intok') |
 449    looptok: printf0('looptok') |
 450    modtok: printf0('modtok') |
 451    moduletok: printf0('moduletok') |
 452    nottok: printf0('nottok') |
 453    oftok: printf0('oftok') |
 454    ortok: printf0('ortok') |
 455    pointertok: printf0('pointertok') |
 456    proceduretok: printf0('proceduretok') |
 457    qualifiedtok: printf0('qualifiedtok') |
 458    unqualifiedtok: printf0('unqualifiedtok') |
 459    recordtok: printf0('recordtok') |
 460    repeattok: printf0('repeattok') |
 461    returntok: printf0('returntok') |
 462    settok: printf0('settok') |
 463    thentok: printf0('thentok') |
 464    totok: printf0('totok') |
 465    typetok: printf0('typetok') |
 466    untiltok: printf0('untiltok') |
 467    vartok: printf0('vartok') |
 468    whiletok: printf0('whiletok') |
 469    withtok: printf0('withtok') |
 470    asmtok: printf0('asmtok') |
 471    volatiletok: printf0('volatiletok') |
 472    periodperiodperiodtok: printf0('periodperiodperiodtok') |
 473    datetok: printf0('datetok') |
 474    linetok: printf0('linetok') |
 475    filetok: printf0('filetok') |
 476    integertok: printf0('integertok') |
 477    identtok: printf0('identtok') |
 478    realtok: printf0('realtok') |
 479    stringtok: printf0('stringtok')
 480
 481    ELSE
 482    END
 483 END DisplayToken ;
 484
 485
 486 (*
 487    UpdateFromBucket - updates the global variables:  currenttoken,
 488                       currentstring, currentcolumn and currentinteger
 489                       from TokenBucket, b, and, offset.
 490 *)
 491
 492 PROCEDURE UpdateFromBucket (b: TokenBucket; offset: CARDINAL) ;
 493 BEGIN
 494    IF InsertionIndex > 0
 495    THEN
 496       (* we have an inserted token to use.  *)
 497       Assert (b^.buf[offset].insert # NIL) ;
 498       WITH b^.buf[offset].insert^.buf[InsertionIndex] DO
 499          currenttoken   := token ;
 500          currentstring  := KeyToCharStar(str) ;
 501          currentcolumn  := col ;
 502          currentinteger := int ;
 503          IF Debugging
 504          THEN
 505             printf3('line %d (# %d  %d) ', line, offset, CurrentTokNo)
 506          END
 507       END ;
 508       INC (InsertionIndex) ;
 509       IF InsertionIndex = b^.buf[offset].insert^.len
 510       THEN
 511          InsertionIndex := 0 ;  (* finished consuming the inserted tokens.  *)
 512          INC (CurrentTokNo)
 513       END
 514    ELSIF (b^.buf[offset].insert # NIL) AND (InsertionIndex = 0)
 515    THEN
 516       (* this source token has extra tokens appended after it by the error recovery.  *)
 517       Assert (b^.buf[offset].insert^.len > 0) ;  (* we must have at least one token.  *)
 518       InsertionIndex := 1 ; (* so set the index ready for the next UpdateFromBucket.  *)
 519       (* and read the original token.  *)
 520       WITH b^.buf[offset] DO
 521          currenttoken   := token ;
 522          currentstring  := KeyToCharStar(str) ;
 523          currentcolumn  := col ;
 524          currentinteger := int ;
 525          IF Debugging
 526          THEN
 527             printf3('line %d (# %d  %d) ', line, offset, CurrentTokNo)
 528          END
 529       END
 530    ELSE
 531       (* no inserted tokens after this token so read it and move on.  *)
 532       WITH b^.buf[offset] DO
 533          currenttoken   := token ;
 534          currentstring  := KeyToCharStar(str) ;
 535          currentcolumn  := col ;
 536          currentinteger := int ;
 537          IF Debugging
 538          THEN
 539             printf3('line %d (# %d  %d) ', line, offset, CurrentTokNo)
 540          END
 541       END ;
 542       INC (CurrentTokNo)
 543    END
 544 END UpdateFromBucket ;
 545
 546
 547 (*
 548    DisplayTokenEntry -
 549 *)
 550
 551 PROCEDURE DisplayTokenEntry (topBucket: TokenBucket; index, total: CARDINAL) ;
 552 VAR
 553    i: CARDINAL ;
 554 BEGIN
 555    printf1 ("%d: ", total) ;
 556    DisplayToken (topBucket^.buf[index].token) ;
 557    printf1 (" %a ", topBucket^.buf[index].str) ;
 558    IF total = GetTokenNo ()
 559    THEN
 560       printf0 (" <- current token")
 561    END ;
 562    printf0 ("\n") ;
 563    (* now check for inserted tokens.  *)
 564    IF topBucket^.buf[index].insert # NIL
 565    THEN
 566       i := 1 ;
 567       WHILE i < topBucket^.buf[index].insert^.len DO
 568          printf1 ("   %d: ", i) ;
 569          DisplayToken (topBucket^.buf[index].insert^.buf[i].token) ;
 570          printf1 (" %a\n", topBucket^.buf[index].insert^.buf[i].str) ;
 571          INC (i)
 572       END
 573    END
 574 END DisplayTokenEntry ;
 575
 576
 577 (*
 578    DumpTokens - developer debugging aid.
 579 *)
 580
 581 PROCEDURE DumpTokens ;
 582 VAR
 583    tb    : TokenBucket ;
 584    i,
 585    tokenNo,
 586    total,
 587    length : CARDINAL ;
 588 BEGIN
 589    tokenNo := GetTokenNo () ;
 590    tb := ListOfTokens.head ;
 591    total := 0 ;
 592    WHILE tb # NIL DO
 593       length := tb^.len ;
 594       i := 0 ;
 595       WHILE i < length DO
 596          DisplayTokenEntry (tb, i, total) ;
 597          INC (i) ;
 598          INC (total)
 599       END ;
 600       tb := tb^.next
 601    END ;
 602    printf2 ("%d: tokenNo,  %d: total\n", tokenNo, total) ;
 603    IF (total # 0) AND (tokenNo = total)
 604    THEN
 605       printf1 ("%d: end of buffer ", total) ;
 606       printf0 (" <- current token") ;
 607       printf0 ("\n") ;
 608    END ;
 609 END DumpTokens ;
 610
 611
 612 (*
 613    GetNonEofToken - providing that we have not already seen an eof for this source
 614                     file call m2flex.GetToken and GetToken if requested.
 615 *)
 616
 617 PROCEDURE GetNonEofToken (callGetToken: BOOLEAN) ;
 618 BEGIN
 619    IF SeenEof
 620    THEN
 621       currenttoken := eoftok
 622    ELSE
 623       (* Call the lexical phase to place a new token into the last bucket.  *)
 624       m2flex.GetToken () ;
 625       IF callGetToken
 626       THEN
 627          GetToken
 628       END
 629    END
 630 END GetNonEofToken ;
 631
 632
 633 (*
 634    GetToken - gets the next token into currenttoken.
 635 *)
 636
 637 PROCEDURE GetToken ;
 638 VAR
 639    t: CARDINAL ;
 640    b: TokenBucket ;
 641 BEGIN
 642    IF UseBufferedTokens
 643    THEN
 644       t := CurrentTokNo ;
 645       b := FindTokenBucket(t) ;
 646       UpdateFromBucket (b, t)
 647    ELSE
 648       IF ListOfTokens.tail=NIL
 649       THEN
 650          GetNonEofToken (FALSE) ;
 651          IF ListOfTokens.tail=NIL
 652          THEN
 653             HALT
 654          END
 655       END ;
 656       IF CurrentTokNo>=ListOfTokens.LastBucketOffset
 657       THEN
 658          (* CurrentTokNo is in the last bucket or needs to be read.  *)
 659          IF CurrentTokNo-ListOfTokens.LastBucketOffset<ListOfTokens.tail^.len
 660          THEN
 661             UpdateFromBucket (ListOfTokens.tail,
 662                               CurrentTokNo-ListOfTokens.LastBucketOffset)
 663          ELSE
 664             (* and call ourselves again to collect the token from bucket *)
 665             GetNonEofToken (TRUE)
 666          END
 667       ELSE
 668          t := CurrentTokNo ;
 669          b := FindTokenBucket (t) ;
 670          UpdateFromBucket (b, t)
 671       END
 672    END
 673 END GetToken ;
 674
 675
 676 (*
 677    SyncOpenWithBuffer - synchronise the buffer with the start of a file.
 678                         Skips all the tokens to do with the previous file.
 679 *)
 680
 681 PROCEDURE SyncOpenWithBuffer ;
 682 BEGIN
 683    IF ListOfTokens.tail#NIL
 684    THEN
 685       WITH ListOfTokens.tail^ DO
 686          CurrentTokNo := ListOfTokens.LastBucketOffset+len
 687       END
 688    END
 689 END SyncOpenWithBuffer ;
 690
 691
 692 (*
 693    GetInsertBucket - returns the insertion bucket associated with token count
 694                      and the topBucket.  It creates a new TokenBucket if necessary.
 695 *)
 696
 697 PROCEDURE GetInsertBucket (topBucket: TokenBucket; count: CARDINAL) : TokenBucket ;
 698 BEGIN
 699    IF topBucket^.buf[count].insert = NIL
 700    THEN
 701       NEW (topBucket^.buf[count].insert) ;
 702       topBucket^.buf[count].insert^.buf[0] := topBucket^.buf[count] ;
 703       topBucket^.buf[count].insert^.buf[0].insert := NIL ;
 704       topBucket^.buf[count].insert^.len := 1  (* empty, slot 0 contains the original token for ease.  *)
 705    END ;
 706    RETURN topBucket^.buf[count].insert
 707 END GetInsertBucket ;
 708
 709
 710 (*
 711    AppendToken - appends desc to the end of the insertionBucket.
 712 *)
 713
 714 PROCEDURE AppendToken (insertionBucket: TokenBucket; desc: TokenDesc) ;
 715 BEGIN
 716    IF insertionBucket^.len < MaxBucketSize
 717    THEN
 718       insertionBucket^.buf[insertionBucket^.len] := desc ;
 719       INC (insertionBucket^.len)
 720    END
 721 END AppendToken ;
 722
 723
 724 (*
 725    InsertToken - inserts a symbol, token, infront of the current token
 726                  ready for the next pass.
 727 *)
 728
 729 PROCEDURE InsertToken (token: toktype) ;
 730 VAR
 731    topBucket, insertionBucket: TokenBucket ;
 732    count : CARDINAL ;
 733    desc  : TokenDesc ;
 734 BEGIN
 735    Assert (ListOfTokens.tail # NIL) ;
 736    count := GetTokenNo () -1 ;
 737    topBucket := FindTokenBucket (count) ;
 738    insertionBucket := GetInsertBucket (topBucket, count) ;
 739    desc := topBucket^.buf[count] ;
 740    desc.token := token ;
 741    desc.insert := NIL ;
 742    AppendToken (insertionBucket, desc) ;
 743    IF DebugRecover
 744    THEN
 745       DumpTokens
 746    END
 747 END InsertToken ;
 748
 749
 750 (*
 751    InsertTokenAndRewind - inserts a symbol, token, infront of the current token
 752                           and then moves the token stream back onto the inserted token.
 753 *)
 754
 755 PROCEDURE InsertTokenAndRewind (token: toktype) ;
 756 VAR
 757    offset   : CARDINAL ;
 758    topBucket: TokenBucket ;
 759 BEGIN
 760    IF GetTokenNo () > 0
 761    THEN
 762       InsertToken (token) ;
 763       offset := CurrentTokNo -2 ;
 764       topBucket := FindTokenBucket (offset) ;
 765       InsertionIndex := topBucket^.buf[offset].insert^.len -1 ;
 766       DEC (CurrentTokNo, 2) ;
 767       GetToken
 768    END
 769 END InsertTokenAndRewind ;
 770
 771
 772 (*
 773    GetPreviousTokenLineNo - returns the line number of the previous token.
 774 *)
 775
 776 PROCEDURE GetPreviousTokenLineNo () : CARDINAL ;
 777 BEGIN
 778    (*
 779    IF GetTokenNo()>0
 780    THEN
 781       RETURN( TokenToLineNo(GetTokenNo()-1, 0) )
 782    ELSE
 783       RETURN( 0 )
 784    END
 785       *)
 786    RETURN GetLineNo ()
 787 END GetPreviousTokenLineNo ;
 788
 789
 790 (*
 791    GetLineNo - returns the current line number where the symbol occurs in
 792                the source file.
 793 *)
 794
 795 PROCEDURE GetLineNo () : CARDINAL ;
 796 BEGIN
 797    IF CurrentTokNo = 0
 798    THEN
 799       RETURN 0
 800    ELSE
 801       RETURN TokenToLineNo (GetTokenNo (), 0)
 802    END
 803 END GetLineNo ;
 804
 805
 806 (*
 807    GetColumnNo - returns the current column where the symbol occurs in
 808                  the source file.
 809 *)
 810
 811 PROCEDURE GetColumnNo () : CARDINAL ;
 812 BEGIN
 813    IF CurrentTokNo = 0
 814    THEN
 815       RETURN 0
 816    ELSE
 817       RETURN TokenToColumnNo (GetTokenNo (), 0)
 818    END
 819 END GetColumnNo ;
 820
 821
 822 (*
 823    GetTokenNo - returns the current token number.
 824 *)
 825
 826 PROCEDURE GetTokenNo () : CARDINAL ;
 827 BEGIN
 828    IF CurrentTokNo = 0
 829    THEN
 830       RETURN 0
 831    ELSE
 832       RETURN CurrentTokNo-1
 833    END
 834 END GetTokenNo ;
 835
 836
 837 (*
 838    GetTokenName - returns the token name given the tokenno.
 839 *)
 840
 841 PROCEDURE GetTokenName (tokenno: CARDINAL) : Name ;
 842 VAR
 843    b: TokenBucket ;
 844    n: Name ;
 845 BEGIN
 846    b := FindTokenBucket (tokenno) ;
 847    IF b=NIL
 848    THEN
 849       RETURN NulName
 850    ELSE
 851       WITH b^.buf[tokenno] DO
 852          n := tokToTok (token) ;
 853          IF n=NulName
 854          THEN
 855             RETURN str
 856          ELSE
 857             RETURN n
 858          END
 859       END
 860    END
 861 END GetTokenName ;
 862
 863
 864 (*
 865    FindTokenBucket - returns the TokenBucket corresponding to the TokenNo.
 866 *)
 867
 868 PROCEDURE FindTokenBucket (VAR TokenNo: CARDINAL) : TokenBucket ;
 869 VAR
 870    b: TokenBucket ;
 871 BEGIN
 872    b := ListOfTokens.head ;
 873    WHILE b#NIL DO
 874       WITH b^ DO
 875          IF TokenNo<len
 876          THEN
 877             RETURN b
 878          ELSE
 879             DEC (TokenNo, len)
 880          END
 881       END ;
 882       b := b^.next
 883    END ;
 884    RETURN NIL
 885 END FindTokenBucket ;
 886
 887
 888 (*
 889    TokenToLineNo - returns the line number of the current file for the
 890                    TokenNo. The depth refers to the include depth.
 891                    A depth of 0 is the current file, depth of 1 is the file
 892                    which included the current file. Zero is returned if the
 893                    depth exceeds the file nesting level.
 894 *)
 895
 896 PROCEDURE TokenToLineNo (TokenNo: CARDINAL; depth: CARDINAL) : CARDINAL ;
 897 VAR
 898    b: TokenBucket ;
 899    l: SourceList ;
 900 BEGIN
 901    IF (TokenNo = UnknownTokenNo) OR (TokenNo = BuiltinTokenNo)
 902    THEN
 903       RETURN 0
 904    ELSE
 905       b := FindTokenBucket (TokenNo) ;
 906       IF b = NIL
 907       THEN
 908          RETURN 0
 909       ELSE
 910          IF depth = 0
 911          THEN
 912             RETURN b^.buf[TokenNo].line
 913          ELSE
 914             l := b^.buf[TokenNo].file^.left ;
 915             WHILE depth>0 DO
 916                l := l^.left ;
 917                IF l=b^.buf[TokenNo].file^.left
 918                THEN
 919                   RETURN 0
 920                END ;
 921                DEC (depth)
 922             END ;
 923             RETURN l^.line
 924          END
 925       END
 926    END
 927 END TokenToLineNo ;
 928
 929
 930 (*
 931    TokenToColumnNo - returns the column number of the current file for the
 932                      TokenNo. The depth refers to the include depth.
 933                      A depth of 0 is the current file, depth of 1 is the file
 934                      which included the current file. Zero is returned if the
 935                      depth exceeds the file nesting level.
 936 *)
 937
 938 PROCEDURE TokenToColumnNo (TokenNo: CARDINAL; depth: CARDINAL) : CARDINAL ;
 939 VAR
 940    b: TokenBucket ;
 941    l: SourceList ;
 942 BEGIN
 943    IF (TokenNo = UnknownTokenNo) OR (TokenNo = BuiltinTokenNo)
 944    THEN
 945       RETURN 0
 946    ELSE
 947       b := FindTokenBucket (TokenNo) ;
 948       IF b=NIL
 949       THEN
 950          RETURN 0
 951       ELSE
 952          IF depth = 0
 953          THEN
 954             RETURN b^.buf[TokenNo].col
 955          ELSE
 956             l := b^.buf[TokenNo].file^.left ;
 957             WHILE depth>0 DO
 958                l := l^.left ;
 959                IF l=b^.buf[TokenNo].file^.left
 960                THEN
 961                   RETURN 0
 962                END ;
 963                DEC (depth)
 964             END ;
 965             RETURN l^.col
 966          END
 967       END
 968    END
 969 END TokenToColumnNo ;
 970
 971
 972 (*
 973    TokenToLocation - returns the location_t corresponding to, TokenNo.
 974 *)
 975
 976 PROCEDURE TokenToLocation (TokenNo: CARDINAL) : location_t ;
 977 VAR
 978    b: TokenBucket ;
 979 BEGIN
 980    IF TokenNo = UnknownTokenNo
 981    THEN
 982       RETURN UnknownLocation ()
 983    ELSIF TokenNo = BuiltinTokenNo
 984    THEN
 985       RETURN BuiltinsLocation ()
 986    ELSE
 987       b := FindTokenBucket (TokenNo) ;
 988       IF b=NIL
 989       THEN
 990          RETURN UnknownLocation ()
 991       ELSE
 992          RETURN b^.buf[TokenNo].loc
 993       END
 994    END
 995 END TokenToLocation ;
 996
 997
 998 (*
 999    FindFileNameFromToken - returns the complete FileName for the appropriate
1000                            source file yields the token number, TokenNo.
1001                            The, Depth, indicates the include level: 0..n
1002                            Level 0 is the current. NIL is returned if n+1
1003                            is requested.
1004 *)
1005
1006 PROCEDURE FindFileNameFromToken (TokenNo: CARDINAL; depth: CARDINAL) : String ;
1007 VAR
1008    b: TokenBucket ;
1009    l: SourceList ;
1010 BEGIN
1011    b := FindTokenBucket (TokenNo) ;
1012    IF b=NIL
1013    THEN
1014       RETURN NIL
1015    ELSE
1016       IF TokenNo = UnknownTokenNo
1017       THEN
1018          RETURN NIL
1019       ELSIF TokenNo = BuiltinTokenNo
1020       THEN
1021          RETURN NIL
1022       ELSE
1023          l := b^.buf[TokenNo].file^.left ;
1024          WHILE depth>0 DO
1025             l := l^.left ;
1026             IF l=b^.buf[TokenNo].file^.left
1027             THEN
1028                RETURN NIL
1029             END ;
1030             DEC (depth)
1031          END ;
1032          RETURN l^.name
1033       END
1034    END
1035 END FindFileNameFromToken ;
1036
1037
1038 (*
1039    GetFileName - returns a String defining the current file.
1040 *)
1041
1042 PROCEDURE GetFileName () : String ;
1043 BEGIN
1044    RETURN FindFileNameFromToken (GetTokenNo (), 0)
1045 END GetFileName ;
1046
1047
1048 (*
1049    AddTokToList - adds a token to a dynamic list.
1050 *)
1051
1052 PROCEDURE AddTokToList (t: toktype; n: Name;
1053                         i: INTEGER; l: CARDINAL; c: CARDINAL;
1054                         f: SourceList; location: location_t) ;
1055 BEGIN
1056    IF ListOfTokens.head=NIL
1057    THEN
1058       NEW (ListOfTokens.head) ;
1059       IF ListOfTokens.head=NIL
1060       THEN
1061          (* list error *)
1062       END ;
1063       ListOfTokens.tail := ListOfTokens.head ;
1064       ListOfTokens.tail^.len := 0
1065    ELSIF ListOfTokens.tail^.len=MaxBucketSize
1066    THEN
1067       Assert(ListOfTokens.tail^.next=NIL) ;
1068       NEW (ListOfTokens.tail^.next) ;
1069       IF ListOfTokens.tail^.next=NIL
1070       THEN
1071          (* list error *)
1072       ELSE
1073          ListOfTokens.tail := ListOfTokens.tail^.next ;
1074          ListOfTokens.tail^.len := 0
1075       END ;
1076       INC (ListOfTokens.LastBucketOffset, MaxBucketSize)
1077    END ;
1078    WITH ListOfTokens.tail^ DO
1079       next := NIL ;
1080       WITH buf[len] DO
1081          token  := t ;
1082          str    := n ;
1083          int    := i ;
1084          line   := l ;
1085          col    := c ;
1086          file   := f ;
1087          loc    := location ;
1088          insert := NIL ;
1089       END ;
1090       INC (len)
1091    END
1092 END AddTokToList ;
1093
1094
1095 (*
1096    IsLastTokenEof - returns TRUE if the last token was an eoftok
1097 *)
1098
1099 PROCEDURE IsLastTokenEof () : BOOLEAN ;
1100 VAR
1101    b: TokenBucket ;
1102 BEGIN
1103    IF ListOfTokens.tail#NIL
1104    THEN
1105       IF ListOfTokens.tail^.len=0
1106       THEN
1107          b := ListOfTokens.head ;
1108          IF b=ListOfTokens.tail
1109          THEN
1110             RETURN FALSE
1111          END ;
1112          WHILE b^.next#ListOfTokens.tail DO
1113             b := b^.next
1114          END ;
1115       ELSE
1116          b := ListOfTokens.tail
1117       END ;
1118       WITH b^ DO
1119          Assert (len>0) ;     (* len should always be >0 *)
1120          RETURN buf[len-1].token=eoftok
1121       END
1122    END ;
1123    RETURN FALSE
1124 END IsLastTokenEof ;
1125
1126
1127 (*
1128    PrintTokenNo - displays token and the location of the token.
1129 *)
1130
1131 PROCEDURE PrintTokenNo (tokenno: CARDINAL) ;
1132 VAR
1133    s: String ;
1134 BEGIN
1135    printf1 ("tokenno = %d, ", tokenno) ;
1136    s := InitStringCharStar (KeyToCharStar (GetTokenName (tokenno))) ;
1137    printf1 ("%s\n", s) ;
1138    s := KillString (s)
1139 END PrintTokenNo ;
1140
1141
1142 (*
1143    isSrcToken - returns TRUE if tokenno is associated with
1144                 program source code.
1145 *)
1146
1147 PROCEDURE isSrcToken (tokenno: CARDINAL) : BOOLEAN ;
1148 BEGIN
1149    RETURN (tokenno # UnknownTokenNo) AND (tokenno # BuiltinTokenNo)
1150 END isSrcToken ;
1151
1152
1153 (*
1154    MakeVirtualTok - providing caret, left, right are associated with a source file
1155                     and exist on the same src line then
1156                     create and return a new tokenno which is created from
1157                     tokenno range1 and range2.  Otherwise return caret.
1158 *)
1159
1160 PROCEDURE MakeVirtualTok (caret, left, right: CARDINAL) : CARDINAL ;
1161 VAR
1162    bufLeft, bufRight: TokenBucket ;
1163    lc, ll, lr       : location_t ;
1164 BEGIN
1165    IF isSrcToken (caret) AND isSrcToken (left) AND isSrcToken (right)
1166    THEN
1167       lc := TokenToLocation (caret) ;
1168       ll := TokenToLocation (left) ;
1169       lr := TokenToLocation (right) ;
1170       bufLeft := FindTokenBucket (left) ;   (* left maybe changed now.  *)
1171       bufRight := FindTokenBucket (right) ;  (* right maybe changed now.  *)
1172
1173       IF (bufLeft^.buf[left].line = bufRight^.buf[right].line) AND
1174          (bufLeft^.buf[left].file = bufRight^.buf[right].file)
1175       THEN
1176          (* on the same line, create a new token and location.  *)
1177          AddTokToList (virtualrangetok, NulName, 0,
1178                        bufLeft^.buf[left].line, bufLeft^.buf[left].col, bufLeft^.buf[left].file,
1179                        GetLocationBinary (lc, ll, lr)) ;
1180          RETURN ListOfTokens.LastBucketOffset + ListOfTokens.tail^.len - 1
1181       END
1182    END ;
1183    RETURN caret
1184 END MakeVirtualTok ;
1185
1186
1187 (* ***********************************************************************
1188  *
1189  * These functions allow m2.flex to deliver tokens into the buffer
1190  *
1191  ************************************************************************* *)
1192
1193 (*
1194    AddTok - adds a token to the buffer.
1195 *)
1196
1197 PROCEDURE AddTok (t: toktype) ;
1198 VAR
1199    s: String ;
1200 BEGIN
1201    IF t = eoftok
1202    THEN
1203       SeenEof := TRUE
1204    END ;
1205    IF NOT ((t=eoftok) AND IsLastTokenEof())
1206    THEN
1207       AddTokToList(t, NulName, 0,
1208                    m2flex.GetLineNo(), m2flex.GetColumnNo(), CurrentSource,
1209                    m2flex.GetLocation()) ;
1210       CurrentUsed := TRUE ;
1211       IF Debugging
1212       THEN
1213          (* display each token as a warning.  *)
1214          s := InitStringCharStar (KeyToCharStar (GetTokenName (GetTokenNo ()))) ;
1215          WarnStringAt (s, GetTokenNo ())
1216       END
1217    END
1218 END AddTok ;
1219
1220
1221 (*
1222    AddTokCharStar - adds a token to the buffer and an additional string, s.
1223                     A copy of string, s, is made.
1224 *)
1225
1226 PROCEDURE AddTokCharStar (t: toktype; s: ADDRESS) ;
1227 BEGIN
1228    AddTokToList(t, makekey(s), 0, m2flex.GetLineNo(),
1229                 m2flex.GetColumnNo(), CurrentSource, m2flex.GetLocation()) ;
1230    CurrentUsed := TRUE
1231 END AddTokCharStar ;
1232
1233
1234 (*
1235    AddTokInteger - adds a token and an integer to the buffer.
1236 *)
1237
1238 PROCEDURE AddTokInteger (t: toktype; i: INTEGER) ;
1239 VAR
1240    s: String ;
1241    c,
1242    l: CARDINAL ;
1243 BEGIN
1244    l := m2flex.GetLineNo() ;
1245    c := m2flex.GetColumnNo() ;
1246    s := Sprintf1(Mark(InitString('%d')), i) ;
1247    AddTokToList(t, makekey(string(s)), i, l, c, CurrentSource, m2flex.GetLocation()) ;
1248    s := KillString(s) ;
1249    CurrentUsed := TRUE
1250 END AddTokInteger ;
1251
1252
1253 BEGIN
1254    Init
1255 END M2LexBuf.