Written in Modula-2+ by John Ellis before the dawn of history Converted to Modula-3 by Bill Kalsow on Oct 1989 Cleaned up and documented by J. Stolfi on Nov 1990

Last modified on Mon Jan 30 16:09:03 PST 1995 by kalsow modified on Thu Jan 28 10:45:08 PST 1993 by mjordan modified on Mon Jun 29 22:09:16 PDT 1992 by muller modified on Sun Feb 23 14:45:03 PST 1992 by meehan modified on Thu Jul 25 19:30:49 PDT 1991 by stolfi modified on Mon Apr 22 17:34:37 1991 by nichols@xerox.com modified on Tue May 2 10:32:50 1989 by ellis

MODULE XFormat;

IMPORT Text, Wx, Thread, Scheduler;

TYPE
  (* RefStream = ARRAY [0..LAST(CARDINAL)] OF REFANY; *)

REVEAL
  T = T_ BRANDED "XFormat.T" OBJECT
    wx:          Wx.T;

    width:       CARDINAL;   (* Current nominal line width *)
    indent:      CARDINAL;   (* Current offset for breaks *)

    chars:       CharBuf;    (* ExprBuf for compacting PutChar's *)
    numChars:    CARDINAL;   (* Number of chars in /chars/ *)

    cThread:     Thread.T;         (* Consumer thread *)
    lock:        Thread.Mutex;     (* Protects shared Producer/Consumer data *)
    changed:     Thread.Condition; (* Something changed *)
    closed:      BOOLEAN;          (* /Close/ operator is through the pipe *)

    (* stream:   RefStream; *)     (* Dummy: the input stream *)

    buffer:      ExprBuf;          (* Expression buffer *)
    bufSize:     CARDINAL;         (* NUMBER(buffer^) *)

    start:       ARRAY Who OF CARDINAL; (* Start of each thread's buffer area*)
    size:        ARRAY Who OF CARDINAL; (* Size of each thread's buffer area *)

    next:       CARDINAL;      (* Next undefined position of input stream *)

    pPutLim:    CARDINAL;      (* Time for Producer to put to Consumer *)
    cGetLim:    CARDINAL;      (* Time for Consumer to get from Producer  *)

    waiters:     CARDINAL;     (* Number of threads waiting for Allocate *)
  OVERRIDES
    underlyingWr  := UnderlyingWr;
    close         := Close;
    flush         := Flush;
    putText       := PutText;
    putChar       := PutChar;
    putMarkup     := PutMarkup;
    break         := Break;
    partialBreak  := PartialBreak;
    newLine       := NewLine;
    unitedBreak   := UnitedBreak;
    group         := Group;
    begin         := Begin;
    align         := Align;
    noAlign       := NoAlign;
    col           := Col;
    end           := End;
  END;

  (*
    Note on the storage scheme:

    The two threads (Producer and Consumer) operate on the /input
    stream/, an ideal sequence /t.stream/ of REFANYs that encodes the
    test strings and formatting operations sent to the Formatter.

    Ideally the sequence /t.stream/ is infinite, but at any moment only
    its first /t.next/ elements have been specified by the client.
    By definition, /t.stream/ is modified only by the Producer (the
    client), which merely sets t.stream[t.next] to the appropriate
    value, and increments t.pnext.  The values of t.stream[i] for
    i < t.next are never modified by anyone.

    At any moment, each thread "owns" a segment of the input stream
    t.stream.  The segment owned by thread /who/ starts at
    /t.start[who]/ and contain /t.size[who]/ characters.  The two
    segments are contiguous (i.e, t.start[Consumer] + t.size[Consumer]
    = t.start[Producer]), and their total size is equal to the
    t.bufSize.  The next undefined element t.next is either in the
    Producer's segment, or just beyond it.

    The two segments are stored circularly in the array /t.buffer/,
    which has length /t.bufSize/.  Specifically, element /i/ of the
    input stream is stored in /t.buffer[i MOD t.bufSize]/, for all /i/
    in the range

      [ t.start[Consumer] .. t.start[Producer] + t.size[Producer] ]

    The field /t.start[who]/ is modified only by te thread /who/ itself.
    The field /t.size[who]/ can be modified by either thread, and
    therefore should be accessed only with /t.lock/ held. (However, the
    other thread can only cause /t.size[who]/ to grow, never to shrink).
    For instance, every now and then the Producer will donate an initial
    piece of its segment to the Consumer.  Similarly, every now and
    then the Consumer will throw away an initial piece of its segment,
    and increase the Producer's /t.size/ so as to maintain the total
    size of th etwo segments equal to /t.bufSize/.

    Occasionally, the array /t.buffer/ may fill up; at that point it
    it will be expanded automatically, so as to preserve the invariants
    above.  This expansion happens only when both threads are
    blocked in the same /Allocate/ procedure (below); at other
    times, it is safe to reference /t.buffer/ and /t.bufSize/
    without acquiring /t.lock/.

    In principle the Producer could just pass each input item directly
    to the Consumer, and keep its input stream segment always
    empty.  The reason for not doing so is efficiency: the lock must
    be acquired for each batch.

    The Consumer needs random access to its stream segment because it
    has to do unbounded lookahead.   *)

TYPE
  ExprBuf = REF ARRAY OF REFANY;
  CharBuf = ARRAY [0..255] OF CHAR;
  Who    = {Producer, Consumer};

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

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

EXCEPTION (* Client errors: *)
  UnmatchedEnd;     (* /End/ without matching /Group/, /Align/, etc. *)
  InvalidAlignRow;  (* A row of an /Align/ is neither a /Group/.../End/ nor /NoAlign/ *)

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

VAR (*CONST*)
  firstInt: Int;
  lastInt: Int;
  ints: ARRAY [-256..256] OF Int;
  chars: ARRAY CHAR OF Char;
  bools: ARRAY BOOLEAN OF Bool;
  breakTypes: ARRAY BreakType OF REF BreakType;

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;
  ColOp:          Op;
  MarkUpOp:       Op;
  CharOp:         Op;
  TextOp:         Op;
  NoAlignOp:      Op;
  BreakOp:        Op;
  PartialBreakOp: Op;
  NewLineOp:      Op;
  UnitedBreakOp:  Op;
  EndOp:          Op;
  FlushOp:        Op;
  CloseOp:        Op;

PROCEDURE New(wx: Wx.T;  width: CARDINAL:= 75): T =
  BEGIN
    WITH t = NEW(T) DO
      t.wx := wx;
      t.width := width;
      t.indent := 0;

      t.numChars := 0;

      (* t.stream := RefStream{NIL, ..}; *)

      t.buffer := NEW (ExprBuf, 4 * ChunkSize);
      t.bufSize := NUMBER (t.buffer^);

      t.start[Who.Producer]:= 0;
      t.size[Who.Producer]:= NUMBER (t.buffer^);

      t.start[Who.Consumer]:= 0;
      t.size[Who.Consumer]:= 0;

      t.next := 0;

      t.pPutLim := 0;

      t.cGetLim := 0;

      t.lock := NEW (Thread.Mutex);
      t.changed := NEW (Thread.Condition);
      t.closed := FALSE;

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

      RETURN t
    END
  END New;

PROCEDURE UnderlyingWr(t: T): Wx.T =
  BEGIN
    RETURN t.wx;
  END UnderlyingWr;

PROCEDURE Flush(t: T) =
  BEGIN
    IF t.numChars > 0 THEN AddChars(t) END;
    AddRef(t, FlushOp);
    WaitUntilEmpty(t, t.next);
    (* Wr.Flush(t.wr); *)
  END Flush;

PROCEDURE Close(t: T) =
  BEGIN
    AddRef(t, CloseOp);
    Flush(t);
    WaitUntilEmpty(t, t.next);
    EVAL Thread.Join(t.cThread);
  END Close;

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

PROCEDURE Begin(t: T;  offset := 0;  width: CARDINAL:= LAST (CARDINAL)) =
  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) =
  BEGIN
    IF t.numChars > 0 THEN AddChars(t) END;
    AddRef(t, EndOp);
  END End;

PROCEDURE PutChar(t: T;  c: CHAR) =
  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) =
  BEGIN
    IF raw THEN
      IF t.numChars > 0 THEN AddChars(t) END;
      AddRef(t, text);
    ELSE
      IF t.numChars > 0 THEN AddChars(t) END;
      FOR i := 0 TO Text.Length(text) - 1 DO
        PutChar(t, Text.GetChar(text, i));
      END;
      IF t.numChars > 0 THEN AddChars(t) END;
    END;
  END PutText;

PROCEDURE PutMarkup(t: T;  text: Text.T;  width := 0) =
  BEGIN
    IF t.numChars > 0 THEN AddChars(t) END;
    AddRef(t, MarkUpOp);
    AddRef(t, text);
    AddRef(t, NewInt (width));
  END PutMarkup;

PROCEDURE Break (t: T;  offset := 0;  type := BreakType.OptimalBreak;  freshLine := TRUE) =
  BEGIN
    IF t.numChars > 0 THEN AddChars (t) END;
    AddRef(t, BreakOp);
    AddRef(t, NewInt (offset));
    AddRef(t, breakTypes[type]);
    AddRef(t, bools[freshLine]);
  END Break;

PROCEDURE PartialBreak(t: T;  offset := 0;  freshLine := TRUE) =
  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) =
  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) =
  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;
  ) =
  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);
  END Align;

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

PROCEDURE Col (t: T; column: INTEGER; relative := FALSE; space: CARDINAL := 0)=
  BEGIN
    IF t.numChars > 0 THEN AddChars(t) END;
    AddRef(t, ColOp);
    AddRef(t, NewInt(column));
    AddRef(t, bools[relative]);
    AddRef(t, NewInt(space));
  END Col;

PROCEDURE AddRef(t: T; ref: REFANY) =
  (*
    Adds an element to the Producer buffer.  If the buffer gets big
    enough, or the added element is the "Flush" operator, then releases
    the buffer's contents to the Consumer thread.  *)
  VAR pFree: CARDINAL;
  BEGIN
    IF t.next = t.pPutLim THEN
      (* Time to send data to Consumer, and get some more space: *)
      pFree := Release(t, Who.Producer, t.pPutLim - t.start[Who.Producer]);
      IF pFree = 0 THEN
        pFree := Allocate(t, Who.Producer, ChunkSize);
      END;
      <* ASSERT t.start[Who.Producer] = t.next *>
      t.pPutLim := t.start[Who.Producer] + MIN(pFree, ChunkSize);
    END;

    (* t.stream[t.next] := ref; *)

    t.buffer[t.next MOD t.bufSize] := ref;
    t.next := t.next + 1;

    IF (t.next = t.pPutLim) OR (ref = FlushOp) THEN
      pFree := Release(t, Who.Producer, t.next - t.start[Who.Producer]);
      <* ASSERT t.start[Who.Producer] = t.next *>
      t.pPutLim := t.start[Who.Producer] + MIN(pFree, ChunkSize);
    END;
  END AddRef;

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

PROCEDURE Release(
    t: T;
    this: Who;
    size: CARDINAL
  ): CARDINAL =
  (*
    Releases the oldest /size/ elements of the input stream segment
    belonging to thread /this/.  If /this=Producer/, those elements
    are appended to the Consumer's segment. If /this=Consumer/, the
    elements are discarded, and the Producer's segment is extended
    forward so as to use up the space thus vacated in /t.buffer/.

    Returns a lower bound /n/ for the final value t.size[this].
    It is only an estimate, because the other thread may
    cause t.size[this] grow at any time. *)
  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];
    END;
    Changed (t);
    RETURN newSize;
  END Release;

PROCEDURE Allocate(
    t: T;
    this: Who;
    minSize: CARDINAL;
  ): CARDINAL =
  (*
    Ensures that /this/'s segment of the input stream contains at least
    /minSize/ elements.

    Returns a lower bound /n/ to the final value of t.size[this].
    The value is only a lower bound, because the other thread may
    cause /t.size[this]/ to grow at any time. *)
  BEGIN
    LOCK t.lock DO
      IF t.size[this] < minSize THEN
        INC (t.waiters);
        WHILE (t.size[this] < minSize) DO
          IF t.waiters = 2 THEN Expand(t) END;
          Thread.Wait(t.lock, t.changed);
        END;
        DEC (t.waiters);
      END;
      RETURN t.size[this]
    END;
  END Allocate;

PROCEDURE Expand(t: T) =
  (*
    Expands t.buffer, preserving its contents.
    Safe only if both producer and consumer are blocked in /Allocate/.
    LL >= t.lock *)
  VAR from, to: CARDINAL;
  BEGIN
    <* ASSERT t.waiters = 2 *>
    WITH
      oldSize = t.bufSize + 0,
      newSize = 2 * oldSize,
      newBuffer = NEW (ExprBuf, newSize)
    DO
      from := t.start[Who.Consumer] MOD oldSize;
      to := t.start[Who.Consumer] MOD newSize;
      FOR i := 0 TO oldSize - 1 DO
        newBuffer[to]:= t.buffer[from];
        from := from + 1;
        IF from = oldSize THEN from := 0 END;
        to := to + 1;
        IF to = newSize THEN to := 0 END;
      END;
      t.buffer := newBuffer;
      t.bufSize := newSize;
      INC (t.size[Who.Producer], newSize - oldSize);
      Changed (t);
    END
  END Expand;

PROCEDURE Changed (t: T) =
  BEGIN
    Thread.Broadcast (t.changed);
    Scheduler.Yield ();
  END Changed;

PROCEDURE WaitUntilEmpty(t: T;  index: CARDINAL) =
  (*
    Blocks until the Consumer thread eats the input stream
    up to but not including t.stream[index]. *)
  BEGIN
    LOCK t.lock DO
      WHILE (t.start[Who.Consumer] < index) DO
        Thread.Wait(t.lock, t.changed);
      END;
    END;
  END WaitUntilEmpty;

TYPE
  Mode = {
    Thinking, (* Computing the displacement if we were to print *)
    Writing   (* Actually printing *)
  };

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

<*INLINE*>
PROCEDURE Probe(t: T; i: CARDINAL) =
  (*
    Blocks until item t.stream[i] is in Consumer's segment *)
  BEGIN
    IF i >= t.cGetLim THEN
      WITH
        cSize = Allocate(t, Who.Consumer, i - t.start[Who.Consumer] + 1)
      DO
        t.cGetLim := t.start[Who.Consumer] + cSize;
        <* ASSERT t.cGetLim >= i *>
      END
    END;
  END Probe;

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

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

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

<*INLINE*>
PROCEDURE GetBreakType (t: T; i: CARDINAL): BreakType =
  BEGIN
    RETURN NARROW (t.buffer[i MOD t.bufSize], REF BreakType)^;
  END GetBreakType;

PROCEDURE PeekOp(t: T; i: CARDINAL): Op =
  BEGIN
    WITH r = Peek(t, i) DO
      TYPECASE r OF
      | NULL   => RETURN TextOp;
      | Text.T => RETURN TextOp;
      | Op(op) => RETURN op;
      | Char   => RETURN CharOp;
      ELSE
        <* ASSERT FALSE *>
      END
    END
  END PeekOp;

PROCEDURE Peek(t: T; i: CARDINAL): REFANY =
  BEGIN
    Probe(t, i);
    RETURN Get(t, i);
  END Peek;

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;

PROCEDURE PrintTop(self: ConsumerThreadClosure): REFANY =
  VAR pos: Position;
  (*
    The printing thread *)
  BEGIN
    pos.i := 0;
    pos.l := 0;
    pos.c := 0;
    pos.b := 0;
    REPEAT
      EVAL PrintUntil(self.t, Mode.Writing, pos, LAST (INTEGER), FlushOp);
    UNTIL self.t.closed;
    RETURN NIL;
  END PrintTop;

The various Print* procedures below return TRUE if mode=Mode.Thinking and the stuff to be printed does not fit in the current line.

PROCEDURE Print(
    t: T;
    mode: Mode;
    VAR pos: Position;
    maxL: CARDINAL
  ): BOOLEAN =
  (*
    Prints the next expression from the input stream *)
  VAR result: BOOLEAN;
      flushed: BOOLEAN := FALSE;
      i: CARDINAL;
  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(op) =>
          WITH opArgs = op.args DO
            pos.i := i + 1 + opArgs;
            IF (opArgs > 0) THEN Probe(t, i + opArgs) END;
          END;
          result := op.proc(t, mode, pos, maxL, i+1);
          flushed := (op = FlushOp)
    | Char(ch) =>
          pos.i := i + 1;
          result := DoPrintChar(t, mode, pos, maxL, ch);
    ELSE
      <* ASSERT FALSE *>
    END;
    IF (mode = Mode.Writing)
    AND (flushed OR (pos.i >= t.start[Who.Consumer] + ChunkSize)) THEN
      WITH
        cSize = Release(t, Who.Consumer, pos.i - t.start[Who.Consumer])
      DO
        <* ASSERT t.start[Who.Consumer] = pos.i *>
        t.cGetLim := t.start[Who.Consumer] + cSize
      END
    END;

    RETURN result;
  END Print;

PROCEDURE PrintRest(
    t: T;
    mode: Mode;
    VAR pos: Position;
    maxL: CARDINAL;
    op: Op
  ): BOOLEAN =
  (*
    Prints expressions from the input stream up to (but not including)
    the first operator with precedence less than or equal to op.  *)
  BEGIN
    LOOP
      WITH nextOp = PeekOp(t, pos.i) DO
        IF nextOp.precedence <= op.precedence THEN EXIT END;
        IF Print(t, mode, pos, maxL) THEN RETURN TRUE END;
      END
    END;
    RETURN FALSE;
  END PrintRest;

PROCEDURE PrintUntil(
    t: T;
    mode: Mode;
    VAR pos: Position;
    maxL: CARDINAL;
    op: Op
  ): BOOLEAN =
  (*
    Prints expressions from the input stream up to the first operator
    /next/ with precedence less than or equal to /op/, inclusive.
    Requires that /next/ be /op/ or a FlushOp.  *)
  VAR nextOp: Op;
      lastOp: Op := NIL; (*DEBUG*)
  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;
      lastOp := nextOp; (*DEBUG*)
    END;
    IF nextOp = FlushOp THEN
      IF (op = FlushOp) THEN
        EVAL Print(t, mode, pos, maxL)
      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;
    <*UNUSED*> args: CARDINAL
  ): BOOLEAN =
  (*
    Prints expressions from the input stream up to the first operator
    /EndOp/ or /FlushOp/.  *)
  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 =
  (*
    Prints expressions from the input stream up to the first operator
    /EndOp/ or /FlushOp/, modifying locally the /offset/ and /width/.  *)
  VAR beginState: BeginState;
      b: BOOLEAN;
  BEGIN
    WITH
      offset = GetI (t, args),
      width = GetI (t, args + 1)
    DO
      EnterBegin(t, mode, pos, maxL, offset, width, beginState);
      b := PrintUntil(t, mode, pos, maxL, EndOp);
      ExitBegin(t, mode, pos, maxL, beginState);
      RETURN b
    END
  END PrintBegin;

PROCEDURE EnterBegin(
    t: T;
    mode: Mode;
    VAR pos: Position;
    VAR maxL: CARDINAL;
    offset: INTEGER;
    width: CARDINAL;
    VAR beginState: BeginState
  ) =
  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;
    <*UNUSED*> mode: Mode;
    VAR pos: Position;
    <*UNUSED*> VAR maxL: CARDINAL;
    VAR beginState: BeginState
  ) =
  BEGIN
    pos.l := pos.l + beginState.saveL;
    t.indent := beginState.saveIndent;
    t.width := beginState.saveWidth;
  END ExitBegin;

PROCEDURE PrintEnd(
    <*UNUSED*> t: T;
    <*UNUSED*> mode: Mode;
    <*UNUSED*> VAR pos: Position;
    <*UNUSED*> maxL: CARDINAL;
    <*UNUSED*> args: CARDINAL
  ): BOOLEAN =
  (*
    /EndOp/s should have been gobbled up by the respective /Begin/s,
    /Group/s, and /Align/s. *)
  <*FATAL UnmatchedEnd*>
  BEGIN
    RAISE UnmatchedEnd;
    (* RETURN FALSE; *)
  END PrintEnd;

PROCEDURE PrintFlush(
    <*UNUSED*> t: T;
    <*UNUSED*> mode: Mode;
    <*UNUSED*> VAR pos: Position;
    <*UNUSED*> maxL: CARDINAL;
    <*UNUSED*> args: CARDINAL
  ): BOOLEAN =
  (*
    Prints a /Flush/ operator.  Other print procedures should
    watch for it. *)
  BEGIN
    RETURN FALSE;
  END PrintFlush;

PROCEDURE PrintClose(
               t: T;
    <*UNUSED*> mode: Mode;
    <*UNUSED*> VAR pos: Position;
    <*UNUSED*> maxL: CARDINAL;
    <*UNUSED*> args: CARDINAL
  ): BOOLEAN =
  (*
    Prints a /Close/ operator. *)
  BEGIN
    t.closed := TRUE;
    RETURN FALSE;
  END PrintClose;

PROCEDURE PrintText(
    t: T;
    mode: Mode;
    VAR pos: Position;
    <*UNUSED*> maxL: CARDINAL;
    args: CARDINAL
  ): BOOLEAN =
  (*
    Prints a text string. *)
  BEGIN
    RETURN DoPrintText(t, mode, pos, Get(t, args));
  END PrintText;

PROCEDURE DoPrintText(
    t: T;
    mode: Mode;
    VAR pos: Position;
    text: Text.T
  ): BOOLEAN =
  BEGIN
    IF pos.b > 0 THEN DoTrailingBlanks(t, mode, pos) END;
    IF mode = Mode.Writing THEN Wx.PutText(t.wx, text) END;
    pos.c := pos.c + Text.Length(text);
    RETURN (mode = Mode.Thinking) AND (pos.c > t.width);
  END DoPrintText;

PROCEDURE PrintMarkUp(
    t: T;
    mode: Mode;
    VAR pos: Position;
    <*UNUSED*> maxL: CARDINAL;
    args: CARDINAL
  ): BOOLEAN =
  (*
    Prints a zero-width, markup string. *)
  BEGIN
    RETURN DoPrintMarkUp(t, mode, pos, Get(t, args), GetI(t, args+1));
  END PrintMarkUp;

PROCEDURE DoPrintMarkUp(
    t: T;
    mode: Mode;
    VAR pos: Position;
    text: Text.T;
    width: INTEGER
  ): BOOLEAN =
  BEGIN
    IF pos.b > 0 THEN DoTrailingBlanks(t, mode, pos) END;
    IF mode = Mode.Writing THEN Wx.PutText(t.wx, text) END;
    pos.c := pos.c + width;
    RETURN (mode = Mode.Thinking) AND (pos.c > t.width);
  END DoPrintMarkUp;

PROCEDURE PrintChar(
    t: T;
    mode: Mode;
    VAR pos: Position;
    maxL: CARDINAL;
    args: CARDINAL
  ): BOOLEAN =
  BEGIN
    RETURN DoPrintChar(t, mode, pos, maxL, Get(t, args));
  END PrintChar;

PROCEDURE DoPrintChar(
    t: T;
    mode: Mode;
    VAR pos: Position;
    <*UNUSED*> maxL: CARDINAL;
    ch: Char
  ): BOOLEAN =
  BEGIN
    IF ch^ = '\n' THEN
      <* ASSERT FALSE *>
      (* RETURN DoNewLine(t, mode, pos, maxL, FIRST (INTEGER)); *)
    ELSIF ch^ = ' ' THEN
      pos.b := pos.b + 1;
      RETURN FALSE;
    ELSE
      IF pos.b > 0 THEN DoTrailingBlanks(t, mode, pos) END;
      IF mode = Mode.Writing THEN Wx.PutChar(t.wx, ch^) 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
    ) =
  BEGIN
    IF mode = Mode.Writing THEN
      FOR i := 1 TO pos.b DO Wx.PutChar(t.wx, ' ') END;
    END;
    pos.c := pos.c + pos.b;
    pos.b := 0;
  END DoTrailingBlanks;

PROCEDURE PrintBreak(
    t: T;
    mode: Mode;
    VAR pos: Position;
    maxL: CARDINAL;
    args: CARDINAL
  ): BOOLEAN =
  (*
    Prints a /Break/ operator and all succeeding expressions
    until next line break (of any kind), /End/, or /Flush/. *)
  BEGIN
    WITH
      offset = GetI (t, args),
      type = GetBreakType (t, args + 1),
      freshLine = GetB (t, args + 2)
    DO
      IF type = BreakType.NonOptimal THEN
        RETURN DoNonOptimalBreak(t, mode, pos, maxL, offset, freshLine);
      ELSE
        RETURN DoOptimalBreak(t, mode, pos, maxL, offset, freshLine, type)
      END
    END
  END PrintBreak;

PROCEDURE DoNonOptimalBreak(
    t: T;
    mode: Mode;
    VAR pos: Position;
    maxL: CARDINAL;
    offset: INTEGER;
    freshLine: BOOLEAN;
  ): BOOLEAN =
  VAR pos1: Position; b1: BOOLEAN;
  BEGIN
    (* See if it fits in current line: *)
    pos1:= pos;
    b1 := PrintRest(t, Mode.Thinking, pos1, pos1.l, BreakOp);
    IF NOT b1 AND mode = Mode.Thinking THEN
      pos := pos1;
      RETURN FALSE;
    ELSIF b1 AND DoLine(t, mode, pos, maxL, offset, freshLine) THEN
      RETURN TRUE
    ELSE
      RETURN PrintRest(t, mode, pos, maxL, BreakOp);
    END;
  END DoNonOptimalBreak;

PROCEDURE DoOptimalBreak(
    t: T;
    mode: Mode;
    VAR pos: Position;
    maxL: CARDINAL;
    offset: INTEGER;
    freshLine: BOOLEAN;
    type: BreakType;
  ): BOOLEAN =
  VAR pos1, pos2: Position;
      willOverflowSameLine, willOverflowOnNewLine: BOOLEAN;
      doBreak: BOOLEAN;
  BEGIN
    (* Check what would happen if we did NOT break here: *)
    pos1:= pos;
    willOverflowSameLine := PrintRest(t, Mode.Thinking, pos1, maxL, BreakOp);
    IF (NOT willOverflowSameLine) 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;

    (* Check what would happen if we DID break here: *)
    pos2:= pos;
    willOverflowOnNewLine:=
      DoLine(t, Mode.Thinking, pos2, maxL, offset, freshLine) OR
      PrintRest(t, Mode.Thinking, pos2, maxL, BreakOp);

    (* Compare the two outcomes, and do the best: *)
    doBreak :=
      ( willOverflowSameLine AND willOverflowOnNewLine ) OR
      ( (NOT willOverflowOnNewLine) AND
        ( willOverflowSameLine OR
          (pos2.l < pos1.l) OR
          (pos2.l = pos1.l AND pos2.c <= t.width AND type = BreakType.OptimalBreak)
        )
      );
    IF mode = Mode.Writing THEN
      IF doBreak THEN
        RETURN DoLine(t, mode, pos, maxL, offset, freshLine)
      ELSE
        RETURN PrintRest(t, mode, pos, maxL, BreakOp)
      END;
    ELSE
      IF doBreak THEN
        pos := pos2;
        RETURN willOverflowOnNewLine;
      ELSE
        pos := pos1;
        RETURN willOverflowSameLine;
      END;
    END
  END DoOptimalBreak;

PROCEDURE PrintPartialBreak(
    t: T;
    mode: Mode;
    VAR pos: Position;
    maxL: CARDINAL;
    args: CARDINAL
  ): BOOLEAN =
  (*
    Prints a /PartialBreak/ operator and all succeeding expressions
    or /Break/s until next /PartialBreak/, /NewLine/, /UnitedBreak/,
    /End/, or /Flush/.  *)
  BEGIN
    WITH
      offset = GetI (t, args),
      freshLine = GetB (t, args + 1)
    DO
      RETURN (pos.l > 0) AND DoLine(t, mode, pos, maxL, offset, freshLine)
    END
  END PrintPartialBreak;

PROCEDURE PrintCol (
    t: T;
    <*UNUSED*> mode: Mode;
    VAR pos : Position;
    <*UNUSED*> maxL: CARDINAL;
    args: CARDINAL
  ): BOOLEAN =
  VAR column := GetI(t, args);
  BEGIN
    WITH
      relative = GetB(t, args + 1),
      space = GetI(t, args + 2)
    DO
      IF relative THEN INC(column, t.indent); END;
      IF pos.c + pos.b < column THEN
        pos.b := column - pos.c;
      ELSE
        INC(pos.b, space);
      END
    END;
    RETURN FALSE;
  END PrintCol;

PROCEDURE PrintNewLine(
    t: T;
    mode: Mode;
    VAR pos: Position;
    maxL: CARDINAL;
    args: CARDINAL
  ): BOOLEAN =
  (*
    Prints a /NewLine/ operator and all succeeding expressions,
    including /Break/s and /PartialBreaks/, up to the next
    /NewLine/, /UnitedBreak/, /End/, or /Flush/. *)
  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 DoLine(
    t: T;
    mode: Mode;
    VAR pos: Position;
    maxL: CARDINAL;
    offset: INTEGER;
    freshLine: BOOLEAN
  ): BOOLEAN =
  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 =
  BEGIN
    IF mode = Mode.Writing THEN Wx.PutChar(t.wx, '\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 =
  VAR b: CARDINAL;
  BEGIN
    b := MAX (0, t.indent + offset);
    IF b < pos.c + pos.b THEN
      IF mode = Mode.Writing THEN Wx.PutChar(t.wx, '\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 PrintUnitedBreak(
    t: T;
    mode: Mode;
    VAR pos: Position;
    maxL: CARDINAL;
    args: CARDINAL
  ): BOOLEAN =
  (*
    Prints a /UnitedBreak/ operator and all succeeding expressions
    or line breaks until next /End/, or /Flush/.  *)
  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 =
  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;
  BEGIN
    columns := GetI (t, args);
    tryOneLine := GetB (t, args + 1);
    offset := GetI (t, args + 2);
    alignPred := Get  (t, args + 3);
    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) 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) 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;
  ): BOOLEAN =
  <*FATAL InvalidAlignRow*>
  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);
      IF op # GroupOp THEN RAISE InvalidAlignRow END;
      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.pred(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;
    <*UNUSED*> maxL: CARDINAL;
    blanks: INTEGER
  ): BOOLEAN =
  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) =
  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;
    <*UNUSED*> args: CARDINAL
  ): BOOLEAN =
  BEGIN
    RETURN Print(t, mode, pos, maxL);
  END PrintNoAlign;

PROCEDURE NewInt(i: INTEGER): 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
      WITH x = NEW(Int) DO x^:= i; RETURN x END
    END;
  END NewInt;

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

BEGIN
  GroupOp        := DefineOp(PrintGroup,        0, 13);
  BeginOp        := DefineOp(PrintBegin,        2, 12);
  AlignOp        := DefineOp(PrintAlign,        4, 11);
  ColOp          := DefineOp(PrintCol,          3, 10);
  TextOp         := DefineOp(PrintText,         1, 9);
  MarkUpOp       := DefineOp(PrintMarkUp,       2, 7);
  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);
  CloseOp        := DefineOp(PrintClose,        0, FIRST (INTEGER) + 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;
  FOR k := FIRST(breakTypes) TO LAST(breakTypes) DO
    breakTypes[k] := NEW(REF BreakType);
    breakTypes[k]^ := k;
  END;
END XFormat.