-- 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
  };

}...