(* mcLexBuf.mod provides a buffer for the all the tokens created by m2.lex.
Copyright (C) 2015-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 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.