<> <> <> <> <> <> DIRECTORY Atom, Basics USING [RawBytes, RawChars], IO, IOUtils, Rope, RefText, RuntimeError USING [BoundsFault]; IOCommonImpl: CEDAR PROGRAM IMPORTS IO, IOUtils, Atom, RefText, RuntimeError EXPORTS IO, IOUtils SHARES IO --for representation of StreamProcs = BEGIN <> STREAM: TYPE = IO.STREAM; ROPE: TYPE = Rope.ROPE; UnsafeBlock: TYPE = IO.UnsafeBlock; ByteArrayPtr: TYPE = LONG POINTER TO Basics.RawBytes; CharArrayPtr: TYPE = LONG POINTER TO Basics.RawChars; StreamProcs: TYPE = IO.StreamProcs; TypeOfEraseChar: TYPE = PROC [self: STREAM, char: CHAR]; TypeOfGetLength: TYPE = PROC [self: STREAM] RETURNS [length: INT]; TypeOfSetLength: TYPE = PROC [self: STREAM, length: INT]; <> Error: PUBLIC ERROR [ec: IO.ErrorCode, stream: STREAM] = CODE; EndOfStream: PUBLIC ERROR [stream: STREAM] = CODE; <> CreateStreamProcs: PUBLIC PROC [ variety: IO.StreamVariety, class: ATOM, getChar: PROC [self: STREAM] RETURNS [CHAR], getBlock: PROC [self: STREAM, block: REF TEXT, startIndex: NAT, count: NAT] RETURNS [nBytesRead: NAT], unsafeGetBlock: UNSAFE PROC [self: STREAM, block: UnsafeBlock] RETURNS [nBytesRead: INT], endOf: PROC [self: STREAM] RETURNS [BOOL], charsAvail: PROC [self: STREAM, wait: BOOL] RETURNS [INT], backup: PROC [self: STREAM, char: CHAR], putChar: PROC [self: STREAM, char: CHAR], putBlock: PROC [self: STREAM, block: REF READONLY TEXT, startIndex: NAT, count: NAT], unsafePutBlock: PROC [self: STREAM, block: UnsafeBlock], flush: PROC [self: STREAM], reset: PROC [self: STREAM], close: PROC [self: STREAM, abort: BOOL], getIndex: PROC [self: STREAM] RETURNS [INT], setIndex: PROC [self: STREAM, index: INT], getLength: PROC [self: STREAM] RETURNS [length: INT], setLength: PROC [self: STREAM, length: INT], eraseChar: PROC [self: STREAM, char: CHAR] ] RETURNS [REF StreamProcs] = { streamProcs: REF StreamProcs _ NEW[StreamProcs _ [ variety: variety, class: class, getChar: IF getChar # NIL THEN getChar ELSE IF unsafeGetBlock # NIL THEN GetCharViaUnsafeGetBlock ELSE DefaultGetChar, getBlock: IF getBlock # NIL THEN getBlock ELSE IF unsafeGetBlock # NIL THEN GetBlockViaUnsafeGetBlock ELSE GetBlockViaGetChar, unsafeGetBlock: IF unsafeGetBlock # NIL THEN unsafeGetBlock ELSE UnsafeGetBlockViaGetChar, endOf: IF endOf = NIL THEN DefaultEndOf ELSE endOf, charsAvail: IF charsAvail = NIL THEN DefaultCharsAvail ELSE charsAvail, backup: IF backup = NIL THEN DefaultBackup ELSE backup, putChar: IF putChar # NIL THEN putChar ELSE IF unsafePutBlock # NIL THEN PutCharViaUnsafePutBlock ELSE DefaultPutChar, putBlock: IF putBlock # NIL THEN putBlock ELSE IF unsafePutBlock # NIL THEN PutBlockViaUnsafePutBlock ELSE PutBlockViaPutChar, unsafePutBlock: IF unsafePutBlock # NIL THEN unsafePutBlock ELSE UnsafePutBlockViaPutChar, flush: IF flush = NIL THEN DefaultFlush ELSE flush, reset: IF reset = NIL THEN DefaultReset ELSE reset, close: IF close = NIL THEN DefaultClose ELSE close, getIndex: IF getIndex = NIL THEN DefaultGetIndex ELSE getIndex, setIndex: IF setIndex = NIL THEN DefaultSetIndex ELSE setIndex, propList: NIL]]; IF getLength # NIL THEN IOUtils.StoreProc[streamProcs, $GetLength, NEW[TypeOfGetLength _ getLength]]; IF setLength # NIL THEN IOUtils.StoreProc[streamProcs, $SetLength, NEW[TypeOfSetLength _ setLength]]; IF eraseChar # NIL THEN IOUtils.StoreProc[streamProcs, $EraseChar, NEW[TypeOfEraseChar _ eraseChar]]; RETURN[streamProcs]; }; CreateStream: PUBLIC PROC [ streamProcs: REF StreamProcs, streamData: REF ANY, backingStream: STREAM _ NIL] RETURNS [stream: STREAM] = { RETURN[NEW[IO.STREAMRecord _ [ streamProcs: streamProcs, streamData: streamData, backingStream: backingStream] ]]; }; <> AddNat: PROC [a, b: NAT] RETURNS [NAT] = INLINE { RETURN [MIN[CARDINAL[a]+CARDINAL[b], NAT.LAST]]; }; DefaultGetChar: PROC [self: STREAM] RETURNS [CHAR] = { IF self.backingStream # NIL THEN RETURN[self.backingStream.GetChar[]] ELSE ERROR Error[NotImplementedForThisStream, self]; }; GetCharViaUnsafeGetBlock: PUBLIC PROC [self: STREAM] RETURNS [CHAR] = TRUSTED { buff: PACKED ARRAY [0..1] OF CHAR; bp: ByteArrayPtr = LOOPHOLE[LONG[@buff]]; IF self.streamProcs.unsafeGetBlock[self, [base: bp, startIndex: 0, count: 1]] = 0 THEN ERROR IO.EndOfStream[self]; RETURN[buff[0]] }; GetBlockViaGetChar: PUBLIC PROC [self: STREAM, block: REF TEXT, startIndex: NAT, count: NAT] RETURNS [nBytesRead: NAT] = { nBytes: NAT = MIN [block.maxLength, AddNat[startIndex, count]] - startIndex; FOR i: NAT IN [0 .. nBytes) DO block[startIndex+i] _ self.GetChar[ ! EndOfStream => { nBytesRead _ i; EXIT }]; REPEAT FINISHED => nBytesRead _ nBytes; ENDLOOP; block.length _ startIndex + nBytesRead; RETURN[nBytesRead]; }; GetBlockViaUnsafeGetBlock: PUBLIC PROC [self: IO.STREAM, block: REF TEXT, startIndex: NAT, count: NAT] RETURNS [nBytesRead: NAT] = TRUSTED { nBytesRead _ self.streamProcs.unsafeGetBlock[self, [ base: LOOPHOLE[block, ByteArrayPtr]+SIZE[TEXT[0]], startIndex: startIndex, count: MAX[MIN[INT[count], INT[block.maxLength]-startIndex], 0] ]]; block.length _ startIndex + nBytesRead; RETURN[nBytesRead]; }; UnsafeGetBlockViaGetChar: PUBLIC UNSAFE PROC [self: STREAM, block: UnsafeBlock] RETURNS [nBytesRead: INT] = UNCHECKED { nBytesRead _ 0; IF block.startIndex < 0 OR block.count < 0 THEN ERROR RuntimeError.BoundsFault; FOR i: INT IN [0 .. block.count) DO LOOPHOLE[block.base, CharArrayPtr][block.startIndex+i] _ self.GetChar[ ! IO.EndOfStream => { nBytesRead _ i; EXIT }] REPEAT FINISHED => nBytesRead _ block.count; ENDLOOP; RETURN[nBytesRead]; }; DefaultPutChar: PROC [self: STREAM, char: CHAR] = { backing: STREAM _ self.backingStream; IF backing # NIL THEN backing.streamProcs.putChar[backing, char] ELSE ERROR IO.Error[$NotImplementedForThisStream, self]; }; PutCharViaUnsafePutBlock: PUBLIC PROC [self: STREAM, char: CHAR] = TRUSTED { buff: PACKED ARRAY [0..1] OF CHAR; bp: ByteArrayPtr _ LOOPHOLE[LONG[@buff]]; buff[0] _ char; self.streamProcs.unsafePutBlock[self, [base: bp, startIndex: 0, count: 1]]; }; PutBlockViaPutChar: PUBLIC PROC [self: STREAM, block: REF READONLY TEXT, startIndex: NAT, count: NAT] = { stopIndexPlusOne: NAT _ AddNat[startIndex, count]; IF stopIndexPlusOne > block.maxLength THEN stopIndexPlusOne _ block.length; FOR i: NAT IN [startIndex .. stopIndexPlusOne) DO self.streamProcs.putChar[self, block[i]]; ENDLOOP; }; PutBlockViaUnsafePutBlock: PUBLIC PROC [ self: STREAM, block: REF READONLY TEXT, startIndex: NAT, count: NAT] = TRUSTED { stopIndexPlusOne: NAT _ AddNat[startIndex, count]; IF stopIndexPlusOne > block.maxLength THEN stopIndexPlusOne _ block.length; self.streamProcs.unsafePutBlock[self, [ base: LOOPHOLE[block,LONG POINTER]+TEXT[0].SIZE, startIndex: startIndex, count: MAX[INT[stopIndexPlusOne] - INT[startIndex], 0] ] ] }; UnsafePutBlockViaPutChar: PUBLIC PROC [self: STREAM, block: UnsafeBlock] = { IF block.startIndex < 0 OR block.count < 0 THEN ERROR RuntimeError.BoundsFault; FOR i: INT IN [block.startIndex .. block.startIndex+block.count) DO TRUSTED { self.streamProcs.putChar[self, LOOPHOLE[block.base, CharArrayPtr][i]] } ENDLOOP; }; <> DefaultEndOf: PROC [self: STREAM] RETURNS [BOOL] = { backing: STREAM _ self.backingStream; IF backing # NIL THEN RETURN[backing.streamProcs.endOf[backing]]; ERROR Error[NotImplementedForThisStream, self]; }; DefaultCharsAvail: PROC [self: STREAM, wait: BOOL] RETURNS [INT _ LAST[INT]] = { backing: STREAM _ self.backingStream; IF backing # NIL THEN RETURN[backing.streamProcs.charsAvail[backing, wait]]; }; DefaultFlush: PROC [self: STREAM] = { backing: STREAM _ self.backingStream; IF backing # NIL THEN backing.streamProcs.flush[backing]; }; DefaultReset: PROC [self: STREAM] = { backing: STREAM _ self.backingStream; IF backing # NIL THEN backing.streamProcs.reset[backing]; }; DefaultClose: PROC [self: STREAM, abort: BOOL _ FALSE] = { backing: STREAM; IF abort THEN self.streamProcs.reset[self] ELSE self.streamProcs.flush[self]; backing _ self.backingStream; IF backing # NIL THEN backing.streamProcs.close[backing, abort]; self.streamProcs _ closedStreamProcs; }; DefaultGetIndex: PROC [self: STREAM] RETURNS [index: INT] = { backing: STREAM _ self.backingStream; IF backing # NIL THEN RETURN[backing.streamProcs.getIndex[backing]] ELSE ERROR Error[NotImplementedForThisStream, self]; }; DefaultSetIndex: PROC [self: STREAM, index: INT] = { backing: STREAM _ self.backingStream; IF backing # NIL THEN backing.streamProcs.setIndex[backing, index] ELSE ERROR IO.Error[$NotImplementedForThisStream, self]; }; <> closedStreamProcs: PUBLIC REF StreamProcs _ NEW[StreamProcs _ [ variety: $inputOutput, class: $Closed, getChar: ClosedGetChar, getBlock: ClosedGetBlock, unsafeGetBlock: ClosedUnsafeGetBlock, endOf: ClosedEndOf, charsAvail: ClosedCharsAvail, backup: ClosedBackup, putChar: ClosedPutChar, putBlock: ClosedPutBlock, unsafePutBlock: ClosedUnsafePutBlock, flush: ClosedFlush, reset: ClosedReset, close: ClosedClose, getIndex: ClosedGetIndex, setIndex: ClosedSetIndex, propList: NIL]]; ClosedGetChar: PROC [self: STREAM] RETURNS [CHAR] = { ERROR IO.Error[$StreamClosed, self] }; ClosedGetBlock: PROC [self: STREAM, block: REF TEXT, startIndex: NAT, count: NAT] RETURNS [nBytesRead: NAT] = { ERROR IO.Error[$StreamClosed, self] }; ClosedUnsafeGetBlock: UNSAFE PROC [self: STREAM, block: UnsafeBlock]RETURNS [nBytesRead: INT] = { ERROR IO.Error[$StreamClosed, self] }; ClosedEndOf: PROC [self: STREAM] RETURNS [BOOL] = { ERROR IO.Error[$StreamClosed, self] }; ClosedCharsAvail: PROC [self: STREAM, wait: BOOL] RETURNS [INT] = { ERROR IO.Error[$StreamClosed, self] }; ClosedBackup: PROC [self: STREAM, char: CHAR] = { ERROR IO.Error[$StreamClosed, self] }; ClosedPutChar: PROC [self: STREAM, char: CHAR] = { ERROR Error[$StreamClosed, self] }; ClosedPutBlock: PROC [self: STREAM, block: REF READONLY TEXT, startIndex: NAT,count: NAT] = { ERROR Error[$StreamClosed, self] }; ClosedUnsafePutBlock: PROC [self: STREAM, block: UnsafeBlock] = { ERROR Error[$StreamClosed, self] }; ClosedFlush: PROC [self: STREAM] = { ERROR Error[$StreamClosed, self] }; ClosedReset: PROC [self: STREAM] = { }; ClosedClose: PROC [self: STREAM, abort: BOOL _ FALSE] = { }; ClosedGetIndex: PROC [self: STREAM] RETURNS [index: INT] = { ERROR Error[$StreamClosed, self] }; ClosedSetIndex: PROC [self: STREAM, index: INT] = { ERROR Error[$StreamClosed, self] }; <> <<>> GetChar: PUBLIC PROC [self: STREAM] RETURNS [CHAR] = { RETURN[self.streamProcs.getChar[self]]; }; GetBlock: PUBLIC PROC [self: STREAM, block: REF TEXT, startIndex: NAT _ 0, count: NAT _ NAT.LAST] RETURNS [nBytesRead: NAT] = { RETURN[self.streamProcs.getBlock[self, block, startIndex, count]]; }; UnsafeGetBlock: PUBLIC UNSAFE PROC [self: STREAM, block: UnsafeBlock] RETURNS [nBytesRead: INT] = UNCHECKED { <> RETURN[self.streamProcs.unsafeGetBlock[self, block]]; }; EndOf: PUBLIC PROC [self: STREAM] RETURNS [BOOL] = { RETURN[self.streamProcs.endOf[self]]; }; CharsAvail: PUBLIC PROC [self: STREAM, wait: BOOL _ FALSE] RETURNS [INT] = { <> RETURN[self.streamProcs.charsAvail[self, wait]]; }; Backup: PUBLIC PROC [self: STREAM, char: CHAR] = { <> self.streamProcs.backup[self, char]; }; <<>> PeekChar: PUBLIC PROC [self: STREAM] RETURNS [char: CHAR] = { <> char _ self.GetChar[]; self.Backup[char]; }; <

> <<>> PutChar: PUBLIC PROC [self: STREAM, char: CHAR] = { self.streamProcs.putChar[self, char]; }; PutBlock: PUBLIC PROC [self: STREAM, block: REF READONLY TEXT, startIndex: NAT _ 0, count: NAT _ NAT.LAST] = { self.streamProcs.putBlock[self, block, startIndex, count]; }; UnsafePutBlock: PUBLIC PROC [self: STREAM, block: UnsafeBlock] = { <> self.streamProcs.unsafePutBlock[self, block]; }; Flush: PUBLIC PROC [self: STREAM] = { <> self.streamProcs.flush[self]; }; <<>> EraseChar: PUBLIC PROC [self: STREAM, char: CHAR] = { proc: REF ANY; DO IF self.streamProcs.class = $Closed THEN ERROR IO.Error[$StreamClosed, self]; proc _ InlineLookupProc[self, $EraseChar]; IF proc # NIL THEN {(NARROW[proc, REF TypeOfEraseChar])^ [self, char]; RETURN} ELSE IF self.backingStream # NIL THEN self _ self.backingStream ELSE {self.PutChar['\\]; self.PutChar[char]; RETURN}; ENDLOOP; }; <> <<>> Reset: PUBLIC PROC [self: STREAM] = {self.streamProcs.reset[self]}; Close: PUBLIC PROC [self: STREAM, abort: BOOL _ FALSE] = {self.streamProcs.close[self, abort]}; <<>> <> <<>> GetIndex: PUBLIC PROC[self: STREAM] RETURNS [index: INT] = { RETURN[self.streamProcs.getIndex[self]]}; SetIndex: PUBLIC PROC[self: STREAM, index: INT] = { self.streamProcs.setIndex[self, index]}; GetLength: PUBLIC PROC [self: STREAM] RETURNS [length: INT] = { proc: REF ANY; DO IF self.streamProcs.class = $Closed THEN ERROR IO.Error[$StreamClosed, self]; proc _ InlineLookupProc[self, $GetLength]; SELECT TRUE FROM proc # NIL => RETURN[(NARROW[proc, REF TypeOfGetLength])^ [self] ]; self.backingStream # NIL => self _ self.backingStream; ENDCASE => Error[NotImplementedForThisStream, self]; ENDLOOP; }; SetLength: PUBLIC PROC [self: STREAM, length: INT] = { proc: REF ANY; DO IF self.streamProcs.class = $Closed THEN ERROR IO.Error[$StreamClosed, self]; proc _ InlineLookupProc[self, $SetLength]; IF proc # NIL THEN {(NARROW[proc, REF TypeOfSetLength ])^ [self, length]; RETURN} ELSE IF self.backingStream # NIL THEN self _ self.backingStream ELSE ERROR IO.Error[$NotImplementedForThisStream, self]; ENDLOOP; }; <> <<"Standard implementation" means "try property list, then try backing stream, then do something simple (e.g. Error[NotImplementedForThisStream])">> <<>> GetInfo: PUBLIC PROC [stream: STREAM] RETURNS [variety: IO.StreamVariety, class: ATOM] = { RETURN [stream.streamProcs.variety, stream.streamProcs.class]; }; InlineLookupProc: PROC [self: STREAM, operation: ATOM] RETURNS [proc: REF ANY] = INLINE { FOR l: Atom.PropList _ self.streamProcs.propList, l.rest UNTIL l = NIL DO IF l.first.key = operation THEN RETURN[l.first.val]; ENDLOOP; }; <> <<>> AmbushStream: PUBLIC PROC [self: STREAM, streamProcs: REF StreamProcs, streamData: REF ANY, reusing: STREAM _ NIL] = { IF reusing = NIL OR reusing = self -- to prevent circularities due to bugs -- THEN reusing _ NEW[IO.STREAMRecord _ [streamProcs: NIL, streamData: NIL]]; reusing^ _ self^; self^ _ [streamProcs: streamProcs, streamData: streamData, propList: reusing.propList, backingStream: reusing]; reusing.propList _ NIL; -- keep only one copy of prop list. }; UnAmbushStream: PUBLIC PROC [self: STREAM] = { propList: Atom.PropList = self.propList; IF self.backingStream = NIL THEN RETURN; self^ _ self.backingStream^; IF self.propList # NIL THEN ERROR; -- access to the backing stream prop list was an error self.propList _ propList; }; <> <<>> StoreData: PUBLIC PROC [self: STREAM, key: ATOM, data: REF ANY] = { self.propList _ Atom.PutPropOnList[self.propList, key, data]; }; LookupData: PUBLIC PROC [self: STREAM, key: ATOM] RETURNS [REF ANY] = { RETURN[Atom.GetPropFromList[self.propList, key]]; }; RemoveData: PUBLIC PROC [self: STREAM, key: ATOM] = { self.propList _ Atom.RemPropFromList[self.propList, key]; }; StoreProc: PUBLIC PROC [class: REF StreamProcs, key: ATOM, procRef: REF ANY] = { class.propList _ Atom.PutPropOnList[class.propList, key, procRef]; }; LookupProc: PUBLIC PROC [self: STREAM, key: ATOM] RETURNS [procRef: REF ANY] = { RETURN[Atom.GetPropFromList[self.streamProcs.propList, key]]; }; <<>> <> BackupData: TYPE = REF BackupRecord; BackupRecord: TYPE = RECORD[stream: STREAM, buffer: REF TEXT]; backupProcs: REF StreamProcs = IO.CreateStreamProcs[ variety: $inputOutput, class: $BackedUp, getChar: BackupGetChar, endOf: BackupEndOf, charsAvail: BackupCharsAvail, reset: BackupReset, backup: BackupBackup ]; DefaultBackup: PROC [self: STREAM, char: CHAR] = { <> data: BackupData _ NARROW[IOUtils.LookupData[self, $Backup]]; IF data = NIL THEN { <<-- first time for this particular stream>> data _ NEW[BackupRecord _ [ stream: IO.CreateStream[NIL, NIL], buffer: RefText.New[8]]]; IOUtils.StoreData[self: self, key: $Backup, data: data] }; IF data.stream = self THEN ERROR Error[IllegalBackup, self]; -- while self in backed-up state, client performed self.backingStream.Backup[] (!) AmbushStream[self: self, streamProcs: backupProcs, streamData: data, reusing: data.stream]; self.Backup[char]; }; BackupBackup: PROC [self: STREAM, char: CHAR] = { <> data: BackupData = NARROW[IOUtils.LookupData[self, $Backup]]; data.buffer _ RefText.InlineAppendChar[data.buffer, char ! RuntimeError.BoundsFault => ERROR IO.Error[BufferOverflow, self]]; }; BackupGetChar: PROC [self: STREAM] RETURNS [char: CHAR] = { data: BackupData = NARROW[self.streamData]; char _ data.buffer[data.buffer.length - 1]; data.buffer.length _ data.buffer.length - 1; IF data.buffer.length = 0 THEN UnAmbushStream[self]; RETURN[char]; }; BackupEndOf: PROC [self: STREAM] RETURNS [BOOL] = { RETURN[FALSE]; }; BackupCharsAvail: PROC [self: STREAM, wait: BOOL] RETURNS [INT] = { data: BackupData = NARROW[self.streamData]; IF data.buffer.length > 0 THEN RETURN [data.buffer.length]; RETURN[self.backingStream.CharsAvail[wait]]; }; BackupReset: PROC [self: STREAM] = { data: BackupData = NARROW[self.streamData]; data.buffer.length _ 0; UnAmbushStream[self]; self.Reset[]; }; END. <> <> <> <> <>