
    <<CtoSScannerImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, January 3, 1986 9:07:37 am PST>>
        <<derived from Compiler/Scanner.mesa>>

    DIRECTORY
        Ascii: TYPE USING [BS, CR, FF, LF, TAB],
        Basics: TYPE USING [charsPerWord, Word],
        IO: TYPE USING [
            card, EndOf, GetBlock, GetChar, GetIndex, Put, PutChar, rope, SetIndex, STREAM],
        CtoSP1: TYPE P1 USING [Token, nullTValue],
        CtoSParseTable: TYPE ParseTable USING [
            HashIndex, HashTableRef, IndexTableRef, ScanTableRef, TableRef, TSymbol, VocabularyRef,
            endMarker, tokenARROW, tokenATOM, tokenBRACKET, tokenCHAR, tokenDOT,
            tokenEQUAL, tokenGE, tokenGREATER, tokenID, tokenLE, tokenLESS,
            tokenFLNUM, tokenLNUM, tokenLSTR, tokenMINUS, tokenNE, tokenNUM, tokenSTR,
            tokenTILDE],
        PrincOps: TYPE USING [wordsPerPage],
        RefText: TYPE USING [Append],
        Rope: TYPE USING [FromProc, ROPE],
        SMOps: TYPE USING [MS];

    CtoSScannerImpl: CEDAR PROGRAM
            IMPORTS IO, RefText, Rope 
            EXPORTS CtoSP1 = {
        OPEN CtoSParseTable, P1~~CtoSP1;

    <<table installation>>

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

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

        CharClass: PROC[c: CHAR]  RETURNS[TSymbol] ~ TRUSTED INLINE {
            RETURN [scanTab[c]]};

    <<scanner state>>

        cm: SMOps.MS;
        out: IO.STREAM;
        zone: ZONE _ NIL;

        StreamIndex: TYPE ~ INT;

        stream: IO.STREAM _ NIL;        -- the input stream

        textPages: NAT ~ 6;
        charsPerPage: NAT ~ PrincOps.wordsPerPage*Basics.charsPerWord;
        textChars: NAT ~ textPages*charsPerPage;

        tB: REF TEXT _ NIL;
        tI, tMax: [0..textChars];
        tOrigin, tLimit: StreamIndex;
        tEnded: BOOL;


        FillBuffer: PROC ~ {
            tOrigin _ tLimit;
            IF tEnded THEN tMax _ 0
            ELSE {
                tMax _ stream.GetBlock[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: RECORD [offset, length: CARDINAL];    -- initial buffer segment

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

        BufferOverflow: ERROR ~ CODE;

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


        char: CHAR;        -- current (most recently scanned) character
        nesting: NAT;    -- counts depth of nesting with [|( and )|]

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


        Substr: PUBLIC PROC  [start: StreamIndex, length: INT] RETURNS [r: Rope.ROPE] ~ {
            saveIndex: StreamIndex ~ stream.GetIndex;

            GetChar: PROC RETURNS[CHAR] ~ {RETURN [stream.GetChar]};

            stream.SetIndex[start];
            r _ Rope.FromProc[length, GetChar];
            stream.SetIndex[saveIndex];
            RETURN};



        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;
                IF nesting = 0 THEN {index _ tOrigin + tI;  value _ P1.nullTValue};
                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;
                        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 TRUSTED {
                            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;
                        GO TO GotNext};

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

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

                    '' => {
                        c: CHAR;
                        valid, advance: BOOL;
                        NextChar[];
                        [c, valid, advance] _ Escape[];
                        IF ~valid THEN ScanError[$escape, index + 1];
                        class _ tokenCHAR;
                        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;
                        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;
                        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[]};

                    '. => {
                        NextChar[];
                        SELECT char FROM
                            IN ['0..'9] => {
                                valid: BOOL;
                                buffer[0] _ '.;
                                [class, 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}};

                    '[, '( => {
                        nesting _ nesting + 1; GO TO GetNext};

                    '], ') => {
                        nesting _ nesting - 1;
                        IF nesting <= 0 THEN {nesting _ 0; class _ tokenBRACKET};
                        GO TO GetNext}

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

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


        <<numerical conversion>>

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

            CollectNumber: PROC [i: CARDINAL, float: BOOL_FALSE]
                  RETURNS [class: TSymbol, 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[]};

                maxWord: LONG CARDINAL ~ Basics.Word.LAST;
                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[];
                            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 => NULL;
                    tokenFLNUM => NULL;
                    ENDCASE =>
                        IF LOOPHOLE[v, LONG CARDINAL] <= maxWord THEN
                            class _ tokenNUM;
                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];

            AppendDecimal: PROC [v: LONG CARDINAL, digit: CHAR ['0..'9]]
                  RETURNS [newV: LONG CARDINAL, valid: BOOL] ~ {
                maxV: LONG CARDINAL ~ 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: LONG CARDINAL, digit: CHAR ['0..'7]]
                  RETURNS [newV: LONG CARDINAL, valid: BOOL] ~ {
                maxV: LONG CARDINAL ~ 3777777777b;    -- (2**32-1)/8
                d: [0..7] ~ Digit[digit];
                valid _ (v <= maxV);
                newV _ 8*v + d;
                RETURN};

            AppendHex: PROC [v: LONG CARDINAL, digit: CHAR ['0..'F]]
                  RETURNS [newV: LONG CARDINAL, valid: BOOL] ~ {
                maxV: LONG CARDINAL ~ 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: LONG CARDINAL, digit: CHAR ['0..'9]] RETURNS [BOOL] ~ {
                maxV: LONG CARDINAL ~ 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: LONG CARDINAL _ 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: LONG CARDINAL _ 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;
                maxChar: NAT ~ 377b;
                i: CARDINAL _ 0;
                v: LONG CARDINAL _ 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 .. maxChar] THEN valid _ FALSE;
                value _ v;
                RETURN};

            ScanHex: PROC [s: REF TEXT] RETURNS [value: LongLit, valid: BOOL_TRUE] ~ {
                c: CHAR;
                i: CARDINAL _ 0;
                v: LONG CARDINAL _ 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] ~ {
                c: CHAR;
                i: CARDINAL _ 0;
                v: LONG CARDINAL _ 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;
                RETURN};

        <<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 > 377b THEN {valid _ FALSE; v _ 0};
                            c _ v + 0c};
                        ENDCASE => valid _ advance _ FALSE};
                RETURN};


        <<initialization/finalization>>

            ScanInit: PUBLIC PROC [model: SMOps.MS, source: IO.STREAM] ~ {
                cm _ model;  out _ model.out;  zone _ model.z;
                stream _ source;
                IF buffer = NIL THEN buffer _ zone.NEW[TEXT[256]];
                desc.offset _ 0;
                iMax _ buffer.length _ buffer.maxLength;
                tB _ zone.NEW[TEXT[textChars]];
                tOrigin _ tLimit _ 0;  tMax _ 0;  tEnded _ FALSE;
                FillBuffer[];  char _ tB[tI];  nesting _ 0;
                nTokens _ nErrors _ 0};

            ScanReset: PUBLIC PROC RETURNS [CARDINAL, CARDINAL] ~ {
                stream _ out _ NIL;
                zone.FREE[@tB];
                IF buffer # NIL THEN zone.FREE[@buffer];
                zone _ NIL;
                RETURN [nTokens, nErrors]};


        <<error handling>>

            ResetScanIndex: PUBLIC PROC [index: StreamIndex] RETURNS [success: BOOL] ~ {
                IF ~(index IN [tOrigin .. tLimit)) THEN {
                    page: CARDINAL ~ index/charsPerPage;
                    tOrigin _ tLimit _ page*charsPerPage;
                    tMax _ 0;  tEnded _ FALSE;
                    stream.SetIndex[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: StreamIndex] ~ {
                nErrors _ nErrors + 1;
                ErrorContext[
                    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];
                out.PutChar['\n]};


            ErrorContext: PUBLIC PROC [message: Rope.ROPE, tokenIndex: StreamIndex] ~ {
                saveIndex: StreamIndex ~ stream.GetIndex;
                start, lineIndex: StreamIndex _ tokenIndex;
                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: CHAR ~ stream.GetChar;
                    IF char = '\n THEN EXIT;
                    out.PutChar[char];
                    ENDLOOP;
                out.PutChar['\n];
                stream.SetIndex[start];
                UNTIL stream.GetIndex = tokenIndex OR stream.EndOf DO
                    char _ stream.GetChar;
                    out.PutChar[IF char = '\t THEN '\t ELSE ' ];
                    ENDLOOP;
                out.Put[IO.rope["^ "], IO.rope[message]];
                out.Put[IO.rope[" ["], IO.card[tokenIndex], IO.rope["]\n"]];
                stream.SetIndex[saveIndex]};

            }.

