
    <<Scanner.mesa>>
        <<Copyright  1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, June 17, 1986 2:26:36 pm PDT>>
        <<Paul Rovner, September 22, 1983 3:48 pm>>
        <<Russ Atkinson (RRA) March 6, 1985 10:34:00 pm PST>>

    DIRECTORY
        Ascii: TYPE USING [BS, CR, FF, LF, TAB],
        ConvertUnsafe: TYPE USING [SubString],
        Host: TYPE MachineParms USING [bitsPerWord, bitsPerChar],
        IO: TYPE USING [
            card, EndOf, GetChar, GetIndex, Put, PutChar, rope, SetIndex, STREAM, UnsafeGetBlock],
        LiteralOps: TYPE USING [Find, FindString],
        P1: TYPE USING [Index, Token, Value, nullValue],
        ParseTable: TYPE USING [
            HashIndex, HashTableRef, IndexTableRef, ScanTableRef, TableRef, TSymbol, VocabularyRef,
             endMarker, tokenARROW, tokenATOM, tokenCHAR, tokenDOT, tokenDOTS, tokenEQUAL,
             tokenGE, tokenGREATER, tokenID, tokenLE, tokenLESS, tokenFLNUM, tokenLNUM,
             tokenLSTR, tokenMINUS, tokenNE, tokenNUM, tokenSTR, tokenTILDE],
        Real: TYPE USING [RealException, PairToReal],
        RefText: TYPE USING [Append],
        Rope: TYPE USING [ROPE],
        SymbolOps: TYPE USING [EnterString],
        Target: TYPE MachineParms USING [maxChar, maxLongWord, maxWord],
        VM: TYPE USING [wordsPerPage];


    Scanner: PROGRAM
        IMPORTS IO, LiteralOps, Real, RefText, SymbolOps 
        EXPORTS P1 = {
        OPEN ParseTable;

    <<table installation>>

        tablePtr: ParseTable.TableRef;
        hashTab: HashTableRef;
        scanTab: ScanTableRef;
        vocab: VocabularyRef;
        vocabIndex: IndexTableRef;

        InstallScanTable: PUBLIC PROC[base: ParseTable.TableRef] = {
            tablePtr _ base;
            hashTab _ @tablePtr[tablePtr.scanTable.hashTab];
            scanTab _ @tablePtr[tablePtr.scanTable.scanTab];
            vocab _ LOOPHOLE[@tablePtr[tablePtr.scanTable.vocabBody]];
            vocabIndex _ @tablePtr[tablePtr.scanTable.vocabIndex]};


    <<scanner state>>

        stream: IO.STREAM _ NIL;        -- the input stream
        streamOrigin: P1.Index; -- FileStream.FileByteIndex

        Logger: PROC[PROC [log: IO.STREAM]] _ NIL;

        charsPerWord: NAT ~ Host.bitsPerWord/Host.bitsPerChar;
        charsPerPage: NAT ~ charsPerWord*VM.wordsPerPage;

        textPages: NAT ~ 6;
        textWords: NAT ~ textPages*VM.wordsPerPage;
        textChars: NAT ~ textWords*charsPerWord;
        TextBuffer: TYPE ~ PACKED ARRAY [0..textChars) OF CHAR;

        tB: REF TextBuffer;
        tI, tMax: [0..textChars];
        tOrigin, tLimit: P1.Index;
        tEnded: BOOL;


        FillBuffer: PROC ~ {
            tOrigin _ tLimit;
            IF tEnded THEN tMax _ 0
            ELSE {
                tMax _ stream.UnsafeGetBlock[[LOOPHOLE[tB], 0, textChars]].nBytesRead;
                IF tMax < textChars THEN tEnded _ TRUE;
                tLimit _ tOrigin + tMax};
            IF tMax = 0 THEN {tB[0] _ '\000; tMax _ 1};
            tI _ 0};


        buffer: REF TEXT _ NIL;        -- token assembly area
        iMax: CARDINAL;        -- iMax = buffer.maxLength
        desc: ConvertUnsafe.SubString;    -- initial buffer segment

        nTokens: NAT;                -- token count
        nErrors: NAT;                -- lexical errors

        BufferOverflow: ERROR ~ CODE;

        ExpandBuffer: PROC ~ {
            oldBuffer: REF TEXT _ buffer;
            IF oldBuffer.length > 2000 THEN ERROR BufferOverflow;
            buffer _ NEW[TEXT[2*buffer.length]];
            desc.base _ LOOPHOLE[buffer, LONG POINTER];
            buffer _ RefText.Append[to~buffer, from~oldBuffer];
            iMax _ buffer.length _ buffer.maxLength};


        char: CHAR;        -- current (most recently scanned) character
        qDot: BOOL;        -- used to resolved decimal point vs. interval

        NextChar: PROC ~ {    -- also expanded inline within Atom
            IF (tI_tI+1) = tMax THEN FillBuffer[]; char _ tB[tI]};


        NextToken: PUBLIC PROC RETURNS[token: P1.Token] ~ {
            OPEN token;
            DO
                WHILE char IN ['\000..' ] DO
                    SELECT char FROM
                        '\000 => {        -- ^@^@ is Tioga escape seq
                            IF (tI_tI+1) = tMax THEN {IF tEnded THEN GO TO EndFile; FillBuffer[]};
                            char _ tB[tI];
                            IF char = '\000 THEN GO TO EndFile};
                        ENDCASE => {
                            IF (tI_tI+1) = tMax THEN {IF tEnded THEN GO TO EndFile; FillBuffer[]};
                            char _ tB[tI]};
                    ENDLOOP;
                index _ tOrigin + tI;  value _ P1.nullValue;
                SELECT char FROM

                    'a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm,
                    'n, 'o, 'p, 'q, 'r, 's, 't, 'u, 'v, 'w, 'x, 'y, 'z  => {
                        i: CARDINAL _ 0;
                        DO
                            buffer[i] _ char;
                            IF (tI_tI+1) = tMax THEN FillBuffer[];
                            char _ tB[tI];
                            SELECT char FROM
                                IN ['a..'z], IN ['A..'Z], IN ['0..'9] =>
                                    IF (i _ i+1) >= iMax THEN ExpandBuffer[];
                                ENDCASE => EXIT;
                            ENDLOOP;
                        desc.length _ i+1;
                        class _ tokenID;  value.r _ SymbolOps.EnterString[desc];
                        GO TO GotNext};

                    'A, 'B, 'C, 'D, 'E, 'F, 'G, 'H, 'I, 'J, 'K, 'L, 'M,
                    'N, 'O, 'P, 'Q, 'R, 'S, 'T, 'U, 'V, 'W, 'X, 'Y, 'Z  => {
                        i: CARDINAL _ 0;
                        uId: BOOL _ TRUE;
                        first, last: NAT _ char.ORD;
                        DO
                            buffer[i] _ char;
                            IF (tI_tI+1) = tMax THEN FillBuffer[];
                            char _ tB[tI];
                            SELECT char FROM
                                IN ['A..'Z] => {
                                    last _ char.ORD; IF (i _ i+1) >= iMax THEN ExpandBuffer[]};
                                IN ['a..'z], IN ['0..'9] => {
                                    uId _ FALSE; IF (i _ i+1) >= iMax THEN ExpandBuffer[]};
                                ENDCASE => EXIT;
                            ENDLOOP;
                        i _ i+1;
                        IF uId THEN {
                            h: HashIndex _ ((first*128-first) + last) MOD HashIndex.LAST + 1;
                            j, s1, s2: CARDINAL;
                            WHILE (j _ hashTab[h].symbol) # 0 DO
                                IF vocabIndex[j]-(s2_vocabIndex[j-1]) = i THEN
                                    FOR s1 IN [0 .. i) DO
                                        IF buffer[s1] # vocab.text[s2] THEN EXIT;
                                        s2 _ s2+1;
                                        REPEAT
                                            FINISHED => {class _ j; GO TO GotNext};
                                        ENDLOOP;
                                IF (h _ hashTab[h].link) = 0 THEN EXIT;
                                ENDLOOP};
                        desc.length _ i;
                        class _ tokenID;  value.r _ SymbolOps.EnterString[desc];
                        GO TO GotNext};

                    '0, '1, '2, '3, '4, '5, '6, '7, '8, '9  => {
                        valid: BOOL;
                        [class, value, valid] _ CollectNumber[i~0];
                        IF ~valid THEN ScanError[$number, index];
                        GO TO GotNext};

                    ',, ';, ':, '_, '#, '+, '*, '/, '^, '@, '!,
                    '(, '), '[, '], '{, '}  => {
                        class _ scanTab[char]; GO TO GetNext};

                    '' => {
                        c: CHAR;
                        valid, advance: BOOL;
                        NextChar[];
                        [c, valid, advance] _ Escape[];
                        IF ~valid THEN ScanError[$escape, index + 1];
                        class _ tokenCHAR;  value.r _ LiteralOps.Find[c.ORD];
                        IF advance THEN GO TO GetNext ELSE GO TO GotNext};

                    '" => {
                        i: CARDINAL _ 0;
                        valid: BOOL;
                        advance: BOOL _ TRUE;
                        DO 
                            IF advance THEN {
                                IF (tI_tI+1) = tMax THEN {IF tEnded THEN GO TO EOFEnd; FillBuffer[]};
                                char _ tB[tI]};
                            SELECT char FROM
                                '" => {
                                    IF (tI_tI+1) = tMax THEN FillBuffer[];
                                    char _ tB[tI];
                                    IF char # '" THEN GO TO QuoteEnd};
                                ENDCASE;
                            IF i >= iMax THEN ExpandBuffer[
                                ! BufferOverflow => {ScanError[$string, index]; i _ 0; CONTINUE}];
                            [buffer[i], valid, advance] _ Escape[];  i _ i+1;
                            IF ~valid THEN ScanError[$escape, tOrigin + tI];
                            REPEAT
                                QuoteEnd => NULL;
                                EOFEnd => {ScanError[$string, index]; FillBuffer[]; char _ tB[tI]};
                            ENDLOOP;
                        desc.length _ i;
                        value.r _ LiteralOps.FindString[desc];
                        IF char = 'l OR char = 'L THEN {class _ tokenLSTR; GO TO GetNext}
                        ELSE {class _ tokenSTR; GO TO GotNext}};

                    '$ => {
                        i: CARDINAL;
                        i _ 0;  NextChar[];
                        SELECT char FROM
                            IN ['a..'z], IN ['A..'Z] => NULL;
                            ENDCASE => ScanError[$atom, index];
                        DO 
                            SELECT char FROM
                                IN ['a..'z], IN ['A..'Z], IN ['0..'9] => {
                                    IF i >= iMax THEN ExpandBuffer[]; buffer[i] _ char; i _ i+1};
                                ENDCASE => EXIT;
                            NextChar[];
                            ENDLOOP;
                        desc.length _ i;
                        class _ tokenATOM;  value.r _ SymbolOps.EnterString[desc];
                        GO TO GotNext};

                    '- => {
                        NextChar[];
                        IF char # '- THEN {class _ tokenMINUS; GO TO GotNext};
                        char _ '\000;
                        DO
                            pChar: CHAR ~ char;
                            IF (tI_tI+1) = tMax THEN {IF tEnded THEN GO TO EndFile;  FillBuffer[]};
                            char _ tB[tI];
                            SELECT char FROM
                                '- => IF pChar = '- THEN EXIT;
                                '\n => EXIT;
                                ENDCASE;
                            ENDLOOP;
                        NextChar[]};

                    '. => {
                        IF qDot THEN {
                            qDot _ FALSE; index _ index-1; class _ tokenDOTS; GO TO GetNext};
                        NextChar[];
                        SELECT char FROM
                            '. => {class _ tokenDOTS; GO TO GetNext};
                            IN ['0..'9] => {
                                valid: BOOL;
                                buffer[0] _ '.;
                                [class, value, valid] _ CollectNumber[i~1, float~TRUE];
                                IF ~valid THEN ScanError[$number, index];
                                GO TO GotNext};
                            ENDCASE => {class _ tokenDOT; GO TO GotNext}};

                    '= => {
                        NextChar[];
                        IF char = '> THEN {class _ tokenARROW; GO TO GetNext}
                        ELSE {class _ tokenEQUAL; GO TO GotNext}};

                    '< => {
                        NextChar[];
                        IF char = '= THEN {class _ tokenLE; GO TO GetNext}
                        ELSE {class _ tokenLESS; GO TO GotNext}};

                    '> => {
                        NextChar[];
                        IF char = '= THEN {class _ tokenGE; GO TO GetNext}
                        ELSE {class _ tokenGREATER; GO TO GotNext}};

                    '~ => {
                        NextChar[];
                        SELECT char FROM
                            '= => {class _ tokenNE; GO TO GetNext};
                            '< => {class _ tokenGE; GO TO GetNext};
                            '> => {class _ tokenLE; GO TO GetNext}
                            ENDCASE => {class _ tokenTILDE; GO TO GotNext}};

                    '\254 => {    --  in the Xerox Character Code Standard
                        class _ scanTab['_]; GO TO GetNext};

                    '\255 => {    --  in the Xerox Character Code Standard
                        class _ scanTab['^]; GO TO GetNext};

                    ENDCASE => {
                        class _ scanTab[char];
                        IF class # 0 THEN GO TO GetNext;
                        NextChar[];
                        ScanError[$char, index]};

                REPEAT
                    GetNext => {IF (tI_tI+1) = tMax THEN FillBuffer[]; char _ tB[tI]};
                    GotNext => NULL;
                    EndFile => {
                        class _ endMarker;  index _ tOrigin + (tI-1);  value _ P1.nullValue;
                        UNTIL tEnded DO FillBuffer[] ENDLOOP;        -- flush stream
                        FillBuffer[];  char _ tB[tI]};
                ENDLOOP;
            nTokens _ nTokens + 1;
            RETURN};


    <<numerical conversion>>

        LongLit: TYPE ~ LONG UNSPECIFIED;
        endMark: CHAR ~ '\000;

        CollectNumber: PROC[i: CARDINAL, float: BOOL_FALSE]
              RETURNS[class: TSymbol, value: P1.Value, valid: BOOL] ~ {
            hexCount: NAT _ 0;
            hexSig: PACKED ARRAY CHAR['a..'h] OF {F, T} _ ALL[F];
            v: LongLit;

            Accept: PROC ~ INLINE {
                buffer[i] _ char;
                IF (i _ i+1) >= iMax THEN ExpandBuffer[];
                NextChar[]};

            class _ tokenLNUM;
            DO
                SELECT char FROM
                    IN ['0..'9] => Accept[];
                    'e, 'E => {
                        hexSig['e] _ T; hexCount _ hexCount + 1;  Accept[];
                        IF hexCount = 1 AND char = '+ OR char = '- THEN {
                            float _ TRUE; Accept[]}};
                    IN ['a..'f] => {hexSig[char] _ T; hexCount _ hexCount+1;  Accept[]};
                    IN ['A..'F] => {
                        hexSig[char+('a-'A)] _ T; hexCount _ hexCount+1;  Accept[]};
                    'h, 'H => {hexSig['h] _ T; hexCount _ hexCount+1;  Accept[]};
                    '. => {
                        IF hexCount # 0 OR float THEN EXIT;
                        NextChar[];
                        IF char = '. THEN {qDot _ TRUE; EXIT};
                        float _ TRUE;
                        buffer[i] _ '.;
                        IF (i _ i+1) >= iMax THEN ExpandBuffer[]};
                    ENDCASE => EXIT;
                ENDLOOP;
            buffer[i] _ endMark;
            SELECT TRUE FROM
                float => {class _ tokenFLNUM; [v, valid] _ ScanFloating[buffer]};
                (hexSig['h] = T) => [v, valid] _ ScanHex[buffer];
                ENDCASE =>
                    SELECT hexCount FROM
                        0 => [v, valid] _ ScanDecimal[buffer];
                        1 =>
                            SELECT hexSig FROM
                                [F,T,F,F,F,F,F,F] => [v, valid] _ ScanOctal[buffer];
                                [F,F,T,F,F,F,F,F] => {
                                    class _ tokenCHAR;
                                    [v, valid] _ ScanOctalChar[buffer]};
                                [F,F,F,T,F,F,F,F] => [v, valid] _ ScanDecimal[buffer];
                                [F,F,F,F,T,F,F,F] => {
                                    class _ tokenFLNUM;
                                    [v, valid] _ ScanFloating[buffer]};
                            ENDCASE => [v, valid] _ ScanHex[buffer];
                        ENDCASE => [v, valid] _ ScanHex[buffer];
            SELECT class FROM
                tokenCHAR => value _ EnterLit[v];
                tokenFLNUM => value _ EnterLit[v];
                ENDCASE => {
                    SELECT LOOPHOLE[v, CARD] FROM
                        <= Target.maxWord => class _ tokenNUM;
                        >  Target.maxLongWord => valid _ FALSE;
                        ENDCASE;
                    value _ EnterLit[v]};
            RETURN};

        Digit: ARRAY CHAR ['0..'9] OF [0..9] ~ [0,1,2,3,4,5,6,7,8,9];
        HexDigit: ARRAY CHAR ['A..'F] OF [0..15] ~ [10,11,12,13,14,15];

        <<the following 5 procs assume that the host CARD is good for at least 32 bits>>

        AppendDecimal: PROC[v: CARD, digit: CHAR ['0..'9]] RETURNS[newV: CARD, valid: BOOL] ~ {
            maxV: CARD ~ 429496729;    -- (2**32-1)/10
            maxD: NAT ~ 5;        -- (2**32-1) MOD 10
            d: [0..9] ~ Digit[digit];
            valid _ v < maxV OR (v = maxV AND d <= maxD);
            newV _ 10*v + d;
            RETURN};

        AppendOctal: PROC[v: CARD, digit: CHAR ['0..'7]] RETURNS[newV: CARD, valid: BOOL] ~ {
            maxV: CARD ~ 3777777777b;    -- (2**32-1)/8
            d: [0..7] ~ Digit[digit];
            valid _ (v <= maxV);
            newV _ 8*v + d;
            RETURN};

        AppendHex: PROC[v: CARD, digit: CHAR ['0..'F]] RETURNS[newV: CARD, valid: BOOL] ~ {
            maxV: CARD ~ 0FFFFFFFh;    -- (2**32-1)/16
            d: [0..15] ~ IF digit IN ['0..'9] THEN Digit[digit] ELSE HexDigit[digit];
            valid _ (v <= maxV);
            newV _ 16*v + d;
            RETURN};

        AppendToScale: PROC[v: CARDINAL, digit: CHAR ['0..'9]]
              RETURNS[newV: CARDINAL, valid: BOOL] ~ {
            maxV: NAT ~ 6553;        -- (2**16-1)/10
            maxD: NAT ~ 5;        -- (2**16-1) MOD 10
            d: [0..9] ~ Digit[digit];
            valid _ v < maxV OR (v = maxV AND d <= maxD);
            newV _ 10*v + d;
            RETURN};

        ValidFraction: PROC[v: CARD, digit: CHAR ['0..'9]] RETURNS[BOOL] ~ {
            maxV: CARD ~ 214748364;    -- (2**31-1)/10
            maxD: NAT ~ 7;        -- (2**31-1) MOD 10
            RETURN[v < maxV OR (v = maxV AND Digit[digit] <= maxD)]};


        ScanDecimal: PROC[s: REF TEXT] RETURNS[value: LongLit, valid: BOOL_TRUE] ~ {
            c: CHAR;
            i: CARDINAL _ 0;
            v: CARD _ 0;
            IF s[i] NOT IN ['0..'9] THEN valid _ FALSE;
            WHILE (c _ s[i]) IN ['0..'9] DO
                IF valid THEN [v, valid] _ AppendDecimal[v, c];
                i _ i+1;
                ENDLOOP;
            IF c = 'd OR c = 'D THEN {
                scale: CARDINAL _ 0;
                WHILE (c _ s[i_i+1]) IN ['0..'9] DO
                    IF valid THEN [scale, valid] _ AppendToScale[scale, c];
                    ENDLOOP;
                THROUGH [1 .. scale] WHILE valid DO
                    [v, valid] _ AppendDecimal[v, '0] ENDLOOP
                };
            IF c # endMark THEN valid _ FALSE;
            value _ v;
            RETURN};

        ScanOctal: PROC[s: REF TEXT] RETURNS[value: LongLit, valid: BOOL_TRUE] ~ {
            c: CHAR;
            i: CARDINAL _ 0;
            v: CARD _ 0;
            IF s[i] NOT IN ['0..'7] THEN valid _ FALSE;
            WHILE (c _ s[i]) IN ['0..'7] DO
                IF valid THEN [v, valid] _ AppendOctal[v, c];
                i _ i+1;
                ENDLOOP;
            IF c = 'b OR c = 'B THEN {
                scale: CARDINAL _ 0;
                WHILE (c _ s[i_i+1]) IN ['0..'9] DO
                    IF valid THEN [scale, valid] _ AppendToScale[scale, c];
                    ENDLOOP;
                THROUGH [1 .. scale] WHILE valid DO
                    [v, valid] _ AppendOctal[v, '0] ENDLOOP};
            IF c # endMark THEN valid _ FALSE;
            value _ v;
            RETURN};

        ScanOctalChar: PROC[s: REF TEXT] RETURNS[value: LongLit, valid: BOOL_TRUE] ~ {
            c: CHAR;
            i: CARDINAL _ 0;
            v: CARD _ 0;
            IF s[i] NOT IN ['0..'7] THEN valid _ FALSE;
            WHILE (c _ s[i]) IN ['0..'7] DO
                IF valid THEN [v, valid] _ AppendOctal[v, c];
                i _ i+1;
                ENDLOOP;
            IF c = 'c OR c = 'C THEN c _ s[i_i+1] ELSE valid _ FALSE;
            IF c # endMark OR v NOT IN [0 .. Target.maxChar] THEN valid _ FALSE;
            value _ v;
            RETURN};

        ScanHex: PROC[s: REF TEXT] RETURNS[value: LongLit, valid: BOOL_TRUE] ~ {
            c: CHAR;
            i: CARDINAL _ 0;
            v: CARD _ 0;
            IF s[i] NOT IN ['0..'9] THEN valid _ FALSE;
            DO
                SELECT (c _ s[i]) FROM
                    IN ['0..'9], IN ['A..'F] =>
                        IF valid THEN [v, valid] _ AppendHex[v, c];
                    IN ['a..'f] =>
                        IF valid THEN [v, valid] _ AppendHex[v, VAL[(c.ORD-'a.ORD)+'A.ORD]];
                    ENDCASE => EXIT;
                i _ i + 1;
                ENDLOOP;
            IF c = 'h OR c = 'H THEN {
                scale: CARDINAL _ 0;
                WHILE (c _ s[i_i+1]) IN ['0..'9] DO
                    IF valid THEN [scale, valid] _ AppendToScale[scale, c];
                    ENDLOOP;
                THROUGH [1 .. scale] WHILE valid DO
                    [v, valid] _ AppendHex[v, '0] ENDLOOP};
            IF c # endMark THEN valid _ FALSE;
            value _ v;
            RETURN};

        ScanFloating: PROC[s: REF TEXT] RETURNS[value: LongLit, valid: BOOL_TRUE] ~ {
            <<assumes that a REAL (32 bit IEEE floating point value) has its bits mapped into storage the same way as a 32 bit unsigned integer 
            and can be read/stored consistently as a CARD >>
            c: CHAR;
            i: CARDINAL _ 0;
            v: CARD _ 0;
            exp: INTEGER _ 0;
            WHILE (c _ s[i]) IN ['0..'9] DO
                valid _ valid AND ValidFraction[v, c];
                IF valid THEN v _ AppendDecimal[v, c].newV
                ELSE exp _ exp + 1;    -- should round
                i _ i+1;
                ENDLOOP;
            IF c = '. THEN {
                i _ i+1;
                IF s[i] NOT IN ['0..'9] THEN valid _ FALSE;
                WHILE (c _ s[i]) IN ['0..'9] DO
                    valid _ valid AND ValidFraction[v, c];
                    IF valid THEN {[v, valid] _ AppendDecimal[v, c]; exp _ exp-1}
                    ELSE NULL;    -- should round
                    i _ i+1;
                    ENDLOOP};
            valid _ TRUE;
            IF c = 'e OR c = 'E THEN {
                scale: INTEGER _ 0;
                op: {plus, minus} _ $plus;
                i _ i + 1;
                SELECT s[i] FROM
                    '+ => i _ i+1;
                    '- => {op _ $minus; i _ i+1};
                    ENDCASE;
                IF s[i] NOT IN ['0..'9] THEN valid _ FALSE;
                WHILE (c _ s[i]) IN ['0..'9] DO
                    IF valid THEN [scale, valid] _ AppendToScale[scale, c];
                    i _ i+1;
                    ENDLOOP;
                exp _ IF op = $plus THEN exp + scale ELSE exp - scale};    -- need overflow check
            IF c # endMark THEN valid _ FALSE;
            value _ Real.PairToReal[v, exp
                ! Real.RealException => {valid _ FALSE; RESUME}];
            RETURN};

        EnterLit: PROC[v: LongLit] RETURNS[P1.Value] ~ {
            RETURN[[ref[LiteralOps.Find[v]]]]};


    <<character and string constants>>

        escapeMark: CHAR ~ '\\;

        Escape: PROC RETURNS[c: CHAR, valid, advance: BOOL_TRUE] ~ {
            c _ char;
            IF c = escapeMark THEN {
                NextChar[];
                SELECT char FROM
                    'n, 'N => c _ Ascii.CR;
                    'r, 'R => c _ Ascii.CR;
                    'l, 'L => c _ Ascii.LF;
                    't, 'T => c _ Ascii.TAB;
                    'b, 'B => c _ Ascii.BS;
                    'f, 'F => c _ Ascii.FF;
                    '', '", escapeMark => c _ char;
                    IN ['0 .. '7] => {
                        nc, v: CARDINAL _ 0;
                        DO
                            IF ~(char IN ['0..'7]) THEN {valid _ advance _ FALSE; EXIT};
                            v _ 8*v + Digit[char];
                            IF (nc _ nc+1) = 3 THEN EXIT;
                            NextChar[];
                            ENDLOOP;
                        IF v > Target.maxChar THEN {valid _ FALSE; v _ 0};
                        c _ v + 0c};
                    ENDCASE => valid _ advance _ FALSE
                };
            RETURN};


    <<initialization/finalization>>

        ScanInit: PUBLIC PROC[source: IO.STREAM, logger: PROC [PROC[log: IO.STREAM]]] ~ {
            stream _ source;  Logger _ logger;
            IF buffer = NIL THEN buffer _ NEW[TEXT[256]];
            desc.base _ LOOPHOLE[buffer, LONG POINTER];  desc.offset _ 0;
            iMax _ buffer.length _ buffer.maxLength;
            streamOrigin _ stream.GetIndex[];
            tB _ NEW[TextBuffer];
            tOrigin _ tLimit _ 0;  tMax _ 0;  tEnded _ FALSE;
            FillBuffer[];  char _ tB[tI];  qDot _ FALSE;
            nTokens _ nErrors _ 0};

        ScanStats: PUBLIC PROC RETURNS[NAT, NAT] ~ {
            RETURN[nTokens, nErrors]};

        ScanReset: PUBLIC PROC ~ {
            IF buffer # NIL THEN FREE[@buffer];
            IF tB # NIL THEN FREE[@tB];
            stream _ NIL;  Logger _ NIL};


    <<error handling>>

        ResetScanIndex: PUBLIC PROC[index: P1.Index] RETURNS[success: BOOL] ~ {
            IF ~(index IN [tOrigin .. tLimit)) THEN {
                page: CARDINAL ~ index/charsPerPage;
                tOrigin _ tLimit _ page*charsPerPage;
                tMax _ 0;  tEnded _ FALSE;
                stream.SetIndex[streamOrigin + tOrigin];
                FillBuffer[]};
            tI _ index - tOrigin;
            IF tI >= tMax THEN FillBuffer[];  char _ tB[tI];  RETURN[TRUE]};


        ErrorCode: TYPE ~ {number, string, char, atom, escape};

        ScanError: PROC[code: ErrorCode, tokenIndex: P1.Index] ~ {

            Inner: PROC[log: IO.STREAM] ~ {
                ErrorContext[log,
                    SELECT code FROM
                        $number => "invalid number",
                        $string => "string unterminated or too long",
                        $char => "invalid character",
                        $atom => "invalid atom",
                        $escape => "invalid escape sequence",
                        ENDCASE => NIL,
                    tokenIndex];
                log.PutChar['\n]};

            nErrors _ nErrors + 1;
            Logger[Inner]};


        ErrorContext: PUBLIC PROC[
              to: IO.STREAM, message: Rope.ROPE, tokenIndex: P1.Index] ~ {
            saveIndex: P1.Index ~ stream.GetIndex[];
            origin: P1.Index ~ streamOrigin + tokenIndex;
            start, lineIndex: P1.Index _ origin;
            char: CHAR;
            n: [1..100];
            FOR n IN [1..100] UNTIL lineIndex = 0 DO
                lineIndex _ lineIndex - 1;
                stream.SetIndex[lineIndex];
                IF stream.GetChar[] = '\n THEN EXIT;
                start _ lineIndex;
                ENDLOOP;
            stream.SetIndex[start];
            FOR n IN [1..100] UNTIL stream.EndOf[] DO
                char _ stream.GetChar[];
                SELECT char FROM
                    '\n, '\032 => EXIT;
                    ENDCASE => to.PutChar[char];
                ENDLOOP;
            to.PutChar['\n];
            stream.SetIndex[start];
            UNTIL stream.GetIndex[] = origin OR stream.EndOf[] DO
                char _ stream.GetChar[];
                to.PutChar[IF char = '\t THEN '\t ELSE ' ];
                ENDLOOP;
            to.Put[IO.rope["^ "], IO.rope[message]];
            to.Put[IO.rope[" ["], IO.card[tokenIndex]];
            to.PutChar[']];   to.PutChar['\n];
            stream.SetIndex[saveIndex]};

        }.

