TokenIOImpl.mesa
Copyright © 1983 by Xerox Corporation. All rights reserved.
by Christian Jacobi August 24, 1983 3:10 pm
last edited by Christian Jacobi December 14, 1983 2:15 pm
DIRECTORY
Atom, Basics, IO, Rope, SafeStorage, TokenIO;
TokenIOImpl: CEDAR MONITOR
IMPORTS Atom, IO, Rope, SafeStorage
EXPORTS TokenIO =
BEGIN
-- we use read, write for encoded, (exported) IO
-- we use get/put for actual unencoded IO
-- codes
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;
-- types
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)
--];
--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
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];
--doubly linked LRU list
wAtomTable:
REF
ARRAY [xReadTableMin..xReadTableMax]
OF
ATOM =
NEW[ARRAY [xReadTableMin..xReadTableMax] OF ATOM];
freeEntry: INTEGER;
lastEntry: INTEGER = xReadTableMax;
--input tables
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];
-- Remove atom i from access list
accessList[accessList[i].older].younger ← accessList[i].younger;
accessList[accessList[i].younger].older ← accessList[i].older;
GOTO touchI
END;
ENDLOOP;
-- not found
--Determine where atom will go in table
IF freeEntry<=xReadTableMax
THEN
BEGIN
i ← freeEntry;
freeEntry ← freeEntry + 1;
END
ELSE
--reuse oldest entry
BEGIN
i ← accessList[dummy].younger;
accessList[dummy].younger ← accessList[i].younger;
accessList[accessList[i].younger].older ← dummy;
END;
--Add atom to atom table
wAtomTable[i] ← a;
PutByte[xFillTable];
PutByte[i];
PutAtom[a];
GOTO touchI;
EXITS
touchI
--i is touched atom-- => {
--Put atom most recently touched (i) at the front
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=xAtomText => {RETURN [Token[kind: atom, ref: GetAtom[]]]};
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;
--features used to debug TokenIO and other chipndale IO
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 [] =
--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)
BEGIN
readAgain ← TRUE
END;
--Attaching TokenIo to STREAMS
--while TokenIo is attached to a stream no other operations on this
--stream should occur
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 [] =
--also invalidates marks
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.