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

(* Last modified on Sat Jun 23 03:26:23 1990 by muller         *)
(*      modified on Wed Oct 18 16:14:05 1989 by kalsow         *)
(*      modified on Tue May  2 10:32:50 1989 by ellis          *)


MODULE Formatter;

IMPORT Text, Wr, Thread, Time, Word;

REVEAL
  T = BRANDED REF RECORD
        wr          : Wr.T;
        width       : CARDINAL;
        indent      : CARDINAL;

        chars       : ARRAY [0..255] OF CHAR;
        numChars    : CARDINAL;

        pStart      : CARDINAL;
        pSize       : CARDINAL;
        pNext       : CARDINAL;
        pEnd        : CARDINAL;

        cThread     : Thread.T;
        cStart      : CARDINAL;
        cSize       : CARDINAL;
        cEnd        : CARDINAL;

        lock        : Thread.Mutex;
        changed     : Thread.Condition;
        buffer      : Buffer;
        n           : CARDINAL;
        nMask       : INTEGER;
        size        : ARRAY Who OF CARDINAL;
        start       : ARRAY Who OF CARDINAL;
        waiters     : CARDINAL;
        waitTime    : ARRAY Who OF Time.T;
        flushed     : BOOLEAN;
        failure     : BOOLEAN;
        failureCode : REFANY;
      END;

TYPE
  Buffer = REF ARRAY OF REFANY;
  Who    = {Producer, Consumer};

  Closure = Thread.SizedClosure OBJECT t: T; METHODS END;

CONST ChunkSize = 128; (* Must be a power of 2 *)

TYPE
  Position = RECORD
               l: CARDINAL; (* current line of current object, 0-based *)
               c: CARDINAL; (* current column, 0-based *)
               b: CARDINAL; (* trailing blanks after .c *)
               i: CARDINAL; (* next item in buffer *)
             END;

TYPE
  Mode = {Thinking, Writing};

TYPE
  Char  = REF CHAR;
  Int   = REF INTEGER;
  Bool  = REF BOOLEAN;

VAR firstInt : Int;
VAR lastInt  : Int;
VAR ints     : ARRAY [-256..256] OF Int;
VAR chars    : ARRAY CHAR OF Char;
VAR bools    : ARRAY BOOLEAN OF Bool;

TYPE
  OpProc = PROCEDURE (t: T;  m: Mode;  VAR p: Position;  i, x: CARDINAL)
                        : BOOLEAN;

  Op = REF RECORD
         proc       : OpProc;
	 args       : CARDINAL;
	 precedence : INTEGER;
       END;

VAR
  GroupOp        : Op;
  BeginOp        : Op;
  AlignOp        : Op;
  CharOp         : Op;
  TextOp         : Op;
  NoAlignOp      : Op;
  BreakOp        : Op;
  PartialBreakOp : Op;
  NewLineOp      : Op;
  UnitedBreakOp  : Op;
  EndOp          : Op;
  FlushOp        : Op;


(*****************************************************************************

Producer-side operations

*****************************************************************************)

PROCEDURE New (wr: Wr.T;  width: CARDINAL := 75): T RAISES {} =
  VAR t :T := NEW (T);
  BEGIN
    t.wr       := wr;
    t.width    := width;
    t.indent   := 0;

    t.numChars := 0;

    t.pStart   := 0;
    t.pSize    := 0;
    t.pNext    := 0;
    t.pEnd     := 0;

    t.cStart   := 0;
    t.cSize    := 0;
    t.cEnd     := 0;

    t.lock := Thread.NewMutex ();
    t.changed := Thread.NewCondition ();

    t.buffer              := NEW (Buffer, 4 * ChunkSize);
    t.n                   := NUMBER (t.buffer^);
    t.nMask               := Word.Not (-t.n);
    t.start[Who.Producer] := 0;
    t.start[Who.Consumer] := 0;
    t.size[Who.Producer]  := NUMBER (t.buffer^);
    t.size[Who.Consumer]  := 0;
    t.flushed             := FALSE;
    t.failure             := FALSE;

    t.cThread := Thread.Fork (NEW (Closure, apply := PrintTop, 
				   t := t, stackSize := 100000));

    RETURN t;
  END New;

PROCEDURE UnderlyingWr (t: T): Wr.T RAISES {} =
  BEGIN
    RETURN t.wr;
  END UnderlyingWr;

PROCEDURE Flush (t: T) RAISES {Wr.Failure} =
  BEGIN
    IF t.numChars > 0 THEN AddChars (t) END;
    AddRef (t, FlushOp);
    WaitUntilEmpty (t, t.pNext);
    Wr.Flush (t.wr);
  END Flush;

PROCEDURE Close (t: T) RAISES {Wr.Failure} =
  BEGIN
    Flush (t);
    Thread.Alert (t.cThread);
    IF NIL = Thread.Join (t.cThread) THEN END;
  END Close;

PROCEDURE Group (t: T) RAISES {Wr.Failure} =
  BEGIN
    IF t.numChars > 0 THEN AddChars (t) END;
    AddRef (t, GroupOp);
  END Group;

PROCEDURE Begin (t: T;  offset := 0;  width: CARDINAL := LAST (CARDINAL))
  RAISES {Wr.Failure} =
  BEGIN
    IF t.numChars > 0 THEN AddChars (t) END;
    AddRef (t, BeginOp);
    AddRef (t, NewInt (offset));
    AddRef (t, NewInt (width));
  END Begin;

PROCEDURE End (t: T) RAISES {Wr.Failure} =
  BEGIN
    IF t.numChars > 0 THEN AddChars (t) END;
    AddRef (t, EndOp);
  END End;

PROCEDURE PutChar (t: T;  c: CHAR) RAISES {Wr.Failure} =
  BEGIN
    IF c = '\n' THEN
      NewLine (t, FIRST (INTEGER), FALSE);
    ELSIF c = ' ' THEN
      IF t.numChars > 0 THEN AddChars (t) END;
      AddRef (t, chars[c]);
    ELSE
      IF t.numChars >= NUMBER (t.chars) THEN AddChars (t) END;
      t.chars[t.numChars] := c;
      INC (t.numChars);
    END;
  END PutChar;

PROCEDURE PutText (t: T;  text: Text.T;  raw := FALSE) RAISES {Wr.Failure} =
  BEGIN
    IF raw THEN
      IF t.numChars > 0 THEN AddChars (t) END;
      AddRef (t, text);
    ELSE
      FOR i := 0 TO Text.Length (text) - 1 DO
        PutChar (t, Text.GetChar (text, i));
      END;
    END;
  END PutText;

PROCEDURE Break (t: T;  offset := 0;  optimal := TRUE;  freshLine := TRUE)
  RAISES {Wr.Failure} =
  BEGIN
    IF t.numChars > 0 THEN AddChars (t) END;
    AddRef (t, BreakOp);
    AddRef (t, NewInt (offset));
    AddRef (t, bools[optimal]);
    AddRef (t, bools[freshLine]);
  END Break;

PROCEDURE PartialBreak (t: T;  offset := 0;  freshLine := TRUE)
  RAISES {Wr.Failure} =
  BEGIN
    IF t.numChars > 0 THEN AddChars (t) END;
    AddRef (t, PartialBreakOp);
    AddRef (t, NewInt (offset));
    AddRef (t, bools[freshLine]);
  END PartialBreak;

PROCEDURE UnitedBreak (t: T;  offset := 0;  freshLine := TRUE)
  RAISES {Wr.Failure} =
  BEGIN
    IF t.numChars > 0 THEN AddChars (t) END;
    AddRef (t, UnitedBreakOp);
    AddRef (t, NewInt (offset));
    AddRef (t, bools[freshLine]);
  END UnitedBreak;

PROCEDURE NewLine (t: T;  offset := 0;  freshLine := TRUE)
  RAISES {Wr.Failure} =
  BEGIN
    IF t.numChars > 0 THEN AddChars (t) END;
    AddRef (t, NewLineOp);
    AddRef (t, NewInt (offset));
    AddRef (t, bools[freshLine]);
  END NewLine;

PROCEDURE Align (t: T;
                 columns      : CARDINAL;
                 tryOneLine   : BOOLEAN   := TRUE;
                 offset       : INTEGER   := 0;
                 alignPred    : AlignPred := NIL;
                 alignPredArg : REFANY    := NIL)  RAISES {Wr.Failure} =
  BEGIN
    IF t.numChars > 0 THEN AddChars (t) END;
    AddRef (t, AlignOp);
    AddRef (t, NewInt (columns));
    AddRef (t, bools[tryOneLine]);
    AddRef (t, NewInt (offset));
    AddRef (t, alignPred);
    AddRef (t, alignPredArg);
  END Align;

PROCEDURE NoAlign (t: T) RAISES {Wr.Failure} =
  BEGIN
    IF t.numChars > 0 THEN AddChars (t) END;
    AddRef (t, NoAlignOp);
  END NoAlign;

PROCEDURE AddRef (t: T;  ref: REFANY) RAISES {Wr.Failure} =
  BEGIN
    IF t.pNext = t.pEnd THEN
      t.pSize := Release (t, Who.Producer, t.pSize);
      IF t.pSize = 0 THEN
        t.pSize := Allocate (t, Who.Producer, ChunkSize, ChunkSize);
      END;
      t.pStart := t.pNext;
      t.pEnd := t.pStart + t.pSize;
    END;

    t.buffer[Word.And (t.pNext, t.nMask)] := ref;
    t.pNext := t.pNext + 1;

    IF (t.pNext = t.pEnd) OR (ref = FlushOp) THEN
      t.flushed := (ref = FlushOp);
      t.pSize   := Release (t, Who.Producer, t.pNext - t.pStart);
      t.pStart  := t.pNext;
      t.pEnd    := t.pStart + t.pSize;
    END;
  END AddRef;

PROCEDURE AddChars (t: T) RAISES {Wr.Failure} =
  BEGIN
    AddRef (t, Text.FromChars (SUBARRAY (t.chars, 0, t.numChars)));
    t.numChars := 0;
  END AddChars;


(*****************************************************************************

Buffering

*****************************************************************************)


PROCEDURE Release (t: T;  this: Who;  size: CARDINAL): CARDINAL
  RAISES {Wr.Failure} =
  VAR that: Who;  newSize: CARDINAL;
  BEGIN
    IF this = Who.Producer
      THEN that := Who.Consumer;
      ELSE that := Who.Producer;
    END;
    LOCK t.lock DO
      t.start[this] := t.start[this] + size;
      DEC (t.size[this], size);
      INC (t.size[that], size);
      newSize := t.size[this];
      CheckForFailure (t, this);
    END;
    Thread.Broadcast (t.changed);
    RETURN newSize;
  END Release;

PROCEDURE Allocate (t: T;
                    this    : Who;
		    minSize : CARDINAL;
		    maxSize : CARDINAL := LAST (INTEGER)) : CARDINAL
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR time: Time.T;
  BEGIN
    LOCK t.lock DO
      IF t.size[this] < minSize THEN
        INC (t.waiters);
        WHILE (t.size[this] < minSize)
          AND ((t.size[this] = 0) OR ((NOT t.flushed) AND (NOT t.failure))) DO
          IF t.waiters = 2 THEN Expand (t, this) END;
          time := Time.Now ();
          Thread.AlertWait (t.lock, t.changed);
          t.waitTime[this] := Time.Add (t.waitTime[this],
                                        Time.Subtract (Time.Now (), time));
        END;
        DEC (t.waiters);
      END;
      CheckForFailure (t, this);
      RETURN MIN (t.size[this], maxSize);
    END;
  END Allocate;

PROCEDURE Expand (t: T; this: Who) RAISES {} =
  VAR newBuffer: Buffer;  n2, from, to: CARDINAL;
  BEGIN
    n2 := 2 * t.n;
    newBuffer := NEW (Buffer, n2);
    from := t.start[Who.Consumer] MOD t.n;
    to := t.start[Who.Consumer] MOD n2;
    FOR i := 0 TO t.n - 1 DO
      newBuffer[to] := t.buffer[from];
      from := from + 1;  IF from = t.n THEN from := 0 END;
      to   := to   + 1;  IF to = n2    THEN to := 0   END;
    END;
    t.buffer := newBuffer;
    INC (t.size[Who.Producer], t.n);
    t.n := 2 * t.n;
    t.nMask := Word.Not (-t.n);
    Thread.Broadcast (t.changed);
  END Expand;

PROCEDURE WaitUntilEmpty (t: T;  index: CARDINAL) RAISES {Wr.Failure} =
  BEGIN
    LOCK t.lock DO
      WHILE (t.start[Who.Consumer] < index) AND ( NOT t.failure) DO
        Thread.Wait (t.lock, t.changed);
      END;
      CheckForFailure (t, Who.Producer);
      t.flushed := FALSE;
    END;
  END WaitUntilEmpty;

PROCEDURE SetFailure (t: T;  failureCode: REFANY) RAISES {} =
  BEGIN
    LOCK t.lock DO
      t.failure := TRUE;
      t.failureCode := failureCode;
    END;
    Thread.Broadcast (t.changed);
  END SetFailure;

PROCEDURE CheckForFailure (t: T;  who: Who) RAISES {Wr.Failure} =
  BEGIN
    IF (who = Who.Producer) AND (t.failure) THEN
      RAISE Wr.Failure (t.failureCode);
    END;
  END CheckForFailure;


(*****************************************************************************

Consumer-side operations

Invariant:  mode = Writing => maxL = LAST( INTEGER )

*****************************************************************************)

<*INLINE*> PROCEDURE Probe (t: T; i: CARDINAL) RAISES {Thread.Alerted} =
  BEGIN
    IF i >= t.cEnd THEN
      t.cSize := Allocate (t, Who.Consumer, t.cSize + 1);
      t.cEnd := t.cStart + t.cSize;
    END;
  END Probe;

<*INLINE*> PROCEDURE Get (t: T; i: CARDINAL): REFANY RAISES {} =
  BEGIN
    RETURN t.buffer[i MOD t.n];
  END Get;

<*INLINE*> PROCEDURE GetB (t: T; i: CARDINAL): BOOLEAN RAISES {} =
  BEGIN
    RETURN NARROW (t.buffer[i MOD t.n], Bool)^;
  END GetB;

<*INLINE*> PROCEDURE GetI (t: T; i: CARDINAL): INTEGER RAISES {} =
  BEGIN
    RETURN NARROW (t.buffer[i MOD t.n], Int)^;
  END GetI;

PROCEDURE PrintTop (self: Closure): REFANY RAISES {} =
  VAR pos: Position;
  BEGIN
    TRY
      pos.i := 0;
      pos.l := 0;
      pos.c := 0;
      pos.b := 0;
      LOOP
        EVAL PrintUntil (self.t, Mode.Writing, pos, LAST (INTEGER), FlushOp);
      END;
    EXCEPT
    | Thread.Alerted          => (* exit loop *)
    | Wr.Failure(failureCode) => SetFailure (self.t, failureCode);
    END;
    RETURN NIL;
  END PrintTop;

PROCEDURE Print (t: T;  mode: Mode; VAR pos: Position; maxL: CARDINAL): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR i, opArgs: CARDINAL;  op: Op;  result: BOOLEAN;
  BEGIN
    <* ASSERT mode = Mode.Thinking OR maxL = LAST (INTEGER) *>
    i := pos.i;
    Probe (t, i);

    TYPECASE Get (t, i) OF

    | Text.T(text) =>
          pos.i := i + 1;
          result := DoPrintText (t, mode, pos, text);

    | Op(z) =>
          op := z;
	  opArgs := op.args;
          pos.i := i + 1 + opArgs;
	  IF (opArgs > 0) THEN Probe (t, i + opArgs) END;
          result := op.proc (t, mode, pos, maxL, i+1);

    | Char (char) =>
          pos.i := i + 1;
          result := DoPrintChar (t, mode, pos, maxL, char);
    END;

    IF (mode = Mode.Writing)
      AND ((op = FlushOp) OR (pos.i >= t.cStart + ChunkSize)) THEN
      t.cSize  := Release (t, Who.Consumer, pos.i - t.cStart);
      t.cStart := pos.i;
      t.cEnd   := t.cStart + t.cSize;
    END;

    RETURN result;
  END Print;

PROCEDURE PrintRest (t: T;
                     mode : Mode;
                 VAR pos  : Position;
                     maxL : CARDINAL;
                     op   : Op): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR nextOp: Op;
  BEGIN
    LOOP
      nextOp := PeekOp (t, pos.i);
      IF nextOp.precedence <= op.precedence THEN RETURN FALSE END;
      IF Print (t, mode, pos, maxL) THEN RETURN TRUE END;
    END;
    RETURN FALSE;
  END PrintRest;

PROCEDURE PrintUntil (t: T;
                      mode : Mode;
		  VAR pos  : Position;
                      maxL : CARDINAL;
                      op   : Op): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR nextOp: Op;
  BEGIN
    LOOP
      nextOp := PeekOp (t, pos.i);
      IF nextOp.precedence <= op.precedence THEN EXIT END;
      IF Print (t, mode, pos, maxL) THEN RETURN TRUE END;
    END;
    IF nextOp = FlushOp THEN
      IF (op = FlushOp) AND Print (t, mode, pos, maxL) THEN END;
    ELSE
      <* ASSERT nextOp = op *>
      pos.i := pos.i + 1;
    END;
    RETURN FALSE;
  END PrintUntil;

PROCEDURE PrintGroup (t: T;
                      mode : Mode;
                  VAR pos  : Position;
                      maxL : CARDINAL;
                      args : CARDINAL): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  BEGIN
    RETURN PrintUntil (t, mode, pos, maxL, EndOp);
  END PrintGroup;

TYPE BeginState = RECORD
                    saveIndent : INTEGER;
                    saveWidth  : INTEGER;
                    saveL      : INTEGER;
                  END;

PROCEDURE PrintBegin (t: T;
                      mode   : Mode;
                  VAR pos    : Position;
                      maxL   : CARDINAL;
                      args   : CARDINAL): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR beginState: BeginState;  b: BOOLEAN;  offset, width: INTEGER;
  BEGIN
    offset := GetI (t, args);
    width  := GetI (t, args + 1);
    EnterBegin (t, mode, pos, maxL, offset, width, beginState);
    b := PrintUntil (t, mode, pos, maxL, EndOp);
    ExitBegin (t, mode, pos, maxL, beginState);
    RETURN b;
  END PrintBegin;

PROCEDURE EnterBegin (t: T;
                      mode       : Mode;
                  VAR pos        : Position;
                  VAR maxL       : CARDINAL;
                      offset     : INTEGER;
                      width      : CARDINAL;
                  VAR beginState : BeginState) RAISES {} =
  BEGIN
    beginState.saveIndent := t.indent;
    beginState.saveWidth := t.width;
    beginState.saveL := pos.l;
    IF width < LAST (INTEGER) THEN t.width := width END;
    IF offset < LAST (INTEGER) THEN
      t.indent := MAX (0, pos.c + pos.b + offset);
     END;
    IF mode = Mode.Thinking THEN maxL := MAX (0, maxL - pos.l) END;
    pos.l := 0;
  END EnterBegin;

PROCEDURE ExitBegin (t: T;
                     mode       : Mode;
                 VAR pos        : Position;
                 VAR maxL       : CARDINAL;
                 VAR beginState : BeginState) RAISES {} =
  BEGIN
    pos.l := pos.l + beginState.saveL;
    t.indent := beginState.saveIndent;
    t.width := beginState.saveWidth;
  END ExitBegin;

PROCEDURE PrintEnd (t: T;
                    mode : Mode;
                VAR pos  : Position;
                    maxL : CARDINAL;
                    args : CARDINAL): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  BEGIN
    <* ASSERT FALSE *>
    RETURN FALSE;
  END PrintEnd;

PROCEDURE PrintFlush (t: T;
                      mode : Mode;
                  VAR pos  : Position;
                      maxL : CARDINAL;
                      args : CARDINAL): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  BEGIN
    RETURN FALSE;
  END PrintFlush;

PROCEDURE PrintText (t: T;
                     mode : Mode;
                 VAR pos  : Position;
                     maxL : CARDINAL;
                     args : CARDINAL): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  BEGIN
    RETURN DoPrintText (t, mode, pos, Get (t, args));
  END PrintText;

PROCEDURE DoPrintText (t: T;
                       mode : Mode;
                   VAR pos  : Position;
                       text : Text.T): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  BEGIN
    IF pos.b > 0 THEN DoTrailingBlanks (t, mode, pos) END;
    IF mode = Mode.Writing THEN Wr.PutText (t.wr, text) END;
    pos.c := pos.c + Text.Length (text);
    RETURN (mode = Mode.Thinking) AND (pos.c > t.width);
  END DoPrintText;

PROCEDURE PrintChar (t: T;
                     mode : Mode;
                 VAR pos  : Position;
                     maxL : CARDINAL;
                     args : CARDINAL): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  BEGIN
    RETURN DoPrintChar (t, mode, pos, maxL, Get (t, args));
  END PrintChar;

PROCEDURE DoPrintChar (t: T;
                     mode : Mode;
                 VAR pos  : Position;
                     maxL : CARDINAL;
                     char : Char): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  BEGIN
    IF char^ = '\n' THEN
      RETURN DoNewLine (t, mode, pos, maxL, FIRST (INTEGER));
    ELSIF char^ = ' ' THEN
      pos.b := pos.b + 1;
      RETURN FALSE;
    ELSE
      IF pos.b > 0 THEN DoTrailingBlanks (t, mode, pos) END;
      IF mode = Mode.Writing THEN Wr.PutChar (t.wr, char^) END;
      pos.c := pos.c + 1;
      RETURN (mode = Mode.Thinking) AND (pos.c > t.width);
    END;
  END DoPrintChar;

PROCEDURE DoTrailingBlanks (t: T;
                            mode : Mode;
                        VAR pos  : Position)
  RAISES {Thread.Alerted, Wr.Failure} =
  BEGIN
    IF mode = Mode.Writing THEN
      FOR i := 1 TO pos.b DO Wr.PutChar (t.wr, ' ') END;
    END;
    pos.c := pos.c + pos.b;
    pos.b := 0;
  END DoTrailingBlanks;

PROCEDURE PrintNewLine (t: T;
                        mode      : Mode;
                    VAR pos       : Position;
                        maxL      : CARDINAL;
			args      : CARDINAL): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR offset: INTEGER;  freshLine: BOOLEAN;
  BEGIN
    offset    := GetI (t, args);
    freshLine := GetB (t, args + 1);
    RETURN DoLine (t, mode, pos, maxL, offset, freshLine);
  END PrintNewLine;

PROCEDURE PrintBreak (t: T;
                      mode      : Mode;
                  VAR pos       : Position;
                      maxL      : CARDINAL;
                      args      : CARDINAL): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR pos1, pos2: Position;  b1, b2: BOOLEAN;  doBreak: BOOLEAN;
    offset: INTEGER;  optimal, freshLine: BOOLEAN;
  BEGIN
    offset    := GetI (t, args);
    optimal   := GetB (t, args + 1);
    freshLine := GetB (t, args + 2);
(*
    IF NOT optimal THEN
      pos1 := pos;
      IF PrintRest (t, Thinking, pos1, pos1.l, BreakOp) THEN
        IF DoLine (t, mode, pos, maxL, offset, freshLine) THEN
          RETURN TRUE;
        END;
      END;
      RETURN PrintRest (t, mode, pos, maxL, BreakOp);
    END;
*)
    IF NOT optimal THEN
      pos1 := pos;
      b1 := PrintRest (t, Mode.Thinking, pos1, pos1.l, BreakOp);
      IF (NOT b1) AND (mode = Mode.Thinking) THEN
        pos := pos1;
        RETURN FALSE;
      END;
      IF b1 AND DoLine (t, mode, pos, maxL, offset, freshLine) THEN
        RETURN TRUE;
      END;
      RETURN PrintRest (t, mode, pos, maxL, BreakOp);
    END;

    pos1 := pos;
    b1 := PrintRest (t, Mode.Thinking, pos1, maxL, BreakOp);
    IF ( NOT b1) AND (pos1.l = pos.l) THEN
      IF mode = Mode.Writing THEN
        RETURN PrintRest (t, mode, pos, maxL, BreakOp);
      ELSE
        pos := pos1;
        RETURN FALSE;
      END;
    END;
    pos2 := pos;
    b2 := DoLine (t, Mode.Thinking, pos2, maxL, offset, freshLine)
           OR PrintRest (t, Mode.Thinking, pos2, maxL, BreakOp);
    doBreak := (b1 AND b2)
               OR ((NOT b2)
	           AND (b1 OR (pos2.l < pos1.l)
                           OR ((pos2.l = pos1.l) AND (pos2.c <= t.width))));
    IF mode = Mode.Writing THEN
      RETURN ((NOT doBreak) OR DoLine (t, mode, pos, maxL, offset, freshLine))
             AND PrintRest (t, mode, pos, maxL, BreakOp);
    ELSE
      IF doBreak
        THEN  pos := pos2;  RETURN b2;
        ELSE  pos := pos1;  RETURN b1;
      END;
    END;
  END PrintBreak;

PROCEDURE PrintPartialBreak (t: T;
                             mode      : Mode;
                         VAR pos       : Position;
                             maxL      : CARDINAL;
			     args      : CARDINAL): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR offset: INTEGER;  freshLine: BOOLEAN;
  BEGIN
    offset    := GetI (t, args);
    freshLine := GetB (t, args + 1);
    RETURN (pos.l > 0) AND DoLine (t, mode, pos, maxL, offset, freshLine);
  END PrintPartialBreak;

PROCEDURE PrintUnitedBreak (t: T;
                            mode      : Mode;
                        VAR pos       : Position;
                            maxL      : CARDINAL;
			    args      : CARDINAL): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR pos1: Position; doBreak: BOOLEAN; refany: REFANY;
    offset: INTEGER;  freshLine: BOOLEAN;
  BEGIN
    offset    := GetI (t, args);
    freshLine := GetB (t, args + 1);
    doBreak := FALSE;
    pos1 := pos;
    LOOP
      IF (pos1.l > 0)
        OR PrintRest (t, Mode.Thinking, pos1, pos.l, UnitedBreakOp) THEN
        doBreak := TRUE;
        EXIT;
      END;
      IF Peek (t, pos1.i) # UnitedBreakOp THEN EXIT END;
      pos1.i := pos1.i + 3;
    END;
    IF (mode = Mode.Thinking) AND (maxL <= pos.l) THEN
      pos := pos1;
      RETURN doBreak;
    END;
    LOOP
      IF doBreak THEN
        IF DoLine (t, mode, pos, maxL, offset, freshLine) THEN
          RETURN TRUE;
        END;
      END;
      IF PrintRest (t, mode, pos, maxL, UnitedBreakOp) THEN RETURN TRUE END;
      IF Peek (t, pos.i) # UnitedBreakOp THEN RETURN FALSE END;
      refany := Peek (t, pos.i);
      offset := NARROW (Peek (t, pos.i + 1), Int)^;
      freshLine := NARROW (Peek (t, pos.i + 2), Bool)^;
      pos.i := pos.i + 3;
    END;
  END PrintUnitedBreak;

TYPE Widths = REF ARRAY OF INTEGER;

PROCEDURE PrintAlign (t: T;
                      mode         : Mode;
                  VAR pos          : Position;
                      maxL         : CARDINAL;
		      args         : CARDINAL): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR
    oneLine      : BOOLEAN;
    beginState   : BeginState;
    pos1         : Position;
    start        : CARDINAL;
    endRun       : CARDINAL;
    maxWidths    : Widths;
    widths       : Widths;
    op           : Op;
    columns      : INTEGER;
    tryOneLine   : BOOLEAN;
    offset       : INTEGER;
    alignPred    : AlignPred;
    alignPredArg : REFANY;
  BEGIN
    columns      := GetI (t, args);
    tryOneLine   := GetB (t, args + 1);
    offset       := GetI (t, args + 2);
    alignPred    := Get  (t, args + 3);
    alignPredArg := Get  (t, args + 4);
    TRY
      oneLine := tryOneLine AND (pos.l = 0);
      EnterBegin (t, mode, pos, maxL, 0, t.width, beginState);

      maxWidths := NEW (Widths, columns);
      widths    := NEW (Widths, columns);

      IF oneLine THEN
        pos1 := pos;
        IF NOT PrintUntil (t, Mode.Thinking, pos1, pos.l, EndOp) THEN
          IF mode = Mode.Writing THEN
            RETURN PrintUntil (t, mode, pos, maxL, EndOp);
          ELSE
            pos := pos1;
            RETURN FALSE;
          END;
        END;
      END;

      start := pos.i;
      LOOP (* While another run of rows exists *)
        op := PeekOp (t, pos.i);
        IF (op = EndOp) OR (op = FlushOp) THEN EXIT END;

        pos1 := pos;
        LOOP (* While there are more rows in the run *)
          endRun := pos1.i;
          IF (op = EndOp) OR (op = FlushOp) THEN EXIT END;
          IF op = NoAlignOp THEN
            IF endRun = pos.i THEN endRun := endRun + 1 END;
            EXIT;
          END;
          IF (pos1.i > start) AND DoNewLine (t, Mode.Thinking, pos1, maxL, 0)
            THEN
            pos := pos1;
            RETURN TRUE;
          END;
          IF
            PrintRow (t, Mode.Thinking, pos1, pos1.l, maxWidths, widths,
                      offset, alignPred, alignPredArg) THEN
            IF endRun = pos.i THEN endRun := pos1.i END;
            EXIT;
          END;
          op := PeekOp (t, pos1.i);
        END;

        LOOP (* While there are more rows in the run *)
          IF pos.i >= endRun THEN EXIT END;
          IF Peek (t, pos.i) = NoAlignOp THEN
            IF Print (t, mode, pos, maxL) THEN RETURN TRUE END;
          ELSIF ((pos.i > start) AND DoNewLine (t, mode, pos, maxL, 0))
            OR PrintRow (t, mode, pos, maxL, maxWidths, widths, offset, NIL,
                         NIL) THEN
            RETURN TRUE;
          END;
        END;

        ClearWidths (maxWidths);
      END;

      IF op = EndOp THEN pos.i := pos.i + 1 END;
      RETURN FALSE;

    FINALLY

      ExitBegin (t, mode, pos, maxL, beginState);

    END;
  END PrintAlign;

PROCEDURE PrintRow (t: T;
                    mode         : Mode;
                VAR pos          : Position;
                    maxL         : CARDINAL;
                    maxWidths    : Widths;
                    widths       : Widths;
                    offset       : INTEGER;
                    alignPred    : AlignPred;
                    alignPredArg : REFANY): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR
    beginState: BeginState;
    col: CARDINAL;
    start: CARDINAL;
    op: Op;
  BEGIN
    TRY
      EnterBegin (t, mode, pos, maxL, offset, t.width, beginState);
      ClearWidths (widths);

      op := PeekOp (t, pos.i);
      <* ASSERT op = GroupOp *>
      pos.i := pos.i + 1;

      col := 0;
      LOOP (* while there are more items in the row *)
        start := pos.c + pos.b;
        IF (op = EndOp) OR (op = FlushOp) THEN EXIT END;

        IF Print (t, mode, pos, maxL) THEN RETURN TRUE END;

        IF col < NUMBER (widths^) THEN
          widths[col] := pos.c + pos.b - start;
          IF (alignPred # NIL)
            AND (NOT alignPred^ (alignPredArg, col, maxWidths[col],
                                 widths[col])) THEN
            RETURN TRUE;
          END;
          IF DoBlanks (t, mode, pos, maxL, maxWidths[col] - widths[col]) THEN
            RETURN TRUE;
          END;
          col := col + 1;
        END;

        op := PeekOp (t, pos.i);
      END;
      IF op = EndOp THEN pos.i := pos.i + 1 END;

      FOR z := col TO LAST (widths^) DO
        col := z;
        IF DoBlanks (t, mode, pos, maxL, maxWidths[col]) THEN
          RETURN TRUE;
        END;
      END;

      FOR i := 0 TO col - 1 DO
        maxWidths[i] := MAX (maxWidths[i], widths[i]);
      END;

      RETURN FALSE;
    FINALLY
      ExitBegin (t, mode, pos, maxL, beginState);
    END;
  END PrintRow;

PROCEDURE DoBlanks (t: T;
                    mode   : Mode;
                VAR pos    : Position;
                    maxL   : CARDINAL;
                    blanks : INTEGER): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  BEGIN
    pos.b := pos.b + MAX (0, blanks);
    RETURN (mode = Mode.Thinking) AND (pos.c + pos.b > t.width);
  END DoBlanks;

PROCEDURE ClearWidths (widths: Widths) RAISES {} =
  BEGIN
    FOR i := 0 TO LAST (widths^) DO widths[i] := 0 END;
  END ClearWidths;

PROCEDURE PrintNoAlign (t: T;
                        mode : Mode;
                    VAR pos  : Position;
                        maxL : CARDINAL;
			args : CARDINAL): BOOLEAN
   RAISES {Thread.Alerted, Wr.Failure} =
  BEGIN
    RETURN Print (t, mode, pos, maxL);
  END PrintNoAlign;

PROCEDURE DoLine (t: T;
                  mode      : Mode;
              VAR pos       : Position;
                  maxL      : CARDINAL;
                  offset    : INTEGER;
                  freshLine : BOOLEAN): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  BEGIN
    IF freshLine THEN
      RETURN DoFreshLine (t, mode, pos, maxL, offset);
    ELSE
      RETURN DoNewLine (t, mode, pos, maxL, offset);
    END;
  END DoLine;

PROCEDURE DoNewLine (t: T;
                     mode   : Mode;
                 VAR pos    : Position;
                     maxL   : CARDINAL;
                     offset : INTEGER): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  BEGIN
    IF mode = Mode.Writing THEN Wr.PutChar (t.wr, '\n') END;
    pos.c := 0;
    pos.b := MAX (0, t.indent + offset);
    pos.l := pos.l + 1;
    RETURN (mode = Mode.Thinking) AND (pos.l > maxL);
  END DoNewLine;

PROCEDURE DoFreshLine (t: T;
                       mode   : Mode;
                   VAR pos    : Position;
                       maxL   : CARDINAL;
                       offset : INTEGER): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR b: CARDINAL;
  BEGIN
    b := MAX (0, t.indent + offset);
    IF b < pos.c + pos.b THEN
      IF mode = Mode.Writing THEN Wr.PutChar (t.wr, '\n') END;
      pos.c := 0;
      pos.b := b;
      pos.l := pos.l + 1;
    END;
    RETURN (mode = Mode.Thinking) AND ((pos.l > maxL) OR (pos.c > t.width));
  END DoFreshLine;

PROCEDURE PeekOp (t: T; i: CARDINAL): Op
  RAISES {Thread.Alerted} =
  VAR r: REFANY;  tc: INTEGER;
  BEGIN
    r := Peek (t, i);
    tc := TYPECODE (r);
    TYPECASE r OF
    | NULL   => RETURN TextOp;
    | Text.T => RETURN TextOp;
    | Op(op) => RETURN op;
    | Char   => RETURN CharOp;
    END;
  END PeekOp;

PROCEDURE Peek (t: T; i: CARDINAL): REFANY
  RAISES {Thread.Alerted} =
  BEGIN
    Probe (t, i);
    RETURN Get (t, i);
  END Peek;

PROCEDURE DefineOp (proc       : OpProc;
                    args       : CARDINAL;
                    precedence : INTEGER): Op RAISES {} =
  BEGIN
    RETURN NEW (Op,  proc := proc,  args := args,  precedence := precedence);
  END DefineOp;

PROCEDURE NewInt (i: INTEGER): Int =
  VAR x: Int;
  BEGIN
    IF (FIRST (ints) <= i) AND (i <= LAST (ints)) THEN RETURN ints[i];
    ELSIF (i = FIRST (INTEGER))                   THEN RETURN firstInt;
    ELSIF (i = LAST (INTEGER))                    THEN RETURN lastInt;
    ELSE                    x := NEW (Int);  x^ := i;  RETURN x;
    END;
  END NewInt;

BEGIN
  GroupOp        := DefineOp (PrintGroup,        0, 13);
  BeginOp        := DefineOp (PrintBegin,        2, 12);
  AlignOp        := DefineOp (PrintAlign,        5, 11);
  TextOp         := DefineOp (PrintText,         1, 9);
  CharOp         := DefineOp (PrintChar,         1, 7);
  NoAlignOp      := DefineOp (PrintNoAlign,      0, 6);
  BreakOp        := DefineOp (PrintBreak,        3, 5);
  PartialBreakOp := DefineOp (PrintPartialBreak, 2, 4);
  NewLineOp      := DefineOp (PrintNewLine,      2, 3);
  UnitedBreakOp  := DefineOp (PrintUnitedBreak,  2, 2);
  EndOp          := DefineOp (PrintEnd,          0, 1);
  FlushOp        := DefineOp (PrintFlush,        0, FIRST (INTEGER));

  FOR i := FIRST (ints) TO LAST (ints) DO
    ints[i] := NEW (Int);
    ints[i]^ := i;
  END;
  firstInt := NEW (Int);  firstInt^ := FIRST (INTEGER);
  lastInt  := NEW (Int);  lastInt^  := LAST (INTEGER);
  FOR c := FIRST (chars) TO LAST (chars) DO
    chars[c] := NEW (Char);
    chars[c]^ := c;
  END;
  bools [TRUE]  := NEW (Bool);  bools[TRUE]^  := TRUE;
  bools [FALSE] := NEW (Bool);  bools[FALSE]^ := FALSE;
END Formatter.