DIRECTORY
IO USING [CreateStream, CreateStreamProcs, EndOfStream, Error, STREAM, StreamProcs],
IOUtils USING [StoreProc, LookupProc],
PrincOpsUtils USING [ByteBlt],
Rope USING [ROPE],
TapeOps
USING [BackSpaceFile, ErrorCode, GetStatus, maxBufferLength, ReadRecord,
TapeHandle, TapeStatus, TapeOpsError, TapeOpsWarning, Unload, WriteFileMark, WriteRecord],
TapeStreams;
TapeStreamsImpl:
CEDAR
PROGRAM
IMPORTS IO, IOUtils, PrincOpsUtils, TapeOps
EXPORTS TapeStreams SHARES IO = BEGIN
OPEN TapeStreams;
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
defaultProc: PUBLIC TapeRecordProc = {RETURN};
Error: PUBLIC ERROR [error: ErrorDesc] = CODE;
StreamOpen:
PUBLIC
PROC [tape: TapeOps.TapeHandle, access: AccessOptions ← read,
blocking:
NAT ← 80, padding: FillBlockOptions ← blanks,
conversions: ConversionList ←
NIL, tapeRecordProc: TapeRecordProc ←
NIL,
clientData:
REF
ANY ←
NIL, allowSoftErrors:
BOOL ←
TRUE]
RETURNS[stream:
IO.
STREAM] =
BEGIN
ENABLE TapeOps.TapeOpsError => ProduceError[ec, code];
streamProcs: REF IO.StreamProcs;
s: TapeStreamState ← NEW[TapeStreamStateRec];
IF blocking >= TapeOps.maxBufferLength
THEN
ERROR Error[
[user, "A blocking has been specified larger than the tape server can handle"]];
IF access = write
THEN
BEGIN
status: TapeOps.TapeStatus ← tape.GetStatus[];
IF status[FPT] THEN ERROR Error[[user, "Tape is write protected!"]];
END;
s.padding ← padding;
s.blockSize ← blocking;
s.tapeRecordProc ← tapeRecordProc;
s.clientData ← clientData;
s.access ← access;
s.tapeHandle ← tape;
s.index ← 0;
s.allowSoftErrors ← allowSoftErrors;
s.lastBufferIndexPlusOne ← s.blockSize;
s.buffer ← NEW[TEXT[TapeOps.maxBufferLength]];
s.eof ← FALSE;
SELECT s.access
FROM
read => streamProcs ←
IO.CreateStreamProcs[class: $TapeStream,
variety: input, getChar: GetChar, getBlock: GetBlock, endOf: EndOf,
close: Close];
write =>
BEGIN
streamProcs ← IO.CreateStreamProcs[class: $TapeStream,
variety: output, putChar: PutChar, putBlock: PutBlock, flush: Flush,
close: Close];
IOUtils.StoreProc[streamProcs, $FlushBlock, NEW[FlushBlockProc ← FlushBlock]];
END;
ENDCASE => ERROR;
stream ← IO.CreateStream[streamProcs, s];
FOR c: TapeStreams.ConversionList ← conversions, c.rest
WHILE c#
NIL
DO
p: Conversion = c.first^.proc;
ra: REF ANY = c.first^.clientData;
stream ← p[stream, ra];
SELECT s.access
FROM
read => IF stream.streamProcs.variety = output THEN ERROR IO.Error[NotImplementedForThisStream, stream];
write => IF stream.streamProcs.variety = input THEN ERROR IO.Error[NotImplementedForThisStream, stream];
ENDCASE => NULL;
ENDLOOP;
END;
Private Procs
PutChar:
PROC[self:
IO.
STREAM, char:
CHAR] =
BEGIN
s: TapeStreamState ← NARROW[self.streamData];
s.writing ← TRUE;
IF s.index >= s.lastBufferIndexPlusOne THEN StoreBuffer[s];
s.buffer[s.index] ← char;
s.index ← s.index + 1;
END; -- of PutTapeChar
PutBlock:
PROC
[self: IO.STREAM, block: REF READONLY TEXT, startIndex: NAT ← 0, count: NAT ← LAST[NAT]] = BEGIN
s: TapeStreamState ← NARROW[self.streamData];
count ← MIN[count, block.length];
s.writing ← TRUE;
UNTIL count = 0
DO
bufferChars, bytesToPut: CARDINAL;
IF s.index >= s.lastBufferIndexPlusOne THEN StoreBuffer[s];
bufferChars ← s.lastBufferIndexPlusOne - s.index;
bytesToPut ← MIN[count, bufferChars];
TRUSTED
BEGIN
[] ← PrincOpsUtils.ByteBlt[
to: [ (LOOPHOLE[s.buffer, LONG POINTER] + SIZE[TEXT[0]]), s.index, s.index + bytesToPut ],
from: [ (LOOPHOLE[block, LONG POINTER] + SIZE[TEXT[0]]), startIndex, startIndex+bytesToPut ]
];
END;
s.index ← s.index + bytesToPut;
count ← count - bytesToPut;
startIndex ← startIndex + bytesToPut;
ENDLOOP;
END; -- of PutTapeBlock
GetChar:
PROC[self:
IO.
STREAM]
RETURNS [char:
CHAR] =
BEGIN
s: TapeStreamState ← NARROW[self.streamData];
IF
NOT s.firstRecordRead
THEN
BEGIN
[s.eof, s.buffer] ← s.tapeHandle.ReadRecord[s.buffer
! TapeOps.TapeOpsError => ProduceError[ec, code]];
s.lastBufferIndexPlusOne ← s.buffer.length;
s.firstRecordRead ← TRUE;
END;
IF s.eof THEN ERROR IO.EndOfStream[self];
char ← s.buffer[s.index];
s.index ← s.index + 1;
IF s.index >= s.lastBufferIndexPlusOne
THEN
BEGIN
LoadBuffer[s];
IF s.index = -1 THEN s.eof ← TRUE;
END;
RETURN[char];
END; -- of GetTapeChar
GetBlock:
PROC
[self:
IO.
STREAM, block:
REF
TEXT, startIndex:
NAT ← 0, count:
NAT ←
LAST[
NAT]]
RETURNS[nBytesRead: NAT] = BEGIN
s: TapeStreamState ← NARROW[self.streamData];
IF
NOT s.firstRecordRead
THEN
BEGIN
[s.eof, s.buffer] ← s.tapeHandle.ReadRecord[s.buffer
! TapeOps.TapeOpsError => ProduceError[ec, code]];
s.lastBufferIndexPlusOne ← s.buffer.length;
s.firstRecordRead ← TRUE;
END;
IF s.eof THEN RETURN [0];
count ← MIN[count, block.maxLength - startIndex];
nBytesRead ← 0;
UNTIL count = 0
DO
bufferChars, bytesToGet: CARDINAL;
IF s.index >= s.lastBufferIndexPlusOne
THEN
BEGIN
LoadBuffer[s];
IF s.index = -1 THEN { s.eof ← TRUE; RETURN [nBytesRead]; };
END;
bufferChars ← s.lastBufferIndexPlusOne - s.index;
bytesToGet ← MIN[count, bufferChars];
TRUSTED
BEGIN
[] ← PrincOpsUtils.ByteBlt[
to: [ (LOOPHOLE[block, LONG POINTER] + SIZE[TEXT[0]]), startIndex, startIndex+bytesToGet ],
from: [ (LOOPHOLE[s.buffer, LONG POINTER] + SIZE[TEXT[0]]), s.index, s.index + bytesToGet ]
];
END;
s.index ← s.index + bytesToGet;
count ← count - bytesToGet;
startIndex ← startIndex + bytesToGet;
nBytesRead ← nBytesRead + bytesToGet;
ENDLOOP;
END; -- of GetTapeBlock
Close:
PROC[self:
IO.
STREAM, abort:
BOOL ←
FALSE] =
BEGIN
s: TapeStreamState ← NARROW[self.streamData];
IF self.streamProcs = NIL THEN RETURN;
IF s.writing
THEN
BEGIN
Flush[self];
s.status ← s.tapeHandle.WriteFileMark[ ! TapeOps.TapeOpsError => ProduceError[ec, code]];
IF s.tapeRecordProc # NIL THEN s.tapeRecordProc[s.clientData];
s.status ← s.tapeHandle.WriteFileMark[ ! TapeOps.TapeOpsError => ProduceError[ec, code]];
s.status ← s.tapeHandle.BackSpaceFile[ ! TapeOps.TapeOpsError => ProduceError[ec, code]];
END;
IF abort THEN s.status ← s.tapeHandle.Unload[ ! TapeOps.TapeOpsError => ProduceError[ec, code]];
s.clientData ← NIL;
END; -- of Close
EndOf:
PUBLIC
PROC[self:
IO.
STREAM]
RETURNS [
BOOL] =
BEGIN
s: TapeStreamState ← NARROW[self.streamData];
IF
NOT s.firstRecordRead
THEN
BEGIN
[s.eof, s.buffer, s.status] ← s.tapeHandle.ReadRecord[s.buffer
! TapeOps.TapeOpsError => ProduceError[ec, code]];
s.lastBufferIndexPlusOne ← s.buffer.length;
s.firstRecordRead ← TRUE;
END;
RETURN [s.eof];
END;
Flush:
PUBLIC
PROC [ self:
IO.
STREAM ] =
BEGIN
s: TapeStreamState = NARROW[self.streamData];
fb: FlushBlockProc = NARROW[IOUtils.LookupProc[self, $FlushBlock], REF FlushBlockProc]^;
fb[self: self, padChar: (IF s.padding = blanks THEN ' ELSE '\000), truncate: s.padding = truncate];
END;
FlushBlock:
PROC [ self:
IO.
STREAM, padChar:
CHAR ← '\000, bytesRequired:
INT ←
LAST[
INT], truncate:
BOOL ←
FALSE ]
-- TapeStreams.FlushBlockProc -- =
BEGIN
s: TapeStreamState ← NARROW[self.streamData];
IF s.writing
AND s.index # 0
AND (bytesRequired =
LAST[
INT]
-- to catch overflow --
OR s.index+bytesRequired>s.lastBufferIndexPlusOne)
THEN
BEGIN
IF ~truncate
THEN
BEGIN
FOR i:
INT
IN [s.index .. s.lastBufferIndexPlusOne)
DO
s.buffer[i] ← padChar;
ENDLOOP;
s.index ← s.lastBufferIndexPlusOne;
END;
s.buffer.length ← s.index;
s.status ← s.tapeHandle.WriteRecord[s.buffer
! TapeOps.TapeOpsError => ProduceError[ec, code]];
IF s.tapeRecordProc # NIL THEN s.tapeRecordProc[s.clientData];
s.index ← 0;
END;
END;
Internal Procs
ProduceError:
PROC [ec:
ROPE, code: TapeOps.ErrorCode] =
BEGIN
ERROR Error[ [(SELECT code FROM
DataError => environment,
NameLookUpError => user,
ServerControlStreamAbort => environment,
ServerProtocolError => bug,
TapeOperationError => environment,
TapeUserError => user,
ENDCASE => ERROR), ec] ];
END;
StoreBuffer:
PROC [s: TapeStreamState] =
BEGIN
s.buffer.length ← s.index;
s.status ← s.tapeHandle.WriteRecord[s.buffer
! TapeOps.TapeOpsError => ProduceError[ec, code]];
s.index ← 0;
IF s.tapeRecordProc # NIL THEN s.tapeRecordProc[s.clientData];
END;
LoadBuffer:
PROC [s: TapeStreamState] =
BEGIN
fmk: BOOL ← FALSE;
[fmk, s.buffer, s.status] ← s.tapeHandle.ReadRecord[s.buffer
! TapeOps.TapeOpsError => ProduceError[ec, code];
TapeOps.TapeOpsWarning => RESUME [s.allowSoftErrors]];
IF fmk THEN s.index ← -1 ELSE s.index ← 0;
s.lastBufferIndexPlusOne ← s.buffer.length;
IF s.tapeRecordProc # NIL THEN s.tapeRecordProc[s.clientData];
END;
END. -- of TapeStreamsImpl