TapeStreamsImpl.mesa
Copyright © 1984, 1986, Xerox Corporation. All rights reserved.
Last Edited by: McCreight, February 26, 1985 1:51:09 pm PST
Tim Diebert: August 6, 1986 11:17:49 am PDT
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 ANYNIL, allowSoftErrors: BOOLTRUE]
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: NATLAST[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: NATLAST[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 {block.length ← 0; 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; block.length ← nBytesRead; 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;
block.length ← nBytesRead;
END; -- of GetTapeBlock
Close: PROC[self: IO.STREAM, abort: BOOLFALSE] = 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: INTLAST[INT], truncate: BOOLFALSE ] -- 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: BOOLFALSE;
[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