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

(* File: Emit.m3                                               *)
(* Last Modified On Fri Jul 13 03:28:52 1990 by muller         *)
(*      Modified On Thu Feb 15 09:03:35 1990 by kalsow         *)




UNSAFE MODULE Emit;

IMPORT String, Expr, Wr, UnsafeWr, Variable, Host, Text;
IMPORT Fmt, Scanner, Scope, Temp, Value, TextWr, Word;

CONST
  EndString = '\000';
  IndentGap = 3;
  Margin    = 120;

TYPE
  StreamState = RECORD
    wr        : Wr.T;
    indent    : INTEGER;
    newline   : BOOLEAN;
    breakable : BOOLEAN;
    flushLine : BOOLEAN;
    file      : String.T;
    line      : INTEGER;
    width     : INTEGER;
  END;

  T = REF RECORD
    next: T;
    current: Stream;
    streams: ARRAY Stream OF StreamState;
    pending: T;
  END;

VAR
  x	 : INTEGER;
  fmt    : Text.T;
  stack  : T;
  free   : T;
  cur    : StreamState;
  digits := ARRAY [0..9] OF CHAR { '0','1','2','3','4','5','6','7','8','9' };

PROCEDURE Push () =
  VAR t: T;
  BEGIN
    (* save the current entry *)
    IF (stack # NIL) THEN stack.streams[stack.current] := cur END;

    (* get a new one *)
    IF (free = NIL) THEN free := NEW (T) END;
    t := free;  free := t.next;

    (* initialize the new entry *)
    FOR i := FIRST (Stream) TO LAST (Stream) DO
      WITH z = t.streams[i] DO
     (* z.wr        := TextWr.New () *)
        z.indent    := 0;
        z.newline   := TRUE;
	z.breakable := TRUE;
	z.flushLine := FALSE;
	z.file      := NIL;
	z.line      := 0;
	z.width     := 0;
      END;
    END;
    t.current := 0;
    t.pending := NIL;
    t.next    := stack;
    stack     := t;

    (* finally, switch to the first stream *)
    cur := t.streams[0];
    IF (cur.wr = NIL) THEN cur.wr := TextWr.New () END;
  END Push;

PROCEDURE Pop () =
  VAR t: T;
  BEGIN
    IF (stack = NIL) THEN RETURN END;
    t := stack;  stack := t.next;

    (* save the current entry *)
    t.streams[t.current] := cur;

    IF (stack = NIL) THEN
      Flush (t);
    ELSE (* mark this guy as pending *)
      t.next := stack.pending;
      stack.pending := t;
    END;

    (* refresh the global state *)
    IF (stack # NIL)
      THEN cur := stack.streams[stack.current];
      ELSE cur.wr := Host.output
    END;
  END Pop;

PROCEDURE Flush (t: T) =
  VAR q: T;
  BEGIN
    WHILE (t # NIL) DO
      q := t.next;

      (* write each of its streams *)
      FOR i := FIRST (Stream) TO LAST (Stream) DO
        IF (t.streams[i].wr # NIL) THEN
          UnsafeWr.FastPutText (Host.output, TextWr.ToText (t.streams[i].wr));
        END;
      END;

      (* write anybody that's pending on this guy *)
      Flush (t.pending);

      (* put this guy on the free list *)
      t.next := free;  free := t;

      t := q;
    END;
  END Flush;

PROCEDURE Switch (new: Stream): Stream =
  VAR old: Stream;
  BEGIN
    old := stack.current;
    IF (old # new) THEN
      stack.streams[old] := cur;
      cur := stack.streams[new];
      stack.current := new;
    END;
    IF (cur.wr = NIL) THEN cur.wr := TextWr.New () END;
    RETURN old;
  END Switch;

PROCEDURE SetLine () =
  VAR file: String.T;  line: INTEGER;
  BEGIN
    IF (cur.breakable) AND (NOT Host.Clines) THEN
      Scanner.Here (file, line);
      IF (cur.flushLine) THEN
        UnsafeWr.FastPutChar (cur.wr, '\n');
	INC (cur.line);
	cur.newline   := TRUE;
	cur.breakable := TRUE;
	cur.width     := 0;
      ELSIF ((file = cur.file) AND (line = cur.line)) OR (line <= 0) THEN
        IF (cur.width <= Margin) THEN
          UnsafeWr.FastPutChar (cur.wr, ' ');
	  cur.newline   := FALSE;
          cur.breakable := FALSE;
	  INC (cur.width);
	ELSIF (line > 0) THEN
	  UnsafeWr.FastPutText (cur.wr, "\n#line ");
	  UnsafeWr.FastPutInt (cur.wr, line);
	  UnsafeWr.FastPutChar (cur.wr, '\n');
	  cur.newline   := TRUE;
	  cur.breakable := TRUE;
	  cur.width     := 0;
	ELSE (* line <= 0  ==> line number doesn't matter *)
	  UnsafeWr.FastPutChar (cur.wr, '\n');
	  cur.newline   := TRUE;
	  cur.breakable := TRUE;
	  cur.width     := 0;
	END;
      ELSIF (file # cur.file) THEN
        UnsafeWr.FastPutText (cur.wr, "\n#line ");
	IF (line > 0)
	  THEN UnsafeWr.FastPutInt  (cur.wr, line);
	  ELSE UnsafeWr.FastPutText (cur.wr, "9999");
	END;
        UnsafeWr.FastPutText (cur.wr, " \"");
        String.Put (cur.wr, file);
        UnsafeWr.FastPutText (cur.wr, "\"\n");
        cur.file      := file;
        cur.line      := line;      
	cur.newline   := TRUE;
	cur.breakable := TRUE;
	cur.width     := 0;
      ELSIF (cur.line <= line) AND (line <= cur.line+10) THEN
        WHILE (cur.line < line) DO
	  UnsafeWr.FastPutChar (cur.wr, '\n');
	  INC (cur.line);
	END;
	cur.newline   := TRUE;
	cur.breakable := TRUE;
	cur.width     := 0;
      ELSE
        UnsafeWr.FastPutText (cur.wr, "\n#line ");
	UnsafeWr.FastPutInt  (cur.wr, line);
	UnsafeWr.FastPutChar (cur.wr, '\n');
        cur.line      := line;      
	cur.newline   := TRUE;
	cur.breakable := TRUE;
	cur.width     := 0;
      END;
    END;
  END SetLine;

PROCEDURE X () =
  VAR c: CHAR;
  BEGIN
    LOOP
      IF x >= Text.Length (fmt) THEN RETURN END;
      IF (cur.breakable) THEN SetLine () END;
      c := Text.GetChar (fmt, x);
      CASE c (* x^ *) OF
      | '\n' =>
          IF (Host.Clines) OR (cur.flushLine) THEN
            UnsafeWr.FastPutChar (cur.wr, '\n');
	    INC (cur.line);
	    cur.newline := TRUE;
	    cur.flushLine := FALSE;
	    cur.width := 0;
	  ELSE
            cur.breakable := TRUE;
	  END;
      | FlushLine =>
          IF (NOT cur.newline) THEN
	    UnsafeWr.FastPutChar (cur.wr, '\n');
	    INC (cur.line);
	  END;
          cur.newline   := FALSE;
	  cur.breakable := FALSE;
	  cur.flushLine := TRUE;
	  cur.width     := 0;
      | Indent =>
          INC (cur.indent, IndentGap);
      | Outdent =>
          DEC (cur.indent, IndentGap);
      | EndString =>
          RETURN;
      ELSE
        IF (cur.newline) THEN
          FOR i := 1 TO cur.indent DO UnsafeWr.FastPutChar (cur.wr,' ')  END;
          cur.newline := FALSE;
	  cur.width   := cur.indent;
        END;
        cur.breakable := FALSE;
	IF (c = Marker) THEN  INC (x); RETURN  END;
        UnsafeWr.FastPutChar (cur.wr, (* x^ *) c);
        cur.newline := FALSE;
	INC (cur.width);
      END;
      INC (x);
    END;
  END X;

PROCEDURE TT (t: Temp.T) =
  VAR z: INTEGER; zz: Text.T;
  BEGIN
    X ();
    z := x; zz := fmt;
    Temp.Write (t);
    x := z; fmt:= zz;
  END TT;

PROCEDURE V (v: Variable.T) =
  VAR z: INTEGER; t: Temp.T; zz: Text.T;
  BEGIN
    X ();
    z := x; zz := fmt;
    t := Variable.Load (v);
    Temp.Write (t);
    Temp.Free (t);
    x := z; fmt := zz;
  END V;

PROCEDURE L (v: Variable.T) =
  VAR z: INTEGER; zz: Text.T;
  BEGIN
    X ();
    z := x; zz := fmt;
    Variable.LoadLValue (v);
    x := z; fmt := zz;
  END L;

PROCEDURE I (i: INTEGER) =
  BEGIN
    X ();
    IF (cur.breakable) THEN SetLine (); cur.breakable := FALSE; END;
    IF (0 <= i) THEN
      IF (i < 10) THEN
        UnsafeWr.FastPutChar (cur.wr, digits[i]);
	INC (cur.width);
      ELSIF (i < 100) THEN
        UnsafeWr.FastPutChar (cur.wr, digits[i DIV 10]);
        UnsafeWr.FastPutChar (cur.wr, digits[i MOD 10]);
	INC (cur.width, 2);
      ELSE
        UnsafeWr.FastPutInt (cur.wr, i);
	INC (cur.width, 3);
      END;
    ELSE
      UnsafeWr.FastPutInt (cur.wr, i);
      INC (cur.width, 3);
    END;
  END I;

PROCEDURE C (c: CHAR) =
  VAR n: INTEGER;
  BEGIN
    X ();
    IF (cur.breakable) THEN SetLine (); cur.breakable := FALSE; END;
    IF (c < ' ') OR (c = '\"') OR (c = '\'') OR ('~' < c) OR (c = '\\') THEN
      n := Word.And (ORD (c), 255);
      UnsafeWr.FastPutChar (cur.wr, '\\');
      UnsafeWr.FastPutChar (cur.wr, digits[n DIV 64]);  n := Word.And (n, 63);
      UnsafeWr.FastPutChar (cur.wr, digits[n DIV 8]);   n := Word.And (n, 7);
      UnsafeWr.FastPutChar (cur.wr, digits[n]);
      INC (cur.width, 4);
    ELSE (* simple graphic character *)
      UnsafeWr.FastPutChar (cur.wr, c);
      INC (cur.width);
    END;
  END C;

PROCEDURE Q (s: String.T) =
  BEGIN
    X ();
    IF (cur.breakable) THEN SetLine (); cur.breakable := FALSE; END;
    String.PutChars (cur.wr, s);
    INC (cur.width, 4 * String.Length (s));
  END Q;

PROCEDURE S (s: String.T) =
  BEGIN
    X ();
    IF (cur.breakable) THEN SetLine (); cur.breakable := FALSE; END;
    String.Put (cur.wr, s);
    INC (cur.width, String.Length (s));
  END S;

PROCEDURE SS (READONLY ss: String.Stack) =
  BEGIN
    X ();
    IF (cur.breakable) THEN SetLine (); cur.breakable := FALSE; END;
    FOR i := 0 TO ss.top-1 DO
      String.Put (cur.wr, ss.stk[i]);
      INC (cur.width, String.Length (ss.stk[i]));
    END;
  END SS;

PROCEDURE R (r: LONGREAL) =
  VAR t: TEXT;  u: ARRAY [0..50] OF CHAR;  len: INTEGER;
  BEGIN
    X ();
    IF (cur.breakable) THEN SetLine (); cur.breakable := FALSE; END;
    t := Fmt.LongReal (r, 13, Fmt.Style.Sci);
    Text.PutStr (u, t);
    len := Text.Length (t);
    FOR i := 0 TO len - 1 DO
      IF u[i] = 'D' OR u[i] = 'd' OR u[i] = 'E' THEN u[i] := 'e'; EXIT; END;
    END;
    UnsafeWr.FastPutString (cur.wr, SUBARRAY (u, 0, len));
    INC (cur.width, len);
  END R;

PROCEDURE N (v: Value.T) =
  VAR z: INTEGER; zz: Text.T;
  BEGIN
    X ();
    z := x; zz := fmt;
    Scope.GenName (v);
    x := z; fmt:= zz;
  END N;

PROCEDURE H (h: INTEGER) =
  BEGIN
    X ();
    IF (cur.breakable) THEN SetLine (); cur.breakable := FALSE; END;
    UnsafeWr.FastPutText (cur.wr, Fmt.Pad (Fmt.Unsigned (h, 16), 8, '0'));
    INC (cur.width, 8);
  END H;

PROCEDURE Op (f: Format) =
  BEGIN
    fmt := f; x := 0;
    X ();
  END Op;

PROCEDURE OpC (f: Format;  c: CHAR) =
  BEGIN
    fmt := f; x := 0;
    C (c);
    X ();
  END OpC;

PROCEDURE OpQ (f: Format; s: String.T) =
  BEGIN
    fmt := f; x := 0;
    Q (s);
    X ();
  END OpQ;

PROCEDURE OpS (f: Format; s: String.T) =
  BEGIN
    fmt := f; x := 0;
    S (s);
    X ();
  END OpS;

PROCEDURE OpSS (f: Format; s1, s2: String.T) =
  BEGIN
    fmt := f; x := 0;
    S (s1);
    S (s2);
    X ();
  END OpSS;

PROCEDURE OpSI (f: Format; s: String.T; i: INTEGER) =
  BEGIN
    fmt := f; x := 0;
    S (s);
    I (i);
    X ();
  END OpSI;

PROCEDURE OpIS (f: Format; i: INTEGER; s: String.T) =
  BEGIN
    fmt := f; x := 0;
    I (i);
    S (s);
    X ();
  END OpIS;

PROCEDURE OpI (f: Format; i: INTEGER) =
  BEGIN
    fmt := f; x := 0;
    I (i);
    X ();
  END OpI;

PROCEDURE OpII (f: Format; i1, i2: INTEGER) =
  BEGIN
    fmt := f; x := 0;
    I (i1);
    I (i2);
    X ();
  END OpII;

PROCEDURE OpIII (f: Format; i1, i2, i3: INTEGER) =
  BEGIN
    fmt := f; x := 0;
    I (i1);
    I (i2);
    I (i3);
    X ();
  END OpIII;

PROCEDURE OpV (f: Format; v: Variable.T) =
  BEGIN
    fmt := f; x := 0;
    V (v);
    X ();
  END OpV;

PROCEDURE OpL (f: Format; v: Variable.T) =
  BEGIN
    fmt := f; x := 0;
    L (v);
    X ();
  END OpL;

PROCEDURE OpR (f: Format; r: LONGREAL) =
  BEGIN
    fmt := f; x := 0;
    R (r);
    X ();
  END OpR;

PROCEDURE OpN (f: Format; v: Value.T) =
  BEGIN
    fmt := f; x := 0;
    N (v);
    X ();
  END OpN;

PROCEDURE OpH (f: Format; h: INTEGER) =
  BEGIN
    fmt := f; x := 0;
    H (h);
    X ();
  END OpH;

PROCEDURE OpHH (f: Format; h1, h2: INTEGER) =
  BEGIN
    fmt := f; x := 0;
    H (h1);
    H (h2);
    X ();
  END OpHH;

PROCEDURE OpT (f: Format; t: Temp.T) =
  BEGIN
    fmt := f; x := 0;
    TT (t);
    X ();
  END OpT;

PROCEDURE OpTT (f: Format; t1, t2: Temp.T) =
  BEGIN
    fmt := f; x := 0;
    TT (t1);
    TT (t2);
    X ();
  END OpTT;

PROCEDURE OpTTT (f: Format; t1, t2, t3: Temp.T) =
  BEGIN
    fmt := f; x := 0;
    TT (t1);
    TT (t2);
    TT (t3);
    X ();
  END OpTTT;

PROCEDURE OpTI (f: Format; t: Temp.T; i: INTEGER) =
  BEGIN
    fmt := f; x := 0;
    TT (t);
    I (i);
    X ();
  END OpTI;

PROCEDURE OpIT (f: Format; i: INTEGER; t: Temp.T) =
  BEGIN
    fmt := f; x := 0;
    I (i);
    TT (t);
    X ();
  END OpIT;

PROCEDURE OpX (f: Format; t: Text.T) =
  BEGIN
    fmt := f; x := 0;
    X ();
    IF (cur.breakable) THEN SetLine (); cur.breakable := FALSE; END;
    UnsafeWr.FastPutText (cur.wr, t);
    X ();
  END OpX;

PROCEDURE OpZ   (f: Format;  READONLY ss: String.Stack) =
  BEGIN
    fmt := f; x := 0;
    SS (ss);
    X ();
  END OpZ;

PROCEDURE OpSZ  (f: Format;  s: String.T;  READONLY ss: String.Stack) =
  BEGIN
    fmt := f; x := 0;
    S (s);
    SS (ss);
    X ();
  END OpSZ;

PROCEDURE ZeroL (size: INTEGER; f: Format; v: Variable.T) =
  BEGIN
    Zero (size);
    OpL (f, v);
    Op (");\n");
  END ZeroL;

PROCEDURE ZeroT (size: INTEGER; f: Format; t: Temp.T) =
  BEGIN
    Zero (size);
    OpT (f, t);
    Op (");\n");
  END ZeroT;

PROCEDURE ZeroZ (size: INTEGER; f: Format; READONLY ss: String.Stack) =
  BEGIN
    Zero (size);
    OpZ (f, ss);
    Op (");\n");
  END ZeroZ;

PROCEDURE Zero (size: INTEGER) =
  BEGIN
    CASE size OF
    |  1 => Op ("ZERO1B (");
    |  2 => Op ("ZERO1S (");
    |  4 => Op ("ZERO1  (");
    |  8 => Op ("ZERO2  (");
    | 12 => Op ("ZERO3  (");
    | 16 => Op ("ZERO4  (");
    | 20 => Op ("ZERO5  (");
    | 24 => Op ("ZERO6  (");
    | 28 => Op ("ZERO7  (");
    | 32 => Op ("ZERO8  (");
    ELSE    OpI ("ZERO  (@, ", size);
    END;
  END Zero;

PROCEDURE Comment (t: Text.T) =
  VAR i, j, len: INTEGER;
  BEGIN
    IF (cur.breakable) THEN SetLine (); cur.breakable := FALSE; END;
    i := 0;
    len := Text.Length (t);
    WHILE (i + 70 < len) DO
      UnsafeWr.FastPutText (cur.wr, "  /** ");
      UnsafeWr.FastPutText (cur.wr, Text.Sub (t, i, 60));
      UnsafeWr.FastPutText (cur.wr, " **/\n");
      INC (i, 60);
      INC (cur.line);
      cur.width := 0;
    END;
    IF (i < len) THEN
      UnsafeWr.FastPutText (cur.wr, "  /** ");
      UnsafeWr.FastPutText (cur.wr, Text.Sub (t, i, len - i));
      IF (len > 70) THEN
        (* pad the last line *)
        j := 60 - (len - i);
        WHILE (j > 0) DO UnsafeWr.FastPutChar (cur.wr, ' '); DEC (j)  END;
      END;
      UnsafeWr.FastPutText (cur.wr, " **/\n");
      INC (cur.line);
      cur.width := 0;
    END;
  END Comment;

PROCEDURE Initialize () =
  BEGIN
    cur.wr        := Host.output;
    cur.indent    := 0;
    cur.newline   := TRUE;
    cur.breakable := TRUE;
    cur.flushLine := FALSE;
    cur.file      := NIL;
    cur.line      := 2;
    cur.width     := 0;
    free          := NIL;
    stack         := NIL;
    Op ("\003#include \"M3Runtime.h\"\003\n");
    Wr.Flush (Host.output);
  END Initialize;

BEGIN
END Emit.