UNSAFE MODULE FastIO EXPORTS FastIO, BinaryIO;

(***************************************************************************)
(*                      Copyright (C) Olivetti 1989                        *)
(*                          All Rights reserved                            *)
(*                                                                         *)
(* Use and copy of this software and preparation of derivative works based *)
(* upon this software are permitted to any person, provided this same      *)
(* copyright notice and the following Olivetti warranty disclaimer are     *) 
(* included in any copy of the software or any modification thereof or     *)
(* derivative work therefrom made by any person.                           *)
(*                                                                         *)
(* This software is made available AS IS and Olivetti disclaims all        *)
(* warranties with respect to this software, whether expressed or implied  *)
(* under any law, including all implied warranties of merchantibility and  *)
(* fitness for any purpose. In no event shall Olivetti be liable for any   *)
(* damages whatsoever resulting from loss of use, data or profits or       *)
(* otherwise arising out of or in connection with the use or performance   *)
(* of this software.                                                       *)
(***************************************************************************)

IMPORT Text, IO, IOBuffer_priv, BulkIO;
IMPORT Cstring;

(* Uses the procedures in 'IOBuffer_priv' to provide fast, unsafe serial put
and get operations on streams.

  Every successful operation (except Close) leaves the underlying stream
disabled. Any attempts to use the underlying stream while it is disabled will
cause 'IO.Error' to be raised.

  Only stream operations raise 'Error'. Care is taken to disable the
'FastIO.Stream' before calling a stream operation. Hence if an error occurs
during the stream operation the fast stream is left disabled. Any attempt to
use it will cause another error.

  An 'EndOfStream' is raised with a valid 'FastIO.Stream'. It can be converted
into a "normal" 'IO.EndOfStream', if desired, by calling 'Close' to detach the
'FastGet.Stream' e.g
  EXCEPT
  | FastGet.EndOfStream(t) => RAISE IO.EndOfStream(FastGet.Close(t));
  END;
*)


REVEAL
  Stream = BRANDED OBJECT
    slow: IO.Stream := NIL;
    start, current, endPut, endGet, unget: UNTRACED REF CHAR := NIL;
  END;
(* 'slow' is our reference to the underlying stream. It is readonly to the
outside world (it is available via the 'SlowStream' call). Because 'IO' never
sets the stream buffer to NIL and only 'IO' has write access to the stream
buffer field of a stream the stream buffer will not be collected as long as
'slow' refers to the stream.

'start' points to the first character in the stream buffer or is NIL

'current' points to the current position in the buffer or is NIL

'endGet' is the limit for getting characters from the buffer

'endPut' is the limit for putting characters to the buffer

'unget' is used to determine if a call of 'Unget' is legal.

*)

EXCEPTION
  Fatal;


PROCEDURE Disable(s: Stream): UNTRACED REF CHAR RAISES {}=
(* This routine disables 's' and enables the underlying 'IO.Stream'. The calls
which enable the underlying stream may raise an error so we ensure that 's' is
disabled before we call them. *)
  VAR
    start := s.start;
  BEGIN
    (* If stream disabled already somebody is trying to do something naughty *)
    IF start = NIL THEN RAISE Fatal <* CRASH *> END;

    (* Disable stream; we also set 'unget' to be 'current' so that 'Unget' is
     disabled *)
    s.start := NIL;
    s.unget := s.current;

    (* Now check if any characters have been put into or read from the buffer,
     thus altering the buffer position. If they have one (and only one) of the
     pointers 'endPut' or 'endGet' will be greater than the start of the
     buffer. *)
    IF s.endPut > start THEN
      (* Reset 'endPut'; enable the underlying stream, notifying it of the
       change in buffer position *)
      s.endPut := start;
      IOBuffer_priv.EnableAfterPut(
          s.slow, (s.current - start) DIV ADRSIZE(CHAR));
    ELSIF s.endGet > start THEN
      (* Reset 'endGet'; enable the underlying stream, notifying it of the
       change in buffer position *)
      s.endGet := start;
      IOBuffer_priv.EnableAfterGet(
          s.slow, (s.current - start) DIV ADRSIZE(CHAR));
    ELSE
      (* No change in buffer position; just enable the underlying stream *)
      IOBuffer_priv.Enable(s.slow);
    END;

    (* At this point 's.slow' is enabled and valid (if it was not an error
     would have been raised). 's' is disabled - 's.endPut <= s.current' and
     's.endGet <= s.current' so the fast put and get operations are disabled.
     's.unget = s.current' so ungets are disabled. 's.start' is NIL *)
    RETURN start;
  END Disable;


<*INLINE*> PROCEDURE Enable(
    s: Stream;
    start: UNTRACED REF CHAR)
    RAISES {IO.Error}=
(* Disables the underlying 'IO.Stream' and enables 's', setting 's.start' to
be 'start'. This routine is only called when 's' is disabled (i.e. after a call
to 'Disable' or just after 's' is created) *)
  BEGIN
    IOBuffer_priv.Disable(s.slow);
    s.start := start;
  END Enable;


PROCEDURE New(s: IO.Stream): Stream RAISES {IO.Error}=
  CONST
    SlowProperties = IO.PropertySet{
        IO.Property.Unbuffered, IO.Property.LineBuffered};
  VAR
    start := ADR(IOBuffer_priv.StreamBuffer(s)[0]);
    new := NEW(Stream,
        slow := s,
        current := start,
        endPut := start,
        endGet := start,
        unget := start);
  BEGIN
    (* Unbuffered and line buffered streams are treated specially; for them
     either 's.start = NIL' (disabled) or 's.endPut < s.start <= s.endPut'
     Hence fast put operations are always disabled *)
    IF IO.Properties(s) * SlowProperties # IO.NoProperties THEN
      DEC(new.endPut);
    END;
    (* 'new' is initialized to be disabled. We now enable it *)
    Enable(new, start);
    RETURN new;
  END New;


<*INLINE*> PROCEDURE SlowStream(s: Stream): IO.Stream RAISES {}=
  BEGIN
    RETURN s.slow;
  END SlowStream;


<*INLINE*> PROCEDURE SetBounds(
    s: Stream;
    start: UNTRACED REF CHAR;
    bounds: IOBuffer_priv.Bounds)
    : UNTRACED REF CHAR
    RAISES {}=
  BEGIN
    s.current := start + bounds.low * ADRSIZE(CHAR);
    RETURN start + bounds.high * ADRSIZE(CHAR);
  END SetBounds;


<*INLINE*> PROCEDURE EnableForPutting(
    s: Stream;
    start: UNTRACED REF CHAR;
    makeSpace: BOOLEAN)
    RAISES {IO.Error}=
(* Like 'Enable' but when it disables the underlying stream it enquires if
there is buffer space available for putting. If 'makeSpace' is TRUE the
underlying stream will actively try to make space for putting, flushing if
necessary. Note that such a flush might cause a stream error. *)
  BEGIN
    s.endPut := SetBounds(
        s, start, IOBuffer_priv.DisableForPutting(s.slow, makeSpace));
    s.start := start;
  END EnableForPutting;


PROCEDURE SlowPut(s: Stream; ch: CHAR) RAISES {IO.Error}=
(* Called if there appears to be no space for putting in the buffer *)
  BEGIN
    IF s.endPut < s.start THEN
      (* This is an unbuffered or line buffered stream; we let 'IO' do the
       work *)
      IF s.endGet > s.start THEN
        (* We were getting; we must use 'Disable', which will update the
         buffer position if necessary *)
        WITH start = Disable(s) DO
          IO.Put(s.slow, ch);
          Enable(s, start);
        END;
      ELSE
        (* No need to update the buffer position, we use a special speed up
         procedure, which disables us, does a put to the slow stream and then
         enables us again *)
        IOBuffer_priv.SinglePut(s.slow, ch);
      END;
    ELSE
      (* The normal case; we diable 's' and then enable for putting. Note that
       the 'makeSpace' argument to 'EnableForPutting' is TRUE so, barring an
       exception, we are guaranteed to get some space for putting *)
      EnableForPutting(s, Disable(s), TRUE);
      s.current^ := ch;
      INC(s.current, ADRSIZE(CHAR));
    END;
  END SlowPut;


<*INLINE*> PROCEDURE Put(s: Stream; ch: CHAR) RAISES {IO.Error}=
(* If we are out of space call 'SlowPut'; otherwise just stuff 'ch' into the
buffer *)
  BEGIN
    WITH current = s.current DO
      IF current >= s.endPut THEN
        SlowPut(s, ch);
      ELSE
        current^ := ch;
        INC(current, ADRSIZE(CHAR));
      END; (* if *)
    END;
  END Put;


PROCEDURE PutN(s: Stream; a: ADDRESS; bytes: CARDINAL) RAISES {IO.Error}=
(* Puts what it can straight to the buffer. Then calls 'BulkIO' to do any
remaining work *)
  BEGIN
    (* Handle the null case straight away *)
    IF bytes = 0 THEN RETURN END;

    (* Put all that we can straight to the buffer *)
    WITH current = s.current DO
      VAR
        copy := MIN((s.endPut - current) DIV ADRSIZE(CHAR), bytes);
      BEGIN
        IF copy > 0 THEN
          EVAL Cstring.memcpy(current, a, copy);
          INC(current, copy * ADRSIZE(CHAR));
          IF copy = bytes THEN RETURN END;
          INC(a, copy * ADRSIZE(CHAR));
          DEC(bytes, copy);
        END;
      END;
    END;

    (* If we get here we have filled the buffer and 'a' and 'bytes' have
     been adjusted to reflect the bytes already written. Now we delegate all
     the hard work to 'BulkIO.PutN' *)
    WITH start = Disable(s) DO
      BulkIO.PutN(s.slow, a, bytes);
      IF s.endPut < start THEN
        (* Unbuffered or line buffered stream; we don't call 'EnableForPutting'
         because we always want fast puts to be disabled on such a stream *)
        Enable(s, start);
      ELSE
        (* Normal stream; if there is any buffer space left we get it but we
         don't insist on making more *)
        EnableForPutting(s, start, FALSE)
      END;
    END;
  END PutN;


<*INLINE*> PROCEDURE EnableForGetting(
    s: Stream;
    start: UNTRACED REF CHAR;
    makeSpace: BOOLEAN)
    RAISES {IO.Error}=
(* Like 'Enable' but when it disables the underlying stream it enquires if
there are unread characters in the buffer. If 'makeSpace' is TRUE the
underlying stream will actively try to fill the buffer - note that such a fill
might cause a stream error. Even if 'makeSpace' is TRUE there may not be any
characters for reading in the buffer after a call of 'EnableForGetting'; if not
end of stream has been reached. *)
  BEGIN
    s.endGet := SetBounds(
        s, start, IOBuffer_priv.DisableForGetting(s.slow, makeSpace));
    (* Set 's.unget' to 's.current' to prevent a call of 'Unget' *)
    s.unget := s.current;
    s.start := start;
  END EnableForGetting;


PROCEDURE FillBuffer(s: Stream) RAISES {IO.Error, EndOfStream}=
(* Refills the buffer when it is exhausted. Guarantees to either fill the
buffer or raise an exception *)
  BEGIN
    (* Disable 's' and then enable it for getting *)
    EnableForGetting(s, Disable(s), TRUE);
    IF s.endGet = s.current THEN
      (* End of stream. We want an 'Unget' after a 'Get' which reached end of
       stream to do nothing. To mark this special case of a 'Get' which reached
       end of stream we set 's.unget' to be less than 's.start' *)
      s.unget := s.start - 1;
      RAISE EndOfStream(s);
    END;
  END FillBuffer;


<*INLINE*> PROCEDURE Get(s: Stream): CHAR RAISES {IO.Error, EndOfStream}=
(* If the buffer is exhausted then refill it. Get a char from the buffer *)
  VAR
    char: CHAR;
  BEGIN
    WITH current = s.current DO
      IF current >= s.endGet THEN FillBuffer(s) END;
      char := current^;
      INC(current, ADRSIZE(CHAR));
    END;
    RETURN char;
  END Get;


PROCEDURE BadUnget(s: Stream) RAISES {IO.Error}=
(* Called to force an 'IO.Error' with 'Fault.BadUnget' *)
  BEGIN
    EVAL Disable(s);
    (* Last operation was not an 'IO.Get' so the following will force a bad
     unget error! *)
    IO.Unget(s.slow);
  END BadUnget;


<*INLINE*> PROCEDURE Unget(s: Stream) RAISES {IO.Error}=
  BEGIN
    WITH current = s.current DO
      (* If 'current = s.unget' then either the buffer is disabled or the last
       operation was not a 'Get' *)
      IF current = s.unget THEN BadUnget(s) END;
      (* If 's.unget < s.start' the last operation was a 'Get' which hit end
       of stream. This check must be after the previous one because if 's' is
       disabled 's.start' would be NIL and the value of NIL might be very large
       on some systems *)
      IF s.unget < s.start THEN RETURN END;
      (* If 's.endGet = s.start' the last operation cannot have been a
       successful get because there are no readable characters in the buffer *)
      IF s.endGet = s.start THEN BadUnget(s) END;
      (* Now the checks have been done we just decrement 'current' and set
       's.unget' to prevent another 'Unget' *)
      DEC(current, ADRSIZE(CHAR));
      s.unget := current;
    END;
  END Unget;


PROCEDURE GetN(
    s: Stream;
    a: ADDRESS;
    bytes: CARDINAL;
    raiseEndOfStream := FALSE)
    : CARDINAL
    RAISES {IO.Error, EndOfStream}=
(* Gets what it can from the buffer; calls 'BulkIO' to do any remaining work *)
  BEGIN
    (* Handle the null case immediately *)
    IF bytes = 0 THEN RETURN 0 END;

    (* Get all that we can straight from the buffer *)
    WITH current = s.current DO
      VAR
        copy := MIN((s.endGet - current) DIV ADRSIZE(CHAR), bytes);
      BEGIN
        IF copy > 0 THEN
          EVAL Cstring.memcpy(a, current, copy);
          INC(current, copy * ADRSIZE(CHAR));
          IF copy = bytes THEN s.unget := current; RETURN bytes END;
          INC(a, copy * ADRSIZE(CHAR));
          DEC(bytes, copy);
        END;
      END;
    END;

    (* If we get here we have exhausted the buffer and 'a' and 'bytes' have
     been adjusted to reflect the bytes already read. Now we delegate all
     the hard work to 'BulkIO.GetN' *)
    VAR
      start := Disable(s);
      got := BulkIO.GetN(s.slow, a, bytes); <* UNEXPECTED IO.EndOfStream *>
    BEGIN
      (* If there are any unread characters available we want to know but we
       don't want to force a fill; we call 'EnableForGetting' with 'makeSpace'
       FALSE *)
      EnableForGetting(s, start, FALSE);
      (* If we didn't get all the characters we wanted we must have hit end of
       stream *)
      IF got < bytes AND raiseEndOfStream THEN
        RAISE EndOfStream(s);
      ELSE
        RETURN got;
      END;
    END;
  END GetN;


PROCEDURE Close(
    s: Stream;
    closeStream := FALSE)
    : IO.Stream
    RAISES {IO.Error}=
(* Disable the stream so it is no further use and set 's.slow' to NIL. Close
the underlying stream if 'closeStream' is TRUE *) 
  VAR
    save := s.slow;
  BEGIN
    EVAL Disable(s);
    s.slow := NIL;
    IF closeStream THEN IO.Close(save); RETURN NIL ELSE RETURN save END;
  END Close;


(* The following are fast binary output routines; all try to put directly to
the buffer if possible, and call 'PutN' to handle the difficult case where the
buffer is full *)

PROCEDURE PutBinInt(s: Stream; int: INTEGER) RAISES {IO.Error}=
  BEGIN
    WITH current = s.current DO
      IF current + ADRSIZE(INTEGER) <= s.endPut THEN
        LOOPHOLE(current, UNTRACED REF INTEGER)^ := int;
        INC(current, ADRSIZE(INTEGER));
      ELSE
        PutN(s, ADR(int), ADRSIZE(INTEGER));
      END;
    END;
  END PutBinInt;


<*INLINE*> PROCEDURE PutBinCard(s: Stream; card: CARDINAL) RAISES {IO.Error}=
  BEGIN
    PutBinInt(s, card);
  END PutBinCard;


PROCEDURE PutBinReal(s: Stream; real: REAL) RAISES {IO.Error}=
  BEGIN
    WITH current = s.current DO
      IF current + ADRSIZE(REAL) <= s.endPut THEN
        LOOPHOLE(current, UNTRACED REF REAL)^ := real;
        INC(current, ADRSIZE(REAL));
      ELSE
        PutN(s, ADR(real), ADRSIZE(REAL));
      END;
    END;
  END PutBinReal;


PROCEDURE PutBinLongReal(s: Stream; longReal: LONGREAL) RAISES {IO.Error}=
  BEGIN
    WITH current = s.current DO
      IF current + ADRSIZE(LONGREAL) <= s.endPut THEN
        LOOPHOLE(current, UNTRACED REF LONGREAL)^ := longReal;
        INC(current, ADRSIZE(LONGREAL));
      ELSE
        PutN(s, ADR(longReal), ADRSIZE(LONGREAL));
      END;
    END;
  END PutBinLongReal;


(* The following are fast binary input operations. They all try to get directly
from the buffer and call 'GetN' to handle the difficult case when the buffer is
exhausted. They all set 's.unget' after they have completed so an 'Unget' after
a 'GetBinWhatever' will fail. *)

PROCEDURE GetBinInt(s: Stream): INTEGER RAISES {IO.Error, EndOfStream}=
  VAR
    int: INTEGER;
  BEGIN
    WITH current = s.current DO
      IF current + ADRSIZE(INTEGER) <= s.endGet THEN
        int := LOOPHOLE(current, UNTRACED REF INTEGER)^;
        INC(current, ADRSIZE(INTEGER));
        s.unget := current;
      ELSE
        EVAL GetN(s, ADR(int), ADRSIZE(INTEGER), TRUE);
      END;
    END;
    RETURN int;
  END GetBinInt;


<*INLINE*> PROCEDURE GetBinCard(
    s: Stream)
    : CARDINAL
    RAISES {IO.Error, EndOfStream}=
  BEGIN
    RETURN GetBinInt(s);
  END GetBinCard;


PROCEDURE GetBinReal(s: Stream): REAL RAISES {IO.Error, EndOfStream}=
  VAR
    real: REAL;
  BEGIN
    WITH current = s.current DO
      IF current + ADRSIZE(REAL) <= s.endGet THEN
        real := LOOPHOLE(current, UNTRACED REF REAL)^;
        INC(current, ADRSIZE(REAL));
        s.unget := current;
      ELSE
        EVAL GetN(s, ADR(real), ADRSIZE(REAL), TRUE);
      END;
    END;
    RETURN real;
  END GetBinReal;


PROCEDURE GetBinLongReal(s: Stream): LONGREAL RAISES {IO.Error, EndOfStream}=
  VAR
    longReal: LONGREAL;
  BEGIN
    WITH current = s.current DO
      IF current + ADRSIZE(LONGREAL) <= s.endGet THEN
        longReal := LOOPHOLE(current, UNTRACED REF LONGREAL)^;
        INC(current, ADRSIZE(LONGREAL));
        s.unget := current;
      ELSE
        EVAL GetN(s, ADR(longReal), ADRSIZE(LONGREAL), TRUE);
      END;
    END;
    RETURN longReal;
  END GetBinLongReal;


(* Now various veneers on the standard IO procedures, to make them usable on
a 'FastGet.Stream' *)

PROCEDURE Flush(s: Stream) RAISES {IO.Error}=
  VAR
    start := Disable(s);
  BEGIN
    IO.Flush(s.slow);
    Enable(s, start);
  END Flush;

PROCEDURE GotEndOfStream(s: Stream): BOOLEAN RAISES {IO.Error}=
  BEGIN
    WITH start = Disable(s), eos = IO.GotEndOfStream(s.slow) DO
      Enable(s, start);
      RETURN eos;
    END;
  END GotEndOfStream;

PROCEDURE Length(s: Stream): CARDINAL RAISES {IO.Error}=
  BEGIN
    WITH start = Disable(s), length = IO.Length(s.slow) DO
      Enable(s, start);
      RETURN length;
    END;
  END Length;

PROCEDURE Truncate(s: Stream; length: CARDINAL) RAISES {IO.Error}=
  VAR
    start := Disable(s);
  BEGIN
    IO.Truncate(s.slow, length);
    Enable(s, start);
  END Truncate;

PROCEDURE Tell(s: Stream): CARDINAL RAISES {IO.Error}=
  BEGIN
    WITH start = Disable(s), pos = IO.Tell(s.slow) DO
      Enable(s, start);
      RETURN pos;
    END;
  END Tell;

PROCEDURE Seek(
    s: Stream;
    offset := 0;
    mode: IO.SeekMode := IO.SeekMode.Beginning)
    RAISES {IO.Error}=
  VAR
    start := Disable(s);
  BEGIN
    IO.Seek(s.slow, offset, mode);
    Enable(s, start);
  END Seek;

PROCEDURE Properties(s: Stream): IO.PropertySet RAISES {}=
  BEGIN
    RETURN IO.Properties(s.slow);
  END Properties;

PROCEDURE Name(s: Stream): Text.T RAISES {}=
  BEGIN
    RETURN IO.Name(s.slow);
  END Name;


BEGIN

END FastIO.