(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)

(* Last modified on Tue Jun  9 13:57:07 PDT 1992 by kalsow     *)
(*      modified on Tue Mar 24 22:18:02 PST 1992 by muller     *)

UNSAFE MODULE UFileWr;

IMPORT Unix, Uuio, IOFailure, Wr, WrClass, Ustat, Word;

REVEAL
  T = Wr.T BRANDED "UFileWr.T" OBJECT
        targetFD: INTEGER;
      OVERRIDES
        close := Close;
      END;

EXCEPTION Error;
<*FATAL Error*>

(*---------------------- FILE WRITERS ---------------------------------*)

PROCEDURE New (fd: INTEGER; buffered := FALSE): T  RAISES {Wr.Failure} =
  VAR statbuf: Ustat.struct_stat;
  BEGIN
    IF Ustat.fstat (fd, ADR (statbuf)) = -1 THEN Fail (IOFailure.fstat); END;
    CASE Word.And (statbuf.st_mode, Ustat.S_IFMT) OF
    | Ustat.S_IFCHR, Ustat.S_IFPIPE, Ustat.S_IFPORT, Ustat.S_IFSOCK => 
        RETURN NewTerminalWriter (fd, buffered);
    | Ustat.S_IFREG =>
        RETURN NewDiskWriter (fd, statbuf.st_size);
    ELSE
        RETURN NewDiskWriter (fd, statbuf.st_size);
    END;
  END New;

PROCEDURE Close (wr: T) RAISES {Wr.Failure} =
  BEGIN
    wr.buff := NIL;
    wr.closed := TRUE;
    IF (wr.targetFD >= 3) AND (Unix.close (wr.targetFD) = -1) THEN
      Fail (IOFailure.close);
    END;
  END Close;

PROCEDURE Fail (reason: IOFailure.T) RAISES {Wr.Failure} =
  BEGIN
    RAISE Wr.Failure (reason);
  END Fail;

(*---------------------- DISK WRITERS --------------------------------*)


CONST
  DiskWriterBuffSize = 4096;

TYPE
  DiskWriter = T BRANDED "UFileWr.DiskWriter" OBJECT
                 targetSize: INTEGER; 
               OVERRIDES
                 length := DiskLength;
                 seek   := DiskSeek;
                 flush  := DiskFlush;
               END;

PROCEDURE NewDiskWriter (fd: INTEGER; size: INTEGER): DiskWriter RAISES {} =
  BEGIN
    RETURN (NEW (DiskWriter, 
                    st := 0, 
                    lo := 0,
                    cur := 0,
                    hi := DiskWriterBuffSize,
                    buff := NEW (REF ARRAY OF CHAR, DiskWriterBuffSize),
                    closed := FALSE,
                    seekable := TRUE,
                    buffered := TRUE,
                    targetFD := fd,
                    targetSize := size));
  END NewDiskWriter;

PROCEDURE DiskLength (wr: DiskWriter): CARDINAL RAISES {} =
  BEGIN
    RETURN wr.targetSize;
  END DiskLength;

PROCEDURE DiskSeek (wr: DiskWriter; n: CARDINAL) RAISES {Wr.Failure}=
  VAR buffered, status: INTEGER;
  BEGIN
    IF (wr.closed) THEN RAISE Error(*Closed*); END;
    buffered := wr.cur - wr.lo;
    IF (buffered # 0) THEN
      status := Uuio.write (wr.targetFD, ADR (wr.buff^ [0]), buffered);
      IF (status # buffered) THEN Fail (IOFailure.write); END;
      wr.targetSize := MAX (wr.targetSize, wr.cur);
    END;
    n := MIN (n, wr.targetSize);
    IF (n # wr.cur) THEN
      status := Unix.lseek (wr.targetFD, n, Unix.L_SET);
      IF (status # n) THEN Fail (IOFailure.lseek); END;
    END;
    wr.lo := n;
    wr.cur := n;
    wr.hi := wr.lo + NUMBER (wr.buff^);
  END DiskSeek;

PROCEDURE DiskFlush (wr: DiskWriter) RAISES {Wr.Failure} =
  VAR status, buffered: INTEGER;
  BEGIN
    buffered := wr.cur - wr.lo;
    IF (buffered # 0) THEN
      status := Uuio.write (wr.targetFD, ADR (wr.buff^ [0]), buffered);
      IF status # buffered THEN Fail (IOFailure.write); END;
      wr.targetSize := MAX (wr.targetSize, wr.cur);
      wr.lo := wr.cur;
      wr.hi := wr.cur + NUMBER (wr.buff^);
    END;
  END DiskFlush;

(*---------------------- TERMINAL WRITERS --------------------------------*)

CONST
  TerminalWriterBuffSize = 4096;

TYPE
  TerminalWriter = T BRANDED "UFileWr.TerminalWriter" OBJECT
		   OVERRIDES
		     seek  := TerminalSeek;
	             flush := TerminalFlush;
                   END;

PROCEDURE NewTerminalWriter (fd: INTEGER; buffered: BOOLEAN): TerminalWriter
          RAISES {} =
  BEGIN
    RETURN (NEW (TerminalWriter,
		 st := 0,
		 lo := 0,
		 cur := 0,
		 hi := TerminalWriterBuffSize,
	         buff := NEW (REF ARRAY OF CHAR, TerminalWriterBuffSize),
		 closed := FALSE,
		 seekable := FALSE,
		 buffered := buffered,
                 targetFD := fd));
  END NewTerminalWriter;

PROCEDURE TerminalSeek (wr: TerminalWriter; n: CARDINAL) RAISES {Wr.Failure} =
  VAR status, buffered: INTEGER;
  BEGIN
    IF (n # wr.cur) OR (wr.cur # wr.hi) THEN RAISE Error(*Unseekable*); END;
    buffered := wr.cur - wr.lo;
    status := Uuio.write (wr.targetFD, ADR (wr.buff^ [0]), buffered);
    IF status # buffered THEN Fail (IOFailure.write); END;
    wr.lo := wr.cur;
    wr.hi := wr.cur + NUMBER (wr.buff^);
  END TerminalSeek;

PROCEDURE TerminalFlush (wr: TerminalWriter) RAISES {Wr.Failure} =
  VAR status, buffered: INTEGER;
  BEGIN
    IF (wr.lo < wr.cur) THEN
      buffered := wr.cur - wr.lo;
      status := Uuio.write (wr.targetFD, ADR (wr.buff^ [0]), buffered);
      IF status # buffered THEN Fail (IOFailure.write); END;
      wr.lo := wr.cur;
      wr.hi := wr.cur + NUMBER (wr.buff^);
    END;
  END TerminalFlush;

BEGIN
END UFileWr.