(* Copyright (C) 1989, Digital Equipment Corporation *) (* All rights reserved. *) (* See the file COPYRIGHT for a full description. *) (* File: EqualExpr.m3 *) (* Last modified on Fri Jul 20 12:49:38 1990 by muller *) (* modified on Tue Feb 13 08:53:17 1990 by kalsow *) MODULE EqualExpr; IMPORT Expr, ExprAB, ExprABC, ExprRep, Type, Error, SetType; IMPORT Bool, Int, Reel, Longreal, Address, Emit, SetExpr; IMPORT IntegerExpr, RealExpr, LongrealExpr, EnumExpr, AddressExpr; IMPORT Refany, ProcExpr, Temp, Wr, Text, EnumType, ProcType, Null; IMPORT String, Scope, RecordType, ArrayType, Field, Value, NamedType; IMPORT NamedExpr, QualifyExpr, Variable, SubrangeType, PackedType; IMPORT ValueRep, CompareExpr, UserProc, Procedure; TYPE P = ExprABC.T OBJECT eq : CompareExpr.Op; METHODS bind := ExprAB.Bind; check := Check; compile := Compile; evaluate := Fold; fprint := FPrinter; write := ExprRep.NoWriter; isEqual := EqCheck; getBounds := ExprRep.NoBounds; isWritable := ExprRep.IsNever; isDesignator := ExprRep.IsNever; isZeroes := ExprRep.IsNever; genLiteral := ExprRep.NoLiteral; END; 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 := CompareExpr.Op.EQ; 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 := CompareExpr.Op.NE; p.type := Bool.T; RETURN p; END NewNE; PROCEDURE Check (p: P) = VAR ta, tb: Type.T; BEGIN Expr.TypeCheck (p.a); Expr.TypeCheck (p.b); 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 Compile (p: P): Temp.T = VAR range: Type.T; t1, t2, t3: Temp.T; label: String.T; fields: Scope.T; ta, tb, index, elems, base: Type.T; min, max, n: INTEGER; proc: Value.T; BEGIN t1 := Expr.Compile (p.a); t2 := Expr.Compile (p.b); t3 := Temp.Alloc (p); ta := Type.Base (p.a.type); tb := Type.Base (p.b.type); IF (ta = Int.T) OR (ta = Reel.T) OR (ta = Longreal.T) OR EnumType.Is (ta) OR SubrangeType.Split (ta, min, max) OR PackedType.Split (ta, n, base) OR Type.IsSubtype (ta, Address.T) OR Type.IsSubtype (ta, Refany.T) THEN Emit.OpT ("@ = ", t3); IF p.eq = CompareExpr.Op.EQ THEN Emit.OpTT ("(@ == @)", t1, t2); ELSE Emit.OpTT ("(@ != @)", t1, t2); END; Emit.Op (";\n"); ELSIF SetType.Split (ta, range) THEN SetExpr.CompileCompareT (t1, t2, t3, ta, p.eq); ELSIF ProcType.Is (ta) OR ProcType.Is (tb) THEN Emit.Op ("{\001\n"); Emit.OpT ("char *p1 = (char*)@;\n", t1); Emit.Op ("char *f1 = (ADDRESS) "); 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.OpT ("char *p2 = (char*)@;\n", t2); Emit.Op ("char *f2 = (ADDRESS) "); 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.Op ("if (IS_CLOSURE (p1)) {\001\n"); Emit.Op ("f1 = (char*) CLOSURE_FRAME (p1); \n"); Emit.Op ("p1 = (char*) CLOSURE_PROC (p1); };\002\n"); END; IF CanHaveFrame (p.b) THEN Emit.Op ("if (IS_CLOSURE (p2)) {\001\n"); Emit.Op ("f2 = (char*) CLOSURE_FRAME (p2); \n"); Emit.Op ("p2 = (char*) CLOSURE_PROC (p2); };\002\n"); END; IF p.eq = CompareExpr.Op.EQ THEN Emit.OpT ("@ = ((p1 == p2) && (f1 == f2));\n", t3); ELSE Emit.OpT ("@ = ((p1 != p2) || (f1 != f2));\n", t3); END; Emit.Op ("\002};\n"); ELSIF RecordType.Split (ta, fields) OR ArrayType.Split (ta, index, elems) THEN label := String.Unique (String.Add ("fail")); Emit.OpI ("{\001\nt@ *arg1 =", Type.Name (p.a.type)); Emit.OpT (" &(@);\n", t1); Emit.OpI ("t@ *arg2 =", Type.Name (p.b.type)); Emit.OpT (" &(@);\n", t2); IF p.eq = CompareExpr.Op.EQ THEN Emit.OpT ("@ = 0 /* FALSE */;\n", t3); ELSE Emit.OpT ("@ = 1 /* TRUE */;\n", t3); END; CompileTest (ta, tb, String.Add ("(*arg1)"), String.Add ("(*arg2)"), label, p); IF p.eq = CompareExpr.Op.EQ THEN Emit.OpT ("@ = 1 /* TRUE */;\n", t3); ELSE Emit.OpT ("@ = 0 /* FALSE */;\n", t3); END; Emit.OpS ("@:;\n\002};\n", label); 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 (obj) THEN RETURN TRUE; ELSE (* non-formal, non-const => frame = NIL *) RETURN FALSE; END; END CanHaveFrame; PROCEDURE CompileTest (t1, t2: Type.T; p1, p2, label: String.T; p: P) = VAR fields: Scope.T; range, i1, i2, e1, e2: Type.T; BEGIN t1 := NamedType.Strip (t1); t2 := NamedType.Strip (t2); IF RecordType.Split (t1, fields) THEN CompileRecord (fields, p1, p2, label, p); ELSIF ArrayType.Split (t1, i1, e1) AND ArrayType.Split (t2, i2, e2) THEN CompileArray (i1, e1, p1, i2, e2, p2, label, p); ELSIF SetType.Split (t1, range) THEN SetExpr.CompileCompareL (p1, p2, label, range); ELSE (* this work also for procedures: only globals can be assigned to variables, which is the case here. *) CompileOrdinary (p1, p2, label); END; END CompileTest; PROCEDURE CompileOrdinary (p1, p2, label: String.T) = BEGIN Emit.OpSS ("if (@ != @)", p1, p2); Emit.OpS (" goto @;\n", label); END CompileOrdinary; PROCEDURE CompileArray (i1, e1: Type.T; p1: String.T; i2, e2: Type.T; p2, label: String.T; p: P) = VAR m: INTEGER; o1 := p1; o2 := p2; BEGIN GenShapeCheck (i1, e1, p1, i2, e2, p2, label, 0); Emit.Op ("{\001\n"); IF i1 = NIL THEN m := Type.Name (ArrayType.OpenType (e1)); Emit.OpI ("t@ *arg11 = ", m); Emit.OpIS ("(t@ *)(@.elts);\n", m, p1); o1 := String.Add ("(*arg11)"); END; IF i2 = NIL THEN m := Type.Name (ArrayType.OpenType (e2)); Emit.OpI ("t@ *arg22 = ", m); Emit.OpIS ("(t@ *)(@.elts);\n", m, p2); o2 := String.Add ("(*arg22)"); END; GenValueCheck (i1, e1, p1, o1, i2, e2, p2, o2, label, 0, p); Emit.Op ("\002};\n"); END CompileArray; PROCEDURE GenShapeCheck (i1, e1: Type.T; p1: String.T; i2, e2: Type.T; p2, label: String.T; n: INTEGER) = BEGIN IF (i1 = NIL) AND (i2 = NIL) THEN Emit.OpSI ("if (@.size[@] ", p1, n); Emit.OpSI ("!= @.size[@])", p2, n); Emit.OpS (" goto @;\n", label); ELSIF (i1 = NIL) THEN Emit.OpSI ("if (@.size[@]", p1, n); Emit.OpIS (" != @) goto @;\n", Type.Number (i2), label); ELSIF (i2 = NIL) THEN Emit.OpIS ("if (@ != @.", Type.Number (i1), p2); Emit.OpIS ("size[@]) goto @;\n", n, label); ELSE RETURN; END; e1 := NamedType.Strip (e1); e2 := NamedType.Strip (e2); IF ArrayType.Split (e1, i1, e1) AND ArrayType.Split (e2, i2, e2) THEN GenShapeCheck (i1, e1, p1, i2, e2, p2, label, n+1); END; END GenShapeCheck; PROCEDURE GenValueCheck (i1, e1: Type.T; p1, o1: String.T; i2, e2: Type.T; p2, o2, label: String.T; n: INTEGER; p: P) = VAR loopVar, v1, v2: String.T; j1, j2: Type.T; BEGIN loopVar := String.Unique (String.Add ("init")); IF (i1 = NIL) AND (i2 = NIL) THEN Emit.OpS ("{\001\nint @;\n", loopVar); Emit.OpSS ("for (@ = 0; @ < ", loopVar, loopVar); Emit.OpSI ("@.size[@]; ", p1, n); Emit.OpS ("@++) {\001\n", loopVar); v1 := o1; v2 := o2; ELSIF (i1 = NIL) THEN Emit.OpS ("{\001\nint @;\n", loopVar); Emit.OpSS ("for (@ = 0; @ < ", loopVar, loopVar); Emit.OpIS ("@; @++) {\001\n", Type.Number (i2), loopVar); v1 := o1; v2 := String.Unique (String.Add ("b")); Emit.OpIS ("t@ *@ = ", Type.Name (e2), v2); Emit.OpSS ("(@).elts + @;\n", o2, loopVar); v2 := String.Concat (String.Add ("*"), v2); ELSIF (i2 = NIL) THEN Emit.OpS ("{\001\nint @;\n", loopVar); Emit.OpSS ("for (@ = 0; @ < ", loopVar, loopVar); Emit.OpIS ("@; @++) {\001\n", Type.Number (i1), loopVar); v1 := String.Unique (String.Add ("a")); Emit.OpIS ("t@ *@ = ", Type.Name (e1), v1); Emit.OpSS ("(@).elts + @;\n", o1, loopVar); v1 := String.Concat (String.Add ("*"), v1); v2 := o2; ELSE Emit.OpS ("{\001\nint @;\n", loopVar); Emit.OpSS ("for (@ = 0; @ < ", loopVar, loopVar); Emit.OpIS ("@; @++) {\001\n", Type.Number (i1), loopVar); v1 := String.Unique (String.Add ("a")); Emit.OpIS ("t@ *@ = ", Type.Name (e1), v1); Emit.OpSS ("(@).elts + @;\n", o1, loopVar); v1 := String.Concat (String.Add ("*"), v1); v2 := String.Unique (String.Add ("b")); Emit.OpIS ("t@ *@ = ", Type.Name (e2), v2); Emit.OpSS ("(@).elts + @;\n", o2, loopVar); v2 := String.Concat (String.Add ("*"), v2); END; e1 := NamedType.Strip (e1); e2 := NamedType.Strip (e2); IF ArrayType.Split (e1, j1, e1) AND ArrayType.Split (e2, j2, e2) THEN GenValueCheck (j1, e1, p1, v1, j2, e2, p2, v2, label, n+1, p); IF (i1 = NIL) AND (j1 # NIL) THEN Emit.Op ("arg11++;\n"); END; IF (i2 = NIL) AND (j2 # NIL) THEN Emit.Op ("arg22++;\n"); END; ELSE CompileTest (e1, e2, v1, v2, label, p); IF (i1 = NIL) THEN Emit.Op ("arg11++;\n"); END; IF (i2 = NIL) THEN Emit.Op ("arg22++;\n"); END; END; Emit.Op ("\002};\n\002};\n"); END GenValueCheck; PROCEDURE CompileRecord (f: Scope.T; p1, p2, label: String.T; p: P) = VAR fields : Scope.ValueList; n, j : INTEGER; type : Type.T; default : Expr.T; BEGIN p1 := String.Concat (String.Add ("("), p1); p1 := String.Concat (p1, String.Add (")._")); p2 := String.Concat (String.Add ("("), p2); p2 := String.Concat (p2, String.Add (")._")); Scope.ToList (f, fields, n); FOR i := 0 TO n-1 DO VAR b: BOOLEAN := Field.Split (fields[i], j, type, default); BEGIN <* ASSERT b *> END; CompileTest (type, type, String.Concat (p1, fields[i].name), String.Concat (p2, fields[i].name), label, p); END; END CompileRecord; 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 RealExpr.Compare (e1, e2, s) OR LongrealExpr.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 = CompareExpr.Op.EQ) = (s = 0)]; END; RETURN NIL; END Fold; PROCEDURE FPrinter (p: P; map: Type.Map; wr: Wr.T) = BEGIN IF p.eq = CompareExpr.Op.EQ THEN Wr.PutText (wr, "= ") ELSE Wr.PutText (wr, "# ") END; Expr.Fingerprint (p.a, map, wr); Expr.Fingerprint (p.b, map, wr); END FPrinter; BEGIN END EqualExpr.