TJaMScanner2Impl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Original version by John Warnock, March 7, 1979
Paxton, 29-Jan-82 10:08:07
McGregor, September 10, 1982 11:27 am
Russ Atkinson, September 26, 1983 1:03 pm
Michael Plass, February 14, 1985 12:51:39 pm PST
Doug Wyatt, March 5, 1985 5:16:08 pm PST
DIRECTORY
Ascii USING [BS, CR, FF, LF, TAB],
Basics USING [BITSHIFT, LongNumber],
Convert USING [Error, RealFromRope],
TJaMBasic USING [Object],
TJaMInternal USING [Frame, Stack],
TJaMOps USING [Error, GetStream, KillStream, Pop, Push, PushBoolean, StreamToken, StringToken, SubString, Text, typechk],
TJaMScanner,
TJaMStorage,
TJaMVM USING [GetChar, GetText],
Real USING [RealException],
Rope USING [ROPE, Translate],
TJaMStreamDefs 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.
TJaMScanner2Impl: PROGRAM
IMPORTS Basics, Convert, TJaMOps, TJaMScanner, TJaMVM, Real, Rope
EXPORTS TJaMScanner = {
OPEN TJaMStorage ;
ROPE: TYPE = Rope.ROPE;
RemoveEscapes: PUBLIC PROC [text: TJaMOps.Text] RETURNS [TJaMOps.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[TJaMBasic.Object] = {
val: Basics.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.highbits ← Basics.BITSHIFT[val.highbits,3] + Basics.BITSHIFT[val.lowbits,3-16];
val.lowbits ← Basics.BITSHIFT[val.lowbits,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[TJaMBasic.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]];
};
StringToRope: PROC
[text: LONG STRING, start: NAT ← 0, len: NAT ← LAST[NAT]] RETURNS [ROPE] = {
IF text = NIL OR text.length = 0 THEN RETURN [NIL];
RETURN [Rope.Translate[LOOPHOLE[text], start, len, NIL]];
};
MakeReal: PUBLIC PROC[text: LONG STRING] RETURNS[TJaMBasic.Object] = {
r: REAL ← Convert.RealFromRope[StringToRope[text]
! Real.RealException, Convert.Error => TRUSTED{GOTO Overflow}];
RETURN[[L, real[r]]];
EXITS Overflow => ERROR TJaMOps.Error[TJaMScanner.overflow];
};
StringToOctal: PUBLIC PROC[string: string TJaMBasic.Object] RETURNS[TJaMBasic.Object] = {
text: STRING ← [20];
IF string.length>text.maxlength THEN {
len: CARDINAL = text.maxlength;
TJaMVM.GetText[TJaMOps.SubString[string,string.length-len,len],text];
text[0] ← TJaMVM.GetChar[string,0]
} -- preserve sign
ELSE TJaMVM.GetText[string,text];
RETURN[MakeOctal[text]];
};
StringToInteger: PUBLIC PROC[string: string TJaMBasic.Object] RETURNS[TJaMBasic.Object] = {
text: STRING ← [20];
IF string.length>text.maxlength THEN RETURN[StringToReal[string]]
ELSE { TJaMVM.GetText[string,text]; RETURN[MakeInteger[text]] };
};
StringToReal: PUBLIC PROC[string: string TJaMBasic.Object] RETURNS[TJaMBasic.Object] = {
s: STRING ← [50];
TJaMVM.GetText[string, s];
RETURN[MakeReal[s]];
};
One intrinsic
JToken: PUBLIC PROC[frame: TJaMInternal.Frame] = {
ob: TJaMBasic.Object ← TJaMOps.Pop[frame.opstk];
found,error: BOOLEAN; tok,rem: TJaMBasic.Object;
WITH ob:ob SELECT FROM
string => [found,error,tok,rem] ← TJaMOps.StringToken[frame,ob];
stream => {
s: TJaMStreamDefs.StreamHandle ← TJaMOps.GetStream[ob];
[found,error,tok] ← TJaMOps.StreamToken[frame,s];
IF found THEN rem ← ob ELSE TJaMOps.KillStream[ob];
};
ENDCASE => ERROR TJaMOps.Error[TJaMOps.typechk];
IF found THEN { TJaMOps.Push[frame.opstk,rem]; TJaMOps.Push[frame.opstk,tok] };
TJaMOps.PushBoolean[frame.opstk, found];
ignores error flag
};
}...