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;


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 [
againList: LIST OF Token _ NIL, --reserved for the implementor
readFunny: BOOL _ FALSE,
isOldV1: BOOL_FALSE,
isR: BOOL,
tab: LRUCache.Handle,
rTab: ARRAY [xTabMin..xTabMax] OF Rope.ROPE _ ALL[NIL],
catcher: PROC [Handle] _ NIL,
oldTable: REF ARRAY [1..100] OF ATOM _ NIL
];

PutC: PROC [self: IO.STREAM, char: CHAR] = INLINE {
self.streamProcs.putChar[self, char];
};

PutB: PROC [s: IO.STREAM, c: BYTE] = INLINE {
s.streamProcs.putChar[s, LOOPHOLE[c, CHAR]];
};

PutInt: PROC [s: IO.STREAM, i: INT32] = TRUSTED INLINE {
s.streamProcs.unsafePutBlock[s, [@i, 0, 4]]
};

Put2B: PROC [s: IO.STREAM, c: CARD16] = TRUSTED INLINE {
s.streamProcs.unsafePutBlock[s, [@c, 0, 2]]
};

PutRope: PROC [s: IO.STREAM, r: Rope.ROPE] = INLINE {
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];
}
};

GetC: PROC [self: IO.STREAM] RETURNS [CHAR] = INLINE {
RETURN[self.streamProcs.getChar[self]];
};
GetB: PROC [s: IO.STREAM] RETURNS [c: BYTE] = INLINE {
c _ LOOPHOLE[s.streamProcs.getChar[s]];
};

Get2B: PROC [s: IO.STREAM] RETURNS [c: CARD16] = TRUSTED INLINE {
IF s.streamProcs.unsafeGetBlock[s, [@c, 0, 2]]<2 THEN ERROR EncodingError
};

GetInt: PROC [s: IO.STREAM] RETURNS [i: INT32] = TRUSTED INLINE {
IF s.streamProcs.unsafeGetBlock[s, [@i, 0, 4]]<4 THEN ERROR EncodingError;
};

GetRope: PROC [s: IO.STREAM] RETURNS [Rope.ROPE] = INLINE {
XGetChar: PROC [] RETURNS [CHAR] = { RETURN [GetC[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
int: Token.int => WriteInt[h, int.value];
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];
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 [] RETURNS [r: Rope.ROPE] = INLINE {
c: BYTE = GetB[h.s];
SELECT TRUE FROM
c IN [xTabMin..xTabMax] => r _ imp.rTab[c] _ GetRope[h.s];
ENDCASE => ERROR;
};

imp: Imp = h.imp;
b: BYTE; 
IF (b _ GetB[h.s]) <= xRes 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 b FROM
xIntP2 => RETURN [[int[Get2B[h.s]]]];
xIntP1 => RETURN [[int[GetB[h.s]]]];
xPop => RETURN [[pop[NIL]]];
xPush2 => WITH InternalRead[h] SELECT FROM
atom: Token.atom => RETURN [[push2[atom.value]]];
ENDCASE => RETURN [[error[NIL]]];
xPush => WITH InternalRead[h] SELECT FROM
atom: Token.atom => RETURN [[push[atom.value]]];
ENDCASE => RETURN [[error[NIL]]];
xRope => IF (b _ GetB[h.s]) IN [xTabMin..xTabMax] 
THEN RETURN [ [rope[imp.rTab[b]]] ]
ELSE ERROR EncodingError;
xFillR => RETURN [[rope[FillTable[]]]];
xIntN1 => {i: INT = GetB[h.s]; RETURN [[int[-i-1]]]};
xInt4 => RETURN [[int[GetInt[h.s]]]];
xIntN2 => {i: INT = Get2B[h.s]; RETURN [[int[-i-1]]]};
xFillA => RETURN [[atom[MyRopeToAtom[FillTable[]]]]];
xStream => {TSIStartFunny[h]; RETURN [[streamed[NIL]]]};
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: BYTE = 255;
xPushFlag: BYTE = 254;
xRope: BYTE = 253;
xPopFlag: BYTE = 252;
xFillTable: BYTE = 0;
xReadTableMin: BYTE = 1;  -- >0 ! 
dummy: BYTE = xReadTableMin-1;
xReadTableMax: BYTE = 100;
xFirstShortNat: BYTE = xReadTableMax+1;
xLastShortNat: BYTE = 247;
 shortNatLast: BYTE = xLastShortNat-xFirstShortNat; 
xTwoByteCard: BYTE = 251;
xTwoByteNegative: BYTE = 250;
xOneBytePos: BYTE = 249;
xOneByteNeg: BYTE = 248;

OldGetRope: PROC [h: Handle] RETURNS [Rope.ROPE] =  {
XGetChar: PROC [] RETURNS [CHAR] = { RETURN [GetC[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: BYTE; 
IF (b _ GetB[h.s])<=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 b FROM
xPopFlag => RETURN [[pop[NIL]]];
xPushFlag => WITH OLDV1InternalReadToken[h] SELECT FROM
atom: Token.atom => RETURN [[push[atom.value]]];
ENDCASE => RETURN [[error[NIL]]];
xTwoByteCard => RETURN [[int[Get2B[h.s]]]];
xRope => RETURN [ [rope[OldGetRope[h]]] ];
xOneBytePos => RETURN [[int[GetB[h.s]]]];
xOneByteNeg => {i: INT = GetB[h.s]; RETURN [[int[-i-1]]]};
xLongInt => RETURN [[int[GetInt[h.s]]]];
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;



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 {
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
};
BEGIN
token: Token = InternalRead[h];
IF doDebug THEN Remember[token];
RETURN [token]
END;
};

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


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 _ GetC[h.s];
IF ch=escChar THEN {
ch _ GetC[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] = {
c: CHAR;
imp: Imp _ h.imp;
IF ~imp.isR THEN ERROR;
IF ~imp.readFunny THEN RETURN;
DO
c _ GetC[h.s];
IF c=escChar THEN {
c _ GetC[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;
PutC[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 PutC[h.s, escChar];
PutC[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 PutC[self, escChar];
PutC[self, block[i]];
ENDLOOP;
};

END.



TokenIOImpl.mesa
Copyright c 1983, 1985, 1986, 1987 by Xerox Corporation.  All rights reserved.
Created by Christian Jacobi August 24, 1983 3:10 pm
Last Edited by: Christian Jacobi, April 7, 1987 5:24:48 pm PDT
-- Terminology
-- 	read, write for encoded, (exported) IO
-- 	get/put for actual unencoded IO
--these x-codes are found on files


--NIL and "" is encoded differently; this fidelity is mainly important for atoms

--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...
--debugging must optional; the MOD operation costs 5% runtime on read!
--we wont speak about the new...



-- STREAM STREAM STREAM STREAM STREAM

--stops and skips until the next token
Κ=˜
codeš
œ™Kšœ
Οm
œC™NKš
œ3™3Kš
œ>™>K˜—š
Οk	˜	KšœžœM˜a—K˜šΟnœžœ
žœ
˜Kšžœžœ8˜LKšžœ˜Kšžœ
žœ˜—Kš
ž˜Kšžœ	˜
K˜Kš
Οc™Kš
 *™*Kš
 #™#K˜Kš
 "™"Kšœžœ	 %˜AKšœžœ	 8˜TK˜Kšœ	žœ
˜Kšœ	žœ˜Kšœžœ˜Kšœžœ˜Kšœžœ˜Kšœ	žœ˜Kšœ	žœ˜Kšœ	žœ˜Kšœ	žœ˜Kšœžœ˜Kšœžœ˜Kšœ
žœ˜Kšœžœ˜Kšœ	žœ˜Kšœ	žœ˜Kšœ	žœ˜Kšœžœ˜Kšœžœ˜K˜Kšœžœ˜+Kšœžœ˜$K™Kšœ	žœ˜K˜KšŸ
œžœ
žœžœ˜&KšŸœžœ
žœžœ
˜K™Kšœžœžœ˜šœžœ
žœžœ˜Kšœžœ
žœ	žœ ˜>Kšœžœžœ
˜Kšœ	žœ
žœ
˜Kšœžœ
˜
Kš
œ˜Kšœžœžœžœžœ
žœ˜7Kšœ	žœžœ
˜Kš
œ
žœ
žœ
žœ
žœž˜*Kš
œ˜—K˜šŸœžœžœ
žœžœžœ˜3Kš
œ%˜%Kš
œ˜—K˜šŸœžœžœ
žœžœžœ˜-Kšœžœžœ˜,Kš
œ˜—K˜šŸœžœžœ
žœžœžœ˜8Kš
œ+˜+Kš
œ˜—K˜šŸœžœžœ
žœžœžœ
žœ˜8Kš
œ+˜+Kš
œ˜—K˜šŸœžœžœ
žœ
žœžœ˜5Kš
 P™PKšžœžœ
žœ
˜šžœ˜Kšœžœ˜šžœ
˜Kšžœ˜Kšžœ!˜%—Kšžœ˜K˜
—Kš
œ˜K˜—šŸœžœž	œžœžœžœ˜6Kšžœ!˜'K˜K™—šŸœžœžœ
žœžœžœžœ˜6Kšœžœ˜'Kš
œ˜—K˜šŸœžœžœ
žœžœžœžœ
žœ˜AKšžœ/žœ
žœ˜IK˜K˜—šŸœžœžœ
žœžœžœžœ
žœ˜AKšžœ/žœ
žœ˜JKš
œ˜K˜—šŸœžœžœ
žœžœžœžœ˜;Kš
Ÿœžœžœžœžœ
˜8Kšœžœ˜šžœžœ˜Kš
žœ
žœ
žœžœ
žœ˜4K˜—Kšžœžœ
žœ˜Kšžœ+˜1Kš
œ˜K˜—šŸœžœ
žœžœžœžœ˜;Kšžœžœžœ
žœ
žœ
žœ˜3K˜—K˜šŸœžœ
žœ˜,šžœžœ
ž˜Kš
œ)˜)Kš
œ-˜-Kš
œ1˜1Kš
œ˜Kš
œ-˜-Kš
œ-˜-Kš
œ-˜-Kšœžœ
˜"Kšœ"žœ
˜(Kšœžœ
˜Kšžœžœ
˜—K˜—K˜šŸœžœ
žœžœ˜-Kšžœ	žœ
žœ	˜Kšžœ	žœ˜ šžœ
žœ
ž˜Kšœžœ0˜4Kšœžœ0˜4Kš	œžœžœ
žœ
žœ*˜BKšœžœ5˜9Kš	œžœžœ
žœ
žœ1˜GKšžœ'˜.—Kš
œ˜—K˜šŸ	œžœ
žœžœ˜/Kšœžœ˜ Kšœžœ
žœ
˜Kš
œ˜Kšžœ	žœ
žœ	˜Kšžœ	žœ˜ Kš
œ>˜>šžœ˜
Kšžœ7˜;Kšžœ˜—Kš
œ˜K˜—šŸ	œžœ
žœžœ˜4Kšœžœ
žœ
˜Kš
œ˜Kšžœ	žœ
žœ	˜Kšžœ	žœ˜ Kš
œ>˜>šžœ˜
Kšžœ7˜;Kšžœ%˜)—Kš
œ˜K˜—š
Ÿ	œžœ
žœžœ
žœ˜3Kšžœ	žœ
žœ	˜Kšžœ	žœ˜ Kš
œ"˜"Kš
œ˜K˜—š
Ÿ
œžœ
žœžœ
žœ˜4Kšžœ	žœ
žœ	˜Kšžœ	žœ˜ Kš
œ#˜#Kš
œ˜K˜—šŸœžœ
žœ˜%Kšžœ	žœ
žœ	˜Kšžœ	žœ˜ Kš
œ˜Kš
œ˜K˜—šŸ	œžœ
žœžœ˜/Kš
œ<˜<Kšžœ	žœ
žœ	˜Kšžœ	žœ˜ Kš
œ;˜;Kš
œ˜K˜—š
Ÿœžœ
žœžœžœ˜GKšœžœ
˜	Kšžœ	žœ
žœ	˜Kšžœ	žœ˜ Kš
œ˜Kšœžœ˜Kš
œ˜Kšžœžœ
žœ˜Kš
œ˜K˜—šŸ
œžœ
žœ žœ˜?Kš	œžœžœžœ
žœ˜%Kšœžœžœ˜Kšžœ	žœ
žœ	˜Kšžœ˜Kš
œ˜Kšžœ˜Kš
œ˜—K˜šŸœžœ
žœžœ˜?šžœ˜	šžœ˜Kšžœžœ
žœ˜-Kš
œ˜—šžœ˜
šžœžœ˜Kšœžœ˜Kšœžœ$žœžœ˜Dš
œ7˜7Kš
œ-˜-Kš
œ˜—Kšœ "˜%—K˜—šžœ˜
š
œ7˜7Kš
œ-˜-Kš
œ˜—Kšœ "˜%—šœ
žœ˜Kš
œ4˜4Kšžœžœ
žœ
˜(K˜—K˜—K˜š
Ÿ	œžœžœ
žœžœ˜4Kšœžœ
˜šžœ
žœ
ž˜Kšœžœ6˜:Kšžœžœ
˜—Kš
œ˜—K˜Kš
œ˜Kšœžœ˜	šžœžœ "˜Cšžœ
žœ
ž˜Kšœžœžœ˜=Kšœžœžœ'˜HKšžœžœ
˜—K˜
—šžœ˜šžœž˜
Kšœ
žœ˜%Kšœ
žœ˜$Kšœžœžœ˜šœ
žœžœ
ž˜*Kšœžœ˜1Kšžœžœ	žœ˜!—šœ	žœžœ
ž˜)Kšœžœ˜0Kšžœžœ	žœ˜!—šœ	žœžœ˜2Kšžœ
žœ˜#Kšžœ
žœ˜—Kšœ
žœ˜'Kšœžœžœ˜5Kšœ	žœ˜%Kšœžœžœ˜6Kšœ
žœ%˜5Kšœžœžœ˜8š
œ
˜
Kš
œS˜SKšžœ˜Kš
œ˜—Kšžœžœ
˜—K˜
—š
ž˜Kšœžœ	žœ˜%š
œ˜Kš
œ6˜6Kšžœ˜Kš
œ˜——Kš
œ˜—K˜šŸœžœ
žœžœ˜Gš
ž˜šžœ˜	Kšžœžœžœ
žœ˜@Kšžœ
žœžœ
žœ˜:šœ
žœ˜Kš
œ6˜6Kšžœžœ
žœ
˜(K˜
—K˜——K˜Kšœ
žœ˜Kšœžœ˜Kšœžœ˜Kšœ
žœ˜Kšœžœ˜šœžœ ˜"Kšœžœ˜—Kšœžœ˜Kšœžœ˜'Kšœžœžœ!˜OKšœžœ˜Kšœžœ˜Kšœ
žœ˜Kšœ
žœ˜K˜šŸ
œžœ
žœžœ˜5Kš
Ÿœžœžœ
žœžœ˜:Kšœžœ
˜Kšžœ
žœ˜$Kšžœžœ
žœ˜Kšžœ+˜1Kš
œ˜K˜—šŸ
œžœ
žœžœ˜2Kšœžœ˜Kšžœžœ
žœžœ
˜*Kšžœ
žœ˜!Kš
œ˜—K˜šŸœžœžœžœ˜3Kšœžœ
˜šžœ
žœ
ž˜šœžœ%˜)Kš
œ˜Kš
œ$˜$Kš
œ˜—Kšžœž˜—Kš
œ˜—K˜Kšœžœ˜	šžœ žœ "˜Jšžœ
žœ
ž˜Kšœžœ%žœ˜Kšœžœ$˜(Kšœž
˜Kšžœ˜"Kš
œ˜—Kšœžœ˜3Kšžœžœ
˜—K˜
—šžœ˜šžœž˜
Kšœžœžœ˜ šœ
žœžœ
ž˜7Kšœžœ˜0Kšžœžœ	žœ˜!—Kšœžœ˜+Kšœ	žœ˜*Kšœžœ˜)Kšœžœžœ˜:Kšœžœ˜(Kšœžœžœ˜@Kšžœžœ
˜—K˜
—š
ž˜Kšœžœ	žœ˜%š
œ˜Kš
œ6˜6Kšžœ˜Kš
œ˜——Kšžœ
˜—K˜K˜Kš
 <™<Kš
 J™JKš
 !™!K˜Kšœ
žœ˜š	œ
žœ
žœžœ
žœ˜1Kš	œžœ
žœžœ
žœ˜)—Kš
œ˜Kšœ	žœžœ
˜K˜šŸœžœžœ˜(Kš
 F™FKš
  ™ Kšœžœ˜,Kšœžœ
˜)K˜—K™šŸœžœ
žœžœ˜%Kšžœ8žœ˜EKš
œ˜—K˜š
Ÿœžœ
žœ
žœžœ˜>šžœ	žœ˜K˜šžœžœ
žœ˜Kš
œ$˜$Kš
œ#˜#Kšžœžœ
žœžœ˜AKšžœ˜Kš
œ
˜
—šžœ
žœžœ˜Kš
œ˜K˜
—šžœ
žœ
žœ˜Kš
œ)˜)Kšžœ	žœ˜ Kšžœ˜K˜
—Kšžœ
ž˜
Kš
œ˜—š
ž˜Kš
œ˜Kšžœ	žœ˜ Kšžœ˜Kšžœ
˜—Kš
œ˜—K˜šŸ	œžœ
žœ˜0K˜Kšœ
žœ
˜Kšœžœ˜'Kš
œ˜K˜—š
Ÿœžœ
žœžœ
žœ˜:Kšžœ
žœ
žœ˜"K˜—K˜šŸœžœ
žœ
žœžœ
žœžœ
žœžœ	žœžœ
˜vKšžœžœ
žœžœ
žœ
žœ˜(šžœžœ˜Kš
œ˜Kšœžœ
˜
šœžœ	˜Kš
œ˜Kš
œ˜Kš
œ˜—Kšœžœ
˜Kš
œ
˜
Kšœžœžœ
˜*Kš
œ˜—K˜—K˜šŸœžœ
žœ
žœ
žœžœ
žœ
žœžœžœ˜qKšœžœ
˜Kšœžœ˜.Kšœžœžœ	˜.šžœžœ˜Kš
œ=˜=Kšžœžœ2˜>Kšžœžœ2˜=Kšžœ˜K˜—Kšœžœžœ	˜.šžœžœ˜šžœžœ˜
K˜Kš
œ-˜-Kš
œžœ
žœ
žœ
žœžœ
žœ˜6Kšœžœžœ
˜#K˜
—šžœ˜Kš
œ;˜;Kšžœ˜K˜
—K˜—šžœ˜Kš
œ3˜3Kšžœ˜K˜—K˜K™—šŸœžœ
žœ
žœ
žœžœ
žœ
žœ	žœ
žœžœ˜kKšœžœ˜&Kš
œ˜šœžœ˜šœžœ˜Kš
œ9˜9Kšžœ˜Kš
œ
˜
—Kš
œ˜—Kš
œ˜Kš
œ˜K˜K˜—šŸœžœ˜%Kš
œ˜Kšžœ˜K˜—K˜š
Ÿœžœ
žœ
žœžœ˜4Kš
œ˜šžœžœ
ž˜Kšœžœ
˜%Kšžœ˜—Kš
œ˜K˜—šŸœžœ
žœ
žœžœ
žœ˜8Kš
œ˜šžœžœ
ž˜Kšœžœ˜(Kšžœ˜—Kš
œ˜K˜—šŸœžœ
žœ
žœžœ
žœ˜=Kš
œ˜šžœžœ
ž˜Kšœžœ˜(Kšžœ˜—Kš
œ˜K˜—šŸœžœ
žœ˜$Kš
œ˜šžœžœ
ž˜Kšœžœ
˜Kšžœ˜—Kš
œ˜—K˜šŸœžœ
žœ
žœžœ
žœ˜8Kš
œ˜šžœžœ
ž˜Kšœžœ˜(Kšžœ˜—Kš
œ˜—K˜šŸ	œžœ
žœ
žœžœ
žœ˜9Kš
œ˜šžœžœ
ž˜Kšœžœ˜+Kšžœ˜—Kš
œ˜—K˜š
Ÿœžœ
žœ
žœžœ˜6Kš
œ˜šžœžœ
ž˜Kšœžœ˜(Kšžœ˜—Kš
œ˜—K˜šŸœžœ
žœ˜!Kšœžœ˜š
ž˜Kš
œ˜šžœžœ
ž˜š
œ˜K˜Kšžœ
žœ
žœ˜%šžœ˜Kš
œ˜Kš
œ˜Kš
œ
˜
—Kš
œ˜—Kš
œ$˜$Kš	œžœžœ
žœ
žœ˜:Kš
œ,˜,Kšœ4žœ˜<Kšžœžœ
˜—Kšžœžœ
žœ
˜Kš
œ˜Kš
ž˜—K˜—K˜K™Kš
 %™%K˜šŸ
œžœ
žœ
žœžœ
žœ˜>K˜Kšžœ
žœ
žœ
˜Kšžœ
žœ
žœžœ4˜VKš
œ
˜
Kš
œ˜K™—šŸœžœ
žœ
žœžœ
žœ˜?K˜Kšžœ	žœ
žœ
˜Kšžœ
žœ
žœžœ4˜VKš
œ
˜
Kšžœ
žœ˜"Kš
œ˜—K˜šœ
žœ
žœžœ˜4K˜K˜Kš
œ˜Kš
œ˜Kš
œ˜—K˜šœ
žœ
žœžœ˜4K˜K˜Kš
œ˜Kš
œ˜—K˜šŸ
œžœžœ
žœžœžœ˜<Kšœžœ˜$Kš
œ˜Kšžœ
žœ
žœ
˜Kšžœžœ
žœ˜+Kš
œ˜šžœžœ˜Kš
œ˜Kšžœžœ
žœ˜$Kšœžœ˜K˜K˜—K˜—K˜šŸ
œžœ˜#Kš
œ˜Kšžœ
žœ
žœ
˜Kšœžœžœ
˜%Kš
œ˜—K˜šŸœžœ˜"Kš
 &™&Kšœžœ
˜Kš
œ˜Kšžœ
žœ
žœ
˜Kšžœžœ
žœ
˜š
ž˜Kš
œ˜šžœžœ˜Kš
œ˜Kšžœžœ
ž˜Kš
œ˜—Kšžœ
˜—Kšœžœ
˜Kšœžœ
žœ
˜+Kš
œ˜—K˜šŸœžœ˜"Kš
œ˜Kšžœ	žœ
žœ
˜Kšžœ
žœ
žœ
˜Kš
œ˜Kš
œ
˜
Kšœ
žœ
˜K˜—K˜šŸ
œžœ˜#Kš
œ˜Kšžœ	žœ
žœ
˜Kšžœ	žœ
žœ
˜Kšœ
žœ
˜Kš
œ˜K˜—K˜š
Ÿ
œžœžœ
žœžœ˜2Kšœžœ˜$Kšžœ
žœ˜"Kšžœžœ˜(Kš
œ˜Kš
œ˜—K˜šŸœžœžœ
žœ	žœ
žœ
žœžœ	žœ˜^šŸœžœžœžœžœžœ˜1Kšžœžœ
žœžœžœ
žœ˜0K˜—KšΟrΠkr‘œ‘
œ‘
˜2Kšœžœ˜$Kšžœ
žœ˜"š’‘’‘
’‘"’˜1Kš
’‘
œ‘
’‘
œ‘
œ
‘˜-Kšœ‘
œ‘
˜Kš’‘
˜—Kš
œ˜K˜—Kšžœ
˜K˜K˜K˜—…—Bξc=