(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* Last modified on Tue Jun 16 10:16:28 PDT 1992 by muller                   *)
(*      modified on Tue Nov 26 18:19:41 PST 1991 by meehan                   *)

MODULE SeekableRd;

IMPORT Rd, RdClass, Thread, FilterRd;

REVEAL
  T = Public BRANDED "SeekableRd.T" OBJECT
        rd        : Rd.T;
        closeChild: BOOLEAN
      OVERRIDES
        init   := Init;
        length := Length;
        seek   := Seek;
        close  := Close;
      END;

PROCEDURE EnsureSeekable (rd: Rd.T; closeChild := FALSE): Rd.T
  RAISES {Rd.EndOfFile, Rd.Failure, Thread.Alerted} =
  BEGIN
    IF Rd.Seekable (rd) THEN
      RETURN NEW (FilterRd.T).init (rd, closeChild)
    ELSE
      RETURN NEW (T).init (rd, closeChild)
    END
  END EnsureSeekable;
  
PROCEDURE Init (z: T; rd: Rd.T; closeChild := FALSE; bufferSizeFactor := 4):
  T RAISES {Rd.EndOfFile, Rd.Failure, Thread.Alerted} =
  BEGIN
    RdClass.Lock (rd);          (* Try to make it ready, so we can get the
                                   size of rd.buff. *)
    TRY
      IF rd.seek (FALSE) = RdClass.SeekResult.Eof THEN
        RAISE Rd.EndOfFile
      ELSE
        WITH
          newChars = rd.hi - rd.lo,
          buffsize = bufferSizeFactor * NUMBER (rd.buff^) DO
          z.rd := rd;
          z.closeChild := closeChild;
          z.buff := NEW (REF ARRAY OF CHAR, buffsize);
          z.st := 0;
          z.lo := rd.lo;
          z.cur := rd.cur;
          z.hi := rd.hi;
          z.closed := FALSE;
          z.intermittent := FALSE;
          z.seekable := TRUE;
          SUBARRAY (z.buff^, 0, newChars) :=
            SUBARRAY (rd.buff^, rd.st, newChars);
          RETURN z
        END
      END
    FINALLY
      RdClass.Unlock (rd)
    END
  END Init;

PROCEDURE Ready (rd: Rd.T): BOOLEAN =
  BEGIN
    RETURN NOT rd.closed AND rd.buff # NIL AND rd.lo <= rd.cur
             AND rd.cur < rd.hi
  END Ready;
  
PROCEDURE Seek (z: T; dontBlock: BOOLEAN): RdClass.SeekResult
  RAISES {Rd.Failure, Thread.Alerted} =
  BEGIN
    IF Ready (z) THEN
      RETURN RdClass.SeekResult.Ready
    ELSIF z.cur < z.lo THEN
      RAISE Rd.Failure ("Can't seek that far back")
    END;
    RdClass.Lock (z.rd);
    TRY
      z.rd.cur := z.cur;
      WITH a = z.rd.seek (dontBlock) DO
        IF a # RdClass.SeekResult.Ready THEN RETURN a END
      END;
      (* Is there room at the end of our buffer? *)
      WITH
        newChars = z.rd.hi - z.rd.lo, (* in z.rd.buff *)
        oldChars = z.hi - z.lo, (* already in z.buff *)
        overflow = oldChars + newChars - NUMBER (z.buff^), (* too many? *)
        keep = oldChars - overflow DO (* how many can stay? *)
        IF overflow <= 0 THEN
          SUBARRAY (z.buff^, oldChars, newChars) :=
            SUBARRAY (z.rd.buff^, z.rd.st, newChars);
        ELSE
          (* Left-shift the bytes we can keep. *)
          SUBARRAY (z.buff^, 0, keep) :=
            SUBARRAY (z.buff^, overflow, keep);
          (* Copy the new bytes. *)
          SUBARRAY (z.buff^, keep, newChars) :=
            SUBARRAY (z.rd.buff^, z.rd.st, newChars);
          (* Increase our 'lo' index. *)
          z.lo := z.lo + overflow
        END
      END;
      z.hi := z.rd.hi;          (* Maintain the invariant. *)
      RETURN RdClass.SeekResult.Ready
    FINALLY
      RdClass.Unlock (z.rd)
    END
  END Seek;

PROCEDURE Length (z: T): CARDINAL RAISES {Rd.Failure, Thread.Alerted} =
  BEGIN
    RETURN z.hi
  END Length;

PROCEDURE Close (z: T) RAISES {Rd.Failure, Thread.Alerted} =
  BEGIN
    z.closed := TRUE;
    z.buff := NIL;
    IF z.closeChild THEN Rd.Close (z.rd) END
  END Close;

BEGIN
END SeekableRd.