From: Arnaud Charlet Date: Tue, 29 Jul 2014 13:16:09 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=220d1fd9dfd8d7abcb9d5cc38f5ee8e5ba7c2a64;p=gcc.git [multiple changes] 2014-07-29 Robert Dewar * ali.adb (Initialize_ALI): Initialize SSO_Default_Specified (Scan_ALI): Set SSO_Default in ALIs_Record (Scan_ALI): Set SSO_Default_Specified. * ali.ads (ALIs_Record): Add field SSO_Default (SSO_Default_Specified): New global switch. * bcheck.adb (Check_Consistent_SSO_Default): New procedure (Check_Configuration_Consistency): Call this procedure * einfo.adb (SSO_Set_High_By_Default): New function (SSO_Set_Low_By_Default): New function (Set_SSO_Set_High_By_Default): New procedure (Set_SSO_Set_Low_By_Default): New procedure (Write_Entity_Flags): List new flags * einfo.ads (SSO_Set_Low_By_Default): New flag (SSO_Set_High_By_Default): New flag * freeze.adb (Set_SSO_From_Default): New procedure (Freeze_Array_Type): Call Set_SSO_From_Default (Freeze_Record_Type): Call Set_SSO_From_Default * gnat_rm.texi: Document pragma Default_Scalar_Storage_Order * lib-writ.adb (Write_ALI): Set OL/OH in P line as needed * lib-writ.ads: Add OL/OH parameters to P line * opt.adb: Set Default_SSO, Default_SSO_Config as appropriate * opt.ads (Default_SSO): New global switch (Default_SSO_Config): New global switch * repinfo.adb (List_Scalar_Storage_Order): List SSO when it is set by default using pragma Default_Scalar_Storage_Order. * sem.ads (Scope_Stack_Entry): Add component Save_Default_SSO * sem_ch13.adb (Inherit_Delayed_Rep_Aspects): Clear SSO defaults when explicit SSO is inherited. (Analyze_Attribute_Definition_Clause): Clear SSO defaults when explicit SSO is specified. (Inherit_Aspects_At_Freeze_Point): Clear SSO default when inheriting SSO. * sem_ch3.adb (Set_Default_SSO): New procedure (Analyze_Private_Extension_Declaration): Set defualt SSO (Array_Type_Declaration): ditto (Build_Derived_Array_Type): ditto (Build_Derived_Private_Type): ditto (Build_Derived_Record_Type): ditto (Build_Derived_Type): ditto (Make_Class_Wide_Type): ditto (Record_Type_Declaration): ditto * sem_ch8.adb (Pop_Scope): Restore Default_SSO (Push_Scope): Save Default_SSO * sem_prag.adb (Analyze_Pragma, case Default_Scalar_Storage_Order): Set Default_SSO 2014-07-29 Ed Schonberg * sem_ch6.adb (Valid_Operator_Definition): Verify that all parameter have mode IN. This check must be done here for subprogram instantiations that have operator names, because their analysis does not follow the same path as that for subprogram declarations. From-SVN: r213167 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 917f4beb415..82be63d5d5a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,56 @@ +2014-07-29 Robert Dewar + + * ali.adb (Initialize_ALI): Initialize SSO_Default_Specified + (Scan_ALI): Set SSO_Default in ALIs_Record (Scan_ALI): Set + SSO_Default_Specified. + * ali.ads (ALIs_Record): Add field SSO_Default + (SSO_Default_Specified): New global switch. + * bcheck.adb (Check_Consistent_SSO_Default): New procedure + (Check_Configuration_Consistency): Call this procedure + * einfo.adb (SSO_Set_High_By_Default): New + function (SSO_Set_Low_By_Default): New function + (Set_SSO_Set_High_By_Default): New procedure + (Set_SSO_Set_Low_By_Default): New procedure (Write_Entity_Flags): + List new flags + * einfo.ads (SSO_Set_Low_By_Default): New flag + (SSO_Set_High_By_Default): New flag + * freeze.adb (Set_SSO_From_Default): New procedure + (Freeze_Array_Type): Call Set_SSO_From_Default + (Freeze_Record_Type): Call Set_SSO_From_Default + * gnat_rm.texi: Document pragma Default_Scalar_Storage_Order + * lib-writ.adb (Write_ALI): Set OL/OH in P line as needed + * lib-writ.ads: Add OL/OH parameters to P line + * opt.adb: Set Default_SSO, Default_SSO_Config as appropriate + * opt.ads (Default_SSO): New global switch (Default_SSO_Config): + New global switch + * repinfo.adb (List_Scalar_Storage_Order): List SSO when it is + set by default using pragma Default_Scalar_Storage_Order. + * sem.ads (Scope_Stack_Entry): Add component Save_Default_SSO + * sem_ch13.adb (Inherit_Delayed_Rep_Aspects): + Clear SSO defaults when explicit SSO is inherited. + (Analyze_Attribute_Definition_Clause): Clear SSO defaults when + explicit SSO is specified. + (Inherit_Aspects_At_Freeze_Point): + Clear SSO default when inheriting SSO. + * sem_ch3.adb (Set_Default_SSO): New procedure + (Analyze_Private_Extension_Declaration): Set defualt SSO + (Array_Type_Declaration): ditto (Build_Derived_Array_Type): ditto + (Build_Derived_Private_Type): ditto (Build_Derived_Record_Type): + ditto (Build_Derived_Type): ditto (Make_Class_Wide_Type): ditto + (Record_Type_Declaration): ditto + * sem_ch8.adb (Pop_Scope): Restore Default_SSO (Push_Scope): + Save Default_SSO + * sem_prag.adb (Analyze_Pragma, case + Default_Scalar_Storage_Order): Set Default_SSO + +2014-07-29 Ed Schonberg + + * sem_ch6.adb (Valid_Operator_Definition): Verify that + all parameter have mode IN. This check must be done here for + subprogram instantiations that have operator names, because their + analysis does not follow the same path as that for subprogram + declarations. + 2014-07-29 Robert Dewar * freeze.adb (Freeze_Entity, Concurrent_Type case): Add a guard diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 73db0e88b50..d94cb7e0e09 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -115,6 +115,7 @@ package body ALI is Normalize_Scalars_Specified := False; Partition_Elaboration_Policy_Specified := ' '; Queuing_Policy_Specified := ' '; + SSO_Default_Specified := False; Static_Elaboration_Model_Used := False; Task_Dispatching_Policy_Specified := ' '; Unreserve_All_Interrupts_Specified := False; @@ -892,6 +893,7 @@ package body ALI is Restrictions => No_Restrictions, SAL_Interface => False, Sfile => No_File, + SSO_Default => ' ', Task_Dispatching_Policy => ' ', Time_Slice_Value => -1, WC_Encoding => 'b', @@ -1131,6 +1133,19 @@ package body ALI is Fatal_Error_Ignore; end if; + -- Processing for OH/OL + + elsif C = 'O' then + C := Getc; + + if C = 'L' or else C = 'H' then + ALIs.Table (Id).SSO_Default := C; + SSO_Default_Specified := True; + + else + Fatal_Error_Ignore; + end if; + -- Processing for Qx elsif C = 'Q' then diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index 66a462ed41e..1b05ba6717b 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -188,6 +188,12 @@ package ALI is -- Set to True if file was compiled with Normalize_Scalars. Not set if -- 'P' appears in Ignore_Lines. + SSO_Default : Character; + -- Set to 'H' or 'L' if file was compiled with a configuration pragma + -- file containing Default_Scalar_Storage_Order (High/Low_Order_First). + -- Set to ' ' if neither pragma was present. Not set if 'P' appears in + -- Ignore_Lines. + Unit_Exception_Table : Boolean; -- Set to True if unit exception table pointer generated. Not set if 'P' -- appears in Ignore_Lines. @@ -501,6 +507,11 @@ package ALI is -- ali files, showing whether a restriction pragma exists anywhere, and -- accumulating the aggregate knowledge of violations. + SSO_Default_Specified : Boolean := False; + -- Set to True if at least one ALI file contains an OH/OL flag indicating + -- that it was compiled with a configuration pragmas file containing the + -- pragma Default_Scalar_Storage_Order (OH/OL present in ALI file P line). + Stack_Check_Switch_Set : Boolean := False; -- Set to True if at least one ALI file contains '-fstack-check' in its -- argument list. diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb index 0e81ee650e9..a141013f843 100644 --- a/gcc/ada/bcheck.adb +++ b/gcc/ada/bcheck.adb @@ -56,6 +56,7 @@ package body Bcheck is procedure Check_Consistent_Queuing_Policy; procedure Check_Consistent_Restrictions; procedure Check_Consistent_Restriction_No_Default_Initialization; + procedure Check_Consistent_SSO_Default; procedure Check_Consistent_Zero_Cost_Exception_Handling; procedure Consistency_Error_Msg (Msg : String); @@ -88,6 +89,10 @@ package body Bcheck is Check_Consistent_Partition_Elaboration_Policy; end if; + if SSO_Default_Specified then + Check_Consistent_SSO_Default; + end if; + if Zero_Cost_Exceptions_Specified then Check_Consistent_Zero_Cost_Exception_Handling; end if; @@ -1108,6 +1113,73 @@ package body Bcheck is end loop; end Check_Consistent_Restriction_No_Default_Initialization; + ---------------------------------- + -- Check_Consistent_SSO_Default -- + ---------------------------------- + + procedure Check_Consistent_SSO_Default is + Default : Character; + + begin + Default := ALIs.Table (ALIs.First).SSO_Default; + + -- Check all entries match the default above from the first entry + + for A1 in ALIs.First + 1 .. ALIs.Last loop + if ALIs.Table (A1).SSO_Default /= Default then + Default := '?'; + exit; + end if; + end loop; + + -- All match, return + + if Default /= '?' then + return; + end if; + + -- Here we have a mismatch + + Consistency_Error_Msg + ("files not compiled with same Default_Scalar_Storage_Order"); + + Write_Eol; + Write_Str ("files compiled with High_Order_First"); + Write_Eol; + + for A1 in ALIs.First .. ALIs.Last loop + if ALIs.Table (A1).SSO_Default = 'H' then + Write_Str (" "); + Write_Name (ALIs.Table (A1).Sfile); + Write_Eol; + end if; + end loop; + + Write_Eol; + Write_Str ("files compiled with Low_Order_First"); + Write_Eol; + + for A1 in ALIs.First .. ALIs.Last loop + if ALIs.Table (A1).SSO_Default = 'L' then + Write_Str (" "); + Write_Name (ALIs.Table (A1).Sfile); + Write_Eol; + end if; + end loop; + + Write_Eol; + Write_Str ("files compiled with no Default_Scalar_Storage_Order"); + Write_Eol; + + for A1 in ALIs.First .. ALIs.Last loop + if ALIs.Table (A1).SSO_Default = ' ' then + Write_Str (" "); + Write_Name (ALIs.Table (A1).Sfile); + Write_Eol; + end if; + end loop; + end Check_Consistent_SSO_Default; + --------------------------------------------------- -- Check_Consistent_Zero_Cost_Exception_Handling -- --------------------------------------------------- diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 926190b823d..35a88befa32 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -564,13 +564,13 @@ package body Einfo is -- Stores_Attribute_Old_Prefix Flag270 -- (Has_Protected) Flag271 + -- (SSO_Set_Low_By_Default) Flag272 + -- (SSO_Set_Low_By_Default) Flag273 -- (unused) Flag1 -- (unused) Flag2 -- (unused) Flag3 - -- (unused) Flag272 - -- (unused) Flag273 -- (unused) Flag274 -- (unused) Flag275 -- (unused) Flag276 @@ -2972,6 +2972,18 @@ package body Einfo is return Node19 (Id); end Spec_Entity; + function SSO_Set_High_By_Default (Id : E) return B is + begin + pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id)); + return Flag273 (Base_Type (Id)); + end SSO_Set_High_By_Default; + + function SSO_Set_Low_By_Default (Id : E) return B is + begin + pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id)); + return Flag272 (Base_Type (Id)); + end SSO_Set_Low_By_Default; + function Static_Discrete_Predicate (Id : E) return S is begin pragma Assert (Is_Discrete_Type (Id)); @@ -5768,6 +5780,22 @@ package body Einfo is Set_Node19 (Id, V); end Set_Spec_Entity; + procedure Set_SSO_Set_High_By_Default (Id : E; V : B := True) is + begin + pragma Assert + (Is_Base_Type (Id) + and then (Is_Record_Type (Id) or else Is_Array_Type (Id))); + Set_Flag273 (Id, V); + end Set_SSO_Set_High_By_Default; + + procedure Set_SSO_Set_Low_By_Default (Id : E; V : B := True) is + begin + pragma Assert + (Is_Base_Type (Id) + and then (Is_Record_Type (Id) or else Is_Array_Type (Id))); + Set_Flag272 (Id, V); + end Set_SSO_Set_Low_By_Default; + procedure Set_Static_Discrete_Predicate (Id : E; V : S) is begin pragma Assert (Is_Discrete_Type (Id) and then Has_Predicates (Id)); @@ -8448,6 +8476,8 @@ package body Einfo is W ("Size_Known_At_Compile_Time", Flag92 (Id)); W ("SPARK_Aux_Pragma_Inherited", Flag266 (Id)); W ("SPARK_Pragma_Inherited", Flag265 (Id)); + W ("SSO_Set_High_By_Default", Flag273 (Id)); + W ("SSO_Set_Low_By_Default", Flag272 (Id)); W ("Static_Elaboration_Desired", Flag77 (Id)); W ("Stores_Attribute_Old_Prefix", Flag270 (Id)); W ("Strict_Alignment", Flag145 (Id)); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 41f134cd03d..753a0306048 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -3897,6 +3897,16 @@ package Einfo is -- case where there is a separate spec, where this field references -- the corresponding parameter entities in the spec. +-- SSO_Set_High_By_Default (Flag273) [base type only] +-- Defined for record and array types. Set in the base type if a pragma +-- Default_Scalar_Storage_Order (High_Order_First) was active at the time +-- the record or array was declared and therefore applies to it. + +-- SSO_Set_Low_By_Default (Flag272) [base type only] +-- Defined for record and array types. Set in the base type if a pragma +-- Default_Scalar_Storage_Order (High_Order_First) was active at the time +-- the record or array was declared and therefore applies to it. + -- Static_Discrete_Predicate (List25) -- Defined in discrete types/subtypes with static predicates (with the -- two flags Has_Predicates and Has_Static_Predicate set). Set if the @@ -5367,6 +5377,8 @@ package Einfo is -- Has_Pragma_Pack (Flag121) (impl base type only) -- Is_Constrained (Flag12) -- Reverse_Storage_Order (Flag93) (base type only) + -- SSO_Set_High_By_Default (Flag273) (base type only) + -- SSO_Set_Low_By_Default (Flag272) (base type only) -- Next_Index (synth) -- Number_Dimensions (synth) -- (plus type attributes) @@ -5392,6 +5404,8 @@ package Einfo is -- First_Entity (Node17) -- Equivalent_Type (Node18) (always Empty for type) -- Last_Entity (Node20) + -- SSO_Set_High_By_Default (Flag273) (base type only) + -- SSO_Set_Low_By_Default (Flag272) (base type only) -- First_Component (synth) -- First_Component_Or_Discriminant (synth) -- (plus type attributes) @@ -6023,6 +6037,8 @@ package Einfo is -- OK_To_Reorder_Components (Flag239) (base type only) -- Reverse_Bit_Order (Flag164) (base type only) -- Reverse_Storage_Order (Flag93) (base type only) + -- SSO_Set_High_By_Default (Flag273) (base type only) + -- SSO_Set_Low_By_Default (Flag272) (base type only) -- First_Component (synth) -- First_Component_Or_Discriminant (synth) -- (plus type attributes) @@ -6049,6 +6065,8 @@ package Einfo is -- OK_To_Reorder_Components (Flag239) (base type only) -- Reverse_Bit_Order (Flag164) (base type only) -- Reverse_Storage_Order (Flag93) (base type only) + -- SSO_Set_High_By_Default (Flag273) (base type only) + -- SSO_Set_Low_By_Default (Flag272) (base type only) -- First_Component (synth) -- First_Component_Or_Discriminant (synth) -- (plus type attributes) @@ -6073,6 +6091,8 @@ package Einfo is -- Component_Type (Node20) (base type only) -- Static_Real_Or_String_Predicate (Node25) -- Is_Constrained (Flag12) + -- SSO_Set_High_By_Default (Flag273) (base type only) + -- SSO_Set_Low_By_Default (Flag272) (base type only) -- Next_Index (synth) -- Number_Dimensions (synth) -- (plus type attributes) @@ -6812,6 +6832,8 @@ package Einfo is function SPARK_Pragma (Id : E) return N; function SPARK_Pragma_Inherited (Id : E) return B; function Spec_Entity (Id : E) return E; + function SSO_Set_High_By_Default (Id : E) return B; + function SSO_Set_Low_By_Default (Id : E) return B; function Static_Elaboration_Desired (Id : E) return B; function Static_Initialization (Id : E) return N; function Static_Discrete_Predicate (Id : E) return S; @@ -7447,6 +7469,8 @@ package Einfo is procedure Set_SPARK_Pragma (Id : E; V : N); procedure Set_SPARK_Pragma_Inherited (Id : E; V : B := True); procedure Set_Spec_Entity (Id : E; V : E); + procedure Set_SSO_Set_High_By_Default (Id : E; V : B := True); + procedure Set_SSO_Set_Low_By_Default (Id : E; V : B := True); procedure Set_Static_Elaboration_Desired (Id : E; V : B); procedure Set_Static_Initialization (Id : E; V : N); procedure Set_Static_Discrete_Predicate (Id : E; V : S); @@ -8232,6 +8256,8 @@ package Einfo is pragma Inline (SPARK_Pragma); pragma Inline (SPARK_Pragma_Inherited); pragma Inline (Spec_Entity); + pragma Inline (SSO_Set_High_By_Default); + pragma Inline (SSO_Set_Low_By_Default); pragma Inline (Static_Elaboration_Desired); pragma Inline (Static_Initialization); pragma Inline (Static_Discrete_Predicate); @@ -8666,6 +8692,8 @@ package Einfo is pragma Inline (Set_SPARK_Pragma); pragma Inline (Set_SPARK_Pragma_Inherited); pragma Inline (Set_Spec_Entity); + pragma Inline (Set_SSO_Set_High_By_Default); + pragma Inline (Set_SSO_Set_Low_By_Default); pragma Inline (Set_Static_Elaboration_Desired); pragma Inline (Set_Static_Initialization); pragma Inline (Set_Static_Discrete_Predicate); diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 9aee0a128a9..046af103674 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -180,6 +180,14 @@ package body Freeze is -- the flag if Debug_Info_Off is set. This procedure also ensures that -- subsidiary entities have the flag set as required. + procedure Set_SSO_From_Default (T : Entity_Id); + -- T is a record or array type that is being frozen. If it is a base type, + -- and if SSO_Set_Low/High_By_Default is set, then Reverse_Storage order + -- will be set appropriately. Note that an explicit occurrence of aspect + -- Scalar_Storage_Order or an explicit setting of this aspect with an + -- attribute definition clause occurs, then these two flags are reset in + -- any case, so call will have no effect. + procedure Undelay_Type (T : Entity_Id); -- T is a type of a component that we know to be an Itype. We don't want -- this to have a Freeze_Node, so ensure it doesn't. Do the same for any @@ -2074,7 +2082,11 @@ package body Freeze is -- Processing that is done only for base types - if Ekind (Arr) = E_Array_Type then + if Ekind (Arr) = E_Array_Type then -- what about E_String_Type ??? + + -- Deal with default setting of reverse storage order + + Set_SSO_From_Default (Arr); -- Propagate flags for component type @@ -3091,6 +3103,12 @@ package body Freeze is end loop; end; + -- Deal with default setting of reverse storage order + + Set_SSO_From_Default (Rec); + + -- Now deal with reverse storage order/bit order issues + if Present (SSO_ADC) then -- Check compatibility of Scalar_Storage_Order with Bit_Order, if @@ -4692,12 +4710,11 @@ package body Freeze is then Freeze_Record_Type (E); - -- For a concurrent type, freeze corresponding record type. This - -- does not correspond to any specific rule in the RM, but the - -- record type is essentially part of the concurrent type. - -- Freeze as well all local entities. This includes record types - -- created for entry parameter blocks, and whatever local entities - -- may appear in the private part. + -- For a concurrent type, freeze corresponding record type. This does + -- not correspond to any specific rule in the RM, but the record type + -- is essentially part of the concurrent type. Also freeze all local + -- entities. This includes record types created for entry parameter + -- blocks and whatever local entities may appear in the private part. elsif Is_Concurrent_Type (E) then if Present (Corresponding_Record_Type (E)) then @@ -7174,6 +7191,29 @@ package body Freeze is end if; end Set_Component_Alignment_If_Not_Set; + -------------------------- + -- Set_SSO_From_Default -- + -------------------------- + + procedure Set_SSO_From_Default (T : Entity_Id) is + begin + if (Is_Record_Type (T) or else Is_Array_Type (T)) + and then Is_Base_Type (T) + then + if (Bytes_Big_Endian and then SSO_Set_Low_By_Default (T)) + or else + ((not Bytes_Big_Endian) and then SSO_Set_High_By_Default (T)) + then + -- If flags cause reverse storage order, then set the result. Note + -- that we would have ignored the pragma setting the non default + -- storage order in any case, hence the assertion at this point. + + pragma Assert (Support_Nondefault_SSO_On_Target); + Set_Reverse_Storage_Order (T); + end if; + end if; + end Set_SSO_From_Default; + ------------------ -- Undelay_Type -- ------------------ diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index eb762b69898..3319bd7b487 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -140,6 +140,7 @@ Implementation Defined Pragmas * Pragma CPU:: * Pragma Debug:: * Pragma Debug_Policy:: +* Pragma Default_Scalar_Storage_Order:: * Pragma Default_Storage_Pool:: * Pragma Depends:: * Pragma Detect_Blocking:: @@ -990,6 +991,7 @@ consideration, the use of these pragmas should be minimized. * Pragma CPU:: * Pragma Debug:: * Pragma Debug_Policy:: +* Pragma Default_Scalar_Storage_Order:: * Pragma Default_Storage_Pool:: * Pragma Depends:: * Pragma Detect_Blocking:: @@ -2507,8 +2509,79 @@ This pragma is equivalent to a corresponding @code{Check_Policy} pragma with a first argument of @code{Debug}. It is retained for historical compatibility reasons. +@node Pragma Default_Scalar_Storage_Order +@unnumberedsec Pragma Default_Scalar_Storage_Order +@cindex Default_Scalar_Storage_Order +@cindex Scalar_Storage_Order +@findex Default_Scalar_Storage_Order +@noindent +Syntax: + +@smallexample @c ada +pragma Default_Scalar_Storage_Order (High_Order_First | Low_Order_First); +@end smallexample + +@noindent +Normally if no explicit @code{Scalar_Storage_Order} is given for a record +type or array type, then the scalar storage order defaults to the ordinary +default for the target. But this default may be overridden using this pragma. +The pragma may appear as a configuration pragma, or locally within a package +spec or declarative part. In the latter case, it applies to all subsequent +types declared within that package spec or declarative part. + +If this pragma is used as a configuration pragma which appears within a +configuration pragma file (as opposed to appearing explicitly at the start +of a single unit), then the binder will require that all units in a partition +be compiled in a similar manner, including all units in the run-time that +are included in the partition. + +The following example shows the use of this pragma: + +@smallexample @c ada +pragma Default_Scalar_Storage_Order (High_Order_First); +with System; use System; +package DSSO1 is + type H1 is record + a : Integer; + end record; + + type L2 is record + a : Integer; + end record; + for L2'Scalar_Storage_Order use Low_Order_First; + + type L2a is new L2; + + package Inner is + type H3 is record + a : Integer; + end record; + + pragma Default_Scalar_Storage_Order (Low_Order_First); + + type L4 is record + a : Integer; + end record; + end Inner; + + type H4a is new Inner.L4; + + type H5 is record + a : Integer; + end record; +end DSSO1; +@end smallexample + +@noindent +In this example record types L.. have @code{Low_Order_First} scalar +storage order, and record types H.. have @code{High_Order_First}. +Note that in the case of @code{H4a}, the order is not inherited +from the parent type. Only an explicitly set @code{Scalar_Storage_Order} +gets inherited on type derivation. + @node Pragma Default_Storage_Pool @unnumberedsec Pragma Default_Storage_Pool +@cindex Default_Storage_Pool @findex Default_Storage_Pool @noindent Syntax: @@ -9306,7 +9379,9 @@ this attribute. @noindent For every array or record type @var{S}, the representation attribute @code{Scalar_Storage_Order} denotes the order in which storage elements -that make up scalar components are ordered within S: +that make up scalar components are ordered within S. The value given must +be a static expression of type System.Bit_Order. The following is an example +of the use of this feature: @smallexample @c ada -- Component type definitions @@ -9340,6 +9415,7 @@ that make up scalar components are ordered within S: -- the former is used. @end smallexample +@noindent Other properties are as for standard representation attribute @code{Bit_Order}, as defined by Ada RM 13.5.3(4). The default is @code{System.Default_Bit_Order}. @@ -9349,10 +9425,12 @@ this means that if a @code{Scalar_Storage_Order} attribute definition clause is not confirming, then the type's @code{Bit_Order} shall be specified explicitly and set to the same value. -For a record extension, the derived type shall have the same scalar storage -order as the parent type. +Derived types inherit an explicitly set scalar storage order from their parent +types. This may be overridden for the derived type by giving an explicit scalar +storage order for the derived type. For a record extension, the derived type +must have the same scalar storage order as the parent type. -If a component of @var{S} is of a record or array type, then that type shall +If a component of @var{S} is of a record or array type, then that type must also have a @code{Scalar_Storage_Order} attribute definition clause. A component of a record or array type that is a packed array, or that @@ -9392,6 +9470,11 @@ are relaxed. Instead, the following rules apply: @end itemize +If no scalar storage order is specified for a type (either directly, or by +inheritance in the case of a derived type), then the default is normally +the native ordering of the target, but this default can be overridden using +pragma @code{Default_Scalar_Storage_Order}. + @node Attribute Simple_Storage_Pool @unnumberedsec Attribute Simple_Storage_Pool @cindex Storage pool, simple diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 06cd956ab79..5ca7b4b5bfb 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -1159,6 +1159,11 @@ package body Lib.Writ is Write_Info_Str (" NS"); end if; + if Default_SSO_Config /= ' ' then + Write_Info_Str (" O"); + Write_Info_Char (Default_SSO_Config); + end if; + if Sec_Stack_Used then Write_Info_Str (" SS"); end if; diff --git a/gcc/ada/lib-writ.ads b/gcc/ada/lib-writ.ads index aee3f8f3e41..66f08dc987d 100644 --- a/gcc/ada/lib-writ.ads +++ b/gcc/ada/lib-writ.ads @@ -220,6 +220,12 @@ package Lib.Writ is -- NS Normalize_Scalars pragma in effect for all units in -- this file. + -- OH Pragma Default_Scalar_Storage_Order (High_Order_First) is + -- present in a configuration pragma file that applies. + + -- OL Pragma Default_Scalar_Storage_Order (Low_Order_First) is + -- present in a configuration pragma file that applies. + -- Qx A valid Queueing_Policy pragma applies to all the units -- in this file, where x is the first character (upper case) -- of the policy name (e.g. 'P' for Priority_Queueing). diff --git a/gcc/ada/opt.adb b/gcc/ada/opt.adb index 68944c7cc3c..115500dfaa0 100644 --- a/gcc/ada/opt.adb +++ b/gcc/ada/opt.adb @@ -52,6 +52,7 @@ package body Opt is Check_Float_Overflow_Config := Check_Float_Overflow; Check_Policy_List_Config := Check_Policy_List; Default_Pool_Config := Default_Pool; + Default_SSO_Config := Default_SSO; Dynamic_Elaboration_Checks_Config := Dynamic_Elaboration_Checks; Exception_Locations_Suppressed_Config := Exception_Locations_Suppressed; Extensions_Allowed_Config := Extensions_Allowed; @@ -90,6 +91,7 @@ package body Opt is Check_Float_Overflow := Save.Check_Float_Overflow; Check_Policy_List := Save.Check_Policy_List; Default_Pool := Save.Default_Pool; + Default_SSO := Save.Default_SSO; Dynamic_Elaboration_Checks := Save.Dynamic_Elaboration_Checks; Exception_Locations_Suppressed := Save.Exception_Locations_Suppressed; Extensions_Allowed := Save.Extensions_Allowed; @@ -130,6 +132,7 @@ package body Opt is Save.Check_Float_Overflow := Check_Float_Overflow; Save.Check_Policy_List := Check_Policy_List; Save.Default_Pool := Default_Pool; + Save.Default_SSO := Default_SSO; Save.Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks; Save.Exception_Locations_Suppressed := Exception_Locations_Suppressed; Save.Extensions_Allowed := Extensions_Allowed; @@ -190,6 +193,7 @@ package body Opt is Assertions_Enabled := Assertions_Enabled_Config; Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config; Check_Policy_List := Check_Policy_List_Config; + Default_SSO := Default_SSO_Config; SPARK_Mode := SPARK_Mode_Config; SPARK_Mode_Pragma := SPARK_Mode_Pragma_Config; else @@ -210,6 +214,7 @@ package body Opt is Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config; Check_Float_Overflow := Check_Float_Overflow_Config; Check_Policy_List := Check_Policy_List_Config; + Default_SSO := Default_SSO_Config; Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks_Config; Extensions_Allowed := Extensions_Allowed_Config; External_Name_Exp_Casing := External_Name_Exp_Casing_Config; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 4f882105364..ba28fe31e86 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -418,17 +418,26 @@ package Opt is -- to trigger the activation of the remote debugging interface. -- Is this still true ??? + Default_Exit_Status : Int := 0; + -- GNATBIND + -- Set the default exit status value. Set by the -Xnnn switch for the + -- binder. + Debug_Generated_Code : Boolean := False; -- GNAT -- Set True (-gnatD switch) to debug generated expanded code instead -- of the original source code. Causes debugging information to be -- written with respect to the generated code file that is written. - Default_Exit_Status : Int := 0; - -- GNATBIND - -- Set the default exit status value. Set by the -Xnnn switch for the - -- binder. - + Default_Pool : Node_Id := Empty; + -- GNAT + -- Used to record the storage pool name (or null literal) that is the + -- argument of an applicable pragma Default_Storage_Pool. + -- Empty: No pragma Default_Storage_Pool applies. + -- N_Null node: "pragma Default_Storage_Pool (null);" applies. + -- otherwise: "pragma Default_Storage_Pool (X);" applies, and + -- this points to the name X. + -- Push_Scope and Pop_Scope in Sem_Ch8 save and restore this value. Default_Stack_Size : Int := -1; -- GNATBIND -- Set to default primary stack size in units of bytes. Set by @@ -442,15 +451,11 @@ package Opt is -- default was set by the binder, and that the default should be the -- initial value of System.Secondary_Stack.Default_Secondary_Stack_Size. - Default_Pool : Node_Id := Empty; + Default_SSO : Character := ' '; -- GNAT - -- Used to record the storage pool name (or null literal) that is the - -- argument of an applicable pragma Default_Storage_Pool. - -- Empty: No pragma Default_Storage_Pool applies. - -- N_Null node: "pragma Default_Storage_Pool (null);" applies. - -- otherwise: "pragma Default_Storage_Pool (X);" applies, and - -- this points to the name X. - -- Push_Scope and Pop_Scope in Sem_Ch8 save and restore this value. + -- Set if a pragma Default_Scalar_Storage_Order has been given. The value + -- of ' ' indicates that no default has been set, otherwise the value is + -- either 'H' for High_Order_First or 'L' for Lower_Order_First. Detect_Blocking : Boolean := False; -- GNAT @@ -1809,7 +1814,8 @@ package Opt is -- These are settings that are used to establish the mode at the start of -- each unit. The values defined below can be affected either by command -- line switches, or by the use of appropriate configuration pragmas in a - -- configuration pragma file. + -- configuration pragma file (but NOT by a local use of a configuration + -- pragma in a single file). Ada_Version_Config : Ada_Version_Type; -- GNAT @@ -1863,6 +1869,12 @@ package Opt is -- Same as Default_Pool above, except this is only for Default_Storage_Pool -- pragmas that are configuration pragmas. + Default_SSO_Config : Character := ' '; + -- GNAT + -- Set if a pragma Default_Scalar_Storage_Order appears as a configuration + -- pragma. A value of ' ' means that no pragma was given, otherwise the + -- value is 'H' for High_Order_First or 'L' for Low_Order_First. + Dynamic_Elaboration_Checks_Config : Boolean := False; -- GNAT -- Set True for dynamic elaboration checking mode, as set by the -gnatE @@ -2116,6 +2128,7 @@ private Check_Float_Overflow : Boolean; Check_Policy_List : Node_Id; Default_Pool : Node_Id; + Default_SSO : Character; Dynamic_Elaboration_Checks : Boolean; Exception_Locations_Suppressed : Boolean; Extensions_Allowed : Boolean; diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index 5d1c1db6172..dbec602e985 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -1092,10 +1092,14 @@ package body Repinfo is -- Start of processing for List_Scalar_Storage_Order begin - if Has_Rep_Item (Ent, Name_Scalar_Storage_Order) then + -- List info if set explicitly or by use of Default_Scalar_Storage_Order - -- For a record type with explicitly specified scalar storage order, - -- also display explicit Bit_Order. + if Has_Rep_Item (Ent, Name_Scalar_Storage_Order) + or else SSO_Set_Low_By_Default (Ent) + or else SSO_Set_High_By_Default (Ent) + then + -- For a record type with specified scalar storage order, also + -- display explicit Bit_Order. if Is_Record_Type (Ent) then List_Attr ("Bit_Order"); diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads index 5a6ebcda8b5..681df14671a 100644 --- a/gcc/ada/sem.ads +++ b/gcc/ada/sem.ads @@ -486,6 +486,9 @@ package Sem is Save_SPARK_Mode_Pragma : Node_Id; -- Setting of SPARK_Mode_Pragma on entry to restore on exit + Save_Default_SSO : Character; + -- Setting of Default_SSO on entry to restore on exit + Save_Uneval_Old : Character; -- Setting of Uneval_Old on entry to restore on exit diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 73dc3c5ec1e..f6a4be12f83 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -932,6 +932,12 @@ package body Sem_Ch13 is and then Reverse_Storage_Order (P) then Set_Reverse_Storage_Order (Base_Type (E)); + + -- Clear default SSO indications, since the aspect + -- overrides the default. + + Set_SSO_Set_Low_By_Default (Base_Type (E), False); + Set_SSO_Set_High_By_Default (Base_Type (E), False); end if; -- Small @@ -3272,6 +3278,18 @@ package body Sem_Ch13 is Typ := Etype (F); + -- If the attribute specification comes from an aspect + -- specification for a class-wide stream, the parameter + -- must be a class-wide type of the entity to which the + -- aspect applies. + + if From_Aspect_Specification (N) + and then Class_Present (Parent (N)) + and then Is_Class_Wide_Type (Typ) + then + Typ := Etype (Typ); + end if; + else Typ := Etype (Subp); end if; @@ -4758,6 +4776,12 @@ package body Sem_Ch13 is & "not supported on target", Expr); end if; end if; + + -- Clear SSO default indications since explicit setting of the + -- order overrides the defaults. + + Set_SSO_Set_Low_By_Default (Base_Type (U_Ent), False); + Set_SSO_Set_High_By_Default (Base_Type (U_Ent), False); end if; end Scalar_Storage_Order; @@ -10311,6 +10335,12 @@ package body Sem_Ch13 is Set_Reverse_Storage_Order (Bas_Typ, Reverse_Storage_Order (Entity (Name (Get_Rep_Item (Typ, Name_Scalar_Storage_Order))))); + + -- Clear default SSO indications, since the inherited aspect + -- which was set explicitly overrides the default. + + Set_SSO_Set_Low_By_Default (Bas_Typ, False); + Set_SSO_Set_High_By_Default (Bas_Typ, False); end if; end if; end; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 9eb1618a099..a2aeaf96c4c 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -699,6 +699,11 @@ package body Sem_Ch3 is -- scalar range. Subt provides the parent subtype to be used to analyze, -- resolve, and check the given range. + procedure Set_Default_SSO (T : Entity_Id); + -- T is the entity for an array or record being declared. This procedure + -- sets the flags SSO_Set_Low_By_Default/SSO_Set_High_By_Default according + -- to the setting of Opt.Default_SSO. + procedure Signed_Integer_Type_Declaration (T : Entity_Id; Def : Node_Id); -- Create a new signed integer entity, and apply the constraint to obtain -- the required first named subtype of this type. @@ -846,8 +851,7 @@ package body Sem_Ch3 is Set_Ekind (Anon_Type, E_Anonymous_Access_Protected_Subprogram_Type); else - Set_Ekind - (Anon_Type, E_Anonymous_Access_Subprogram_Type); + Set_Ekind (Anon_Type, E_Anonymous_Access_Subprogram_Type); end if; Set_Can_Use_Internal_Rep @@ -4176,6 +4180,7 @@ package body Sem_Ch3 is Set_Scope (T, Current_Scope); Set_Ekind (T, E_Record_Type_With_Private); Init_Size_Align (T); + Set_Default_SSO (T); Set_Etype (T, Parent_Base); Set_Has_Task (T, Has_Task (Parent_Base)); @@ -5154,6 +5159,7 @@ package body Sem_Ch3 is Set_Etype (Implicit_Base, Implicit_Base); Set_Scope (Implicit_Base, Current_Scope); Set_Has_Delayed_Freeze (Implicit_Base); + Set_Default_SSO (Implicit_Base); -- The constrained array type is a subtype of the unconstrained one @@ -5201,6 +5207,7 @@ package body Sem_Ch3 is Is_Controlled (Element_Type)); Set_Finalize_Storage_Only (T, Finalize_Storage_Only (Element_Type)); + Set_Default_SSO (T); end if; -- Common attributes for both cases @@ -5680,8 +5687,8 @@ package body Sem_Ch3 is if Nkind (Indic) /= N_Subtype_Indication then Make_Implicit_Base; - Set_Ekind (Derived_Type, Ekind (Parent_Type)); - Set_Etype (Derived_Type, Implicit_Base); + Set_Ekind (Derived_Type, Ekind (Parent_Type)); + Set_Etype (Derived_Type, Implicit_Base); Copy_Array_Subtype_Attributes (Derived_Type, Parent_Type); else @@ -6582,6 +6589,7 @@ package body Sem_Ch3 is Set_Ekind (Full_Der, E_Record_Type); Set_Is_Underlying_Record_View (Full_Der); + Set_Default_SSO (Full_Der); Analyze (Decl); @@ -7496,6 +7504,7 @@ package body Sem_Ch3 is if Private_Extension then Type_Def := N; Set_Ekind (Derived_Type, E_Record_Type_With_Private); + Set_Default_SSO (Derived_Type); else Type_Def := Type_Definition (N); @@ -7509,6 +7518,7 @@ package body Sem_Ch3 is if Present (Record_Extension_Part (Type_Def)) then Set_Ekind (Derived_Type, E_Record_Type); + Set_Default_SSO (Derived_Type); -- Create internal access types for components with anonymous -- access types. @@ -7819,7 +7829,6 @@ package body Sem_Ch3 is else declare GB : constant Node_Id := Enclosing_Generic_Body (Derived_Type); - begin if Present (GB) and then GB /= Enclosing_Generic_Body (Parent_Base) @@ -8472,6 +8481,15 @@ package body Sem_Ch3 is Set_Convention (Derived_Type, Convention (Parent_Base)); + -- Set SSO default for record or array type + + if (Is_Array_Type (Derived_Type) + or else Is_Record_Type (Derived_Type)) + and then Is_Base_Type (Derived_Type) + then + Set_Default_SSO (Derived_Type); + end if; + -- Propagate invariant information. The new type has invariants if -- they are inherited from the parent type, and these invariants can -- be further inherited, so both flags are set. @@ -17087,6 +17105,7 @@ package body Sem_Ch3 is Set_Is_Abstract_Type (CW_Type, False); Set_Is_Constrained (CW_Type, False); Set_Is_First_Subtype (CW_Type, Is_First_Subtype (T)); + Set_Default_SSO (CW_Type); if Ekind (T) = E_Class_Wide_Subtype then Set_Etype (CW_Type, Etype (Base_Type (T))); @@ -20056,6 +20075,7 @@ package body Sem_Ch3 is Init_Size_Align (T); Set_Interfaces (T, No_Elist); Set_Stored_Constraint (T, No_Elist); + Set_Default_SSO (T); -- Normal case @@ -20421,6 +20441,24 @@ package body Sem_Ch3 is end if; end Set_Completion_Referenced; + --------------------- + -- Set_Default_SSO -- + --------------------- + + procedure Set_Default_SSO (T : Entity_Id) is + begin + case Opt.Default_SSO is + when ' ' => + null; + when 'L' => + Set_SSO_Set_Low_By_Default (T, True); + when 'H' => + Set_SSO_Set_High_By_Default (T, True); + when others => + raise Program_Error; + end case; + end Set_Default_SSO; + --------------------- -- Set_Fixed_Range -- --------------------- diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index c29d5c549c1..1f3a4c50dd7 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -12017,6 +12017,15 @@ package body Sem_Ch6 is Error_Msg_N ("default values not allowed for operator parameters", Parent (F)); + + -- For function instantiations that are operators, we must check + -- separately that the corresponding generic only has in-parameters. + -- For subprogram declarations this is done in Set_Formal_Mode. + -- Such an error could not arise in earlier versions of the language. + + elsif Ekind (F) /= E_In_Parameter then + Error_Msg_N + ("operators can only have IN parameters", F); end if; Next_Formal (F); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index f2f03f0e393..8643caee853 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -7533,6 +7533,7 @@ package body Sem_Ch8 is Default_Pool := SST.Save_Default_Storage_Pool; SPARK_Mode := SST.Save_SPARK_Mode; SPARK_Mode_Pragma := SST.Save_SPARK_Mode_Pragma; + Default_SSO := SST.Save_Default_SSO; Uneval_Old := SST.Save_Uneval_Old; if Debug_Flag_W then @@ -7606,6 +7607,7 @@ package body Sem_Ch8 is SST.Save_Default_Storage_Pool := Default_Pool; SST.Save_SPARK_Mode := SPARK_Mode; SST.Save_SPARK_Mode_Pragma := SPARK_Mode_Pragma; + SST.Save_Default_SSO := Default_SSO; SST.Save_Uneval_Old := Uneval_Old; if Scope_Stack.Last > Scope_Stack.First then diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 136a664ffe9..66b5640bf1f 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -13176,7 +13176,10 @@ package body Sem_Prag is -- pragma Default_Scalar_Storage_Order -- (High_Order_First | Low_Order_First); - when Pragma_Default_Scalar_Storage_Order => + when Pragma_Default_Scalar_Storage_Order => DSSO : declare + Default : Character; + + begin GNAT_Pragma; Check_Arg_Count (1); @@ -13189,7 +13192,27 @@ package body Sem_Prag is Check_No_Identifiers; Check_Arg_Is_One_Of - (Arg1, Name_Low_Order_First, Name_High_Order_First); + (Arg1, Name_High_Order_First, Name_Low_Order_First); + Get_Name_String (Chars (Get_Pragma_Arg (Arg1))); + Default := Fold_Upper (Name_Buffer (1)); + + if not Support_Nondefault_SSO_On_Target + and then (Ttypes.Bytes_Big_Endian /= (Default = 'H')) + then + if Warn_On_Unrecognized_Pragma then + Error_Msg_N + ("non-default Scalar_Storage_Order not supported " + & "on target?g?", N); + Error_Msg_N + ("\pragma Default_Scalar_Storage_Order ignored?g?", N); + end if; + + -- Here set the specified default + + else + Opt.Default_SSO := Default; + end if; + end DSSO; -------------------------- -- Default_Storage_Pool --