Last modified on Fri Sep 23 11:12:07 PDT 1994 by kalsow modified on Mon Jun 21 11:48:09 PDT 1993 by wobber modified on Sun May 23 00:04:54 PDT 1993 by swart modified on Wed Apr 28 12:01:41 PDT 1993 by mcjones modified on Thu Jan 28 13:54:21 PST 1993 by mjordan modified on Tue Mar 24 22:18:02 PST 1992 by muller
UNSAFE MODULE; IMPORT File, FS, Pathname, OSError, RegularFile, Wr, WrClass; IMPORT RTIO, Fmt; PROCEDURE FileWr Open (p: Pathname.T): T RAISES {OSError.E} = BEGIN RETURN NEW(T).init(FS.OpenFile(p)) END Open; PROCEDUREOpenAppend (p: Pathname.T): T RAISES {OSError.E} = VAR h: RegularFile.T := FS.OpenFile(p, truncate := FALSE); BEGIN EVAL h.seek(RegularFile.Origin.End, 0); RETURN NEW(T).init(h) END OpenAppend; REVEAL T = Public BRANDED "FileWr.T" OBJECT targetH: File.T; OVERRIDES init := Init; seek := Seek; length := Length; flush := Flush; close := Close; putString := PutString; END;
Q1: Ifwr.targetH
is aRegularFile.T
then the current position ofwr.targetH
is equal towr.lo
.Q2: If
wr.seekable
, thenwr.targetH
is aRegularFile.T
.
TYPE CharBuffer = REF ARRAY OF CHAR; CONST BufferSize = 4096; CONST BIG = 16_1000000; (* 2^24 => 16M *) TYPE ByteArrayPtr = UNTRACED REF ARRAY [0 .. BIG-1] OF File.Byte; PROCEDUREInit (wr: T; h: File.T; buffered: BOOLEAN := TRUE): T RAISES {OSError.E} = BEGIN wr.targetH := h; wr.st := 0; wr.closed := FALSE; IF (wr.buff = NIL) THEN wr.buff := NEW(CharBuffer, BufferSize); (*ELSE reuse the existing buffer *) END; TYPECASE h OF | RegularFile.T (hRF) => (* seekable *) wr.seekable := TRUE; wr.cur := hRF.seek(RegularFile.Origin.Current, 0); wr.buffered := TRUE; ELSE wr.seekable := FALSE; wr.cur := 0; wr.buffered := buffered; END; wr.lo := wr.cur; wr.hi := wr.cur + NUMBER(wr.buff^); RETURN wr END Init; EXCEPTION Error; <*FATAL Error*> PROCEDURESeek (wr: T; n: CARDINAL) RAISES {Wr.Failure} = BEGIN IF NOT wr.seekable AND n # wr.hi THEN RTIO.PutText("FileWr.Seek:wr.seekable=" & Fmt.Bool(wr.seekable) & ";n=" & Fmt.Int(n) & ";wr.hi=" & Fmt.Int(wr.hi) & "\n"); RTIO.Flush(); RAISE Error END; TRY EmptyBuffer (wr); (* Maintains V4 -- we hope that on a seek failure the file position is unchanged, ensuring Q1 *) IF n # wr.cur THEN IF n > wr.cur THEN n := MIN(n, VAL(wr.targetH.status().size, INTEGER)); END; EVAL NARROW(wr.targetH, RegularFile.T).seek( RegularFile.Origin.Beginning, n); wr.cur := n; wr.lo := n; wr.hi := n + NUMBER(wr.buff^); END; EXCEPT | OSError.E(code) => RAISE Wr.Failure(code) END END Seek; PROCEDURELength (wr: T): CARDINAL RAISES {Wr.Failure} = BEGIN TRY IF wr.seekable THEN RETURN MAX (wr.cur, VAL(wr.targetH.status().size, INTEGER)); ELSE RETURN wr.cur; END EXCEPT | OSError.E(code) => RAISE Wr.Failure(code) END END Length; PROCEDUREFlush (wr: T) RAISES {Wr.Failure} = BEGIN IF wr.cur > wr.lo THEN TRY EmptyBuffer (wr); EXCEPT OSError.E(code) => RAISE Wr.Failure(code) END; END END Flush; PROCEDUREEmptyBuffer (wr: T) RAISES {OSError.E} = VAR buffered := wr.cur - wr.lo; start := 0; n: INTEGER; BEGIN WHILE (buffered > 0) DO n := MIN (buffered, BIG); wr.targetH.write( SUBARRAY(LOOPHOLE(ADR(wr.buff[start]), ByteArrayPtr)^, 0, n)); DEC (buffered, n); INC (start, n); END; (* the file position is now wr.cur *) wr.lo := wr.cur; wr.hi := wr.cur + NUMBER(wr.buff^); END EmptyBuffer; PROCEDUREPutString (wr: T; READONLY buf: ARRAY OF CHAR) RAISES {Wr.Failure} = VAR toWrite, start, n: INTEGER; BEGIN IF NUMBER(buf) <= wr.hi - wr.cur THEN SUBARRAY(wr.buff^, wr.cur - wr.lo, NUMBER(buf)) := buf; INC(wr.cur, NUMBER(buf)); ELSE Flush(wr); IF 2 * NUMBER(buf) < NUMBER(wr.buff^) THEN SUBARRAY(wr.buff^, 0, NUMBER(buf)) := buf; INC(wr.cur, NUMBER(buf)); ELSE TRY toWrite := NUMBER (buf); start := 0; WHILE toWrite > 0 DO n := MIN (toWrite, BIG); wr.targetH.write( SUBARRAY(LOOPHOLE(ADR(buf[start]), ByteArrayPtr)^, 0, n)); DEC (toWrite, n); INC (start, n); END; INC(wr.cur, NUMBER(buf)); wr.lo := wr.cur; wr.hi := wr.cur + NUMBER(wr.buff^); EXCEPT | OSError.E (code) => RAISE Wr.Failure(code); END END END END PutString; PROCEDUREClose (wr: T) RAISES {Wr.Failure} = BEGIN TRY wr.targetH.close() EXCEPT OSError.E(code) => RAISE Wr.Failure(code) END; END Close; BEGIN END FileWr.