diff options
author | Ronan Desplanques <desplanques@adacore.com> | 2024-09-02 15:38:21 +0200 |
---|---|---|
committer | Marc Poulhiès <dkm@gcc.gnu.org> | 2024-10-08 10:37:11 +0200 |
commit | 7e09f16ef980883598268b2044b9b370ec3a9611 (patch) | |
tree | 236cd26c5cc9b0f85994488a873a1fe59f2b9240 | |
parent | 23017cea9c8438865e557782c6c46eb996cf2132 (diff) | |
download | gcc-7e09f16ef980883598268b2044b9b370ec3a9611.zip gcc-7e09f16ef980883598268b2044b9b370ec3a9611.tar.gz gcc-7e09f16ef980883598268b2044b9b370ec3a9611.tar.bz2 |
ada: Add External_Initialization extension
This patch introduces a GNAT extension that adds a new aspect,
External_Initialization. A section is added to the reference
manual with a description of what the aspect does.
The implementation reuses existing mechanisms, in particular
Sinput.L.Load_Source_File and Sem_Res.Set_String_Literal_Subtype.
A new node kind is added, and nodes of that type are present in what
is passed to the back ends. That makes it necessary to update the back
ends to handle the new node type. The C interface is extended to make
that possible.
gcc/ada/ChangeLog:
* aspects.ads: Add entities for External_Initialization.
* checks.adb (Selected_Length_Checks): Add support for
N_External_Initializer nodes.
* doc/gnat_rm/gnat_language_extensions.rst: Add section for the added
extension.
* exp_util.adb (Insert_Actions): Add support for N_External_Initializer
nodes.
* fe.h (C_Source_Buffer): New function.
* gen_il-fields.ads: Add new field.
* gen_il-gen-gen_nodes.adb: Add N_External_Initializer node kind.
* gen_il-gen.adb: Add new field type.
* gen_il-types.ads: Add new node kind and new field type.
* pprint.adb (Expr_Name): Handle new node kind.
* sem.adb (Analyze): Add support for N_External_Initializer nodes.
* sem_ch13.adb (Analyze_Aspect_Specifications, Check_Aspect_At_Freeze_Point):
Add support for External_Initialization aspect.
* sem_ch3.adb (Apply_External_Initialization): New subprogram.
(Analyze_Object_Declaration): Add support for External_Initialization aspect.
* sem_res.adb (Resolve_External_Initializer): New procedure.
(Resolve): Add support for N_External_Initializer nodes.
(Set_String_Literal_Subtype): Extend to handle N_External_Initializer nodes.
* sinfo-utils.adb (Is_In_Union_Id): Adapt to new field addition.
* sinfo.ads: Add documentation for new node kind and new field.
* sinput.adb, sinput.ads (C_Source_Buffer): Add new C interface function.
* snames.ads-tmpl: Add new aspect identifier.
* sprint.adb (Sprint_Node_Actual): Add nop handling of N_External_Initializer
nodes.
* types.ads: Modify type to allow for new C interface.
* gcc-interface/trans.cc (gnat_to_gnu): Handle new GNAT node type.
* gcc-interface/Make-lang.in: Update list of stage1 run-time library units.
* gnat-style.texi: Regenerate.
* gnat_rm.texi: Regenerate.
* gnat_ugn.texi: Regenerate.
-rw-r--r-- | gcc/ada/aspects.ads | 6 | ||||
-rw-r--r-- | gcc/ada/checks.adb | 4 | ||||
-rw-r--r-- | gcc/ada/doc/gnat_rm/gnat_language_extensions.rst | 25 | ||||
-rw-r--r-- | gcc/ada/exp_util.adb | 1 | ||||
-rw-r--r-- | gcc/ada/fe.h | 7 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/Make-lang.in | 2 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/trans.cc | 11 | ||||
-rw-r--r-- | gcc/ada/gen_il-fields.ads | 1 | ||||
-rw-r--r-- | gcc/ada/gen_il-gen-gen_nodes.adb | 3 | ||||
-rw-r--r-- | gcc/ada/gen_il-gen.adb | 1 | ||||
-rw-r--r-- | gcc/ada/gen_il-types.ads | 2 | ||||
-rw-r--r-- | gcc/ada/gnat-style.texi | 4 | ||||
-rw-r--r-- | gcc/ada/gnat_rm.texi | 99 | ||||
-rw-r--r-- | gcc/ada/gnat_ugn.texi | 10 | ||||
-rw-r--r-- | gcc/ada/pprint.adb | 1 | ||||
-rw-r--r-- | gcc/ada/sem.adb | 6 | ||||
-rw-r--r-- | gcc/ada/sem_ch13.adb | 15 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.adb | 101 | ||||
-rw-r--r-- | gcc/ada/sem_res.adb | 34 | ||||
-rw-r--r-- | gcc/ada/sinfo-utils.adb | 1 | ||||
-rw-r--r-- | gcc/ada/sinfo.ads | 15 | ||||
-rw-r--r-- | gcc/ada/sinput.adb | 19 | ||||
-rw-r--r-- | gcc/ada/sinput.ads | 9 | ||||
-rw-r--r-- | gcc/ada/snames.ads-tmpl | 1 | ||||
-rw-r--r-- | gcc/ada/sprint.adb | 3 | ||||
-rw-r--r-- | gcc/ada/types.ads | 2 |
26 files changed, 329 insertions, 54 deletions
diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index adaa11f..2a5e0f2 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -96,6 +96,7 @@ package Aspects is Aspect_Dispatching_Domain, Aspect_Dynamic_Predicate, Aspect_Exceptional_Cases, -- GNAT + Aspect_External_Initialization, -- GNAT Aspect_External_Name, Aspect_External_Tag, Aspect_Finalizable, -- GNAT @@ -293,6 +294,7 @@ package Aspects is Aspect_Effective_Writes => True, Aspect_Exceptional_Cases => True, Aspect_Extensions_Visible => True, + Aspect_External_Initialization => True, Aspect_Favor_Top_Level => True, Aspect_Finalizable => True, Aspect_First_Controlling_Parameter => True, @@ -437,6 +439,7 @@ package Aspects is Aspect_Dispatching_Domain => Expression, Aspect_Dynamic_Predicate => Expression, Aspect_Exceptional_Cases => Expression, + Aspect_External_Initialization => Expression, Aspect_External_Name => Expression, Aspect_External_Tag => Expression, Aspect_Finalizable => Expression, @@ -536,6 +539,7 @@ package Aspects is Aspect_Dynamic_Predicate => False, Aspect_Exceptional_Cases => False, Aspect_Exclusive_Functions => False, + Aspect_External_Initialization => False, Aspect_External_Name => False, Aspect_External_Tag => False, Aspect_Finalizable => False, @@ -711,6 +715,7 @@ package Aspects is Aspect_Exclusive_Functions => Name_Exclusive_Functions, Aspect_Export => Name_Export, Aspect_Extensions_Visible => Name_Extensions_Visible, + Aspect_External_Initialization => Name_External_Initialization, Aspect_External_Name => Name_External_Name, Aspect_External_Tag => Name_External_Tag, Aspect_Favor_Top_Level => Name_Favor_Top_Level, @@ -1050,6 +1055,7 @@ package Aspects is Aspect_Exceptional_Cases => Never_Delay, Aspect_Export => Never_Delay, Aspect_Extensions_Visible => Never_Delay, + Aspect_External_Initialization => Never_Delay, Aspect_First_Controlling_Parameter => Never_Delay, Aspect_Ghost => Never_Delay, Aspect_Global => Never_Delay, diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 57307c3..bc07876 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -10152,7 +10152,9 @@ package body Checks is -- T_Typ'Length = string-literal-length - if Nkind (Expr_Actual) = N_String_Literal + -- The above also applies to the External_Initializer case. + + if Nkind (Expr_Actual) in N_String_Literal | N_External_Initializer and then Ekind (Etype (Expr_Actual)) = E_String_Literal_Subtype then Cond := diff --git a/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst b/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst index e7cd73f..b29f23c 100644 --- a/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst +++ b/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst @@ -740,3 +740,28 @@ the following standard-Ada instantiation: Link to the original RFC: https://github.com/AdaCore/ada-spark-rfcs/blob/topic/generic_instantiations/considered/rfc-inference-of-dependent-types.md + +External_Initialization Aspect +------------------------------ + +The ``External_Initialization`` aspect provides a feature similar to Rust's ``include_bytes!`` +and to C23's ``#embed``. It has the effect of initializing an object with the contents of +a file specified by a file path. + +Only string objects and objects of type ``Ada.Streams.Stream_Element_Array`` can be subject +to the ``External_Initialization`` aspect. + +Example: + +.. code-block:: ada + + with Ada.Streams; + + package P is + S : constant String with External_Initialization => "foo.txt"; + + X : constant Ada.Streams.Stream_Element_Array with External_Initialization => "bar.bin"; + end P; + +Link to the original RFC: +https://github.com/AdaCore/ada-spark-rfcs/blob/master/considered/rfc-embed-binary-resources.rst diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 9b67384..5aa0f77 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -8260,6 +8260,7 @@ package body Exp_Util is | N_Expanded_Name | N_Explicit_Dereference | N_Extension_Aggregate + | N_External_Initializer | N_Floating_Point_Definition | N_Formal_Decimal_Fixed_Point_Definition | N_Formal_Derived_Type_Definition diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index b4c1aea5..9d3606c 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -345,11 +345,18 @@ extern void Set_Present_Expr (Node_Id, Uint); /* sinput: */ +struct c_array { + char *pointer; + int length; +}; + +#define C_Source_Buffer sinput__c_source_buffer #define Debug_Source_Name sinput__debug_source_name #define Get_Column_Number sinput__get_column_number #define Get_Logical_Line_Number sinput__get_logical_line_number #define Get_Source_File_Index sinput__get_source_file_index +extern struct c_array C_Source_Buffer (Source_File_Index); extern File_Name_Type Debug_Source_Name (Source_File_Index); extern Column_Number_Type Get_Column_Number (Source_Ptr); extern Line_Number_Type Get_Logical_Line_Number (Source_Ptr); diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index 1174eb1..32c5ed3 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -517,6 +517,7 @@ GNAT_ADA_OBJS+= \ ada/libgnat/g-speche.o \ ada/libgnat/g-table.o \ ada/libgnat/g-u3spch.o \ + ada/libgnat/i-c.o \ ada/libgnat/interfac.o \ ada/libgnat/s-addope.o \ ada/libgnat/s-addima.o \ @@ -691,6 +692,7 @@ GNATBIND_OBJS += \ ada/libgnat/g-byorma.o \ ada/libgnat/g-hesora.o \ ada/libgnat/g-htable.o \ + ada/libgnat/i-c.o \ ada/libgnat/interfac.o \ ada/libgnat/s-addope.o \ ada/libgnat/s-assert.o \ diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc index 710907b..ebcf2cd 100644 --- a/gcc/ada/gcc-interface/trans.cc +++ b/gcc/ada/gcc-interface/trans.cc @@ -6401,6 +6401,17 @@ gnat_to_gnu (Node_Id gnat_node) gnu_result = build_atomic_load (gnu_result, aa_sync); break; + case N_External_Initializer: + { + gnu_result_type = get_unpadded_type (Etype (gnat_node)); + struct c_array a = C_Source_Buffer (File_Index (gnat_node)); + + gnu_result = build_string ((unsigned) a.length, a.pointer); + + TREE_TYPE (gnu_result) = gnu_result_type; + } + break; + case N_Integer_Literal: { tree gnu_type; diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads index 8011fa3..dcebab6 100644 --- a/gcc/ada/gen_il-fields.ads +++ b/gcc/ada/gen_il-fields.ads @@ -182,6 +182,7 @@ package Gen_IL.Fields is Expression, Expression_Copy, Expressions, + File_Index, First_Bit, First_Inlined_Subprogram, First_Name, diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb index 327ff37..d211343 100644 --- a/gcc/ada/gen_il-gen-gen_nodes.adb +++ b/gcc/ada/gen_il-gen-gen_nodes.adb @@ -461,6 +461,9 @@ begin -- Gen_IL.Gen.Gen_Nodes (Sy (Actions, List_Id, Default_No_List), Sy (Expression, Node_Id, Default_Empty))); + Cc (N_External_Initializer, N_Subexpr, + (Sy (File_Index, Source_File_Index))); + Cc (N_If_Expression, N_Subexpr, (Sy (Expressions, List_Id, Default_No_List), Sy (Is_Elsif, Flag), diff --git a/gcc/ada/gen_il-gen.adb b/gcc/ada/gen_il-gen.adb index 7e58a2c..0f7abe7 100644 --- a/gcc/ada/gen_il-gen.adb +++ b/gcc/ada/gen_il-gen.adb @@ -872,6 +872,7 @@ package body Gen_IL.Gen is | Uint | Uint_Subtype | Ureal + | Source_File_Index | Source_Ptr | Union_Id | Node_Id diff --git a/gcc/ada/gen_il-types.ads b/gcc/ada/gen_il-types.ads index 48de818..f2a6595 100644 --- a/gcc/ada/gen_il-types.ads +++ b/gcc/ada/gen_il-types.ads @@ -60,6 +60,7 @@ package Gen_IL.Types is Upos, Nonzero_Uint, Ureal, + Source_File_Index, Node_Kind_Type, -- Type of result of Nkind function, i.e. Node_Kind Entity_Kind_Type, -- Type of result of Ekind function, i.e. Entity_Kind @@ -249,6 +250,7 @@ package Gen_IL.Types is N_String_Literal, N_Explicit_Dereference, N_Expression_With_Actions, + N_External_Initializer, N_If_Expression, N_Indexed_Component, N_Interpolated_String_Literal, diff --git a/gcc/ada/gnat-style.texi b/gcc/ada/gnat-style.texi index 29b4c88..d0ba53a 100644 --- a/gcc/ada/gnat-style.texi +++ b/gcc/ada/gnat-style.texi @@ -3,7 +3,7 @@ @setfilename gnat-style.info @documentencoding UTF-8 @ifinfo -@*Generated by Sphinx 5.3.0.@* +@*Generated by Sphinx 8.0.2.@* @end ifinfo @settitle GNAT Coding Style A Guide for GNAT Developers @defindex ge @@ -19,7 +19,7 @@ @copying @quotation -GNAT Coding Style: A Guide for GNAT Developers , Dec 21, 2023 +GNAT Coding Style: A Guide for GNAT Developers , Oct 07, 2024 AdaCore diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 4ef631f..e2686b0 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -3,7 +3,7 @@ @setfilename gnat_rm.info @documentencoding UTF-8 @ifinfo -@*Generated by Sphinx 5.3.0.@* +@*Generated by Sphinx 8.0.2.@* @end ifinfo @settitle GNAT Reference Manual @defindex ge @@ -19,7 +19,7 @@ @copying @quotation -GNAT Reference Manual , Aug 30, 2024 +GNAT Reference Manual , Oct 07, 2024 AdaCore @@ -913,6 +913,7 @@ Experimental Language Extensions * Mutably Tagged Types with Size’Class Aspect:: * Generalized Finalization:: * Inference of Dependent Types in Generic Instantiations:: +* External_Initialization Aspect:: Security Hardening Features @@ -9193,7 +9194,7 @@ also be used as a configuration pragma. The fourth form, with an @code{On|Off} parameter and a string, is used to control individual messages, based on their text. The string argument is a pattern that is used to match against the text of individual -warning messages (not including the initial “warning: ” tag). +warning messages (not including the initial “warning: “ tag). The pattern may contain asterisks, which match zero or more characters in the message. For example, you can use @@ -29387,6 +29388,7 @@ Features activated via @code{-gnatX0} or * Mutably Tagged Types with Size’Class Aspect:: * Generalized Finalization:: * Inference of Dependent Types in Generic Instantiations:: +* External_Initialization Aspect:: @end menu @@ -29724,7 +29726,7 @@ procedure Initialize (Obj : in out Ctrl); Link to the original RFC: @indicateurl{https://github.com/AdaCore/ada-spark-rfcs/blob/topic/finalization-rehaul/considered/rfc-generalized-finalization.md} -@node Inference of Dependent Types in Generic Instantiations,,Generalized Finalization,Experimental Language Extensions +@node Inference of Dependent Types in Generic Instantiations,External_Initialization Aspect,Generalized Finalization,Experimental Language Extensions @anchor{gnat_rm/gnat_language_extensions inference-of-dependent-types-in-generic-instantiations}@anchor{455} @subsection Inference of Dependent Types in Generic Instantiations @@ -29804,8 +29806,35 @@ package Int_Array_Operations is new Array_Operations Link to the original RFC: @indicateurl{https://github.com/AdaCore/ada-spark-rfcs/blob/topic/generic_instantiations/considered/rfc-inference-of-dependent-types.md} +@node External_Initialization Aspect,,Inference of Dependent Types in Generic Instantiations,Experimental Language Extensions +@anchor{gnat_rm/gnat_language_extensions external-initialization-aspect}@anchor{456} +@subsection External_Initialization Aspect + + +The @code{External_Initialization} aspect provides a feature similar to Rust’s @code{include_bytes!} +and to C23’s @code{#embed}. It has the effect of initializing an object with the contents of +a file specified by a file path. + +Only string objects and objects of type @code{Ada.Streams.Stream_Element_Array} can be subject +to the @code{External_Initialization} aspect. + +Example: + +@example +with Ada.Streams; + +package P is + S : constant String with External_Initialization => "foo.txt"; + + X : constant Ada.Streams.Stream_Element_Array with External_Initialization => "bar.bin"; +end P; +@end example + +Link to the original RFC: +@indicateurl{https://github.com/AdaCore/ada-spark-rfcs/blob/master/considered/rfc-embed-binary-resources.rst} + @node Security Hardening Features,Obsolescent Features,GNAT language extensions,Top -@anchor{gnat_rm/security_hardening_features doc}@anchor{456}@anchor{gnat_rm/security_hardening_features id1}@anchor{457}@anchor{gnat_rm/security_hardening_features security-hardening-features}@anchor{15} +@anchor{gnat_rm/security_hardening_features doc}@anchor{457}@anchor{gnat_rm/security_hardening_features id1}@anchor{458}@anchor{gnat_rm/security_hardening_features security-hardening-features}@anchor{15} @chapter Security Hardening Features @@ -29827,7 +29856,7 @@ change. @end menu @node Register Scrubbing,Stack Scrubbing,,Security Hardening Features -@anchor{gnat_rm/security_hardening_features register-scrubbing}@anchor{458} +@anchor{gnat_rm/security_hardening_features register-scrubbing}@anchor{459} @section Register Scrubbing @@ -29863,7 +29892,7 @@ programming languages, see @cite{Using the GNU Compiler Collection (GCC)}. @c Stack Scrubbing: @node Stack Scrubbing,Hardened Conditionals,Register Scrubbing,Security Hardening Features -@anchor{gnat_rm/security_hardening_features stack-scrubbing}@anchor{459} +@anchor{gnat_rm/security_hardening_features stack-scrubbing}@anchor{45a} @section Stack Scrubbing @@ -30007,7 +30036,7 @@ Bar_Callable_Ptr. @c Hardened Conditionals: @node Hardened Conditionals,Hardened Booleans,Stack Scrubbing,Security Hardening Features -@anchor{gnat_rm/security_hardening_features hardened-conditionals}@anchor{45a} +@anchor{gnat_rm/security_hardening_features hardened-conditionals}@anchor{45b} @section Hardened Conditionals @@ -30097,7 +30126,7 @@ be used with other programming languages supported by GCC. @c Hardened Booleans: @node Hardened Booleans,Control Flow Redundancy,Hardened Conditionals,Security Hardening Features -@anchor{gnat_rm/security_hardening_features hardened-booleans}@anchor{45b} +@anchor{gnat_rm/security_hardening_features hardened-booleans}@anchor{45c} @section Hardened Booleans @@ -30158,7 +30187,7 @@ and more details on that attribute, see @cite{Using the GNU Compiler Collection @c Control Flow Redundancy: @node Control Flow Redundancy,,Hardened Booleans,Security Hardening Features -@anchor{gnat_rm/security_hardening_features control-flow-redundancy}@anchor{45c} +@anchor{gnat_rm/security_hardening_features control-flow-redundancy}@anchor{45d} @section Control Flow Redundancy @@ -30326,7 +30355,7 @@ see @cite{Using the GNU Compiler Collection (GCC)}. These options can be used with other programming languages supported by GCC. @node Obsolescent Features,Compatibility and Porting Guide,Security Hardening Features,Top -@anchor{gnat_rm/obsolescent_features doc}@anchor{45d}@anchor{gnat_rm/obsolescent_features id1}@anchor{45e}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{16} +@anchor{gnat_rm/obsolescent_features doc}@anchor{45e}@anchor{gnat_rm/obsolescent_features id1}@anchor{45f}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{16} @chapter Obsolescent Features @@ -30345,7 +30374,7 @@ compatibility purposes. @end menu @node pragma No_Run_Time,pragma Ravenscar,,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id2}@anchor{45f}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{460} +@anchor{gnat_rm/obsolescent_features id2}@anchor{460}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{461} @section pragma No_Run_Time @@ -30358,7 +30387,7 @@ preferred usage is to use an appropriately configured run-time that includes just those features that are to be made accessible. @node pragma Ravenscar,pragma Restricted_Run_Time,pragma No_Run_Time,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id3}@anchor{461}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{462} +@anchor{gnat_rm/obsolescent_features id3}@anchor{462}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{463} @section pragma Ravenscar @@ -30367,7 +30396,7 @@ The pragma @code{Ravenscar} has exactly the same effect as pragma is part of the new Ada 2005 standard. @node pragma Restricted_Run_Time,pragma Task_Info,pragma Ravenscar,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id4}@anchor{463}@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{464} +@anchor{gnat_rm/obsolescent_features id4}@anchor{464}@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{465} @section pragma Restricted_Run_Time @@ -30377,7 +30406,7 @@ preferred since the Ada 2005 pragma @code{Profile} is intended for this kind of implementation dependent addition. @node pragma Task_Info,package System Task_Info s-tasinf ads,pragma Restricted_Run_Time,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id5}@anchor{465}@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{466} +@anchor{gnat_rm/obsolescent_features id5}@anchor{466}@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{467} @section pragma Task_Info @@ -30403,7 +30432,7 @@ in the spec of package System.Task_Info in the runtime library. @node package System Task_Info s-tasinf ads,,pragma Task_Info,Obsolescent Features -@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{467}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{468} +@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{468}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{469} @section package System.Task_Info (@code{s-tasinf.ads}) @@ -30413,7 +30442,7 @@ to support the @code{Task_Info} pragma. The predefined Ada package standard replacement for GNAT’s @code{Task_Info} functionality. @node Compatibility and Porting Guide,GNU Free Documentation License,Obsolescent Features,Top -@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{469}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{17}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{46a} +@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{46a}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{17}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{46b} @chapter Compatibility and Porting Guide @@ -30435,7 +30464,7 @@ applications developed in other Ada environments. @end menu @node Writing Portable Fixed-Point Declarations,Compatibility with Ada 83,,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{46b}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{46c} +@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{46c}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{46d} @section Writing Portable Fixed-Point Declarations @@ -30557,7 +30586,7 @@ If you follow this scheme you will be guaranteed that your fixed-point types will be portable. @node Compatibility with Ada 83,Compatibility between Ada 95 and Ada 2005,Writing Portable Fixed-Point Declarations,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{46d}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{46e} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{46e}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{46f} @section Compatibility with Ada 83 @@ -30585,7 +30614,7 @@ following subsections treat the most likely issues to be encountered. @end menu @node Legal Ada 83 programs that are illegal in Ada 95,More deterministic semantics,,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{46f}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{470} +@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{470}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{471} @subsection Legal Ada 83 programs that are illegal in Ada 95 @@ -30685,7 +30714,7 @@ the fix is usually simply to add the @code{(<>)} to the generic declaration. @end itemize @node More deterministic semantics,Changed semantics,Legal Ada 83 programs that are illegal in Ada 95,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{471}@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{472} +@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{472}@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{473} @subsection More deterministic semantics @@ -30713,7 +30742,7 @@ which open select branches are executed. @end itemize @node Changed semantics,Other language compatibility issues,More deterministic semantics,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{473}@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{474} +@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{474}@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{475} @subsection Changed semantics @@ -30755,7 +30784,7 @@ covers only the restricted range. @end itemize @node Other language compatibility issues,,Changed semantics,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{475}@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{476} +@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{476}@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{477} @subsection Other language compatibility issues @@ -30788,7 +30817,7 @@ include @code{pragma Interface} and the floating point type attributes @end itemize @node Compatibility between Ada 95 and Ada 2005,Implementation-dependent characteristics,Compatibility with Ada 83,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{477}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{478} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{478}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{479} @section Compatibility between Ada 95 and Ada 2005 @@ -30860,7 +30889,7 @@ can declare a function returning a value from an anonymous access type. @end itemize @node Implementation-dependent characteristics,Compatibility with Other Ada Systems,Compatibility between Ada 95 and Ada 2005,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{479}@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{47a} +@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{47a}@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{47b} @section Implementation-dependent characteristics @@ -30883,7 +30912,7 @@ transition from certain Ada 83 compilers. @end menu @node Implementation-defined pragmas,Implementation-defined attributes,,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{47b}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{47c} +@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{47c}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{47d} @subsection Implementation-defined pragmas @@ -30905,7 +30934,7 @@ avoiding compiler rejection of units that contain such pragmas; they are not relevant in a GNAT context and hence are not otherwise implemented. @node Implementation-defined attributes,Libraries,Implementation-defined pragmas,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{47d}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{47e} +@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{47e}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{47f} @subsection Implementation-defined attributes @@ -30919,7 +30948,7 @@ Ada 83, GNAT supplies the attributes @code{Bit}, @code{Machine_Size} and @code{Type_Class}. @node Libraries,Elaboration order,Implementation-defined attributes,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{47f}@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{480} +@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{480}@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{481} @subsection Libraries @@ -30948,7 +30977,7 @@ be preferable to retrofit the application using modular types. @end itemize @node Elaboration order,Target-specific aspects,Libraries,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{481}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{482} +@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{482}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{483} @subsection Elaboration order @@ -30984,7 +31013,7 @@ pragmas either globally (as an effect of the `-gnatE' switch) or locally @end itemize @node Target-specific aspects,,Elaboration order,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{483}@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{484} +@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{484}@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{485} @subsection Target-specific aspects @@ -30997,10 +31026,10 @@ on the robustness of the original design. Moreover, Ada 95 (and thus Ada 2005 and Ada 2012) are sometimes incompatible with typical Ada 83 compiler practices regarding implicit packing, the meaning of the Size attribute, and the size of access values. -GNAT’s approach to these issues is described in @ref{485,,Representation Clauses}. +GNAT’s approach to these issues is described in @ref{486,,Representation Clauses}. @node Compatibility with Other Ada Systems,Representation Clauses,Implementation-dependent characteristics,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{486}@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{487} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{487}@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{488} @section Compatibility with Other Ada Systems @@ -31043,7 +31072,7 @@ far beyond this minimal set, as described in the next section. @end itemize @node Representation Clauses,Compatibility with HP Ada 83,Compatibility with Other Ada Systems,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{488}@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{485} +@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{489}@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{486} @section Representation Clauses @@ -31136,7 +31165,7 @@ with thin pointers. @end itemize @node Compatibility with HP Ada 83,,Representation Clauses,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{489}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{48a} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{48a}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{48b} @section Compatibility with HP Ada 83 @@ -31166,7 +31195,7 @@ extension of package System. @end itemize @node GNU Free Documentation License,Index,Compatibility and Porting Guide,Top -@anchor{share/gnu_free_documentation_license doc}@anchor{48b}@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{48c} +@anchor{share/gnu_free_documentation_license doc}@anchor{48c}@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{48d} @chapter GNU Free Documentation License diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index e59ee9f..9ba8984 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -3,7 +3,7 @@ @setfilename gnat_ugn.info @documentencoding UTF-8 @ifinfo -@*Generated by Sphinx 5.3.0.@* +@*Generated by Sphinx 8.0.2.@* @end ifinfo @settitle GNAT User's Guide for Native Platforms @defindex ge @@ -19,7 +19,7 @@ @copying @quotation -GNAT User's Guide for Native Platforms , Aug 30, 2024 +GNAT User's Guide for Native Platforms , Oct 07, 2024 AdaCore @@ -11195,7 +11195,7 @@ of the pragma @code{Restriction_Warnings}. `[warning-as-error]' Used to tag warning messages that have been converted to error messages by use of the pragma Warning_As_Error. Note that such warnings are prefixed by -the string “error: ” rather than “warning: “. +the string “error: “ rather than “warning: “. @item `[enabled by default]' @@ -23061,13 +23061,13 @@ From there, to be able to link your binaries with PIE and therefore drop the @code{-no-pie} workaround, you’ll need to get the identified dependencies rebuilt with PIE enabled (compiled with @code{-fPIE} and linked with @code{-pie}). -@anchor{gnat_ugn/platform_specific_information choosing-the-scheduling-policy-with-gnu-linux}@anchor{1c2} + @geindex SCHED_FIFO scheduling policy @geindex SCHED_RR scheduling policy @geindex SCHED_OTHER scheduling policy - +@anchor{gnat_ugn/platform_specific_information choosing-the-scheduling-policy-with-gnu-linux}@anchor{1c2} @node Choosing the Scheduling Policy with GNU/Linux,A GNU/Linux Debug Quirk,Position Independent Executable PIE Enabled by Default on Linux,GNU/Linux Topics @anchor{gnat_ugn/platform_specific_information id7}@anchor{1c3} @subsection Choosing the Scheduling Policy with GNU/Linux diff --git a/gcc/ada/pprint.adb b/gcc/ada/pprint.adb index 6d30511..fbf0e59 100644 --- a/gcc/ada/pprint.adb +++ b/gcc/ada/pprint.adb @@ -653,6 +653,7 @@ package body Pprint is when N_Case_Expression | N_Delta_Aggregate + | N_External_Initializer | N_Interpolated_String_Literal | N_Op_Rotate_Left | N_Op_Rotate_Right diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 3305b56..915a1cc 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -249,6 +249,12 @@ package body Sem is when N_Extension_Aggregate => Analyze_Aggregate (N); + -- The expansion of the External_Initialization aspect creates fully + -- analyzed N_External_Initializer nodes. + + when N_External_Initializer => + null; + when N_Formal_Object_Declaration => Analyze_Formal_Object_Declaration (N); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 0770baf..953da67 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -4638,6 +4638,20 @@ package body Sem_Ch13 is Chars => Name_Storage_Size, Expression => Relocate_Node (Expr)); end if; + + when Aspect_External_Initialization => + Error_Msg_GNAT_Extension + ("External_Initialization aspect", Sloc (Aspect)); + + -- The External_Initialization aspect specifications that + -- are attached to object declarations were already + -- processed and detached from the list at an earlier stage, + -- so we can only get here if the specification is not in an + -- appropriate place. + + Error_Msg_N + ("External_Initialization aspect can only be specified " & + "for object declarations", Aspect); end case; -- Attach the corresponding pragma/attribute definition clause to @@ -11566,6 +11580,7 @@ package body Sem_Ch13 is | Aspect_Dimension | Aspect_Dimension_System | Aspect_Exceptional_Cases + | Aspect_External_Initialization | Aspect_Global | Aspect_GNAT_Annotate | Aspect_Implicit_Dereference diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 4dac4ee..e2050e4 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -82,7 +82,9 @@ with Sinfo; use Sinfo; with Sinfo.Nodes; use Sinfo.Nodes; with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; +with Sinput.L; with Snames; use Snames; +with Stringt; with Strub; use Strub; with Targparm; use Targparm; with Tbuild; use Tbuild; @@ -3845,6 +3847,12 @@ package body Sem_Ch3 is -- E is set to Expression (N) throughout this routine. When Expression -- (N) is modified, E is changed accordingly. + procedure Apply_External_Initialization + (Specification : N_Aspect_Specification_Id); + -- Transform N with the effects of the External_Initialization aspect + -- specified by Specification. Note that Specification is removed from + -- N's list of aspects. + procedure Check_Dynamic_Object (Typ : Entity_Id); -- A library-level object with nonstatic discriminant constraints may -- require dynamic allocation. The declaration is illegal if the @@ -3881,6 +3889,84 @@ package body Sem_Ch3 is -- Any other relevant delayed aspects on object declarations ??? + ----------------------------------- + -- Apply_External_Initialization -- + ----------------------------------- + + procedure Apply_External_Initialization + (Specification : N_Aspect_Specification_Id) + is + Def : constant Node_Id := Expression (Specification); + + Expr : N_Subexpr_Id; + + begin + Remove (Specification); + + Error_Msg_GNAT_Extension + ("External_Initialization aspect", Sloc (Specification)); + + if Present (E) then + Error_Msg_N + ("initialization expression not allowed for object with aspect " + & "External_Initialization", Specification); + return; + end if; + + Set_Has_Init_Expression (N); + Set_Expression (N, Error); + E := Error; + + if Nkind (Def) /= N_String_Literal then + Error_Msg_N + ("External_Initialization aspect expects a string literal value", + Specification); + return; + end if; + + if not (Is_String_Type (T) + or else Is_RTE (Base_Type (T), RE_Stream_Element_Array)) + then + Error_Msg_N + ("External_Initialization aspect can only be applied to objects " + & "of string types or type Ada.Streams.Stream_Element_Array", + Specification); + return; + end if; + + begin + declare + Name : constant Valid_Name_Id := + Stringt.String_To_Name (Strval (Def)); + + Source_File_I : constant Source_File_Index := + Sinput.L.Load_Source_File (File_Name_Type (Name)); + begin + if Source_File_I <= No_Source_File then + Error_Msg_N ("cannot find input file", Specification); + return; + end if; + + Expr := + Make_External_Initializer + (Sloc (Specification), Source_File_I); + end; + exception + when Constraint_Error => + -- The most likely cause for a constraint error is a file + -- whose size does not fit into Integer. We could modify + -- Load_Source_File to report that error with a special + -- exception??? + Error_Msg_N + ("External_Initialization file exceeds maximum length", + Specification); + return; + end; + + Set_Expression (N, Expr); + E := Expr; + end Apply_External_Initialization; + -------------------------- -- Check_Dynamic_Object -- -------------------------- @@ -4393,6 +4479,15 @@ package body Sem_Ch3 is end if; end if; + declare + S : constant Opt_N_Aspect_Specification_Id := + Find_Aspect (Id, Aspect_External_Initialization); + begin + if Present (S) then + Apply_External_Initialization (S); + end if; + end; + -- Ada 2005 (AI-231): Propagate the null-excluding attribute and carry -- out some static checks. @@ -4891,12 +4986,10 @@ package body Sem_Ch3 is end if; end if; - -- Case of initialization present but in error. Set initial - -- expression as absent (but do not make above complaints). + -- Case of initialization present but in error elsif E = Error then - Set_Expression (N, Empty); - E := Empty; + null; -- Case of initialization present diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index e7fd7d6..c8652ee 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -84,6 +84,7 @@ with Sinfo; use Sinfo; with Sinfo.Nodes; use Sinfo.Nodes; with Sinfo.Utils; use Sinfo.Utils; with Sinfo.CN; use Sinfo.CN; +with Sinput; use Sinput; with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; @@ -213,6 +214,7 @@ package body Sem_Res is procedure Resolve_Equality_Op (N : Node_Id; Typ : Entity_Id); procedure Resolve_Explicit_Dereference (N : Node_Id; Typ : Entity_Id); procedure Resolve_Expression_With_Actions (N : Node_Id; Typ : Entity_Id); + procedure Resolve_External_Initializer (N : Node_Id; Typ : Entity_Id); procedure Resolve_If_Expression (N : Node_Id; Typ : Entity_Id); procedure Resolve_Generalized_Indexing (N : Node_Id; Typ : Entity_Id); procedure Resolve_Indexed_Component (N : Node_Id; Typ : Entity_Id); @@ -298,8 +300,10 @@ package body Sem_Res is procedure Set_String_Literal_Subtype (N : Node_Id; Typ : Entity_Id); -- The String_Literal_Subtype is built for all strings that are not - -- operands of a static concatenation operation. If the argument is not - -- a N_String_Literal node, then the call has no effect. + -- operands of a static concatenation operation. It is also built for + -- expressions generated by the expansion of the External_Initialization + -- aspect. If the argument is not an N_String_Literal node or an + -- N_External_Initializer node, then the call has no effect. procedure Set_Slice_Subtype (N : Node_Id); -- Build subtype of array type, with the range specified by the slice @@ -3414,6 +3418,9 @@ package body Sem_Res is when N_Extension_Aggregate => Resolve_Extension_Aggregate (N, Ctx_Type); + when N_External_Initializer => + Resolve_External_Initializer (N, Ctx_Type); + when N_Function_Call => Resolve_Call (N, Ctx_Type); @@ -9375,6 +9382,15 @@ package body Sem_Res is end Resolve_Expression_With_Actions; ---------------------------------- + -- Resolve_External_Initializer -- + ---------------------------------- + + procedure Resolve_External_Initializer (N : Node_Id; Typ : Entity_Id) is + begin + Set_String_Literal_Subtype (N, Typ); + end Resolve_External_Initializer; + + ---------------------------------- -- Resolve_Generalized_Indexing -- ---------------------------------- @@ -13037,16 +13053,23 @@ package body Sem_Res is Loc : constant Source_Ptr := Sloc (N); Low_Bound : constant Node_Id := Type_Low_Bound (Etype (First_Index (Typ))); + Length : constant Nat := + (case Nkind (N) is + when N_String_Literal => String_Length (Strval (N)), + -- Sinput.Source_Last points to an EOF character that's not in the + -- original file and we do not include that character. + when N_External_Initializer => Nat ( + Source_Last (File_Index (N)) - Source_First (File_Index (N))), + when others => 0); Subtype_Id : Entity_Id; begin - if Nkind (N) /= N_String_Literal then + if Nkind (N) not in N_String_Literal | N_External_Initializer then return; end if; Subtype_Id := Create_Itype (E_String_Literal_Subtype, N); - Set_String_Literal_Length (Subtype_Id, UI_From_Int - (String_Length (Strval (N)))); + Set_String_Literal_Length (Subtype_Id, UI_From_Int (Length)); Set_Etype (Subtype_Id, Base_Type (Typ)); Set_Is_Constrained (Subtype_Id); Set_Etype (N, Subtype_Id); @@ -13068,7 +13091,6 @@ package body Sem_Res is else declare - Length : constant Nat := String_Length (Strval (N)); Index_List : constant List_Id := New_List; Index_Type : constant Entity_Id := Etype (First_Index (Typ)); Array_Subtype : Entity_Id; diff --git a/gcc/ada/sinfo-utils.adb b/gcc/ada/sinfo-utils.adb index 25bb09d..23485aa 100644 --- a/gcc/ada/sinfo-utils.adb +++ b/gcc/ada/sinfo-utils.adb @@ -255,6 +255,7 @@ package body Sinfo.Utils is when Flag_Field | Node_Kind_Type_Field | Entity_Kind_Type_Field + | Source_File_Index_Field | Source_Ptr_Field | Small_Paren_Count_Type_Field | Convention_Id_Field diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index beecc2c..746207a 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1291,6 +1291,10 @@ package Sinfo is -- modifications performed on the original expression such as replacement -- of the current type instance or substitutions of primitives. + -- File_Index + -- Present in N_External_Initializer nodes. Contains a Source_File_Index + -- that references the file the external initializer points to. + -- First_Inlined_Subprogram -- Present in the N_Compilation_Unit node for the main program. Points -- to a chain of entities for subprograms that are to be inlined. The @@ -8070,6 +8074,17 @@ package Sinfo is -- the expression of the node is fully analyzed and expanded, at which -- point it is safe to remove it, since no more actions can be inserted. + -------------------------- + -- External Initializer -- + -------------------------- + + -- This node is used to represent an instance of the + -- External_Initialization aspect. + + -- N_External_Initializer + -- File_Index + -- plus fields for expression + -------------------- -- Free Statement -- -------------------- diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb index 8538a06..f2e6dda 100644 --- a/gcc/ada/sinput.adb +++ b/gcc/ada/sinput.adb @@ -276,6 +276,25 @@ package body Sinput is return +Buf; end Build_Location_String; + --------------------- + -- C_Source_Buffer -- + --------------------- + + function C_Source_Buffer (S : SFI) return C_Array is + use type Interfaces.C.int; + + Length : constant Interfaces.C.int := + Interfaces.C.int (Source_Last (S) - Source_First (S)); + + Text : constant Source_Buffer_Ptr := Source_Text (S); + + Pointer : constant access constant Character := + (if Length = 0 then null else + Text (Text'First)'Access); + begin + return (Pointer, Length); + end C_Source_Buffer; + ------------------- -- Check_For_BOM -- ------------------- diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads index 1045acd..ce47fef 100644 --- a/gcc/ada/sinput.ads +++ b/gcc/ada/sinput.ads @@ -56,6 +56,7 @@ with Alloc; with Casing; use Casing; +with Interfaces.C; with Namet; use Namet; with System; with Table; @@ -706,6 +707,14 @@ package Sinput is -- reloaded. It is intended for tools that parse several times sources, -- to avoid memory leaks. + type C_Array is record + Pointer : access constant Character; + Length : Interfaces.C.int range 0 .. Interfaces.C.int'Last; + end record with Convention => C_Pass_By_Copy; + + function C_Source_Buffer (S : SFI) return C_Array with + Export, Convention => C, External_Name => "sinput__c_source_buffer"; + private pragma Inline (File_Name); pragma Inline (Full_File_Name); diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 12a14c8..b11eb30 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -155,6 +155,7 @@ package Snames is Name_Disable_Controlled : constant Name_Id := N + $; Name_Dynamic_Predicate : constant Name_Id := N + $; Name_Exclusive_Functions : constant Name_Id := N + $; + Name_External_Initialization : constant Name_Id := N + $; Name_Finalizable : constant Name_Id := N + $; Name_Full_Access_Only : constant Name_Id := N + $; Name_Ghost_Predicate : constant Name_Id := N + $; diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index ea16591..321fd7f 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -1840,6 +1840,9 @@ package body Sprint is Write_Char (';'); + when N_External_Initializer => + null; + when N_Delta_Aggregate => Write_Str_With_Col_Check_Sloc ("("); Sprint_Node (Expression (Node)); diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index 97fbbf4..bc466f6 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -147,7 +147,7 @@ package Types is type Text_Ptr is new Int range -4 .. Int'Last; -- -4 .. -1 are special; see constants below - type Text_Buffer is array (Text_Ptr range <>) of Character; + type Text_Buffer is array (Text_Ptr range <>) of aliased Character; -- Text buffer used to hold source file or library information file type Text_Buffer_Ptr is access all Text_Buffer; |