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, August 16, 1986 6:28:41 pm PDT
DIRECTORY
Atom, Basics, IO, LRUCache, PrincOps, Rope, RuntimeError, TerminalIO, TokenIO, UserProfile;
TokenIOImpl: CEDAR MONITOR
IMPORTS Atom, IO, LRUCache, Rope, RuntimeError, TerminalIO, UserProfile
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.STREAMNIL;
stopWriting: PUBLIC BOOLFALSE;
lruQueue: LRUCache.Handle ← LRUCache.Create[xReadTableMax-xReadTableMin+1, Hash, Equal];
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;
--input tables
reader: IO.STREAMNIL;
readAgain: BOOLFALSE;
token: Token;
rTtable: REF ARRAY [xReadTableMin..xReadTableMax] OF Token =
NEW[ARRAY [xReadTableMin..xReadTableMax] OF Token];
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] = INLINE {
RETURN [IO.GetChar[reader]];
};
XGetChar: PROC [] RETURNS[CHAR] = { --not inline; used as formal procedure
RETURN [GetChar[]];
};
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: XGetChar] ];
};
GetAtom: PROC [] RETURNS [a: ATOM] = INLINE {
r: Rope.ROPE = GetRope[];
IF Rope.InlineIsEmpty[r] THEN RETURN [NIL]
ELSE RETURN [ Atom.MakeAtom[r] ];
};
FillTable: PROC[] RETURNS [t: Token] = INLINE
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
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;
Hash: PROC [x: REF] RETURNS [CARDINAL] = {
HashCode: PROC [REF] RETURNS [CARDINAL] = TRUSTED MACHINE CODE {
PrincOps.zXOR;
};
RETURN [HashCode[x]]
};
Equal: PROC [x, y: REF] RETURNS [b: BOOL] = {
RETURN [x=y]
};
WriteAtom: PUBLIC PROC [a: ATOM] =
BEGIN
index: NAT; insert: BOOL;
IF stopWriting THEN SIGNAL WritingStopped;
[index: index, insert: insert] ← LRUCache.Include[lruQueue, a];
IF insert THEN {
PutByte[xFillTable];
PutByte[index+xReadTableMin];
PutAtom[a];
}
ELSE {
PutByte[index+xReadTableMin];
};
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 {
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
};
ENDLOOP;
--not found
--Determine where atom will go in table
IF freeEntry<=xReadTableMax THEN {
i ← freeEntry;
freeEntry ← freeEntry + 1;
}
ELSE {
--reuse oldest entry
i ← accessList[dummy].younger;
accessList[dummy].younger ← accessList[i].younger;
accessList[accessList[i].younger].older ← dummy;
};
--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
IF stopWriting THEN SIGNAL WritingStopped;
PutByte[xRope];
PutRope[r];
END;
WritePushFlag: PUBLIC PROC [a: ATOMNIL] =
BEGIN
IF stopWriting THEN SIGNAL WritingStopped;
PutByte[xPushFlag];
WriteAtom[a];
END;
WritePopFlag: PUBLIC PROC [] =
BEGIN
IF stopWriting THEN SIGNAL WritingStopped;
PutByte[xPopFlag];
END;
MarkAndWriteInt: PUBLIC PROC [value: INT] RETURNS [Mark] =
BEGIN
mark: Mark = 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
pos: INT = IO.GetIndex[writer];
IO.SetIndex[writer, mark.index];
PutInt[value];
IO.SetIndex[writer, pos];
END;
InternalReadToken: PROC [] RETURNS [Token] =
BEGIN
ENABLE {
IO.EndOfStream => IF NotDebugging[] THEN GOTO endOfStreamReturn;
IO.Error => IF NotDebugging[] THEN GOTO endOfStreamReturn;
RuntimeError.UNCAUGHT => {
TerminalIO.WriteRope["** unknown TokenIO error\n"];
IF NotDebugging[] THEN GOTO errorReturn;
}
};
b: [0..255];
b ← GetByte[];
IF b<=xLastShortNat THEN {--this if statement for speed only
SELECT TRUE FROM
b IN [xFirstShortNat..xLastShortNat] =>
{RETURN [Token[kind: int, ref: NEW[INT← b-xFirstShortNat]]]};
b IN [xReadTableMin..xReadTableMax] => {RETURN [rTtable[b]]};
b=xFillTable => {RETURN FillTable[]};
ENDCASE => ERROR;
}
ELSE {
SELECT TRUE FROM
b=xPopFlag => {RETURN [Token[kind: popFlag, ref: NIL]]};
b=xPushFlag => {
t: Token ← InternalReadToken[];
IF t.kind#atom THEN RETURN [Token[kind: error, ref: NIL]];
RETURN [Token[kind: pushFlag, ref: t.ref]]
};
b=xTwoByteCard => {RETURN [Token[kind: int, ref: NEW[INT←Get2Bytes[]]]]};
b=xRope => {RETURN [Token[kind: rope, ref: GetRope[]]]};
b=xOneBytePos => {RETURN [Token[kind: int, ref: NEW[INT←GetByte[]]]]};
b=xOneByteNeg =>
{i: INT = GetByte[]; RETURN [Token[kind: int, ref: NEW[INT←-i-1]]]};
b=xLongInt => {RETURN [Token[kind: int, ref: NEW[INT←GetInt[]]]]};
b=xTwoByteNegative =>
{i: INT = Get2Bytes[]; RETURN [Token[kind: int, ref: NEW[INT←-i-1]]]};
ENDCASE => ERROR;
}
EXITS
errorReturn => RETURN [Token[kind: error, ref: NIL]];
endOfStreamReturn => {
TerminalIO.WriteRope["** end of TokenIO stream\n"];
RETURN [Token[kind: endOfStream, ref: NIL]]
};
END;
--features used to debug TokenIO and other ChipNDale IO
debugMax: NAT = 10;
debugBuffer: REF ARRAY [0..debugMax) OF Token ← NEW[ARRAY [0..debugMax) OF Token];
debugIndex: [0..debugMax] ← 0;
doDebug: BOOLFALSE;
NotDebugging: PROC RETURNS [BOOL] = {
RETURN [ UserProfile.Boolean["ChipNDale.CatchLowLevelErrors", TRUE] ]
};
ReadToken: PUBLIC PROC [] RETURNS [Token] =
BEGIN
IF readAgain THEN {readAgain←FALSE; RETURN [token]};
token ← InternalReadToken[];
IF doDebug THEN {
--debugging optional; the MOD operation costs 5% runtime on read!
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: REFNIL] = CODE;
only on Attach or Release
ReleaseReader: PUBLIC PROC [] =
BEGIN
reader ← NIL
END;
DoAttachR: ENTRY PROC [stream: IO.STREAM] RETURNS [ok: BOOL] =
BEGIN ENABLE UNWIND => NULL;
IF (ok ← reader=NIL) THEN reader ← stream
END;
AttachReader: PUBLIC PROC [stream: IO.STREAM] =
BEGIN
ok: BOOL;
ok ← DoAttachR[stream];
IF ~ok THEN ERROR Error[alreadyAttached, Rope.FromRefText["file is already attached"]];
IF GetByte[ ! IO.EndOfStream => GOTO empty ]#xTokenIOCode THEN {
reader ← NIL;
ERROR Error[wrongVersion, Rope.FromRefText["file not produced with TokenIO"]];
};
IF GetByte[]#xVersionCode THEN {
reader ← NIL;
ERROR Error[wrongVersion, Rope.FromRefText["TokenIO version missmatch"]];
};
EXITS
empty =>{
reader ← NIL;
ERROR Error[why: other, explanation: Rope.FromRefText["empty file"]];
};
END;
DoAttachW: ENTRY PROC [stream: IO.STREAM] RETURNS [ok: BOOL] =
BEGIN ENABLE UNWIND => NULL;
IF (ok ← writer=NIL) THEN writer ← stream
END;
AttachWriter: PUBLIC PROC [stream: IO.STREAM] =
BEGIN
ok: BOOL;
ok ← DoAttachW[stream];
IF ~ok THEN ERROR Error[alreadyAttached, Rope.FromRefText["file is already attached"]];
[] ← IO.GetIndex[stream! IO.Error => GOTO NoGetIndex];
stopWriting ← FALSE;
writer ← stream;
LRUCache.Reset[lruQueue];
XX accessList[dummy] ← LinkRecord[dummy, dummy];
XX freeEntry ← xReadTableMin;
PutByte[xTokenIOCode];
PutByte[xVersionCode];
EXITS
NoGetIndex => {
writer ← NIL;
Error[other, Rope.FromRefText["file uses stream without GetIndex"]];
}
END;
ReleaseWriter: PUBLIC PROC [] =
--also invalidates marks
BEGIN
writer ← NIL
END;
EncodingError: PUBLIC SIGNAL = CODE; --For normal users it is an ERROR
--making a signal allows proceeding with the debugger, which is usefull
--on emergency cases...
ReadInt: PUBLIC PROC [] RETURNS [INT] =
BEGIN
t: Token ← ReadToken[];
IF t.kind#int THEN SIGNAL EncodingError;
RETURN [NARROW[t.ref, REF INT]^]
END;
ReadAtom: PUBLIC PROC [] RETURNS [ATOM] =
BEGIN
t: Token ← ReadToken[];
IF t.kind#atom THEN SIGNAL EncodingError;
RETURN [NARROW[t.ref, ATOM]]
END;
ReadRope: PUBLIC PROC [] RETURNS [Rope.ROPE] =
BEGIN
t: Token ← ReadToken[];
IF t.kind#rope THEN SIGNAL EncodingError;
RETURN [NARROW[t.ref, Rope.ROPE]]
END;
ReadPushFlag: PUBLIC PROC [] RETURNS [ATOM] =
BEGIN
t: Token ← ReadToken[];
IF t.kind#pushFlag THEN SIGNAL EncodingError;
RETURN [NARROW[t.ref, ATOM]]
END;
ReadPopFlag: PUBLIC PROC [] =
BEGIN
t: Token ← ReadToken[];
IF t.kind#TokenType[popFlag] THEN SIGNAL EncodingError;
END;
END.