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

(* Last modified on Fri Jul 13 01:55:01 1990 by muller         *)

UNSAFE MODULE UFileRdWr EXPORTS UFileRdWr, FileStream, Stdio;

IMPORT CoreOS, CoreOS, M3toC;
IMPORT Wr, WrClass, Rd, RdClass, Text, Time;
IMPORT Word;

TYPE
  FileReader = Rd.T BRANDED "UFileRdWr.FileReader" OBJECT
                 targetFD: INTEGER; END;

  FileWriter = Wr.T BRANDED "UFileRdWr.FileWriter" OBJECT
                 targetFD: INTEGER; END;

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


CONST
  DiskWriterBuffSize = 4096;

TYPE
  DiskWriter = FileWriter BRANDED "UFileRdWr.DiskWriter" OBJECT
                 targetSize: INTEGER; 
               METHODS
                 seek := DiskWriterSeek;
                 flush := DiskWriterFlush;
                 close := FileWriterClose END;

PROCEDURE NewDiskWriter (fd: INTEGER; size: INTEGER): FileWriter =
  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 DiskWriterSeek (wr: DiskWriter; n: CARDINAL)
    RAISES {Wr.Error, Wr.Failure} =
  VAR buffered, status: INTEGER;
  BEGIN
    IF (wr.closed) THEN
      RAISE Wr.Error (Wr.Code.Closed); END;
    buffered := wr.cur - wr.lo;
    IF (buffered # 0) THEN
      status := CoreOS.write (wr.targetFD, ADR (wr.buff^ [0]), buffered);
      IF (status # buffered) THEN
        RAISE Wr.Failure (NIL); END;
      wr.targetSize := MAX (wr.targetSize, wr.cur); END;
    n := MIN (n, wr.targetSize);
    IF (n # wr.cur) THEN
      status := CoreOS.lseek (wr.targetFD, n, CoreOS.L_SET);
      IF (status # n) THEN
        RAISE Wr.Failure (NIL); END; END;
    wr.lo := n;
    wr.cur := n;
    wr.hi := wr.lo + NUMBER (wr.buff^);
  END DiskWriterSeek;

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

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

CONST
  DiskReaderBuffSize = 4096;

TYPE
  DiskReader = FileReader BRANDED "UFileRdWr.DiskReader" OBJECT
                 targetSize: INTEGER; 
               METHODS
                 seek := DiskReaderSeek;
                 length := DiskReaderLength;
                 close := FileReaderClose; END;

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

PROCEDURE DiskReaderSeek (rd: DiskReader; <*UNUSED*> dontBlock: BOOLEAN):
              RdClass.SeekResult RAISES {Rd.Failure, Rd.Alerted, Rd.Error} =
  VAR status: INTEGER;
  BEGIN
    status := CoreOS.lseek (rd.targetFD, rd.cur, CoreOS.L_SET);
    IF (status # rd.cur) THEN
      RAISE Rd.Failure (NIL); END;
    status := CoreOS.read (rd.targetFD, ADR (rd.buff^ [FIRST (rd.buff^)]),
                           NUMBER (rd.buff^));
    IF (status = -1) THEN
      RAISE Rd.Failure (NIL);
    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 DiskReaderSeek;

PROCEDURE DiskReaderLength (rd: DiskReader): CARDINAL
  RAISES {Rd.Failure, Rd.Alerted, Rd.Error} =
  BEGIN
    RETURN (rd.targetSize);
  END DiskReaderLength;

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

CONST
  TerminalWriterBuffSize = 1;

TYPE
  TerminalWriter = FileWriter BRANDED "UFileRdWr.TerminalWriter" OBJECT
		   METHODS
		     seek := TerminalWriterSeek;
	             flush := TerminalWriterFlush;
		     close := FileWriterClose; END;

PROCEDURE NewTerminalWriter (fd: INTEGER; buffered: BOOLEAN): FileWriter =
  VAR bufSize: INTEGER;
  BEGIN
    IF buffered THEN
      bufSize := DiskWriterBuffSize;
    ELSE
      bufSize := TerminalWriterBuffSize; END;

    RETURN (NEW (TerminalWriter,
		 st := 0,
		 lo := 0,
		 cur := 0,
		 hi := bufSize,
	         buff := NEW (REF ARRAY OF CHAR, bufSize),
		 closed := FALSE,
		 seekable := FALSE,
		 buffered := buffered,
                 targetFD := fd));
  END NewTerminalWriter;

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

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

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


CONST
  TerminalReaderBuffSize = 4096;

TYPE
  TerminalReader = FileReader BRANDED "UFileRdWr.TerminalReader" OBJECT
		   METHODS
 		      seek := TerminalReaderSeek;
	              close := FileReaderClose; END;

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

  IF CoreOS.fcntl (fd, CoreOS.F_SETFL, 
	           Word.Or (CoreOS.fcntl (fd, CoreOS.F_GETFL, 0),
                            CoreOS.O_NDELAY)) # 0 THEN
    RAISE Rd.Failure (NIL); END;
  	
  END NewTerminalReader;

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

  (* CoreOS.read will not block because we have set O_NDELAY in this file. *)

  VAR status: INTEGER;
  BEGIN
    LOOP
      status := CoreOS.read (rd.targetFD, ADR (rd.buff^ [FIRST (rd.buff^)]),
                             NUMBER (rd.buff^));
      IF     status = -1
         AND CoreOS.errno # CoreOS.EWOULDBLOCK
         AND CoreOS.errno # CoreOS.EAGAIN THEN
        RAISE Rd.Failure (NIL);
      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;

      Time.Pause (10000); END;

  END TerminalReaderSeek;

(*---------------------- NULL WRITERS --------------------------------*)

CONST
  NullWriterBuffSize = 1024;

TYPE
  NullWriter = FileWriter BRANDED "UFileRdWr.NullWriter" OBJECT
		   METHODS
		     seek := NullWriterSeek;
	             flush := NullWriterFlush;
		     close := FileWriterClose; END;

PROCEDURE NewNullWriter (fd: INTEGER): FileWriter =
  BEGIN
    RETURN (NEW (NullWriter,
		    st := 0,
		    lo := 0,
		    cur := 0,
		    hi := NullWriterBuffSize,
	            buff := NEW (REF ARRAY OF CHAR, NullWriterBuffSize),
		    closed := FALSE,
		    seekable := FALSE,
		    buffered := TRUE,
                    targetFD := fd));
  END NewNullWriter;

PROCEDURE NullWriterSeek (wr: NullWriter; n: CARDINAL) RAISES {Wr.Error} =
  BEGIN
    IF (n # wr.cur) OR (wr.cur # wr.hi) THEN
      RAISE Wr.Error (Wr.Code.Unseekable); END;
    wr.lo := wr.cur;
    wr.hi := wr.cur + 1;
  END NullWriterSeek;

PROCEDURE NullWriterFlush (<*UNUSED*> wr: NullWriter) RAISES {} =
  BEGIN
  END NullWriterFlush;

(*---------------------- NULL READERS ----------------------------*)


TYPE
  NullReader = FileReader BRANDED "UFileRdWr.NullReader" OBJECT
		   METHODS
 		      seek := NullReaderSeek;
	              close := FileReaderClose; END;

PROCEDURE NewNullReader (fd: INTEGER): FileReader =
  BEGIN
    RETURN (NEW (NullReader,
		    st := 0,
		    lo := 0,
		    cur := 0,
		    hi := 0,
	            buff := NIL,
		    closed := FALSE, 
		    seekable := FALSE,
	            intermittent := FALSE, 
		    targetFD := fd));
  END NewNullReader;

PROCEDURE NullReaderSeek (<*UNUSED*> rd: NullReader; 
                          <*UNUSED*> dontBlock: BOOLEAN): RdClass.SeekResult
   RAISES {Rd.Failure, Rd.Alerted, Rd.Error} =

  BEGIN
    RETURN (RdClass.SeekResult.Eof);
  END NullReaderSeek;

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

PROCEDURE CreateFileWriter (fd: INTEGER; buffered := FALSE): Wr.T =
  VAR
    wr: FileWriter;
    statbuf: CoreOS.struct_stat;
  BEGIN
    IF CoreOS.fstat (fd, statbuf) = -1 THEN
      RAISE Wr.Failure (NIL); END;
    CASE statbuf.st_mode DIV CoreOS.SIFMT OF
    | CoreOS.SIFCHR => 
      IF statbuf.st_rdev = 770 THEN
        wr := NewNullWriter (fd);
      ELSE
        wr := NewTerminalWriter (fd, buffered); END;
    | CoreOS.SIFPIPE, CoreOS.SIFPORT =>
      wr := NewDiskWriter (fd, 0);
    | CoreOS.SIFREG =>
      wr := NewDiskWriter (fd, statbuf.st_size);
    ELSE
      RAISE Wr.Failure (NIL); END;
    RETURN (wr);
  END CreateFileWriter;

PROCEDURE FileWriterClose (wr: FileWriter) RAISES {Wr.Failure} =
  BEGIN
    wr.buff := NIL;
    wr.closed := TRUE;
    IF wr.targetFD >= 3 THEN
      IF CoreOS.close (wr.targetFD) = -1 THEN RAISE Wr.Failure (NIL); END; END;
  END FileWriterClose;

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

PROCEDURE CreateFileReader (fd: INTEGER): Rd.T =
  VAR
    rd: FileReader;
    statbuf: CoreOS.struct_stat;
  BEGIN
    IF CoreOS.fstat (fd, statbuf) = -1 THEN
      RAISE Rd.Failure (NIL); END;
    CASE statbuf.st_mode DIV CoreOS.SIFMT OF
    | CoreOS.SIFCHR => 
      IF statbuf.st_rdev = 770 THEN
        rd := NewNullReader (fd);
      ELSE
        rd := NewTerminalReader (fd); END;
    | CoreOS.SIFPIPE, CoreOS.SIFPORT =>
      rd := NewTerminalReader (fd);
    | CoreOS.SIFREG =>
      rd := NewDiskReader (fd, statbuf.st_size);
    ELSE
      RAISE Rd.Failure (NIL); END;
    RETURN (rd);
  END CreateFileReader;

PROCEDURE FileReaderClose (rd: FileReader) RAISES {Rd.Failure} =
  BEGIN
    rd.buff := NIL;
    rd.closed := TRUE;
    IF rd.targetFD >= 3 AND CoreOS.close (rd.targetFD) = -1 THEN
      RAISE Wr.Failure (NIL); END;
  END FileReaderClose;

(* ------------------------- FILESTREAM ---------------------------------*)

PROCEDURE OpenWriteOrAppend (nm: Text.T; flags: INTEGER): Wr.T =
  VAR fd: INTEGER;
  BEGIN
    fd := CoreOS.open (M3toC.TtoS (nm), flags, CoreOS.Mrwrr);
    IF fd < 0 THEN
      RAISE Wr.Failure (NIL); END;
    RETURN (CreateFileWriter (fd));
  END OpenWriteOrAppend;

PROCEDURE OpenWrite (nm: Text.T): Wr.T =
  BEGIN
    RETURN OpenWriteOrAppend (nm, CoreOS.O_WRONLY + 
			          CoreOS.O_CREAT + CoreOS.O_TRUNC);
  END OpenWrite;

PROCEDURE OpenAppend (nm: Text.T): Wr.T =
  BEGIN
    RETURN OpenWriteOrAppend (nm, CoreOS.O_WRONLY + 
				  CoreOS.O_CREAT + CoreOS.O_APPEND);
  END OpenAppend;

PROCEDURE OpenRead (nm: Text.T): Rd.T =
  VAR fd: INTEGER;
  BEGIN
    fd := CoreOS.open (M3toC.TtoS (nm), CoreOS.O_RDONLY, CoreOS.Mrwrr);
    IF fd < 0 THEN
      RAISE Rd.Failure (NIL); END;
    RETURN (CreateFileReader (fd));
  END OpenRead;


(* --------------------------- STDIO -----------------------------------*)

PROCEDURE Close () = 
  BEGIN
    Rd.Close (stdin);
    Wr.Close (stdout);
    Wr.Close (stderr);
 END Close;

BEGIN
  stdin  := CreateFileReader (0);
  stdout := CreateFileWriter (1);
  stderr := CreateFileWriter (2);
  bufferedStdout := CreateFileWriter (1, TRUE);
  bufferedStderr := CreateFileWriter (2, TRUE);
END UFileRdWr.