
<<FILE: M2SImpl.mesa>>
<<Modula-2 Scanner>>
<<Last Edited by: Gutknecht, September 18, 1985 0:28:05 am PDT>>
    <<Satterthwaite December 11, 1985 9:13:25 am PST>>

DIRECTORY
IO: TYPE USING [STREAM, EndOf, GetChar, Put, rope, char, card],
M2S: TYPE USING [IdBufLen, Symbol, NumTyp, CharArray];

M2SImpl : CEDAR PROGRAM 
IMPORTS IO
EXPORTS M2S = 

BEGIN OPEN M2S;

KW: INTEGER = 43; -- number of keywords --
maxCard: CARDINAL = 177777B;
maxDig: CARDINAL = 7;
maxExp: CARDINAL = 38;
maxReal: REAL = 1E38;

IdBufLim: CARDINAL = IdBufLen - 100;

sym: PUBLIC Symbol;
id: PUBLIC CARDINAL;

numtyp: PUBLIC NumTyp;
intval: PUBLIC LONG INTEGER;
dblval: PUBLIC LONG INTEGER;
realval: PUBLIC REAL;
scanerr: PUBLIC BOOL;
source: PUBLIC IO.STREAM;
sourcepos: PUBLIC LONG CARDINAL;

log: PUBLIC IO.STREAM;

IdBuf: PUBLIC REF CharArray _ NEW [CharArray]; -- identifier buffer --

ch: CHAR; --current character
id0, id1: CARDINAL; --indices of id-buffer
keyWds: ARRAY [0..KW] OF
RECORD [sym: Symbol, ind: CARDINAL];

power: ARRAY [0..5] OF REAL _ [1.0E1, 1.0E2, 1.0E4, 1.0E8, 1.0E16, 1.0E32];

InitScanner: PUBLIC PROC =
{ ch _ ' ; sourcepos _ 0; scanerr _ FALSE;
IF id0 = 0 THEN id0 _ id ELSE id _ id0 };

Enter: PUBLIC PROC [name: REF TEXT] RETURNS [CARDINAL] =
{ i: CARDINAL _ id;
id _ id + 1; 
FOR j: CARDINAL _ 0, j + 1 WHILE name [j] # '  DO
IdBuf [id] _ name [j]; id _ id + 1
ENDLOOP;
IdBuf [i] _ '\000 + id-i;
RETURN [i] };

Diff: PUBLIC PROC [i, j: CARDINAL] RETURNS [INTEGER] =
{ k: CARDINAL _ IdBuf[i].ORD;
DO
IF k = 0 THEN RETURN [0];
IF IdBuf[i] # IdBuf[j] THEN
  RETURN [ IdBuf[i].ORD - IdBuf[j].ORD ]
ELSE { i _ i+1; j _ j+1; k _ k-1}
ENDLOOP };

GetCh: PROC = { ch _ source.GetChar; sourcepos _ sourcepos + 1 };

String: PROC [termCh: CHAR] =
{ id1 _ id + 1;
IF id1 > IdBufLim THEN { Mark [91]; id1 _ 1};
DO GetCh;
IF ch = termCh THEN EXIT;
IF ch < '  THEN { Mark [45]; EXIT };
IdBuf [id1] _ ch; id1 _ id1 + 1
ENDLOOP;
GetCh;
IdBuf[id] _ '\000 + id1-id; -- length
IF IdBuf [id]  = '\002 THEN {
sym _ number; numtyp _ char; intval _ IdBuf[id+1].ORD }
ELSE { sym _ string;
IF IdBuf [id]  = '\001 THEN
{ IdBuf[id1] _ '\000; id1 _ id1 + 1; IdBuf[id] _ '\002 }}};

Identifier: PROC =
{ k, l, m, d: INTEGER;
id1 _ id + 1;
IF id1 > IdBufLim THEN { Mark [91]; id1 _ 1 };
DO IdBuf [id1] _ ch; id1 _ id1 + 1;
GetCh;
IF (ch<'0) OR (ch>'9) AND (ch<'A) OR (ch>'Z) AND (ch<'a) OR (ch>'z) THEN EXIT
ENDLOOP;
IdBuf [id] _ '\000 + id1-id; -- length
k _ 0; l _ KW-1;
WHILE l >= k DO
m _ (k + l) / 2;
d _ Diff [keyWds[m].ind, id];
IF d < 0 THEN k _ m + 1 ELSE l _ m - 1
ENDLOOP;
IF Diff [keyWds[k].ind, id] = 0 THEN sym _ keyWds[k].sym
ELSE sym _ ident };

Number: PROC =
{ i, j, l, d, e: CARDINAL;
x, f: REAL;
d1: INTEGER;
neg: BOOL;
lastCh: CHAR;
dig: ARRAY [0..31] OF CHAR;

Ten:  PROC [e: CARDINAL] RETURNS [REAL] =
{ u: REAL _ 1.0;
FOR k: CARDINAL _ 0, k + 1 WHILE e > 0 DO
IF e MOD 2 = 1 THEN u _ power [k] * u;
e _ e/2
ENDLOOP;
RETURN [u] };

sym _ number; i _ 0;
DO dig [i] _ ch; i _ i + 1;
GetCh;
IF (ch<'0) OR (ch>'9) AND (ch<'A) OR (ch>'Z) AND (ch<'a) OR (ch>'z) THEN EXIT
ENDLOOP;
lastCh _ ch; j _ 0;
WHILE (j < i) AND (dig [j] = '0) DO j _ j + 1 ENDLOOP;
IF lastCh = '. THEN { GetCh;
IF ch = '. THEN { lastCh _ '\000; ch _ '\177 -- ellipsis-- }};
IF lastCh = '. THEN -- decimal point --
{ x _ 0.0; l _ 0;
WHILE j < i DO -- read int part --
IF l < maxDig THEN
{ IF dig [j] > '9 THEN Mark [40];
x _ x * 10.0 + (dig [j].ORD - '0.ORD);
l _ l + 1 }
ELSE Mark [41];
j _ j + 1
ENDLOOP;
l _ 0; f _ 0.0;
WHILE ('0 <= ch) AND (ch <= '9) DO -- read fraction
IF l < maxDig THEN {
f _ f*10.0 + (ch.ORD - '0.ORD);
l _ l + 1 };
GetCh;
ENDLOOP;
x _ f / Ten[l] + x; e _ 0; neg _ FALSE;
IF ch = 'E THEN { GetCh;
IF ch = '- THEN { neg _ TRUE; GetCh }
ELSE IF ch = '+ THEN GetCh;
WHILE ('0 <= ch) AND (ch <= '9) DO -- read exponent
e _ e *10 + (ch.ORD - '0.ORD);
GetCh
ENDLOOP };
IF neg THEN
IF e <= maxExp THEN x _ x / Ten[e] ELSE x _ 0.0
ELSE
IF e <= maxExp THEN { f _ Ten[e];
IF maxReal / f >= x THEN x _ f*x ELSE Mark [41] }
ELSE Mark [41];
numtyp _ real; realval _ x }
ELSE -- integer --
{ lastCh _ dig [i-1];
IF lastCh = 'B THEN { i _ i - 1;
numtyp _  cardint; intval _ 0;
WHILE j < i DO
d _ dig[j].ORD - '0.ORD;
IF (d < 8) AND ((maxCard-d) / 8 >= intval) THEN
intval _ intval  * 8 + d
ELSE { Mark [29]; intval _ 0 };
j _ j + 1
ENDLOOP }
ELSE IF lastCh = 'H THEN { i _ i - 1;
IF i <= j+4 THEN
{ numtyp _  cardint; intval _ 0;
WHILE j < i DO
d _ dig[j].ORD - '0.ORD;
IF d > 22 THEN { Mark [29]; d _ 0 }
ELSE IF d > 9 THEN d _ d - 7;
intval _ intval  * 16 + d;
j _ j + 1
ENDLOOP }
ELSE IF i <=  j+8 THEN
{ numtyp _  longint; dblval _ 0;
DO
d _ dig[j].ORD - '0.ORD;
IF d > 22 THEN { Mark [29]; d _ 0 }
ELSE IF d > 9 THEN d _ d - 7;
dblval _ dblval * 16 + d;
j _ j + 1;
IF j = i THEN EXIT
ENDLOOP }
ELSE { Mark [29]; numtyp _  longint }}
ELSE IF lastCh = 'D THEN
{ i _ i - 1; d1 _ 0; numtyp _  longint;
WHILE j < i DO
d1 _ d1 * 10 + (dig[j].ORD - '0.ORD);
j _ j + 1
ENDLOOP;
dblval _ d1 }
ELSE IF lastCh = 'C THEN
{ i _ i - 1; intval _ 0; numtyp _  char;
WHILE j < i DO
d _ dig[j].ORD - '0.ORD;
intval _ intval  * 8 + d;
IF (d >= 8) OR (intval >= 256) THEN { Mark [29]; intval _ 0 };
j _ j + 1
ENDLOOP }
ELSE -- decimal? -- {
numtyp _  cardint; intval _ 0;
WHILE j < i DO
d _ dig[j].ORD - '0.ORD;
IF (d < 10) AND ((maxCard-d) / 10 >= intval) THEN
intval _ intval  * 10 + d
ELSE { Mark [29]; intval _ 0 };
j _ j + 1
ENDLOOP }}};

GetSym: PUBLIC PROC =

{ Comment: PROC = 
{ GetCh;
DO
WHILE (ch # '*) AND (ch # '\000) DO
IF ch = '( THEN { GetCh;
IF ch ='* THEN Comment }
ELSE GetCh
ENDLOOP;
IF ch = '* THEN GetCh ELSE Mark [42]; 
IF (ch = ')) OR (ch = '\000) THEN EXIT
ENDLOOP;
IF ch = ') THEN GetCh };

DO
IF source.EndOf THEN { ch _ ' ; EXIT };
IF (ch <= ' ) OR (ch > '\177) THEN GetCh ELSE EXIT
ENDLOOP;

SELECT ch FROM -- ' <= ch <= '\177
'     => { sym _ eof; ch _ '\000 };
'!    =>    { sym _ null; GetCh };
'"    => String ['"];
'#    => { sym _ neq; GetCh };
'    => { sym _ null; GetCh };
'%    => { sym _ null; GetCh };
'&    => { sym _ and; GetCh };
''    => { String [''] };
'(    => { GetCh;
      IF ch = '* THEN { Comment; GetSym } ELSE sym _ lparen };
')    => { sym _ rparen; GetCh };
'*    => { sym _ times; GetCh };
'+    => { sym _ plus; GetCh };
',    => { sym _ comma; GetCh };
'-    => { sym _ minus; GetCh };
'.    => { GetCh;
      IF ch = '. THEN { GetCh; sym _ ellipsis } ELSE sym _ period };
'/    => { sym _ slash; GetCh };
IN ['0..'9] => Number;
':    => { GetCh;
       IF ch = '= THEN { GetCh; sym _ becomes } ELSE sym _ colon };
';    => { sym _ semicolon; GetCh };
'<    => { GetCh;
       IF ch = '= THEN { sym _ leq; GetCh }
       ELSE
         IF ch = '> THEN { sym _ neq; GetCh } ELSE sym _ lss };
'=    => { sym _ eql;  GetCh };
'>    => { GetCh;
       IF ch = '= THEN { GetCh; sym _ geq } ELSE sym _ gtr };
'?    => { sym _ null; GetCh };
'@    => { sym _ null; GetCh };
IN ['A..'Z] => Identifier;
'[    => { sym _ lbrak; GetCh };
'\\    => { sym _ null; GetCh };
']    => { sym _ rbrak; GetCh };
'^    => { sym _ arrow; GetCh };
'_    => { sym _ becomes; GetCh };
IN ['a..'z] => Identifier;
'{    => {  sym _ lbrace; GetCh };
'|    => { sym _ bar; GetCh };
'}    => { sym _ rbrace; GetCh };
'~    => { sym _ not; GetCh };
'\177 => { sym _ ellipsis; GetCh }
ENDCASE };

KeepId: PUBLIC PROC = { id _ id1 };

Mark: PUBLIC PROC [n: CARDINAL] =
{ IO.Put [log, IO.card[sourcepos], IO.char[' ]];
IO.Put [log, IO.rope["err"], IO.card[n], IO.char[' ]];
scanerr _ TRUE };

<<M2Scanner initialization:>>

{ IdBuf [0] _ '\001; id _ 1; id0 _ 0; ch _ ' ;

keyWds[0].sym _ by; keyWds[0].ind _ Enter ["BY "];
keyWds[1].sym _ do; keyWds[1].ind _ Enter ["DO "];
keyWds[2].sym _ if; keyWds[2].ind _ Enter ["IF "];
keyWds[3].sym _ in; keyWds[3].ind _ Enter ["IN "];
keyWds[4].sym _ of; keyWds[4].ind _ Enter ["OF "];
keyWds[5].sym _ or; keyWds[5].ind _ Enter ["OR "];
keyWds[6].sym _ to; keyWds[6].ind _ Enter ["TO "];
keyWds[7].sym _ and; keyWds[7].ind _ Enter ["AND "];
keyWds[8].sym _ div; keyWds[8].ind _ Enter ["DIV "];
keyWds[9].sym _ end; keyWds[9].ind _ Enter ["END "];
keyWds[10].sym _ for; keyWds[10].ind _ Enter ["FOR "];
keyWds[11].sym _ mod; keyWds[11].ind _ Enter ["MOD "];
keyWds[12].sym _ not; keyWds[12].ind _ Enter ["NOT "];
keyWds[13].sym _ rem; keyWds[13].ind _ Enter ["REM "];
keyWds[14].sym _ set; keyWds[14].ind _ Enter ["SET "];
keyWds[15].sym _ var; keyWds[15].ind _ Enter ["VAR "];
keyWds[16].sym _ case; keyWds[16].ind _ Enter ["CASE "];
keyWds[17].sym _ code; keyWds[17].ind _ Enter ["CODE "];
keyWds[18].sym _ else; keyWds[18].ind _ Enter ["ELSE "];
keyWds[19].sym _ exit; keyWds[19].ind _ Enter ["EXIT "];
keyWds[20].sym _ from; keyWds[20].ind _ Enter ["FROM "];
keyWds[21].sym _ loop; keyWds[21].ind _ Enter ["LOOP "];
keyWds[22].sym _ then; keyWds[22].ind _ Enter ["THEN "];
keyWds[23].sym _ type; keyWds[23].ind _ Enter ["TYPE "];
keyWds[24].sym _ with; keyWds[24].ind _ Enter ["WITH "];
keyWds[25].sym _ array; keyWds[25].ind _ Enter ["ARRAY "];
keyWds[26].sym _ begin; keyWds[26].ind _ Enter ["BEGIN "];
keyWds[27].sym _ const; keyWds[27].ind _ Enter ["CONST "];
keyWds[28].sym _ elsif; keyWds[28].ind _ Enter ["ELSIF "];
keyWds[29].sym _ until; keyWds[29].ind _ Enter ["UNTIL "];
keyWds[30].sym _ while; keyWds[30].ind _ Enter ["WHILE "];
keyWds[31].sym _ export; keyWds[31].ind _ Enter ["EXPORT "];
keyWds[32].sym _ import; keyWds[32].ind _ Enter ["IMPORT "];
keyWds[33].sym _ module; keyWds[33].ind _ Enter ["MODULE "];
keyWds[34].sym _ record; keyWds[34].ind _ Enter ["RECORD "];
keyWds[35].sym _ repeat; keyWds[35].ind _ Enter ["REPEAT "];
keyWds[36].sym _ return; keyWds[36].ind _ Enter ["RETURN "];
keyWds[37].sym _ forward; keyWds[37].ind _ Enter ["FORWARD "];
keyWds[38].sym _ pointer; keyWds[38].ind _ Enter ["POINTER "];
keyWds[39].sym _ procedure; keyWds[39].ind _ Enter ["PROCEDURE "];
keyWds[40].sym _ qualified; keyWds[40].ind _ Enter ["QUALIFIED "];
keyWds[41].sym _ definition; keyWds[41].ind _ Enter ["DEFINITION "];
keyWds[42].sym _ implementation; keyWds[42].ind _ Enter ["IMPLEMENTATION "];
keyWds[43].ind _ Enter [" "] -- sentinel for binary search -- }

END.
