
    <<TokenIOImpl.mesa>>
        <<Copyright © 1983, 1985, 1986 by Xerox Corporation.  All rights reserved.>>
        <<Created by Christian Jacobi August 24, 1983 3:10 pm>>
        <<Last Edited by: Christian Jacobi, December 22, 1986 3:27:30 pm PST>>

    DIRECTORY
        Atom, Basics, FS, IO, LRUCache, Properties, Rope, RuntimeError, TerminalIO, TokenIO, UserProfile;

    TokenIOImpl: CEDAR MONITOR 
        IMPORTS Atom, FS, IO, LRUCache, Rope, RuntimeError, TerminalIO, UserProfile 
        EXPORTS TokenIO
        SHARES IO =
    BEGIN
    OPEN TokenIO;

    <<-- Terminology>>
    <<--     read, write for encoded, (exported) IO>>
    <<--     get/put for actual unencoded IO>>

    <<--these x-codes are found on files>>
    xTokenIOCode:     BYTE = 237;  -- this is really a TokenStreams file
    xVersionCode:     BYTE =   2;  -- this is really a TokenStreams file of correct version

    xTabMin:    BYTE =   0;   
    xTabMax:    BYTE = 100;
    xIntSFirst: BYTE = 101;
    xIntSLast:    BYTE = 241;
    xRes:     BYTE = 242;
    xIntN1:     BYTE = 243;
    xIntP1:     BYTE = 244;
    xIntN2:     BYTE = 245;
    xIntP2:     BYTE = 246;
    xInt4:     BYTE = 247;
    xReal:     BYTE = 248;
    xStream:     BYTE = 249;
    xRope:     BYTE = 250;
    xFillR:     BYTE = 251;
    xFillA:     BYTE = 252;
    xPush2:     BYTE = 253;
    xPush:     BYTE = 254;
    xPop:     BYTE = 255;


    shortNatLast:    BYTE = xIntSLast-xIntSFirst; 
    tabSize:         BYTE = xTabMax-xTabMin+1;
    <<>>
    escChar: CHAR = 33C;

    EncodingError: PUBLIC SIGNAL = CODE;  
    Stopped: PUBLIC SIGNAL = CODE;
    <<>>
    Imp: TYPE = REF ImpRec;
    ImpRec: PUBLIC TYPE = RECORD [
        tab: LRUCache.Handle,
        rTab: ARRAY [xTabMin..xTabMax] OF Rope.ROPE,
        oldTable: REF ARRAY [1..100] OF ATOM _ NIL,
        againList: LIST OF Token _ NIL, --reserved for the implementor
        readFunny: BOOL _ FALSE,
        catcher: PROC [Handle] _ NIL,
        isOldV1: BOOL_FALSE,
        isR: BOOL
        ];

    InlinePutChar: PROC [self: IO.STREAM, char: CHAR] = INLINE {
        <<--IO.PutChar[s, char];>>
        self.streamProcs.putChar[self, char];
        };

    InlineGetChar: PROC [self: IO.STREAM] RETURNS [CHAR] = INLINE {
        <<--IO.GetChar[self];>>
        RETURN[self.streamProcs.getChar[self]];
        };
        <<>>
    PutB: PROC [s: IO.STREAM, c: BYTE] = INLINE {
        <<--IO.PutChar[s, LOOPHOLE[c, CHAR]];>>
        s.streamProcs.putChar[s, LOOPHOLE[c, CHAR]];
        };

    PutInt: PROC [s: IO.STREAM, i: INT32] = TRUSTED INLINE {
        <<--long: Basics.LongNumber = Basics.LongNumber[li[li: i]]; >>
        <<--Put2B[s, long.lo];>>
        <<--Put2B[s, long.hi];>>
        s.streamProcs.unsafePutBlock[s, [@i, 0, 4]]
        };

    Put2B: PROC [s: IO.STREAM, c: CARD16] = TRUSTED INLINE {
        <<--InlinePutChar[s, LOOPHOLE[c / 256, CHAR]];>>
        <<--InlinePutChar[s, LOOPHOLE[c MOD 256, CHAR]];>>
        s.streamProcs.unsafePutBlock[s, [@c, 0, 2]]
        };

    PutRope: PROC [s: IO.STREAM, r: Rope.ROPE] = INLINE {
        <<--NIL and "" is encoded differently; this fidelity is mainly important for atoms>>
        IF r=NIL THEN PutB[s, 255]
        ELSE {
            leng: INT ~ Rope.Length[r];
            IF leng<254 THEN PutB[s, leng] 
            ELSE {PutB[s, 254]; PutInt[s, leng]};
            IO.PutRope[s, r];
            }
        };

    GetB: PROC [s: IO.STREAM] RETURNS [c: BYTE] = INLINE {
        <<--c _ LOOPHOLE[IO.GetChar[s], [0..255]];>>
        c _ LOOPHOLE[s.streamProcs.getChar[s], BYTE];
        };

    Get2B: PROC [s: IO.STREAM] RETURNS [c: CARD16] = TRUSTED INLINE {
        <<--h: [0..255] ~ GetB[s];>>
        <<--c _ h*256+GetB[s];>>
        block: Basics.UnsafeBlock _ [@c, 0, 2];
        IF s.streamProcs.unsafeGetBlock[s, block]<2 THEN ERROR EncodingError
        };

    GetInt: PROC [s: IO.STREAM] RETURNS [i: INT32] = TRUSTED INLINE {
        <<long: Basics.LongNumber = Basics.LongNumber[pair[ >>
            <<lo: Get2B[s],>>
            <<hi: Get2B[s]>>
            <<]];>>
        <<RETURN [long.li]>>
        block: Basics.UnsafeBlock _ [@i, 0, 4];
        IF s.streamProcs.unsafeGetBlock[s, block]<4 THEN ERROR EncodingError;
        };

    GetRope: PROC [s: IO.STREAM] RETURNS [Rope.ROPE] = INLINE {

        XGetChar: PROC [] RETURNS [CHAR] = { 
            RETURN [InlineGetChar[s]];
            };

        leng: INT _ GetB[s];
        IF leng>=254 THEN {
            IF leng=255 THEN RETURN [NIL]
            ELSE leng _ GetInt[s];
            };
        IF leng=0 THEN RETURN [""];
        RETURN [ Rope.FromProc[len: leng, p: XGetChar] ];
        };

    MyRopeToAtom: PROC [r: Rope.ROPE] RETURNS [ATOM] = INLINE {
        RETURN [ IF r=NIL THEN NIL ELSE Atom.MakeAtom[r] ];
        };

    Write: PUBLIC PROC [h: Handle, t: Token] = {
        WITH t SELECT FROM
            push: Token.push => WritePush[h, push.value];
            push2: Token.push2 => WritePush2[h, push2.value];
            pop: Token.pop => WritePop[h];
            atom: Token.atom => WriteAtom[h, atom.value];
            rope: Token.rope => WriteRope[h, rope.value];
            int: Token.int => WriteInt[h, int.value];
            real: Token.real => WriteReal[h, real.value];
            streamed: Token.streamed => ERROR;
            endOfStream: Token.endOfStream => ERROR;
            error: Token.error => ERROR;
            ENDCASE => ERROR;
        };

    WriteInt: PUBLIC PROC [h: Handle, i: INT] = {
        IF h.stop^ THEN ERROR Stopped;
        IF h.funny THEN TSOStopFunny[h];
        SELECT TRUE FROM
            i IN [0..shortNatLast] => {PutB[h.s, i+xIntSFirst]};
            i IN [0..255]  => {PutB[h.s, xIntP1]; PutB[h.s, i]};
            i IN [0..INT[LAST[CARD16]]] => {PutB[h.s, xIntP2]; Put2B[h.s, i]};
            i IN [-256..-1]  => {PutB[h.s, xIntN1]; PutB[h.s, -i-1]};
            i IN [-INT[LAST[CARD16]]..-1] => {PutB[h.s, xIntN2]; Put2B[h.s, -i-1]};
            ENDCASE => {PutB[h.s, xInt4]; PutInt[h.s, i]};
        };

    WriteAtom: PUBLIC PROC [h: Handle, a: ATOM] = {
        r: Rope.ROPE ~ Atom.GetPName[a];
        index: NAT; insert: BOOL;
        imp: Imp _ h.imp;
        IF h.stop^ THEN ERROR Stopped;
        IF h.funny THEN TSOStopFunny[h];
        [index: index, insert: insert] _ LRUCache.Include[imp.tab, r];
        IF insert THEN {
            PutB[h.s, xFillA];
            PutB[h.s, index];
            PutRope[h.s, r];
            }
        ELSE PutB[h.s, index]
        };

    WriteRope: PUBLIC PROC [h: Handle, r: Rope.ROPE] = {
        index: NAT; insert: BOOL;
        imp: Imp _ h.imp;
        IF h.stop^ THEN ERROR Stopped;
        IF h.funny THEN TSOStopFunny[h];
        [index: index, insert: insert] _ LRUCache.Include[imp.tab, r];
        IF insert THEN {
            PutB[h.s, xFillR];
            PutB[h.s, index];
            PutRope[h.s, r];
            }
        ELSE {
            PutB[h.s, xRope];
            PutB[h.s, index];
            }
        };

    WritePush: PUBLIC PROC [h: Handle, a: ATOM_NIL] = {
        IF h.stop^ THEN ERROR Stopped;
        IF h.funny THEN TSOStopFunny[h];
        PutB[h.s, xPush];
        WriteAtom[h, a];
        };

    WritePush2: PUBLIC PROC [h: Handle, a: ATOM_NIL] = {
        IF h.stop^ THEN ERROR Stopped;
        IF h.funny THEN TSOStopFunny[h];
        PutB[h.s, xPush2];
        WriteAtom[h, a];
        };

    WritePop: PUBLIC PROC [h: Handle] = {
        IF h.stop^ THEN ERROR Stopped;
        IF h.funny THEN TSOStopFunny[h];
        PutB[h.s, xPop];
        };

    WriteReal: PUBLIC PROC [h: Handle, r: REAL] = {
        long: Basics.LongNumber = Basics.LongNumber[real[real: r]]; 
        IF h.stop^ THEN ERROR Stopped;
        IF h.funny THEN TSOStopFunny[h];
        PutB[h.s, xReal];
        Put2B[h.s, long.lo];
        Put2B[h.s, long.hi];
        };

    MarkAndWriteInt: PUBLIC PROC [h: Handle, value: INT] RETURNS [Mark] = {
        pos: INT;
        IF h.stop^ THEN ERROR Stopped;
        IF h.funny THEN TSOStopFunny[h];
        PutB[h.s, xInt4];
        pos _ IO.GetIndex[h.s];
        PutInt[h.s, value];
        RETURN [NEW[INT_pos]]
        };

    UpdateMark: PUBLIC PROC [h: Handle, mark: Mark, value: INT] = {
        intPos: INT _ NARROW[mark, REF INT]^;
        curPos: INT = IO.GetIndex[h.s];
        IF h.stop^ THEN ERROR Stopped;
        IO.SetIndex[h.s, intPos];
        PutInt[h.s, value];
        IO.SetIndex[h.s, curPos];
        };

    InternalRead: PROC [h: Handle] RETURNS [Token_[error[NIL]]] = {
        ENABLE { 
            IO.EndOfStream => {
                IF NotDebugging[] THEN GOTO endOfStreamReturn
                };
            IO.Error => {
                IF ec=Failure THEN {
                    error: FS.ErrorDesc;
                    error _ FS.ErrorFromStream[h.s ! RuntimeError.UNCAUGHT => CONTINUE];
                    TerminalIO.PutF["**TokenIO => FS.Error[%g, ""%g""]\n", [atom[error.code]], [rope[error.explanation]]];
                    };
                <<--you want to land in the debugger>>
                };
            FS.Error => {
                TerminalIO.PutF["**TokenIO => FS.Error[%g, ""%g""]\n", [atom[error.code]], [rope[error.explanation]]];
                <<--you want to land in the debugger>>
                };
            RuntimeError.UNCAUGHT => {
                TerminalIO.PutRope["** TokenIO => unknown error\n"];
                IF NotDebugging[] THEN GOTO errorReturn;
                };
            };

        FillTable: PROC [h: Handle] RETURNS [r: Rope.ROPE] = --INLINE-- {
            imp: Imp _ h.imp;
            c: CARDINAL = GetB[h.s];
            SELECT TRUE FROM
                c IN [xTabMin..xTabMax] => {
                    r _ imp.rTab[c] _ GetRope[h.s];
                    };
                ENDCASE => ERROR
            };

        imp: Imp _ h.imp;
        b: [0..255]; 
        b _ GetB[h.s];
        IF b<=xIntSLast THEN {--this if statement for speed only
            SELECT TRUE FROM
                b IN [xIntSFirst..xIntSLast] => RETURN [[int[b-xIntSFirst]]];
                b IN [xTabMin..xTabMax] => 
                    RETURN [ [atom[MyRopeToAtom[imp.rTab[b]]]] ];
                ENDCASE => ERROR;
            }
        ELSE {
            SELECT TRUE FROM
                b=xPop => RETURN [[pop[NIL]]];
                b=xPush => {
                    WITH InternalRead[h] SELECT FROM
                        atom: Token.atom => RETURN [[push[atom.value]]];
                        ENDCASE => RETURN [[error[NIL]]];
                    };
                b=xPush2 => {
                    WITH InternalRead[h] SELECT FROM
                        atom: Token.atom => RETURN [[push2[atom.value]]];
                        ENDCASE => RETURN [[error[NIL]]];
                    };
                b=xIntP2 => RETURN [[int[Get2B[h.s]]]];
                b=xRope => {
                    b _ GetB[h.s];
                    IF b IN [xTabMin..xTabMax] THEN RETURN [ [rope[imp.rTab[b]]] ]
                    ELSE ERROR EncodingError
                    };
                b=xIntP1 => RETURN [[int[GetB[h.s]]]];
                b=xIntN1 => {i: INT = GetB[h.s]; RETURN [[int[-i-1]]]};
                b=xInt4 => RETURN [[int[GetInt[h.s]]]];
                b=xIntN2 => {i: INT = Get2B[h.s]; RETURN [[int[-i-1]]]};
                b=xFillA => RETURN [[atom[MyRopeToAtom[FillTable[h]]]]];
                b=xFillR => RETURN [[rope[FillTable[h]]]];
                b=xStream => {
                    TSIStartFunny[h];
                    RETURN [[streamed[NIL]]];
                    };
                b=xReal => {
                    long: Basics.LongNumber = Basics.LongNumber[pair[ 
                        lo: Get2B[h.s],
                        hi: Get2B[h.s]
                        ]];
                    RETURN [[real[long.real]]];
                    };
                ENDCASE => ERROR;
            }
        EXITS
            errorReturn => RETURN [[error[NIL]]];
            endOfStreamReturn => {
                TerminalIO.PutRope["** end of TokenStreams stream\n"];
                RETURN [ [endOfStream[]] ]
                };
        };

    OLDV1InternalReadToken: PROC [h: Handle] RETURNS [Token_[error[NIL]]] =
        BEGIN
            ENABLE { 
                IO.EndOfStream => IF NotDebugging[] THEN GOTO endOfStreamReturn;
                IO.Error => IF NotDebugging[] THEN GOTO endOfStreamReturn;
                RuntimeError.UNCAUGHT => {
                    TerminalIO.PutRope["** unknown TokenStreams error\n"];
                    IF NotDebugging[] THEN GOTO errorReturn;
                    }
                };

        xLongInt: CARDINAL = 255;
        xPushFlag: CARDINAL = 254;
        xRope: CARDINAL = 253;
        xPopFlag: CARDINAL = 252;
        xFillTable: CARDINAL = 0;
        xReadTableMin: CARDINAL = 1;  -- >0 ! 
            dummy: INTEGER = xReadTableMin-1;
        xReadTableMax: CARDINAL = 100;
        xFirstShortNat: CARDINAL = xReadTableMax+1;
        xLastShortNat: CARDINAL = 247;
         shortNatLast: CARDINAL = xLastShortNat-xFirstShortNat; 
        xTwoByteCard: CARDINAL = 251;
        xTwoByteNegative: CARDINAL = 250;
        xOneBytePos: CARDINAL = 249;
        xOneByteNeg: CARDINAL = 248;

        OldGetRope: PROC [h: Handle] RETURNS [Rope.ROPE] =  {
            XGetChar: PROC [] RETURNS[CHAR] = { --not inline; used as formal procedure
                RETURN [InlineGetChar[h.s]];
                };

            leng: INT _ GetB[h.s];
            IF leng=255 THEN leng _ GetInt[h.s];
            IF leng=0 THEN RETURN [""];
            RETURN [ Rope.FromProc[len: leng, p: XGetChar] ];
            };

        OldGetAtom: PROC [h: Handle] RETURNS [a: ATOM] = {
            r: Rope.ROPE = OldGetRope[h];
            IF Rope.InlineIsEmpty[r] THEN RETURN [NIL]
            ELSE RETURN [ Atom.MakeAtom[r] ];
            };

        OldFillTable: PROC[h: Handle] RETURNS [a: ATOM] = {
            c: CARDINAL = GetB[h.s];
            SELECT TRUE FROM
                c IN [xReadTableMin..xReadTableMax] => { 
                    imp: Imp _ h.imp;
                    a _ imp.oldTable[c] _ OldGetAtom[h];
                    };
                ENDCASE => ERROR
            };

        b: [0..255]; 
        b _ GetB[h.s];
        IF b<=xLastShortNat THEN {--this if statement for speed only
            SELECT TRUE FROM
                b IN [xFirstShortNat..xLastShortNat] => {RETURN [[int[b-xFirstShortNat]]]};
                b IN [xReadTableMin..xReadTableMax] => {
                    imp: Imp _ h.imp;
                    RETURN [ [atom[imp.oldTable[b]]] ]
                    };
                b=xFillTable => {RETURN [[atom[OldFillTable[h]]]]};
                ENDCASE => ERROR;
            }
        ELSE {
            SELECT TRUE FROM
                b=xPopFlag => RETURN [[pop[NIL]]];
                b=xPushFlag => {
                    WITH OLDV1InternalReadToken[h] SELECT FROM
                        atom: Token.atom => RETURN [[push[atom.value]]];
                        ENDCASE => RETURN [[error[NIL]]];
                    };
                b=xTwoByteCard => RETURN [[int[Get2B[h.s]]]];
                b=xRope => RETURN [ [rope[OldGetRope[h]]] ];
                b=xOneBytePos => RETURN [[int[GetB[h.s]]]];
                b=xOneByteNeg => {i: INT = GetB[h.s]; RETURN [[int[-i-1]]]};
                b=xLongInt => RETURN [[int[GetInt[h.s]]]];
                b=xTwoByteNegative => {i: INT = Get2B[h.s]; RETURN [[int[-i-1]]]};
                ENDCASE => ERROR;
            }
        EXITS
            errorReturn => RETURN [[error[NIL]]];
            endOfStreamReturn => {
                TerminalIO.PutRope["** end of TokenStreams stream\n"];
                RETURN [ [endOfStream[]] ]
                };
        END;


    <<--features used to debug TokenStreams and other ChipNDale IO>>
    <<--    debugging must be optional; the MOD operation costs 5% runtime on read!>>
    <<--    we wont speak about the new...>>

    debugMax: NAT = 10;
    debugBuffer: REF ARRAY [0..debugMax) OF REF Token
         _ NEW[ARRAY [0..debugMax) OF REF Token];
    debugIndex:  [0..debugMax] _ 0;
    doDebug: BOOL _ FALSE;

    Remember: PROC [token: Token] = INLINE {
        <<--debugging must optional; the MOD operation costs 5% runtime on read!>>
        <<--we wont speak about the new...>>
        debugBuffer[debugIndex] _ NEW[Token_token]; 
        debugIndex _ (debugIndex+1) MOD debugMax;
        };
    <<>>
    NotDebugging: PROC RETURNS [BOOL] = {
        RETURN [ UserProfile.Boolean["ChipNDale.CatchLowLevelErrors", TRUE] ]
        };

    Read: PUBLIC PROC [h: Handle] RETURNS [Token_[error[NIL]]] = {
        IF h.funny THEN {
            imp: Imp _ h.imp;
            IF imp.againList#NIL THEN {
                token: Token _ imp.againList.first; 
                imp.againList _ imp.againList.rest;
                IF imp.againList=NIL THEN h.funny _ imp.isOldV1 OR imp.readFunny;
                RETURN [token]
                }
            ELSE IF imp.readFunny THEN {
                TSISkipFunny[h];
                }
            ELSE IF imp.isOldV1 THEN {
                token: Token _ OLDV1InternalReadToken[h];
                IF doDebug THEN Remember[token];
                RETURN [token]
                }
            ELSE ERROR
            };
        {
            token: Token _ InternalRead[h];
            IF doDebug THEN Remember[token];
            RETURN [token]
            };
        };

    ReadAgain: PUBLIC PROC [h: Handle, t: Token] = {
        imp: Imp _ h.imp;
        h.funny _ TRUE;
        imp.againList _ CONS[t, imp.againList];
        };

    Close: PUBLIC PROC [h: Handle, closeStream: BOOL_TRUE] = {
        IF closeStream THEN IO.Close[h.s];
        };

    CommonCreate: PROC [stream: IO.STREAM, stop: REF BOOL, isR: BOOL_TRUE, catcher: PROC[Handle]_NIL] RETURNS [Handle] = {
        IF stop=NIL THEN stop _ NEW[BOOL_FALSE];
        RETURN [ NEW[HandleRec _ [
            stop: stop, 
            funny: FALSE,
            imp: NEW[ImpRec_[
                tab: LRUCache.Create[tabSize],
                rTab: ALL[NIL],
                againList: NIL,
                catcher: catcher,
                isR: isR
                ]],
            stream: NIL,
            s: stream,
            properties: NEW[Properties.PropList _ NIL]
            ]]];
        };

    CreateReader: PUBLIC PROC [stream: IO.STREAM, stop: REF BOOL_NIL, catcher: PROC [Handle]] RETURNS [h: Handle] = {
        b: CARDINAL;
        h _ CommonCreate[stream, stop, TRUE, catcher];
        b _ GetB[h.s ! IO.EndOfStream => GOTO short ];
        IF b#xTokenIOCode THEN { 
            TerminalIO.PutRope["file not produced with TokenStreams\n"]; 
            IF b=57 THEN TerminalIO.PutRope["    might be a SIL file\n"]; 
            IF b=5 THEN TerminalIO.PutRope["    might be a bcd file\n"]; 
            ERROR EncodingError
            };
        b _ GetB[h.s ! IO.EndOfStream => GOTO short ];
        IF b#xVersionCode THEN { 
            IF b=1 THEN {
                imp: Imp _ h.imp;
                TerminalIO.PutRope["old file version !!!\n"];
                imp.oldTable _ NEW[ARRAY [1..100] OF ATOM _ ALL[NIL]];
                imp.isOldV1 _ TRUE;
                h.funny _ TRUE;
                }
            ELSE {
                TerminalIO.PutRope["file not produced with TokenStreams"]; 
                ERROR EncodingError
                }
            };
        EXITS short => {
            TerminalIO.PutRope["TokenStreams stream to short"];
            ERROR EncodingError
            };
        };
        <<>>
    CreateWriter: PUBLIC PROC [stream: IO.STREAM, stop: REF BOOL_NIL, truth: BOOL_TRUE] RETURNS [h: Handle] = {
        h _ CommonCreate[stream, stop, FALSE];
        h.truth _ truth;
        [] _ IO.GetIndex[stream 
            ! IO.Error => {
                TerminalIO.PutRope["TokenStreams stream needs GetIndex"];
                ERROR EncodingError
                }
            ];
        PutB[h.s, xTokenIOCode];
        PutB[h.s, xVersionCode];
        };

    Error: PROC [h: Handle, t: Token] = {
        ReadAgain[h, t];
        SIGNAL EncodingError;
        };

    ReadInt: PUBLIC PROC [h: Handle] RETURNS [INT_0] = {
        t: Token _ Read[h];
        WITH t SELECT FROM
            int: Token.int => RETURN [int.value];
            ENDCASE => Error[h, t]; 
        };

    ReadAtom: PUBLIC PROC [h: Handle] RETURNS [ATOM_NIL] = {
        t: Token _ Read[h];
        WITH t SELECT FROM
            atom: Token.atom => RETURN [atom.value];
            ENDCASE => Error[h, t];
        };

    ReadRope: PUBLIC PROC [h: Handle] RETURNS [Rope.ROPE_NIL] = {
        t: Token _ Read[h];
        WITH t SELECT FROM
            rope: Token.rope => RETURN [rope.value];
            ENDCASE => Error[h, t]; 
        };

    ReadPop: PUBLIC PROC [h: Handle] = {
        t: Token _ Read[h];
        WITH t SELECT FROM
            pop: Token.pop => NULL;
            ENDCASE => Error[h, t];
        };

    ReadPush: PUBLIC PROC [h: Handle] RETURNS [ATOM_NIL] = {
        t: Token _ Read[h];
        WITH t SELECT FROM
            push: Token.push => RETURN [push.value];
            ENDCASE => Error[h, t]; 
        };

    ReadPush2: PUBLIC PROC [h: Handle] RETURNS [ATOM_NIL] = {
        t: Token _ Read[h];
        WITH t SELECT FROM
            push2: Token.push2 => RETURN [push2.value];
            ENDCASE => Error[h, t]; 
        };

    ReadReal: PUBLIC PROC [h: Handle] RETURNS [REAL_0] = {
        t: Token _ Read[h];
        WITH t SELECT FROM
            real: Token.real => RETURN [real.value];
            ENDCASE => Error[h, t]; 
        };

    Skip: PUBLIC PROC [h: Handle] = {
        num, nest: INT _ 0;
        DO
            t: Token _ Read[h];
            WITH t SELECT FROM
                push: Token.push => {
                    imp: Imp _ h.imp;
                    IF imp.catcher=NIL THEN nest _ nest+1
                    ELSE {
                        ReadAgain[h, t];
                        imp.catcher[h];
                        }
                    };
                push2: Token.push2 => nest _ nest+1;
                pop: Token.pop => IF num=0 THEN RETURN ELSE nest _ nest-1;
                streamed: Token.streamed => TSISkipFunny[h];
                endOfStream: Token.endOfStream => {ReadAgain[h, t]; RETURN};
                ENDCASE => NULL;
            IF nest<0 THEN EXIT;
            num _ num+1
            ENDLOOP
        };

    <<>>
    <<-- STREAM STREAM STREAM STREAM STREAM>>

    ReadStream: PUBLIC PROC [h: Handle] RETURNS [s: IO.STREAM] = {
        imp: Imp _ h.imp;
        IF ~imp.isR THEN ERROR;
        IF h.stream=NIL THEN h.stream _ IO.CreateStream[streamProcs: tSIProcs, streamData: h];
        s _ h.stream;
        };
        <<>>
    WriteStream: PUBLIC PROC [h: Handle] RETURNS [s: IO.STREAM] = {
        imp: Imp _ h.imp;
        IF imp.isR THEN ERROR;
        IF h.stream=NIL THEN h.stream _ IO.CreateStream[streamProcs: tSOProcs, streamData: h];
        s _ h.stream;
        IF ~h.funny THEN TSOStartFunny[h];
        };

    tSOProcs: REF IO.StreamProcs _ IO.CreateStreamProcs[
        variety: $output, 
        class: $TokenStreamsOutStream,
        putChar: TSOPutChar,
        putBlock: TSOPutBlock
        ];

    tSIProcs: REF IO.StreamProcs _ IO.CreateStreamProcs[
        variety: $input, 
        class: $TokenStreamsInStream,
        getChar: TSIGetChar
        ];

    TSIGetChar: PROC [self: IO.STREAM] RETURNS [ch: CHAR_0c] = {
        h: Handle _ NARROW[self.streamData];
        imp: Imp _ h.imp;
        IF ~imp.isR THEN ERROR;
        IF ~imp.readFunny THEN ERROR EncodingError;
        ch _ InlineGetChar[h.s];
        IF ch=escChar THEN {
            ch _ InlineGetChar[h.s];
            IF ch=escChar THEN RETURN [escChar];
            imp.readFunny _ FALSE; 
            ch _ 0c;
            } 
        };

    TSIStartFunny: PROC [h: Handle] = {
        imp: Imp _ h.imp;
        IF ~imp.isR THEN ERROR;
        imp.readFunny _ TRUE;
        h.funny _ TRUE;
        };

    TSISkipFunny: PROC [h: Handle] = {
        <<--stops and skips until the next token>>
        c: CHAR;
        imp: Imp _ h.imp;
        IF ~imp.isR THEN ERROR;
        IF ~imp.readFunny THEN RETURN;
        DO
            c _ InlineGetChar[h.s];
            IF c=escChar THEN {
                c _ InlineGetChar[h.s];
                IF c#escChar THEN EXIT
                };
            ENDLOOP;
        imp.readFunny _ FALSE;
        h.funny _ imp.againList#NIL OR imp.isOldV1;
        };

    TSOStopFunny: PROC [h: Handle] = {
        imp: Imp _ h.imp;
        IF imp.isR THEN ERROR;
        IF ~h.funny THEN RETURN;
        InlinePutChar[h.s, escChar];
        PutB[h.s, 1];
        h.funny _ FALSE;
        };

    TSOStartFunny: PROC [h: Handle] = {
        imp: Imp _ h.imp;
        IF imp.isR THEN ERROR;
        IF h.funny THEN RETURN;
        h.funny _ TRUE;
        PutB[h.s, xStream];
        };

    TSOPutChar: PROC [self: IO.STREAM, char: CHAR] = {
        h: Handle _ NARROW[self.streamData];
        IF ~h.funny THEN TSOStartFunny[h];
        IF char=escChar THEN InlinePutChar[h.s, escChar];
        InlinePutChar[h.s, char];
        };

    TSOPutBlock: PROC [self: IO.STREAM, block: REF READONLY TEXT, startIndex: NAT, count: NAT] = {
        AddNat: PROC [a, b: NAT] RETURNS [NAT] = INLINE {
            RETURN [MIN[CARDINAL[a]+CARDINAL[b], NAT.LAST]];
            };
        stopIndexPlusOne: NAT _ AddNat[startIndex, count];
        h: Handle _ NARROW[self.streamData];
        IF ~h.funny THEN TSOStartFunny[h];
        FOR i: NAT IN [startIndex .. stopIndexPlusOne) DO
            IF block[i]=escChar THEN InlinePutChar[self, escChar];
            InlinePutChar[self, block[i]];
            ENDLOOP;
        };

    END.