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

(* File: TextExpr.m3                                           *)
(* Last modified on Fri Sep 11 18:20:23 PDT 1992 by rustan     *)
(*      modified on Mon Mar  9 10:02:34 PST 1992 by kalsow     *)
(*      modified on Sun Feb 24 04:07:17 1991 by muller         *)

MODULE TextExpr;

IMPORT Expr, ExprRep, String, Textt, Emit, Temp, Type, MBuf;

CONST
  TextTypecode = 2;  (* KRML  used to be 1 *)
  GcStatusRecursivelyMarked = 3;

TYPE
  P = Expr.T OBJECT
        value : String.T;
      OVERRIDES
        typeOf       := ExprRep.NoType;
        check        := ExprRep.NoCheck;
        compile      := Compile;
        evaluate     := ExprRep.Self;
        fprint       := FPrinter;
        write        := Writer;
        isEqual      := EqCheck;
        getBounds    := ExprRep.NoBounds;
        isWritable   := ExprRep.IsNever;
        isDesignator := ExprRep.IsNever;
	isZeroes     := IsZeroes;
	genLiteral   := GenLiteral;
      END;

VAR nextID: INTEGER := 0;

PROCEDURE Reset () =
  BEGIN
    nextID := 0;
  END Reset;

PROCEDURE New (value: String.T): Expr.T =
  VAR p := NEW (P);
  BEGIN
    ExprRep.Init (p);
    p.value   := value;
    p.type    := Textt.T;
    p.checked := TRUE;
    RETURN p;
  END New;

PROCEDURE EqCheck (a: P;  e: Expr.T): BOOLEAN =
  BEGIN
    TYPECASE e OF
    | NULL => RETURN FALSE;
    | P(b) => RETURN (a.value = b.value);
    ELSE      RETURN FALSE;
    END;
  END EqCheck;

PROCEDURE SetUID (p: P) =
  VAR save: Emit.Stream;  uid: INTEGER;
  BEGIN
    IF (String.GetUID (p.value) < 0) THEN
      (* generate the literal *)
      save := Emit.Switch (Emit.Stream.TextLiterals);
      uid := nextID;  INC (nextID);
      String.SetUID (p.value, uid);
      Emit.OpI ("_PRIVATE _TXT _txt@ = ", uid);
      EmitRep (p.value);
      Emit.Op (";\n");
      EVAL Emit.Switch (save);
    END;
  END SetUID;

PROCEDURE EmitRep (s: String.T) =
  VAR len := String.Length (s);
  BEGIN
    (* KRML  The first of the following numbers is the size of the
       node allocated on the heap.  Although this object is not allocated
       on the heap, the size is filled in. *)
    Emit.OpII ("{ {sizeof(_TXT), @, @ },",
               TextTypecode, GcStatusRecursivelyMarked); (* changed KRML *)
    IF (len < (*** KRML 45 ***) 30 (* new KRML *) )
      THEN Emit.OpSI (" \"@\", @}", s, len+1);
      ELSE Emit.OpSI ("\001\n\"@\",\n@\002\n}", s, len+1);
    END;
  END EmitRep;

PROCEDURE Compile (p: P): Temp.T =
  BEGIN
    RETURN Temp.FromExpr (p);
  END Compile;

PROCEDURE Writer (p: P;  <*UNUSED*> t1, t2: Temp.T) =
  BEGIN
    SetUID (p);
    Emit.OpI ("((_ADDRESS)(& _txt@.str))", String.GetUID (p.value));
  END Writer;

PROCEDURE GenLiteral (p: P) =
  BEGIN
    SetUID (p);
    Emit.OpI ("((_ADDRESS)(& _txt@.str))", String.GetUID (p.value));
  END GenLiteral;

PROCEDURE Split (e: Expr.T;  VAR value: String.T): BOOLEAN =
  BEGIN
    TYPECASE e OF
    | NULL => RETURN FALSE;
    | P(p) => value := p.value;  RETURN TRUE;
    ELSE      RETURN FALSE;
    END;
  END Split;

PROCEDURE Cat (a, b: Expr.T;  VAR c: Expr.T): BOOLEAN =
  VAR sa, sb: String.T;
  BEGIN
    TYPECASE a OF
    | NULL => RETURN FALSE;
    | P(p) => sa := p.value;
    ELSE      RETURN FALSE;
    END;
    TYPECASE b OF
    | NULL => RETURN FALSE;
    | P(p) => sb := p.value;
    ELSE      RETURN FALSE;
    END;
    c := New (String.Concat (sa, sb));
    RETURN TRUE;
  END Cat;

PROCEDURE FPrinter (p: P;  <*UNUSED*> map: Type.FPMap;  wr: MBuf.T) =
  BEGIN
    MBuf.PutText (wr, "\"");
    String.Put (wr, p.value);
    MBuf.PutText (wr, "\"");
  END FPrinter;

PROCEDURE IsZeroes (<*UNUSED*>p: P): BOOLEAN = 
  BEGIN
    RETURN FALSE;
  END IsZeroes;

BEGIN
END TextExpr.