IOCommonImpl.mesa
Last edited by:
MBrown on January 13, 1984 2:15 pm
Paul Rovner on May 26, 1983 2:00 pm
Teitelman on April 20, 1983 2:52 pm
TO DO
remove "debugClose" flag when no longer needed
DIRECTORY
Atom,
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;
CharArrayPtr: TYPE = LONG POINTER TO PACKED ARRAY [0..0) OF CHAR;
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];
Errors
Error: PUBLIC ERROR [ec: IO.ErrorCode, stream: STREAM] = CODE;
EndOfStream: PUBLIC ERROR [stream: STREAM] = CODE;
Creating streams
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] ]];
};
Default Procedures: Get/Put Char/Block
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;
IF self.UnsafeGetBlock[[base: @buff, 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.UnsafeGetBlock[[
base: LOOPHOLE[block,LONG POINTER]+TEXT[0].SIZE,
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] = {
IF self.backingStream # NIL THEN self.backingStream.PutChar[char]
ELSE ERROR IO.Error[$NotImplementedForThisStream, self];
};
PutCharViaUnsafePutBlock: PUBLIC PROC [self: STREAM, char: CHAR] = TRUSTED {
buff: PACKED ARRAY [0..1] OF CHAR;
buff[0] ← char;
self.UnsafePutBlock[[base: @buff, 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.PutChar[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.UnsafePutBlock[[
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.PutChar[LOOPHOLE[block.base, CharArrayPtr][i]] }
ENDLOOP;
};
Default Procedures: others
DefaultEndOf: PROC [self: STREAM] RETURNS [BOOL] = {
IF self.backingStream # NIL THEN RETURN[self.backingStream.EndOf[]]
ELSE ERROR Error[NotImplementedForThisStream, self];
};
DefaultCharsAvail: PROC [self: STREAM, wait: BOOL] RETURNS [INT] = {
IF self.backingStream # NIL THEN RETURN[self.backingStream.CharsAvail[wait]]
ELSE RETURN[INT.LAST];
};
DefaultFlush: PROC [self: STREAM] = {
IF self.backingStream # NIL THEN self.backingStream.Flush[];
};
DefaultReset: PROC [self: STREAM] = {
IF self.backingStream # NIL THEN self.backingStream.Reset[];
};
debugClose: BOOL ← TRUE; -- crock until important clients get fixed
DefaultClose: PROC [self: STREAM, abort: BOOL ← FALSE] = {
IF abort THEN self.Reset[] ELSE self.Flush[];
IF self.backingStream # NIL THEN self.backingStream.Close[abort];
IF NOT debugClose THEN self.streamProcs ← closedStreamProcs;
};
DefaultGetIndex: PROC [self: STREAM] RETURNS [index: INT] = {
IF self.backingStream # NIL THEN RETURN[self.backingStream.GetIndex[]]
ELSE ERROR Error[NotImplementedForThisStream, self];
};
DefaultSetIndex: PROC [self: STREAM, index: INT] = {
IF self.backingStream # NIL THEN self.backingStream.SetIndex[index]
ELSE ERROR IO.Error[$NotImplementedForThisStream, self];
};
Closed Stream Procedures
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] };
Generic procedures with the standard implementation
"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];
};
PeekChar: PUBLIC PROC [self: STREAM] RETURNS [char: CHAR] = {
char ← self.GetChar[]; self.Backup[char]
};
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;
};
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];
IF proc # NIL THEN RETURN[(NARROW[proc, REF TypeOfGetLength])^ [self] ]
ELSE IF self.backingStream # NIL THEN self ← self.backingStream
ELSE ERROR 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;
};
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;
};
Ambush / UnAmbush Stream
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;
};
Default Backup implementation
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] = {
This is the implementation of Backup supplied by CreateStreamProcs when the client does not supply its own. This implementation ambushes the stream self. The stream created by the ambushing is saved so that it can be reused if the stream enters the backed-up state often.
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] = {
this is the implementation of Backup when a stream is in the backed-up state from a call to BackupFirstChar.
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.
Change Log
Changed by MBrown on October 25, 1983 1:18 pm
Added "IF NOT debugClose THEN self.streamProcs ← closedStreamProcs;" to DefaultClose (default is debugClose = TRUE because compiler and binder break otherwise ...)
Changed by MBrown on November 15, 1983 5:25 pm
Fixed off-by-one error in BackupGetChar.