-- JaMScanner2Impl.mesa
-- Original version by John Warnock, March 7, 1979
-- Last changed by Paxton, 29-Jan-82 10:08:07
-- Last changed by McGregor, September 10, 1982 11:27 am

DIRECTORY
JaMBasic USING [Object],
JaMInternal USING [Frame, Stack],
JaMOps USING [Error, GetStream, KillStream, Pop, Push,
PushBoolean, StreamToken, StringToken, SubString, Text, typechk],
JaMScanner,
JaMStorage,
JaMVM USING [GetChar, GetText],
Ascii USING [BS, CR, FF, LF, TAB],
Inline USING [BITSHIFT, LongNumber],
Real USING [ReadReal, RealException],
StreamDefs USING [StreamHandle];

-- This program implements a very simple lexical scanner which works in the
-- following way. When the routine "StreamToken" or "StringToken" is called
-- then the first token is returned on the top of stack followed by the
-- remainder of the source at next-on-stack.

JaMScanner2Impl: PROGRAM
IMPORTS JaMOps, JaMScanner, JaMVM, Inline, Real
EXPORTS JaMScanner = {
OPEN VM:JaMVM, JaMScanner, JaMStorage, JaMOps, JaMInternal, JaMBasic;

RemoveEscapes: PUBLIC PROC [text: Text] RETURNS [Text,BOOLEAN] = {
len: CARDINAL ← text.length;
read, write: CARDINAL ← 0;
char: CHARACTER;
error: BOOLEAN ← FALSE;
Get: PROC RETURNS [ch: CHARACTER] = INLINE { ch ← text[read]; read ← read+1 };
WHILE read < len DO
IF (text[write] ← Get[]) = '\\ THEN {
SELECT char ← Get[] FROM
  'n, 'N, 'r, 'R => char ← Ascii.CR;
  't, 'T => char ← Ascii.TAB;
  'b, 'B => char ← Ascii.BS;
  'f, 'F => char ← Ascii.FF;
  'l, 'L => char ← Ascii.LF;
  '\\, '', '" => NULL;
  IN ['0..'3] => {
  d: CARDINAL ← char-'0;
  IF read = len THEN error ← TRUE
  ELSE {
  IF (char ← Get[]) NOT IN ['0..'7] THEN error ← TRUE;
  d ← d*8 + char-'0;
  IF read = len THEN error ← TRUE
  ELSE {
  IF (char ← Get[]) NOT IN ['0..'7] THEN error ← TRUE;
  d ← d*8 + char-'0 }};
  char ← LOOPHOLE[d] };
  ENDCASE => error ← TRUE;
text[write] ← char };
write ← write+1;
ENDLOOP;
text.length ← write;
RETURN [text,error] };

MakeOctal: PUBLIC PROC[text: LONG STRING] RETURNS[Object] = {
val: Inline.LongNumber ← [lc[0]];
neg: BOOLEAN ← FALSE;
i: CARDINAL ← 0;
SELECT text[0] FROM '+ => { i ← 1 }; '- => { neg ← TRUE; i ← 1 }; ENDCASE;
FOR j: CARDINAL IN[i..text.length-1) DO
c: CHARACTER ← text[j];
-- use shifting to multiply by 8
val.high ← Inline.BITSHIFT[val.high,3] + Inline.BITSHIFT[val.low,3-16];
val.low ← Inline.BITSHIFT[val.low,3];
IF c>'0 THEN val.lc ← val.lc + (c-'0);
ENDLOOP;
RETURN[[L,integer[IF neg THEN -val.li ELSE val.li]]];
};

MakeInteger: PUBLIC PROC[text: LONG STRING] RETURNS[Object] = {
val: LONG CARDINAL ← 0;
max: LONG CARDINAL = LAST[LONG CARDINAL];
lim: LONG CARDINAL = max/10; -- lim*10 <= max
int: LONG INTEGER;
neg: BOOLEAN ← FALSE;
i: CARDINAL ← 0;
SELECT text[0] FROM '+ => { i ← 1 }; '- => { neg ← TRUE; i ← 1 }; ENDCASE;
FOR j: CARDINAL IN[i..text.length) WHILE val<max DO
c: CHARACTER ← text[j];
val ← IF val<=lim THEN val*10 ELSE max;
IF c>'0 THEN { d: CARDINAL ← c-'0; val ← IF d<(max-val) THEN val+d ELSE max };
ENDLOOP;
int ← LOOPHOLE[val]; IF neg THEN int ← -int;
IF (int<0)=neg THEN RETURN[[L,integer[int]]] ELSE RETURN[MakeReal[text]];
};

MakeReal: PUBLIC PROC[text: LONG STRING] RETURNS[Object] = {
i: CARDINAL ← 0;
Get: SAFE PROC RETURNS [CHARACTER] = TRUSTED { c: CHARACTER ← Ascii.CR;
IF i<text.length THEN { c ← text[i]; i ← i + 1 }; RETURN[c] };
ob: Object;
{ ENABLE Real.RealException => TRUSTED { ob ← overflow; CONTINUE };
r: REAL ← Real.ReadReal[Get]; ob ← [L,real[r]] };
RETURN[ob];
};

StringToOctal: PUBLIC PROC[string: string Object] RETURNS[Object] = {
text: STRING ← [20];
IF string.length>text.maxlength THEN {
len: CARDINAL = text.maxlength;
VM.GetText[SubString[string,string.length-len,len],text];
text[0] ← VM.GetChar[string,0] } -- preserve sign
ELSE VM.GetText[string,text];
RETURN[MakeOctal[text]];
};

StringToInteger: PUBLIC PROC[string: string Object] RETURNS[Object] = {
text: STRING ← [20];
IF string.length>text.maxlength THEN RETURN[StringToReal[string]]
ELSE { VM.GetText[string,text]; RETURN[MakeInteger[text]] };
};

StringToReal: PUBLIC PROC[string: string Object] RETURNS[Object] = {
i: CARDINAL ← 0;
Get: SAFE PROC RETURNS[CHARACTER] = TRUSTED { c: CHARACTER ← Ascii.CR;
IF i<string.length THEN { c ← VM.GetChar[string,i]; i ← i + 1 }; RETURN[c] };
ob: Object;
{ ENABLE Real.RealException => TRUSTED { ob ← overflow; CONTINUE };
r: REAL ← Real.ReadReal[Get]; ob ← [L,real[r]] };
RETURN[ob];
};

-- One intrinsic

JToken: PUBLIC PROC[frame: Frame] = {
ob: Object ← Pop[frame.opstk];
found,error: BOOLEAN; tok,rem: Object;
WITH ob:ob SELECT FROM
string => [found,error,tok,rem] ← StringToken[frame,ob];
stream => {
s: StreamHandle ← GetStream[ob];
[found,error,tok] ← StreamToken[frame,s];
IF found THEN rem ← ob ELSE KillStream[ob];
};
ENDCASE => ERROR Error[typechk];
IF found THEN { Push[frame.opstk,rem]; Push[frame.opstk,tok] };
PushBoolean[frame.opstk, found];
-- ignores error flag
};

}...