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

(* Last modified on Mon Mar 09 13:46:38 PST 1992 by muller     *)
(*      modified on Sat Feb 29 08:20:22 PST 1992 by kalsow     *)



(* This implementation of the Wr, WrClass and UnsafeWr interfaces is an
   alternative to the WrRep module.
 
   The first difference is that it works with garbage collectors that move
   referents.  This is achieved by having indices into buff instead of 
   UNTRACED REFs.

   The second difference concerns unbuffered writers.  In WrRep, the 
   buffer of an unbuffered writer is made of length one, in the MakeClean 
   procedure.  This is a problem, because characters are delivered one by one;
   if the target if a file, it means one system call per character ! In this
   version, the buffer is only flushed after put every operation provided by the
   Wr and UnsafeWr interfaces. *)

UNSAFE MODULE WrMove EXPORTS Wr, WrClass, UnsafeWr;
IMPORT Thread, Convert, Text, TextF;
FROM Thread IMPORT Alerted;

REVEAL
  Private = Thread.Mutex BRANDED "WrMove.Private" OBJECT END;

EXCEPTION Error;
<*FATAL Error*>

PROCEDURE Lock(wr: T) RAISES {} =
  BEGIN 
    Thread.Acquire(wr);
  END Lock;

PROCEDURE Unlock(wr: T) =
  BEGIN
    Thread.Release(wr)
  END Unlock;


PROCEDURE PutChar(wr: T; ch: CHAR) RAISES {Failure, Alerted} =
  BEGIN
    LOCK wr DO
      FastPutChar (wr, ch); END;
  END PutChar;

PROCEDURE FastPutChar (wr: T; ch: CHAR) RAISES {Failure, Alerted} =
  BEGIN
    LOOP
      IF wr.cur < wr.hi THEN
        wr.buff [wr.st + wr.cur - wr.lo] := ch;
        INC (wr.cur);
        IF NOT wr.buffered THEN
          wr.flush (); END;
        RETURN;

      ELSIF wr.closed THEN
        RAISE Error(*Code.Closed*);

      ELSE
        wr.seek (wr.cur); END; END;
  END FastPutChar;



PROCEDURE PutText (wr: T; t: TEXT) RAISES {Failure, Alerted} =
  BEGIN
    PutString (wr, SUBARRAY (t^, 0, Text.Length (t)));
  END PutText;

PROCEDURE FastPutText (wr:T; t: TEXT) RAISES {Failure, Alerted} =
  BEGIN
    FastPutString (wr, SUBARRAY (t^, 0, Text.Length (t)));
  END FastPutText;



PROCEDURE PutString (wr: T; READONLY a: ARRAY OF CHAR)
  RAISES {Failure, Alerted} =
  BEGIN
    LOCK wr DO
      FastPutString (wr, a); END;
  END PutString;

PROCEDURE FastPutString (wr: T; READONLY a: ARRAY OF CHAR)
  RAISES {Failure, Alerted} =
  VAR 
    start: CARDINAL := 0;
    l := NUMBER (a);
  BEGIN
    WHILE (l > 0) DO
      VAR n := MIN (wr.hi - wr.cur, l); BEGIN
        IF n > 0 THEN
          SUBARRAY (wr.buff^, wr.st + wr.cur - wr.lo, n)
            := SUBARRAY (a, start, n);
          INC (start, n);
          DEC (l, n);
          INC (wr.cur, n); END; END;
      IF l > 0 THEN
        wr.seek (wr.cur); END; END;
    IF NOT wr.buffered THEN
      wr.flush (); END;
  END FastPutString;



PROCEDURE FastPutInt (wr: T; n: INTEGER; base: Convert.Base := 10)
  RAISES {Failure, Alerted} =
  <*FATAL Convert.Failed*>
  VAR
    chars: ARRAY [0..BITSIZE(INTEGER) + 3] OF CHAR;
    size:  INTEGER;
  BEGIN
    size := Convert.FromInt (chars, n, base);
    FastPutString (wr, SUBARRAY (chars, 0, size));  
  END FastPutInt;

PROCEDURE FastPutReal (wr: T; r: REAL; p: CARDINAL := 6;
                       s := Convert.Style.Mix)
  RAISES {Failure, Alerted} =
  <*FATAL Convert.Failed*>
  VAR
    chars: ARRAY [0..100] OF CHAR;
    size:  INTEGER;
  BEGIN
    size := Convert.FromFloat (chars, r, p, s);
    FastPutString (wr, SUBARRAY (chars, 0, size));
  END FastPutReal;

PROCEDURE FastPutLongReal (wr: T; r: LONGREAL; p: CARDINAL := 6;
                           s := Convert.Style.Mix)
  RAISES {Failure, Alerted} =
  <*FATAL Convert.Failed*>
  VAR
    chars: ARRAY [0..100] OF CHAR;
    size:  INTEGER;
  BEGIN
    size := Convert.FromLongFloat (chars, r, p, s);
    FastPutString (wr, SUBARRAY (chars, 0, size));
  END FastPutLongReal;



   
PROCEDURE Seek(wr: T; n: CARDINAL) RAISES {Failure, Alerted} =
  BEGIN
    LOCK wr DO
      IF wr.closed THEN
        RAISE Error(*Code.Closed*);
      ELSIF NOT wr.seekable THEN
        RAISE Error(*Code.Unseekable*);
        (**RAISE Failure ("Can\'t seek an unseekable writer");**) END;
      wr.seek(n); END;
  END Seek;

PROCEDURE Flush (wr: T) RAISES {Failure, Alerted} =
  BEGIN
    LOCK wr DO
      IF wr.closed THEN
        RAISE Error(*Code.Closed*); END;
      wr.flush(); END;
  END Flush;



PROCEDURE Index(wr: T): CARDINAL RAISES {} =
  BEGIN 
    LOCK wr DO 
      IF wr.closed THEN
        RAISE Error(*Code.Closed*) END;
      RETURN wr.cur; END;
  END Index;

PROCEDURE Length (wr: T): CARDINAL RAISES {Failure, Alerted} =
  BEGIN
    LOCK wr DO
      IF wr.closed THEN
        RAISE Error(*Code.Closed*); END;
      RETURN wr.length (); END;
  END Length;

PROCEDURE Close (wr: T) RAISES {Failure, Alerted} =
  BEGIN
    LOCK wr DO FastClose (wr); END;
  END Close;

PROCEDURE FastClose (wr: T) RAISES {Failure, Alerted} =
  BEGIN
    IF NOT wr.closed THEN
      TRY 
        wr.flush(); 
        wr.close();
      FINALLY 
        wr.closed := TRUE;
        wr.cur := wr.hi; END; END;
  END FastClose;

PROCEDURE Seekable (wr: T): BOOLEAN RAISES {} =
  BEGIN
    LOCK wr DO
      RETURN wr.seekable; END;
  END Seekable;

PROCEDURE Closed(wr: T): BOOLEAN RAISES {} =
  BEGIN
    LOCK wr DO
      RETURN wr.closed; END;
  END Closed;

PROCEDURE Buffered(wr: T): BOOLEAN RAISES {} =
  BEGIN
    LOCK wr DO
      RETURN wr.buffered; END;
  END Buffered;

PROCEDURE CloseDefault(wr: T) RAISES {} =
  BEGIN 
    wr.buff := NIL;
  END CloseDefault;

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

PROCEDURE LengthDefault(wr: T): CARDINAL RAISES {} =
  BEGIN
    RETURN wr.cur;
  END LengthDefault;

BEGIN
END WrMove.