<> <> <> <> 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.