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;


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;



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
  
ΰTapeStreamsImpl.mesa
Copyright c 1984, 1986, Xerox Corporation.  All rights reserved.
Last Edited by: McCreight, February 26, 1985 1:51:09 pm PST
Tim Diebert: March 18, 1986 8:22:52 am PST
Private Procs
Internal Procs
Κ
ή˜
codeš
œ™K•StartOfExpansion[]šœ
Οm
œ5™@K™;K™*—K˜š
Οk	˜	Kšžœ
žœ7žœ˜TKšœžœ˜&Kšœžœ˜Kšœžœžœ˜šœžœC˜PKš
œZ˜Z—Kš
œ˜—K˜šΟbœžœ
ž˜Kšžœ
žœ!˜+Kšžœ
žœ
žœž˜%Kšžœ
˜K˜Kšžœžœžœ
˜Kšžœžœžœ
žœ
˜K˜Kšœ
žœžœ˜.K˜KšŸœžœ
žœžœ
˜.K˜šΠbn
œžœ
žœDžœIžœ#žœžœ
žœžœžœžœžœ	žœ
žœž˜­Kšžœ0˜6Kšœ
žœ
žœ
˜ Kšœžœ˜-šžœ%ž˜+šžœ˜Kš
œP˜P——šžœžœ
ž˜Kš
œ.˜.Kšžœžœžœ
žœ+˜DKšžœ
˜—K˜Kš
œ˜Kš
œ"˜"Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ$˜$Kš
œ'˜'Kšœžœ
žœ˜.Kšœžœ
˜šžœ
ž˜šœžœ&˜?Kš
œC˜CKš
œ˜—š
œ˜Kš
ž˜Kšœžœ&˜6Kš
œD˜DKš
œ˜Kšœ,žœ˜NKšžœ
˜—Kšžœžœ
˜—Kšœ	žœ˜)šžœ5žœžœ
ž˜FKš
œ˜Kšœžœ
žœ˜"Kš
œ˜šžœ
ž˜Kš	œžœ%žœ
žœ
žœ,˜hKš	œ	žœ$žœ
žœ
žœ,˜hKšžœžœ
˜—Kšžœ
˜—Kšžœ
˜—K˜Kš
Ÿ
™
K˜šΟnœžœžœ
žœžœž˜2Kšœžœ˜-Kšœžœ
˜Kšžœ%žœ˜;Kš
œ˜K˜KšžœΟc˜—K˜K˜š‘œž˜Kšœžœ
žœ	žœ
žœ
žœžœ
žœžœ
žœž˜`Kšœžœ˜-Kšœžœ˜!Kšœžœ
˜šžœž˜Kšœžœ
˜"Kšžœ%žœ˜;Kš
œ1˜1Kšœ
žœ˜%šžœ
ž˜
š
œ˜Kšœžœžœ
žœžœ
žœ'˜ZKšœ	žœžœ
žœžœ
žœ*˜\Kš
œ˜—Kšžœ
˜—Kš
œ˜Kš
œ˜Kš
œ%˜%Kšžœ
˜—Kšžœ’˜—K˜K˜š
‘œžœžœ
žœžœžœž˜;Kšœžœ˜-šžœ
žœžœ
ž˜#˜4Kš
œ2˜2—Kš
œ+˜+Kšœžœ
˜Kšžœ
˜—Kšžœžœ
žœ
žœ˜)Kš
œ˜K˜šžœ%žœ
ž˜1Kš
œ˜Kšžœžœ	žœ
˜"Kšžœ
˜—Kšžœ˜
Kšžœ’˜—K˜š‘œž˜šœžœ
žœ	žœ
žœžœ
žœžœ
žœ˜OKšžœ
žœž˜ —Kšœžœ˜-šžœ
žœžœ
ž˜#˜4Kš
œ2˜2—Kš
œ+˜+Kšœžœ
˜Kšžœ
˜—Kšžœžœ
žœ˜Kšœžœ&˜1Kš
œ˜šžœž˜Kšœžœ
˜"šžœ%žœ
ž˜1Kš
œ˜Kšžœžœžœžœ˜<Kšžœ
˜—Kš
œ1˜1Kšœ
žœ˜%šžœ
ž˜
š
œ˜Kšœžœžœ
žœžœ
žœ+˜[Kšœ	žœžœ
žœžœ
žœ&˜[Kš
œ˜—Kšžœ
˜—Kš
œ˜Kš
œ˜Kš
œ%˜%Kš
œ%˜%Kšžœ
˜—Kšžœ’˜—K˜š
‘œžœžœ
žœ	žœžœž˜9Kšœžœ˜-Kšžœžœ
žœ
žœ
˜&šžœžœ
ž˜Kš
œ˜Kš
œY˜YKšžœžœ
žœ ˜>Kš
œY˜YKš
œY˜YKšžœ
˜—KšžœžœS˜`Kšœžœ
˜Kšžœ’˜—K˜š œžœ
žœžœ
žœžœžœž˜:Kšœžœ˜-šžœ
žœžœ
ž˜#˜>Kš
œ2˜2—Kš
œ+˜+Kšœžœ
˜Kšžœ
˜—Kšžœ	˜Kšžœ
˜—K˜š‘œžœ
žœ	žœ
žœž˜.Kšœžœ˜-Kšœžœ(žœ˜XKšœžœžœžœ)˜dKšžœ
˜—K˜š 
œžœ	žœ
žœžœžœžœ
žœ
žœžœ’ œ˜–
Kš
ž˜Kšœžœ˜-šžœžœ
žœžœ
žœ’œ
žœ1ž˜‹
Kš
ž˜šžœž˜Kš
ž˜šžœžœ
žœ'ž˜6Kš
œ˜Kšžœ
˜—Kš
œ#˜#Kšžœ
˜—Kš
œ˜š
œ,˜,Kš
œ2˜2—Kšžœžœ
žœ ˜>Kš
œ˜Kšžœ
˜—Kšžœ
˜K˜K˜—Kš
 ™K˜š œžœžœž˜>Kšžœ
žœž˜Kš
œ˜Kš
œ˜Kš
œ(˜(Kš
œ˜Kš
œ"˜"Kš
œ˜Kšžœžœ	˜Kšžœ
˜—K˜š‘œžœž˜.K˜š
œ,˜,Kš
œ2˜2—K˜Kšžœžœ
žœ ˜>Kšžœ
˜—K˜š 
œžœž˜-Kšœžœžœ
˜š
œ<˜<Kš
œ1˜1Kšœžœ˜6—Kšžœžœžœ
˜*Kš
œ+˜+Kšžœžœ
žœ ˜>Kšžœ
˜K˜K˜—Kšžœ’œ˜——…— b,