gcc/m2/mc/mcLexBuf.mod

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