OSDN Git Service

* gcc-interface/gigi.h (gnat_mark_addressable): Rename parameter.
[pf3gnuchains/gcc-fork.git] / gcc / ada / gcc-interface / utils2.c
index 2998605..5db38c5 100644 (file)
@@ -242,11 +242,11 @@ find_common_type (tree t1, tree t2)
 static tree
 compare_arrays (tree result_type, tree a1, tree a2)
 {
-  tree result = convert (result_type, boolean_true_node);
-  tree a1_is_null = convert (result_type, boolean_false_node);
-  tree a2_is_null = convert (result_type, boolean_false_node);
   tree t1 = TREE_TYPE (a1);
   tree t2 = TREE_TYPE (a2);
+  tree result = convert (result_type, integer_one_node);
+  tree a1_is_null = convert (result_type, integer_zero_node);
+  tree a2_is_null = convert (result_type, integer_zero_node);
   bool a1_side_effects_p = TREE_SIDE_EFFECTS (a1);
   bool a2_side_effects_p = TREE_SIDE_EFFECTS (a2);
   bool length_zero_p = false;
@@ -254,33 +254,34 @@ compare_arrays (tree result_type, tree a1, tree a2)
   /* If either operand has side-effects, they have to be evaluated only once
      in spite of the multiple references to the operand in the comparison.  */
   if (a1_side_effects_p)
-    a1 = gnat_protect_expr (a1);
+    a1 = protect_multiple_eval (a1);
 
   if (a2_side_effects_p)
-    a2 = gnat_protect_expr (a2);
+    a2 = protect_multiple_eval (a2);
 
   /* Process each dimension separately and compare the lengths.  If any
-     dimension has a length known to be zero, set LENGTH_ZERO_P to true
-     in order to suppress the comparison of the data at the end.  */
+     dimension has a size known to be zero, set SIZE_ZERO_P to 1 to
+     suppress the comparison of the data.  */
   while (TREE_CODE (t1) == ARRAY_TYPE && TREE_CODE (t2) == ARRAY_TYPE)
     {
       tree lb1 = TYPE_MIN_VALUE (TYPE_DOMAIN (t1));
       tree ub1 = TYPE_MAX_VALUE (TYPE_DOMAIN (t1));
       tree lb2 = TYPE_MIN_VALUE (TYPE_DOMAIN (t2));
       tree ub2 = TYPE_MAX_VALUE (TYPE_DOMAIN (t2));
-      tree length1 = size_binop (PLUS_EXPR, size_binop (MINUS_EXPR, ub1, lb1),
-                                size_one_node);
-      tree length2 = size_binop (PLUS_EXPR, size_binop (MINUS_EXPR, ub2, lb2),
-                                size_one_node);
+      tree bt = get_base_type (TREE_TYPE (lb1));
+      tree length1 = fold_build2 (MINUS_EXPR, bt, ub1, lb1);
+      tree length2 = fold_build2 (MINUS_EXPR, bt, ub2, lb2);
       tree comparison, this_a1_is_null, this_a2_is_null;
+      tree nbt, tem;
+      bool btem;
 
       /* If the length of the first array is a constant, swap our operands
-        unless the length of the second array is the constant zero.  */
-      if (TREE_CODE (length1) == INTEGER_CST && !integer_zerop (length2))
+        unless the length of the second array is the constant zero.
+        Note that we have set the `length' values to the length - 1.  */
+      if (TREE_CODE (length1) == INTEGER_CST
+         && !integer_zerop (fold_build2 (PLUS_EXPR, bt, length2,
+                                         convert (bt, integer_one_node))))
        {
-         tree tem;
-         bool btem;
-
          tem = a1, a1 = a2, a2 = tem;
          tem = t1, t1 = t2, t2 = tem;
          tem = lb1, lb1 = lb2, lb2 = tem;
@@ -291,56 +292,51 @@ compare_arrays (tree result_type, tree a1, tree a2)
          a2_side_effects_p = btem;
        }
 
-      /* If the length of the second array is the constant zero, we can just
-        use the original stored bounds for the first array and see whether
-        last < first holds.  */
-      if (integer_zerop (length2))
+      /* If the length of this dimension in the second array is the constant
+        zero, we can just go inside the original bounds for the first
+        array and see if last < first.  */
+      if (integer_zerop (fold_build2 (PLUS_EXPR, bt, length2,
+                                     convert (bt, integer_one_node))))
        {
-         length_zero_p = true;
-
-         ub1 = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
-         lb1 = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
+         tree ub = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
+         tree lb = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
 
-         comparison = build_binary_op (LT_EXPR, result_type, ub1, lb1);
+         comparison = build_binary_op (LT_EXPR, result_type, ub, lb);
          comparison = SUBSTITUTE_PLACEHOLDER_IN_EXPR (comparison, a1);
-         if (EXPR_P (comparison))
-           SET_EXPR_LOCATION (comparison, input_location);
+         length1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (length1, a1);
 
+         length_zero_p = true;
          this_a1_is_null = comparison;
-         this_a2_is_null = convert (result_type, boolean_true_node);
+         this_a2_is_null = convert (result_type, integer_one_node);
        }
 
-      /* Otherwise, if the length is some other constant value, we know that
-        this dimension in the second array cannot be superflat, so we can
-        just use its length computed from the actual stored bounds.  */
+      /* If the length is some other constant value, we know that the
+        this dimension in the first array cannot be superflat, so we
+        can just use its length from the actual stored bounds.  */
       else if (TREE_CODE (length2) == INTEGER_CST)
        {
-         tree bt;
-
          ub1 = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
          lb1 = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
-         /* Note that we know that UB2 and LB2 are constant and hence
-            cannot contain a PLACEHOLDER_EXPR.  */
          ub2 = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t2)));
          lb2 = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t2)));
-         bt = get_base_type (TREE_TYPE (ub1));
+         nbt = get_base_type (TREE_TYPE (ub1));
 
          comparison
            = build_binary_op (EQ_EXPR, result_type,
-                              build_binary_op (MINUS_EXPR, bt, ub1, lb1),
-                              build_binary_op (MINUS_EXPR, bt, ub2, lb2));
+                              build_binary_op (MINUS_EXPR, nbt, ub1, lb1),
+                              build_binary_op (MINUS_EXPR, nbt, ub2, lb2));
+
+         /* Note that we know that UB2 and LB2 are constant and hence
+            cannot contain a PLACEHOLDER_EXPR.  */
+
          comparison = SUBSTITUTE_PLACEHOLDER_IN_EXPR (comparison, a1);
-         if (EXPR_P (comparison))
-           SET_EXPR_LOCATION (comparison, input_location);
+         length1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (length1, a1);
 
          this_a1_is_null = build_binary_op (LT_EXPR, result_type, ub1, lb1);
-         if (EXPR_P (this_a1_is_null))
-           SET_EXPR_LOCATION (this_a1_is_null, input_location);
-
-         this_a2_is_null = convert (result_type, boolean_false_node);
+         this_a2_is_null = convert (result_type, integer_zero_node);
        }
 
-      /* Otherwise, compare the computed lengths.  */
+      /* Otherwise compare the computed lengths.  */
       else
        {
          length1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (length1, a1);
@@ -348,39 +344,20 @@ compare_arrays (tree result_type, tree a1, tree a2)
 
          comparison
            = build_binary_op (EQ_EXPR, result_type, length1, length2);
-         if (EXPR_P (comparison))
-           SET_EXPR_LOCATION (comparison, input_location);
-
-         /* If the length expression is of the form (cond ? val : 0), assume
-            that cond is equivalent to (length != 0).  That's guaranteed by
-            construction of the array types in gnat_to_gnu_entity.  */
-         if (TREE_CODE (length1) == COND_EXPR
-             && integer_zerop (TREE_OPERAND (length1, 2)))
-           this_a1_is_null = invert_truthvalue (TREE_OPERAND (length1, 0));
-         else
-           this_a1_is_null = build_binary_op (EQ_EXPR, result_type, length1,
-                                              size_zero_node);
-          if (EXPR_P (this_a1_is_null))
-           SET_EXPR_LOCATION (this_a1_is_null, input_location);
-
-         /* Likewise for the second array.  */
-         if (TREE_CODE (length2) == COND_EXPR
-             && integer_zerop (TREE_OPERAND (length2, 2)))
-           this_a2_is_null = invert_truthvalue (TREE_OPERAND (length2, 0));
-         else
-           this_a2_is_null = build_binary_op (EQ_EXPR, result_type, length2,
-                                              size_zero_node);
-          if (EXPR_P (this_a2_is_null))
-           SET_EXPR_LOCATION (this_a2_is_null, input_location);
+
+         this_a1_is_null
+           = build_binary_op (LT_EXPR, result_type, length1,
+                              convert (bt, integer_zero_node));
+         this_a2_is_null
+           = build_binary_op (LT_EXPR, result_type, length2,
+                              convert (bt, integer_zero_node));
        }
 
-      /* Append expressions for this dimension to the final expressions.  */
       result = build_binary_op (TRUTH_ANDIF_EXPR, result_type,
                                result, comparison);
 
       a1_is_null = build_binary_op (TRUTH_ORIF_EXPR, result_type,
                                    this_a1_is_null, a1_is_null);
-
       a2_is_null = build_binary_op (TRUTH_ORIF_EXPR, result_type,
                                    this_a2_is_null, a2_is_null);
 
@@ -388,12 +365,11 @@ compare_arrays (tree result_type, tree a1, tree a2)
       t2 = TREE_TYPE (t2);
     }
 
-  /* Unless the length of some dimension is known to be zero, compare the
+  /* Unless the size of some bound is known to be zero, compare the
      data in the array.  */
   if (!length_zero_p)
     {
       tree type = find_common_type (TREE_TYPE (a1), TREE_TYPE (a2));
-      tree comparison;
 
       if (type)
        {
@@ -401,12 +377,8 @@ compare_arrays (tree result_type, tree a1, tree a2)
          a2 = convert (type, a2);
        }
 
-      comparison = fold_build2 (EQ_EXPR, result_type, a1, a2);
-      if (EXPR_P (comparison))
-       SET_EXPR_LOCATION (comparison, input_location);
-
-      result
-       = build_binary_op (TRUTH_ANDIF_EXPR, result_type, result, comparison);
+      result = build_binary_op (TRUTH_ANDIF_EXPR, result_type, result,
+                               fold_build2 (EQ_EXPR, result_type, a1, a2));
     }
 
   /* The result is also true if both sizes are zero.  */
@@ -499,9 +471,9 @@ nonbinary_modular_operation (enum tree_code op_code, tree type, tree lhs,
   /* For subtraction, add the modulus back if we are negative.  */
   else if (op_code == MINUS_EXPR)
     {
-      result = gnat_protect_expr (result);
+      result = protect_multiple_eval (result);
       result = fold_build3 (COND_EXPR, op_type,
-                           fold_build2 (LT_EXPR, boolean_type_node, result,
+                           fold_build2 (LT_EXPR, integer_type_node, result,
                                         convert (op_type, integer_zero_node)),
                            fold_build2 (PLUS_EXPR, op_type, result, modulus),
                            result);
@@ -510,9 +482,9 @@ nonbinary_modular_operation (enum tree_code op_code, tree type, tree lhs,
   /* For the other operations, subtract the modulus if we are >= it.  */
   else
     {
-      result = gnat_protect_expr (result);
+      result = protect_multiple_eval (result);
       result = fold_build3 (COND_EXPR, op_type,
-                           fold_build2 (GE_EXPR, boolean_type_node,
+                           fold_build2 (GE_EXPR, integer_type_node,
                                         result, modulus),
                            fold_build2 (MINUS_EXPR, op_type,
                                         result, modulus),
@@ -726,28 +698,16 @@ build_binary_op (enum tree_code op_code, tree result_type,
       modulus = NULL_TREE;
       break;
 
-    case TRUTH_ANDIF_EXPR:
-    case TRUTH_ORIF_EXPR:
-    case TRUTH_AND_EXPR:
-    case TRUTH_OR_EXPR:
-    case TRUTH_XOR_EXPR:
-#ifdef ENABLE_CHECKING
-      gcc_assert (TREE_CODE (get_base_type (result_type)) == BOOLEAN_TYPE);
-#endif
-      operation_type = left_base_type;
-      left_operand = convert (operation_type, left_operand);
-      right_operand = convert (operation_type, right_operand);
-      break;
-
     case GE_EXPR:
     case LE_EXPR:
     case GT_EXPR:
     case LT_EXPR:
+      gcc_assert (!POINTER_TYPE_P (left_type));
+
+      /* ... fall through ... */
+
     case EQ_EXPR:
     case NE_EXPR:
-#ifdef ENABLE_CHECKING
-      gcc_assert (TREE_CODE (get_base_type (result_type)) == BOOLEAN_TYPE);
-#endif
       /* If either operand is a NULL_EXPR, just return a new one.  */
       if (TREE_CODE (left_operand) == NULL_EXPR)
        return build2 (op_code, result_type,
@@ -864,6 +824,13 @@ build_binary_op (enum tree_code op_code, tree result_type,
       modulus = NULL_TREE;
       break;
 
+    case PREINCREMENT_EXPR:
+    case PREDECREMENT_EXPR:
+    case POSTINCREMENT_EXPR:
+    case POSTDECREMENT_EXPR:
+      /* These operations are not used anymore.  */
+      gcc_unreachable ();
+
     case LSHIFT_EXPR:
     case RSHIFT_EXPR:
     case LROTATE_EXPR:
@@ -1016,9 +983,7 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
       break;
 
     case TRUTH_NOT_EXPR:
-#ifdef ENABLE_CHECKING
-      gcc_assert (TREE_CODE (get_base_type (result_type)) == BOOLEAN_TYPE);
-#endif
+      gcc_assert (result_type == base_type);
       result = invert_truthvalue (operand);
       break;
 
@@ -1060,28 +1025,13 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
          TREE_TYPE (result) = type = build_pointer_type (type);
          break;
 
-       case COMPOUND_EXPR:
-         /* Fold a compound expression if it has unconstrained array type
-            since the middle-end cannot handle it.  But we don't it in the
-            general case because it may introduce aliasing issues if the
-            first operand is an indirect assignment and the second operand
-            the corresponding address, e.g. for an allocator.  */
-         if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
-           {
-             result = build_unary_op (ADDR_EXPR, result_type,
-                                      TREE_OPERAND (operand, 1));
-             result = build2 (COMPOUND_EXPR, TREE_TYPE (result),
-                              TREE_OPERAND (operand, 0), result);
-             break;
-           }
-         goto common;
-
        case ARRAY_REF:
        case ARRAY_RANGE_REF:
        case COMPONENT_REF:
        case BIT_FIELD_REF:
-           /* If this is for 'Address, find the address of the prefix and add
-              the offset to the field.  Otherwise, do this the normal way.  */
+           /* If this is for 'Address, find the address of the prefix and
+              add the offset to the field.  Otherwise, do this the normal
+              way.  */
          if (op_code == ATTR_ADDR_EXPR)
            {
              HOST_WIDE_INT bitsize;
@@ -1108,6 +1058,11 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
              if (!offset)
                offset = size_zero_node;
 
+             if (bitpos % BITS_PER_UNIT != 0)
+               post_error
+                 ("taking address of object not aligned on storage unit?",
+                  error_gnat_node);
+
              offset = size_binop (PLUS_EXPR, offset,
                                   size_int (bitpos / BITS_PER_UNIT));
 
@@ -1182,17 +1137,21 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
              operand = convert (type, operand);
            }
 
+         if (type != error_mark_node)
+           operation_type = build_pointer_type (type);
+
          gnat_mark_addressable (operand);
-         result = build_fold_addr_expr (operand);
+         result = fold_build1 (ADDR_EXPR, operation_type, operand);
        }
 
       TREE_CONSTANT (result) = staticp (operand) || TREE_CONSTANT (operand);
       break;
 
     case INDIRECT_REF:
-      /* If we want to refer to an unconstrained array, use the appropriate
-        expression to do so.  This will never survive down to the back-end.
-        But if TYPE is a thin pointer, first convert to a fat pointer.  */
+      /* If we want to refer to an entire unconstrained array,
+        make up an expression to do so.  This will never survive to
+        the backend.  If TYPE is a thin pointer, first convert the
+        operand to a fat pointer.  */
       if (TYPE_IS_THIN_POINTER_P (type)
          && TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (type)))
        {
@@ -1209,15 +1168,12 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
          TREE_READONLY (result)
            = TYPE_READONLY (TYPE_UNCONSTRAINED_ARRAY (type));
        }
-
-      /* If we are dereferencing an ADDR_EXPR, return its operand.  */
       else if (TREE_CODE (operand) == ADDR_EXPR)
        result = TREE_OPERAND (operand, 0);
 
-      /* Otherwise, build and fold the indirect reference.  */
       else
        {
-         result = build_fold_indirect_ref (operand);
+         result = fold_build1 (op_code, TREE_TYPE (type), operand);
          TREE_READONLY (result) = TYPE_READONLY (TREE_TYPE (type));
        }
 
@@ -1270,7 +1226,7 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
 
                result = fold_build3 (COND_EXPR, operation_type,
                                      fold_build2 (NE_EXPR,
-                                                  boolean_type_node,
+                                                  integer_type_node,
                                                   operand,
                                                   convert
                                                     (operation_type,
@@ -1335,9 +1291,8 @@ build_cond_expr (tree result_type, tree condition_operand,
   true_operand = convert (result_type, true_operand);
   false_operand = convert (result_type, false_operand);
 
-  /* If the result type is unconstrained, take the address of the operands and
-     then dereference the result.  Likewise if the result type is passed by
-     reference, but this is natively handled in the gimplifier.  */
+  /* If the result type is unconstrained, take the address of the operands
+     and then dereference our result.  */
   if (TREE_CODE (result_type) == UNCONSTRAINED_ARRAY_TYPE
       || CONTAINS_PLACEHOLDER_P (TYPE_SIZE (result_type)))
     {
@@ -1505,13 +1460,12 @@ build_call_raise (int msg, Node_Id gnat_node, char kind)
     = (gnat_node != Empty && Sloc (gnat_node) != No_Location)
       ? Get_Logical_Line_Number (Sloc(gnat_node)) : input_line;
 
-  TREE_TYPE (filename) = build_array_type (unsigned_char_type_node,
-                                          build_index_type (size_int (len)));
+  TREE_TYPE (filename)
+    = build_array_type (char_type_node, build_index_type (size_int (len)));
 
   return
     build_call_2_expr (fndecl,
-                      build1 (ADDR_EXPR,
-                              build_pointer_type (unsigned_char_type_node),
+                      build1 (ADDR_EXPR, build_pointer_type (char_type_node),
                               filename),
                       build_int_cst (NULL_TREE, line_number));
 }
@@ -1632,15 +1586,22 @@ build_simple_component_ref (tree record_variable, tree component,
       tree new_field;
 
       /* First loop thru normal components.  */
+
       for (new_field = TYPE_FIELDS (record_type); new_field;
           new_field = TREE_CHAIN (new_field))
-       if (SAME_FIELD_P (field, new_field))
+       if (field == new_field
+           || DECL_ORIGINAL_FIELD (new_field) == field
+           || new_field == DECL_ORIGINAL_FIELD (field)
+           || (DECL_ORIGINAL_FIELD (field)
+               && (DECL_ORIGINAL_FIELD (field)
+                   == DECL_ORIGINAL_FIELD (new_field))))
          break;
 
       /* Next, loop thru DECL_INTERNAL_P components if we haven't found
          the component in the first search. Doing this search in 2 steps
          is required to avoiding hidden homonymous fields in the
          _Parent field.  */
+
       if (!new_field)
        for (new_field = TYPE_FIELDS (record_type); new_field;
             new_field = TREE_CHAIN (new_field))
@@ -1839,7 +1800,7 @@ maybe_wrap_malloc (tree data_size, tree data_type, Node_Id gnat_node)
     {
       /* Latch malloc's return value and get a pointer to the aligning field
         first.  */
-      tree storage_ptr = gnat_protect_expr (malloc_ptr);
+      tree storage_ptr = protect_multiple_eval (malloc_ptr);
 
       tree aligning_record_addr
        = convert (build_pointer_type (aligning_type), storage_ptr);
@@ -1849,7 +1810,7 @@ maybe_wrap_malloc (tree data_size, tree data_type, Node_Id gnat_node)
 
       tree aligning_field
        = build_component_ref (aligning_record, NULL_TREE,
-                              TYPE_FIELDS (aligning_type), false);
+                              TYPE_FIELDS (aligning_type), 0);
 
       tree aligning_field_addr
         = build_unary_op (ADDR_EXPR, NULL_TREE, aligning_field);
@@ -1984,7 +1945,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
     {
       tree storage_type
        = build_unc_object_type_from_ptr (result_type, type,
-                                         get_identifier ("ALLOC"), false);
+                                         get_identifier ("ALLOC"));
       tree template_type = TREE_TYPE (TYPE_FIELDS (storage_type));
       tree storage_ptr_type = build_pointer_type (storage_type);
       tree storage;
@@ -2000,7 +1961,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
 
       storage = build_call_alloc_dealloc (NULL_TREE, size, storage_type,
                                          gnat_proc, gnat_pool, gnat_node);
-      storage = convert (storage_ptr_type, gnat_protect_expr (storage));
+      storage = convert (storage_ptr_type, protect_multiple_eval (storage));
 
       if (TYPE_IS_PADDING_P (type))
        {
@@ -2040,7 +2001,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
            build_component_ref
            (build_unary_op (INDIRECT_REF, NULL_TREE,
                             convert (storage_ptr_type, storage)),
-            NULL_TREE, TYPE_FIELDS (storage_type), false),
+            NULL_TREE, TYPE_FIELDS (storage_type), 0),
            build_template (template_type, type, NULL_TREE)),
           convert (result_type, convert (storage_ptr_type, storage)));
     }
@@ -2078,7 +2039,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
      and return the address with a COMPOUND_EXPR.  */
   if (init)
     {
-      result = gnat_protect_expr (result);
+      result = protect_multiple_eval (result);
       result
        = build2 (COMPOUND_EXPR, TREE_TYPE (result),
                  build_binary_op
@@ -2100,11 +2061,12 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
 tree
 fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual)
 {
+  tree field;
   tree parm_decl = get_gnu_tree (gnat_formal);
+  tree const_list = NULL_TREE;
   tree record_type = TREE_TYPE (TREE_TYPE (parm_decl));
-  tree const_list = NULL_TREE, field;
-  const bool do_range_check
-    = strcmp ("MBO",
+  int do_range_check =
+      strcmp ("MBO",
              IDENTIFIER_POINTER (DECL_NAME (TYPE_FIELDS (record_type))));
 
   expr = maybe_unconstrained_array (expr);
@@ -2116,24 +2078,23 @@ fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual)
                              SUBSTITUTE_PLACEHOLDER_IN_EXPR
                              (DECL_INITIAL (field), expr));
 
-      /* Check to ensure that only 32-bit pointers are passed in
-        32-bit descriptors */
-      if (do_range_check
-          && strcmp (IDENTIFIER_POINTER (DECL_NAME (field)), "POINTER") == 0)
+      /* Check to ensure that only 32bit pointers are passed in
+        32bit descriptors */
+      if (do_range_check &&
+          strcmp (IDENTIFIER_POINTER (DECL_NAME (field)), "POINTER") == 0)
         {
-         tree pointer64type
-           = build_pointer_type_for_mode (void_type_node, DImode, false);
+         tree pointer64type =
+            build_pointer_type_for_mode (void_type_node, DImode, false);
          tree addr64expr = build_unary_op (ADDR_EXPR, pointer64type, expr);
-         tree malloc64low
-           = build_int_cstu (long_integer_type_node, 0x80000000);
+         tree malloc64low =
+            build_int_cstu (long_integer_type_node, 0x80000000);
 
          add_stmt (build3 (COND_EXPR, void_type_node,
-                           build_binary_op (GE_EXPR, boolean_type_node,
+                           build_binary_op (GE_EXPR, long_integer_type_node,
                                             convert (long_integer_type_node,
                                                      addr64expr),
                                             malloc64low),
-                           build_call_raise (CE_Range_Check_Failed,
-                                             gnat_actual,
+                           build_call_raise (CE_Range_Check_Failed, gnat_actual,
                                              N_Raise_Constraint_Error),
                            NULL_TREE));
         }
@@ -2164,10 +2125,6 @@ gnat_mark_addressable (tree t)
        t = TREE_OPERAND (t, 0);
        break;
 
-      case COMPOUND_EXPR:
-       t = TREE_OPERAND (t, 1);
-       break;
-
       case CONSTRUCTOR:
        TREE_ADDRESSABLE (t) = 1;
        return true;
@@ -2190,303 +2147,3 @@ gnat_mark_addressable (tree t)
        return true;
     }
 }
-\f
-/* Save EXP for later use or reuse.  This is equivalent to save_expr in tree.c
-   but we know how to handle our own nodes.  */
-
-tree
-gnat_save_expr (tree exp)
-{
-  tree type = TREE_TYPE (exp);
-  enum tree_code code = TREE_CODE (exp);
-
-  if (TREE_CONSTANT (exp) || code == SAVE_EXPR || code == NULL_EXPR)
-    return exp;
-
-  if (code == UNCONSTRAINED_ARRAY_REF)
-    {
-      tree t = build1 (code, type, gnat_save_expr (TREE_OPERAND (exp, 0)));
-      TREE_READONLY (t) = TYPE_READONLY (type);
-      return t;
-    }
-
-  /* If this is a COMPONENT_REF of a fat pointer, save the entire fat pointer.
-     This may be more efficient, but will also allow us to more easily find
-     the match for the PLACEHOLDER_EXPR.  */
-  if (code == COMPONENT_REF
-      && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (exp, 0))))
-    return build3 (code, type, gnat_save_expr (TREE_OPERAND (exp, 0)),
-                  TREE_OPERAND (exp, 1), TREE_OPERAND (exp, 2));
-
-  return save_expr (exp);
-}
-
-/* Protect EXP for immediate reuse.  This is a variant of gnat_save_expr that
-   is optimized under the assumption that EXP's value doesn't change before
-   its subsequent reuse(s) except through its potential reevaluation.  */
-
-tree
-gnat_protect_expr (tree exp)
-{
-  tree type = TREE_TYPE (exp);
-  enum tree_code code = TREE_CODE (exp);
-
-  if (TREE_CONSTANT (exp) || code == SAVE_EXPR || code == NULL_EXPR)
-    return exp;
-
-  /* If EXP has no side effects, we theoritically don't need to do anything.
-     However, we may be recursively passed more and more complex expressions
-     involving checks which will be reused multiple times and eventually be
-     unshared for gimplification; in order to avoid a complexity explosion
-     at that point, we protect any expressions more complex than a simple
-     arithmetic expression.  */
-  if (!TREE_SIDE_EFFECTS (exp))
-    {
-      tree inner = skip_simple_arithmetic (exp);
-      if (!EXPR_P (inner) || REFERENCE_CLASS_P (inner))
-       return exp;
-    }
-
-  /* If this is a conversion, protect what's inside the conversion.  */
-  if (code == NON_LVALUE_EXPR
-      || CONVERT_EXPR_CODE_P (code)
-      || code == VIEW_CONVERT_EXPR)
-  return build1 (code, type, gnat_protect_expr (TREE_OPERAND (exp, 0)));
-
-  /* If we're indirectly referencing something, we only need to protect the
-     address since the data itself can't change in these situations.  */
-  if (code == INDIRECT_REF || code == UNCONSTRAINED_ARRAY_REF)
-    {
-      tree t = build1 (code, type, gnat_protect_expr (TREE_OPERAND (exp, 0)));
-      TREE_READONLY (t) = TYPE_READONLY (type);
-      return t;
-    }
-
-  /* If this is a COMPONENT_REF of a fat pointer, save the entire fat pointer.
-     This may be more efficient, but will also allow us to more easily find
-     the match for the PLACEHOLDER_EXPR.  */
-  if (code == COMPONENT_REF
-      && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (exp, 0))))
-    return build3 (code, type, gnat_protect_expr (TREE_OPERAND (exp, 0)),
-                  TREE_OPERAND (exp, 1), TREE_OPERAND (exp, 2));
-
-  /* If this is a fat pointer or something that can be placed in a register,
-     just make a SAVE_EXPR.  Likewise for a CALL_EXPR as large objects are
-     returned via invisible reference in most ABIs so the temporary will
-     directly be filled by the callee.  */
-  if (TYPE_IS_FAT_POINTER_P (type)
-      || TYPE_MODE (type) != BLKmode
-      || code == CALL_EXPR)
-    return save_expr (exp);
-
-  /* Otherwise reference, protect the address and dereference.  */
-  return
-    build_unary_op (INDIRECT_REF, type,
-                   save_expr (build_unary_op (ADDR_EXPR,
-                                              build_reference_type (type),
-                                              exp)));
-}
-
-/* This is equivalent to stabilize_reference_1 in tree.c but we take an extra
-   argument to force evaluation of everything.  */
-
-static tree
-gnat_stabilize_reference_1 (tree e, bool force)
-{
-  enum tree_code code = TREE_CODE (e);
-  tree type = TREE_TYPE (e);
-  tree result;
-
-  /* We cannot ignore const expressions because it might be a reference
-     to a const array but whose index contains side-effects.  But we can
-     ignore things that are actual constant or that already have been
-     handled by this function.  */
-  if (TREE_CONSTANT (e) || code == SAVE_EXPR)
-    return e;
-
-  switch (TREE_CODE_CLASS (code))
-    {
-    case tcc_exceptional:
-    case tcc_declaration:
-    case tcc_comparison:
-    case tcc_expression:
-    case tcc_reference:
-    case tcc_vl_exp:
-      /* If this is a COMPONENT_REF of a fat pointer, save the entire
-        fat pointer.  This may be more efficient, but will also allow
-        us to more easily find the match for the PLACEHOLDER_EXPR.  */
-      if (code == COMPONENT_REF
-         && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (e, 0))))
-       result
-         = build3 (code, type,
-                   gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
-                   TREE_OPERAND (e, 1), TREE_OPERAND (e, 2));
-      /* If the expression has side-effects, then encase it in a SAVE_EXPR
-        so that it will only be evaluated once.  */
-      /* The tcc_reference and tcc_comparison classes could be handled as
-        below, but it is generally faster to only evaluate them once.  */
-      else if (TREE_SIDE_EFFECTS (e) || force)
-       return save_expr (e);
-      else
-       return e;
-      break;
-
-    case tcc_binary:
-      /* Recursively stabilize each operand.  */
-      result
-       = build2 (code, type,
-                 gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
-                 gnat_stabilize_reference_1 (TREE_OPERAND (e, 1), force));
-      break;
-
-    case tcc_unary:
-      /* Recursively stabilize each operand.  */
-      result
-       = build1 (code, type,
-                 gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force));
-      break;
-
-    default:
-      gcc_unreachable ();
-    }
-
-  /* See similar handling in gnat_stabilize_reference.  */
-  TREE_READONLY (result) = TREE_READONLY (e);
-  TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (e);
-  TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
-
-  return result;
-}
-
-/* This is equivalent to stabilize_reference in tree.c but we know how to
-   handle our own nodes and we take extra arguments.  FORCE says whether to
-   force evaluation of everything.  We set SUCCESS to true unless we walk
-   through something we don't know how to stabilize.  */
-
-tree
-gnat_stabilize_reference (tree ref, bool force, bool *success)
-{
-  tree type = TREE_TYPE (ref);
-  enum tree_code code = TREE_CODE (ref);
-  tree result;
-
-  /* Assume we'll success unless proven otherwise.  */
-  if (success)
-    *success = true;
-
-  switch (code)
-    {
-    case CONST_DECL:
-    case VAR_DECL:
-    case PARM_DECL:
-    case RESULT_DECL:
-      /* No action is needed in this case.  */
-      return ref;
-
-    case ADDR_EXPR:
-    CASE_CONVERT:
-    case FLOAT_EXPR:
-    case FIX_TRUNC_EXPR:
-    case VIEW_CONVERT_EXPR:
-      result
-       = build1 (code, type,
-                 gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
-                                           success));
-      break;
-
-    case INDIRECT_REF:
-    case UNCONSTRAINED_ARRAY_REF:
-      result = build1 (code, type,
-                      gnat_stabilize_reference_1 (TREE_OPERAND (ref, 0),
-                                                  force));
-      break;
-
-    case COMPONENT_REF:
-     result = build3 (COMPONENT_REF, type,
-                     gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
-                                               success),
-                     TREE_OPERAND (ref, 1), NULL_TREE);
-      break;
-
-    case BIT_FIELD_REF:
-      result = build3 (BIT_FIELD_REF, type,
-                      gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
-                                                success),
-                      gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
-                                                  force),
-                      gnat_stabilize_reference_1 (TREE_OPERAND (ref, 2),
-                                                  force));
-      break;
-
-    case ARRAY_REF:
-    case ARRAY_RANGE_REF:
-      result = build4 (code, type,
-                      gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
-                                                success),
-                      gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
-                                                  force),
-                      NULL_TREE, NULL_TREE);
-      break;
-
-    case CALL_EXPR:
-      result = gnat_stabilize_reference_1 (ref, force);
-      break;
-
-    case COMPOUND_EXPR:
-      result = build2 (COMPOUND_EXPR, type,
-                      gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
-                                                success),
-                      gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
-                                                  force));
-      break;
-
-    case CONSTRUCTOR:
-      /* Constructors with 1 element are used extensively to formally
-        convert objects to special wrapping types.  */
-      if (TREE_CODE (type) == RECORD_TYPE
-         && VEC_length (constructor_elt, CONSTRUCTOR_ELTS (ref)) == 1)
-       {
-         tree index
-           = VEC_index (constructor_elt, CONSTRUCTOR_ELTS (ref), 0)->index;
-         tree value
-           = VEC_index (constructor_elt, CONSTRUCTOR_ELTS (ref), 0)->value;
-         result
-           = build_constructor_single (type, index,
-                                       gnat_stabilize_reference_1 (value,
-                                                                   force));
-       }
-      else
-       {
-         if (success)
-           *success = false;
-         return ref;
-       }
-      break;
-
-    case ERROR_MARK:
-      ref = error_mark_node;
-
-      /* ...  fall through to failure ... */
-
-      /* If arg isn't a kind of lvalue we recognize, make no change.
-        Caller should recognize the error for an invalid lvalue.  */
-    default:
-      if (success)
-       *success = false;
-      return ref;
-    }
-
-  /* TREE_THIS_VOLATILE and TREE_SIDE_EFFECTS set on the initial expression
-     may not be sustained across some paths, such as the way via build1 for
-     INDIRECT_REF.  We reset those flags here in the general case, which is
-     consistent with the GCC version of this routine.
-
-     Special care should be taken regarding TREE_SIDE_EFFECTS, because some
-     paths introduce side-effects where there was none initially (e.g. if a
-     SAVE_EXPR is built) and we also want to keep track of that.  */
-  TREE_READONLY (result) = TREE_READONLY (ref);
-  TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (ref);
-  TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
-
-  return result;
-}