-- file BcdScan.mesa
-- last modified by Satterthwaite, May 25, 1982 11:51 am
-- derived from Compiler>Scanner.mesa
DIRECTORY
Ascii: TYPE USING [BS, ControlZ, CR, FF, LF, NUL, TAB],
CharIO: TYPE USING [PutChar, PutNumber, PutString],
CompilerUtil: TYPE USING [
AcquireStream, AcquireZone, ReleaseStream, ReleaseZone],
Environment: TYPE USING [charsPerWord, charsPerPage, wordsPerPage],
FileStream: TYPE USING [FileByteIndex, EndOf, GetIndex, SetIndex],
P1: TYPE USING [Token, Value, NullValue],
ParseTable: TYPE USING [
HashIndex, HashTableRef, IndexTableRef, ScanTableRef, TableRef, VocabularyRef,
EndMarker, tokenID, tokenSTR],
Stream: TYPE USING [Handle, GetBlock, GetChar],
Strings: TYPE USING [String, SubStringDescriptor, AppendString],
SymbolOps: TYPE USING [EnterString];
Scanner: PROGRAM
IMPORTS
CharIO, CompilerUtil, FileStream, Stream, Strings, SymbolOps
EXPORTS P1 = {
OPEN ParseTable;
zone: UNCOUNTED ZONE ← NIL;
hashTab: HashTableRef;
scanTab: ScanTableRef;
vocab: VocabularyRef;
vocabIndex: IndexTableRef;
stream: Stream.Handle ← NIL; -- the input stream
streamOrigin: FileStream.FileByteIndex;
TextPages: CARDINAL = 6;
TextWords: CARDINAL = TextPages*Environment.wordsPerPage;
TextChars: CARDINAL = TextWords*Environment.charsPerWord;
TextBuffer: TYPE = PACKED ARRAY [0..TextChars) OF CHARACTER;
tB: LONG POINTER TO TextBuffer;
tI, tMax: [0..TextChars];
tOrigin, tLimit: CARDINAL;
tEnded: BOOLEAN;
FillBuffer: PROC = {
tOrigin ← tLimit;
IF tEnded THEN tMax ← 0
ELSE {
tMax ← stream.GetBlock[[tB, 0, TextChars]].bytesTransferred;
IF tMax < TextChars THEN tEnded ← TRUE;
tLimit ← tOrigin + tMax};
IF tMax = 0 THEN {tB[0] ← Ascii.NUL; tMax ← 1};
tI ← 0};
buffer: Strings.String ← NIL; -- token assembly area
iMax: CARDINAL; -- iMax = buffer.maxlength
desc: Strings.SubStringDescriptor; -- initial buffer segment
nTokens: CARDINAL; -- token count
nErrors: CARDINAL; -- lexical errors
BufferOverflow: ERROR = CODE;
ExpandBuffer: PROC = {
oldBuffer: Strings.String ← buffer;
IF oldBuffer.length > 2000 THEN ERROR BufferOverflow;
buffer ← zone.NEW[StringBody[2*oldBuffer.length]];
Strings.AppendString[buffer, oldBuffer];
iMax ← buffer.length ← buffer.maxlength;
zone.FREE[@oldBuffer];
desc.base ← buffer};
char: CHARACTER; -- current (most recently scanned) character
qDot: BOOLEAN; -- used to resolved decimal point vs. interval
NextChar: PROC = { -- also expanded inline within Atom
IF (tI←tI+1) = tMax THEN FillBuffer[]; char ← tB[tI]};
Atom: PUBLIC PROC RETURNS [token: P1.Token] = {
OPEN token;
DO
WHILE char IN [Ascii.NUL..' ] DO
SELECT char FROM
Ascii.NUL => { -- ↑@↑@ is Tioga escape seq
IF (tI←tI+1) = tMax THEN {IF tEnded THEN GO TO EndFile; FillBuffer[]};
char ← tB[tI];
IF char = Ascii.NUL THEN GO TO EndFile};
Ascii.ControlZ => -- ↑Z is Bravo escape char
UNTIL char = Ascii.CR DO
IF (tI←tI+1) = tMax THEN {IF tEnded THEN GO TO EndFile; FillBuffer[]};
char ← tB[tI];
ENDLOOP;
ENDCASE => {
IF (tI←tI+1) = tMax THEN {IF tEnded THEN GO TO EndFile; FillBuffer[]};
char ← tB[tI]};
ENDLOOP;
index ← tOrigin + tI; value ← P1.NullValue;
SELECT char FROM
'a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm,
'n, 'o, 'p, 'q, 'r, 's, 't, 'u, 'v, 'w, 'x, 'y, 'z => {
i: CARDINAL ← 0;
DO
buffer[i] ← char;
IF (tI←tI+1) = tMax THEN FillBuffer[];
char ← tB[tI];
SELECT char FROM
IN ['a..'z], IN ['A..'Z], IN ['0..'9] =>
IF (i ← i+1) >= iMax THEN ExpandBuffer[];
ENDCASE => EXIT;
ENDLOOP;
desc.length ← i+1;
class ← tokenID; value.r ← SymbolOps.EnterString[@desc];
GO TO GotNext};
'A, 'B, 'C, 'D, 'E, 'F, 'G, 'H, 'I, 'J, 'K, 'L, 'M,
'N, 'O, 'P, 'Q, 'R, 'S, 'T, 'U, 'V, 'W, 'X, 'Y, 'Z => {
i: CARDINAL ← 0;
uId: BOOLEAN ← TRUE;
first, last: CARDINAL ← char-0c;
DO
buffer[i] ← char;
IF (tI←tI+1) = tMax THEN FillBuffer[];
char ← tB[tI];
SELECT char FROM
IN ['A..'Z] => {
last ← char-0c; IF (i ← i+1) >= iMax THEN ExpandBuffer[]};
IN ['a..'z], IN ['0..'9] => {
uId ← FALSE; IF (i ← i+1) >= iMax THEN ExpandBuffer[]};
ENDCASE => EXIT;
ENDLOOP;
i ← i+1;
IF uId THEN {
h: HashIndex ← ((first*128-first) + last) MOD LAST[HashIndex] + 1;
j, s1, s2: CARDINAL;
WHILE (j ← hashTab[h].symbol) # 0 DO
IF vocabIndex[j]-(s2←vocabIndex[j-1]) = i THEN
FOR s1 IN [0 .. i) DO
IF buffer[s1] # vocab.text[s2] THEN EXIT;
s2 ← s2+1;
REPEAT
FINISHED => {class ← j; GO TO GotNext};
ENDLOOP;
IF (h ← hashTab[h].link) = 0 THEN EXIT;
ENDLOOP};
desc.length ← i;
class ← tokenID; value.r ← SymbolOps.EnterString[@desc];
GO TO GotNext};
',, ';, ':, '←, '#, '~, '+, '*, '/, '↑, '@, '!,
'(, '), '[, '], '{, '} => {
class ← scanTab[char]; GO TO GetNext};
'" => {
i: CARDINAL ← 0;
valid: BOOLEAN;
advance: BOOLEAN ← TRUE;
DO
IF advance THEN {
IF (tI←tI+1) = tMax THEN {IF tEnded THEN GO TO EOFEnd; FillBuffer[]};
char ← tB[tI]};
SELECT char FROM
'" => {
IF (tI←tI+1) = tMax THEN FillBuffer[];
char ← tB[tI];
IF char # '" THEN GO TO QuoteEnd};
ENDCASE;
IF i >= iMax THEN ExpandBuffer[
! BufferOverflow => {ScanError[string, index]; i ← 0; CONTINUE}];
[buffer[i], valid, advance] ← Escape[]; i ← i+1;
IF ~valid THEN ScanError[escape, tOrigin + tI];
REPEAT
QuoteEnd => NULL;
EOFEnd => {ScanError[string, index]; FillBuffer[]; char ← tB[tI]};
ENDLOOP;
desc.length ← i;
value.r ← SymbolOps.EnterString[@desc];
class ← tokenSTR; GO TO GotNext};
'- => {
NextChar[];
IF char # '- THEN {
class ← scanTab['-];
IF class = 0 THEN ScanError[char, index-1];
GO TO GotNext};
char ← Ascii.NUL;
DO
pChar: CHARACTER = char;
IF (tI←tI+1) = tMax THEN {IF tEnded THEN GO TO EndFile; FillBuffer[]};
char ← tB[tI];
SELECT char FROM
'- => IF pChar = '- THEN EXIT;
Ascii.CR => EXIT;
ENDCASE;
ENDLOOP;
NextChar[]};
ENDCASE => {
class ← scanTab[char];
IF class # 0 THEN GO TO GetNext;
NextChar[];
ScanError[char, index]};
REPEAT
GetNext => {IF (tI←tI+1) = tMax THEN FillBuffer[]; char ← tB[tI]};
GotNext => NULL;
EndFile => {
class ← EndMarker; index ← tOrigin + (tI-1); value ← P1.NullValue;
UNTIL tEnded DO FillBuffer[] ENDLOOP; -- flush stream
FillBuffer[]; char ← tB[tI]};
ENDLOOP;
nTokens ← nTokens + 1;
RETURN};
-- character and string constants
EscapeMark: CHARACTER = 134c; -- '\
Escape: PROC RETURNS [c: CHARACTER, valid, advance: BOOLEAN ← TRUE] = {
c ← char;
IF c = EscapeMark THEN {
NextChar[];
SELECT char FROM
'n, 'N => c ← Ascii.CR;
'r, 'R => c ← Ascii.CR;
'l, 'L => c ← Ascii.LF;
't, 'T => c ← Ascii.TAB;
'b, 'B => c ← Ascii.BS;
'f, 'F => c ← Ascii.FF;
'', '", EscapeMark => c ← char;
IN ['0 .. '7] => {
nc, v: CARDINAL ← 0;
DO
IF ~(char IN ['0..'7]) THEN {valid ← advance ← FALSE; EXIT};
v ← 8*v + (char - '0);
IF (nc ← nc+1) = 3 THEN EXIT;
NextChar[];
ENDLOOP;
IF v > 377b THEN {valid ← FALSE; v ← 0};
c ← v + 0c};
ENDCASE => valid ← advance ← FALSE};
RETURN};
-- initialization/finalization
ScanInit: PUBLIC PROC [table: ParseTable.TableRef] = {
zone ← CompilerUtil.AcquireZone[];
stream ← CompilerUtil.AcquireStream[source];
hashTab ← @table[table.scanTable.hashTab];
scanTab ← @table[table.scanTable.scanTab];
vocab ← LOOPHOLE[@table[table.scanTable.vocabBody]];
vocabIndex ← @table[table.scanTable.vocabIndex];
IF buffer = NIL THEN buffer ← zone.NEW[StringBody[256]];
iMax ← buffer.length ← buffer.maxlength;
desc.base ← buffer; desc.offset ← 0;
streamOrigin ← FileStream.GetIndex[stream];
tB ← zone.NEW[TextBuffer];
tOrigin ← tLimit ← 0; tMax ← 0; tEnded ← FALSE;
FillBuffer[]; char ← tB[tI]; qDot ← FALSE;
nTokens ← nErrors ← 0};
ScanReset: PUBLIC PROC RETURNS [CARDINAL, CARDINAL] = {
CompilerUtil.ReleaseStream[source];
zone.FREE[@tB];
IF buffer # NIL THEN zone.FREE[@buffer];
CompilerUtil.ReleaseZone[zone]; zone ← NIL;
RETURN [nTokens, nErrors]};
-- error handling
StreamIndex: TYPE = FileStream.FileByteIndex;
ResetScanIndex: PUBLIC PROC [index: CARDINAL] RETURNS [success: BOOLEAN] = {
IF ~(index IN [tOrigin .. tLimit)) THEN {
page: CARDINAL = index/Environment.charsPerPage;
tOrigin ← tLimit ← page*Environment.charsPerPage;
tMax ← 0; tEnded ← FALSE;
FileStream.SetIndex[stream, streamOrigin + tOrigin];
FillBuffer[]};
tI ← index - tOrigin;
IF tI >= tMax THEN FillBuffer[]; char ← tB[tI]; RETURN [TRUE]};
ErrorCode: TYPE = {number, string, char, atom, escape};
ScanError: PROC [code: ErrorCode, tokenIndex: CARDINAL] = {
errorStream: Stream.Handle ← CompilerUtil.AcquireStream[log];
nErrors ← nErrors + 1;
ErrorContext[errorStream,
SELECT code FROM
number => "invalid number"L,
string => "string unterminated or too long"L,
char => "invalid character"L,
atom => "invalid atom"L,
escape => "invalid escape sequence"L,
ENDCASE => NIL,
tokenIndex];
CharIO.PutChar[errorStream, Ascii.CR];
CompilerUtil.ReleaseStream[log]};
ErrorContext: PUBLIC PROC [
to: Stream.Handle, message: Strings.String, tokenIndex: CARDINAL] = {
OPEN CharIO;
saveIndex: StreamIndex = FileStream.GetIndex[stream];
origin: StreamIndex = streamOrigin + tokenIndex;
start, lineIndex: StreamIndex ← origin;
char: CHARACTER;
n: [1..100];
FOR n IN [1..100] UNTIL lineIndex = 0 DO
lineIndex ← lineIndex - 1;
FileStream.SetIndex[stream, lineIndex];
IF stream.GetChar[] = Ascii.CR THEN EXIT;
start ← lineIndex;
ENDLOOP;
FileStream.SetIndex[stream, start];
FOR n IN [1..100] UNTIL FileStream.EndOf[stream] DO
char ← stream.GetChar[];
SELECT char FROM
Ascii.CR, Ascii.ControlZ => EXIT;
ENDCASE => PutChar[to, char];
ENDLOOP;
CharIO.PutChar[to, Ascii.CR];
FileStream.SetIndex[stream, start];
UNTIL FileStream.GetIndex[stream] = origin OR FileStream.EndOf[stream] DO
char ← stream.GetChar[];
PutChar[to, IF char = Ascii.TAB THEN Ascii.TAB ELSE ' ];
ENDLOOP;
PutString[to, "↑ "L]; PutString[to, message]; PutString[to, " ["L];
PutNumber[to, tokenIndex, [base:10, zerofill:FALSE, unsigned:TRUE, columns:0]];
PutChar[to, ']]; CharIO.PutChar[to, Ascii.CR];
FileStream.SetIndex[stream, saveIndex]};
}.