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, October 30, 1986 6:38:15 pm PST
DIRECTORY
Atom, Basics, FS, IO, LRUCache, PropertyLists, 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: NAT = 237; -- this is really a TokenStreams file
xVersionCode: NAT = 2; -- this is really a TokenStreams file of correct version
xTabMin: NAT = 0;
xTabMax: NAT = 100;
xIntSFirst: NAT = 101;
xIntSLast: NAT = 241;
xRes: NAT = 242;
xIntN1: NAT = 243;
xIntP1: NAT = 244;
xIntN2: NAT = 245;
xIntP2: NAT = 246;
xInt4: NAT = 247;
xReal: NAT = 248;
xStream: NAT = 249;
xRope: NAT = 250;
xFillR: NAT = 251;
xFillA: NAT = 252;
xPush2: NAT = 253;
xPush: NAT = 254;
xPop: NAT = 255;
shortNatLast: NAT = xIntSLast-xIntSFirst;
tabSize: NAT = 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:
CARDINAL] =
INLINE {
IO. PutChar[s, LOOPHOLE[c, CHAR]];
s.streamProcs.putChar[s, LOOPHOLE[c, CHAR]];
};
PutInt:
PROC [s:
IO.
STREAM, i:
INT] =
INLINE {
long: Basics.LongNumber = Basics.LongNumber[li[li: i]];
Put2B[s, long.lowbits];
Put2B[s, long.highbits];
};
Put2B:
PROC [s:
IO.
STREAM, c:
CARDINAL] =
INLINE {
InlinePutChar[s, LOOPHOLE[c / 256, CHAR]];
InlinePutChar[s, LOOPHOLE[c MOD 256, CHAR]];
};
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: [0..255]] =
INLINE {
c ← LOOPHOLE[IO.GetChar[s], [0..255]];
c ← LOOPHOLE[s.streamProcs.getChar[s], [0..255]];
};
Get2B:
PROC [s:
IO.
STREAM]
RETURNS [c:
CARDINAL] =
INLINE {
h: [0..255] ~ GetB[s];
c ← h*256+GetB[s];
};
GetInt:
PROC [s:
IO.
STREAM]
RETURNS [
INT] =
INLINE {
long: Basics.LongNumber = Basics.LongNumber[num[
lowbits: Get2B[s],
highbits: Get2B[s]
]];
RETURN [long.li]
};
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[CARDINAL]]] => {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[CARDINAL]]..-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.lowbits];
Put2B[h.s, long.highbits];
};
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[num[
lowbits: Get2B[h.s],
highbits: 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[PropertyLists.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]
RETURNS [h: Handle] = {
h ← CommonCreate[stream, stop, FALSE];
[] ←
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𡤀] = {
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𡤀] = {
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�] = {
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.