Last modified on Thu May 20 15:22:42 PDT 1993 by swart modified on Mon Mar 23 08:13:46 PST 1992 by kalsow modified on Thu Jan 25 10:33:49 1990 by muller

UNSAFE MODULE EventWr EXPORTS EventWr;

IMPORT WrClass, EventWrF;

REVEAL
  T = EventWrF.T BRANDED "EventWr.T" OBJECT
      OVERRIDES
        seek   := Seek;
        close  := Close;
        length := Length;
        init := Init;
        flush := Flush;
      END;

TYPE
  Buffer     = EventWrF.Buffer;
  BufferList = EventWrF.BufferList;

CONST
  BufferSize = EventWrF.BufferSize;

PROCEDURE Init (wr: T): T =
  BEGIN
    WrClass.Lock(wr);
    TRY
      (* May already be allocated, if we are reusing wr. *)
      IF wr.buffers = NIL THEN
        wr.buffers := NEW(BufferList, 32);
        FOR i := FIRST (wr.buffers^) TO LAST (wr.buffers^) DO
          wr.buffers[i] := NIL;
        END;
      END;
      wr.st := 0;
      wr.cur := 0;
      wr.max_len := 0;
      wr.closed := FALSE;
      wr.seekable := TRUE;
      wr.buffered := TRUE;
      GotoBuffer(wr, wr.cur);
    FINALLY
      WrClass.Unlock(wr);
    END;
    RETURN wr;
  END Init;

PROCEDURE New(): T = BEGIN RETURN NEW(T).init(); END New;

PROCEDURE Length (wr: T): CARDINAL RAISES {} =
  BEGIN
    wr.max_len := MAX (wr.max_len, wr.cur);
    RETURN wr.max_len;
  END Length;

PROCEDURE Seek(wr: T; n: CARDINAL) RAISES {} =
  BEGIN
    (* capture the current length of the writer *)
    wr.max_len := MAX (wr.max_len, wr.cur);

    (* make sure we don't seek beyond the end of the writer *)
    n := MIN (n, wr.max_len);

    IF (n < wr.lo) OR (wr.hi <= n) THEN GotoBuffer (wr, n) END;
    wr.cur := n;
  END Seek;

PROCEDURE Flush(wr: T) =
  BEGIN
    Seek(wr, wr.cur);
  END Flush;

PROCEDURE GotoBuffer (wr: T;  n: INTEGER) =
  VAR buf := n DIV BufferSize;
  BEGIN
    WHILE (buf > LAST (wr.buffers^)) DO ExpandBufferPool (wr) END;
    WHILE (wr.n_buffers <= buf) DO
      (* May already be allocated, if we are reusing wr. *)
      IF wr.buffers [wr.n_buffers] = NIL THEN
        wr.buffers [wr.n_buffers] := NEW (Buffer, BufferSize);
      END;
      INC (wr.n_buffers);
    END;
    wr.cur_buf := buf;
    wr.buff    := wr.buffers [buf];
    wr.lo      := buf * BufferSize;
    wr.hi      := wr.lo + BufferSize;
  END GotoBuffer;

PROCEDURE ExpandBufferPool (wr: T) =
  VAR new := NEW (BufferList, 2 * NUMBER (wr.buffers^));
  BEGIN
    SUBARRAY (new^, 0, wr.n_buffers) := wr.buffers^;
    FOR i := LAST(wr.buffers^)+1 TO LAST (new^) DO
      new[i] := NIL;
    END;
    wr.buffers := new;
  END ExpandBufferPool;

PROCEDURE Close(wr: T) RAISES {} =
  BEGIN
    wr.buff      := NIL;
    wr.cur_buf   := 0;
    wr.n_buffers := 0;
  END Close;

PROCEDURE ToChars(wr: T): REF ARRAY OF CHAR =
  VAR result: REF ARRAY OF CHAR;  len, start, n_full: INTEGER;
  BEGIN
    WrClass.Lock(wr);
    TRY
      (* capture the current length of the writer *)
      len := MAX (wr.max_len, wr.cur);

      (* allocate the result and count the buffersp *)
      result := NEW (REF ARRAY OF CHAR, len);
      n_full := len DIV BufferSize;

      (* copy the full buffers *)
      start  := 0; (* current character index *)
      FOR i := 0 TO n_full - 1 DO
        SUBARRAY (result^, start, BufferSize) := wr.buffers[i]^;
        INC (start, BufferSize);
      END;

      (* copy the remaining partial buffer *)
      len := len - start;
      IF (len > 0) THEN
        SUBARRAY (result^, start, len)
            := SUBARRAY (wr.buffers[n_full]^, 0, len);
      END;

      (* reset the length, pointers and buffers *)
      wr.max_len := 0;
      wr.cur := 0;
      GotoBuffer (wr, 0);
    FINALLY
      WrClass.Unlock(wr)
    END;
    RETURN result;
  END ToChars;

BEGIN
END EventWr.