* [Ada] Extend No_Dependence restriction to code generation
@ 2022-07-13 10:03 Pierre-Marie de Rodat
0 siblings, 0 replies; 2+ messages in thread
From: Pierre-Marie de Rodat @ 2022-07-13 10:03 UTC (permalink / raw)
To: gcc-patches; +Cc: Eric Botcazou
[-- Attachment #1: Type: text/plain, Size: 1062 bytes --]
This reports violations for 4 units from gigi.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* gcc-interface/trans.cc (gigi): Report a violation of No_Dependence
on System.Stack_Checking if Stack_Check_Probes_On_Target is not set
and -fstack-check is specified.
(build_binary_op_trapv): Report violatiosn of No_Dependence on both
System.Arith_64 and System.Arith_128.
(add_decl_expr): If an initialized variable, report a violation of
No_Dependence on System.Memory_Copy for large aggregate types.
(gnat_to_gnu) <N_Op_Eq>: Report a violation
of No_Dependence on System.Memory_Compare for large aggregate types.
<N_Assignment_Statement>! Report a violation of No_Dependence on
System.Memory_Set, System.Memory_Move or else System.Memory_Copy for
large aggregate types.
* gcc-interface/utils2.cc (maybe_wrap_malloc): Report a violation of
No_Dependence on System.Memory.
(maybe_wrap_free): Add GNAT_NODE parameter and report a violation of
No_Dependence on System.Memory.
(build_call_alloc_dealloc): Adjust call to maybe_wrap_free.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 7377 bytes --]
diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc
--- a/gcc/ada/gcc-interface/trans.cc
+++ b/gcc/ada/gcc-interface/trans.cc
@@ -364,7 +364,12 @@ gigi (Node_Id gnat_root,
/* Enable GNAT stack checking method if needed */
if (!Stack_Check_Probes_On_Target)
- set_stack_check_libfunc ("__gnat_stack_check");
+ {
+ set_stack_check_libfunc ("__gnat_stack_check");
+ if (flag_stack_check != NO_STACK_CHECK)
+ Check_Restriction_No_Dependence_On_System (Name_Stack_Checking,
+ gnat_root);
+ }
/* Retrieve alignment settings. */
double_float_alignment = get_target_double_float_alignment ();
@@ -6933,9 +6938,18 @@ gnat_to_gnu (Node_Id gnat_node)
= convert (TREE_TYPE (gnu_rhs), TYPE_SIZE (gnu_type));
}
+ /* If this is a comparison between (potentially) large aggregates, then
+ declare the dependence on the memcmp routine. */
+ else if ((kind == N_Op_Eq || kind == N_Op_Ne)
+ && AGGREGATE_TYPE_P (TREE_TYPE (gnu_lhs))
+ && (!TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_lhs)))
+ || compare_tree_int (TYPE_SIZE (TREE_TYPE (gnu_lhs)),
+ 2 * BITS_PER_WORD) > 0))
+ Check_Restriction_No_Dependence_On_System (Name_Memory_Compare,
+ gnat_node);
+
/* Pending generic support for efficient vector logical operations in
- GCC, convert vectors to their representative array type view and
- fallthrough. */
+ GCC, convert vectors to their representative array type view. */
gnu_lhs = maybe_vector_array (gnu_lhs);
gnu_rhs = maybe_vector_array (gnu_rhs);
@@ -7254,6 +7268,8 @@ gnat_to_gnu (Node_Id gnat_node)
value = int_const_binop (BIT_AND_EXPR, value, mask);
}
gnu_result = build_call_expr (t, 3, dest, value, size);
+ Check_Restriction_No_Dependence_On_System (Name_Memory_Set,
+ gnat_node);
}
/* Otherwise build a regular assignment. */
@@ -7278,7 +7294,18 @@ gnat_to_gnu (Node_Id gnat_node)
tree from_ptr = build_fold_addr_expr (from);
tree t = builtin_decl_explicit (BUILT_IN_MEMMOVE);
gnu_result = build_call_expr (t, 3, to_ptr, from_ptr, size);
+ Check_Restriction_No_Dependence_On_System (Name_Memory_Move,
+ gnat_node);
}
+
+ /* If this is an assignment between (potentially) large aggregates,
+ then declare the dependence on the memcpy routine. */
+ else if (AGGREGATE_TYPE_P (TREE_TYPE (gnu_lhs))
+ && (!TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_lhs)))
+ || compare_tree_int (TYPE_SIZE (TREE_TYPE (gnu_lhs)),
+ 2 * BITS_PER_WORD) > 0))
+ Check_Restriction_No_Dependence_On_System (Name_Memory_Copy,
+ gnat_node);
}
break;
@@ -8437,27 +8464,37 @@ add_decl_expr (tree gnu_decl, Node_Id gnat_node)
&& !TYPE_FAT_POINTER_P (type))
MARK_VISITED (TYPE_ADA_SIZE (type));
- /* If this is a variable and an initializer is attached to it, it must be
- valid for the context. Similar to init_const in create_var_decl. */
- if (TREE_CODE (gnu_decl) == VAR_DECL
- && (gnu_init = DECL_INITIAL (gnu_decl))
- && (!gnat_types_compatible_p (type, TREE_TYPE (gnu_init))
+ if (TREE_CODE (gnu_decl) == VAR_DECL && (gnu_init = DECL_INITIAL (gnu_decl)))
+ {
+ /* If this is a variable and an initializer is attached to it, it must be
+ valid for the context. Similar to init_const in create_var_decl. */
+ if (!gnat_types_compatible_p (type, TREE_TYPE (gnu_init))
|| (TREE_STATIC (gnu_decl)
&& !initializer_constant_valid_p (gnu_init,
- TREE_TYPE (gnu_init)))))
- {
- DECL_INITIAL (gnu_decl) = NULL_TREE;
- if (TREE_READONLY (gnu_decl))
+ TREE_TYPE (gnu_init))))
{
- TREE_READONLY (gnu_decl) = 0;
- DECL_READONLY_ONCE_ELAB (gnu_decl) = 1;
- }
+ DECL_INITIAL (gnu_decl) = NULL_TREE;
+ if (TREE_READONLY (gnu_decl))
+ {
+ TREE_READONLY (gnu_decl) = 0;
+ DECL_READONLY_ONCE_ELAB (gnu_decl) = 1;
+ }
+
+ /* Remove any padding so the assignment is done properly. */
+ gnu_decl = maybe_padded_object (gnu_decl);
- /* Remove any padding so the assignment is done properly. */
- gnu_decl = maybe_padded_object (gnu_decl);
+ gnu_stmt
+ = build_binary_op (INIT_EXPR, NULL_TREE, gnu_decl, gnu_init);
+ add_stmt_with_node (gnu_stmt, gnat_node);
+ }
- gnu_stmt = build_binary_op (INIT_EXPR, NULL_TREE, gnu_decl, gnu_init);
- add_stmt_with_node (gnu_stmt, gnat_node);
+ /* If this is the initialization of a (potentially) large aggregate, then
+ declare the dependence on the memcpy routine. */
+ if (AGGREGATE_TYPE_P (type)
+ && (!TREE_CONSTANT (TYPE_SIZE (type))
+ || compare_tree_int (TYPE_SIZE (type), 2 * BITS_PER_WORD) > 0))
+ Check_Restriction_No_Dependence_On_System (Name_Memory_Copy,
+ gnat_node);
}
}
@@ -9359,6 +9396,7 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left,
if (code == MULT_EXPR && precision == 64 && BITS_PER_WORD < 64)
{
tree int64 = gnat_type_for_size (64, 0);
+ Check_Restriction_No_Dependence_On_System (Name_Arith_64, gnat_node);
return convert (gnu_type, build_call_n_expr (mulv64_decl, 2,
convert (int64, lhs),
convert (int64, rhs)));
@@ -9368,6 +9406,7 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left,
else if (code == MULT_EXPR && precision == 128 && BITS_PER_WORD < 128)
{
tree int128 = gnat_type_for_size (128, 0);
+ Check_Restriction_No_Dependence_On_System (Name_Arith_128, gnat_node);
return convert (gnu_type, build_call_n_expr (mulv128_decl, 2,
convert (int128, lhs),
convert (int128, rhs)));
diff --git a/gcc/ada/gcc-interface/utils2.cc b/gcc/ada/gcc-interface/utils2.cc
--- a/gcc/ada/gcc-interface/utils2.cc
+++ b/gcc/ada/gcc-interface/utils2.cc
@@ -2259,6 +2259,8 @@ maybe_wrap_malloc (tree data_size, tree data_type, Node_Id gnat_node)
tree malloc_ptr = build_call_n_expr (malloc_decl, 1, size_to_malloc);
+ Check_Restriction_No_Dependence_On_System (Name_Memory, gnat_node);
+
if (aligning_type)
{
/* Latch malloc's return value and get a pointer to the aligning field
@@ -2305,7 +2307,7 @@ maybe_wrap_malloc (tree data_size, tree data_type, Node_Id gnat_node)
designated by DATA_PTR using the __gnat_free entry point. */
static inline tree
-maybe_wrap_free (tree data_ptr, tree data_type)
+maybe_wrap_free (tree data_ptr, tree data_type, Node_Id gnat_node)
{
/* In the regular alignment case, we pass the data pointer straight to free.
In the superaligned case, we need to retrieve the initial allocator
@@ -2317,6 +2319,8 @@ maybe_wrap_free (tree data_ptr, tree data_type)
tree free_ptr;
+ Check_Restriction_No_Dependence_On_System (Name_Memory, gnat_node);
+
if (data_align > system_allocator_alignment)
{
/* DATA_FRONT_PTR (void *)
@@ -2363,7 +2367,7 @@ build_call_alloc_dealloc (tree gnu_obj, tree gnu_size, tree gnu_type,
/* Otherwise, object to "free" or "malloc" with possible special processing
for alignments stricter than what the default allocator honors. */
else if (gnu_obj)
- return maybe_wrap_free (gnu_obj, gnu_type);
+ return maybe_wrap_free (gnu_obj, gnu_type, gnat_node);
else
{
/* Assert that we no longer can be called with this special pool. */
^ permalink raw reply [flat|nested] 2+ messages in thread
* [Ada] Extend No_Dependence restriction to code generation
@ 2022-07-12 12:25 Pierre-Marie de Rodat
0 siblings, 0 replies; 2+ messages in thread
From: Pierre-Marie de Rodat @ 2022-07-12 12:25 UTC (permalink / raw)
To: gcc-patches; +Cc: Eric Botcazou
[-- Attachment #1: Type: text/plain, Size: 1011 bytes --]
This makes it possible to report violations of the No_Dependence restriction
during code generation, in other words outside of the Ada front-end proper.
These violations are supposed to be only for child units of System, so the
implementation is restricted to these cases.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* restrict.ads (type ND_Entry): Add System_Child component.
(Check_Restriction_No_Dependence_On_System): Declare.
* restrict.adb (Global_Restriction_No_Tasking): Move around.
(Violation_Of_No_Dependence): New procedure.
(Check_Restriction_No_Dependence): Call Violation_Of_No_Dependence
to report a violation.
(Check_Restriction_No_Dependence_On_System): New procedure.
(Set_Restriction_No_Dependenc): Set System_Child component if the
unit is a child of System.
* snames.ads-tmpl (Name_Arith_64): New package name.
(Name_Arith_128): Likewise.
(Name_Memory): Likewise.
(Name_Stack_Checking): Likewise.
* fe.h (Check_Restriction_No_Dependence_On_System): Declare.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 8589 bytes --]
diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h
--- a/gcc/ada/fe.h
+++ b/gcc/ada/fe.h
@@ -252,6 +252,8 @@ extern Boolean SJLJ_Exceptions (void);
restrict__check_no_implicit_protected_alloc
#define Check_No_Implicit_Task_Alloc \
restrict__check_no_implicit_task_alloc
+#define Check_Restriction_No_Dependence_On_System \
+ restrict__check_restriction_no_dependence_on_system
#define No_Exception_Handlers_Set \
restrict__no_exception_handlers_set
#define No_Exception_Propagation_Active \
@@ -262,6 +264,7 @@ extern void Check_Implicit_Dynamic_Code_Allowed (Node_Id);
extern void Check_No_Implicit_Heap_Alloc (Node_Id);
extern void Check_No_Implicit_Protected_Alloc (Node_Id);
extern void Check_No_Implicit_Task_Alloc (Node_Id);
+extern void Check_Restriction_No_Dependence_On_System (Name_Id, Node_Id);
extern Boolean No_Exception_Handlers_Set (void);
extern Boolean No_Exception_Propagation_Active (void);
diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -44,10 +44,6 @@ with Uname; use Uname;
package body Restrict is
- Global_Restriction_No_Tasking : Boolean := False;
- -- Set to True when No_Tasking is set in the run-time package System
- -- or in a configuration pragmas file (for example, gnat.adc).
-
--------------------------------
-- Package Local Declarations --
--------------------------------
@@ -55,6 +51,10 @@ package body Restrict is
Config_Cunit_Boolean_Restrictions : Save_Cunit_Boolean_Restrictions;
-- Save compilation unit restrictions set by config pragma files
+ Global_Restriction_No_Tasking : Boolean := False;
+ -- Set to True when No_Tasking is set in the run-time package System
+ -- or in a configuration pragmas file (for example, gnat.adc).
+
Restricted_Profile_Result : Boolean := False;
-- This switch memoizes the result of Restricted_Profile function calls for
-- improved efficiency. Valid only if Restricted_Profile_Cached is True.
@@ -122,6 +122,11 @@ package body Restrict is
-- message is to be suppressed if this is an internal file and this file is
-- not the main unit. Returns True if message is to be suppressed.
+ procedure Violation_Of_No_Dependence (Unit : Int; N : Node_Id);
+ -- Called if a violation of restriction No_Dependence for Unit at node N
+ -- is found. This routine outputs the appropriate message, taking care of
+ -- warning vs real violation.
+
-------------------
-- Abort_Allowed --
-------------------
@@ -550,8 +555,6 @@ package body Restrict is
-------------------------------------
procedure Check_Restriction_No_Dependence (U : Node_Id; Err : Node_Id) is
- DU : Node_Id;
-
begin
-- Ignore call if node U is not in the main source unit. This avoids
-- cascaded errors, e.g. when Ada.Containers units with other units.
@@ -567,26 +570,33 @@ package body Restrict is
-- Loop through entries in No_Dependence table to check each one in turn
for J in No_Dependences.First .. No_Dependences.Last loop
- DU := No_Dependences.Table (J).Unit;
+ if Same_Unit (No_Dependences.Table (J).Unit, U) then
+ Violation_Of_No_Dependence (J, Err);
+ return;
+ end if;
+ end loop;
+ end Check_Restriction_No_Dependence;
- if Same_Unit (U, DU) then
- Error_Msg_Sloc := Sloc (DU);
- Error_Msg_Node_1 := DU;
+ -----------------------------------------------
+ -- Check_Restriction_No_Dependence_On_System --
+ -----------------------------------------------
- if No_Dependences.Table (J).Warn then
- Error_Msg
- ("?*?violation of restriction `No_Dependence '='> &`#",
- Sloc (Err));
- else
- Error_Msg
- ("|violation of restriction `No_Dependence '='> &`#",
- Sloc (Err));
- end if;
+ procedure Check_Restriction_No_Dependence_On_System
+ (U : Name_Id;
+ Err : Node_Id)
+ is
+ pragma Assert (U /= No_Name);
+
+ begin
+ -- Loop through entries in No_Dependence table to check each one in turn
+ for J in No_Dependences.First .. No_Dependences.Last loop
+ if No_Dependences.Table (J).System_Child = U then
+ Violation_Of_No_Dependence (J, Err);
return;
end if;
end loop;
- end Check_Restriction_No_Dependence;
+ end Check_Restriction_No_Dependence_On_System;
--------------------------------------------------
-- Check_Restriction_No_Specification_Of_Aspect --
@@ -1474,6 +1484,8 @@ package body Restrict is
Warn : Boolean;
Profile : Profile_Name := No_Profile)
is
+ ND : ND_Entry;
+
begin
-- Loop to check for duplicate entry
@@ -1495,7 +1507,26 @@ package body Restrict is
-- Entry is not currently in table
- No_Dependences.Append ((Unit, Warn, Profile));
+ ND := (Unit, No_Name, Warn, Profile);
+
+ -- Check whether this is a child unit of System
+
+ if Nkind (Unit) = N_Selected_Component then
+ declare
+ Root : Node_Id := Unit;
+
+ begin
+ while Nkind (Prefix (Root)) = N_Selected_Component loop
+ Root := Prefix (Root);
+ end loop;
+
+ if Chars (Prefix (Root)) = Name_System then
+ ND.System_Child := Chars (Selector_Name (Root));
+ end if;
+ end;
+ end if;
+
+ No_Dependences.Append (ND);
end Set_Restriction_No_Dependence;
--------------------------------------
@@ -1647,6 +1678,24 @@ package body Restrict is
end if;
end Suppress_Restriction_Message;
+ --------------------------------
+ -- Violation_Of_No_Dependence --
+ --------------------------------
+
+ procedure Violation_Of_No_Dependence (Unit : Int; N : Node_Id) is
+ begin
+ Error_Msg_Node_1 := No_Dependences.Table (Unit).Unit;
+ Error_Msg_Sloc := Sloc (Error_Msg_Node_1);
+
+ if No_Dependences.Table (Unit).Warn then
+ Error_Msg
+ ("?*?violation of restriction `No_Dependence '='> &`#", Sloc (N));
+ else
+ Error_Msg
+ ("|violation of restriction `No_Dependence '='> &`#", Sloc (N));
+ end if;
+ end Violation_Of_No_Dependence;
+
---------------------
-- Tasking_Allowed --
---------------------
diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads
--- a/gcc/ada/restrict.ads
+++ b/gcc/ada/restrict.ads
@@ -168,6 +168,9 @@ package Restrict is
Unit : Node_Id;
-- The unit parameter from the No_Dependence pragma
+ System_Child : Name_Id;
+ -- The name if the unit is a child of System, or else No_Name
+
Warn : Boolean;
-- True if from Restriction_Warnings, False if from Restrictions
@@ -269,6 +272,13 @@ package Restrict is
-- an explicit WITH clause). U is a node for the unit involved, and Err is
-- the node to which an error will be attached if necessary.
+ procedure Check_Restriction_No_Dependence_On_System
+ (U : Name_Id;
+ Err : Node_Id);
+ -- Likewise, but for the child units of System referenced by their name
+
+ -- WARNING: There is a matching C declaration of this subprogram in fe.h
+
procedure Check_Restriction_No_Specification_Of_Aspect (N : Node_Id);
-- N is the node id for an N_Aspect_Specification, an N_Pragma, or an
-- N_Attribute_Definition_Clause. An error message (warning) will be issued
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -274,10 +274,14 @@ package Snames is
-- Names for packages that are treated specially by the compiler
+ Name_Arith_64 : constant Name_Id := N + $;
+ Name_Arith_128 : constant Name_Id := N + $;
Name_Exception_Traces : constant Name_Id := N + $;
Name_Finalization : constant Name_Id := N + $;
Name_Interfaces : constant Name_Id := N + $;
+ Name_Memory : constant Name_Id := N + $;
Name_Most_Recent_Exception : constant Name_Id := N + $;
+ Name_Stack_Checking : constant Name_Id := N + $;
Name_Standard : constant Name_Id := N + $;
Name_System : constant Name_Id := N + $;
Name_Text_IO : constant Name_Id := N + $;
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2022-07-13 10:03 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-07-13 10:03 [Ada] Extend No_Dependence restriction to code generation Pierre-Marie de Rodat
-- strict thread matches above, loose matches on Subject: below --
2022-07-12 12:25 Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).