<> <> <> <> <> <> <> <> <<>> 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]; <> 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]; <> 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'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]]; }; <> 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]; <> }; }...