<> <> <> <> 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] = { log.Put [IO.card[sourcepos], IO.char[' ]]; log.Put [IO.rope["err"], IO.card[n], IO.char[' ]]; scanerr _ TRUE }; <> { 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.