===================================================================
@@ -154,13 +154,24 @@ static tree make_type_from_size (tree, t
static unsigned int validate_alignment (Uint, Entity_Id, unsigned int);
static unsigned int ceil_alignment (unsigned HOST_WIDE_INT);
static void check_ok_for_atomic (tree, Entity_Id, bool);
-static int compatible_signatures_p (tree, tree);
static tree create_field_decl_from (tree, tree, tree, tree, tree, tree);
static tree get_rep_part (tree);
static tree get_variant_part (tree);
static tree create_variant_part_from (tree, tree, tree, tree, tree);
static void copy_and_substitute_in_size (tree, tree, tree);
static void rest_of_type_decl_compilation_no_defer (tree);
+
+/* The relevant constituents of a subprogram binding to a GCC builtin. Used
+ to pass around calls performing profile compatibilty checks. */
+
+typedef struct {
+ Entity_Id gnat_entity; /* The Ada subprogram entity. */
+ tree ada_fntype; /* The corresponding GCC type node. */
+ tree btin_fntype; /* The GCC builtin function type node. */
+} intrin_binding_t;
+
+static bool intrin_profiles_compatible_p (intrin_binding_t *);
+
/* Given GNAT_ENTITY, a GNAT defining identifier node, which denotes some Ada
entity, return the equivalent GCC tree for that entity (a ..._DECL node)
@@ -3906,9 +3917,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
We still want the parameter associations to take place because the
proper generation of calls depends on it (a GNAT parameter without
a corresponding GCC tree has a very specific meaning), so we don't
- just break here. */
- if (Convention (gnat_entity) == Convention_Intrinsic)
- gnu_builtin_decl = builtin_decl_for (gnu_ext_name);
+ just "break;" here. */
+ if (Convention (gnat_entity) == Convention_Intrinsic
+ && Present (Interface_Name (gnat_entity)))
+ {
+ gnu_builtin_decl = builtin_decl_for (gnu_ext_name);
+
+ /* Post a "Wextra" warning if we couldn't find the decl. Absence
+ of a real intrinsic for an import is most often unexpected but
+ allows hooking in alternate bodies, convenient in some cases so
+ we don't want the warning to be unconditional. */
+ if (gnu_builtin_decl == NULL_TREE && extra_warnings)
+ post_error ("?gcc intrinsic not found for&!", gnat_entity);
+ }
/* ??? What if we don't find the builtin node above ? warn ? err ?
In the current state we neither warn nor err, and calls will just
@@ -4204,21 +4225,25 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
| (TYPE_QUAL_CONST * const_flag)
| (TYPE_QUAL_VOLATILE * volatile_flag));
- /* If we have a builtin decl for that function, check the signatures
- compatibilities. If the signatures are compatible, use the builtin
- decl. If they are not, we expect the checker predicate to have
- posted the appropriate errors, and just continue with what we have
- so far. */
+ /* If we have a builtin decl for that function, use it. Check if the
+ profiles are compatible and warn if they are not. The checker is
+ expected to post extra diagnostics in this case. */
if (gnu_builtin_decl)
{
- tree gnu_builtin_type = TREE_TYPE (gnu_builtin_decl);
+ intrin_binding_t inb;
- if (compatible_signatures_p (gnu_type, gnu_builtin_type))
- {
- gnu_decl = gnu_builtin_decl;
- gnu_type = gnu_builtin_type;
- break;
- }
+ inb.gnat_entity = gnat_entity;
+ inb.ada_fntype = gnu_type;
+ inb.btin_fntype = TREE_TYPE (gnu_builtin_decl);
+
+ if (!intrin_profiles_compatible_p (&inb))
+ post_error
+ ("?profile of& doesn't match the builtin it binds!",
+ gnat_entity);
+
+ gnu_decl = gnu_builtin_decl;
+ gnu_type = TREE_TYPE (gnu_builtin_decl);
+ break;
}
/* If there was no specified Interface_Name and the external and
@@ -8036,32 +8061,183 @@ check_ok_for_atomic (tree object, Entity
gnat_error_point, gnat_entity);
}
-/* Check if FTYPE1 and FTYPE2, two potentially different function type nodes,
- have compatible signatures so that a call using one type may be safely
- issued if the actual target function type is the other. Return 1 if it is
- the case, 0 otherwise, and post errors on the incompatibilities.
-
- This is used when an Ada subprogram is mapped onto a GCC builtin, to ensure
- that calls to the subprogram will have arguments suitable for the later
- underlying builtin expansion. */
-static int
-compatible_signatures_p (tree ftype1, tree ftype2)
+/* Helper for the intrin compatibility checks family. Evaluate whether
+ two types are definitely incompatible. */
+
+static bool
+intrin_types_incompatible_p (tree t1, tree t2)
{
- /* As of now, we only perform very trivial tests and consider it's the
- programmer's responsibility to ensure the type correctness in the Ada
- declaration, as in the regular Import cases.
-
- Mismatches typically result in either error messages from the builtin
- expander, internal compiler errors, or in a real call sequence. This
- should be refined to issue diagnostics helping error detection and
- correction. */
-
- /* Almost fake test, ensuring a use of each argument. */
- if (ftype1 == ftype2)
- return 1;
+ enum tree_code code;
+
+ if (TYPE_MAIN_VARIANT (t1) == TYPE_MAIN_VARIANT (t2))
+ return false;
+
+ if (TYPE_MODE (t1) != TYPE_MODE (t2))
+ return true;
+
+ if (TREE_CODE (t1) != TREE_CODE (t2))
+ return true;
+
+ code = TREE_CODE (t1);
+
+ switch (code)
+ {
+ case INTEGER_TYPE:
+ case REAL_TYPE:
+ return TYPE_PRECISION (t1) != TYPE_PRECISION (t2);
+
+ case POINTER_TYPE:
+ case REFERENCE_TYPE:
+ /* Assume designated types are ok. We'd need to account for char * and
+ void * variants to do better, which could rapidly get messy and isn't
+ clearly worth the effort. */
+ return false;
+
+ default:
+ break;
+ }
+
+ return false;
+}
+
+/* Helper for intrin_profiles_compatible_p, to perform compatibility checks
+ on the Ada/builtin argument lists for the INB binding. */
+
+static bool
+intrin_arglists_compatible_p (intrin_binding_t * inb)
+{
+ tree ada_args = TYPE_ARG_TYPES (inb->ada_fntype);
+ tree btin_args = TYPE_ARG_TYPES (inb->btin_fntype);
+
+ /* Sequence position of the last argument we checked. */
+ int argpos = 0;
+
+ while (ada_args != 0 || btin_args != 0)
+ {
+ tree ada_type, btin_type;
+
+ /* If one list is shorter than the other, they fail to match. */
+ if (ada_args == 0 || btin_args == 0)
+ return false;
+
+ ada_type = TREE_VALUE (ada_args);
+ btin_type = TREE_VALUE (btin_args);
+
+ /* If we're done with the Ada args and not with the internal builtin
+ args, complain. */
+ if (ada_type == void_type_node
+ && btin_type != void_type_node)
+ {
+ post_error ("?Ada arguments list too short!", inb->gnat_entity);
+ return false;
+ }
+
+ /* If we're done with the internal builtin args, check the remaining
+ args on the Ada side. If they are all ints, assume these are access
+ levels and just ignore them with a conditional warning. Complain
+ otherwise. */
+ if (btin_type == void_type_node
+ && ada_type != void_type_node)
+ {
+ while (TREE_CODE (ada_type) == INTEGER_TYPE)
+ {
+ ada_args = TREE_CHAIN (ada_args);
+ ada_type = TREE_VALUE (ada_args);
+ }
+
+ if (ada_type != void_type_node)
+ {
+ post_error_ne_num ("?Ada arguments list too long (> ^)!",
+ inb->gnat_entity, inb->gnat_entity,
+ argpos);
+ return false;
+ }
+
+ else
+ {
+ if (extra_warnings)
+ post_error ("?trailing Ada integer args ignored for "
+ "intrinsic binding!",
+ inb->gnat_entity);
+ return true;
+ }
+ }
+
+ /* Otherwise, check that types match for the current argument. */
+ argpos ++;
+ if (intrin_types_incompatible_p (ada_type, btin_type))
+ {
+ post_error_ne_num ("?intrinsic binding type mismatch on argument ^!",
+ inb->gnat_entity, inb->gnat_entity, argpos);
+ return false;
+ }
+
+ ada_args = TREE_CHAIN (ada_args);
+ btin_args = TREE_CHAIN (btin_args);
+ }
+
+ return true;
+}
+
+/* Helper for intrin_profiles_compatible_p, to perform compatibility checks
+ on the Ada/builtin return values for the INB binding. */
+
+static bool
+intrin_return_compatible_p (intrin_binding_t * inb)
+{
+ tree ada_return_type = TREE_TYPE (inb->ada_fntype);
+ tree btin_return_type = TREE_TYPE (inb->btin_fntype);
+
+ if (VOID_TYPE_P (btin_return_type)
+ && VOID_TYPE_P (ada_return_type))
+ return true;
+
+ if (VOID_TYPE_P (ada_return_type)
+ && !VOID_TYPE_P (btin_return_type))
+ {
+ if (extra_warnings)
+ post_error ("?builtin function imported as Ada procedure!",
+ inb->gnat_entity);
+ return true;
+ }
+
+ if (intrin_types_incompatible_p (btin_return_type, ada_return_type))
+ {
+ post_error ("?intrinsic binding type mismatch on return value!",
+ inb->gnat_entity);
+ return false;
+ }
+
+ return true;
+}
+
+/* Check and return whether the Ada and gcc builtin profiles bound by INB are
+ compatible. Issue relevant warnings when they are not.
+
+ This is intended as a light check to diagnose the most obvious cases, not
+ as a full fledged type compatiblity predicate. It is the programmer's
+ responsibility to ensure correctness of the Ada declarations in Imports,
+ especially when binding straight to a compiler internal. */
+
+static bool
+intrin_profiles_compatible_p (intrin_binding_t * inb)
+{
+ /* Check compatibility on return values and argument lists, each responsible
+ for posting warnings as appropriate. Ensure use of the proper sloc for
+ this purpose. */
+
+ bool arglists_compatible_p, return_compatible_p;
+ location_t saved_location = input_location;
+
+ Sloc_to_locus (Sloc (inb->gnat_entity), &input_location);
+
+ return_compatible_p = intrin_return_compatible_p (inb);
+ arglists_compatible_p = intrin_arglists_compatible_p (inb);
+
+ input_location = saved_location;
- return 1;
+ return return_compatible_p && arglists_compatible_p;
}
/* Return a FIELD_DECL node modeled on OLD_FIELD. FIELD_TYPE is its type