+#include "tree-ssa-propagate.h"
+#include "diagnostic.h"
+
+
+/* For each complex ssa name, a lattice value. We're interested in finding
+ out whether a complex number is degenerate in some way, having only real
+ or only complex parts. */
+
+typedef enum
+{
+ UNINITIALIZED = 0,
+ ONLY_REAL = 1,
+ ONLY_IMAG = 2,
+ VARYING = 3
+} complex_lattice_t;
+
+#define PAIR(a, b) ((a) << 2 | (b))
+
+DEF_VEC_I(complex_lattice_t);
+DEF_VEC_ALLOC_I(complex_lattice_t, heap);
+
+static VEC(complex_lattice_t, heap) *complex_lattice_values;
+
+/* For each complex variable, a pair of variables for the components exists in
+ the hashtable. */
+static htab_t complex_variable_components;
+
+/* For each complex SSA_NAME, a pair of ssa names for the components. */
+static VEC(tree, heap) *complex_ssa_name_components;
+
+/* Lookup UID in the complex_variable_components hashtable and return the
+ associated tree. */
+static tree
+cvc_lookup (unsigned int uid)
+{
+ struct int_tree_map *h, in;
+ in.uid = uid;
+ h = htab_find_with_hash (complex_variable_components, &in, uid);
+ return h ? h->to : NULL;
+}
+
+/* Insert the pair UID, TO into the complex_variable_components hashtable. */
+
+static void
+cvc_insert (unsigned int uid, tree to)
+{
+ struct int_tree_map *h;
+ void **loc;
+
+ h = xmalloc (sizeof (struct int_tree_map));
+ h->uid = uid;
+ h->to = to;
+ loc = htab_find_slot_with_hash (complex_variable_components, h,
+ uid, INSERT);
+ *(struct int_tree_map **) loc = h;
+}
+
+/* Return true if T is not a zero constant. In the case of real values,
+ we're only interested in +0.0. */
+
+static int
+some_nonzerop (tree t)
+{
+ int zerop = false;
+
+ if (TREE_CODE (t) == REAL_CST)
+ zerop = REAL_VALUES_IDENTICAL (TREE_REAL_CST (t), dconst0);
+ else if (TREE_CODE (t) == INTEGER_CST)
+ zerop = integer_zerop (t);
+
+ return !zerop;
+}
+
+/* Compute a lattice value from T. It may be a gimple_val, or, as a
+ special exception, a COMPLEX_EXPR. */
+
+static complex_lattice_t
+find_lattice_value (tree t)
+{
+ tree real, imag;
+ int r, i;
+ complex_lattice_t ret;
+
+ switch (TREE_CODE (t))
+ {
+ case SSA_NAME:
+ return VEC_index (complex_lattice_t, complex_lattice_values,
+ SSA_NAME_VERSION (t));
+
+ case COMPLEX_CST:
+ real = TREE_REALPART (t);
+ imag = TREE_IMAGPART (t);
+ break;
+
+ case COMPLEX_EXPR:
+ real = TREE_OPERAND (t, 0);
+ imag = TREE_OPERAND (t, 1);
+ break;
+
+ default:
+ gcc_unreachable ();
+ }
+
+ r = some_nonzerop (real);
+ i = some_nonzerop (imag);
+ ret = r*ONLY_REAL + i*ONLY_IMAG;
+
+ /* ??? On occasion we could do better than mapping 0+0i to real, but we
+ certainly don't want to leave it UNINITIALIZED, which eventually gets
+ mapped to VARYING. */
+ if (ret == UNINITIALIZED)
+ ret = ONLY_REAL;
+
+ return ret;
+}
+
+/* Determine if LHS is something for which we're interested in seeing
+ simulation results. */
+
+static bool
+is_complex_reg (tree lhs)
+{
+ return TREE_CODE (TREE_TYPE (lhs)) == COMPLEX_TYPE && is_gimple_reg (lhs);
+}
+
+/* Mark the incoming parameters to the function as VARYING. */
+
+static void
+init_parameter_lattice_values (void)
+{
+ tree parm;
+
+ for (parm = DECL_ARGUMENTS (cfun->decl); parm ; parm = TREE_CHAIN (parm))
+ if (is_complex_reg (parm) && var_ann (parm) != NULL)
+ {
+ tree ssa_name = default_def (parm);
+ VEC_replace (complex_lattice_t, complex_lattice_values,
+ SSA_NAME_VERSION (ssa_name), VARYING);
+ }
+}
+
+/* Initialize DONT_SIMULATE_AGAIN for each stmt and phi. Return false if
+ we found no statements we want to simulate, and thus there's nothing for
+ the entire pass to do. */
+
+static bool
+init_dont_simulate_again (void)
+{
+ basic_block bb;
+ block_stmt_iterator bsi;
+ tree phi;
+ bool saw_a_complex_op = false;
+
+ FOR_EACH_BB (bb)
+ {
+ for (phi = phi_nodes (bb); phi; phi = PHI_CHAIN (phi))
+ DONT_SIMULATE_AGAIN (phi) = !is_complex_reg (PHI_RESULT (phi));
+
+ for (bsi = bsi_start (bb); !bsi_end_p (bsi); bsi_next (&bsi))
+ {
+ tree orig_stmt, stmt, rhs = NULL;
+ bool dsa;
+
+ orig_stmt = stmt = bsi_stmt (bsi);
+
+ /* Most control-altering statements must be initially
+ simulated, else we won't cover the entire cfg. */
+ dsa = !stmt_ends_bb_p (stmt);
+
+ switch (TREE_CODE (stmt))
+ {
+ case RETURN_EXPR:
+ /* We don't care what the lattice value of <retval> is,
+ since it's never used as an input to another computation. */
+ dsa = true;
+ stmt = TREE_OPERAND (stmt, 0);
+ if (!stmt || TREE_CODE (stmt) != MODIFY_EXPR)
+ break;
+ /* FALLTHRU */
+
+ case MODIFY_EXPR:
+ dsa = !is_complex_reg (TREE_OPERAND (stmt, 0));
+ rhs = TREE_OPERAND (stmt, 1);
+ break;
+
+ case COND_EXPR:
+ rhs = TREE_OPERAND (stmt, 0);
+ break;
+
+ default:
+ break;
+ }
+
+ if (rhs)
+ switch (TREE_CODE (rhs))
+ {
+ case EQ_EXPR:
+ case NE_EXPR:
+ rhs = TREE_OPERAND (rhs, 0);
+ /* FALLTHRU */
+
+ case PLUS_EXPR:
+ case MINUS_EXPR:
+ case MULT_EXPR:
+ case TRUNC_DIV_EXPR:
+ case CEIL_DIV_EXPR:
+ case FLOOR_DIV_EXPR:
+ case ROUND_DIV_EXPR:
+ case RDIV_EXPR:
+ case NEGATE_EXPR:
+ case CONJ_EXPR:
+ if (TREE_CODE (TREE_TYPE (rhs)) == COMPLEX_TYPE)
+ saw_a_complex_op = true;
+ break;
+
+ default:
+ break;
+ }
+
+ DONT_SIMULATE_AGAIN (orig_stmt) = dsa;
+ }
+ }
+
+ return saw_a_complex_op;
+}
+
+
+/* Evaluate statement STMT against the complex lattice defined above. */
+
+static enum ssa_prop_result
+complex_visit_stmt (tree stmt, edge *taken_edge_p ATTRIBUTE_UNUSED,
+ tree *result_p)
+{
+ complex_lattice_t new_l, old_l, op1_l, op2_l;
+ unsigned int ver;
+ tree lhs, rhs;
+
+ if (TREE_CODE (stmt) != MODIFY_EXPR)
+ return SSA_PROP_VARYING;
+
+ lhs = TREE_OPERAND (stmt, 0);
+ rhs = TREE_OPERAND (stmt, 1);
+
+ /* These conditions should be satisfied due to the initial filter
+ set up in init_dont_simulate_again. */
+ gcc_assert (TREE_CODE (lhs) == SSA_NAME);
+ gcc_assert (TREE_CODE (TREE_TYPE (lhs)) == COMPLEX_TYPE);
+
+ *result_p = lhs;
+ ver = SSA_NAME_VERSION (lhs);
+ old_l = VEC_index (complex_lattice_t, complex_lattice_values, ver);
+
+ switch (TREE_CODE (rhs))
+ {
+ case SSA_NAME:
+ case COMPLEX_EXPR:
+ case COMPLEX_CST:
+ new_l = find_lattice_value (rhs);
+ break;
+
+ case PLUS_EXPR:
+ case MINUS_EXPR:
+ op1_l = find_lattice_value (TREE_OPERAND (rhs, 0));
+ op2_l = find_lattice_value (TREE_OPERAND (rhs, 1));
+
+ /* We've set up the lattice values such that IOR neatly
+ models addition. */
+ new_l = op1_l | op2_l;
+ break;
+
+ case MULT_EXPR:
+ case RDIV_EXPR:
+ case TRUNC_DIV_EXPR:
+ case CEIL_DIV_EXPR:
+ case FLOOR_DIV_EXPR:
+ case ROUND_DIV_EXPR:
+ op1_l = find_lattice_value (TREE_OPERAND (rhs, 0));
+ op2_l = find_lattice_value (TREE_OPERAND (rhs, 1));
+
+ /* Obviously, if either varies, so does the result. */
+ if (op1_l == VARYING || op2_l == VARYING)
+ new_l = VARYING;
+ /* Don't prematurely promote variables if we've not yet seen
+ their inputs. */
+ else if (op1_l == UNINITIALIZED)
+ new_l = op2_l;
+ else if (op2_l == UNINITIALIZED)
+ new_l = op1_l;
+ else
+ {
+ /* At this point both numbers have only one component. If the
+ numbers are of opposite kind, the result is imaginary,
+ otherwise the result is real. The add/subtract translates
+ the real/imag from/to 0/1; the ^ performs the comparison. */
+ new_l = ((op1_l - ONLY_REAL) ^ (op2_l - ONLY_REAL)) + ONLY_REAL;
+
+ /* Don't allow the lattice value to flip-flop indefinitely. */
+ new_l |= old_l;
+ }
+ break;
+
+ case NEGATE_EXPR:
+ case CONJ_EXPR:
+ new_l = find_lattice_value (TREE_OPERAND (rhs, 0));
+ break;
+
+ default:
+ new_l = VARYING;
+ break;
+ }
+
+ /* If nothing changed this round, let the propagator know. */
+ if (new_l == old_l)
+ return SSA_PROP_NOT_INTERESTING;
+
+ VEC_replace (complex_lattice_t, complex_lattice_values, ver, new_l);
+ return new_l == VARYING ? SSA_PROP_VARYING : SSA_PROP_INTERESTING;
+}
+
+/* Evaluate a PHI node against the complex lattice defined above. */
+
+static enum ssa_prop_result
+complex_visit_phi (tree phi)
+{
+ complex_lattice_t new_l, old_l;
+ unsigned int ver;
+ tree lhs;
+ int i;
+
+ lhs = PHI_RESULT (phi);
+
+ /* This condition should be satisfied due to the initial filter
+ set up in init_dont_simulate_again. */
+ gcc_assert (TREE_CODE (TREE_TYPE (lhs)) == COMPLEX_TYPE);
+
+ /* We've set up the lattice values such that IOR neatly models PHI meet. */
+ new_l = UNINITIALIZED;
+ for (i = PHI_NUM_ARGS (phi) - 1; i >= 0; --i)
+ new_l |= find_lattice_value (PHI_ARG_DEF (phi, i));
+
+ ver = SSA_NAME_VERSION (lhs);
+ old_l = VEC_index (complex_lattice_t, complex_lattice_values, ver);
+
+ if (new_l == old_l)
+ return SSA_PROP_NOT_INTERESTING;
+
+ VEC_replace (complex_lattice_t, complex_lattice_values, ver, new_l);
+ return new_l == VARYING ? SSA_PROP_VARYING : SSA_PROP_INTERESTING;
+}
+
+/* Create one backing variable for a complex component of ORIG. */
+
+static tree
+create_one_component_var (tree type, tree orig, const char *prefix,
+ const char *suffix, enum tree_code code)
+{
+ tree r = create_tmp_var (type, prefix);
+ add_referenced_tmp_var (r);
+
+ DECL_SOURCE_LOCATION (r) = DECL_SOURCE_LOCATION (orig);
+ DECL_ARTIFICIAL (r) = 1;
+
+ if (DECL_NAME (orig) && !DECL_IGNORED_P (orig))
+ {
+ const char *name = IDENTIFIER_POINTER (DECL_NAME (orig));
+ tree inner_type;
+
+ DECL_NAME (r) = get_identifier (ACONCAT ((name, suffix, NULL)));
+
+ inner_type = TREE_TYPE (TREE_TYPE (orig));
+ SET_DECL_DEBUG_EXPR (r, build1 (code, type, orig));
+ DECL_DEBUG_EXPR_IS_FROM (r) = 1;
+ DECL_IGNORED_P (r) = 0;
+ TREE_NO_WARNING (r) = TREE_NO_WARNING (orig);
+ }
+ else
+ {
+ DECL_IGNORED_P (r) = 1;
+ TREE_NO_WARNING (r) = 1;
+ }
+
+ return r;
+}
+
+/* Retrieve a value for a complex component of VAR. */
+
+static tree
+get_component_var (tree var, bool imag_p)
+{
+ size_t decl_index = DECL_UID (var) * 2 + imag_p;
+ tree ret = cvc_lookup (decl_index);
+
+ if (ret == NULL)
+ {
+ ret = create_one_component_var (TREE_TYPE (TREE_TYPE (var)), var,
+ imag_p ? "CI" : "CR",
+ imag_p ? "$imag" : "$real",
+ imag_p ? IMAGPART_EXPR : REALPART_EXPR);
+ cvc_insert (decl_index, ret);
+ }
+
+ return ret;
+}