OSDN Git Service

* gcc-interface/gigi.h (fill_vms_descriptor): Take GNU_TYPE instead of
authorebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 3 Feb 2011 13:19:38 +0000 (13:19 +0000)
committerebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 3 Feb 2011 13:19:38 +0000 (13:19 +0000)
GNAT_FORMAL.
* gcc-interface/utils2.c (fill_vms_descriptor): Move from here to...
* gcc-interface/utils.c (fill_vms_descriptor): ...here.  Take GNU_TYPE
instead of GNAT_FORMAL.  Protect the expression against multiple uses.
Do not generate the check directly, instead instantiate the template
check present in the descriptor.
(make_descriptor_field): Move around.
(build_vms_descriptor32): Build a template check in the POINTER field.
(build_vms_descriptor): Remove useless suffixes.
* gcc-interface/trans.c (call_to_gnu): Adjust fill_vms_descriptor call.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@169788 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/gcc-interface/gigi.h
gcc/ada/gcc-interface/trans.c
gcc/ada/gcc-interface/utils.c
gcc/ada/gcc-interface/utils2.c

index 56d0030..c520f72 100644 (file)
@@ -1,3 +1,17 @@
+2011-02-03  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/gigi.h (fill_vms_descriptor): Take GNU_TYPE instead of
+       GNAT_FORMAL.
+       * gcc-interface/utils2.c (fill_vms_descriptor): Move from here to...
+       * gcc-interface/utils.c (fill_vms_descriptor): ...here.  Take GNU_TYPE
+       instead of GNAT_FORMAL.  Protect the expression against multiple uses.
+       Do not generate the check directly, instead instantiate the template
+       check present in the descriptor.
+       (make_descriptor_field): Move around.
+       (build_vms_descriptor32): Build a template check in the POINTER field.
+       (build_vms_descriptor): Remove useless suffixes.
+       * gcc-interface/trans.c (call_to_gnu): Adjust fill_vms_descriptor call.
+
 2011-01-26  Eric Botcazou  <ebotcazou@adacore.com>
 
        PR bootstrap/47467
index 67a7a47..e45cf13 100644 (file)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          Copyright (C) 1992-2010, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2011, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -861,10 +861,9 @@ extern tree build_allocator (tree type, tree init, tree result_type,
                              Entity_Id gnat_proc, Entity_Id gnat_pool,
                              Node_Id gnat_node, bool);
 
-/* Fill in a VMS descriptor for EXPR and return a constructor for it.
-   GNAT_FORMAL is how we find the descriptor record. GNAT_ACTUAL is how
-   we derive the source location on a C_E */
-extern tree fill_vms_descriptor (tree expr, Entity_Id gnat_formal,
+/* Fill in a VMS descriptor of GNU_TYPE for GNU_EXPR and return the result.
+   GNAT_ACTUAL is the actual parameter for which the descriptor is built.  */
+extern tree fill_vms_descriptor (tree gnu_type, tree gnu_expr,
                                  Node_Id gnat_actual);
 
 /* Indicate that we need to take the address of T and that it therefore
index 30dbf7a..e438960 100644 (file)
@@ -3071,9 +3071,9 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
              = convert (DECL_ARG_TYPE (gnu_formal), integer_zero_node);
          else
            gnu_actual = build_unary_op (ADDR_EXPR, NULL_TREE,
-                                        fill_vms_descriptor (gnu_actual,
-                                                             gnat_formal,
-                                                             gnat_actual));
+                                        fill_vms_descriptor
+                                        (TREE_TYPE (TREE_TYPE (gnu_formal)),
+                                         gnu_actual, gnat_actual));
        }
       else
        {
index 19a17f9..eac87e0 100644 (file)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2010, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2011, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -203,7 +203,6 @@ static tree split_plus (tree, tree *);
 static tree float_type_for_precision (int, enum machine_mode);
 static tree convert_to_fat_pointer (tree, tree);
 static tree convert_to_thin_pointer (tree, tree);
-static tree make_descriptor_field (const char *,tree, tree, tree, tree);
 static bool potential_alignment_gap (tree, tree, tree);
 static void process_attributes (tree, struct attrib *);
 \f
@@ -2280,6 +2279,22 @@ build_template (tree template_type, tree array_type, tree expr)
   return gnat_build_constructor (template_type, template_elts);
 }
 \f
+/* Helper routine to make a descriptor field.  FIELD_LIST is the list of decls
+   being built; the new decl is chained on to the front of the list.  */
+
+static tree
+make_descriptor_field (const char *name, tree type, tree rec_type,
+                      tree initial, tree field_list)
+{
+  tree field
+    = create_field_decl (get_identifier (name), type, rec_type, NULL_TREE,
+                        NULL_TREE, 0, 0);
+
+  DECL_INITIAL (field) = initial;
+  DECL_CHAIN (field) = field_list;
+  return field;
+}
+
 /* Build a 32-bit VMS descriptor from a Mechanism_Type, which must specify a
    descriptor type, and the GCC type of an object.  Each FIELD_DECL in the
    type contains in its DECL_INITIAL the expression to use when a constructor
@@ -2291,15 +2306,11 @@ tree
 build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
 {
   tree record_type = make_node (RECORD_TYPE);
-  tree pointer32_type;
+  tree pointer32_type, pointer64_type;
   tree field_list = NULL_TREE;
-  int klass;
-  int dtype = 0;
-  tree inner_type;
-  int ndim;
-  int i;
+  int klass, ndim, i, dtype = 0;
+  tree inner_type, tem;
   tree *idx_arr;
-  tree tem;
 
   /* If TYPE is an unconstrained array, use the underlying array type.  */
   if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
@@ -2439,15 +2450,22 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
     = make_descriptor_field ("CLASS", gnat_type_for_size (8, 1), record_type,
                             size_int (klass), field_list);
 
-  /* Of course this will crash at run time if the address space is not
-     within the low 32 bits, but there is nothing else we can do.  */
   pointer32_type = build_pointer_type_for_mode (type, SImode, false);
+  pointer64_type = build_pointer_type_for_mode (type, DImode, false);
+
+  /* Ensure that only 32-bit pointers are passed in 32-bit descriptors.  Note
+     that we cannot build a template call to the CE routine as it would get a
+     wrong source location; instead we use a second placeholder for it.  */
+  tem = build_unary_op (ADDR_EXPR, pointer64_type,
+                       build0 (PLACEHOLDER_EXPR, type));
+  tem = build3 (COND_EXPR, pointer32_type,
+               build_binary_op (GE_EXPR, boolean_type_node, tem,
+                                build_int_cstu (pointer64_type, 0x80000000)),
+               build0 (PLACEHOLDER_EXPR, void_type_node),
+               convert (pointer32_type, tem));
 
   field_list
-    = make_descriptor_field ("POINTER", pointer32_type, record_type,
-                            build_unary_op (ADDR_EXPR,
-                                            pointer32_type,
-                                            build0 (PLACEHOLDER_EXPR, type)),
+    = make_descriptor_field ("POINTER", pointer32_type, record_type, tem,
                             field_list);
 
   switch (mech)
@@ -2488,7 +2506,6 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
        = make_descriptor_field ("DIGITS", gnat_type_for_size (8, 1),
                                 record_type, size_zero_node, field_list);
 
-
       field_list
        = make_descriptor_field ("AFLAGS", gnat_type_for_size (8, 1),
                                 record_type,
@@ -2587,16 +2604,12 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
 tree
 build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
 {
-  tree record64_type = make_node (RECORD_TYPE);
+  tree record_type = make_node (RECORD_TYPE);
   tree pointer64_type;
-  tree field_list64 = NULL_TREE;
-  int klass;
-  int dtype = 0;
-  tree inner_type;
-  int ndim;
-  int i;
+  tree field_list = NULL_TREE;
+  int klass, ndim, i, dtype = 0;
+  tree inner_type, tem;
   tree *idx_arr;
-  tree tem;
 
   /* If TYPE is an unconstrained array, use the underlying array type.  */
   if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
@@ -2718,32 +2731,32 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
 
   /* Make the type for a 64-bit descriptor for VMS.  The first six fields
      are the same for all types.  */
-  field_list64
+  field_list
     = make_descriptor_field ("MBO", gnat_type_for_size (16, 1),
-                            record64_type, size_int (1), field_list64);
-  field_list64
+                            record_type, size_int (1), field_list);
+  field_list
     = make_descriptor_field ("DTYPE", gnat_type_for_size (8, 1),
-                            record64_type, size_int (dtype), field_list64);
-  field_list64
+                            record_type, size_int (dtype), field_list);
+  field_list
     = make_descriptor_field ("CLASS", gnat_type_for_size (8, 1),
-                            record64_type, size_int (klass), field_list64);
-  field_list64
+                            record_type, size_int (klass), field_list);
+  field_list
     = make_descriptor_field ("MBMO", gnat_type_for_size (32, 1),
-                            record64_type, ssize_int (-1), field_list64);
-  field_list64
+                            record_type, ssize_int (-1), field_list);
+  field_list
     = make_descriptor_field ("LENGTH", gnat_type_for_size (64, 1),
-                            record64_type,
+                            record_type,
                             size_in_bytes (mech == By_Descriptor_A
                                            ? inner_type : type),
-                            field_list64);
+                            field_list);
 
   pointer64_type = build_pointer_type_for_mode (type, DImode, false);
 
-  field_list64
-    = make_descriptor_field ("POINTER", pointer64_type, record64_type,
+  field_list
+    = make_descriptor_field ("POINTER", pointer64_type, record_type,
                             build_unary_op (ADDR_EXPR, pointer64_type,
                                             build0 (PLACEHOLDER_EXPR, type)),
-                            field_list64);
+                            field_list);
 
   switch (mech)
     {
@@ -2752,31 +2765,31 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
       break;
 
     case By_Descriptor_SB:
-      field_list64
+      field_list
        = make_descriptor_field ("SB_L1", gnat_type_for_size (64, 1),
-                                record64_type,
+                                record_type,
                                 (TREE_CODE (type) == ARRAY_TYPE
                                  ? TYPE_MIN_VALUE (TYPE_DOMAIN (type))
                                  : size_zero_node),
-                                field_list64);
-      field_list64
+                                field_list);
+      field_list
        = make_descriptor_field ("SB_U1", gnat_type_for_size (64, 1),
-                                record64_type,
+                                record_type,
                                 (TREE_CODE (type) == ARRAY_TYPE
                                  ? TYPE_MAX_VALUE (TYPE_DOMAIN (type))
                                  : size_zero_node),
-                                field_list64);
+                                field_list);
       break;
 
     case By_Descriptor_A:
     case By_Descriptor_NCA:
-      field_list64
+      field_list
        = make_descriptor_field ("SCALE", gnat_type_for_size (8, 1),
-                                record64_type, size_zero_node, field_list64);
+                                record_type, size_zero_node, field_list);
 
-      field_list64
+      field_list
        = make_descriptor_field ("DIGITS", gnat_type_for_size (8, 1),
-                                record64_type, size_zero_node, field_list64);
+                                record_type, size_zero_node, field_list);
 
       dtype = (mech == By_Descriptor_NCA
               ? 0
@@ -2785,22 +2798,22 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
               : (TREE_CODE (type) == ARRAY_TYPE
                  && TYPE_CONVENTION_FORTRAN_P (type)
                  ? 224 : 192));
-      field_list64
+      field_list
        = make_descriptor_field ("AFLAGS", gnat_type_for_size (8, 1),
-                                record64_type, size_int (dtype),
-                                field_list64);
+                                record_type, size_int (dtype),
+                                field_list);
 
-      field_list64
+      field_list
        = make_descriptor_field ("DIMCT", gnat_type_for_size (8, 1),
-                                record64_type, size_int (ndim), field_list64);
+                                record_type, size_int (ndim), field_list);
 
-      field_list64
+      field_list
        = make_descriptor_field ("MBZ", gnat_type_for_size (32, 1),
-                                record64_type, size_int (0), field_list64);
-      field_list64
+                                record_type, size_int (0), field_list);
+      field_list
        = make_descriptor_field ("ARSIZE", gnat_type_for_size (64, 1),
-                                record64_type, size_in_bytes (type),
-                                field_list64);
+                                record_type, size_in_bytes (type),
+                                field_list);
 
       /* Now build a pointer to the 0,0,0... element.  */
       tem = build0 (PLACEHOLDER_EXPR, type);
@@ -2810,10 +2823,10 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
                      convert (TYPE_DOMAIN (inner_type), size_zero_node),
                      NULL_TREE, NULL_TREE);
 
-      field_list64
-       = make_descriptor_field ("A0", pointer64_type, record64_type,
+      field_list
+       = make_descriptor_field ("A0", pointer64_type, record_type,
                                 build1 (ADDR_EXPR, pointer64_type, tem),
-                                field_list64);
+                                field_list);
 
       /* Next come the addressing coefficients.  */
       tem = size_one_node;
@@ -2830,9 +2843,9 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
 
          fname[0] = (mech == By_Descriptor_NCA ? 'S' : 'M');
          fname[1] = '0' + i, fname[2] = 0;
-         field_list64
+         field_list
            = make_descriptor_field (fname, gnat_type_for_size (64, 1),
-                                    record64_type, idx_length, field_list64);
+                                    record_type, idx_length, field_list);
 
          if (mech == By_Descriptor_NCA)
            tem = idx_length;
@@ -2844,16 +2857,16 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
          char fname[3];
 
          fname[0] = 'L', fname[1] = '0' + i, fname[2] = 0;
-         field_list64
+         field_list
            = make_descriptor_field (fname, gnat_type_for_size (64, 1),
-                                    record64_type,
-                                    TYPE_MIN_VALUE (idx_arr[i]), field_list64);
+                                    record_type,
+                                    TYPE_MIN_VALUE (idx_arr[i]), field_list);
 
          fname[0] = 'U';
-         field_list64
+         field_list
            = make_descriptor_field (fname, gnat_type_for_size (64, 1),
-                                    record64_type,
-                                    TYPE_MAX_VALUE (idx_arr[i]), field_list64);
+                                    record_type,
+                                    TYPE_MAX_VALUE (idx_arr[i]), field_list);
        }
       break;
 
@@ -2861,26 +2874,41 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
       post_error ("unsupported descriptor type for &", gnat_entity);
     }
 
-  TYPE_NAME (record64_type) = create_concat_name (gnat_entity, "DESC64");
-  finish_record_type (record64_type, nreverse (field_list64), 0, false);
-  return record64_type;
+  TYPE_NAME (record_type) = create_concat_name (gnat_entity, "DESC64");
+  finish_record_type (record_type, nreverse (field_list), 0, false);
+  return record_type;
 }
 
-/* Utility routine for above code to make a field.  FIELD_LIST is the
-   list of decls being built; the new decl is chained on to the front of
-   the list.  */
+/* Fill in a VMS descriptor of GNU_TYPE for GNU_EXPR and return the result.
+   GNAT_ACTUAL is the actual parameter for which the descriptor is built.  */
 
-static tree
-make_descriptor_field (const char *name, tree type,
-                      tree rec_type, tree initial, tree field_list)
+tree
+fill_vms_descriptor (tree gnu_type, tree gnu_expr, Node_Id gnat_actual)
 {
-  tree field
-    = create_field_decl (get_identifier (name), type, rec_type, NULL_TREE,
-                        NULL_TREE, 0, 0);
+  VEC(constructor_elt,gc) *v = NULL;
+  tree field;
 
-  DECL_INITIAL (field) = initial;
-  DECL_CHAIN (field) = field_list;
-  return field;
+  gnu_expr = maybe_unconstrained_array (gnu_expr);
+  gnu_expr = gnat_protect_expr (gnu_expr);
+  gnat_mark_addressable (gnu_expr);
+
+  /* We may need to substitute both GNU_EXPR and a CALL_EXPR to the raise CE
+     routine in case we have a 32-bit descriptor.  */
+  gnu_expr = build2 (COMPOUND_EXPR, void_type_node,
+                    build_call_raise (CE_Range_Check_Failed, gnat_actual,
+                                      N_Raise_Constraint_Error),
+                    gnu_expr);
+
+  for (field = TYPE_FIELDS (gnu_type); field; field = DECL_CHAIN (field))
+    {
+      tree value
+       = convert (TREE_TYPE (field),
+                  SUBSTITUTE_PLACEHOLDER_IN_EXPR (DECL_INITIAL (field),
+                                                  gnu_expr));
+      CONSTRUCTOR_APPEND_ELT (v, field, value);
+    }
+
+  return gnat_build_constructor (gnu_type, v);
 }
 
 /* Convert GNU_EXPR, a pointer to a 64bit VMS descriptor, to GNU_TYPE, a
index 905b9aa..07d6b5b 100644 (file)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2010, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2011, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -2216,58 +2216,6 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
   return convert (result_type, result);
 }
 \f
-/* Fill in a VMS descriptor for EXPR and return a constructor for it.
-   GNAT_FORMAL is how we find the descriptor record.  GNAT_ACTUAL is
-   how we derive the source location to raise C_E on an out of range
-   pointer. */
-
-tree
-fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual)
-{
-  tree parm_decl = get_gnu_tree (gnat_formal);
-  tree record_type = TREE_TYPE (TREE_TYPE (parm_decl));
-  tree field;
-  const bool do_range_check
-    = strcmp ("MBO",
-             IDENTIFIER_POINTER (DECL_NAME (TYPE_FIELDS (record_type))));
-  VEC(constructor_elt,gc) *v = NULL;
-
-  expr = maybe_unconstrained_array (expr);
-  gnat_mark_addressable (expr);
-
-  for (field = TYPE_FIELDS (record_type); field; field = DECL_CHAIN (field))
-    {
-      tree conexpr = convert (TREE_TYPE (field),
-                             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)
-        {
-         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);
-
-         add_stmt (build3 (COND_EXPR, void_type_node,
-                           build_binary_op (GE_EXPR, boolean_type_node,
-                                            convert (long_integer_type_node,
-                                                     addr64expr),
-                                            malloc64low),
-                           build_call_raise (CE_Range_Check_Failed,
-                                             gnat_actual,
-                                             N_Raise_Constraint_Error),
-                           NULL_TREE));
-        }
-      CONSTRUCTOR_APPEND_ELT (v, field, conexpr);
-    }
-
-  return gnat_build_constructor (record_type, v);
-}
-
 /* Indicate that we need to take the address of T and that it therefore
    should not be allocated in a register.  Returns true if successful.  */