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

(* File: EqualExpr.m3                                          *)
(* Last modified on Fri May 29 16:21:01 PDT 1992 by muller     *)
(*      modified on Mon Mar  2 10:51:03 PST 1992 by kalsow     *)

MODULE EqualExpr;

IMPORT M3, Expr, ExprRep, Type, Error, SetType, Target, Procedure;
IMPORT Bool, Int, Reel, LReel, EReel, Addr, Emit, SetExpr, Variable;
IMPORT IntegerExpr, ReelExpr, EnumExpr, AddressExpr, UserProc;
IMPORT Reff, ProcExpr, Temp, MBuf, EnumType, ProcType, CompareExpr;
IMPORT String, Scope, RecordType, ArrayType, Field, Value;
IMPORT NamedExpr, QualifyExpr;

TYPE
  P = ExprRep.Tabc BRANDED "EqualExpr.P" OBJECT
        eq : BOOLEAN;
      OVERRIDES
        typeOf       := ExprRep.NoType;
        check        := Check;
        compile      := Compile;
        evaluate     := Fold;
        fprint       := FPrinter;
        write        := Writer;
        isEqual      := EqCheck;
        getBounds    := ExprRep.NoBounds;
        isWritable   := ExprRep.IsNever;
        isDesignator := ExprRep.IsNever;
	isZeroes     := ExprRep.IsNever;
	note_write   := ExprRep.NotWritable;
	genLiteral   := ExprRep.NoLiteral;
      END;

CONST OpName = ARRAY BOOLEAN OF TEXT { "!=", "==" };
CONST CmpOp  = ARRAY BOOLEAN OF CompareExpr.Op { CompareExpr.Op.NE,
                                                 CompareExpr.Op.EQ };

PROCEDURE NewEQ (a, b: Expr.T): Expr.T =
  VAR p: P;
  BEGIN
    p := NEW (P);
    ExprRep.Init (p);
    p.a    := a;
    p.b    := b;
    p.eq   := TRUE;
    p.type := Bool.T;
    RETURN p;
  END NewEQ;

PROCEDURE NewNE (a, b: Expr.T): Expr.T =
  VAR p: P;
  BEGIN
    p := NEW (P);
    ExprRep.Init (p);
    p.a    := a;
    p.b    := b;
    p.eq   := FALSE;
    p.type := Bool.T;
    RETURN p;
  END NewNE;

PROCEDURE Check (p: P;  VAR cs: Expr.CheckState) =
  VAR ta, tb: Type.T;
  BEGIN
    Expr.TypeCheck (p.a, cs);
    Expr.TypeCheck (p.b, cs);
    ta := Type.Base (Expr.TypeOf (p.a));
    tb := Type.Base (Expr.TypeOf (p.b));
    IF NOT (Type.IsAssignable (ta, tb) OR Type.IsAssignable (tb, ta)) THEN
      Error.Msg ("illegal operands for comparison");
    END;
  END Check;

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

PROCEDURE Writer (p: P;  t1, t2: Temp.T) =
  VAR ta: Type.T;
  BEGIN
    ta := Type.Base (p.a.type);
    Emit.OpT  ("(@ ", t1);
    Emit.Op   (OpName [p.eq]);
    Emit.OpFT (" ((@)@))", ta, t2);
  END Writer;

PROCEDURE Compile (p: P): Temp.T =
  CONST OpValue = ARRAY BOOLEAN OF TEXT { "@ = 0 /*FALSE*/;\n",
                                          "@ = 1 /*TRUE*/;\n" };
  VAR
    range: Type.T;
    label: INTEGER;
    t1, t2, t3, t4, t5: Temp.T;
    fields: Scope.T;
    ta, tb, index, elems (***, base ***): Type.T;
    (*** min, max, n: INTEGER; ***)
    proc: Value.T;
    proc1, proc2, frame1, frame2: Temp.T;
  BEGIN
    t1 := Expr.Compile (p.a);
    t2 := Expr.Compile (p.b);
    ta := Type.Base (p.a.type);

    (* handle the simple cases as inline macros *)
    IF (ta = Int.T) OR (ta = Reel.T) OR (ta = LReel.T) OR (ta = EReel.T)
       OR EnumType.Is (ta)
       (*** OR SubrangeType.Split (ta, min, max)  ***)
       (*** OR PackedType.Split (ta, n, base) ***)
       OR Type.IsSubtype (ta, Addr.T)
       OR Type.IsSubtype (ta, Reff.T) THEN
      t3 := Temp.AllocMacro (p, FALSE);
      Temp.Depend (t3, t1);
      Temp.Depend (t3, t2);
      RETURN t3;
    END;

    (* else, it's a complex case *)

    t3 := Temp.Alloc (p);
    tb := Type.Base (p.b.type);

    IF SetType.Split (ta, range) THEN
      SetExpr.CompileTCompare (t1, t2, t3, ta, CmpOp [p.eq]);

    ELSIF ProcType.Is (ta) OR ProcType.Is (tb) THEN
      proc1  := Temp.AllocEmpty (Addr.T);
      frame1 := Temp.AllocEmpty (Addr.T);
      proc2  := Temp.AllocEmpty (Addr.T);
      frame2 := Temp.AllocEmpty (Addr.T);

      Emit.OpTT ("@ = (_ADDRESS) @;\n", proc1, t1);
      Emit.OpT  ("@ = (_ADDRESS) ", frame1);
      IF UserProc.IsProcedureLiteral (p.a, proc)
         AND Procedure.IsNested (proc) THEN
	IF NOT Procedure.EmitFrameName (proc) THEN Emit.Op ("_NIL"); END;
      ELSE
        Emit.Op ("0");
      END;
      Emit.Op (";\n");

      Emit.OpTT ("@ = (_ADDRESS) @;\n", proc2, t2);
      Emit.OpT  ("@ = (_ADDRESS) ", frame2);
      IF UserProc.IsProcedureLiteral (p.b, proc)
         AND Procedure.IsNested (proc) THEN
	IF NOT Procedure.EmitFrameName (proc) THEN Emit.Op ("_NIL"); END;
      ELSE
        Emit.Op ("0");
      END;
      Emit.Op   (";\n");
     
      IF CanHaveFrame (p.a) THEN
        Emit.OpT  ("if (_IS_CLOSURE (@)) {\001\n", proc1);
        Emit.OpTT ("@ = (_ADDRESS) _CLOSURE_FRAME (@); \n", frame1, proc1);
        Emit.OpTT ("@ = (_ADDRESS) _CLOSURE_PROC (@);\n\002}\n", proc1, proc1);
      END;

      IF CanHaveFrame (p.b) THEN
        Emit.OpT  ("if (_IS_CLOSURE (@)) {\001\n", proc2);
        Emit.OpTT ("@ = (_ADDRESS) _CLOSURE_FRAME (@); \n", frame2, proc2);
        Emit.OpTT ("@ = (_ADDRESS) _CLOSURE_PROC (@);\n\002}\n", proc2, proc2);
      END;

      Emit.OpT  ("@ = ", t3);
      IF p.eq THEN
        Emit.OpTT ("(@ == @) ", proc1, proc2);
        Emit.OpTT ("&& (@ == @);\n", frame1, frame2);
      ELSE
        Emit.OpTT ("(@ != @) ", proc1, proc2);
        Emit.OpTT ("|| (@ != @);\n", frame1, frame2);
      END;

      Temp.Free (proc1);  Temp.Free (frame1);
      Temp.Free (proc2);  Temp.Free (frame2);

    ELSIF RecordType.Split (ta, fields) OR
	  ArrayType.Split (ta, index, elems) THEN

      label := M3.NextLabel;  INC (M3.NextLabel);

      (* capture the address of the two expressions *)
      t4 := Temp.AllocEmpty (Addr.T);
      Emit.OpTT ("@ = (_ADDRESS) &(@);\n", t4, t1);
      t5 := Temp.AllocEmpty (Addr.T);
      Emit.OpTT ("@ = (_ADDRESS) &(@);\n", t5, t2);

      (* compile branching code that assigns to t3 *)
      Emit.OpT  (OpValue [NOT p.eq], t3);
      CompileTest (ta, tb, t4, t5, label, p);
      Emit.OpT  (OpValue [p.eq], t3);
      Emit.OpL ("@:;\n", label);

      Temp.Free (t4);
      Temp.Free (t5);

    ELSE 
      (* typechecking removed the other cases. *)
      <* ASSERT FALSE *>
    END;

    Temp.Free (t1);
    Temp.Free (t2);
    RETURN t3;
  END Compile;

PROCEDURE CanHaveFrame (e: Expr.T): BOOLEAN =
  VAR name: String.T;  obj: Value.T;
  BEGIN
    IF NOT (NamedExpr.Split (e, name, obj) OR QualifyExpr.Split (e, obj)) THEN
      (* non-constant, non-variable => no frame *)
      RETURN FALSE;
    ELSIF (Value.ClassOf (obj) = Value.Class.Procedure) THEN
      (* constant: no frame *)
      RETURN FALSE;
    ELSIF (Value.ClassOf (obj) = Value.Class.Var) AND
          Variable.HasClosure (Value.Base (obj)) THEN
      RETURN TRUE;
    ELSE (* non-formal, non-const => frame = NIL *)
      RETURN FALSE;
    END;
  END CanHaveFrame;

PROCEDURE CompileTest (t1, t2: Type.T; p1, p2: Temp.T;  label: INTEGER; p: P) =
  VAR fields: Scope.T;  range, i1, i2, e1, e2: Type.T;
  BEGIN
    IF RecordType.Split (t1, fields) THEN
      CompileRecord (t1, fields, p1, p2, label, p);
    ELSIF ArrayType.Split (t1, i1, e1) AND
          ArrayType.Split (t2, i2, e2) THEN
      CompileArray (t1, i1, e1, p1, t2, i2, e2, p2, label, p);
    ELSIF SetType.Split (t1, range) THEN
      SetExpr.CompileLCompare (p1, p2, label, t1);
    ELSE      
      (* this work also for procedures: only globals can be assigned to 
         variables, which is the case here. *)
      CompileOrdinary (t1, p1, p2, label);
    END;
  END CompileTest;

PROCEDURE CompileOrdinary (t1: Type.T;  p1, p2: Temp.T;  label: INTEGER) =
  BEGIN
    Emit.OpFT ("if ((*(@*)@) != ", t1, p1);
    Emit.OpFT ("(*(@*)@)) ", t1, p2);
    Emit.OpL  ("goto @;\n", label);
  END CompileOrdinary;

PROCEDURE CompileArray (t1, i1, e1: Type.T; p1: Temp.T;
                        t2, i2, e2: Type.T; p2: Temp.T;
                            label: INTEGER; p: P) =
  VAR o1, o2: Temp.T;
  BEGIN
    GenShapeCheck (t1, i1, e1, p1, t2, i2, e2, p2, label, 0);

    o1 := Temp.AllocEmpty (Addr.T);
    o2 := Temp.AllocEmpty (Addr.T);

    (* compute the address of the elements *)
    IF i1 = NIL THEN
      Emit.OpT  ("@ = (_ADDRESS) ", o1);
      Emit.OpFT ("((@*)@)->elts;\n", t1, p1);
    ELSE
      Emit.OpTT ("@ = @;\n", o1, p1);
    END;
    IF i2 = NIL THEN
      Emit.OpT  ("@ = (_ADDRESS) ", o2);
      Emit.OpFT ("((@*)@)->elts;\n", t2, p2);
    ELSE
      Emit.OpTT ("@ = @;\n", o2, p2);
    END;

    GenValueCheck (t1, i1, e1, p1, o1, t2, i2, e2, p2, o2, label, 0, p);

    Temp.Free (o1);
    Temp.Free (o2);
  END CompileArray;

PROCEDURE GenShapeCheck (t1, i1, e1: Type.T; p1: Temp.T; 
                         t2, i2, e2: Type.T; p2: Temp.T;
                           label: INTEGER; n: INTEGER) =
  BEGIN
    LOOP
      IF (i1 # NIL) AND (i2 # NIL) THEN RETURN END;

      Emit.Op ("if (");
      IF (i1 = NIL) THEN
        Emit.OpFT ("((@*)@)", t1, p1);
        Emit.OpI  ("->size[@]", n);
      ELSE
        Emit.OpI ("@", Type.Number (i1));
      END;
      Emit.Op (" != ");
      IF (i2 = NIL) THEN
        Emit.OpFT ("((@*)@)", t2, p2);
        Emit.OpI  ("->size[@]", n);
      ELSE
        Emit.OpI ("@", Type.Number (i2));
      END;
      Emit.OpL (") goto @;\n", label);

      IF NOT ArrayType.Split (e1, i1, e1) THEN RETURN END;
      IF NOT ArrayType.Split (e2, i2, e2) THEN RETURN END;
      n := n + 1;
    END;
  END GenShapeCheck;


PROCEDURE GenValueCheck (t1, i1, e1: Type.T; p1, o1: Temp.T; 
                         t2, i2, e2: Type.T; p2, o2: Temp.T;
                                 label: INTEGER;  n: INTEGER; p: P) =
  VAR loopVar: Temp.T;  j1, j2: Type.T;
  BEGIN
    loopVar := Temp.AllocEmpty (Int.T);
    Emit.OpTT ("for (@ = 0; @ < ", loopVar, loopVar);
    IF (i1 # NIL) THEN
      Emit.OpI ("@", Type.Number (i1));
    ELSIF (i2 # NIL) THEN
      Emit.OpI ("@", Type.Number (i1));
    ELSE
      Emit.OpFT ("((@*)@)", t1, p1);
      Emit.OpI  ("->size[@]", n);
    END;
    Emit.OpT ("; @++) {\001\n", loopVar);

    IF ArrayType.Split (e1, j1, e1) AND
       ArrayType.Split (e2, j2, e2) THEN
      GenValueCheck (t1, j1, e1, p1, o1, t2, j2, e2, p2, o2, label, n+1, p);
    ELSE
      CompileTest (e1, e2, o1, o2, label, p);
      Emit.OpTI ("@ += @;\n", o1, Type.Size (e1) DIV Target.CHARSIZE);
      Emit.OpTI ("@ += @;\n", o2, Type.Size (e2) DIV Target.CHARSIZE);
    END;

    Emit.Op ("\002}\n");
    Temp.Free (loopVar);
  END GenValueCheck;

PROCEDURE CompileRecord (recType: Type.T;  f: Scope.T;  p1, p2: Temp.T;
                                                      label: INTEGER; p: P) =
  VAR
    fields  : Scope.ValueList;
    n, j    : INTEGER;
    type    : Type.T;
    t1, t2  : Temp.T;
    fname   : String.T;
  BEGIN
    Scope.ToList (f, fields, n);
    FOR i := 0 TO n-1 DO 
      Field.SplitX (fields[i], j, type);
      fname := Value.CName (fields[i]);
      IF StructuredType (type) THEN
        t1 := Temp.AllocEmpty (Addr.T);
        t2 := Temp.AllocEmpty (Addr.T);
        Emit.OpT  ("@ = (_ADDRESS) &", t1);
        Emit.OpFT ("(((@*)@)", recType, p1);
        Emit.OpS  ("->@);\n", fname);
        Emit.OpT  ("@ = (_ADDRESS) &", t2);
        Emit.OpFT ("(((@*)@)", recType, p2);
        Emit.OpS  ("->@);\n", fname);
        CompileTest (type, type, t1, t2, label, p);
        Temp.Free (t1);
        Temp.Free (t2);
      ELSE (* simple scalar fields *)
        Emit.OpFT ("if (((@*)@)", recType, p1);
        Emit.OpS  ("->@ != ", fname);
        Emit.OpFT ("((@*)@)", recType, p2);
        Emit.OpS  ("->@) ", fname);
        Emit.OpL  ("goto @;\n", label);
      END;
    END;
  END CompileRecord;

PROCEDURE StructuredType (t: Type.T): BOOLEAN =
  VAR a, b: Type.T;  c: Scope.T;
  BEGIN
    t := Type.Base (t);
    IF ArrayType.Split (t, a, b) THEN RETURN TRUE END;
    IF RecordType.Split (t, c) THEN RETURN TRUE END;
    IF SetType.Split (t, a) THEN RETURN TRUE END;
    RETURN FALSE;
  END StructuredType;

PROCEDURE Fold (p: P): Expr.T =
  VAR e1, e2: Expr.T;  s: INTEGER;
  BEGIN
    e1 := Expr.ConstValue (p.a);
    IF (e1 = NIL) THEN RETURN NIL END;
    e2 := Expr.ConstValue (p.b);
    IF (e2 = NIL) THEN RETURN NIL END;
    IF   IntegerExpr.Compare (e1, e2, s)
      OR EnumExpr.Compare (e1, e2, s)
      OR ReelExpr.Compare (e1, e2, s)
      OR AddressExpr.Compare (e1, e2, s)
      OR SetExpr.Compare (e1, e2, s)
      OR ProcExpr.Compare (e1, e2, s) THEN
      RETURN Bool.Map[(p.eq) = (s = 0)];
    END;
    RETURN NIL;
  END Fold;

PROCEDURE FPrinter (p: P;  map: Type.FPMap;  wr: MBuf.T) =
  BEGIN
    MBuf.PutText (wr, OpName [p.eq]);
    Expr.Fingerprint (p.a, map, wr);
    Expr.Fingerprint (p.b, map, wr);
  END FPrinter;

BEGIN
END EqualExpr.