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

(* Last modified on Tue Oct 13 15:45:11 PDT 1992 by muller     *)
(*      modified on Tue Jan 28 12:06:18 PST 1992 by kalsow     *)


UNSAFE MODULE UFileRd;

IMPORT M3toC, IOFailure, Rd, RdClass, Thread, RTScheduler, Word;
IMPORT Unix, Uerror, Uuio, Ustat;

REVEAL
  T = Rd.T BRANDED "UFileRd.T" OBJECT
        targetFD: INTEGER;
      OVERRIDES
        close := Close;
      END;

(*---------------------------- FILE READERS ------------------------*)

PROCEDURE New (fd: INTEGER): T RAISES {Rd.Failure} =
  VAR statbuf: Ustat.struct_stat;
  BEGIN
    IF Ustat.fstat (fd, ADR (statbuf)) # 0 THEN Fail (IOFailure.fstat); END;
    CASE Word.And (statbuf.st_mode, Ustat.S_IFMT) OF
    | Ustat.S_IFCHR =>
        IF IsDevNull (statbuf)
          THEN RETURN NewDiskReader (fd, statbuf.st_size);
          ELSE RETURN NewTerminalReader (fd);
        END;
    | Ustat.S_IFPIPE, Ustat.S_IFPORT, Ustat.S_IFSOCK =>
        RETURN NewTerminalReader (fd);
    | Ustat.S_IFREG =>
        RETURN NewDiskReader (fd, statbuf.st_size);
    ELSE
        RETURN NewDiskReader (fd, statbuf.st_size);
    END;
  END New;

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

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

VAR null_done := FALSE;
VAR null_stat : Ustat.struct_stat;
VAR null_fd   : INTEGER;

PROCEDURE IsDevNull (READONLY statbuf: Ustat.struct_stat): BOOLEAN RAISES {} =
  VAR x: INTEGER;
  BEGIN
    IF (NOT null_done) THEN
      null_done := TRUE;
      null_fd := Unix.open (M3toC.TtoS ("/dev/null"), Unix.O_RDONLY,
                                                         Unix.Mrwrwrw);
      IF (null_fd < 0) THEN RETURN FALSE END;
      x := Ustat.fstat (null_fd, ADR (null_stat));
      EVAL Unix.close (null_fd);
      IF (x # 0) THEN null_fd := -1 END;
    END;
    RETURN (null_fd >= 0) AND (statbuf.st_rdev = null_stat.st_rdev);
  END IsDevNull;

(*-------------------------- DISK READERS ---------------------------*)

CONST
  DiskReaderBuffSize = 4096;

TYPE
  DiskReader = T BRANDED "UFileRd.DiskReader" OBJECT
                 targetSize: INTEGER; 
               OVERRIDES
                 seek   := DiskSeek;
                 length := DiskLength;
               END;

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

PROCEDURE DiskSeek (rd: DiskReader; <*UNUSED*> dontBlock: BOOLEAN):
              RdClass.SeekResult RAISES {Rd.Failure} =
  VAR status: INTEGER;
  BEGIN
    status := Unix.lseek (rd.targetFD, rd.cur, Unix.L_SET);
    IF (status # rd.cur) THEN Fail (IOFailure.lseek); END;
    status := Uuio.read (rd.targetFD, ADR (rd.buff^ [FIRST (rd.buff^)]),
                           NUMBER (rd.buff^));
    IF (status = -1) THEN
      Fail (IOFailure.read);
      <* ASSERT FALSE *>
    ELSIF (status = 0) THEN
      rd.cur := rd.targetSize;
      RETURN (RdClass.SeekResult.Eof);
    ELSE
      rd.lo := rd.cur;
      rd.hi := rd.cur + status;
      RETURN (RdClass.SeekResult.Ready);
    END;
  END DiskSeek;

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

(*---------------------- TERMINAL READERS ----------------------------*)


CONST
  TerminalReaderBuffSize = 4096;

TYPE
  TerminalReader = T BRANDED "UFileRd.TerminalReader" OBJECT
		   OVERRIDES
                     seek := TerminalSeek;
                   END;

PROCEDURE NewTerminalReader (fd: INTEGER): TerminalReader RAISES {} =
  BEGIN
    RETURN (NEW (TerminalReader,
	            st := 0,
		    lo := 0,
		    cur := 0,
		    hi := 0,
	            buff := NEW (REF ARRAY OF CHAR, TerminalReaderBuffSize),
		    closed := FALSE, 
		    seekable := FALSE,
	            intermittent := TRUE, 
		    targetFD := fd));

  END NewTerminalReader;

PROCEDURE TerminalSeek (rd: TerminalReader; dontBlock: BOOLEAN): RdClass.SeekResult
   RAISES {Rd.Failure, Thread.Alerted} =

  VAR
    status: INTEGER;
    readFDSet, errorFDSet := Unix.FDSet {rd.targetFD};
    old_mode := Unix.fcntl (rd.targetFD, Unix.F_GETFL, 0);
    new_mode := Word.Or (old_mode, Unix.O_NDELAY);
  BEGIN
    LOOP
      (* make the read call non-blocking; we cannot set/reset the mode at
         creation/close time, because this may leave the file in an unexpected
         state in the case of a core dump elsewhere. *)

      IF Unix.fcntl (rd.targetFD, Unix.F_SETFL, new_mode) # 0 THEN
	Fail (IOFailure.fcntl);
      END;

      status := Uuio.read (rd.targetFD, ADR (rd.buff^ [FIRST (rd.buff^)]),
                             NUMBER (rd.buff^));

      IF Unix.fcntl (rd.targetFD, Unix.F_SETFL, old_mode) # 0 THEN
	Fail (IOFailure.fcntl);
      END;

      IF status = -1
         AND Uerror.errno # Uerror.EWOULDBLOCK
         AND Uerror.errno # Uerror.EAGAIN THEN
        Fail (IOFailure.read);
      ELSIF status = 0 THEN
        RETURN RdClass.SeekResult.Eof
      ELSIF status > 0 THEN
        rd.lo := rd.cur;
        rd.hi := rd.cur + status;
        RETURN RdClass.SeekResult.Ready;
      ELSIF dontBlock THEN
        RETURN RdClass.SeekResult.WouldBlock;
      END;

      EVAL RTScheduler.IOAlertSelect (Unix.MAX_FDSET, 
                                      ADR (readFDSet), 
                                      NIL, ADR (errorFDSet));
    END;

  END TerminalSeek;

BEGIN
END UFileRd.