<> <> <> <> <> DIRECTORY Ascii USING [BS, CR, FF, LF, TAB], Basics USING [BITSHIFT, LongNumber], Convert USING [Error, RealFromRope], 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], Real USING [RealException], Rope USING [ROPE, Translate], StreamDefs USING [StreamHandle]; <> JaMScanner2Impl: PROGRAM IMPORTS Basics, Convert, JaMOps, JaMScanner, JaMVM, Real, Rope EXPORTS JaMScanner = { OPEN VM:JaMVM, JaMScanner, JaMStorage, JaMOps, JaMInternal, JaMBasic; ROPE: TYPE = Rope.ROPE; 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: 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]; <> 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[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'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[Object] = { ob: Object; { ENABLE Real.RealException, Convert.Error => TRUSTED { ob _ overflow; CONTINUE }; r: REAL _ Convert.RealFromRope[StringToRope[text]]; 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] = { s: STRING _ [50]; JaMVM.GetText[string, s]; RETURN[MakeReal[s]]; }; <> 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]; <> }; }...