<> <> <> <> 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; <> <> <> <<];>> <<--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]; <> <> <> <<--doubly linked LRU list>> <> <> <> <<--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]; }; <<>> <> <> <> <> <> <> <<-- Remove atom i from access list>> <> <> <> <<};>> <> <<--not found>> <<--Determine where atom will go in table>> <> <> <> <<}>> <> <<--reuse oldest entry>> <> <> <> <<};>> <<--Add atom to atom table>> <> <> <> <> <> <> < {>> <<--Put atom most recently touched (i) at the front>> <> <> <> <> <<};>> <> 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; <> 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]; <> <> 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.