IOCommonImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
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
Russ Atkinson (RRA) February 2, 1985 1:35:51 pm PST
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
Types
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];
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;
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;
};
Default Procedures: others
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];
};
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] };
Input operations
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 {
Analogous to GetBlock. Never raises EndOfStream.
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] = {
Returns the number of characters that can be obtained from the stream quickly (e.g. without waiting for the user to type something). If wait, does not return until it can return a nonzero value.
RETURN[self.streamProcs.charsAvail[self, wait]];
};
Backup: PUBLIC PROC [self: STREAM, char: CHAR] = {
Undoes the effect of the most recent GetChar, which returned the value char.
self.streamProcs.backup[self, char];
};
PeekChar: PUBLIC PROC [self: STREAM] RETURNS [char: CHAR] = {
Short for GetChar followed by Backup.
char ← self.GetChar[];
self.Backup[char];
};
Output Operations (defined for output and inputOutput streams)
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] = {
Analogous to PutBlock.
self.streamProcs.unsafePutBlock[self, block];
};
Flush: PUBLIC PROC [self: STREAM] = {
Causes characters that have been output to stream, but not yet sent (because of buffering) to be sent
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;
};
Control Operations (defined for all streams)
Reset: PUBLIC PROC [self: STREAM] = {self.streamProcs.reset[self]};
Close: PUBLIC PROC [self: STREAM, abort: BOOL ← FALSE] = {self.streamProcs.close[self, abort]};
Special Control Operations (defined for file-like streams)
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;
};
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];
};
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;
};
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;
};
Property list manipulation
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]];
};
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.