(* M2LexBuf.mod provides a buffer for m2.lex.

Copyright (C) 2001-2023 Free Software Foundation, Inc.
Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.

This file is part of GNU Modula-2.

GNU Modula-2 is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3, or (at your option)
any later version.

GNU Modula-2 is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Modula-2; see the file COPYING3.  If not see
<http://www.gnu.org/licenses/>.  *)

IMPLEMENTATION MODULE M2LexBuf ;

IMPORT m2flex ;

FROM libc IMPORT strlen ;
FROM SYSTEM IMPORT ADDRESS ;
FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
FROM DynamicStrings IMPORT string, InitString, InitStringCharStar, Equal, Mark, KillString ;
FROM FormatStrings IMPORT Sprintf1 ;
FROM NameKey IMPORT NulName, Name, makekey, MakeKey, KeyToCharStar ;
FROM M2Reserved IMPORT toktype, tokToTok ;
FROM M2Printf IMPORT printf0, printf1, printf2, printf3 ;
FROM M2Debug IMPORT Assert ;
FROM NameKey IMPORT makekey ;
FROM m2linemap IMPORT location_t, GetLocationBinary ;
FROM M2Emit IMPORT UnknownLocation, BuiltinsLocation ;
FROM M2Error IMPORT WarnStringAt ;

CONST
   MaxBucketSize      = 100 ;
   Debugging          = FALSE ;
   DebugRecover       = FALSE ;
   InitialSourceToken = 2 ;   (* 0 is unknown, 1 is builtin.  *)

TYPE
   SourceList = POINTER TO RECORD
                              left,
                              right: SourceList ;
                              name : String ;
                              line : CARDINAL ;
                              col  : CARDINAL ;
                           END ;

   TokenDesc = RECORD
                  token : toktype ;
                  str   : Name ;          (* ident name or string literal.  *)
                  int   : INTEGER ;
                  line  : CARDINAL ;
                  col   : CARDINAL ;
                  file  : SourceList ;
                  loc   : location_t ;
                  insert: TokenBucket ;   (* contains any inserted tokens.  *)
               END ;

   TokenBucket = POINTER TO RECORD
                               buf : ARRAY [0..MaxBucketSize] OF TokenDesc ;
                               len : CARDINAL ;
                               next: TokenBucket ;
                            END ;

   ListDesc = RECORD
                 head,
                 tail            : TokenBucket ;
                 LastBucketOffset: CARDINAL ;
              END ;

VAR
   CurrentSource    : SourceList ;
   UseBufferedTokens,
   CurrentUsed      : BOOLEAN ;
   ListOfTokens     : ListDesc ;
   CurrentTokNo     : CARDINAL ;
   InsertionIndex   : CARDINAL ;
   SeenEof          : BOOLEAN ;  (* Have we seen eof since the last call
                                    to OpenSource.  *)


(*
   InitTokenList - creates an empty token list, which starts the first source token
                   at position 2.  This allows position 0 to be for unknown location
                   and position 1 for builtin token.
*)

PROCEDURE InitTokenList ;
BEGIN
   NEW (ListOfTokens.head) ;
   ListOfTokens.tail := ListOfTokens.head ;
   WITH ListOfTokens.tail^.buf[0] DO
      token := eoftok ;
      str := NulName ;
      int := 0 ;
      line := 0 ;
      col := 0 ;
      file := NIL ;
      loc := UnknownLocation ()
   END ;
   WITH ListOfTokens.tail^.buf[1] DO
      token := eoftok ;
      str := NulName ;
      int := 0 ;
      line := 0 ;
      col := 0 ;
      file := NIL ;
      loc := BuiltinsLocation ()
   END ;
   ListOfTokens.tail^.len := InitialSourceToken
END InitTokenList ;


(*
   Init - initializes the token list and source list.
*)

PROCEDURE Init ;
BEGIN
   SeenEof := FALSE ;
   InsertionIndex := 0 ;
   currenttoken := eoftok ;
   CurrentTokNo := InitialSourceToken ;
   CurrentSource := NIL ;
   ListOfTokens.head := NIL ;
   ListOfTokens.tail := NIL ;
   UseBufferedTokens := FALSE ;
   InitTokenList
END Init ;


(*
   AddTo - adds a new element to the end of SourceList, CurrentSource.
*)

PROCEDURE AddTo (l: SourceList) ;
BEGIN
   l^.right := CurrentSource ;
   l^.left  := CurrentSource^.left ;
   CurrentSource^.left^.right := l ;
   CurrentSource^.left := l ;
   WITH l^.left^ DO
      line := m2flex.GetLineNo() ;
      col  := m2flex.GetColumnNo()
   END
END AddTo ;


(*
   SubFrom - subtracts, l, from the source list.
*)

PROCEDURE SubFrom (l: SourceList) ;
BEGIN
   l^.left^.right := l^.right ;
   l^.right^.left := l^.left
END SubFrom ;


(*
   NewElement - returns a new SourceList
*)

PROCEDURE NewElement (s: ADDRESS) : SourceList ;
VAR
   l: SourceList ;
BEGIN
   NEW (l) ;
   IF l = NIL
   THEN
      HALT
   ELSE
      WITH l^ DO
         name  := InitStringCharStar(s) ;
         left  := NIL ;
         right := NIL
      END
   END ;
   RETURN l
END NewElement ;


(*
   NewList - initializes an empty list with the classic dummy header element.
*)

PROCEDURE NewList () : SourceList ;
VAR
   l: SourceList ;
BEGIN
   NEW (l) ;
   WITH l^ DO
      left  := l ;
      right := l ;
      name  := NIL
   END ;
   RETURN l
END NewList ;


(*
   CheckIfNeedToDuplicate - checks to see whether the CurrentSource has
                            been used, if it has then duplicate the list.
*)

PROCEDURE CheckIfNeedToDuplicate ;
VAR
   l, h: SourceList ;
BEGIN
   IF CurrentUsed
   THEN
      l := CurrentSource^.right ;
      h := CurrentSource ;
      CurrentSource := NewList() ;
      WHILE l#h DO
         AddTo (NewElement (l^.name)) ;
         l := l^.right
      END
   END
END CheckIfNeedToDuplicate ;


(*
   PushFile - indicates that, filename, has just been included.
*)

PROCEDURE PushFile (filename: ADDRESS) ;
VAR
   l: SourceList ;
BEGIN
   CheckIfNeedToDuplicate ;
   AddTo (NewElement (filename)) ;
   IF Debugging
   THEN
      IF CurrentSource^.right#CurrentSource
      THEN
         l := CurrentSource ;
         REPEAT
            printf3('name = %s, line = %d, col = %d\n', l^.name, l^.line, l^.col) ;
            l := l^.right
         UNTIL l=CurrentSource
      END
   END
END PushFile ;


(*
   PopFile - indicates that we are returning to, filename, having finished
             an include.
*)

PROCEDURE PopFile (filename: ADDRESS) ;
VAR
   l: SourceList ;
BEGIN
   CheckIfNeedToDuplicate ;
   IF (CurrentSource#NIL) AND (CurrentSource^.left#CurrentSource)
   THEN
      l := CurrentSource^.left ;  (* last element *)
      SubFrom (l) ;
      DISPOSE (l) ;
      IF (CurrentSource^.left#CurrentSource) AND
         (NOT Equal(CurrentSource^.name, Mark(InitStringCharStar(filename))))
      THEN
         (* mismatch in source file names after preprocessing files *)
      END
   ELSE
      (* source file list is empty, cannot pop an include.. *)
   END
END PopFile ;


(*
   KillList - kills the SourceList providing that it has not been used.
*)

PROCEDURE KillList ;
VAR
   l, k: SourceList ;
BEGIN
   IF (NOT CurrentUsed) AND (CurrentSource#NIL)
   THEN
      l := CurrentSource ;
      REPEAT
         k := l ;
         l := l^.right ;
         DISPOSE(k)
      UNTIL l=CurrentSource
   END
END KillList ;


(*
   ReInitialize - re-initialize the all the data structures.
*)

PROCEDURE ReInitialize ;
VAR
   s, t: TokenBucket ;
BEGIN
   IF ListOfTokens.head#NIL
   THEN
      t := ListOfTokens.head ;
      REPEAT
         s := t ;
         t := t^.next ;
         DISPOSE(s) ;
      UNTIL t=NIL ;
      CurrentUsed := FALSE ;
      KillList
   END ;
   Init
END ReInitialize ;


(*
   SetFile - sets the current filename to, filename.
*)

PROCEDURE SetFile (filename: ADDRESS) ;
BEGIN
   KillList ;
   CurrentUsed   := FALSE ;
   CurrentSource := NewList () ;
   AddTo (NewElement (filename))
END SetFile ;


(*
   OpenSource - Attempts to open the source file, s.
                The success of the operation is returned.
*)

PROCEDURE OpenSource (s: String) : BOOLEAN ;
BEGIN
   SeenEof := FALSE ;
   IF UseBufferedTokens
   THEN
      GetToken ;
      RETURN TRUE
   ELSE
      IF m2flex.OpenSource (string (s))
      THEN
         SetFile (string (s)) ;
         SyncOpenWithBuffer ;
         GetToken ;
         RETURN TRUE
      ELSE
         RETURN FALSE
      END
   END
END OpenSource ;


(*
   CloseSource - closes the current open file.
*)

PROCEDURE CloseSource ;
BEGIN
   IF UseBufferedTokens
   THEN
      WHILE currenttoken#eoftok DO
         GetToken
      END
   ELSE
      (* a subsequent call to m2flex.OpenSource will really close the file *)
   END
END CloseSource ;


(*
   ResetForNewPass - reset the buffer pointers to the beginning ready for
                     a new pass
*)

PROCEDURE ResetForNewPass ;
BEGIN
   InsertionIndex := 0 ;
   CurrentTokNo := InitialSourceToken ;
   UseBufferedTokens := TRUE
END ResetForNewPass ;


(*
   DisplayToken - display the token name using printf0 no newline is emitted.
*)

PROCEDURE DisplayToken (tok: toktype) ;
BEGIN
   CASE tok OF

   eoftok: printf0('eoftok') |
   plustok: printf0('plustok') |
   minustok: printf0('minustok') |
   timestok: printf0('timestok') |
   dividetok: printf0('dividetok') |
   becomestok: printf0('becomestok') |
   ambersandtok: printf0('ambersandtok') |
   periodtok: printf0('periodtok') |
   commatok: printf0('commatok') |
   semicolontok: printf0('semicolontok') |
   lparatok: printf0('lparatok') |
   rparatok: printf0('rparatok') |
   lsbratok: printf0('lsbratok') |
   rsbratok: printf0('rsbratok') |
   lcbratok: printf0('lcbratok') |
   rcbratok: printf0('rcbratok') |
   uparrowtok: printf0('uparrowtok') |
   singlequotetok: printf0('singlequotetok') |
   equaltok: printf0('equaltok') |
   hashtok: printf0('hashtok') |
   lesstok: printf0('lesstok') |
   greatertok: printf0('greatertok') |
   lessgreatertok: printf0('lessgreatertok') |
   lessequaltok: printf0('lessequaltok') |
   greaterequaltok: printf0('greaterequaltok') |
   periodperiodtok: printf0('periodperiodtok') |
   colontok: printf0('colontok') |
   doublequotestok: printf0('doublequotestok') |
   bartok: printf0('bartok') |
   andtok: printf0('andtok') |
   arraytok: printf0('arraytok') |
   begintok: printf0('begintok') |
   bytok: printf0('bytok') |
   casetok: printf0('casetok') |
   consttok: printf0('consttok') |
   definitiontok: printf0('definitiontok') |
   divtok: printf0('divtok') |
   dotok: printf0('dotok') |
   elsetok: printf0('elsetok') |
   elsiftok: printf0('elsiftok') |
   endtok: printf0('endtok') |
   exittok: printf0('exittok') |
   exporttok: printf0('exporttok') |
   fortok: printf0('fortok') |
   fromtok: printf0('fromtok') |
   iftok: printf0('iftok') |
   implementationtok: printf0('implementationtok') |
   importtok: printf0('importtok') |
   intok: printf0('intok') |
   looptok: printf0('looptok') |
   modtok: printf0('modtok') |
   moduletok: printf0('moduletok') |
   nottok: printf0('nottok') |
   oftok: printf0('oftok') |
   ortok: printf0('ortok') |
   pointertok: printf0('pointertok') |
   proceduretok: printf0('proceduretok') |
   qualifiedtok: printf0('qualifiedtok') |
   unqualifiedtok: printf0('unqualifiedtok') |
   recordtok: printf0('recordtok') |
   repeattok: printf0('repeattok') |
   returntok: printf0('returntok') |
   settok: printf0('settok') |
   thentok: printf0('thentok') |
   totok: printf0('totok') |
   typetok: printf0('typetok') |
   untiltok: printf0('untiltok') |
   vartok: printf0('vartok') |
   whiletok: printf0('whiletok') |
   withtok: printf0('withtok') |
   asmtok: printf0('asmtok') |
   volatiletok: printf0('volatiletok') |
   periodperiodperiodtok: printf0('periodperiodperiodtok') |
   datetok: printf0('datetok') |
   linetok: printf0('linetok') |
   filetok: printf0('filetok') |
   integertok: printf0('integertok') |
   identtok: printf0('identtok') |
   realtok: printf0('realtok') |
   stringtok: printf0('stringtok')

   ELSE
   END
END DisplayToken ;


(*
   UpdateFromBucket - updates the global variables:  currenttoken,
                      currentstring, currentcolumn and currentinteger
                      from TokenBucket, b, and, offset.
*)

PROCEDURE UpdateFromBucket (b: TokenBucket; offset: CARDINAL) ;
BEGIN
   IF InsertionIndex > 0
   THEN
      (* we have an inserted token to use.  *)
      Assert (b^.buf[offset].insert # NIL) ;
      WITH b^.buf[offset].insert^.buf[InsertionIndex] DO
         currenttoken   := token ;
         currentstring  := KeyToCharStar(str) ;
         currentcolumn  := col ;
         currentinteger := int ;
         IF Debugging
         THEN
            printf3('line %d (# %d  %d) ', line, offset, CurrentTokNo)
         END
      END ;
      INC (InsertionIndex) ;
      IF InsertionIndex = b^.buf[offset].insert^.len
      THEN
         InsertionIndex := 0 ;  (* finished consuming the inserted tokens.  *)
         INC (CurrentTokNo)
      END
   ELSIF (b^.buf[offset].insert # NIL) AND (InsertionIndex = 0)
   THEN
      (* this source token has extra tokens appended after it by the error recovery.  *)
      Assert (b^.buf[offset].insert^.len > 0) ;  (* we must have at least one token.  *)
      InsertionIndex := 1 ; (* so set the index ready for the next UpdateFromBucket.  *)
      (* and read the original token.  *)
      WITH b^.buf[offset] DO
         currenttoken   := token ;
         currentstring  := KeyToCharStar(str) ;
         currentcolumn  := col ;
         currentinteger := int ;
         IF Debugging
         THEN
            printf3('line %d (# %d  %d) ', line, offset, CurrentTokNo)
         END
      END
   ELSE
      (* no inserted tokens after this token so read it and move on.  *)
      WITH b^.buf[offset] DO
         currenttoken   := token ;
         currentstring  := KeyToCharStar(str) ;
         currentcolumn  := col ;
         currentinteger := int ;
         IF Debugging
         THEN
            printf3('line %d (# %d  %d) ', line, offset, CurrentTokNo)
         END
      END ;
      INC (CurrentTokNo)
   END
END UpdateFromBucket ;


(*
   DisplayTokenEntry -
*)

PROCEDURE DisplayTokenEntry (topBucket: TokenBucket; index, total: CARDINAL) ;
VAR
   i: CARDINAL ;
BEGIN
   printf1 ("%d: ", total) ;
   DisplayToken (topBucket^.buf[index].token) ;
   printf1 (" %a ", topBucket^.buf[index].str) ;
   IF total = GetTokenNo ()
   THEN
      printf0 (" <- current token")
   END ;
   printf0 ("\n") ;
   (* now check for inserted tokens.  *)
   IF topBucket^.buf[index].insert # NIL
   THEN
      i := 1 ;
      WHILE i < topBucket^.buf[index].insert^.len DO
         printf1 ("   %d: ", i) ;
         DisplayToken (topBucket^.buf[index].insert^.buf[i].token) ;
         printf1 (" %a\n", topBucket^.buf[index].insert^.buf[i].str) ;
         INC (i)
      END
   END
END DisplayTokenEntry ;


(*
   DumpTokens - developer debugging aid.
*)

PROCEDURE DumpTokens ;
VAR
   tb    : TokenBucket ;
   i,
   tokenNo,
   total,
   length : CARDINAL ;
BEGIN
   tokenNo := GetTokenNo () ;
   tb := ListOfTokens.head ;
   total := 0 ;
   WHILE tb # NIL DO
      length := tb^.len ;
      i := 0 ;
      WHILE i < length DO
         DisplayTokenEntry (tb, i, total) ;
         INC (i) ;
         INC (total)
      END ;
      tb := tb^.next
   END ;
   printf2 ("%d: tokenNo,  %d: total\n", tokenNo, total) ;
   IF (total # 0) AND (tokenNo = total)
   THEN
      printf1 ("%d: end of buffer ", total) ;
      printf0 (" <- current token") ;
      printf0 ("\n") ;
   END ;
END DumpTokens ;


(*
   GetNonEofToken - providing that we have not already seen an eof for this source
                    file call m2flex.GetToken and GetToken if requested.
*)

PROCEDURE GetNonEofToken (callGetToken: BOOLEAN) ;
BEGIN
   IF SeenEof
   THEN
      currenttoken := eoftok
   ELSE
      (* Call the lexical phase to place a new token into the last bucket.  *)
      m2flex.GetToken () ;
      IF callGetToken
      THEN
         GetToken
      END
   END
END GetNonEofToken ;


(*
   GetToken - gets the next token into currenttoken.
*)

PROCEDURE GetToken ;
VAR
   t: CARDINAL ;
   b: TokenBucket ;
BEGIN
   IF UseBufferedTokens
   THEN
      t := CurrentTokNo ;
      b := FindTokenBucket(t) ;
      UpdateFromBucket (b, t)
   ELSE
      IF ListOfTokens.tail=NIL
      THEN
         GetNonEofToken (FALSE) ;
         IF ListOfTokens.tail=NIL
         THEN
            HALT
         END
      END ;
      IF CurrentTokNo>=ListOfTokens.LastBucketOffset
      THEN
         (* CurrentTokNo is in the last bucket or needs to be read.  *)
         IF CurrentTokNo-ListOfTokens.LastBucketOffset<ListOfTokens.tail^.len
         THEN
            UpdateFromBucket (ListOfTokens.tail,
                              CurrentTokNo-ListOfTokens.LastBucketOffset)
         ELSE
            (* and call ourselves again to collect the token from bucket *)
            GetNonEofToken (TRUE)
         END
      ELSE
         t := CurrentTokNo ;
         b := FindTokenBucket (t) ;
         UpdateFromBucket (b, t)
      END
   END
END GetToken ;


(*
   SyncOpenWithBuffer - synchronise the buffer with the start of a file.
                        Skips all the tokens to do with the previous file.
*)

PROCEDURE SyncOpenWithBuffer ;
BEGIN
   IF ListOfTokens.tail#NIL
   THEN
      WITH ListOfTokens.tail^ DO
         CurrentTokNo := ListOfTokens.LastBucketOffset+len
      END
   END
END SyncOpenWithBuffer ;


(*
   GetInsertBucket - returns the insertion bucket associated with token count
                     and the topBucket.  It creates a new TokenBucket if necessary.
*)

PROCEDURE GetInsertBucket (topBucket: TokenBucket; count: CARDINAL) : TokenBucket ;
BEGIN
   IF topBucket^.buf[count].insert = NIL
   THEN
      NEW (topBucket^.buf[count].insert) ;
      topBucket^.buf[count].insert^.buf[0] := topBucket^.buf[count] ;
      topBucket^.buf[count].insert^.buf[0].insert := NIL ;
      topBucket^.buf[count].insert^.len := 1  (* empty, slot 0 contains the original token for ease.  *)
   END ;
   RETURN topBucket^.buf[count].insert
END GetInsertBucket ;


(*
   AppendToken - appends desc to the end of the insertionBucket.
*)

PROCEDURE AppendToken (insertionBucket: TokenBucket; desc: TokenDesc) ;
BEGIN
   IF insertionBucket^.len < MaxBucketSize
   THEN
      insertionBucket^.buf[insertionBucket^.len] := desc ;
      INC (insertionBucket^.len)
   END
END AppendToken ;


(*
   InsertToken - inserts a symbol, token, infront of the current token
                 ready for the next pass.
*)

PROCEDURE InsertToken (token: toktype) ;
VAR
   topBucket, insertionBucket: TokenBucket ;
   count : CARDINAL ;
   desc  : TokenDesc ;
BEGIN
   Assert (ListOfTokens.tail # NIL) ;
   count := GetTokenNo () -1 ;
   topBucket := FindTokenBucket (count) ;
   insertionBucket := GetInsertBucket (topBucket, count) ;
   desc := topBucket^.buf[count] ;
   desc.token := token ;
   desc.insert := NIL ;
   AppendToken (insertionBucket, desc) ;
   IF DebugRecover
   THEN
      DumpTokens
   END
END InsertToken ;


(*
   InsertTokenAndRewind - inserts a symbol, token, infront of the current token
                          and then moves the token stream back onto the inserted token.
*)

PROCEDURE InsertTokenAndRewind (token: toktype) ;
VAR
   offset   : CARDINAL ;
   topBucket: TokenBucket ;
BEGIN
   IF GetTokenNo () > 0
   THEN
      InsertToken (token) ;
      offset := CurrentTokNo -2 ;
      topBucket := FindTokenBucket (offset) ;
      InsertionIndex := topBucket^.buf[offset].insert^.len -1 ;
      DEC (CurrentTokNo, 2) ;
      GetToken
   END
END InsertTokenAndRewind ;


(*
   GetPreviousTokenLineNo - returns the line number of the previous token.
*)

PROCEDURE GetPreviousTokenLineNo () : CARDINAL ;
BEGIN
   (*
   IF GetTokenNo()>0
   THEN
      RETURN( TokenToLineNo(GetTokenNo()-1, 0) )
   ELSE
      RETURN( 0 )
   END
      *)
   RETURN GetLineNo ()
END GetPreviousTokenLineNo ;


(*
   GetLineNo - returns the current line number where the symbol occurs in
               the source file.
*)

PROCEDURE GetLineNo () : CARDINAL ;
BEGIN
   IF CurrentTokNo = 0
   THEN
      RETURN 0
   ELSE
      RETURN TokenToLineNo (GetTokenNo (), 0)
   END
END GetLineNo ;


(*
   GetColumnNo - returns the current column where the symbol occurs in
                 the source file.
*)

PROCEDURE GetColumnNo () : CARDINAL ;
BEGIN
   IF CurrentTokNo = 0
   THEN
      RETURN 0
   ELSE
      RETURN TokenToColumnNo (GetTokenNo (), 0)
   END
END GetColumnNo ;


(*
   GetTokenNo - returns the current token number.
*)

PROCEDURE GetTokenNo () : CARDINAL ;
BEGIN
   IF CurrentTokNo = 0
   THEN
      RETURN 0
   ELSE
      RETURN CurrentTokNo-1
   END
END GetTokenNo ;


(*
   GetTokenName - returns the token name given the tokenno.
*)

PROCEDURE GetTokenName (tokenno: CARDINAL) : Name ;
VAR
   b: TokenBucket ;
   n: Name ;
BEGIN
   b := FindTokenBucket (tokenno) ;
   IF b=NIL
   THEN
      RETURN NulName
   ELSE
      WITH b^.buf[tokenno] DO
         n := tokToTok (token) ;
	 IF n=NulName
         THEN
            RETURN str
         ELSE
            RETURN n
         END
      END
   END
END GetTokenName ;


(*
   FindTokenBucket - returns the TokenBucket corresponding to the TokenNo.
*)

PROCEDURE FindTokenBucket (VAR TokenNo: CARDINAL) : TokenBucket ;
VAR
   b: TokenBucket ;
BEGIN
   b := ListOfTokens.head ;
   WHILE b#NIL DO
      WITH b^ DO
         IF TokenNo<len
         THEN
            RETURN b
         ELSE
            DEC (TokenNo, len)
         END
      END ;
      b := b^.next
   END ;
   RETURN NIL
END FindTokenBucket ;


(*
   TokenToLineNo - returns the line number of the current file for the
                   TokenNo. The depth refers to the include depth.
                   A depth of 0 is the current file, depth of 1 is the file
                   which included the current file. Zero is returned if the
                   depth exceeds the file nesting level.
*)

PROCEDURE TokenToLineNo (TokenNo: CARDINAL; depth: CARDINAL) : CARDINAL ;
VAR
   b: TokenBucket ;
   l: SourceList ;
BEGIN
   IF (TokenNo = UnknownTokenNo) OR (TokenNo = BuiltinTokenNo)
   THEN
      RETURN 0
   ELSE
      b := FindTokenBucket (TokenNo) ;
      IF b = NIL
      THEN
         RETURN 0
      ELSE
         IF depth = 0
         THEN
            RETURN b^.buf[TokenNo].line
         ELSE
            l := b^.buf[TokenNo].file^.left ;
            WHILE depth>0 DO
               l := l^.left ;
               IF l=b^.buf[TokenNo].file^.left
               THEN
                  RETURN 0
               END ;
               DEC (depth)
            END ;
            RETURN l^.line
         END
      END
   END
END TokenToLineNo ;


(*
   TokenToColumnNo - returns the column number of the current file for the
                     TokenNo. The depth refers to the include depth.
                     A depth of 0 is the current file, depth of 1 is the file
                     which included the current file. Zero is returned if the
                     depth exceeds the file nesting level.
*)

PROCEDURE TokenToColumnNo (TokenNo: CARDINAL; depth: CARDINAL) : CARDINAL ;
VAR
   b: TokenBucket ;
   l: SourceList ;
BEGIN
   IF (TokenNo = UnknownTokenNo) OR (TokenNo = BuiltinTokenNo)
   THEN
      RETURN 0
   ELSE
      b := FindTokenBucket (TokenNo) ;
      IF b=NIL
      THEN
         RETURN 0
      ELSE
         IF depth = 0
         THEN
            RETURN b^.buf[TokenNo].col
         ELSE
            l := b^.buf[TokenNo].file^.left ;
            WHILE depth>0 DO
               l := l^.left ;
               IF l=b^.buf[TokenNo].file^.left
               THEN
                  RETURN 0
               END ;
               DEC (depth)
            END ;
            RETURN l^.col
         END
      END
   END
END TokenToColumnNo ;


(*
   TokenToLocation - returns the location_t corresponding to, TokenNo.
*)

PROCEDURE TokenToLocation (TokenNo: CARDINAL) : location_t ;
VAR
   b: TokenBucket ;
BEGIN
   IF TokenNo = UnknownTokenNo
   THEN
      RETURN UnknownLocation ()
   ELSIF TokenNo = BuiltinTokenNo
   THEN
      RETURN BuiltinsLocation ()
   ELSE
      b := FindTokenBucket (TokenNo) ;
      IF b=NIL
      THEN
         RETURN UnknownLocation ()
      ELSE
         RETURN b^.buf[TokenNo].loc
      END
   END
END TokenToLocation ;


(*
   FindFileNameFromToken - returns the complete FileName for the appropriate
                           source file yields the token number, TokenNo.
                           The, Depth, indicates the include level: 0..n
                           Level 0 is the current. NIL is returned if n+1
                           is requested.
*)

PROCEDURE FindFileNameFromToken (TokenNo: CARDINAL; depth: CARDINAL) : String ;
VAR
   b: TokenBucket ;
   l: SourceList ;
BEGIN
   b := FindTokenBucket (TokenNo) ;
   IF b=NIL
   THEN
      RETURN NIL
   ELSE
      IF TokenNo = UnknownTokenNo
      THEN
         RETURN NIL
      ELSIF TokenNo = BuiltinTokenNo
      THEN
         RETURN NIL
      ELSE
         l := b^.buf[TokenNo].file^.left ;
         WHILE depth>0 DO
            l := l^.left ;
            IF l=b^.buf[TokenNo].file^.left
            THEN
               RETURN NIL
            END ;
            DEC (depth)
         END ;
         RETURN l^.name
      END
   END
END FindFileNameFromToken ;


(*
   GetFileName - returns a String defining the current file.
*)

PROCEDURE GetFileName () : String ;
BEGIN
   RETURN FindFileNameFromToken (GetTokenNo (), 0)
END GetFileName ;


(*
   AddTokToList - adds a token to a dynamic list.
*)

PROCEDURE AddTokToList (t: toktype; n: Name;
                        i: INTEGER; l: CARDINAL; c: CARDINAL;
                        f: SourceList; location: location_t) ;
BEGIN
   IF ListOfTokens.head=NIL
   THEN
      NEW (ListOfTokens.head) ;
      IF ListOfTokens.head=NIL
      THEN
         (* list error *)
      END ;
      ListOfTokens.tail := ListOfTokens.head ;
      ListOfTokens.tail^.len := 0
   ELSIF ListOfTokens.tail^.len=MaxBucketSize
   THEN
      Assert(ListOfTokens.tail^.next=NIL) ;
      NEW (ListOfTokens.tail^.next) ;
      IF ListOfTokens.tail^.next=NIL
      THEN
         (* list error *)
      ELSE
         ListOfTokens.tail := ListOfTokens.tail^.next ;
         ListOfTokens.tail^.len := 0
      END ;
      INC (ListOfTokens.LastBucketOffset, MaxBucketSize)
   END ;
   WITH ListOfTokens.tail^ DO
      next := NIL ;
      WITH buf[len] DO
         token  := t ;
         str    := n ;
         int    := i ;
         line   := l ;
         col    := c ;
         file   := f ;
         loc    := location ;
         insert := NIL ;
      END ;
      INC (len)
   END
END AddTokToList ;


(*
   IsLastTokenEof - returns TRUE if the last token was an eoftok
*)

PROCEDURE IsLastTokenEof () : BOOLEAN ;
VAR
   b: TokenBucket ;
BEGIN
   IF ListOfTokens.tail#NIL
   THEN
      IF ListOfTokens.tail^.len=0
      THEN
         b := ListOfTokens.head ;
         IF b=ListOfTokens.tail
         THEN
            RETURN FALSE
         END ;
         WHILE b^.next#ListOfTokens.tail DO
            b := b^.next
         END ;
      ELSE
         b := ListOfTokens.tail
      END ;
      WITH b^ DO
         Assert (len>0) ;     (* len should always be >0 *)
         RETURN buf[len-1].token=eoftok
      END
   END ;
   RETURN FALSE
END IsLastTokenEof ;


(*
   PrintTokenNo - displays token and the location of the token.
*)

PROCEDURE PrintTokenNo (tokenno: CARDINAL) ;
VAR
   s: String ;
BEGIN
   printf1 ("tokenno = %d, ", tokenno) ;
   s := InitStringCharStar (KeyToCharStar (GetTokenName (tokenno))) ;
   printf1 ("%s\n", s) ;
   s := KillString (s)
END PrintTokenNo ;


(*
   isSrcToken - returns TRUE if tokenno is associated with
                program source code.
*)

PROCEDURE isSrcToken (tokenno: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN (tokenno # UnknownTokenNo) AND (tokenno # BuiltinTokenNo)
END isSrcToken ;


(*
   MakeVirtualTok - providing caret, left, right are associated with a source file
                    and exist on the same src line then
                    create and return a new tokenno which is created from
                    tokenno range1 and range2.  Otherwise return caret.
*)

PROCEDURE MakeVirtualTok (caret, left, right: CARDINAL) : CARDINAL ;
VAR
   bufLeft, bufRight: TokenBucket ;
   lc, ll, lr       : location_t ;
BEGIN
   IF isSrcToken (caret) AND isSrcToken (left) AND isSrcToken (right)
   THEN
      lc := TokenToLocation (caret) ;
      ll := TokenToLocation (left) ;
      lr := TokenToLocation (right) ;
      bufLeft := FindTokenBucket (left) ;   (* left maybe changed now.  *)
      bufRight := FindTokenBucket (right) ;  (* right maybe changed now.  *)

      IF (bufLeft^.buf[left].line = bufRight^.buf[right].line) AND
         (bufLeft^.buf[left].file = bufRight^.buf[right].file)
      THEN
         (* on the same line, create a new token and location.  *)
         AddTokToList (virtualrangetok, NulName, 0,
                       bufLeft^.buf[left].line, bufLeft^.buf[left].col, bufLeft^.buf[left].file,
                       GetLocationBinary (lc, ll, lr)) ;
         RETURN ListOfTokens.LastBucketOffset + ListOfTokens.tail^.len - 1
      END
   END ;
   RETURN caret
END MakeVirtualTok ;


(* ***********************************************************************
 *
 * These functions allow m2.flex to deliver tokens into the buffer
 *
 ************************************************************************* *)

(*
   AddTok - adds a token to the buffer.
*)

PROCEDURE AddTok (t: toktype) ;
VAR
   s: String ;
BEGIN
   IF t = eoftok
   THEN
      SeenEof := TRUE
   END ;
   IF NOT ((t=eoftok) AND IsLastTokenEof())
   THEN
      AddTokToList(t, NulName, 0,
                   m2flex.GetLineNo(), m2flex.GetColumnNo(), CurrentSource,
                   m2flex.GetLocation()) ;
      CurrentUsed := TRUE ;
      IF Debugging
      THEN
         (* display each token as a warning.  *)
         s := InitStringCharStar (KeyToCharStar (GetTokenName (GetTokenNo ()))) ;
         WarnStringAt (s, GetTokenNo ())
      END
   END
END AddTok ;


(*
   AddTokCharStar - adds a token to the buffer and an additional string, s.
                    A copy of string, s, is made.
*)

PROCEDURE AddTokCharStar (t: toktype; s: ADDRESS) ;
BEGIN
   AddTokToList(t, makekey(s), 0, m2flex.GetLineNo(),
                m2flex.GetColumnNo(), CurrentSource, m2flex.GetLocation()) ;
   CurrentUsed := TRUE
END AddTokCharStar ;


(*
   AddTokInteger - adds a token and an integer to the buffer.
*)

PROCEDURE AddTokInteger (t: toktype; i: INTEGER) ;
VAR
   s: String ;
   c,
   l: CARDINAL ;
BEGIN
   l := m2flex.GetLineNo() ;
   c := m2flex.GetColumnNo() ;
   s := Sprintf1(Mark(InitString('%d')), i) ;
   AddTokToList(t, makekey(string(s)), i, l, c, CurrentSource, m2flex.GetLocation()) ;
   s := KillString(s) ;
   CurrentUsed := TRUE
END AddTokInteger ;


BEGIN
   Init
END M2LexBuf.