gnat_rm.texi: Document new mechanism Short_Descriptor.

2008-08-01  Doug Rupp  <rupp@adacore.com>

	* gnat_rm.texi: Document new mechanism Short_Descriptor.

	* types.ads (Mechanism_Type): Modify range for new Short_Descriptor
	mechanism values.

	* sem_prag.adb (Set_Mechanism_Value): Enhance for Short_Descriptor
	mechanism and Short_Descriptor mechanism values.

	* snames.adb (preset_names): Add short_descriptor entry.

	* snames.ads: Add Name_Short_Descriptor.

	* types.h: Add new By_Short_Descriptor mechanism values.

	* sem_mech.adb (Set_Mechanism_Value): Enhance for Short_Descriptor
	mechanism and Short_Descriptor mechanism values.

	* sem_mech.ads (Mechanism_Type): Add new By_Short_Descriptor mechanism
	values.
	(Descriptor_Codes): Modify range for new mechanism values.

	* treepr.adb (Print_Entity_Enfo): Handle new By_Short_Descriptor
	mechanism values.

	* gcc-interface/decl.c (gnat_to_gnu_entity): Handle By_Short_Descriptor.
	(gnat_to_gnu_param): Handle By_Short_Descriptor.

	* gcc-interface/gigi.h (build_vms_descriptor64): Remove prototype.
	(build_vms_descriptor32): New prototype.
	(fill_vms_descriptor): Remove unneeded gnat_actual parameter.

	* gcc-interface/trans.c (call_to_gnu): Removed unneeded gnat_actual
	argument in call fill_vms_descriptor.

	* gcc-interface/utils.c (build_vms_descriptor32): Renamed from
	build_vms_descriptor and enhanced to hande Short_Descriptor mechanism.
	(build_vms_descriptor): Renamed from build_vms_descriptor64.
	(convert_vms_descriptor32): New function.
	(convert_vms_descriptor64): New function.
	(convert_vms_descriptor): Rewrite to handle both 32bit and 64bit
	descriptors.

	* gcc-interface/utils2.c (fill_vms_descriptor): Revert previous changes,
	no longer needed.

From-SVN: r138473

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index f8ebf5a58be6b28afd60a3a258243a5992782115..f7f4a0d1b61b58b9893cb6634abe1100c0908afa 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -3872,6 +3872,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
              ;
            else if (By_Descriptor_Last <= mech && mech <= By_Descriptor)
              mech = By_Descriptor;
+
+           else if (By_Short_Descriptor_Last <= mech &&
+                     mech <= By_Short_Descriptor)
+             mech = By_Short_Descriptor;
+
            else if (mech > 0)
              {
                if (TREE_CODE (gnu_param_type) == UNCONSTRAINED_ARRAY_TYPE
@@ -3913,7 +3918,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                      = chainon (gnu_param, gnu_stub_param_list);
                    /* Change By_Descriptor parameter to By_Reference for
                       the internal version of an exported subprogram.  */
-                   if (mech == By_Descriptor)
+                   if (mech == By_Descriptor || mech == By_Short_Descriptor)
                      {
                        gnu_param
                          = gnat_to_gnu_param (gnat_param, By_Reference,
@@ -4828,11 +4833,11 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
 
   /* VMS descriptors are themselves passed by reference.
      Build both a 32bit and 64bit descriptor, one of which will be chosen
-     in fill_vms_descriptor based on the allocator size */
+     in fill_vms_descriptor. */
   if (mech == By_Descriptor)
     {
       gnu_param_type_alt
-        = build_pointer_type (build_vms_descriptor64 (gnu_param_type,
+        = build_pointer_type (build_vms_descriptor32 (gnu_param_type,
                                                      Mechanism (gnat_param),
                                                      gnat_subprog));
       gnu_param_type
@@ -4840,6 +4845,15 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
                                                    Mechanism (gnat_param),
                                                    gnat_subprog));
     }
+  else if (mech == By_Short_Descriptor)
+    {
+      gnu_param_type_alt = NULL_TREE;
+
+      gnu_param_type
+        = build_pointer_type (build_vms_descriptor32 (gnu_param_type,
+                                                   Mechanism (gnat_param),
+                                                   gnat_subprog));
+    }
 
   /* Arrays are passed as pointers to element type for foreign conventions.  */
   else if (foreign
@@ -4920,6 +4934,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
       && !by_ref
       && (by_return
          || (mech != By_Descriptor
+              && mech != By_Short_Descriptor
              && !POINTER_TYPE_P (gnu_param_type)
              && !AGGREGATE_TYPE_P (gnu_param_type)))
       && !(Is_Array_Type (Etype (gnat_param))
@@ -4931,11 +4946,12 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
                                 ro_param || by_ref || by_component_ptr);
   DECL_BY_REF_P (gnu_param) = by_ref;
   DECL_BY_COMPONENT_PTR_P (gnu_param) = by_component_ptr;
-  DECL_BY_DESCRIPTOR_P (gnu_param) = (mech == By_Descriptor);
+  DECL_BY_DESCRIPTOR_P (gnu_param) = (mech == By_Descriptor ||
+                                      mech == By_Short_Descriptor);
   DECL_POINTS_TO_READONLY_P (gnu_param)
     = (ro_param && (by_ref || by_component_ptr));
 
-  /* Save the 64bit descriptor for later. */
+  /* Save the alternate descriptor for later. */
   SET_DECL_PARM_ALT (gnu_param, gnu_param_type_alt);
 
   /* If no Mechanism was specified, indicate what we're using, then

diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index f44fec89abdb1e93a2a961dceff48f3c34f6c822..915e44f0e0e333e81f0a3f705a8810112660af7f 100644 (file)
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -683,7 +683,7 @@ extern void end_subprog_body (tree body, bool elab_p);
    Return a constructor for the template.  */
 extern tree build_template (tree template_type, tree array_type, tree expr);
 
-/* Build a 32bit VMS descriptor from a Mechanism_Type, which must specify
+/* Build a 64bit 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 is made for the type.  GNAT_ENTITY is a gnat node used
@@ -692,8 +692,8 @@ extern tree build_template (tree template_type, tree array_type, tree expr);
 extern tree build_vms_descriptor (tree type, Mechanism_Type mech,
                                   Entity_Id gnat_entity);
 
-/* Build a 64bit VMS descriptor from a Mechanism_Type. See above. */
-extern tree build_vms_descriptor64 (tree type, Mechanism_Type mech,
+/* Build a 32bit VMS descriptor from a Mechanism_Type. See above. */
+extern tree build_vms_descriptor32 (tree type, Mechanism_Type mech,
                                   Entity_Id gnat_entity);
 
 /* Build a stub for the subprogram specified by the GCC tree GNU_SUBPROG
@@ -853,9 +853,8 @@ extern tree build_allocator (tree type, tree init, tree result_type,
                              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
-   find the size of the allocator. */
-extern tree fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual);
+   GNAT_FORMAL is how we find the descriptor record. */
+extern tree fill_vms_descriptor (tree expr, Entity_Id gnat_formal);
 
 /* Indicate that we need to make the address of EXPR_NODE and it therefore
    should not be allocated in a register.  Return true if successful.  */

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index f8e1d49eaa27db21318aa4800343a7400ce106fd..677ec01356a2be8699dfe3e86a77ceed4129381b 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -2392,8 +2392,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
          else
            gnu_actual = build_unary_op (ADDR_EXPR, NULL_TREE,
                                         fill_vms_descriptor (gnu_actual,
-                                                             gnat_formal,
-                                                             gnat_actual));
+                                                             gnat_formal));
        }
       else
        {
@@ -5910,7 +5909,7 @@ build_unary_op_trapv (enum tree_code code,
 {
   gcc_assert ((code == NEGATE_EXPR) || (code == ABS_EXPR));
 
-  operand = save_expr (operand);
+  operand = protect_multiple_eval (operand);
 
   return emit_check (build_binary_op (EQ_EXPR, integer_type_node,
                                      operand, TYPE_MIN_VALUE (gnu_type)),
@@ -5929,8 +5928,8 @@ build_binary_op_trapv (enum tree_code code,
                       tree left,
                       tree right)
 {
-  tree lhs = save_expr (left);
-  tree rhs = save_expr (right);
+  tree lhs = protect_multiple_eval (left);
+  tree rhs = protect_multiple_eval (right);
   tree type_max = TYPE_MAX_VALUE (gnu_type);
   tree type_min = TYPE_MIN_VALUE (gnu_type);
   tree gnu_expr;

diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 2105abdcb29c58256a2def1bedeb46b28007408a..f94d4bad609d53f947dc4194a2d91547c3a4c603 100644 (file)
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -2659,7 +2659,7 @@ build_template (tree template_type, tree array_type, tree expr)
    an object of that type and also for the name.  */
 
 tree
-build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
+build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
 {
   tree record_type = make_node (RECORD_TYPE);
   tree pointer32_type;
@@ -2689,7 +2689,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
 
   idx_arr = (tree *) alloca (ndim * sizeof (tree));
 
-  if (mech != By_Descriptor_NCA
+  if (mech != By_Descriptor_NCA && mech != By_Short_Descriptor_NCA
       && TREE_CODE (type) == ARRAY_TYPE && TYPE_CONVENTION_FORTRAN_P (type))
     for (i = ndim - 1, inner_type = type;
         i >= 0;
@@ -2775,16 +2775,21 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
   switch (mech)
     {
     case By_Descriptor_A:
+    case By_Short_Descriptor_A:
       class = 4;
       break;
     case By_Descriptor_NCA:
+    case By_Short_Descriptor_NCA:
       class = 10;
       break;
     case By_Descriptor_SB:
+    case By_Short_Descriptor_SB:
       class = 15;
       break;
     case By_Descriptor:
+    case By_Short_Descriptor:
     case By_Descriptor_S:
+    case By_Short_Descriptor_S:
     default:
       class = 1;
       break;
@@ -2797,7 +2802,9 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
     = chainon (field_list,
               make_descriptor_field
               ("LENGTH", gnat_type_for_size (16, 1), record_type,
-               size_in_bytes (mech == By_Descriptor_A ? inner_type : type)));
+               size_in_bytes ((mech == By_Descriptor_A ||
+                                mech == By_Short_Descriptor_A)
+                               ? inner_type : type)));
 
   field_list = chainon (field_list,
                        make_descriptor_field ("DTYPE",
@@ -2823,10 +2830,13 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
   switch (mech)
     {
     case By_Descriptor:
+    case By_Short_Descriptor:
     case By_Descriptor_S:
+    case By_Short_Descriptor_S:
       break;
 
     case By_Descriptor_SB:
+    case By_Short_Descriptor_SB:
       field_list
        = chainon (field_list,
                   make_descriptor_field
@@ -2842,7 +2852,9 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
       break;
 
     case By_Descriptor_A:
+    case By_Short_Descriptor_A:
     case By_Descriptor_NCA:
+    case By_Short_Descriptor_NCA:
       field_list = chainon (field_list,
                            make_descriptor_field ("SCALE",
                                                   gnat_type_for_size (8, 1),
@@ -2859,7 +2871,8 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
        = chainon (field_list,
                   make_descriptor_field
                   ("AFLAGS", gnat_type_for_size (8, 1), record_type,
-                   size_int (mech == By_Descriptor_NCA
+                   size_int ((mech == By_Descriptor_NCA ||
+                              mech == By_Short_Descriptor_NCA)
                              ? 0
                              /* Set FL_COLUMN, FL_COEFF, and FL_BOUNDS.  */
                              : (TREE_CODE (type) == ARRAY_TYPE
@@ -2910,7 +2923,8 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
                                                  TYPE_MIN_VALUE (idx_arr[i])),
                                      size_int (1)));
 
-         fname[0] = (mech == By_Descriptor_NCA ? 'S' : 'M');
+         fname[0] = ((mech == By_Descriptor_NCA ||
+                       mech == By_Short_Descriptor_NCA) ? 'S' : 'M');
          fname[1] = '0' + i, fname[2] = 0;
          field_list
            = chainon (field_list,
@@ -2918,7 +2932,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
                                              gnat_type_for_size (32, 1),
                                              record_type, idx_length));
 
-         if (mech == By_Descriptor_NCA)
+         if (mech == By_Descriptor_NCA || mech == By_Short_Descriptor_NCA)
            tem = idx_length;
        }
 
@@ -2962,7 +2976,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
    an object of that type and also for the name.  */
 
 tree
-build_vms_descriptor64 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
+build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
 {
   tree record64_type = make_node (RECORD_TYPE);
   tree pointer64_type;
@@ -3283,12 +3297,160 @@ make_descriptor_field (const char *name, tree type,
   return field;
 }
 
-/* Convert GNU_EXPR, a pointer to a VMS descriptor, to GNU_TYPE, a regular
-   pointer or fat pointer type.  GNAT_SUBPROG is the subprogram to which
-   the VMS descriptor is passed.  */
+/* Convert GNU_EXPR, a pointer to a 64bit VMS descriptor, to GNU_TYPE, a
+   regular pointer or fat pointer type.  GNAT_SUBPROG is the subprogram to
+   which the VMS descriptor is passed.  */
 
 static tree
-convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
+convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
+{
+  tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr));
+  tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr);
+  /* The CLASS field is the 3rd field in the descriptor.  */
+  tree class = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type)));
+  /* The POINTER field is the 6th field in the descriptor.  */
+  tree pointer64 = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (class)));
+
+  /* Retrieve the value of the POINTER field.  */
+  tree gnu_expr64
+    = build3 (COMPONENT_REF, TREE_TYPE (pointer64), desc, pointer64, NULL_TREE);
+
+  if (POINTER_TYPE_P (gnu_type))
+    return convert (gnu_type, gnu_expr64);
+
+  else if (TYPE_FAT_POINTER_P (gnu_type))
+    {
+      tree p_array_type = TREE_TYPE (TYPE_FIELDS (gnu_type));
+      tree p_bounds_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type)));
+      tree template_type = TREE_TYPE (p_bounds_type);
+      tree min_field = TYPE_FIELDS (template_type);
+      tree max_field = TREE_CHAIN (TYPE_FIELDS (template_type));
+      tree template, template_addr, aflags, dimct, t, u;
+      /* See the head comment of build_vms_descriptor.  */
+      int iclass = TREE_INT_CST_LOW (DECL_INITIAL (class));
+      tree lfield, ufield;
+
+      /* Convert POINTER to the type of the P_ARRAY field.  */
+      gnu_expr64 = convert (p_array_type, gnu_expr64);
+
+      switch (iclass)
+       {
+       case 1:  /* Class S  */
+       case 15: /* Class SB */
+         /* Build {1, LENGTH} template; LENGTH64 is the 5th field.  */
+         t = TREE_CHAIN (TREE_CHAIN (class));
+         t = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
+         t = tree_cons (min_field,
+                        convert (TREE_TYPE (min_field), integer_one_node),
+                        tree_cons (max_field,
+                                   convert (TREE_TYPE (max_field), t),
+                                   NULL_TREE));
+         template = gnat_build_constructor (template_type, t);
+         template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template);
+
+         /* For class S, we are done.  */
+         if (iclass == 1)
+           break;
+
+         /* Test that we really have a SB descriptor, like DEC Ada.  */
+         t = build3 (COMPONENT_REF, TREE_TYPE (class), desc, class, NULL);
+         u = convert (TREE_TYPE (class), DECL_INITIAL (class));
+         u = build_binary_op (EQ_EXPR, integer_type_node, t, u);
+         /* If so, there is already a template in the descriptor and
+            it is located right after the POINTER field.  The fields are
+             64bits so they must be repacked. */
+         t = TREE_CHAIN (pointer64);
+          lfield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
+          lfield = convert (TREE_TYPE (TYPE_FIELDS (template_type)), lfield);
+
+         t = TREE_CHAIN (t);
+          ufield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
+          ufield = convert
+           (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (template_type))), ufield);
+
+         /* Build the template in the form of a constructor. */
+         t = tree_cons (TYPE_FIELDS (template_type), lfield,
+                        tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)),
+                                    ufield, NULL_TREE));
+         template = gnat_build_constructor (template_type, t);
+
+         /* Otherwise use the {1, LENGTH} template we build above.  */
+         template_addr = build3 (COND_EXPR, p_bounds_type, u,
+                                 build_unary_op (ADDR_EXPR, p_bounds_type,
+                                                template),
+                                 template_addr);
+         break;
+
+       case 4:  /* Class A */
+         /* The AFLAGS field is the 3rd field after the pointer in the
+             descriptor.  */
+         t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (pointer64)));
+         aflags = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
+         /* The DIMCT field is the next field in the descriptor after
+             aflags.  */
+         t = TREE_CHAIN (t);
+         dimct = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
+         /* Raise CONSTRAINT_ERROR if either more than 1 dimension
+            or FL_COEFF or FL_BOUNDS not set.  */
+         u = build_int_cst (TREE_TYPE (aflags), 192);
+         u = build_binary_op (TRUTH_OR_EXPR, integer_type_node,
+                              build_binary_op (NE_EXPR, integer_type_node,
+                                               dimct,
+                                               convert (TREE_TYPE (dimct),
+                                                        size_one_node)),
+                              build_binary_op (NE_EXPR, integer_type_node,
+                                               build2 (BIT_AND_EXPR,
+                                                       TREE_TYPE (aflags),
+                                                       aflags, u),
+                                               u));
+         /* There is already a template in the descriptor and it is located
+             in block 3.  The fields are 64bits so they must be repacked. */
+         t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN
+              (t)))));
+          lfield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
+          lfield = convert (TREE_TYPE (TYPE_FIELDS (template_type)), lfield);
+
+         t = TREE_CHAIN (t);
+          ufield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
+          ufield = convert
+           (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (template_type))), ufield);
+
+         /* Build the template in the form of a constructor. */
+         t = tree_cons (TYPE_FIELDS (template_type), lfield,
+                        tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)),
+                                    ufield, NULL_TREE));
+         template = gnat_build_constructor (template_type, t);
+         template = build3 (COND_EXPR, p_bounds_type, u,
+                           build_call_raise (CE_Length_Check_Failed, Empty,
+                                             N_Raise_Constraint_Error),
+                           template);
+         template_addr = build_unary_op (ADDR_EXPR, p_bounds_type, template);
+         break;
+
+       case 10: /* Class NCA */
+       default:
+         post_error ("unsupported descriptor type for &", gnat_subprog);
+         template_addr = integer_zero_node;
+         break;
+       }
+
+      /* Build the fat pointer in the form of a constructor.  */
+      t = tree_cons (TYPE_FIELDS (gnu_type), gnu_expr64,
+                    tree_cons (TREE_CHAIN (TYPE_FIELDS (gnu_type)),
+                               template_addr, NULL_TREE));
+      return gnat_build_constructor (gnu_type, t);
+    }
+
+  else
+    gcc_unreachable ();
+}
+
+/* Convert GNU_EXPR, a pointer to a 32bit VMS descriptor, to GNU_TYPE, a
+   regular pointer or fat pointer type.  GNAT_SUBPROG is the subprogram to
+   which the VMS descriptor is passed.  */
+
+static tree
+convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
 {
   tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr));
   tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr);
@@ -3298,11 +3460,11 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
   tree pointer = TREE_CHAIN (class);
 
   /* Retrieve the value of the POINTER field.  */
-  gnu_expr
+  tree gnu_expr32
     = build3 (COMPONENT_REF, TREE_TYPE (pointer), desc, pointer, NULL_TREE);
 
   if (POINTER_TYPE_P (gnu_type))
-    return convert (gnu_type, gnu_expr);
+    return convert (gnu_type, gnu_expr32);
 
   else if (TYPE_FAT_POINTER_P (gnu_type))
     {
@@ -3316,7 +3478,7 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
       int iclass = TREE_INT_CST_LOW (DECL_INITIAL (class));
 
       /* Convert POINTER to the type of the P_ARRAY field.  */
-      gnu_expr = convert (p_array_type, gnu_expr);
+      gnu_expr32 = convert (p_array_type, gnu_expr32);
 
       switch (iclass)
        {
@@ -3372,14 +3534,14 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
                                                        TREE_TYPE (aflags),
                                                        aflags, u),
                                                u));
-         add_stmt (build3 (COND_EXPR, void_type_node, u,
-                           build_call_raise (CE_Length_Check_Failed, Empty,
-                                             N_Raise_Constraint_Error),
-                           NULL_TREE));
          /* There is already a template in the descriptor and it is
             located at the start of block 3 (12th field).  */
          t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (t))));
          template = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
+         template = build3 (COND_EXPR, p_bounds_type, u,
+                           build_call_raise (CE_Length_Check_Failed, Empty,
+                                             N_Raise_Constraint_Error),
+                           template);
          template_addr = build_unary_op (ADDR_EXPR, p_bounds_type, template);
          break;
 
@@ -3391,9 +3553,10 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
        }
 
       /* Build the fat pointer in the form of a constructor.  */
-      t = tree_cons (TYPE_FIELDS (gnu_type), gnu_expr,
+      t = tree_cons (TYPE_FIELDS (gnu_type), gnu_expr32,
                     tree_cons (TREE_CHAIN (TYPE_FIELDS (gnu_type)),
                                template_addr, NULL_TREE));
+
       return gnat_build_constructor (gnu_type, t);
     }
 
@@ -3401,6 +3564,56 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
     gcc_unreachable ();
 }
 
+/* Convert GNU_EXPR, a pointer to a VMS descriptor, to GNU_TYPE, a
+   regular pointer or fat pointer type.  GNAT_SUBPROG is the subprogram to
+   which the VMS descriptor is passed.  */
+
+static tree
+convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
+{
+  tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr));
+  tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr);
+  tree mbo = TYPE_FIELDS (desc_type);
+  const char *mbostr = IDENTIFIER_POINTER (DECL_NAME (mbo));
+  tree mbmo = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (mbo)));
+  tree is64bit;
+  tree save_type = TREE_TYPE (gnu_expr);
+  tree gnu_expr32, gnu_expr64;
+
+  if (strcmp (mbostr, "MBO") != 0)
+    /* If the field name is not MBO, it must be 32bit and no alternate */
+    return convert_vms_descriptor32 (gnu_type, gnu_expr, gnat_subprog);
+
+  /* Otherwise primary must be 64bit and alternate 32bit */
+
+  /* Test for 64bit descriptor */
+  mbo = build3 (COMPONENT_REF, TREE_TYPE (mbo), desc, mbo, NULL_TREE);
+  mbmo = build3 (COMPONENT_REF, TREE_TYPE (mbmo), desc, mbmo, NULL_TREE);
+  is64bit = build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node,
+            build_binary_op (EQ_EXPR, integer_type_node,
+                                convert (integer_type_node, mbo),
+                                integer_one_node),
+            build_binary_op (EQ_EXPR, integer_type_node,
+                                convert (integer_type_node, mbmo),
+                                integer_minus_one_node));
+
+  gnu_expr64 = convert_vms_descriptor64 (gnu_type, gnu_expr,
+                                         gnat_subprog);
+  /* Convert 32bit alternate. Hack alert ??? */
+  TREE_TYPE (gnu_expr) = DECL_PARM_ALT (gnu_expr);
+  gnu_expr32 = convert_vms_descriptor32 (gnu_type, gnu_expr,
+                                         gnat_subprog);
+  TREE_TYPE (gnu_expr) = save_type;
+
+  if (POINTER_TYPE_P (gnu_type))
+     return build3 (COND_EXPR, gnu_type, is64bit, gnu_expr64, gnu_expr32);
+
+  else if (TYPE_FAT_POINTER_P (gnu_type))
+      return build3 (COND_EXPR, gnu_type, is64bit, gnu_expr64, gnu_expr32);
+  else
+    gcc_unreachable ();
+}
+
 /* Build a stub for the subprogram specified by the GCC tree GNU_SUBPROG
    and the GNAT node GNAT_SUBPROG.  */
 

diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c
index 1ed1b9f9cdba0bb17e457c9f4fed6eec500b78fa..1424ac8649afbba4dfc7c9207ff003452e4ddb19 100644 (file)
--- a/gcc/ada/gcc-interface/utils2.c
+++ b/gcc/ada/gcc-interface/utils2.c
@@ -2156,37 +2156,13 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
    alternate 64bit descriptor. */
 
 tree
-fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual)
+fill_vms_descriptor (tree expr, Entity_Id gnat_formal)
 {
   tree field;
   tree parm_decl = get_gnu_tree (gnat_formal);
   tree const_list = NULL_TREE;
-  int size;
   tree record_type;
 
-  /* A string literal will always be in 32bit space on VMS. Where
-     will it be on other 64bit systems???
-     An identifier's allocation may be unknown at compile time.
-     An explicit dereference could be either in 32bit or 64bit space.
-     Don't know about other possibilities, so assume unknown which
-     will result in fetching the 64bit descriptor. ??? */
-  if (Nkind (gnat_actual) == N_String_Literal)
-    size = 32;
-  else if (Nkind (gnat_actual) == N_Identifier)
-    size = UI_To_Int (Esize (Etype (gnat_actual)));
-  else if (Nkind (gnat_actual) == N_Explicit_Dereference)
-    size = UI_To_Int (Esize (Etype (Prefix (gnat_actual))));
-  else
-    size = 0;
-
-  /* If size is unknown, make it POINTER_SIZE */
-  if (size == 0)
-    size = POINTER_SIZE;
-
-  /* If size is 64bits grab the alternate 64bit descriptor. */
-  if (size == 64)
-    TREE_TYPE (parm_decl) = DECL_PARM_ALT (parm_decl);
-
   record_type = TREE_TYPE (TREE_TYPE (parm_decl));
   expr = maybe_unconstrained_array (expr);
   gnat_mark_addressable (expr);

diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 8c1759471ef3a54075edb92fd20b497d430381ee..50af374938a937187c658016fd172d147d45f7c3 100644 (file)
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -1852,6 +1852,7 @@ MECHANISM_NAME ::=
   Value
 | Reference
 | Descriptor [([Class =>] CLASS_NAME)]
+| Short_Descriptor [([Class =>] CLASS_NAME)]
 
 CLASS_NAME ::= ubs | ubsb | uba | s | sb | a
 @end smallexample
@@ -1884,6 +1885,9 @@ anonymous access parameter.
 @cindex OpenVMS
 @cindex Passing by descriptor
 Passing by descriptor is supported only on the OpenVMS ports of GNAT@.
+The default behavior for Export_Function is to accept either 64bit or
+32bit descriptors unless short_descriptor is specified, then only 32bit
+descriptors are accepted.
 
 @cindex Suppressing external name
 Special treatment is given if the EXTERNAL is an explicit null
@@ -1953,6 +1957,7 @@ MECHANISM_NAME ::=
   Value
 | Reference
 | Descriptor [([Class =>] CLASS_NAME)]
+| Short_Descriptor [([Class =>] CLASS_NAME)]
 
 CLASS_NAME ::= ubs | ubsb | uba | s | sb | a
 @end smallexample
@@ -1970,6 +1975,9 @@ pragma that specifies the desired foreign convention.
 @cindex OpenVMS
 @cindex Passing by descriptor
 Passing by descriptor is supported only on the OpenVMS ports of GNAT@.
+The default behavior for Export_Procedure is to accept either 64bit or
+32bit descriptors unless short_descriptor is specified, then only 32bit
+descriptors are accepted.
 
 @cindex Suppressing external name
 Special treatment is given if the EXTERNAL is an explicit null
@@ -2035,6 +2043,7 @@ MECHANISM_NAME ::=
   Value
 | Reference
 | Descriptor [([Class =>] CLASS_NAME)]
+| Short_Descriptor [([Class =>] CLASS_NAME)]
 
 CLASS_NAME ::= ubs | ubsb | uba | s | sb | a
 @end smallexample
@@ -2057,6 +2066,9 @@ pragma that specifies the desired foreign convention.
 @cindex OpenVMS
 @cindex Passing by descriptor
 Passing by descriptor is supported only on the OpenVMS ports of GNAT@.
+The default behavior for Export_Valued_Procedure is to accept either 64bit or
+32bit descriptors unless short_descriptor is specified, then only 32bit
+descriptors are accepted.
 
 @cindex Suppressing external name
 Special treatment is given if the EXTERNAL is an explicit null
@@ -2483,6 +2495,7 @@ MECHANISM_NAME ::=
   Value
 | Reference
 | Descriptor [([Class =>] CLASS_NAME)]
+| Short_Descriptor [([Class =>] CLASS_NAME)]
 
 CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
 @end smallexample
@@ -2516,6 +2529,8 @@ is used.
 @cindex OpenVMS
 @cindex Passing by descriptor
 Passing by descriptor is supported only on the OpenVMS ports of GNAT@.
+The default behavior for Import_Function is to pass a 64bit descriptor
+unless short_descriptor is specified, then a 32bit descriptor is passed.
 
 @code{First_Optional_Parameter} applies only to OpenVMS ports of GNAT@.
 It specifies that the designated parameter and all following parameters
@@ -2589,6 +2604,7 @@ MECHANISM_NAME ::=
   Value
 | Reference
 | Descriptor [([Class =>] CLASS_NAME)]
+| Short_Descriptor [([Class =>] CLASS_NAME)]
 
 CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
 @end smallexample
@@ -2635,6 +2651,7 @@ MECHANISM_NAME ::=
   Value
 | Reference
 | Descriptor [([Class =>] CLASS_NAME)]
+| Short_Descriptor [([Class =>] CLASS_NAME)]
 
 CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
 @end smallexample

diff --git a/gcc/ada/sem_mech.adb b/gcc/ada/sem_mech.adb
index 177a39ca671904dbad87f01cdcb4aa80874d69cf..87a0d054451e5e54ae4588c4b081f0fea12945ab 100644 (file)
--- a/gcc/ada/sem_mech.adb
+++ b/gcc/ada/sem_mech.adb
@@ -69,7 +69,7 @@ package body Sem_Mech is
            ("mechanism for & has already been set", Mech_Name, Ent);
       end if;
 
-      --  MECHANISM_NAME ::= value | reference | descriptor
+      --  MECHANISM_NAME ::= value | reference | descriptor | short_descriptor
 
       if Nkind (Mech_Name) = N_Identifier then
          if Chars (Mech_Name) = Name_Value then
@@ -85,6 +85,11 @@ package body Sem_Mech is
             Set_Mechanism_With_Checks (Ent, By_Descriptor, Mech_Name);
             return;
 
+         elsif Chars (Mech_Name) = Name_Short_Descriptor then
+            Check_VMS (Mech_Name);
+            Set_Mechanism_With_Checks (Ent, By_Short_Descriptor, Mech_Name);
+            return;
+
          elsif Chars (Mech_Name) = Name_Copy then
             Error_Msg_N
               ("bad mechanism name, Value assumed", Mech_Name);
@@ -95,7 +100,8 @@ package body Sem_Mech is
             return;
          end if;
 
-      --  MECHANISM_NAME ::= descriptor (CLASS_NAME)
+      --  MECHANISM_NAME ::= descriptor (CLASS_NAME) |
+      --                     short_descriptor (CLASS_NAME)
       --  CLASS_NAME     ::= ubs | ubsb | uba | s | sb | a | nca
 
       --  Note: this form is parsed as an indexed component
@@ -104,14 +110,16 @@ package body Sem_Mech is
          Class := First (Expressions (Mech_Name));
 
          if Nkind (Prefix (Mech_Name)) /= N_Identifier
-           or else Chars (Prefix (Mech_Name)) /= Name_Descriptor
+           or else not (Chars (Prefix (Mech_Name)) = Name_Descriptor or else
+                        Chars (Prefix (Mech_Name)) = Name_Short_Descriptor)
            or else Present (Next (Class))
          then
             Bad_Mechanism;
             return;
          end if;
 
-      --  MECHANISM_NAME ::= descriptor (Class => CLASS_NAME)
+      --  MECHANISM_NAME ::= descriptor (Class => CLASS_NAME) |
+      --                     short_descriptor (Class => CLASS_NAME)
       --  CLASS_NAME     ::= ubs | ubsb | uba | s | sb | a | nca
 
       --  Note: this form is parsed as a function call
@@ -121,7 +129,8 @@ package body Sem_Mech is
          Param := First (Parameter_Associations (Mech_Name));
 
          if Nkind (Name (Mech_Name)) /= N_Identifier
-           or else Chars (Name (Mech_Name)) /= Name_Descriptor
+           or else not (Chars (Name (Mech_Name)) = Name_Descriptor or else
+                        Chars (Name (Mech_Name)) = Name_Short_Descriptor)
            or else Present (Next (Param))
            or else No (Selector_Name (Param))
            or else Chars (Selector_Name (Param)) /= Name_Class
@@ -145,27 +154,76 @@ package body Sem_Mech is
          Bad_Class;
          return;
 
-      elsif Chars (Class) = Name_UBS then
+      elsif Chars (Name (Mech_Name)) = Name_Descriptor
+        and then Chars (Class) = Name_UBS
+      then
          Set_Mechanism_With_Checks (Ent, By_Descriptor_UBS,  Mech_Name);
 
-      elsif Chars (Class) = Name_UBSB then
+      elsif Chars (Name (Mech_Name)) = Name_Descriptor
+        and then Chars (Class) = Name_UBSB
+      then
          Set_Mechanism_With_Checks (Ent, By_Descriptor_UBSB, Mech_Name);
 
-      elsif Chars (Class) = Name_UBA then
+      elsif Chars (Name (Mech_Name)) = Name_Descriptor
+        and then Chars (Class) = Name_UBA
+      then
          Set_Mechanism_With_Checks (Ent, By_Descriptor_UBA,  Mech_Name);
 
-      elsif Chars (Class) = Name_S then
+      elsif Chars (Name (Mech_Name)) = Name_Descriptor
+        and then Chars (Class) = Name_S
+      then
          Set_Mechanism_With_Checks (Ent, By_Descriptor_S,    Mech_Name);
 
-      elsif Chars (Class) = Name_SB then
+      elsif Chars (Name (Mech_Name)) = Name_Descriptor
+        and then Chars (Class) = Name_SB
+      then
          Set_Mechanism_With_Checks (Ent, By_Descriptor_SB,   Mech_Name);
 
-      elsif Chars (Class) = Name_A then
+      elsif Chars (Name (Mech_Name)) = Name_Descriptor
+        and then Chars (Class) = Name_A
+      then
          Set_Mechanism_With_Checks (Ent, By_Descriptor_A,    Mech_Name);
 
-      elsif Chars (Class) = Name_NCA then
+      elsif Chars (Name (Mech_Name)) = Name_Descriptor
+        and then Chars (Class) = Name_NCA
+      then
          Set_Mechanism_With_Checks (Ent, By_Descriptor_NCA,  Mech_Name);
 
+      elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+        and then Chars (Class) = Name_UBS
+      then
+         Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBS,  Mech_Name);
+
+      elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+        and then Chars (Class) = Name_UBSB
+      then
+         Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBSB, Mech_Name);
+
+      elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+        and then Chars (Class) = Name_UBA
+      then
+         Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBA,  Mech_Name);
+
+      elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+        and then Chars (Class) = Name_S
+      then
+         Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_S,    Mech_Name);
+
+      elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+        and then Chars (Class) = Name_SB
+      then
+         Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_SB,   Mech_Name);
+
+      elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+        and then Chars (Class) = Name_A
+      then
+         Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_A,    Mech_Name);
+
+      elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+        and then Chars (Class) = Name_NCA
+      then
+         Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_NCA,  Mech_Name);
+
       else
          Bad_Class;
          return;

diff --git a/gcc/ada/sem_mech.ads b/gcc/ada/sem_mech.ads
index 1673a671b0ec3a9080c34e2cc4b628babac7e953..93f6080f1f4e0e7bb46ec4ae6d15f05bc897873d 100644 (file)
--- a/gcc/ada/sem_mech.ads
+++ b/gcc/ada/sem_mech.ads
@@ -95,6 +95,14 @@ package Sem_Mech is
    By_Descriptor_SB   : constant Mechanism_Type := -8;
    By_Descriptor_A    : constant Mechanism_Type := -9;
    By_Descriptor_NCA  : constant Mechanism_Type := -10;
+   By_Short_Descriptor      : constant Mechanism_Type := -11;
+   By_Short_Descriptor_UBS  : constant Mechanism_Type := -12;
+   By_Short_Descriptor_UBSB : constant Mechanism_Type := -13;
+   By_Short_Descriptor_UBA  : constant Mechanism_Type := -14;
+   By_Short_Descriptor_S    : constant Mechanism_Type := -15;
+   By_Short_Descriptor_SB   : constant Mechanism_Type := -16;
+   By_Short_Descriptor_A    : constant Mechanism_Type := -17;
+   By_Short_Descriptor_NCA  : constant Mechanism_Type := -18;
    --  These values are used only in OpenVMS ports of GNAT. Pass by descriptor
    --  is forced, as described in the OpenVMS ABI. The suffix indicates the
    --  descriptor type:
@@ -113,7 +121,7 @@ package Sem_Mech is
    --  type based on the Ada type in accordance with the OpenVMS ABI.
 
    subtype Descriptor_Codes is Mechanism_Type
-     range By_Descriptor_NCA .. By_Descriptor;
+     range By_Short_Descriptor_NCA .. By_Descriptor;
    --  Subtype including all descriptor mechanisms
 
    --  All the above special values are non-positive. Positive values for

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 8d162e6b37b8d68d9ee77f83cead746cde17c246..803f054ce4f19a2307a08ba91033a0dcd4207d38 100644 (file)
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -4622,6 +4622,7 @@ package body Sem_Prag is
       procedure Set_Mechanism_Value (Ent : Entity_Id; Mech_Name : Node_Id) is
          Class : Node_Id;
          Param : Node_Id;
+         Mech_Name_Id : Name_Id;
 
          procedure Bad_Class;
          --  Signal bad descriptor class name
@@ -4655,7 +4656,8 @@ package body Sem_Prag is
               ("mechanism for & has already been set", Mech_Name, Ent);
          end if;
 
-         --  MECHANISM_NAME ::= value | reference | descriptor
+         --  MECHANISM_NAME ::= value | reference | descriptor |
+         --                     short_descriptor
 
          if Nkind (Mech_Name) = N_Identifier then
             if Chars (Mech_Name) = Name_Value then
@@ -4671,6 +4673,11 @@ package body Sem_Prag is
                Set_Mechanism (Ent, By_Descriptor);
                return;
 
+            elsif Chars (Mech_Name) = Name_Short_Descriptor then
+               Check_VMS (Mech_Name);
+               Set_Mechanism (Ent, By_Short_Descriptor);
+               return;
+
             elsif Chars (Mech_Name) = Name_Copy then
                Error_Pragma_Arg
                  ("bad mechanism name, Value assumed", Mech_Name);
@@ -4679,22 +4686,28 @@ package body Sem_Prag is
                Bad_Mechanism;
             end if;
 
-         --  MECHANISM_NAME ::= descriptor (CLASS_NAME)
+         --  MECHANISM_NAME ::= descriptor (CLASS_NAME) |
+         --                     short_descriptor (CLASS_NAME)
          --  CLASS_NAME     ::= ubs | ubsb | uba | s | sb | a | nca
 
          --  Note: this form is parsed as an indexed component
 
          elsif Nkind (Mech_Name) = N_Indexed_Component then
+
             Class := First (Expressions (Mech_Name));
 
             if Nkind (Prefix (Mech_Name)) /= N_Identifier
-              or else Chars (Prefix (Mech_Name)) /= Name_Descriptor
-              or else Present (Next (Class))
+             or else not (Chars (Prefix (Mech_Name)) = Name_Descriptor or else
+                          Chars (Prefix (Mech_Name)) = Name_Short_Descriptor)
+             or else Present (Next (Class))
             then
                Bad_Mechanism;
+            else
+               Mech_Name_Id := Chars (Prefix (Mech_Name));
             end if;
 
-         --  MECHANISM_NAME ::= descriptor (Class => CLASS_NAME)
+         --  MECHANISM_NAME ::= descriptor (Class => CLASS_NAME) |
+         --                     short_descriptor (Class => CLASS_NAME)
          --  CLASS_NAME     ::= ubs | ubsb | uba | s | sb | a | nca
 
          --  Note: this form is parsed as a function call
@@ -4704,7 +4717,8 @@ package body Sem_Prag is
             Param := First (Parameter_Associations (Mech_Name));
 
             if Nkind (Name (Mech_Name)) /= N_Identifier
-              or else Chars (Name (Mech_Name)) /= Name_Descriptor
+              or else not (Chars (Name (Mech_Name)) = Name_Descriptor or else
+                           Chars (Name (Mech_Name)) = Name_Short_Descriptor)
               or else Present (Next (Param))
               or else No (Selector_Name (Param))
               or else Chars (Selector_Name (Param)) /= Name_Class
@@ -4712,6 +4726,7 @@ package body Sem_Prag is
                Bad_Mechanism;
             else
                Class := Explicit_Actual_Parameter (Param);
+               Mech_Name_Id := Chars (Name (Mech_Name));
             end if;
 
          else
@@ -4725,27 +4740,76 @@ package body Sem_Prag is
          if Nkind (Class) /= N_Identifier then
             Bad_Class;
 
-         elsif Chars (Class) = Name_UBS then
+         elsif Mech_Name_Id = Name_Descriptor
+               and then Chars (Class) = Name_UBS
+         then
             Set_Mechanism (Ent, By_Descriptor_UBS);
 
-         elsif Chars (Class) = Name_UBSB then
+         elsif Mech_Name_Id = Name_Descriptor
+               and then Chars (Class) = Name_UBSB
+         then
             Set_Mechanism (Ent, By_Descriptor_UBSB);
 
-         elsif Chars (Class) = Name_UBA then
+         elsif Mech_Name_Id = Name_Descriptor
+               and then Chars (Class) = Name_UBA
+         then
             Set_Mechanism (Ent, By_Descriptor_UBA);
 
-         elsif Chars (Class) = Name_S then
+         elsif Mech_Name_Id = Name_Descriptor
+               and then Chars (Class) = Name_S
+         then
             Set_Mechanism (Ent, By_Descriptor_S);
 
-         elsif Chars (Class) = Name_SB then
+         elsif Mech_Name_Id = Name_Descriptor
+               and then Chars (Class) = Name_SB
+         then
             Set_Mechanism (Ent, By_Descriptor_SB);
 
-         elsif Chars (Class) = Name_A then
+         elsif Mech_Name_Id = Name_Descriptor
+               and then Chars (Class) = Name_A
+         then
             Set_Mechanism (Ent, By_Descriptor_A);
 
-         elsif Chars (Class) = Name_NCA then
+         elsif Mech_Name_Id = Name_Descriptor
+               and then Chars (Class) = Name_NCA
+         then
             Set_Mechanism (Ent, By_Descriptor_NCA);
 
+         elsif Mech_Name_Id = Name_Short_Descriptor
+               and then Chars (Class) = Name_UBS
+         then
+            Set_Mechanism (Ent, By_Short_Descriptor_UBS);
+
+         elsif Mech_Name_Id = Name_Short_Descriptor
+               and then Chars (Class) = Name_UBSB
+         then
+            Set_Mechanism (Ent, By_Short_Descriptor_UBSB);
+
+         elsif Mech_Name_Id = Name_Short_Descriptor
+               and then Chars (Class) = Name_UBA
+         then
+            Set_Mechanism (Ent, By_Short_Descriptor_UBA);
+
+         elsif Mech_Name_Id = Name_Short_Descriptor
+               and then Chars (Class) = Name_S
+         then
+            Set_Mechanism (Ent, By_Short_Descriptor_S);
+
+         elsif Mech_Name_Id = Name_Short_Descriptor
+               and then Chars (Class) = Name_SB
+         then
+            Set_Mechanism (Ent, By_Short_Descriptor_SB);
+
+         elsif Mech_Name_Id = Name_Short_Descriptor
+               and then Chars (Class) = Name_A
+         then
+            Set_Mechanism (Ent, By_Short_Descriptor_A);
+
+         elsif Mech_Name_Id = Name_Short_Descriptor
+               and then Chars (Class) = Name_NCA
+         then
+            Set_Mechanism (Ent, By_Short_Descriptor_NCA);
+
          else
             Bad_Class;
          end if;

diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb
index e97ef15c19cc57f73f730c2249afc513aa9d330b..d23edf9ad6b7127a908d6ab147290526e72d2b66 100644 (file)
--- a/gcc/ada/snames.adb
+++ b/gcc/ada/snames.adb
@@ -415,6 +415,7 @@ package body Snames is
      "secondary_stack_size#" &
      "section#" &
      "semaphore#" &
+     "short_descriptor#" &
      "simple_barriers#" &
      "spec_file_name#" &
      "state#" &

diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads
index 67f35d0bcdb0a0f8724b3f6c0375c9a0e26a3ef6..5a47de55c896872a20ba0e6fb95a2c2bcb6324ab 100644 (file)
--- a/gcc/ada/snames.ads
+++ b/gcc/ada/snames.ads
@@ -643,28 +643,29 @@ package Snames is
    Name_Secondary_Stack_Size           : constant Name_Id := N + 354;
    Name_Section                        : constant Name_Id := N + 355;
    Name_Semaphore                      : constant Name_Id := N + 356;
-   Name_Simple_Barriers                : constant Name_Id := N + 357;
-   Name_Spec_File_Name                 : constant Name_Id := N + 358;
-   Name_State                          : constant Name_Id := N + 359;
-   Name_Static                         : constant Name_Id := N + 360;
-   Name_Stack_Size                     : constant Name_Id := N + 361;
-   Name_Subunit_File_Name              : constant Name_Id := N + 362;
-   Name_Task_Stack_Size_Default        : constant Name_Id := N + 363;
-   Name_Task_Type                      : constant Name_Id := N + 364;
-   Name_Time_Slicing_Enabled           : constant Name_Id := N + 365;
-   Name_Top_Guard                      : constant Name_Id := N + 366;
-   Name_UBA                            : constant Name_Id := N + 367;
-   Name_UBS                            : constant Name_Id := N + 368;
-   Name_UBSB                           : constant Name_Id := N + 369;
-   Name_Unit_Name                      : constant Name_Id := N + 370;
-   Name_Unknown                        : constant Name_Id := N + 371;
-   Name_Unrestricted                   : constant Name_Id := N + 372;
-   Name_Uppercase                      : constant Name_Id := N + 373;
-   Name_User                           : constant Name_Id := N + 374;
-   Name_VAX_Float                      : constant Name_Id := N + 375;
-   Name_VMS                            : constant Name_Id := N + 376;
-   Name_Vtable_Ptr                     : constant Name_Id := N + 377;
-   Name_Working_Storage                : constant Name_Id := N + 378;
+   Name_Short_Descriptor               : constant Name_Id := N + 357;
+   Name_Simple_Barriers                : constant Name_Id := N + 358;
+   Name_Spec_File_Name                 : constant Name_Id := N + 359;
+   Name_State                          : constant Name_Id := N + 360;
+   Name_Static                         : constant Name_Id := N + 361;
+   Name_Stack_Size                     : constant Name_Id := N + 362;
+   Name_Subunit_File_Name              : constant Name_Id := N + 363;
+   Name_Task_Stack_Size_Default        : constant Name_Id := N + 364;
+   Name_Task_Type                      : constant Name_Id := N + 365;
+   Name_Time_Slicing_Enabled           : constant Name_Id := N + 366;
+   Name_Top_Guard                      : constant Name_Id := N + 367;
+   Name_UBA                            : constant Name_Id := N + 368;
+   Name_UBS                            : constant Name_Id := N + 369;
+   Name_UBSB                           : constant Name_Id := N + 370;
+   Name_Unit_Name                      : constant Name_Id := N + 371;
+   Name_Unknown                        : constant Name_Id := N + 372;
+   Name_Unrestricted                   : constant Name_Id := N + 373;
+   Name_Uppercase                      : constant Name_Id := N + 374;
+   Name_User                           : constant Name_Id := N + 375;
+   Name_VAX_Float                      : constant Name_Id := N + 376;
+   Name_VMS                            : constant Name_Id := N + 377;
+   Name_Vtable_Ptr                     : constant Name_Id := N + 378;
+   Name_Working_Storage                : constant Name_Id := N + 379;
 
    --  Names of recognized attributes. The entries with the comment "Ada 83"
    --  are attributes that are defined in Ada 83, but not in Ada 95. These
@@ -678,175 +679,175 @@ package Snames is
    --  The entries marked VMS are recognized only in OpenVMS implementations
    --  of GNAT, and are treated as illegal in all other contexts.
 
-   First_Attribute_Name                : constant Name_Id := N + 379;
-   Name_Abort_Signal                   : constant Name_Id := N + 379; -- GNAT
-   Name_Access                         : constant Name_Id := N + 380;
-   Name_Address                        : constant Name_Id := N + 381;
-   Name_Address_Size                   : constant Name_Id := N + 382; -- GNAT
-   Name_Aft                            : constant Name_Id := N + 383;
-   Name_Alignment                      : constant Name_Id := N + 384;
-   Name_Asm_Input                      : constant Name_Id := N + 385; -- GNAT
-   Name_Asm_Output                     : constant Name_Id := N + 386; -- GNAT
-   Name_AST_Entry                      : constant Name_Id := N + 387; -- VMS
-   Name_Bit                            : constant Name_Id := N + 388; -- GNAT
-   Name_Bit_Order                      : constant Name_Id := N + 389;
-   Name_Bit_Position                   : constant Name_Id := N + 390; -- GNAT
-   Name_Body_Version                   : constant Name_Id := N + 391;
-   Name_Callable                       : constant Name_Id := N + 392;
-   Name_Caller                         : constant Name_Id := N + 393;
-   Name_Code_Address                   : constant Name_Id := N + 394; -- GNAT
-   Name_Component_Size                 : constant Name_Id := N + 395;
-   Name_Compose                        : constant Name_Id := N + 396;
-   Name_Constrained                    : constant Name_Id := N + 397;
-   Name_Count                          : constant Name_Id := N + 398;
-   Name_Default_Bit_Order              : constant Name_Id := N + 399; -- GNAT
-   Name_Definite                       : constant Name_Id := N + 400;
-   Name_Delta                          : constant Name_Id := N + 401;
-   Name_Denorm                         : constant Name_Id := N + 402;
-   Name_Digits                         : constant Name_Id := N + 403;
-   Name_Elaborated                     : constant Name_Id := N + 404; -- GNAT
-   Name_Emax                           : constant Name_Id := N + 405; -- Ada 83
-   Name_Enabled                        : constant Name_Id := N + 406; -- GNAT
-   Name_Enum_Rep                       : constant Name_Id := N + 407; -- GNAT
-   Name_Enum_Val                       : constant Name_Id := N + 408; -- GNAT
-   Name_Epsilon                        : constant Name_Id := N + 409; -- Ada 83
-   Name_Exponent                       : constant Name_Id := N + 410;
-   Name_External_Tag                   : constant Name_Id := N + 411;
-   Name_Fast_Math                      : constant Name_Id := N + 412; -- GNAT
-   Name_First                          : constant Name_Id := N + 413;
-   Name_First_Bit                      : constant Name_Id := N + 414;
-   Name_Fixed_Value                    : constant Name_Id := N + 415; -- GNAT
-   Name_Fore                           : constant Name_Id := N + 416;
-   Name_Has_Access_Values              : constant Name_Id := N + 417; -- GNAT
-   Name_Has_Discriminants              : constant Name_Id := N + 418; -- GNAT
-   Name_Has_Tagged_Values              : constant Name_Id := N + 419; -- GNAT
-   Name_Identity                       : constant Name_Id := N + 420;
-   Name_Img                            : constant Name_Id := N + 421; -- GNAT
-   Name_Integer_Value                  : constant Name_Id := N + 422; -- GNAT
-   Name_Invalid_Value                  : constant Name_Id := N + 423; -- GNAT
-   Name_Large                          : constant Name_Id := N + 424; -- Ada 83
-   Name_Last                           : constant Name_Id := N + 425;
-   Name_Last_Bit                       : constant Name_Id := N + 426;
-   Name_Leading_Part                   : constant Name_Id := N + 427;
-   Name_Length                         : constant Name_Id := N + 428;
-   Name_Machine_Emax                   : constant Name_Id := N + 429;
-   Name_Machine_Emin                   : constant Name_Id := N + 430;
-   Name_Machine_Mantissa               : constant Name_Id := N + 431;
-   Name_Machine_Overflows              : constant Name_Id := N + 432;
-   Name_Machine_Radix                  : constant Name_Id := N + 433;
-   Name_Machine_Rounding               : constant Name_Id := N + 434; -- Ada 05
-   Name_Machine_Rounds                 : constant Name_Id := N + 435;
-   Name_Machine_Size                   : constant Name_Id := N + 436; -- GNAT
-   Name_Mantissa                       : constant Name_Id := N + 437; -- Ada 83
-   Name_Max_Size_In_Storage_Elements   : constant Name_Id := N + 438;
-   Name_Maximum_Alignment              : constant Name_Id := N + 439; -- GNAT
-   Name_Mechanism_Code                 : constant Name_Id := N + 440; -- GNAT
-   Name_Mod                            : constant Name_Id := N + 441; -- Ada 05
-   Name_Model_Emin                     : constant Name_Id := N + 442;
-   Name_Model_Epsilon                  : constant Name_Id := N + 443;
-   Name_Model_Mantissa                 : constant Name_Id := N + 444;
-   Name_Model_Small                    : constant Name_Id := N + 445;
-   Name_Modulus                        : constant Name_Id := N + 446;
-   Name_Null_Parameter                 : constant Name_Id := N + 447; -- GNAT
-   Name_Object_Size                    : constant Name_Id := N + 448; -- GNAT
-   Name_Old                            : constant Name_Id := N + 449; -- GNAT
-   Name_Partition_ID                   : constant Name_Id := N + 450;
-   Name_Passed_By_Reference            : constant Name_Id := N + 451; -- GNAT
-   Name_Pool_Address                   : constant Name_Id := N + 452;
-   Name_Pos                            : constant Name_Id := N + 453;
-   Name_Position                       : constant Name_Id := N + 454;
-   Name_Priority                       : constant Name_Id := N + 455; -- Ada 05
-   Name_Range                          : constant Name_Id := N + 456;
-   Name_Range_Length                   : constant Name_Id := N + 457; -- GNAT
-   Name_Result                         : constant Name_Id := N + 458; -- GNAT
-   Name_Round                          : constant Name_Id := N + 459;
-   Name_Safe_Emax                      : constant Name_Id := N + 460; -- Ada 83
-   Name_Safe_First                     : constant Name_Id := N + 461;
-   Name_Safe_Large                     : constant Name_Id := N + 462; -- Ada 83
-   Name_Safe_Last                      : constant Name_Id := N + 463;
-   Name_Safe_Small                     : constant Name_Id := N + 464; -- Ada 83
-   Name_Scale                          : constant Name_Id := N + 465;
-   Name_Scaling                        : constant Name_Id := N + 466;
-   Name_Signed_Zeros                   : constant Name_Id := N + 467;
-   Name_Size                           : constant Name_Id := N + 468;
-   Name_Small                          : constant Name_Id := N + 469;
-   Name_Storage_Size                   : constant Name_Id := N + 470;
-   Name_Storage_Unit                   : constant Name_Id := N + 471; -- GNAT
-   Name_Stream_Size                    : constant Name_Id := N + 472; -- Ada 05
-   Name_Tag                            : constant Name_Id := N + 473;
-   Name_Target_Name                    : constant Name_Id := N + 474; -- GNAT
-   Name_Terminated                     : constant Name_Id := N + 475;
-   Name_To_Address                     : constant Name_Id := N + 476; -- GNAT
-   Name_Type_Class                     : constant Name_Id := N + 477; -- GNAT
-   Name_UET_Address                    : constant Name_Id := N + 478; -- GNAT
-   Name_Unbiased_Rounding              : constant Name_Id := N + 479;
-   Name_Unchecked_Access               : constant Name_Id := N + 480;
-   Name_Unconstrained_Array            : constant Name_Id := N + 481;
-   Name_Universal_Literal_String       : constant Name_Id := N + 482; -- GNAT
-   Name_Unrestricted_Access            : constant Name_Id := N + 483; -- GNAT
-   Name_VADS_Size                      : constant Name_Id := N + 484; -- GNAT
-   Name_Val                            : constant Name_Id := N + 485;
-   Name_Valid                          : constant Name_Id := N + 486;
-   Name_Value_Size                     : constant Name_Id := N + 487; -- GNAT
-   Name_Version                        : constant Name_Id := N + 488;
-   Name_Wchar_T_Size                   : constant Name_Id := N + 489; -- GNAT
-   Name_Wide_Wide_Width                : constant Name_Id := N + 490; -- Ada 05
-   Name_Wide_Width                     : constant Name_Id := N + 491;
-   Name_Width                          : constant Name_Id := N + 492;
-   Name_Word_Size                      : constant Name_Id := N + 493; -- GNAT
+   First_Attribute_Name                : constant Name_Id := N + 380;
+   Name_Abort_Signal                   : constant Name_Id := N + 380; -- GNAT
+   Name_Access                         : constant Name_Id := N + 381;
+   Name_Address                        : constant Name_Id := N + 382;
+   Name_Address_Size                   : constant Name_Id := N + 383; -- GNAT
+   Name_Aft                            : constant Name_Id := N + 384;
+   Name_Alignment                      : constant Name_Id := N + 385;
+   Name_Asm_Input                      : constant Name_Id := N + 386; -- GNAT
+   Name_Asm_Output                     : constant Name_Id := N + 387; -- GNAT
+   Name_AST_Entry                      : constant Name_Id := N + 388; -- VMS
+   Name_Bit                            : constant Name_Id := N + 389; -- GNAT
+   Name_Bit_Order                      : constant Name_Id := N + 390;
+   Name_Bit_Position                   : constant Name_Id := N + 391; -- GNAT
+   Name_Body_Version                   : constant Name_Id := N + 392;
+   Name_Callable                       : constant Name_Id := N + 393;
+   Name_Caller                         : constant Name_Id := N + 394;
+   Name_Code_Address                   : constant Name_Id := N + 395; -- GNAT
+   Name_Component_Size                 : constant Name_Id := N + 396;
+   Name_Compose                        : constant Name_Id := N + 397;
+   Name_Constrained                    : constant Name_Id := N + 398;
+   Name_Count                          : constant Name_Id := N + 399;
+   Name_Default_Bit_Order              : constant Name_Id := N + 400; -- GNAT
+   Name_Definite                       : constant Name_Id := N + 401;
+   Name_Delta                          : constant Name_Id := N + 402;
+   Name_Denorm                         : constant Name_Id := N + 403;
+   Name_Digits                         : constant Name_Id := N + 404;
+   Name_Elaborated                     : constant Name_Id := N + 405; -- GNAT
+   Name_Emax                           : constant Name_Id := N + 406; -- Ada 83
+   Name_Enabled                        : constant Name_Id := N + 407; -- GNAT
+   Name_Enum_Rep                       : constant Name_Id := N + 408; -- GNAT
+   Name_Enum_Val                       : constant Name_Id := N + 409; -- GNAT
+   Name_Epsilon                        : constant Name_Id := N + 410; -- Ada 83
+   Name_Exponent                       : constant Name_Id := N + 411;
+   Name_External_Tag                   : constant Name_Id := N + 412;
+   Name_Fast_Math                      : constant Name_Id := N + 413; -- GNAT
+   Name_First                          : constant Name_Id := N + 414;
+   Name_First_Bit                      : constant Name_Id := N + 415;
+   Name_Fixed_Value                    : constant Name_Id := N + 416; -- GNAT
+   Name_Fore                           : constant Name_Id := N + 417;
+   Name_Has_Access_Values              : constant Name_Id := N + 418; -- GNAT
+   Name_Has_Discriminants              : constant Name_Id := N + 419; -- GNAT
+   Name_Has_Tagged_Values              : constant Name_Id := N + 420; -- GNAT
+   Name_Identity                       : constant Name_Id := N + 421;
+   Name_Img                            : constant Name_Id := N + 422; -- GNAT
+   Name_Integer_Value                  : constant Name_Id := N + 423; -- GNAT
+   Name_Invalid_Value                  : constant Name_Id := N + 424; -- GNAT
+   Name_Large                          : constant Name_Id := N + 425; -- Ada 83
+   Name_Last                           : constant Name_Id := N + 426;
+   Name_Last_Bit                       : constant Name_Id := N + 427;
+   Name_Leading_Part                   : constant Name_Id := N + 428;
+   Name_Length                         : constant Name_Id := N + 429;
+   Name_Machine_Emax                   : constant Name_Id := N + 430;
+   Name_Machine_Emin                   : constant Name_Id := N + 431;
+   Name_Machine_Mantissa               : constant Name_Id := N + 432;
+   Name_Machine_Overflows              : constant Name_Id := N + 433;
+   Name_Machine_Radix                  : constant Name_Id := N + 434;
+   Name_Machine_Rounding               : constant Name_Id := N + 435; -- Ada 05
+   Name_Machine_Rounds                 : constant Name_Id := N + 436;
+   Name_Machine_Size                   : constant Name_Id := N + 437; -- GNAT
+   Name_Mantissa                       : constant Name_Id := N + 438; -- Ada 83
+   Name_Max_Size_In_Storage_Elements   : constant Name_Id := N + 439;
+   Name_Maximum_Alignment              : constant Name_Id := N + 440; -- GNAT
+   Name_Mechanism_Code                 : constant Name_Id := N + 441; -- GNAT
+   Name_Mod                            : constant Name_Id := N + 442; -- Ada 05
+   Name_Model_Emin                     : constant Name_Id := N + 443;
+   Name_Model_Epsilon                  : constant Name_Id := N + 444;
+   Name_Model_Mantissa                 : constant Name_Id := N + 445;
+   Name_Model_Small                    : constant Name_Id := N + 446;
+   Name_Modulus                        : constant Name_Id := N + 447;
+   Name_Null_Parameter                 : constant Name_Id := N + 448; -- GNAT
+   Name_Object_Size                    : constant Name_Id := N + 449; -- GNAT
+   Name_Old                            : constant Name_Id := N + 450; -- GNAT
+   Name_Partition_ID                   : constant Name_Id := N + 451;
+   Name_Passed_By_Reference            : constant Name_Id := N + 452; -- GNAT
+   Name_Pool_Address                   : constant Name_Id := N + 453;
+   Name_Pos                            : constant Name_Id := N + 454;
+   Name_Position                       : constant Name_Id := N + 455;
+   Name_Priority                       : constant Name_Id := N + 456; -- Ada 05
+   Name_Range                          : constant Name_Id := N + 457;
+   Name_Range_Length                   : constant Name_Id := N + 458; -- GNAT
+   Name_Result                         : constant Name_Id := N + 459; -- GNAT
+   Name_Round                          : constant Name_Id := N + 460;
+   Name_Safe_Emax                      : constant Name_Id := N + 461; -- Ada 83
+   Name_Safe_First                     : constant Name_Id := N + 462;
+   Name_Safe_Large                     : constant Name_Id := N + 463; -- Ada 83
+   Name_Safe_Last                      : constant Name_Id := N + 464;
+   Name_Safe_Small                     : constant Name_Id := N + 465; -- Ada 83
+   Name_Scale                          : constant Name_Id := N + 466;
+   Name_Scaling                        : constant Name_Id := N + 467;
+   Name_Signed_Zeros                   : constant Name_Id := N + 468;
+   Name_Size                           : constant Name_Id := N + 469;
+   Name_Small                          : constant Name_Id := N + 470;
+   Name_Storage_Size                   : constant Name_Id := N + 471;
+   Name_Storage_Unit                   : constant Name_Id := N + 472; -- GNAT
+   Name_Stream_Size                    : constant Name_Id := N + 473; -- Ada 05
+   Name_Tag                            : constant Name_Id := N + 474;
+   Name_Target_Name                    : constant Name_Id := N + 475; -- GNAT
+   Name_Terminated                     : constant Name_Id := N + 476;
+   Name_To_Address                     : constant Name_Id := N + 477; -- GNAT
+   Name_Type_Class                     : constant Name_Id := N + 478; -- GNAT
+   Name_UET_Address                    : constant Name_Id := N + 479; -- GNAT
+   Name_Unbiased_Rounding              : constant Name_Id := N + 480;
+   Name_Unchecked_Access               : constant Name_Id := N + 481;
+   Name_Unconstrained_Array            : constant Name_Id := N + 482;
+   Name_Universal_Literal_String       : constant Name_Id := N + 483; -- GNAT
+   Name_Unrestricted_Access            : constant Name_Id := N + 484; -- GNAT
+   Name_VADS_Size                      : constant Name_Id := N + 485; -- GNAT
+   Name_Val                            : constant Name_Id := N + 486;
+   Name_Valid                          : constant Name_Id := N + 487;
+   Name_Value_Size                     : constant Name_Id := N + 488; -- GNAT
+   Name_Version                        : constant Name_Id := N + 489;
+   Name_Wchar_T_Size                   : constant Name_Id := N + 490; -- GNAT
+   Name_Wide_Wide_Width                : constant Name_Id := N + 491; -- Ada 05
+   Name_Wide_Width                     : constant Name_Id := N + 492;
+   Name_Width                          : constant Name_Id := N + 493;
+   Name_Word_Size                      : constant Name_Id := N + 494; -- GNAT
 
    --  Attributes that designate attributes returning renamable functions,
    --  i.e. functions that return other than a universal value and that
    --  have non-universal arguments.
 
-   First_Renamable_Function_Attribute  : constant Name_Id := N + 494;
-   Name_Adjacent                       : constant Name_Id := N + 494;
-   Name_Ceiling                        : constant Name_Id := N + 495;
-   Name_Copy_Sign                      : constant Name_Id := N + 496;
-   Name_Floor                          : constant Name_Id := N + 497;
-   Name_Fraction                       : constant Name_Id := N + 498;
-   Name_Image                          : constant Name_Id := N + 499;
-   Name_Input                          : constant Name_Id := N + 500;
-   Name_Machine                        : constant Name_Id := N + 501;
-   Name_Max                            : constant Name_Id := N + 502;
-   Name_Min                            : constant Name_Id := N + 503;
-   Name_Model                          : constant Name_Id := N + 504;
-   Name_Pred                           : constant Name_Id := N + 505;
-   Name_Remainder                      : constant Name_Id := N + 506;
-   Name_Rounding                       : constant Name_Id := N + 507;
-   Name_Succ                           : constant Name_Id := N + 508;
-   Name_Truncation                     : constant Name_Id := N + 509;
-   Name_Value                          : constant Name_Id := N + 510;
-   Name_Wide_Image                     : constant Name_Id := N + 511;
-   Name_Wide_Wide_Image                : constant Name_Id := N + 512;
-   Name_Wide_Value                     : constant Name_Id := N + 513;
-   Name_Wide_Wide_Value                : constant Name_Id := N + 514;
-   Last_Renamable_Function_Attribute   : constant Name_Id := N + 514;
+   First_Renamable_Function_Attribute  : constant Name_Id := N + 495;
+   Name_Adjacent                       : constant Name_Id := N + 495;
+   Name_Ceiling                        : constant Name_Id := N + 496;
+   Name_Copy_Sign                      : constant Name_Id := N + 497;
+   Name_Floor                          : constant Name_Id := N + 498;
+   Name_Fraction                       : constant Name_Id := N + 499;
+   Name_Image                          : constant Name_Id := N + 500;
+   Name_Input                          : constant Name_Id := N + 501;
+   Name_Machine                        : constant Name_Id := N + 502;
+   Name_Max                            : constant Name_Id := N + 503;
+   Name_Min                            : constant Name_Id := N + 504;
+   Name_Model                          : constant Name_Id := N + 505;
+   Name_Pred                           : constant Name_Id := N + 506;
+   Name_Remainder                      : constant Name_Id := N + 507;
+   Name_Rounding                       : constant Name_Id := N + 508;
+   Name_Succ                           : constant Name_Id := N + 509;
+   Name_Truncation                     : constant Name_Id := N + 510;
+   Name_Value                          : constant Name_Id := N + 511;
+   Name_Wide_Image                     : constant Name_Id := N + 512;
+   Name_Wide_Wide_Image                : constant Name_Id := N + 513;
+   Name_Wide_Value                     : constant Name_Id := N + 514;
+   Name_Wide_Wide_Value                : constant Name_Id := N + 515;
+   Last_Renamable_Function_Attribute   : constant Name_Id := N + 515;
 
    --  Attributes that designate procedures
 
-   First_Procedure_Attribute           : constant Name_Id := N + 515;
-   Name_Output                         : constant Name_Id := N + 515;
-   Name_Read                           : constant Name_Id := N + 516;
-   Name_Write                          : constant Name_Id := N + 517;
-   Last_Procedure_Attribute            : constant Name_Id := N + 517;
+   First_Procedure_Attribute           : constant Name_Id := N + 516;
+   Name_Output                         : constant Name_Id := N + 516;
+   Name_Read                           : constant Name_Id := N + 517;
+   Name_Write                          : constant Name_Id := N + 518;
+   Last_Procedure_Attribute            : constant Name_Id := N + 518;
 
    --  Remaining attributes are ones that return entities
 
-   First_Entity_Attribute_Name         : constant Name_Id := N + 518;
-   Name_Elab_Body                      : constant Name_Id := N + 518; -- GNAT
-   Name_Elab_Spec                      : constant Name_Id := N + 519; -- GNAT
-   Name_Storage_Pool                   : constant Name_Id := N + 520;
+   First_Entity_Attribute_Name         : constant Name_Id := N + 519;
+   Name_Elab_Body                      : constant Name_Id := N + 519; -- GNAT
+   Name_Elab_Spec                      : constant Name_Id := N + 520; -- GNAT
+   Name_Storage_Pool                   : constant Name_Id := N + 521;
 
    --  These attributes are the ones that return types
 
-   First_Type_Attribute_Name           : constant Name_Id := N + 521;
-   Name_Base                           : constant Name_Id := N + 521;
-   Name_Class                          : constant Name_Id := N + 522;
-   Name_Stub_Type                      : constant Name_Id := N + 523;
-   Last_Type_Attribute_Name            : constant Name_Id := N + 523;
-   Last_Entity_Attribute_Name          : constant Name_Id := N + 523;
-   Last_Attribute_Name                 : constant Name_Id := N + 523;
+   First_Type_Attribute_Name           : constant Name_Id := N + 522;
+   Name_Base                           : constant Name_Id := N + 522;
+   Name_Class                          : constant Name_Id := N + 523;
+   Name_Stub_Type                      : constant Name_Id := N + 524;
+   Last_Type_Attribute_Name            : constant Name_Id := N + 524;
+   Last_Entity_Attribute_Name          : constant Name_Id := N + 524;
+   Last_Attribute_Name                 : constant Name_Id := N + 524;
 
    --  Names of recognized locking policy identifiers
 
@@ -854,10 +855,10 @@ package Snames is
    --  name (e.g. C for Ceiling_Locking). If new policy names are added,
    --  the first character must be distinct.
 
-   First_Locking_Policy_Name           : constant Name_Id := N + 524;
-   Name_Ceiling_Locking                : constant Name_Id := N + 524;
-   Name_Inheritance_Locking            : constant Name_Id := N + 525;
-   Last_Locking_Policy_Name            : constant Name_Id := N + 525;
+   First_Locking_Policy_Name           : constant Name_Id := N + 525;
+   Name_Ceiling_Locking                : constant Name_Id := N + 525;
+   Name_Inheritance_Locking            : constant Name_Id := N + 526;
+   Last_Locking_Policy_Name            : constant Name_Id := N + 526;
 
    --  Names of recognized queuing policy identifiers
 
@@ -865,10 +866,10 @@ package Snames is
    --  name (e.g. F for FIFO_Queuing). If new policy names are added,
    --  the first character must be distinct.
 
-   First_Queuing_Policy_Name           : constant Name_Id := N + 526;
-   Name_FIFO_Queuing                   : constant Name_Id := N + 526;
-   Name_Priority_Queuing               : constant Name_Id := N + 527;
-   Last_Queuing_Policy_Name            : constant Name_Id := N + 527;
+   First_Queuing_Policy_Name           : constant Name_Id := N + 527;
+   Name_FIFO_Queuing                   : constant Name_Id := N + 527;
+   Name_Priority_Queuing               : constant Name_Id := N + 528;
+   Last_Queuing_Policy_Name            : constant Name_Id := N + 528;
 
    --  Names of recognized task dispatching policy identifiers
 
@@ -876,283 +877,283 @@ package Snames is
    --  name (e.g. F for FIFO_Within_Priorities). If new policy names
    --  are added, the first character must be distinct.
 
-   First_Task_Dispatching_Policy_Name    : constant Name_Id := N + 528;
-   Name_EDF_Across_Priorities            : constant Name_Id := N + 528;
-   Name_FIFO_Within_Priorities           : constant Name_Id := N + 529;
-   Name_Non_Preemptive_Within_Priorities : constant Name_Id := N + 530;
-   Name_Round_Robin_Within_Priorities    : constant Name_Id := N + 531;
-   Last_Task_Dispatching_Policy_Name     : constant Name_Id := N + 531;
+   First_Task_Dispatching_Policy_Name    : constant Name_Id := N + 529;
+   Name_EDF_Across_Priorities            : constant Name_Id := N + 529;
+   Name_FIFO_Within_Priorities           : constant Name_Id := N + 530;
+   Name_Non_Preemptive_Within_Priorities : constant Name_Id := N + 531;
+   Name_Round_Robin_Within_Priorities    : constant Name_Id := N + 532;
+   Last_Task_Dispatching_Policy_Name     : constant Name_Id := N + 532;
 
    --  Names of recognized checks for pragma Suppress
 
-   First_Check_Name                    : constant Name_Id := N + 532;
-   Name_Access_Check                   : constant Name_Id := N + 532;
-   Name_Accessibility_Check            : constant Name_Id := N + 533;
-   Name_Alignment_Check                : constant Name_Id := N + 534; -- GNAT
-   Name_Discriminant_Check             : constant Name_Id := N + 535;
-   Name_Division_Check                 : constant Name_Id := N + 536;
-   Name_Elaboration_Check              : constant Name_Id := N + 537;
-   Name_Index_Check                    : constant Name_Id := N + 538;
-   Name_Length_Check                   : constant Name_Id := N + 539;
-   Name_Overflow_Check                 : constant Name_Id := N + 540;
-   Name_Range_Check                    : constant Name_Id := N + 541;
-   Name_Storage_Check                  : constant Name_Id := N + 542;
-   Name_Tag_Check                      : constant Name_Id := N + 543;
-   Name_Validity_Check                 : constant Name_Id := N + 544; -- GNAT
-   Name_All_Checks                     : constant Name_Id := N + 545;
-   Last_Check_Name                     : constant Name_Id := N + 545;
+   First_Check_Name                    : constant Name_Id := N + 533;
+   Name_Access_Check                   : constant Name_Id := N + 533;
+   Name_Accessibility_Check            : constant Name_Id := N + 534;
+   Name_Alignment_Check                : constant Name_Id := N + 535; -- GNAT
+   Name_Discriminant_Check             : constant Name_Id := N + 536;
+   Name_Division_Check                 : constant Name_Id := N + 537;
+   Name_Elaboration_Check              : constant Name_Id := N + 538;
+   Name_Index_Check                    : constant Name_Id := N + 539;
+   Name_Length_Check                   : constant Name_Id := N + 540;
+   Name_Overflow_Check                 : constant Name_Id := N + 541;
+   Name_Range_Check                    : constant Name_Id := N + 542;
+   Name_Storage_Check                  : constant Name_Id := N + 543;
+   Name_Tag_Check                      : constant Name_Id := N + 544;
+   Name_Validity_Check                 : constant Name_Id := N + 545; -- GNAT
+   Name_All_Checks                     : constant Name_Id := N + 546;
+   Last_Check_Name                     : constant Name_Id := N + 546;
 
    --  Names corresponding to reserved keywords, excluding those already
    --  declared in the attribute list (Access, Delta, Digits, Mod, Range).
 
-   Name_Abort                          : constant Name_Id := N + 546;
-   Name_Abs                            : constant Name_Id := N + 547;
-   Name_Accept                         : constant Name_Id := N + 548;
-   Name_And                            : constant Name_Id := N + 549;
-   Name_All                            : constant Name_Id := N + 550;
-   Name_Array                          : constant Name_Id := N + 551;
-   Name_At                             : constant Name_Id := N + 552;
-   Name_Begin                          : constant Name_Id := N + 553;
-   Name_Body                           : constant Name_Id := N + 554;
-   Name_Case                           : constant Name_Id := N + 555;
-   Name_Constant                       : constant Name_Id := N + 556;
-   Name_Declare                        : constant Name_Id := N + 557;
-   Name_Delay                          : constant Name_Id := N + 558;
-   Name_Do                             : constant Name_Id := N + 559;
-   Name_Else                           : constant Name_Id := N + 560;
-   Name_Elsif                          : constant Name_Id := N + 561;
-   Name_End                            : constant Name_Id := N + 562;
-   Name_Entry                          : constant Name_Id := N + 563;
-   Name_Exception                      : constant Name_Id := N + 564;
-   Name_Exit                           : constant Name_Id := N + 565;
-   Name_For                            : constant Name_Id := N + 566;
-   Name_Function                       : constant Name_Id := N + 567;
-   Name_Generic                        : constant Name_Id := N + 568;
-   Name_Goto                           : constant Name_Id := N + 569;
-   Name_If                             : constant Name_Id := N + 570;
-   Name_In                             : constant Name_Id := N + 571;
-   Name_Is                             : constant Name_Id := N + 572;
-   Name_Limited                        : constant Name_Id := N + 573;
-   Name_Loop                           : constant Name_Id := N + 574;
-   Name_New                            : constant Name_Id := N + 575;
-   Name_Not                            : constant Name_Id := N + 576;
-   Name_Null                           : constant Name_Id := N + 577;
-   Name_Of                             : constant Name_Id := N + 578;
-   Name_Or                             : constant Name_Id := N + 579;
-   Name_Others                         : constant Name_Id := N + 580;
-   Name_Out                            : constant Name_Id := N + 581;
-   Name_Package                        : constant Name_Id := N + 582;
-   Name_Pragma                         : constant Name_Id := N + 583;
-   Name_Private                        : constant Name_Id := N + 584;
-   Name_Procedure                      : constant Name_Id := N + 585;
-   Name_Raise                          : constant Name_Id := N + 586;
-   Name_Record                         : constant Name_Id := N + 587;
-   Name_Rem                            : constant Name_Id := N + 588;
-   Name_Renames                        : constant Name_Id := N + 589;
-   Name_Return                         : constant Name_Id := N + 590;
-   Name_Reverse                        : constant Name_Id := N + 591;
-   Name_Select                         : constant Name_Id := N + 592;
-   Name_Separate                       : constant Name_Id := N + 593;
-   Name_Subtype                        : constant Name_Id := N + 594;
-   Name_Task                           : constant Name_Id := N + 595;
-   Name_Terminate                      : constant Name_Id := N + 596;
-   Name_Then                           : constant Name_Id := N + 597;
-   Name_Type                           : constant Name_Id := N + 598;
-   Name_Use                            : constant Name_Id := N + 599;
-   Name_When                           : constant Name_Id := N + 600;
-   Name_While                          : constant Name_Id := N + 601;
-   Name_With                           : constant Name_Id := N + 602;
-   Name_Xor                            : constant Name_Id := N + 603;
+   Name_Abort                          : constant Name_Id := N + 547;
+   Name_Abs                            : constant Name_Id := N + 548;
+   Name_Accept                         : constant Name_Id := N + 549;
+   Name_And                            : constant Name_Id := N + 550;
+   Name_All                            : constant Name_Id := N + 551;
+   Name_Array                          : constant Name_Id := N + 552;
+   Name_At                             : constant Name_Id := N + 553;
+   Name_Begin                          : constant Name_Id := N + 554;
+   Name_Body                           : constant Name_Id := N + 555;
+   Name_Case                           : constant Name_Id := N + 556;
+   Name_Constant                       : constant Name_Id := N + 557;
+   Name_Declare                        : constant Name_Id := N + 558;
+   Name_Delay                          : constant Name_Id := N + 559;
+   Name_Do                             : constant Name_Id := N + 560;
+   Name_Else                           : constant Name_Id := N + 561;
+   Name_Elsif                          : constant Name_Id := N + 562;
+   Name_End                            : constant Name_Id := N + 563;
+   Name_Entry                          : constant Name_Id := N + 564;
+   Name_Exception                      : constant Name_Id := N + 565;
+   Name_Exit                           : constant Name_Id := N + 566;
+   Name_For                            : constant Name_Id := N + 567;
+   Name_Function                       : constant Name_Id := N + 568;
+   Name_Generic                        : constant Name_Id := N + 569;
+   Name_Goto                           : constant Name_Id := N + 570;
+   Name_If                             : constant Name_Id := N + 571;
+   Name_In                             : constant Name_Id := N + 572;
+   Name_Is                             : constant Name_Id := N + 573;
+   Name_Limited                        : constant Name_Id := N + 574;
+   Name_Loop                           : constant Name_Id := N + 575;
+   Name_New                            : constant Name_Id := N + 576;
+   Name_Not                            : constant Name_Id := N + 577;
+   Name_Null                           : constant Name_Id := N + 578;
+   Name_Of                             : constant Name_Id := N + 579;
+   Name_Or                             : constant Name_Id := N + 580;
+   Name_Others                         : constant Name_Id := N + 581;
+   Name_Out                            : constant Name_Id := N + 582;
+   Name_Package                        : constant Name_Id := N + 583;
+   Name_Pragma                         : constant Name_Id := N + 584;
+   Name_Private                        : constant Name_Id := N + 585;
+   Name_Procedure                      : constant Name_Id := N + 586;
+   Name_Raise                          : constant Name_Id := N + 587;
+   Name_Record                         : constant Name_Id := N + 588;
+   Name_Rem                            : constant Name_Id := N + 589;
+   Name_Renames                        : constant Name_Id := N + 590;
+   Name_Return                         : constant Name_Id := N + 591;
+   Name_Reverse                        : constant Name_Id := N + 592;
+   Name_Select                         : constant Name_Id := N + 593;
+   Name_Separate                       : constant Name_Id := N + 594;
+   Name_Subtype                        : constant Name_Id := N + 595;
+   Name_Task                           : constant Name_Id := N + 596;
+   Name_Terminate                      : constant Name_Id := N + 597;
+   Name_Then                           : constant Name_Id := N + 598;
+   Name_Type                           : constant Name_Id := N + 599;
+   Name_Use                            : constant Name_Id := N + 600;
+   Name_When                           : constant Name_Id := N + 601;
+   Name_While                          : constant Name_Id := N + 602;
+   Name_With                           : constant Name_Id := N + 603;
+   Name_Xor                            : constant Name_Id := N + 604;
 
    --  Names of intrinsic subprograms
 
    --  Note: Asm is missing from this list, since Asm is a legitimate
    --  convention name. So is To_Address, which is a GNAT attribute.
 
-   First_Intrinsic_Name                 : constant Name_Id := N + 604;
-   Name_Divide                          : constant Name_Id := N + 604;
-   Name_Enclosing_Entity                : constant Name_Id := N + 605;
-   Name_Exception_Information           : constant Name_Id := N + 606;
-   Name_Exception_Message               : constant Name_Id := N + 607;
-   Name_Exception_Name                  : constant Name_Id := N + 608;
-   Name_File                            : constant Name_Id := N + 609;
-   Name_Generic_Dispatching_Constructor : constant Name_Id := N + 610;
-   Name_Import_Address                  : constant Name_Id := N + 611;
-   Name_Import_Largest_Value            : constant Name_Id := N + 612;
-   Name_Import_Value                    : constant Name_Id := N + 613;
-   Name_Is_Negative                     : constant Name_Id := N + 614;
-   Name_Line                            : constant Name_Id := N + 615;
-   Name_Rotate_Left                     : constant Name_Id := N + 616;
-   Name_Rotate_Right                    : constant Name_Id := N + 617;
-   Name_Shift_Left                      : constant Name_Id := N + 618;
-   Name_Shift_Right                     : constant Name_Id := N + 619;
-   Name_Shift_Right_Arithmetic          : constant Name_Id := N + 620;
-   Name_Source_Location                 : constant Name_Id := N + 621;
-   Name_Unchecked_Conversion            : constant Name_Id := N + 622;
-   Name_Unchecked_Deallocation          : constant Name_Id := N + 623;
-   Name_To_Pointer                      : constant Name_Id := N + 624;
-   Last_Intrinsic_Name                  : constant Name_Id := N + 624;
+   First_Intrinsic_Name                 : constant Name_Id := N + 605;
+   Name_Divide                          : constant Name_Id := N + 605;
+   Name_Enclosing_Entity                : constant Name_Id := N + 606;
+   Name_Exception_Information           : constant Name_Id := N + 607;
+   Name_Exception_Message               : constant Name_Id := N + 608;
+   Name_Exception_Name                  : constant Name_Id := N + 609;
+   Name_File                            : constant Name_Id := N + 610;
+   Name_Generic_Dispatching_Constructor : constant Name_Id := N + 611;
+   Name_Import_Address                  : constant Name_Id := N + 612;
+   Name_Import_Largest_Value            : constant Name_Id := N + 613;
+   Name_Import_Value                    : constant Name_Id := N + 614;
+   Name_Is_Negative                     : constant Name_Id := N + 615;
+   Name_Line                            : constant Name_Id := N + 616;
+   Name_Rotate_Left                     : constant Name_Id := N + 617;
+   Name_Rotate_Right                    : constant Name_Id := N + 618;
+   Name_Shift_Left                      : constant Name_Id := N + 619;
+   Name_Shift_Right                     : constant Name_Id := N + 620;
+   Name_Shift_Right_Arithmetic          : constant Name_Id := N + 621;
+   Name_Source_Location                 : constant Name_Id := N + 622;
+   Name_Unchecked_Conversion            : constant Name_Id := N + 623;
+   Name_Unchecked_Deallocation          : constant Name_Id := N + 624;
+   Name_To_Pointer                      : constant Name_Id := N + 625;
+   Last_Intrinsic_Name                  : constant Name_Id := N + 625;
 
    --  Names used in processing intrinsic calls
 
-   Name_Free                           : constant Name_Id := N + 625;
+   Name_Free                           : constant Name_Id := N + 626;
 
    --  Reserved words used only in Ada 95
 
-   First_95_Reserved_Word              : constant Name_Id := N + 626;
-   Name_Abstract                       : constant Name_Id := N + 626;
-   Name_Aliased                        : constant Name_Id := N + 627;
-   Name_Protected                      : constant Name_Id := N + 628;
-   Name_Until                          : constant Name_Id := N + 629;
-   Name_Requeue                        : constant Name_Id := N + 630;
-   Name_Tagged                         : constant Name_Id := N + 631;
-   Last_95_Reserved_Word               : constant Name_Id := N + 631;
+   First_95_Reserved_Word              : constant Name_Id := N + 627;
+   Name_Abstract                       : constant Name_Id := N + 627;
+   Name_Aliased                        : constant Name_Id := N + 628;
+   Name_Protected                      : constant Name_Id := N + 629;
+   Name_Until                          : constant Name_Id := N + 630;
+   Name_Requeue                        : constant Name_Id := N + 631;
+   Name_Tagged                         : constant Name_Id := N + 632;
+   Last_95_Reserved_Word               : constant Name_Id := N + 632;
 
    subtype Ada_95_Reserved_Words is
      Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word;
 
    --  Miscellaneous names used in semantic checking
 
-   Name_Raise_Exception                : constant Name_Id := N + 632;
+   Name_Raise_Exception                : constant Name_Id := N + 633;
 
    --  Additional reserved words and identifiers used in GNAT Project Files
    --  Note that Name_External is already previously declared
 
-   Name_Ada_Roots                      : constant Name_Id := N + 633;
-   Name_Aggregate                      : constant Name_Id := N + 634;
-   Name_Archive_Builder                : constant Name_Id := N + 635;
-   Name_Archive_Builder_Append_Option  : constant Name_Id := N + 636;
-   Name_Archive_Indexer                : constant Name_Id := N + 637;
-   Name_Archive_Suffix                 : constant Name_Id := N + 638;
-   Name_Binder                         : constant Name_Id := N + 639;
-   Name_Binder_Prefix                  : constant Name_Id := N + 640;
-   Name_Body_Suffix                    : constant Name_Id := N + 641;
-   Name_Builder                        : constant Name_Id := N + 642;
-   Name_Builder_Switches               : constant Name_Id := N + 643;
-   Name_Compiler                       : constant Name_Id := N + 644;
-   Name_Compiler_Kind                  : constant Name_Id := N + 645;
-   Name_Config_Body_File_Name          : constant Name_Id := N + 646;
-   Name_Config_Body_File_Name_Pattern  : constant Name_Id := N + 647;
-   Name_Config_File_Switches           : constant Name_Id := N + 648;
-   Name_Config_File_Unique             : constant Name_Id := N + 649;
-   Name_Config_Spec_File_Name          : constant Name_Id := N + 650;
-   Name_Config_Spec_File_Name_Pattern  : constant Name_Id := N + 651;
-   Name_Configuration                  : constant Name_Id := N + 652;
-   Name_Cross_Reference                : constant Name_Id := N + 653;
-   Name_Default_Language               : constant Name_Id := N + 654;
-   Name_Default_Switches               : constant Name_Id := N + 655;
-   Name_Dependency_Driver              : constant Name_Id := N + 656;
-   Name_Dependency_File_Kind           : constant Name_Id := N + 657;
-   Name_Dependency_Switches            : constant Name_Id := N + 658;
-   Name_Driver                         : constant Name_Id := N + 659;
-   Name_Excluded_Source_Dirs           : constant Name_Id := N + 660;
-   Name_Excluded_Source_Files          : constant Name_Id := N + 661;
-   Name_Excluded_Source_List_File      : constant Name_Id := N + 662;
-   Name_Exec_Dir                       : constant Name_Id := N + 663;
-   Name_Executable                     : constant Name_Id := N + 664;
-   Name_Executable_Suffix              : constant Name_Id := N + 665;
-   Name_Extends                        : constant Name_Id := N + 666;
-   Name_Externally_Built               : constant Name_Id := N + 667;
-   Name_Finder                         : constant Name_Id := N + 668;
-   Name_Global_Configuration_Pragmas   : constant Name_Id := N + 669;
-   Name_Global_Config_File             : constant Name_Id := N + 670;
-   Name_Gnatls                         : constant Name_Id := N + 671;
-   Name_Gnatstub                       : constant Name_Id := N + 672;
-   Name_Implementation                 : constant Name_Id := N + 673;
-   Name_Implementation_Exceptions      : constant Name_Id := N + 674;
-   Name_Implementation_Suffix          : constant Name_Id := N + 675;
-   Name_Include_Switches               : constant Name_Id := N + 676;
-   Name_Include_Path                   : constant Name_Id := N + 677;
-   Name_Include_Path_File              : constant Name_Id := N + 678;
-   Name_Inherit_Source_Path            : constant Name_Id := N + 679;
-   Name_Language_Kind                  : constant Name_Id := N + 680;
-   Name_Language_Processing            : constant Name_Id := N + 681;
-   Name_Languages                      : constant Name_Id := N + 682;
-   Name_Library                        : constant Name_Id := N + 683;
-   Name_Library_Ali_Dir                : constant Name_Id := N + 684;
-   Name_Library_Auto_Init              : constant Name_Id := N + 685;
-   Name_Library_Auto_Init_Supported    : constant Name_Id := N + 686;
-   Name_Library_Builder                : constant Name_Id := N + 687;
-   Name_Library_Dir                    : constant Name_Id := N + 688;
-   Name_Library_GCC                    : constant Name_Id := N + 689;
-   Name_Library_Interface              : constant Name_Id := N + 690;
-   Name_Library_Kind                   : constant Name_Id := N + 691;
-   Name_Library_Name                   : constant Name_Id := N + 692;
-   Name_Library_Major_Minor_Id_Supported : constant Name_Id := N + 693;
-   Name_Library_Options                : constant Name_Id := N + 694;
-   Name_Library_Partial_Linker         : constant Name_Id := N + 695;
-   Name_Library_Reference_Symbol_File  : constant Name_Id := N + 696;
-   Name_Library_Src_Dir                : constant Name_Id := N + 697;
-   Name_Library_Support                : constant Name_Id := N + 698;
-   Name_Library_Symbol_File            : constant Name_Id := N + 699;
-   Name_Library_Symbol_Policy          : constant Name_Id := N + 700;
-   Name_Library_Version                : constant Name_Id := N + 701;
-   Name_Library_Version_Switches       : constant Name_Id := N + 702;
-   Name_Linker                         : constant Name_Id := N + 703;
-   Name_Linker_Executable_Option       : constant Name_Id := N + 704;
-   Name_Linker_Lib_Dir_Option          : constant Name_Id := N + 705;
-   Name_Linker_Lib_Name_Option         : constant Name_Id := N + 706;
-   Name_Local_Config_File              : constant Name_Id := N + 707;
-   Name_Local_Configuration_Pragmas    : constant Name_Id := N + 708;
-   Name_Locally_Removed_Files          : constant Name_Id := N + 709;
-   Name_Map_File_Option                : constant Name_Id := N + 710;
-   Name_Mapping_File_Switches          : constant Name_Id := N + 711;
-   Name_Mapping_Spec_Suffix            : constant Name_Id := N + 712;
-   Name_Mapping_Body_Suffix            : constant Name_Id := N + 713;
-   Name_Metrics                        : constant Name_Id := N + 714;
-   Name_Naming                         : constant Name_Id := N + 715;
-   Name_Object_Generated               : constant Name_Id := N + 716;
-   Name_Objects_Linked                 : constant Name_Id := N + 717;
-   Name_Objects_Path                   : constant Name_Id := N + 718;
-   Name_Objects_Path_File              : constant Name_Id := N + 719;
-   Name_Object_Dir                     : constant Name_Id := N + 720;
-   Name_Pic_Option                     : constant Name_Id := N + 721;
-   Name_Pretty_Printer                 : constant Name_Id := N + 722;
-   Name_Prefix                         : constant Name_Id := N + 723;
-   Name_Project                        : constant Name_Id := N + 724;
-   Name_Roots                          : constant Name_Id := N + 725;
-   Name_Required_Switches              : constant Name_Id := N + 726;
-   Name_Run_Path_Option                : constant Name_Id := N + 727;
-   Name_Runtime_Project                : constant Name_Id := N + 728;
-   Name_Shared_Library_Minimum_Switches : constant Name_Id := N + 729;
-   Name_Shared_Library_Prefix          : constant Name_Id := N + 730;
-   Name_Shared_Library_Suffix          : constant Name_Id := N + 731;
-   Name_Separate_Suffix                : constant Name_Id := N + 732;
-   Name_Source_Dirs                    : constant Name_Id := N + 733;
-   Name_Source_Files                   : constant Name_Id := N + 734;
-   Name_Source_List_File               : constant Name_Id := N + 735;
-   Name_Spec                           : constant Name_Id := N + 736;
-   Name_Spec_Suffix                    : constant Name_Id := N + 737;
-   Name_Specification                  : constant Name_Id := N + 738;
-   Name_Specification_Exceptions       : constant Name_Id := N + 739;
-   Name_Specification_Suffix           : constant Name_Id := N + 740;
-   Name_Stack                          : constant Name_Id := N + 741;
-   Name_Switches                       : constant Name_Id := N + 742;
-   Name_Symbolic_Link_Supported        : constant Name_Id := N + 743;
-   Name_Sync                           : constant Name_Id := N + 744;
-   Name_Synchronize                    : constant Name_Id := N + 745;
-   Name_Toolchain_Description          : constant Name_Id := N + 746;
-   Name_Toolchain_Version              : constant Name_Id := N + 747;
-   Name_Runtime_Library_Dir            : constant Name_Id := N + 748;
+   Name_Ada_Roots                      : constant Name_Id := N + 634;
+   Name_Aggregate                      : constant Name_Id := N + 635;
+   Name_Archive_Builder                : constant Name_Id := N + 636;
+   Name_Archive_Builder_Append_Option  : constant Name_Id := N + 637;
+   Name_Archive_Indexer                : constant Name_Id := N + 638;
+   Name_Archive_Suffix                 : constant Name_Id := N + 639;
+   Name_Binder                         : constant Name_Id := N + 640;
+   Name_Binder_Prefix                  : constant Name_Id := N + 641;
+   Name_Body_Suffix                    : constant Name_Id := N + 642;
+   Name_Builder                        : constant Name_Id := N + 643;
+   Name_Builder_Switches               : constant Name_Id := N + 644;
+   Name_Compiler                       : constant Name_Id := N + 645;
+   Name_Compiler_Kind                  : constant Name_Id := N + 646;
+   Name_Config_Body_File_Name          : constant Name_Id := N + 647;
+   Name_Config_Body_File_Name_Pattern  : constant Name_Id := N + 648;
+   Name_Config_File_Switches           : constant Name_Id := N + 649;
+   Name_Config_File_Unique             : constant Name_Id := N + 650;
+   Name_Config_Spec_File_Name          : constant Name_Id := N + 651;
+   Name_Config_Spec_File_Name_Pattern  : constant Name_Id := N + 652;
+   Name_Configuration                  : constant Name_Id := N + 653;
+   Name_Cross_Reference                : constant Name_Id := N + 654;
+   Name_Default_Language               : constant Name_Id := N + 655;
+   Name_Default_Switches               : constant Name_Id := N + 656;
+   Name_Dependency_Driver              : constant Name_Id := N + 657;
+   Name_Dependency_File_Kind           : constant Name_Id := N + 658;
+   Name_Dependency_Switches            : constant Name_Id := N + 659;
+   Name_Driver                         : constant Name_Id := N + 660;
+   Name_Excluded_Source_Dirs           : constant Name_Id := N + 661;
+   Name_Excluded_Source_Files          : constant Name_Id := N + 662;
+   Name_Excluded_Source_List_File      : constant Name_Id := N + 663;
+   Name_Exec_Dir                       : constant Name_Id := N + 664;
+   Name_Executable                     : constant Name_Id := N + 665;
+   Name_Executable_Suffix              : constant Name_Id := N + 666;
+   Name_Extends                        : constant Name_Id := N + 667;
+   Name_Externally_Built               : constant Name_Id := N + 668;
+   Name_Finder                         : constant Name_Id := N + 669;
+   Name_Global_Configuration_Pragmas   : constant Name_Id := N + 670;
+   Name_Global_Config_File             : constant Name_Id := N + 671;
+   Name_Gnatls                         : constant Name_Id := N + 672;
+   Name_Gnatstub                       : constant Name_Id := N + 673;
+   Name_Implementation                 : constant Name_Id := N + 674;
+   Name_Implementation_Exceptions      : constant Name_Id := N + 675;
+   Name_Implementation_Suffix          : constant Name_Id := N + 676;
+   Name_Include_Switches               : constant Name_Id := N + 677;
+   Name_Include_Path                   : constant Name_Id := N + 678;
+   Name_Include_Path_File              : constant Name_Id := N + 679;
+   Name_Inherit_Source_Path            : constant Name_Id := N + 680;
+   Name_Language_Kind                  : constant Name_Id := N + 681;
+   Name_Language_Processing            : constant Name_Id := N + 682;
+   Name_Languages                      : constant Name_Id := N + 683;
+   Name_Library                        : constant Name_Id := N + 684;
+   Name_Library_Ali_Dir                : constant Name_Id := N + 685;
+   Name_Library_Auto_Init              : constant Name_Id := N + 686;
+   Name_Library_Auto_Init_Supported    : constant Name_Id := N + 687;
+   Name_Library_Builder                : constant Name_Id := N + 688;
+   Name_Library_Dir                    : constant Name_Id := N + 689;
+   Name_Library_GCC                    : constant Name_Id := N + 690;
+   Name_Library_Interface              : constant Name_Id := N + 691;
+   Name_Library_Kind                   : constant Name_Id := N + 692;
+   Name_Library_Name                   : constant Name_Id := N + 693;
+   Name_Library_Major_Minor_Id_Supported : constant Name_Id := N + 694;
+   Name_Library_Options                : constant Name_Id := N + 695;
+   Name_Library_Partial_Linker         : constant Name_Id := N + 696;
+   Name_Library_Reference_Symbol_File  : constant Name_Id := N + 697;
+   Name_Library_Src_Dir                : constant Name_Id := N + 698;
+   Name_Library_Support                : constant Name_Id := N + 699;
+   Name_Library_Symbol_File            : constant Name_Id := N + 700;
+   Name_Library_Symbol_Policy          : constant Name_Id := N + 701;
+   Name_Library_Version                : constant Name_Id := N + 702;
+   Name_Library_Version_Switches       : constant Name_Id := N + 703;
+   Name_Linker                         : constant Name_Id := N + 704;
+   Name_Linker_Executable_Option       : constant Name_Id := N + 705;
+   Name_Linker_Lib_Dir_Option          : constant Name_Id := N + 706;
+   Name_Linker_Lib_Name_Option         : constant Name_Id := N + 707;
+   Name_Local_Config_File              : constant Name_Id := N + 708;
+   Name_Local_Configuration_Pragmas    : constant Name_Id := N + 709;
+   Name_Locally_Removed_Files          : constant Name_Id := N + 710;
+   Name_Map_File_Option                : constant Name_Id := N + 711;
+   Name_Mapping_File_Switches          : constant Name_Id := N + 712;
+   Name_Mapping_Spec_Suffix            : constant Name_Id := N + 713;
+   Name_Mapping_Body_Suffix            : constant Name_Id := N + 714;
+   Name_Metrics                        : constant Name_Id := N + 715;
+   Name_Naming                         : constant Name_Id := N + 716;
+   Name_Object_Generated               : constant Name_Id := N + 717;
+   Name_Objects_Linked                 : constant Name_Id := N + 718;
+   Name_Objects_Path                   : constant Name_Id := N + 719;
+   Name_Objects_Path_File              : constant Name_Id := N + 720;
+   Name_Object_Dir                     : constant Name_Id := N + 721;
+   Name_Pic_Option                     : constant Name_Id := N + 722;
+   Name_Pretty_Printer                 : constant Name_Id := N + 723;
+   Name_Prefix                         : constant Name_Id := N + 724;
+   Name_Project                        : constant Name_Id := N + 725;
+   Name_Roots                          : constant Name_Id := N + 726;
+   Name_Required_Switches              : constant Name_Id := N + 727;
+   Name_Run_Path_Option                : constant Name_Id := N + 728;
+   Name_Runtime_Project                : constant Name_Id := N + 729;
+   Name_Shared_Library_Minimum_Switches : constant Name_Id := N + 730;
+   Name_Shared_Library_Prefix          : constant Name_Id := N + 731;
+   Name_Shared_Library_Suffix          : constant Name_Id := N + 732;
+   Name_Separate_Suffix                : constant Name_Id := N + 733;
+   Name_Source_Dirs                    : constant Name_Id := N + 734;
+   Name_Source_Files                   : constant Name_Id := N + 735;
+   Name_Source_List_File               : constant Name_Id := N + 736;
+   Name_Spec                           : constant Name_Id := N + 737;
+   Name_Spec_Suffix                    : constant Name_Id := N + 738;
+   Name_Specification                  : constant Name_Id := N + 739;
+   Name_Specification_Exceptions       : constant Name_Id := N + 740;
+   Name_Specification_Suffix           : constant Name_Id := N + 741;
+   Name_Stack                          : constant Name_Id := N + 742;
+   Name_Switches                       : constant Name_Id := N + 743;
+   Name_Symbolic_Link_Supported        : constant Name_Id := N + 744;
+   Name_Sync                           : constant Name_Id := N + 745;
+   Name_Synchronize                    : constant Name_Id := N + 746;
+   Name_Toolchain_Description          : constant Name_Id := N + 747;
+   Name_Toolchain_Version              : constant Name_Id := N + 748;
+   Name_Runtime_Library_Dir            : constant Name_Id := N + 749;
 
    --  Other miscellaneous names used in front end
 
-   Name_Unaligned_Valid                : constant Name_Id := N + 749;
+   Name_Unaligned_Valid                : constant Name_Id := N + 750;
 
    --  Ada 2005 reserved words
 
-   First_2005_Reserved_Word            : constant Name_Id := N + 750;
-   Name_Interface                      : constant Name_Id := N + 750;
-   Name_Overriding                     : constant Name_Id := N + 751;
-   Name_Synchronized                   : constant Name_Id := N + 752;
-   Last_2005_Reserved_Word             : constant Name_Id := N + 752;
+   First_2005_Reserved_Word            : constant Name_Id := N + 751;
+   Name_Interface                      : constant Name_Id := N + 751;
+   Name_Overriding                     : constant Name_Id := N + 752;
+   Name_Synchronized                   : constant Name_Id := N + 753;
+   Last_2005_Reserved_Word             : constant Name_Id := N + 753;
 
    subtype Ada_2005_Reserved_Words is
      Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word;
 
    --  Mark last defined name for consistency check in Snames body
 
-   Last_Predefined_Name                : constant Name_Id := N + 752;
+   Last_Predefined_Name                : constant Name_Id := N + 753;
 
    ---------------------------------------
    -- Subtypes Defining Name Categories --

diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb
index a25cfae44fa00a5bf0ab342f40286679ec8c64c4..5fb53ae339ea1b15ab76939bf91cc695d3bbee1b 100644 (file)
--- a/gcc/ada/treepr.adb
+++ b/gcc/ada/treepr.adb
@@ -531,17 +531,44 @@ package body Treepr is
 
             begin
                case M is
-                  when Default_Mechanism  => Write_Str ("Default");
-                  when By_Copy            => Write_Str ("By_Copy");
-                  when By_Reference       => Write_Str ("By_Reference");
-                  when By_Descriptor      => Write_Str ("By_Descriptor");
-                  when By_Descriptor_UBS  => Write_Str ("By_Descriptor_UBS");
-                  when By_Descriptor_UBSB => Write_Str ("By_Descriptor_UBSB");
-                  when By_Descriptor_UBA  => Write_Str ("By_Descriptor_UBA");
-                  when By_Descriptor_S    => Write_Str ("By_Descriptor_S");
-                  when By_Descriptor_SB   => Write_Str ("By_Descriptor_SB");
-                  when By_Descriptor_A    => Write_Str ("By_Descriptor_A");
-                  when By_Descriptor_NCA  => Write_Str ("By_Descriptor_NCA");
+                  when Default_Mechanism
+                                    => Write_Str ("Default");
+                  when By_Copy
+                                    => Write_Str ("By_Copy");
+                  when By_Reference
+                                    => Write_Str ("By_Reference");
+                  when By_Descriptor
+                                    => Write_Str ("By_Descriptor");
+                  when By_Descriptor_UBS
+                                    => Write_Str ("By_Descriptor_UBS");
+                  when By_Descriptor_UBSB
+                                    => Write_Str ("By_Descriptor_UBSB");
+                  when By_Descriptor_UBA
+                                    => Write_Str ("By_Descriptor_UBA");
+                  when By_Descriptor_S
+                                    => Write_Str ("By_Descriptor_S");
+                  when By_Descriptor_SB
+                                    => Write_Str ("By_Descriptor_SB");
+                  when By_Descriptor_A
+                                    => Write_Str ("By_Descriptor_A");
+                  when By_Descriptor_NCA
+                                    => Write_Str ("By_Descriptor_NCA");
+                  when By_Short_Descriptor
+                                    => Write_Str ("By_Short_Descriptor");
+                  when By_Short_Descriptor_UBS
+                                    => Write_Str ("By_Short_Descriptor_UBS");
+                  when By_Short_Descriptor_UBSB
+                                    => Write_Str ("By_Short_Descriptor_UBSB");
+                  when By_Short_Descriptor_UBA
+                                    => Write_Str ("By_Short_Descriptor_UBA");
+                  when By_Short_Descriptor_S
+                                    => Write_Str ("By_Short_Descriptor_S");
+                  when By_Short_Descriptor_SB
+                                    => Write_Str ("By_Short_Descriptor_SB");
+                  when By_Short_Descriptor_A
+                                    => Write_Str ("By_Short_Descriptor_A");
+                  when By_Short_Descriptor_NCA
+                                    => Write_Str ("By_Short_Descriptor_NCA");
 
                   when 1 .. Mechanism_Type'Last =>
                      Write_Str ("By_Copy if size <= ");

diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads
index 9b4bfb825e412f8543835d70e0a3a1a4823dfe10..de9c54bfe5f67e2b06c66f195d7fd0e89bf6a7e7 100644 (file)
--- a/gcc/ada/types.ads
+++ b/gcc/ada/types.ads
@@ -736,7 +736,7 @@ package Types is
    --  passing mechanism. See specification of Sem_Mech for full details.
    --  The following subtype is used to represent values of this type:
 
-   subtype Mechanism_Type is Int range -10 .. Int'Last;
+   subtype Mechanism_Type is Int range -18 .. Int'Last;
    --  Type used to represent a mechanism value. This is a subtype rather
    --  than a type to avoid some annoying processing problems with certain
    --  routines in Einfo (processing them to create the corresponding C).

diff --git a/gcc/ada/types.h b/gcc/ada/types.h
index fb218c203a642888a5771f3900b2467833b6ceb9..1d4fd67065bf6df64cc5209eeee73c538f3837de 100644 (file)
--- a/gcc/ada/types.h
+++ b/gcc/ada/types.h
@@ -328,6 +328,15 @@ typedef Int Mechanism_Type;
 #define By_Descriptor_A    (-9)
 #define By_Descriptor_NCA  (-10)
 #define By_Descriptor_Last (-10)
+#define By_Short_Descriptor      (-11)
+#define By_Short_Descriptor_UBS  (-12)
+#define By_Short_Descriptor_UBSB (-13)
+#define By_Short_Descriptor_UBA  (-14)
+#define By_Short_Descriptor_S    (-15)
+#define By_Short_Descriptor_SB   (-16)
+#define By_Short_Descriptor_A    (-17)
+#define By_Short_Descriptor_NCA  (-18)
+#define By_Short_Descriptor_Last (-18)
 
 /* Internal to Gigi.  */
 #define By_Copy_Return     (-128)