DIRECTORY
Atom, Basics, IO, Rope, SafeStorage, TokenIO;

TokenIOImpl: CEDAR MONITOR 
IMPORTS Atom, IO, Rope, SafeStorage 
EXPORTS TokenIO =
BEGIN


xTokenIOCode: CARDINAL = 237;  -- this is really a TokenIO file
xVersionCode: CARDINAL = 1;  -- this is really a TokenIO file of correct version

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;

Mark: TYPE = REF MarkRep;
MarkRep: PUBLIC TYPE = RECORD [index: INT];
TokenType: TYPE = TokenIO.TokenType; 
--{atom, int, rope, pushFlag, popFlag, endOfStream, error};
Token: TYPE = TokenIO.Token;
--RECORD [
--kind: TokenType,
--ref: REF_NIL   - - either ATOM, Rope.ROPE, REF INT or NIL (Rope.ROPE or NIL if error)
--];

writer: IO.STREAM_NIL;
stopWriting: PUBLIC BOOL _ FALSE;
LinkRecord: TYPE = RECORD[older, younger: INTEGER];
accessList: REF ARRAY [dummy..xReadTableMax] OF LinkRecord = 
NEW[ARRAY [dummy..xReadTableMax] OF LinkRecord];
wAtomTable: REF ARRAY [xReadTableMin..xReadTableMax] OF ATOM =
NEW[ARRAY [xReadTableMin..xReadTableMax] OF ATOM];
freeEntry: INTEGER;
lastEntry: INTEGER = xReadTableMax;

reader: IO.STREAM _ NIL;
readAgain: BOOL _ FALSE;
token: Token; 
rTtable: REF ARRAY [xReadTableMin..xReadTableMax] OF Token = 
NEW[ARRAY [xReadTableMin..xReadTableMax] OF Token];
zone: ZONE _ SafeStorage.GetSystemZone[];


WritingStopped: PUBLIC SIGNAL = CODE;

PutByte: PROC [c: CARDINAL] = INLINE {
IO.PutChar[writer, LOOPHOLE[c, CHAR]];
};

PutInt: PROC [i: INT] = INLINE {
Long: Basics.LongNumber = Basics.LongNumber[li[li: i]]; 
Put2Bytes[Long.lowbits];
Put2Bytes[Long.highbits];
};

Put2Bytes: PROC [c: CARDINAL] = INLINE {
IO.PutChar[writer, LOOPHOLE[c / 256, CHAR]];
IO.PutChar[writer, LOOPHOLE[c MOD 256, CHAR]];
};

PutRope: PROC [r: Rope.ROPE] = INLINE {
leng: INT = Rope.Length[r];
IF leng<255 THEN PutByte[leng] ELSE {PutByte[255]; PutInt[leng]};
IO.PutRope[writer, r];
};

PutAtom: PROC [a: ATOM] = INLINE {
IF a=NIL THEN PutByte[0] ELSE PutRope[Atom.GetPName[a]];
};

GetChar: PROC [] RETURNS[CHAR] = {
RETURN [IO.GetChar[reader]];
};

GetByte: PROC [] RETURNS[c: [0..255]] = INLINE {
c _ LOOPHOLE[IO.GetChar[reader], [0..255]];
};

Get2Bytes: PROC [] RETURNS [c: CARDINAL] = INLINE {
h: [0..255] = GetByte[];
c _ h*256+GetByte[];
};

GetInt: PROC [] RETURNS[INT] = INLINE {
long: Basics.LongNumber = Basics.LongNumber[num[ 
lowbits: Get2Bytes[],
highbits: Get2Bytes[]
]];
RETURN [long.li]
};

GetRope: PROC [] RETURNS[Rope.ROPE] = INLINE {
leng: INT _ GetByte[];
IF leng=255 THEN leng_GetInt[];
IF leng=0 THEN RETURN [""];
RETURN [ Rope.FromProc[len: leng, p: GetChar] ];
};

GetAtom: PROC [] RETURNS [a: ATOM] = INLINE {
r: Rope.ROPE = GetRope[];
IF r=NIL OR r="" THEN RETURN [NIL]
ELSE RETURN [ Atom.MakeAtom[r] ];
};

FillTable: PROC[] RETURNS [t: Token] =
BEGIN
c: CARDINAL = GetByte[];
SELECT TRUE FROM
c IN [xReadTableMin..xReadTableMax] => {t _ rTtable[c] _ Token[kind: atom, ref: GetAtom[]]};
ENDCASE => ERROR
END;

WriteInt: PUBLIC PROC [i: INT] =
BEGIN
ENABLE UNWIND => NULL;
IF stopWriting THEN SIGNAL WritingStopped;
SELECT TRUE FROM
i IN [0..shortNatLast] => {PutByte[i+xFirstShortNat]};
i IN [0..255]  => {PutByte[xOneBytePos]; PutByte[i]};
i IN [0..INT[LAST[CARDINAL]]] => {PutByte[xTwoByteCard]; Put2Bytes[i]};
i IN [-256..-1]  => {PutByte[xOneByteNeg]; PutByte[-i-1]};
i IN [-INT[LAST[CARDINAL]]..-1] => {PutByte[xTwoByteNegative]; Put2Bytes[-i-1]};
ENDCASE => {PutByte[xLongInt]; PutInt[i]};
END;

WriteAtom: PUBLIC PROC [a: ATOM] =
BEGIN
ENABLE UNWIND => NULL;
i: INTEGER;
BEGIN
IF stopWriting THEN SIGNAL WritingStopped;
FOR i _ accessList[dummy].older, accessList[i].older WHILE i#dummy DO
IF a=wAtomTable[i] THEN
BEGIN
PutByte[i];
accessList[accessList[i].older].younger _ accessList[i].younger;
accessList[accessList[i].younger].older _ accessList[i].older;
GOTO touchI
END;
ENDLOOP;
-- not found
IF freeEntry<=xReadTableMax THEN
BEGIN
i _ freeEntry; 
freeEntry _ freeEntry + 1;
END
ELSE
BEGIN
i _ accessList[dummy].younger;
accessList[dummy].younger _ accessList[i].younger;
accessList[accessList[i].younger].older _ dummy;
END;
wAtomTable[i] _ a;
PutByte[xFillTable];
PutByte[i];
PutAtom[a];
GOTO touchI;
EXITS
touchI --i is touched atom-- => {
accessList[i].older _ accessList[dummy].older;
accessList[i].younger _ dummy;
accessList[accessList[dummy].older].younger _ i;
accessList[dummy].older _ i;
};
END;
END;

WriteRope: PUBLIC PROC [r: Rope.ROPE] =
BEGIN
ENABLE UNWIND => NULL;
IF stopWriting THEN SIGNAL WritingStopped;
PutByte[xRope];
PutRope[r];
END;

WritePushFlag: PUBLIC PROC [a: ATOM_NIL] =
BEGIN
ENABLE UNWIND => NULL;
IF stopWriting THEN SIGNAL WritingStopped;
PutByte[xPushFlag];
WriteAtom[a];
END;

WritePopFlag: PUBLIC PROC [] =
BEGIN
ENABLE UNWIND => NULL;
IF stopWriting THEN SIGNAL WritingStopped;
PutByte[xPopFlag];
END;

MarkAndWriteInt: PUBLIC PROC [value: INT] RETURNS [Mark] =
BEGIN
ENABLE UNWIND => NULL;
mark: Mark = zone.NEW[MarkRep];
IF stopWriting THEN SIGNAL WritingStopped;
PutByte[xLongInt];
mark.index _ IO.GetIndex[writer];
PutInt[value];
RETURN [mark]
END;

UpdateMark: PUBLIC PROC [mark: Mark, value: INT] =
BEGIN
ENABLE UNWIND => NULL;
pos: INT = IO.GetIndex[writer];
IO.SetIndex[writer, mark.index];
PutInt[value];
IO.SetIndex[writer, pos];
END;

InternalReadToken: PROC [] RETURNS [Token] =
BEGIN
ENABLE { 
UNWIND => NULL;
ANY => GOTO errorReturn;
};
b: [0..255] _ GetByte[! IO.EndOfStream => GOTO endOfStreamReturn];
SELECT TRUE FROM
b=xPopFlag => {RETURN [Token[kind: popFlag, ref: NIL]]};
b=xLongInt => {RETURN [Token[kind: int, ref: zone.NEW[INT_GetInt[]]]]};
b=xRope => {RETURN [Token[kind: rope, ref: GetRope[]]]};
b=xPushFlag => {
t: Token _ InternalReadToken[];
IF t.kind#atom THEN RETURN [Token[kind: error, ref: NIL]];
RETURN [Token[kind: pushFlag, ref: t.ref]]
};
b IN [xReadTableMin..xReadTableMax] => {RETURN [rTtable[b]]};
b=xFillTable => {RETURN FillTable[]};
b IN [xFirstShortNat..xLastShortNat] => 
{RETURN [Token[kind: int, ref: zone.NEW[INT_ b-xFirstShortNat]]]};
b=xTwoByteCard => {RETURN [Token[kind: int, ref: zone.NEW[INT_Get2Bytes[]]]]};
b=xTwoByteNegative => 
{i: INT = Get2Bytes[]; RETURN [Token[kind: int, ref: zone.NEW[INT_-i-1]]]};
b=xOneBytePos => {RETURN [Token[kind: int, ref: zone.NEW[INT_GetByte[]]]]};
b=xOneByteNeg => 
{i: INT = GetByte[]; RETURN [Token[kind: int, ref: zone.NEW[INT_-i-1]]]};
ENDCASE => ERROR;
EXITS
errorReturn => {RETURN [Token[kind: error, ref: NIL]]};
endOfStreamReturn => {RETURN [Token[kind: endOfStream, ref: NIL]]};
END;


debugMax: NAT = 10;
debugBuffer: ARRAY [0..debugMax) OF Token;
debugIndex:  [0..debugMax] _ 0;

ReadToken: PUBLIC PROC [] RETURNS [Token] =
BEGIN
ENABLE UNWIND => NULL;
IF readAgain THEN {readAgain_FALSE; RETURN [token]};
token _ InternalReadToken[];
debugBuffer[debugIndex] _ token; debugIndex _ (debugIndex+1) MOD debugMax;
RETURN [token]
END;

ReadAgain: PUBLIC PROC [] =
BEGIN
readAgain _ TRUE
END;


Error: PUBLIC ERROR[why: TokenIO.Err, explanation: REF_NIL] = CODE;  
-- only on Attach or Release

AttachReader: PUBLIC ENTRY PROC [stream: IO.STREAM] =
BEGIN
ENABLE UNWIND => NULL;
IF reader#NIL THEN ERROR Error[why: alreadyAttached, explanation: Rope.FromRefText["file is already attached"]];
reader _ stream;
IF GetByte[]#xTokenIOCode THEN { 
reader _ NIL;
ERROR Error[why: wrongVersion, explanation: Rope.FromRefText["file not produced with TokenIO"]];
};
IF GetByte[]#xVersionCode THEN { 
reader _ NIL;
ERROR Error[why: wrongVersion, explanation: Rope.FromRefText["TokenIO version missmatch"]];
}
END;

ReleaseReader: PUBLIC ENTRY PROC [] =
BEGIN
reader _ NIL
END;

AttachWriter: PUBLIC ENTRY PROC [stream: IO.STREAM] =
BEGIN
ENABLE UNWIND => NULL;
IF writer#NIL THEN ERROR Error[why: alreadyAttached, explanation: Rope.FromRefText["file is already attached"]];
[] _ IO.GetIndex[stream! ANY => GOTO NoGetIndex];
stopWriting _ FALSE;
freeEntry _ xReadTableMin;
writer _ stream;
accessList[dummy] _ LinkRecord[dummy, dummy];
freeEntry _ xReadTableMin;
PutByte[xTokenIOCode];
PutByte[xVersionCode];
EXITS
NoGetIndex => Error[why: other, explanation: Rope.FromRefText["file uses stream without GetIndex"]];
END;

ReleaseWriter: PUBLIC ENTRY PROC [] =
BEGIN
writer _ NIL
END;


EncodingError: PUBLIC ERROR = CODE;

ReadInt: PUBLIC PROC [] RETURNS [INT] =
BEGIN
t: Token = ReadToken[];
IF t.kind#int THEN ERROR EncodingError;
RETURN [NARROW[t.ref, REF INT]^]
END;

ReadAtom: PUBLIC PROC [] RETURNS [ATOM] =
BEGIN
t: Token = ReadToken[];
IF t.kind#atom THEN ERROR EncodingError;
RETURN [NARROW[t.ref, ATOM]]
END;

ReadRope: PUBLIC PROC [] RETURNS [Rope.ROPE] =
BEGIN
t: Token = ReadToken[];
IF t.kind#rope THEN ERROR EncodingError;
RETURN [NARROW[t.ref, Rope.ROPE]]
END;

ReadPushFlag: PUBLIC PROC [] RETURNS [ATOM] =
BEGIN
t: Token = ReadToken[];
IF t.kind#pushFlag THEN ERROR EncodingError;
RETURN [NARROW[t.ref, ATOM]]
END;

ReadPopFlag: PUBLIC PROC [] =
BEGIN
t: Token = ReadToken[];
IF t.kind#TokenType[popFlag] THEN ERROR EncodingError;
END;

END.


ˆTokenIOImpl.mesa
by Christian Jacobi August 24, 1983 3:10 pm
last edited by Christian Jacobi December 14, 1983 2:15 pm
-- we use read, write for encoded, (exported) IO
-- we use get/put for actual unencoded IO
-- codes

-- types
--kind = atom => ISTYPE[ref, ATOM]
--kind = int => ISTYPE[ref, REF INT]
--kind = rope => ISTYPE[ref, Rope.ROPE] 
--kind = pushFlag => ref=NIL or ISTYPE[ref, ATOM]
--kind = popFlag => ref=NIL 
--kind = endOfStream => ref=NIL
--kind = error => ref=NIL OR ISTYPE[ref, Rope.ROPE] 
-- output tables
--doubly linked LRU list
--input tables
-- Remove atom i from access list
--Determine where atom will go in table
--reuse oldest entry
--Add atom to atom table
--Put atom most recently touched (i) at the front
--b=xAtomText => {RETURN [Token[kind: atom, ref: GetAtom[]]]};
--features used to debug TokenIO and other chipndale IO
--cause next call of ReadToken to get the same value as the last read
--works only one level deep (reads again only the last value returned by ReadToken)
--Attaching TokenIo to STREAMS
--while TokenIo is attached to a stream no other operations on this
--stream should occur 
--also invalidates marks
�ʘJš
œ™Jš
œ+™+Jš
œ9™9J˜š
Ïk	˜	Jšœ�œ˜-J˜—JšÏnœ�œ
�œ
˜Jš�œ�œ˜$Jš�œ
˜Jš
�˜J˜Jš
œ0™0Jš
œ)™)J˜Jš
œ™Jšœ�œ)˜?Jšœ�œ:˜PJ˜Jšœ
�œ˜Jšœ�œ˜Jšœ�œ˜Jšœ
�œ˜Jšœ�œ˜šœ�œÏc˜&Jšœ�œ˜!—Jšœ�œ˜Jšœ�œ˜+Jšœ�œ�œ!˜WJšœ�œ˜Jšœ�œ˜!Jšœ
�œ˜Jšœ
�œ˜J˜J™Jš
œ™Jšœ�œ�œ	˜Jš	œ	�œ
�œ�œ	�œ˜+šœ�œ˜%Jš
œ;˜;—šœ�œ˜š�œ˜
J˜Jšœ�œ
�œŸF˜WJ˜Jš
œ"™"Jš
œ$™$Jš
œ(™(Jš
œ1™1Jš
œ™Jš
œ™Jš
œ4™4——J˜Jš
œ™Jšœ�œ
�œ
�œ
˜Jšœ
�œ�œ
˜!Jšœ�œ�œ�œ˜3šœ�œ
�œ�œ˜=Jš�œ
�œ�œ
˜0Jš
œ™—š	œ�œ
�œ �œ
�œ˜>Jš�œ
�œ �œ
�œ˜2—Jšœ�˜Jšœ�œ˜#J˜Jš
œ™Jšœ�œ
�œ
�œ
˜Jšœ�œ�œ
˜Jš
œ˜šœ	�œ
�œ �œ	˜=Jš�œ
�œ �œ˜3—Jšœ�œ˜)J˜J˜Jšœ�œ
�œ�œ
˜%J˜šžœ�œ�œ�œ˜&Jš�œ�œ�œ˜&Jš
œ˜—J˜šžœ�œ�œ�œ˜ Jš
œ8˜8Jš
œ˜Jš
œ˜Jš
œ˜—J˜šž	œ�œ�œ�œ˜(Jš�œ�œ
�œ˜,Jš�œ�œ�œ�œ˜.Jš
œ˜—J˜šžœ�œ
�œ�œ˜'Jšœ�œ˜Jš�œ
�œ�œ˜AJš�œ˜Jš
œ˜J˜—šžœ�œ�œ�œ˜"Jš�œ�œ
�œ�œ˜8Jš
œ˜J˜—šžœ�œ
�œ˜"Jš�œ�œ˜Jš
œ˜J˜—šžœ�œ�œ˜0Jšœ�œ
�œ˜+Jš
œ˜—J˜šž	œ�œ�œ�œ˜3Jš
œ˜Jš
œ˜J˜J˜—š
žœ�œ�œ
�œ�œ˜'š
œ1˜1Jš
œ˜Jš
œ˜J˜—Jš�œ
˜Jš
œ˜J˜—š
žœ�œ�œ�œ�œ˜.Jšœ�œ
˜Jš�œ
�œ˜Jš�œ�œ
�œ˜Jš�œ*˜0Jš
œ˜J˜—š
žœ�œ�œ�œ�œ˜-Jšœ�œ
˜Jš�œ�œ
�œ�œ
�œ�œ
˜"Jš�œ
�œ˜!Jš
œ˜—J˜šž	œ�œ�œ˜&Jš
�˜Jšœ�œ
˜š�œ�˜Jš
œ\˜\Jš�œ�˜—Jš�œ
˜—J˜šžœ�œ
�œ�œ˜ š
�˜Jš�œ
�œ�œ
˜—Jš�œ
�œ
�œ˜*š�œ
�œ
�˜Jšœ�œ2˜6Jšœ�œ1˜5Jš	œ�œ�œ
�œ
�œ-˜GJšœ�œ6˜:Jš	œ�œ�œ
�œ
�œ8˜PJš�œ#˜*—Jš�œ
˜—J˜šž	œ�œ
�œ�œ˜"š
�˜Jš�œ
�œ�œ
˜—šœ�œ
˜Jš
�˜Jš�œ
�œ
�œ˜*š�œ2�œ	�˜Eš�œ�˜Jš
�˜J˜J™!J˜@J˜>Jš�œ˜Jš�œ
˜—Jš�œ
˜—Jš
Ÿ˜J™'š�œ�˜ Jš
�˜Jš
œ˜Jš
œ˜Jš
�˜—š
�˜J™Jš
�˜Jš
œ˜Jš
œ2˜2Jš
œ0˜0Jš�œ
˜—J™J˜J˜J˜Jš
œ˜Jš�œ˜š
�˜šœŸœ˜!Jš
œ1™1Jš
œ.˜.Jš
œ˜Jš
œ0˜0Jš
œ˜J˜——Jš
�˜—Jš�œ
˜J˜—šž	œ�œ
�œ˜'š
�˜Jš�œ
�œ�œ
˜—Jš�œ
�œ
�œ˜*Jš
œ˜Jš
œ˜Jš�œ
˜J˜—šž
œ�œ�œ
�œ˜*š
�˜Jš�œ
�œ�œ
˜—Jš�œ
�œ
�œ˜*Jš
œ˜Jš
œ
˜
Jš�œ
˜J˜—šžœ�œ˜š
�˜Jš�œ
�œ�œ
˜—Jš�œ
�œ
�œ˜*Jš
œ˜Jš�œ
˜J˜—š
žœ�œ
�œ	�œ�œ	˜:š
�˜Jš�œ
�œ�œ
˜—Jšœ�œ
˜Jš�œ
�œ
�œ˜*Jš
œ˜Jšœ
�œ˜!Jš
œ˜Jš�œ˜
Jš�œ
˜J˜—šž
œ�œ
�œ�œ˜2š
�˜Jš�œ
�œ�œ
˜—Jšœ�œ�œ˜Jš�œ˜ Jš
œ˜Jš�œ˜Jš�œ
˜—J˜šžœ�œ�œ
˜,š
�˜š�œ˜	Jš�œ�œ
˜Jš�œ�œ
˜J˜——Jšœ�œ�œ˜Bš�œ
�œ
�˜Jšœ�œ�œ˜8Jšœ�œ�œ
�œ˜GJšœ�œ&˜8Jš
œ>™>š
œ˜Jš
œ˜Jš�œ
�œ
�œ�œ˜:Jš�œ$˜*Jš
œ˜—Jšœ�œ$�œ˜=Jšœ�œ˜%šœ�œ$˜(Jšœ
�œ�œ
�œ˜B—Jšœ�œ�œ
�œ˜Nš
œ˜Jš	œ�œ�œ�œ
�œ
˜K—Jšœ�œ�œ
�œ˜Kš
œ˜Jš	œ�œ�œ�œ
�œ
˜I—Jš�œ�œ
˜—š
�˜Jšœ�œ�œ˜7Jšœ�œ �œ˜C—Jš�œ
˜—J˜J˜Jš
œ7™7Jšœ
�œ˜Jšœ
�œ�œ˜*Jš
œ˜J˜šž	œ�œ
�œ�œ
˜+š
�˜Jš�œ
�œ�œ
˜—Jš�œ�œ�œ�œ
˜4Jš
œ˜Jšœ=�œ
˜JJš�œ˜Jš�œ
˜—J˜šž	œ�œ˜Jš
œE™EJš
œS™SJš
�˜Jšœ	�˜Jš�œ
˜J˜—Jš
œ™Jš
œC™CJš
œ™J˜š	œ�œ �œ
�œ�œ˜EJš
Ÿ˜—J˜šžœ�œ
�œ
�œ
�œ
�œ˜5š
�˜Jš�œ
�œ�œ
˜—Jš�œ�œ
�œ
�œX˜pJš
œ˜š�œ�œ
˜!Jšœ	�œ
˜
Jš�œ[˜`J˜—š�œ�œ˜!Jšœ	�œ
˜
Jš�œV˜[J˜
—Jš�œ
˜—J˜šž
œ�œ
�
œ˜%Jš
�˜Jšœ�˜Jš�œ
˜—J˜šžœ�œ
�œ
�œ
�œ
�œ˜5š
�˜Jš�œ
�œ�œ
˜—Jš�œ�œ
�œ
�œX˜pJšœ�œ�œ�œ
˜1Jšœ�œ
˜Jš
œ˜Jš
œ˜Jš
œ-˜-Jš
œ˜Jš
œ˜Jš
œ˜š
�˜Jš
œd˜d—Jš�œ
˜—J˜šž
œ�œ˜%Jš
œ™Jš
�˜Jšœ�˜Jš�œ
˜—J˜J˜Jšœ�œ
�œ�œ
˜#J˜š
žœ�œ
�œ�œ�œ˜'Jš
�˜Jš
œ˜Jš�œ�œ
�œ˜'Jš�œ�œ�œ
�œ˜ Jš�œ
˜J˜—šžœ�œ�œ�œ˜)Jš
�˜Jš
œ˜Jš�œ
�œ
�œ˜(Jš�œ�œ�œ˜Jš�œ
˜J˜—š
žœ�œ
�œ�œ�œ˜.Jš
�˜Jš
œ˜Jš�œ
�œ
�œ˜(Jš�œ�œ
�œ˜!Jš�œ
˜J˜—šžœ�œ�œ�œ˜-Jš
�˜Jš
œ˜Jš�œ�œ
�œ˜,Jš�œ�œ�œ˜Jš�œ
˜J˜—šžœ�œ˜Jš
�˜Jš
œ˜Jš�œ�œ
�œ˜6Jš�œ
˜—J˜Jš�œ
˜J˜J˜—…—$j9