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.STREAM←NIL;
stopWriting: PUBLIC BOOL ← FALSE;
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.STREAM ← NIL;
readAgain: BOOL ← FALSE;
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:
ATOM←
NIL] =
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: BOOL ← FALSE;
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:
REF←
NIL] =
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.