MODULE M3Buf;

IMPORT Wr, Convert, Text, Text8, Thread, Target, TInt, M3FP;

CONST
  ChunkSize = 16_FF00; (* approx. 64K *)
  (* leave some slop for the 'next' pointer & the allocator overhead *)

TYPE
  Chunk = REF RECORD
            next : Chunk := NIL;
            buf  : ARRAY [0..ChunkSize-1] OF CHAR;
          END;

REVEAL
  T = BRANDED "MBuf.T" REF RECORD
        nFull : INTEGER;
        next  : INTEGER;
        head  : Chunk;
        tail  : Chunk;
        drain : Wr.T;
      END;

PROCEDURE New (): T =
  VAR t := NEW (T);
  BEGIN
    t.nFull := 0;
    t.next  := 0;
    t.head  := NEW (Chunk);
    t.tail  := t.head;
    t.drain := NIL;
    RETURN t;
  END New;

PROCEDURE PutChar (t: T;  ch: CHAR) =
  BEGIN
    IF (t.next >= ChunkSize) THEN Expand (t) END;
    t.tail.buf[t.next] := ch;
    INC (t.next);
  END PutChar;

PROCEDURE PutSub (t: T;  READONLY x: ARRAY OF CHAR) =
  VAR
    next := 0;
    len  := NUMBER (x);
    n : INTEGER;
  BEGIN
    IF (len < ChunkSize - t.next) THEN
      SUBARRAY (t.tail.buf, t.next, len) := x;
      INC (t.next, len);
    ELSE
      WHILE (len > 0) DO
        n := MIN (len, ChunkSize - t.next);
        SUBARRAY (t.tail.buf, t.next, n) := SUBARRAY (x, next, n);
        DEC (len, n);
        INC (next, n);
        INC (t.next, n);
        IF (len > 0) THEN Expand (t) END;
      END;
    END;
  END PutSub;

PROCEDURE PutText (t: T;  txt: TEXT) =
  BEGIN
    PutSubText (t, txt, 0, LAST (CARDINAL));
  END PutText;

PROCEDURE PutSubText (t: T;  txt: TEXT;  start, len: CARDINAL) =
  VAR
    cnt := MIN (len, Text.Length (txt) - start);
    buf : ARRAY [0..255] OF CHAR;
  BEGIN
    WHILE (cnt > 0) DO
      Text.SetChars (buf, txt, start);
      PutSub (t, SUBARRAY (buf, 0, MIN (NUMBER (buf), cnt)));
      INC (start, NUMBER (buf));  DEC (cnt, NUMBER (buf));
    END;
  END PutSubText;

CONST digits = ARRAY [0..9] OF CHAR {'0','1','2','3','4','5','6','7','8','9'};

PROCEDURE PutInt  (t: T;  i: INTEGER) =
  <*FATAL Convert.Failed*>
  VAR len: INTEGER;  buf: ARRAY [0..BITSIZE(INTEGER) + 3] OF CHAR;
  BEGIN
    IF (i >= 0) THEN
      IF (i < 10) THEN
        PutChar (t, digits[i]);
        RETURN;
      ELSIF (i < 100) THEN
        PutChar (t, digits[i DIV 10]);
        PutChar (t, digits[i MOD 10]);
        RETURN;
      ELSIF (i < 1000) THEN
        PutChar (t, digits[i DIV 100]);
        PutChar (t, digits[(i DIV 10) MOD 10]);
        PutChar (t, digits[i MOD 10]);
        RETURN;
      END;
    END;
    len := Convert.FromInt (buf, i, 10);
    PutSub (t, SUBARRAY (buf, 0, len));
  END PutInt;

PROCEDURE PutIntt (t: T;  READONLY i: Target.Int) =
  VAR j: INTEGER;
      buf: ARRAY [0..BITSIZE (Target.Int)] OF CHAR;
  BEGIN
    IF TInt.ToInt (i, j) THEN
      PutInt (t, j);
    ELSE
      j := TInt.ToChars (i, buf);
      PutSub (t, SUBARRAY (buf, 0, j));
    END;
  END PutIntt;

PROCEDURE PutFloat (t: T;  READONLY f: Target.Float) =
  <*FATAL Convert.Failed*>
  VAR len: INTEGER;  buf: ARRAY [0..BITSIZE(EXTENDED) + 3] OF CHAR;
  BEGIN
    <*ASSERT f.exponent = 0*>
    len := Convert.FromExtended (buf, f.fraction, 13, Convert.Style.Sci);
    PutSub (t, SUBARRAY (buf, 0, len));
  END PutFloat;

PROCEDURE ToText (t: T): TEXT =
  VAR txt: TEXT;
  BEGIN
    IF (t.nFull = 0)
      THEN txt := Text.FromChars (SUBARRAY (t.head.buf, 0, t.next));
      ELSE txt := MessyToText (t);
    END;
    Reset (t);
    RETURN txt;
  END ToText;

PROCEDURE MessyToText (t: T): TEXT =
  VAR
    len := t.nFull * ChunkSize + t.next;
    txt := Text8.Create (len);
    c := t.head;
    n := 0;
  BEGIN
    FOR i := 1 TO t.nFull DO
      SUBARRAY (txt.contents^, n, ChunkSize) := c.buf;
      c := c.next;
      INC (n, ChunkSize);
    END;
    IF (t.next # 0) THEN
      SUBARRAY (txt.contents^, n, t.next) := SUBARRAY (c.buf, 0, t.next);
    END;
    RETURN txt;
  END MessyToText;

PROCEDURE ToFP (t: T): M3FP.T =
  VAR fp := M3FP.OfEmpty;
  VAR c := t.head;
  BEGIN
    FOR i := 1 TO t.nFull DO
      fp := M3FP.FromChars (c.buf, fp);
      c := c.next;
    END;
    IF (t.next # 0) THEN
      fp := M3FP.FromChars (SUBARRAY (c.buf, 0, t.next), fp);
    END;
    Reset (t);
    RETURN fp;
  END ToFP;

PROCEDURE Flush (t: T;  wr: Wr.T) =
  <*FATAL Wr.Failure, Thread.Alerted*>
  VAR c := t.head;
  BEGIN
    FOR i := 1 TO t.nFull DO  Wr.PutString (wr, c.buf);  c := c.next;  END;
    IF (t.next # 0) THEN Wr.PutString (wr, SUBARRAY (c.buf, 0, t.next)) END;
    Reset (t);
  END Flush;

PROCEDURE AttachDrain (t: T;  wr: Wr.T) =
  BEGIN
    t.drain := wr;
  END AttachDrain;

PROCEDURE Expand (t: T) =
  BEGIN
    <* ASSERT t.next = ChunkSize *>
    IF (t.drain # NIL) THEN
      t.next := 0;
      INC (t.nFull);
      Flush(t, t.drain);
    ELSE
      IF (t.tail.next = NIL) THEN t.tail.next := NEW (Chunk); END;
      t.tail := t.tail.next;
      t.next := 0;
      INC (t.nFull);
    END;
  END Expand;

PROCEDURE Reset (t: T) =
  BEGIN
    (* NOTE: we're not freeing the allocated chunks... *)
    t.tail  := t.head;
    t.nFull := 0;
    t.next  := 0;
  END Reset;

BEGIN
END M3Buf.