(* mcLexBuf.mod provides a buffer for the all the tokens created by m2.lex.

Copyright (C) 2015-2024 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 mcLexBuf ;

IMPORT mcflex ;

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, keyToCharStar ;
FROM mcReserved IMPORT toktype ;
FROM mcComment IMPORT isProcedureComment, isBodyComment, isAfterComment, getContent ;
FROM mcPrintf IMPORT printf0, printf1, printf2, printf3 ;
FROM mcDebug IMPORT assert ;


CONST
   MaxBucketSize = 100 ;
   Debugging     = FALSE ;

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

   tokenDesc = RECORD
                  token: toktype ;
                  str  : Name ;
                  int  : INTEGER ;
		  com  : commentDesc ;
                  line : CARDINAL ;
                  col  : CARDINAL ;
                  file : sourceList ;
               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
   procedureComment,
   bodyComment,
   afterComment     : commentDesc ;
   currentSource    : sourceList ;
   useBufferedTokens,
   currentUsed      : BOOLEAN ;
   listOfTokens     : listDesc ;
   nextTokNo        : CARDINAL ;


(*
   debugLex - display the last, n, tokens.
*)

PROCEDURE debugLex (n: CARDINAL) ;
VAR
   c,
   i, o, t: CARDINAL ;
   b      : tokenBucket ;
BEGIN
   IF nextTokNo > n
   THEN
      o := nextTokNo - n
   ELSE
      o := 0
   END ;
   i := 0 ;
   REPEAT
      t := o + i ;
      IF nextTokNo = t
      THEN
         printf0 ("nextTokNo ")
      END ;
      b := findtokenBucket (t) ;
      IF b = NIL
      THEN
         t := o + i ;
         printf1 ("end of buf  (%d is further ahead than the buffer contents)\n", t)
      ELSE
         c := o + i ;
         printf2 ("entry %d  %d ", c, t) ;
         displayToken (b^.buf[t].token) ;
	 printf0 ("\n") ;
         INC (i)
      END
   UNTIL b = NIL
END debugLex ;


(*
   getProcedureComment - returns the procedure comment if it exists,
                         or NIL otherwise.
*)

PROCEDURE getProcedureComment () : commentDesc ;
BEGIN
   RETURN procedureComment
END getProcedureComment ;


(*
   getBodyComment - returns the body comment if it exists,
                    or NIL otherwise.  The body comment is
                    removed if found.
*)

PROCEDURE getBodyComment () : commentDesc ;
VAR
   b: commentDesc ;
BEGIN
   b := bodyComment ;
   bodyComment := NIL ;
   RETURN b
END getBodyComment ;


(*
   seekTo -
*)

PROCEDURE seekTo (t: CARDINAL) ;
VAR
   b: tokenBucket ;
BEGIN
   nextTokNo := t ;
   IF t > 0
   THEN
      DEC (t) ;
      b := findtokenBucket (t) ;
      IF b = NIL
      THEN
         updateFromBucket (b, t)
      END
   END
END seekTo ;


(*
   peeptokenBucket -
*)

PROCEDURE peeptokenBucket (VAR t: CARDINAL) : tokenBucket ;
VAR
   ct : toktype ;
   old,
   n  : CARDINAL ;
   b, c: tokenBucket ;
BEGIN
   ct := currenttoken ;
   IF Debugging
   THEN
      debugLex (5)
   END ;
   old := getTokenNo () ;
   REPEAT
      n := t ;
      b := findtokenBucket (n) ;
      IF b = NIL
      THEN
         doGetToken ;
         n := t ;
         b := findtokenBucket (n) ;
         IF (b = NIL) OR (currenttoken = eoftok)
         THEN
            (* bailing out.  *)
            nextTokNo := old + 1 ;
            b := findtokenBucket (old) ;
            updateFromBucket (b, old) ;
            RETURN NIL
         END
      END ;
   UNTIL (b # NIL) OR (currenttoken = eoftok) ;
   t := n ;
   nextTokNo := old + 1 ;
   IF Debugging
   THEN
      printf2 ("nextTokNo = %d, old = %d\n", nextTokNo, old)
   END ;
   b := findtokenBucket (old) ;
   IF Debugging
   THEN
      printf1 ("  adjusted old = %d\n", old)
   END ;
   IF b # NIL
   THEN
      updateFromBucket (b, old)
   END ;
   IF Debugging
   THEN
      debugLex (5)
   END ;
   assert (ct = currenttoken) ;
   RETURN b
END peeptokenBucket ;


(*
   peepAfterComment - peeps ahead looking for an after statement comment.  It stops at an END token
                      or if the line number changes.
*)

PROCEDURE peepAfterComment ;
VAR
   oldTokNo,
   t,
   peep,
   cno,
   nextline,
   curline : CARDINAL ;
   b       : tokenBucket ;
   finished: BOOLEAN ;
BEGIN
   oldTokNo := nextTokNo ;
   cno := getTokenNo () ;
   curline := tokenToLineNo (cno, 0) ;
   nextline := curline ;
   peep := 0 ;
   finished := FALSE ;
   REPEAT
      t := cno + peep ;
      b := peeptokenBucket (t) ;
      IF (b = NIL) OR (currenttoken = eoftok)
      THEN
         finished := TRUE
      ELSE
         nextline := b^.buf[t].line ;
	 IF nextline = curline
         THEN
            CASE b^.buf[t].token OF

            eoftok,
            endtok    :  finished := TRUE |
            commenttok:  IF isAfterComment (b^.buf[t].com)
                         THEN
	                    afterComment := b^.buf[t].com
                         END
	    ELSE
	    END
	 ELSE
            finished := TRUE
         END
      END ;
      INC (peep)
   UNTIL finished ;
   seekTo (oldTokNo)
END peepAfterComment ;


(*
   getAfterComment - returns the after comment if it exists,
                     or NIL otherwise.  The after comment is
                     removed if found.
*)

PROCEDURE getAfterComment () : commentDesc ;
VAR
   a: commentDesc ;
BEGIN
   peepAfterComment ;
   a := afterComment ;
   afterComment := NIL ;
   RETURN a
END getAfterComment ;


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

PROCEDURE init ;
BEGIN
   currenttoken := eoftok ;
   nextTokNo := 0 ;
   currentSource := NIL ;
   listOfTokens.head := NIL ;
   listOfTokens.tail := NIL ;
   useBufferedTokens := FALSE ;
   procedureComment := NIL ;
   bodyComment := NIL ;
   afterComment := NIL ;
   lastcomment := NIL
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 := mcflex.getLineNo() ;
      col  := mcflex.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
   IF useBufferedTokens
   THEN
      getToken ;
      RETURN TRUE
   ELSE
      IF mcflex.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 mcflex.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
   nextTokNo := 0 ;
   useBufferedTokens := TRUE
END resetForNewPass ;


(*
   displayToken -
*)

PROCEDURE displayToken (t: toktype) ;
BEGIN
   CASE t OF

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

   ELSE
      printf0 ('unknown tok (--fixme--)\n')
   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
   WITH b^.buf[offset] DO
      currenttoken   := token ;
      currentstring  := keyToCharStar (str) ;
      currentcolumn  := col ;
      currentinteger := int ;
      currentcomment := com ;
      IF currentcomment # NIL
      THEN
         lastcomment := currentcomment
      END ;
      IF Debugging
      THEN
         printf3 ('line %d (# %d  %d) ', line, offset, nextTokNo)
      END
   END
END updateFromBucket ;


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

PROCEDURE getToken ;
BEGIN
   REPEAT
      doGetToken ;
      IF currenttoken = commenttok
      THEN
	 IF isProcedureComment (currentcomment)
	 THEN
            procedureComment := currentcomment ;
            bodyComment := NIL ;
            afterComment := NIL ;
	 ELSIF isBodyComment (currentcomment)
	 THEN
            bodyComment := currentcomment ;
            afterComment := NIL
	 ELSIF isAfterComment (currentcomment)
	 THEN
            procedureComment := NIL ;
            bodyComment := NIL ;
            afterComment := currentcomment
	 END
      END
   UNTIL currenttoken # commenttok
END getToken ;


(*
   doGetToken - fetch the next token into currenttoken.
*)

PROCEDURE doGetToken ;
VAR
   a: ADDRESS ;
   t: CARDINAL ;
   b: tokenBucket ;
BEGIN
   IF useBufferedTokens
   THEN
      t := nextTokNo ;
      b := findtokenBucket (t) ;
      updateFromBucket (b, t)
   ELSE
      IF listOfTokens.tail=NIL
      THEN
         a := mcflex.getToken () ;
         IF listOfTokens.tail=NIL
         THEN
            HALT
         END
      END ;
      IF nextTokNo>=listOfTokens.lastBucketOffset
      THEN
         (* nextTokNo is in the last bucket or needs to be read.  *)
         IF nextTokNo-listOfTokens.lastBucketOffset<listOfTokens.tail^.len
         THEN
            IF Debugging
            THEN
               printf0 ('fetching token from buffer (updateFromBucket)\n')
            END ;
            updateFromBucket (listOfTokens.tail,
                              nextTokNo-listOfTokens.lastBucketOffset)
         ELSE
            IF Debugging
            THEN
               printf0 ('calling flex to place token into buffer\n')
            END ;
            (* call the lexical phase to place a new token into the last bucket.  *)
            a := mcflex.getToken () ;
            getToken ; (* and call ourselves again to collect the token from bucket.  *)
            RETURN
         END
      ELSE
         IF Debugging
         THEN
            printf0 ('fetching token from buffer\n')
         END ;
         t := nextTokNo ;
         b := findtokenBucket (t) ;
         updateFromBucket (b, t)
      END
   END ;
   IF Debugging
   THEN
      displayToken (currenttoken)
   END ;
   INC (nextTokNo)
END doGetToken ;


(*
   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
         nextTokNo := listOfTokens.lastBucketOffset+len
      END
   END
END syncOpenWithBuffer ;


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

PROCEDURE insertToken (token: toktype) ;
BEGIN
   IF listOfTokens.tail#NIL
   THEN
      WITH listOfTokens.tail^ DO
         IF len>0
         THEN
            buf[len-1].token := token
         END
      END ;
      addTokToList (currenttoken, NulName, 0, NIL,
                    getLineNo (), getColumnNo (), currentSource) ;
      getToken
   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) ;
BEGIN
   IF listOfTokens.tail#NIL
   THEN
      WITH listOfTokens.tail^ DO
         IF len>0
         THEN
            buf[len-1].token := token
         END
      END ;
      addTokToList (currenttoken, NulName, 0, NIL,
                    getLineNo(), getColumnNo(), currentSource) ;
      currenttoken := token
   END
END insertTokenAndRewind ;


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

PROCEDURE getPreviousTokenLineNo () : CARDINAL ;
BEGIN
   RETURN getLineNo()
END getPreviousTokenLineNo ;


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

PROCEDURE getLineNo () : CARDINAL ;
BEGIN
   IF nextTokNo=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 nextTokNo=0
   THEN
      RETURN 0
   ELSE
      RETURN tokenToColumnNo (getTokenNo (), 0)
   END
END getColumnNo ;


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

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


(*
   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
   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 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
   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 tokenToColumnNo ;


(*
   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
      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 findFileNameFromToken ;


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

PROCEDURE getFileName () : String ;
BEGIN
   RETURN findFileNameFromToken (getTokenNo (), 0)
END getFileName ;


PROCEDURE stop ; BEGIN END stop ;


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

PROCEDURE addTokToList (t: toktype; n: Name;
                        i: INTEGER; comment: commentDesc;
			l: CARDINAL; c: CARDINAL; f: sourceList) ;
VAR
   b: tokenBucket ;
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 ;
      assert (len # MaxBucketSize) ;
      WITH buf[len] DO
         token := t ;
         str   := n ;
         int   := i ;
	 com   := comment ;
         line  := l ;
         col   := c ;
         file  := f
      END ;
      INC (len)
   END
END addTokToList ;


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

PROCEDURE isLastTokenEof () : BOOLEAN ;
VAR
   t: CARDINAL ;
   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 ;


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

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

PROCEDURE addTok (t: toktype) ;
BEGIN
   IF NOT ((t=eoftok) AND isLastTokenEof())
   THEN
      addTokToList (t, NulName, 0, NIL,
                    mcflex.getLineNo (), mcflex.getColumnNo (), currentSource) ;
      currentUsed := TRUE
   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
   IF strlen(s)>80
   THEN
      stop
   END ;
   addTokToList (t, makekey (s), 0, NIL,
		 mcflex.getLineNo (), mcflex.getColumnNo (), currentSource) ;
   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 := mcflex.getLineNo () ;
   c := mcflex.getColumnNo () ;
   s := Sprintf1 (Mark (InitString ('%d')), i) ;
   addTokToList (t, makekey(string(s)), i, NIL, l, c, currentSource) ;
   s := KillString (s) ;
   currentUsed := TRUE
END addTokInteger ;


(*
   addTokComment - adds a token to the buffer and a comment descriptor, com.
*)

PROCEDURE addTokComment (t: toktype; com: commentDesc) ;
BEGIN
   addTokToList (t, NulName, 0, com,
		 mcflex.getLineNo (), mcflex.getColumnNo (), currentSource) ;
   currentUsed := TRUE
END addTokComment ;


BEGIN
   init
END mcLexBuf.