mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 16:51:13 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2014-08-04  Robert Dewar  <dewar@adacore.com>

	* prj-proc.adb, prj-part.adb, prj-strt.adb, prj.adb, prj.ads,
	prj-attr.adb, prj-attr.ads: Minor reformatting.

2014-08-04  Yannick Moy  <moy@adacore.com>

	* expander.adb (Expand): Always perform special
	expansion in GNATprove mode, even when doing pre-analysis.

2014-08-04  Thomas Quinot  <quinot@adacore.com>

	* repinfo.adb (List_Scalar_Storage_Order): List bit order if
	not default. Also list bit order if SSO is specified. Do not
	assume that bit order is always equal to scalar storage order.

2014-08-04  Thomas Quinot  <quinot@adacore.com>

	* freeze.adb (Set_SSO_From_Default): Do not set scalar storage
	order to reverse SSO for a type that has an explicit native
	Bit_Order.

2014-08-04  Doug Rupp  <rupp@adacore.com>

	* cal.c: Macro check for VxWorks7.
	* init.c (getpid): Likewise.
	* mkdir.c (__gnat_mkdir): Likewise.
	* sysdep.c (__gnat_is_file_not_found_error): Likewise.

2014-08-04  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch3.adb (Expand_N_Object_Declaration): Inhibit generation
	of an invariant check in the case where No_Initialization is set,
	since the object is uninitialized.

2014-08-04  Thomas Quinot  <quinot@adacore.com>

	* snames.ads-tmpl (Default_Scalar_Storage_Order): Now an attribute
	name, in addition to a pragma name.
	* snames.adb-tmpl (Get_Pragma_Id, Is_Configuration_Pragma_Name,
	Is_Pragma_Name): Adjust accordingly.
	* sem_attr.ads, sem_attr.adb, exp_attr.adb
	(Attribute_Default_Scalar_Storage_Order): Add handling of new
	attribute.
	* gnat_rm.texi: Document the above.

From-SVN: r213549
This commit is contained in:
Arnaud Charlet 2014-08-04 11:55:01 +02:00
parent af6478c843
commit 7ed571892e
22 changed files with 570 additions and 450 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
gcc/ada/ChangeLog
View File

@ -1,3 +1,49 @@
2014-08-04 Robert Dewar <dewar@adacore.com>
* prj-proc.adb, prj-part.adb, prj-strt.adb, prj.adb, prj.ads,
prj-attr.adb, prj-attr.ads: Minor reformatting.
2014-08-04 Yannick Moy <moy@adacore.com>
* expander.adb (Expand): Always perform special
expansion in GNATprove mode, even when doing pre-analysis.
2014-08-04 Thomas Quinot <quinot@adacore.com>
* repinfo.adb (List_Scalar_Storage_Order): List bit order if
not default. Also list bit order if SSO is specified. Do not
assume that bit order is always equal to scalar storage order.
2014-08-04 Thomas Quinot <quinot@adacore.com>
* freeze.adb (Set_SSO_From_Default): Do not set scalar storage
order to reverse SSO for a type that has an explicit native
Bit_Order.
2014-08-04 Doug Rupp <rupp@adacore.com>
* cal.c: Macro check for VxWorks7.
* init.c (getpid): Likewise.
* mkdir.c (__gnat_mkdir): Likewise.
* sysdep.c (__gnat_is_file_not_found_error): Likewise.
2014-08-04 Gary Dismukes <dismukes@adacore.com>
* exp_ch3.adb (Expand_N_Object_Declaration): Inhibit generation
of an invariant check in the case where No_Initialization is set,
since the object is uninitialized.
2014-08-04 Thomas Quinot <quinot@adacore.com>
* snames.ads-tmpl (Default_Scalar_Storage_Order): Now an attribute
name, in addition to a pragma name.
* snames.adb-tmpl (Get_Pragma_Id, Is_Configuration_Pragma_Name,
Is_Pragma_Name): Adjust accordingly.
* sem_attr.ads, sem_attr.adb, exp_attr.adb
(Attribute_Default_Scalar_Storage_Order): Add handling of new
attribute.
* gnat_rm.texi: Document the above.
2014-08-04 Arnaud Charlet <charlet@adacore.com>
* exp_util.adb (Check_Float_Op_Overflow): No-op in codepeer

4
gcc/ada/cal.c
View File

@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 1992-2009, Free Software Foundation, Inc. *
* Copyright (C) 1992-2014, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
@ -55,7 +55,7 @@ __gnat_duration_to_timeval (long sec, long usec, void *t)
#ifdef __RTP__
#include <time.h>
#include <version.h>
#if (_WRS_VXWORKS_MINOR != 0)
#if (_WRS_VXWORKS_MAJOR == 7) || (_WRS_VXWORKS_MINOR != 0)
#include <sys/time.h>
#endif
#else

1
gcc/ada/exp_attr.adb
View File

@ -7080,6 +7080,7 @@ package body Exp_Attr is
Attribute_Class |
Attribute_Compiler_Version |
Attribute_Default_Bit_Order |
Attribute_Default_Scalar_Storage_Order |
Attribute_Delta |
Attribute_Denorm |
Attribute_Digits |

5
gcc/ada/exp_ch3.adb
View File

@ -5412,11 +5412,14 @@ package body Exp_Ch3 is
-- is raised, then the object will go out of scope. In the case where
-- an array object is initialized with an aggregate, the expression
-- is removed. Check flag Has_Init_Expression to avoid generating a
-- junk invariant check.
-- junk invariant check and flag No_Initialization to avoid checking
-- an uninitialized object such as a compiler temporary used for an
-- aggregate.
if Has_Invariants (Base_Typ)
and then Present (Invariant_Procedure (Base_Typ))
and then not Has_Init_Expression (N)
and then not No_Initialization (N)
then
Insert_After (N,
Make_Invariant_Call (New_Occurrence_Of (Def_Id, Loc)));

479
gcc/ada/expander.adb
View File

@ -83,6 +83,25 @@ package body Expander is
and then (Full_Analysis or else not Expander_Active)
and then not (Inside_A_Generic and then Expander_Active));
-- The GNATprove_Mode flag indicates that a light expansion for formal
-- verification should be used. This expansion is never done inside
-- generics, because otherwise, this breaks the name resolution
-- mechanism for generic instances.
if GNATprove_Mode then
if not Inside_A_Generic then
Expand_SPARK (N);
end if;
Set_Analyzed (N, Full_Analysis);
-- Regular expansion is normally followed by special handling for
-- transient scopes for unconstrained results, etc. but this is not
-- needed, and in general cannot be done correctly, in this mode, so
-- we are all done.
return;
-- There are three reasons for the Expander_Active flag to be false
-- The first is when are not generating code. In this mode the
@ -91,11 +110,6 @@ package body Expander is
-- which case Full_Analysis = False. See the spec of Sem for more info
-- on this.
-- Additionally, the GNATprove_Mode flag indicates that a light
-- expansion for formal verification should be used. This expansion is
-- never done inside generics, because otherwise, this breaks the name
-- resolution mechanism for generic instances
-- The second reason for the Expander_Active flag to be False is that
-- we are performing a pre-analysis. During pre-analysis all expansion
-- activity is turned off to make sure nodes are semantically decorated
@ -112,9 +126,7 @@ package body Expander is
-- given that the expansion actions that would normally process it will
-- not take place. This prevents cascaded errors due to stack mismatch.
if not Expander_Active
and (Inside_A_Generic or not Full_Analysis or not GNATprove_Mode)
then
elsif not Expander_Active then
Set_Analyzed (N, Full_Analysis);
if Serious_Errors_Detected > 0 and then Scope_Is_Transient then
@ -126,352 +138,333 @@ package body Expander is
return;
else
Debug_A_Entry ("expanding ", N);
begin
-- In GNATprove mode we only need a very limited subset of
-- the usual expansions. This limited subset is implemented
-- in Expand_SPARK.
Debug_A_Entry ("expanding ", N);
if GNATprove_Mode then
Expand_SPARK (N);
Set_Analyzed (N);
-- Processing depends on node kind. For full details on the
-- expansion activity required in each case, see bodies of
-- corresponding expand routines.
-- Regular expansion is normally followed by special handling
-- for transient scopes for unconstrained results, etc. but
-- this is not needed, and in general cannot be done correctly,
-- in this mode, so we are all done.
case Nkind (N) is
return;
when N_Abort_Statement =>
Expand_N_Abort_Statement (N);
-- Here for normal non-SPARK mode
when N_Accept_Statement =>
Expand_N_Accept_Statement (N);
else
-- Processing depends on node kind. For full details on the
-- expansion activity required in each case, see bodies of
-- corresponding expand routines.
when N_Aggregate =>
Expand_N_Aggregate (N);
case Nkind (N) is
when N_Allocator =>
Expand_N_Allocator (N);
when N_Abort_Statement =>
Expand_N_Abort_Statement (N);
when N_And_Then =>
Expand_N_And_Then (N);
when N_Accept_Statement =>
Expand_N_Accept_Statement (N);
when N_Assignment_Statement =>
Expand_N_Assignment_Statement (N);
when N_Aggregate =>
Expand_N_Aggregate (N);
when N_Asynchronous_Select =>
Expand_N_Asynchronous_Select (N);
when N_Allocator =>
Expand_N_Allocator (N);
when N_Attribute_Definition_Clause =>
Expand_N_Attribute_Definition_Clause (N);
when N_And_Then =>
Expand_N_And_Then (N);
when N_Attribute_Reference =>
Expand_N_Attribute_Reference (N);
when N_Assignment_Statement =>
Expand_N_Assignment_Statement (N);
when N_Block_Statement =>
Expand_N_Block_Statement (N);
when N_Asynchronous_Select =>
Expand_N_Asynchronous_Select (N);
when N_Case_Expression =>
Expand_N_Case_Expression (N);
when N_Attribute_Definition_Clause =>
Expand_N_Attribute_Definition_Clause (N);
when N_Case_Statement =>
Expand_N_Case_Statement (N);
when N_Attribute_Reference =>
Expand_N_Attribute_Reference (N);
when N_Conditional_Entry_Call =>
Expand_N_Conditional_Entry_Call (N);
when N_Block_Statement =>
Expand_N_Block_Statement (N);
when N_Delay_Relative_Statement =>
Expand_N_Delay_Relative_Statement (N);
when N_Case_Expression =>
Expand_N_Case_Expression (N);
when N_Delay_Until_Statement =>
Expand_N_Delay_Until_Statement (N);
when N_Case_Statement =>
Expand_N_Case_Statement (N);
when N_Entry_Body =>
Expand_N_Entry_Body (N);
when N_Conditional_Entry_Call =>
Expand_N_Conditional_Entry_Call (N);
when N_Entry_Call_Statement =>
Expand_N_Entry_Call_Statement (N);
when N_Delay_Relative_Statement =>
Expand_N_Delay_Relative_Statement (N);
when N_Entry_Declaration =>
Expand_N_Entry_Declaration (N);
when N_Delay_Until_Statement =>
Expand_N_Delay_Until_Statement (N);
when N_Exception_Declaration =>
Expand_N_Exception_Declaration (N);
when N_Entry_Body =>
Expand_N_Entry_Body (N);
when N_Exception_Renaming_Declaration =>
Expand_N_Exception_Renaming_Declaration (N);
when N_Entry_Call_Statement =>
Expand_N_Entry_Call_Statement (N);
when N_Exit_Statement =>
Expand_N_Exit_Statement (N);
when N_Entry_Declaration =>
Expand_N_Entry_Declaration (N);
when N_Expanded_Name =>
Expand_N_Expanded_Name (N);
when N_Exception_Declaration =>
Expand_N_Exception_Declaration (N);
when N_Explicit_Dereference =>
Expand_N_Explicit_Dereference (N);
when N_Exception_Renaming_Declaration =>
Expand_N_Exception_Renaming_Declaration (N);
when N_Expression_With_Actions =>
Expand_N_Expression_With_Actions (N);
when N_Exit_Statement =>
Expand_N_Exit_Statement (N);
when N_Extended_Return_Statement =>
Expand_N_Extended_Return_Statement (N);
when N_Expanded_Name =>
Expand_N_Expanded_Name (N);
when N_Extension_Aggregate =>
Expand_N_Extension_Aggregate (N);
when N_Explicit_Dereference =>
Expand_N_Explicit_Dereference (N);
when N_Free_Statement =>
Expand_N_Free_Statement (N);
when N_Expression_With_Actions =>
Expand_N_Expression_With_Actions (N);
when N_Freeze_Entity =>
Expand_N_Freeze_Entity (N);
when N_Extended_Return_Statement =>
Expand_N_Extended_Return_Statement (N);
when N_Full_Type_Declaration =>
Expand_N_Full_Type_Declaration (N);
when N_Extension_Aggregate =>
Expand_N_Extension_Aggregate (N);
when N_Function_Call =>
Expand_N_Function_Call (N);
when N_Free_Statement =>
Expand_N_Free_Statement (N);
when N_Generic_Instantiation =>
Expand_N_Generic_Instantiation (N);
when N_Freeze_Entity =>
Expand_N_Freeze_Entity (N);
when N_Goto_Statement =>
Expand_N_Goto_Statement (N);
when N_Full_Type_Declaration =>
Expand_N_Full_Type_Declaration (N);
when N_Handled_Sequence_Of_Statements =>
Expand_N_Handled_Sequence_Of_Statements (N);
when N_Function_Call =>
Expand_N_Function_Call (N);
when N_Identifier =>
Expand_N_Identifier (N);
when N_Generic_Instantiation =>
Expand_N_Generic_Instantiation (N);
when N_If_Expression =>
Expand_N_If_Expression (N);
when N_Goto_Statement =>
Expand_N_Goto_Statement (N);
when N_Indexed_Component =>
Expand_N_Indexed_Component (N);
when N_Handled_Sequence_Of_Statements =>
Expand_N_Handled_Sequence_Of_Statements (N);
when N_If_Statement =>
Expand_N_If_Statement (N);
when N_Identifier =>
Expand_N_Identifier (N);
when N_In =>
Expand_N_In (N);
when N_If_Expression =>
Expand_N_If_Expression (N);
when N_Loop_Statement =>
Expand_N_Loop_Statement (N);
when N_Indexed_Component =>
Expand_N_Indexed_Component (N);
when N_Not_In =>
Expand_N_Not_In (N);
when N_If_Statement =>
Expand_N_If_Statement (N);
when N_Null =>
Expand_N_Null (N);
when N_In =>
Expand_N_In (N);
when N_Object_Declaration =>
Expand_N_Object_Declaration (N);
when N_Loop_Statement =>
Expand_N_Loop_Statement (N);
when N_Object_Renaming_Declaration =>
Expand_N_Object_Renaming_Declaration (N);
when N_Not_In =>
Expand_N_Not_In (N);
when N_Op_Add =>
Expand_N_Op_Add (N);
when N_Null =>
Expand_N_Null (N);
when N_Op_Abs =>
Expand_N_Op_Abs (N);
when N_Object_Declaration =>
Expand_N_Object_Declaration (N);
when N_Op_And =>
Expand_N_Op_And (N);
when N_Object_Renaming_Declaration =>
Expand_N_Object_Renaming_Declaration (N);
when N_Op_Concat =>
Expand_N_Op_Concat (N);
when N_Op_Add =>
Expand_N_Op_Add (N);
when N_Op_Divide =>
Expand_N_Op_Divide (N);
when N_Op_Abs =>
Expand_N_Op_Abs (N);
when N_Op_Eq =>
Expand_N_Op_Eq (N);
when N_Op_And =>
Expand_N_Op_And (N);
when N_Op_Expon =>
Expand_N_Op_Expon (N);
when N_Op_Concat =>
Expand_N_Op_Concat (N);
when N_Op_Ge =>
Expand_N_Op_Ge (N);
when N_Op_Divide =>
Expand_N_Op_Divide (N);
when N_Op_Gt =>
Expand_N_Op_Gt (N);
when N_Op_Eq =>
Expand_N_Op_Eq (N);
when N_Op_Le =>
Expand_N_Op_Le (N);
when N_Op_Expon =>
Expand_N_Op_Expon (N);
when N_Op_Lt =>
Expand_N_Op_Lt (N);
when N_Op_Ge =>
Expand_N_Op_Ge (N);
when N_Op_Minus =>
Expand_N_Op_Minus (N);
when N_Op_Gt =>
Expand_N_Op_Gt (N);
when N_Op_Mod =>
Expand_N_Op_Mod (N);
when N_Op_Le =>
Expand_N_Op_Le (N);
when N_Op_Multiply =>
Expand_N_Op_Multiply (N);
when N_Op_Lt =>
Expand_N_Op_Lt (N);
when N_Op_Ne =>
Expand_N_Op_Ne (N);
when N_Op_Minus =>
Expand_N_Op_Minus (N);
when N_Op_Not =>
Expand_N_Op_Not (N);
when N_Op_Mod =>
Expand_N_Op_Mod (N);
when N_Op_Or =>
Expand_N_Op_Or (N);
when N_Op_Multiply =>
Expand_N_Op_Multiply (N);
when N_Op_Plus =>
Expand_N_Op_Plus (N);
when N_Op_Ne =>
Expand_N_Op_Ne (N);
when N_Op_Rem =>
Expand_N_Op_Rem (N);
when N_Op_Not =>
Expand_N_Op_Not (N);
when N_Op_Rotate_Left =>
Expand_N_Op_Rotate_Left (N);
when N_Op_Or =>
Expand_N_Op_Or (N);
when N_Op_Rotate_Right =>
Expand_N_Op_Rotate_Right (N);
when N_Op_Plus =>
Expand_N_Op_Plus (N);
when N_Op_Shift_Left =>
Expand_N_Op_Shift_Left (N);
when N_Op_Rem =>
Expand_N_Op_Rem (N);
when N_Op_Shift_Right =>
Expand_N_Op_Shift_Right (N);
when N_Op_Rotate_Left =>
Expand_N_Op_Rotate_Left (N);
when N_Op_Shift_Right_Arithmetic =>
Expand_N_Op_Shift_Right_Arithmetic (N);
when N_Op_Rotate_Right =>
Expand_N_Op_Rotate_Right (N);
when N_Op_Subtract =>
Expand_N_Op_Subtract (N);
when N_Op_Shift_Left =>
Expand_N_Op_Shift_Left (N);
when N_Op_Xor =>
Expand_N_Op_Xor (N);
when N_Op_Shift_Right =>
Expand_N_Op_Shift_Right (N);
when N_Or_Else =>
Expand_N_Or_Else (N);
when N_Op_Shift_Right_Arithmetic =>
Expand_N_Op_Shift_Right_Arithmetic (N);
when N_Package_Body =>
Expand_N_Package_Body (N);
when N_Op_Subtract =>
Expand_N_Op_Subtract (N);
when N_Package_Declaration =>
Expand_N_Package_Declaration (N);
when N_Op_Xor =>
Expand_N_Op_Xor (N);
when N_Package_Renaming_Declaration =>
Expand_N_Package_Renaming_Declaration (N);
when N_Or_Else =>
Expand_N_Or_Else (N);
when N_Subprogram_Renaming_Declaration =>
Expand_N_Subprogram_Renaming_Declaration (N);
when N_Package_Body =>
Expand_N_Package_Body (N);
when N_Pragma =>
Expand_N_Pragma (N);
when N_Package_Declaration =>
Expand_N_Package_Declaration (N);
when N_Procedure_Call_Statement =>
Expand_N_Procedure_Call_Statement (N);
when N_Package_Renaming_Declaration =>
Expand_N_Package_Renaming_Declaration (N);
when N_Protected_Type_Declaration =>
Expand_N_Protected_Type_Declaration (N);
when N_Subprogram_Renaming_Declaration =>
Expand_N_Subprogram_Renaming_Declaration (N);
when N_Protected_Body =>
Expand_N_Protected_Body (N);
when N_Pragma =>
Expand_N_Pragma (N);
when N_Qualified_Expression =>
Expand_N_Qualified_Expression (N);
when N_Procedure_Call_Statement =>
Expand_N_Procedure_Call_Statement (N);
when N_Quantified_Expression =>
Expand_N_Quantified_Expression (N);
when N_Protected_Type_Declaration =>
Expand_N_Protected_Type_Declaration (N);
when N_Raise_Statement =>
Expand_N_Raise_Statement (N);
when N_Protected_Body =>
Expand_N_Protected_Body (N);
when N_Raise_Constraint_Error =>
Expand_N_Raise_Constraint_Error (N);
when N_Qualified_Expression =>
Expand_N_Qualified_Expression (N);
when N_Raise_Expression =>
Expand_N_Raise_Expression (N);
when N_Quantified_Expression =>
Expand_N_Quantified_Expression (N);
when N_Raise_Program_Error =>
Expand_N_Raise_Program_Error (N);
when N_Raise_Statement =>
Expand_N_Raise_Statement (N);
when N_Raise_Storage_Error =>
Expand_N_Raise_Storage_Error (N);
when N_Raise_Constraint_Error =>
Expand_N_Raise_Constraint_Error (N);
when N_Real_Literal =>
Expand_N_Real_Literal (N);
when N_Raise_Expression =>
Expand_N_Raise_Expression (N);
when N_Record_Representation_Clause =>
Expand_N_Record_Representation_Clause (N);
when N_Raise_Program_Error =>
Expand_N_Raise_Program_Error (N);
when N_Requeue_Statement =>
Expand_N_Requeue_Statement (N);
when N_Raise_Storage_Error =>
Expand_N_Raise_Storage_Error (N);
when N_Simple_Return_Statement =>
Expand_N_Simple_Return_Statement (N);
when N_Real_Literal =>
Expand_N_Real_Literal (N);
when N_Selected_Component =>
Expand_N_Selected_Component (N);
when N_Record_Representation_Clause =>
Expand_N_Record_Representation_Clause (N);
when N_Selective_Accept =>
Expand_N_Selective_Accept (N);
when N_Requeue_Statement =>
Expand_N_Requeue_Statement (N);
when N_Single_Task_Declaration =>
Expand_N_Single_Task_Declaration (N);
when N_Simple_Return_Statement =>
Expand_N_Simple_Return_Statement (N);
when N_Slice =>
Expand_N_Slice (N);
when N_Selected_Component =>
Expand_N_Selected_Component (N);
when N_Subtype_Indication =>
Expand_N_Subtype_Indication (N);
when N_Selective_Accept =>
Expand_N_Selective_Accept (N);
when N_Subprogram_Body =>
Expand_N_Subprogram_Body (N);
when N_Single_Task_Declaration =>
Expand_N_Single_Task_Declaration (N);
when N_Subprogram_Body_Stub =>
Expand_N_Subprogram_Body_Stub (N);
when N_Slice =>
Expand_N_Slice (N);
when N_Subprogram_Declaration =>
Expand_N_Subprogram_Declaration (N);
when N_Subtype_Indication =>
Expand_N_Subtype_Indication (N);
when N_Task_Body =>
Expand_N_Task_Body (N);
when N_Subprogram_Body =>
Expand_N_Subprogram_Body (N);
when N_Task_Type_Declaration =>
Expand_N_Task_Type_Declaration (N);
when N_Subprogram_Body_Stub =>
Expand_N_Subprogram_Body_Stub (N);
when N_Timed_Entry_Call =>
Expand_N_Timed_Entry_Call (N);
when N_Subprogram_Declaration =>
Expand_N_Subprogram_Declaration (N);
when N_Type_Conversion =>
Expand_N_Type_Conversion (N);
when N_Task_Body =>
Expand_N_Task_Body (N);
when N_Unchecked_Expression =>
Expand_N_Unchecked_Expression (N);
when N_Task_Type_Declaration =>
Expand_N_Task_Type_Declaration (N);
when N_Unchecked_Type_Conversion =>
Expand_N_Unchecked_Type_Conversion (N);
when N_Timed_Entry_Call =>
Expand_N_Timed_Entry_Call (N);
when N_Type_Conversion =>
Expand_N_Type_Conversion (N);
when N_Unchecked_Expression =>
Expand_N_Unchecked_Expression (N);
when N_Unchecked_Type_Conversion =>
Expand_N_Unchecked_Type_Conversion (N);
when N_Variant_Part =>
Expand_N_Variant_Part (N);
when N_Variant_Part =>
Expand_N_Variant_Part (N);
-- For all other node kinds, no expansion activity required
when others =>
null;
when others =>
null;
end case;
end if;
end case;
exception
when RE_Not_Available =>

24
gcc/ada/freeze.adb
View File

@ -3263,7 +3263,7 @@ package body Freeze is
("\??since no component clauses were specified", ADC);
-- Here is where we do the processing to adjust component clauses
-- for reversed bit order.
-- for reversed bit order, when not using reverse SSO.
elsif Reverse_Bit_Order (Rec)
and then not Reverse_Storage_Order (Rec)
@ -7454,9 +7454,17 @@ package body Freeze is
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))
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)))
-- For a record type, if native bit order is specified explicitly,
-- then never set reverse SSO from default.
and then not
(Is_Record_Type (T)
and then Has_Rep_Item (T, Name_Bit_Order)
and then not Reverse_Bit_Order (T))
then
-- If flags cause reverse storage order, then set the result. Note
-- that we would have ignored the pragma setting the non default
@ -7464,6 +7472,14 @@ package body Freeze is
pragma Assert (Support_Nondefault_SSO_On_Target);
Set_Reverse_Storage_Order (T);
-- For a record type, also set reversed bit order. Note that if
-- a bit order has been specified explicitly, then this is a
-- no-op, as per the guard above.
if Is_Record_Type (T) then
Set_Reverse_Bit_Order (T);
end if;
end if;
end if;
end Set_SSO_From_Default;

14
gcc/ada/gnat_rm.texi
View File

@ -351,6 +351,7 @@ Implementation Defined Attributes
* Attribute Compiler_Version::
* Attribute Constrained::
* Attribute Default_Bit_Order::
* Attribute Default_Scalar_Storage_Order::
* Attribute Descriptor_Size::
* Attribute Elaborated::
* Attribute Elab_Body::
@ -8531,6 +8532,7 @@ consideration, you should minimize the use of these attributes.
* Attribute Compiler_Version::
* Attribute Constrained::
* Attribute Default_Bit_Order::
* Attribute Default_Scalar_Storage_Order::
* Attribute Descriptor_Size::
* Attribute Elaborated::
* Attribute Elab_Body::
@ -8781,6 +8783,18 @@ as a @code{Pos} value (0 for @code{High_Order_First}, 1 for
@code{Low_Order_First}). This is used to construct the definition of
@code{Default_Bit_Order} in package @code{System}.
@node Attribute Default_Scalar_Storage_Order
@unnumberedsec Attribute Default_Scalar_Storage_Order
@cindex Big endian
@cindex Little endian
@findex Default_Scalar_Storage_Order
@noindent
@code{Standard'Default_Scalar_Storage_Order} (@code{Standard} is the only
permissible prefix), provides the current value of the default scalar storage
order (as specified using pragma @code{Default_Scalar_Storage_Order}, or
equal to @code{Default_Bit_Order} if unspecified) as a
@code{System.Bit_Order} value. This is a static attribute.
@node Attribute Descriptor_Size
@unnumberedsec Attribute Descriptor_Size
@cindex Descriptor

2
gcc/ada/init.c
View File

@ -1730,7 +1730,7 @@ __gnat_inum_to_ivec (int num)
}
#endif
#if !defined(__alpha_vxworks) && (_WRS_VXWORKS_MAJOR != 6) && !defined(__RTP__)
#if !defined(__alpha_vxworks) && ((_WRS_VXWORKS_MAJOR != 6) && (_WRS_VXWORKS_MAJOR != 7)) && !defined(__RTP__)
/* getpid is used by s-parint.adb, but is not defined by VxWorks, except
on Alpha VxWorks and VxWorks 6.x (including RTPs). */

4
gcc/ada/mkdir.c
View File

@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 2002-2012, Free Software Foundation, Inc. *
* Copyright (C) 2002-2014, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
@ -60,7 +60,7 @@
int
__gnat_mkdir (char *dir_name, int encoding ATTRIBUTE_UNUSED)
{
#if defined (__vxworks) && !(defined (__RTP__) && (_WRS_VXWORKS_MINOR != 0))
#if defined (__vxworks) && !(defined (__RTP__) && ((_WRS_VXWORKS_MAJOR == 7) || (_WRS_VXWORKS_MINOR != 0)))
return mkdir (dir_name);
#elif defined (__MINGW32__)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];

29
gcc/ada/prj-attr.adb
View File

@ -34,7 +34,7 @@ package body Prj.Attr is
-- Data for predefined attributes and packages
-- Names are in lower case and end with '#' or 'D'.
-- Names are in lower case and end with '#' or 'D'
-- Package names are preceded by 'P'
@ -55,16 +55,17 @@ package body Prj.Attr is
-- 'c' same as 'b', with optional index
-- The third optional letter is
-- 'R' to indicate that the attribute is read-only
-- 'O' to indicate that others is allowed as an index for an associative
-- array
-- 'R' the attribute is read-only
-- 'O' others is allowed as an index for an associative array
-- If the character after the name in lower case letter is a 'D'
-- (for default), then 'D' must be followed by an enumeration value of type
-- If the character after the name in lower case letter is a 'D' (for
-- default), then 'D' must be followed by an enumeration value of type
-- Attribute_Default_Value, followed by a '#'.
-- Example:
-- "SVobject_dirDdot_value#"
-- End is indicated by two consecutive '#'
-- End is indicated by two consecutive '#'.
Initialization_Data : constant String :=
@ -647,8 +648,8 @@ package body Prj.Attr is
Finish := Start;
while Initialization_Data (Finish) /= '#'
and then
Initialization_Data (Finish) /= 'D'
and then
Initialization_Data (Finish) /= 'D'
loop
Finish := Finish + 1;
end loop;
@ -658,20 +659,18 @@ package body Prj.Attr is
if Initialization_Data (Finish) = 'D' then
Start := Finish + 1;
Finish := Start;
Finish := Start;
while Initialization_Data (Finish) /= '#' loop
Finish := Finish + 1;
end loop;
declare
Default_Name : constant String :=
Initialization_Data (Start .. Finish - 1);
Initialization_Data (Start .. Finish - 1);
pragma Unsuppress (All_Checks);
begin
Default := Attribute_Default_Value'Value (Default_Name);
exception
when Constraint_Error =>
Osint.Fail
@ -823,8 +822,8 @@ package body Prj.Attr is
In_Package : Package_Node_Id;
Attr_Kind : Defined_Attribute_Kind;
Var_Kind : Defined_Variable_Kind;
Index_Is_File_Name : Boolean := False;
Opt_Index : Boolean := False;
Index_Is_File_Name : Boolean := False;
Opt_Index : Boolean := False;
Default : Attribute_Default_Value := Empty_Value)
is
Attr_Name : Name_Id;

11
gcc/ada/prj-attr.ads
View File

@ -109,7 +109,7 @@ package Prj.Attr is
Default : Attribute_Default_Value := Empty_Value;
-- The value of the attribute when referenced if the attribute has not
-- been (yet) declared.
-- yet been declared.
end record;
-- Name and characteristics of an attribute in a package registered
@ -197,8 +197,7 @@ package Prj.Attr is
function Attribute_Default_Of
(Attribute : Attribute_Node_Id) return Attribute_Default_Value;
-- Returns the default of the attribute, Read_Only_Value for read only
-- attributes, Empty_Value when ndefault not specified or specified
-- value.
-- attributes, Empty_Value when default not specified, or specified value.
function Optional_Index_Of (Attribute : Attribute_Node_Id) return Boolean;
-- Returns True if Attribute is a known attribute and may have an
@ -241,14 +240,14 @@ package Prj.Attr is
In_Package : Package_Node_Id;
Attr_Kind : Defined_Attribute_Kind;
Var_Kind : Defined_Variable_Kind;
Index_Is_File_Name : Boolean := False;
Opt_Index : Boolean := False;
Index_Is_File_Name : Boolean := False;
Opt_Index : Boolean := False;
Default : Attribute_Default_Value := Empty_Value);
-- Add a new attribute to registered package In_Package. Fails if Name
-- (the attribute name) is empty, if In_Package is Empty_Package or if
-- the attribute name has a duplicate name. See definition of type
-- Attribute_Data above for the meaning of parameters Attr_Kind, Var_Kind,
-- Index_Is_File_Name, Opt_Index and Default.
-- Index_Is_File_Name, Opt_Index, and Default.
function Package_Node_Id_Of (Name : Name_Id) return Package_Node_Id;
-- Returns the package node id of the package with name Name. Returns

15
gcc/ada/prj-part.adb
View File

@ -1813,11 +1813,11 @@ package body Prj.Part is
-- with sources if it inherits sources from the project
-- it extends.
if Project_Qualifier_Of
(Project, In_Tree) = Abstract_Project
and then
Project_Qualifier_Of
(Extended_Project, In_Tree) /= Abstract_Project
if Project_Qualifier_Of (Project, In_Tree) =
Abstract_Project
and then
Project_Qualifier_Of (Extended_Project, In_Tree) /=
Abstract_Project
then
Error_Msg
(Env.Flags, "an abstract project can only extend " &
@ -1930,9 +1930,8 @@ package body Prj.Part is
Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration);
if Present (Extended_Project)
and then
Project_Qualifier_Of
(Extended_Project, In_Tree) /= Abstract_Project
and then Project_Qualifier_Of (Extended_Project, In_Tree) /=
Abstract_Project
then
Set_Extending_Project_Of
(Project_Declaration_Of (Extended_Project, In_Tree), In_Tree,

69
gcc/ada/prj-proc.adb
View File

@ -896,56 +896,56 @@ package body Prj.Proc is
The_Default : constant Attribute_Default_Value :=
Default_Of
(The_Current_Term, From_Project_Node_Tree);
begin
case The_Variable.Kind is
when Undefined =>
null;
when Undefined =>
null;
when Single =>
case The_Default is
when Read_Only_Value =>
null;
when Single =>
case The_Default is
when Read_Only_Value =>
null;
when Empty_Value =>
The_Variable.Value := Empty_String;
when Empty_Value =>
The_Variable.Value := Empty_String;
when Dot_Value =>
The_Variable.Value := Dot_String;
when Dot_Value =>
The_Variable.Value := Dot_String;
when Object_Dir_Value =>
From_Project_Node_Tree.Project_Nodes.Table
(The_Current_Term).Name :=
Snames.Name_Object_Dir;
From_Project_Node_Tree.Project_Nodes.Table
(The_Current_Term).Default :=
Dot_Value;
goto Object_Dir_Restart;
when Object_Dir_Value =>
From_Project_Node_Tree.Project_Nodes.Table
(The_Current_Term).Name :=
Snames.Name_Object_Dir;
From_Project_Node_Tree.Project_Nodes.Table
(The_Current_Term).Default :=
Dot_Value;
goto Object_Dir_Restart;
when Target_Value =>
null;
end case;
when Target_Value =>
null;
end case;
when List =>
case The_Default is
when Read_Only_Value =>
null;
when List =>
case The_Default is
when Read_Only_Value =>
null;
when Empty_Value =>
The_Variable.Values := Nil_String;
when Empty_Value =>
The_Variable.Values := Nil_String;
when Dot_Value =>
The_Variable.Values :=
Shared.Dot_String_List;
when Dot_Value =>
The_Variable.Values :=
Shared.Dot_String_List;
when Object_Dir_Value | Target_Value =>
null;
end case;
when Object_Dir_Value | Target_Value =>
null;
end case;
end case;
end;
end if;
case Kind is
when Undefined =>
-- Should never happen
@ -954,7 +954,6 @@ package body Prj.Proc is
null;
when Single =>
case The_Variable.Kind is
when Undefined =>

2
gcc/ada/prj-strt.adb
View File

@ -217,7 +217,7 @@ package body Prj.Strt is
Set_Case_Insensitive
(Reference, In_Tree,
To => Attribute_Kind_Of (Current_Attribute) in
All_Case_Insensitive_Associative_Array);
All_Case_Insensitive_Associative_Array);
Set_Default_Of
(Reference, In_Tree,
To => Attribute_Default_Of (Current_Attribute));

1
gcc/ada/prj.adb
View File

@ -60,7 +60,6 @@ package body Prj is
-- Initial size for extensible buffer used in Add_To_Buffer
The_Empty_String : Name_Id := No_Name;
The_Dot_String : Name_Id := No_Name;
Debug_Level : Integer := 0;

20
gcc/ada/prj.ads
View File

@ -73,21 +73,11 @@ package Prj is
-- Tri-state to decide if -lgnarl is needed when linking
type Attribute_Default_Value is
(Read_Only_Value,
-- for read only attributes (Name, Project_Dir)
Empty_Value,
-- empty string or empty string list
Dot_Value,
-- "." or (".")
Object_Dir_Value,
-- 'Object_Dir
Target_Value
-- 'Target (special rules)
);
(Read_Only_Value, -- For read only attributes (Name, Project_Dir)
Empty_Value, -- Empty string or empty string list
Dot_Value, -- "." or (".")
Object_Dir_Value, -- 'Object_Dir
Target_Value); -- 'Target (special rules)
-- Describe the default values of attributes that are referenced but not
-- declared.

42
gcc/ada/repinfo.adb
View File

@ -166,7 +166,8 @@ package body Repinfo is
procedure List_Scalar_Storage_Order
(Ent : Entity_Id;
Bytes_Big_Endian : Boolean);
-- List scalar storage order information for record or array type Ent
-- List scalar storage order information for record or array type Ent.
-- Also includes bit order information for record types, if necessary.
procedure List_Type_Info (Ent : Entity_Id);
-- List type info for type Ent
@ -1067,20 +1068,22 @@ package body Repinfo is
(Ent : Entity_Id;
Bytes_Big_Endian : Boolean)
is
procedure List_Attr (Attr_Name : String);
-- Show attribute definition clause for Attr_Name
procedure List_Attr (Attr_Name : String; Is_Reversed : Boolean);
-- Show attribute definition clause for Attr_Name (an endianness
-- attribute), depending on whether or not the endianness is reversed
-- compared to native endianness.
---------------
-- List_Attr --
---------------
procedure List_Attr (Attr_Name : String) is
procedure List_Attr (Attr_Name : String; Is_Reversed : Boolean) is
begin
Write_Str ("for ");
List_Name (Ent);
Write_Str ("'" & Attr_Name & " use System.");
if Bytes_Big_Endian xor Reverse_Storage_Order (Ent) then
if Bytes_Big_Endian xor Is_Reversed then
Write_Str ("High");
else
Write_Str ("Low");
@ -1089,23 +1092,32 @@ package body Repinfo is
Write_Line ("_Order_First;");
end List_Attr;
List_SSO : constant Boolean :=
Has_Rep_Item (Ent, Name_Scalar_Storage_Order)
or else SSO_Set_Low_By_Default (Ent)
or else SSO_Set_High_By_Default (Ent);
-- Scalar_Storage_Order is displayed if specified explicitly
-- or set by Default_Scalar_Storage_Order.
-- Start of processing for List_Scalar_Storage_Order
begin
-- List info if set explicitly or by use of Default_Scalar_Storage_Order
-- For record types, list Bit_Order if not default, or if SSO is shown
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)
if Is_Record_Type (Ent)
and then (List_SSO or else Reverse_Bit_Order (Ent))
then
-- For a record type with specified scalar storage order, also
-- display explicit Bit_Order.
List_Attr ("Bit_Order", Reverse_Bit_Order (Ent));
end if;
if Is_Record_Type (Ent) then
List_Attr ("Bit_Order");
end if;
-- List SSO if required. If not, then storage is supposed to be in
-- native order.
List_Attr ("Scalar_Storage_Order");
if List_SSO then
List_Attr ("Scalar_Storage_Order", Reverse_Storage_Order (Ent));
else
pragma Assert (not Reverse_Storage_Order (Ent));
null;
end if;
end List_Scalar_Storage_Order;

161
gcc/ada/sem_attr.adb
View File

@ -65,6 +65,7 @@ with Sem_Util; use Sem_Util;
with Stand; use Stand;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
with System;
with Stringt; use Stringt;
with Style;
with Stylesw; use Stylesw;
@ -3191,21 +3192,52 @@ package body Sem_Attr is
-----------------------
when Attribute_Default_Bit_Order => Default_Bit_Order :
declare
Target_Default_Bit_Order : System.Bit_Order;
begin
Check_Standard_Prefix;
if Bytes_Big_Endian then
Rewrite (N,
Make_Integer_Literal (Loc, False_Value));
Target_Default_Bit_Order := System.High_Order_First;
else
Rewrite (N,
Make_Integer_Literal (Loc, True_Value));
Target_Default_Bit_Order := System.Low_Order_First;
end if;
Rewrite (N,
Make_Integer_Literal (Loc,
UI_From_Int (System.Bit_Order'Pos (Target_Default_Bit_Order))));
Set_Etype (N, Universal_Integer);
Set_Is_Static_Expression (N);
end Default_Bit_Order;
----------------------------------
-- Default_Scalar_Storage_Order --
----------------------------------
when Attribute_Default_Scalar_Storage_Order => Default_SSO : declare
RE_Default_SSO : RE_Id;
begin
Check_Standard_Prefix;
case Opt.Default_SSO is
when ' ' =>
if Bytes_Big_Endian then
RE_Default_SSO := RE_High_Order_First;
else
RE_Default_SSO := RE_Low_Order_First;
end if;
when 'H' =>
RE_Default_SSO := RE_High_Order_First;
when 'L' =>
RE_Default_SSO := RE_Low_Order_First;
when others =>
raise Program_Error;
end case;
Rewrite (N, New_Occurrence_Of (RTE (RE_Default_SSO), Loc));
end Default_SSO;
--------------
-- Definite --
--------------
@ -9534,66 +9566,67 @@ package body Sem_Attr is
-- Note that in some cases, the values have already been folded as
-- a result of the processing in Analyze_Attribute.
when Attribute_Abort_Signal |
Attribute_Access |
Attribute_Address |
Attribute_Address_Size |
Attribute_Asm_Input |
Attribute_Asm_Output |
Attribute_Base |
Attribute_Bit_Order |
Attribute_Bit_Position |
Attribute_Callable |
Attribute_Caller |
Attribute_Class |
Attribute_Code_Address |
Attribute_Compiler_Version |
Attribute_Count |
Attribute_Default_Bit_Order |
Attribute_Elaborated |
Attribute_Elab_Body |
Attribute_Elab_Spec |
Attribute_Elab_Subp_Body |
Attribute_Enabled |
Attribute_External_Tag |
Attribute_Fast_Math |
Attribute_First_Bit |
Attribute_Input |
Attribute_Last_Bit |
Attribute_Library_Level |
Attribute_Maximum_Alignment |
Attribute_Old |
Attribute_Output |
Attribute_Partition_ID |
Attribute_Pool_Address |
Attribute_Position |
Attribute_Priority |
Attribute_Read |
Attribute_Result |
Attribute_Scalar_Storage_Order |
Attribute_Simple_Storage_Pool |
Attribute_Storage_Pool |
Attribute_Storage_Size |
Attribute_Storage_Unit |
Attribute_Stub_Type |
Attribute_System_Allocator_Alignment |
Attribute_Tag |
Attribute_Target_Name |
Attribute_Terminated |
Attribute_To_Address |
Attribute_Type_Key |
Attribute_UET_Address |
Attribute_Unchecked_Access |
Attribute_Universal_Literal_String |
Attribute_Unrestricted_Access |
Attribute_Valid |
Attribute_Valid_Scalars |
Attribute_Value |
Attribute_Wchar_T_Size |
Attribute_Wide_Value |
Attribute_Wide_Wide_Value |
Attribute_Word_Size |
Attribute_Write =>
when Attribute_Abort_Signal |
Attribute_Access |
Attribute_Address |
Attribute_Address_Size |
Attribute_Asm_Input |
Attribute_Asm_Output |
Attribute_Base |
Attribute_Bit_Order |
Attribute_Bit_Position |
Attribute_Callable |
Attribute_Caller |
Attribute_Class |
Attribute_Code_Address |
Attribute_Compiler_Version |
Attribute_Count |
Attribute_Default_Bit_Order |
Attribute_Default_Scalar_Storage_Order |
Attribute_Elaborated |
Attribute_Elab_Body |
Attribute_Elab_Spec |
Attribute_Elab_Subp_Body |
Attribute_Enabled |
Attribute_External_Tag |
Attribute_Fast_Math |
Attribute_First_Bit |
Attribute_Input |
Attribute_Last_Bit |
Attribute_Library_Level |
Attribute_Maximum_Alignment |
Attribute_Old |
Attribute_Output |
Attribute_Partition_ID |
Attribute_Pool_Address |
Attribute_Position |
Attribute_Priority |
Attribute_Read |
Attribute_Result |
Attribute_Scalar_Storage_Order |
Attribute_Simple_Storage_Pool |
Attribute_Storage_Pool |
Attribute_Storage_Size |
Attribute_Storage_Unit |
Attribute_Stub_Type |
Attribute_System_Allocator_Alignment |
Attribute_Tag |
Attribute_Target_Name |
Attribute_Terminated |
Attribute_To_Address |
Attribute_Type_Key |
Attribute_UET_Address |
Attribute_Unchecked_Access |
Attribute_Universal_Literal_String |
Attribute_Unrestricted_Access |
Attribute_Valid |
Attribute_Valid_Scalars |
Attribute_Value |
Attribute_Wchar_T_Size |
Attribute_Wide_Value |
Attribute_Wide_Wide_Value |
Attribute_Word_Size |
Attribute_Write =>
raise Program_Error;
end case;

77
gcc/ada/sem_attr.ads
View File

@ -135,20 +135,31 @@ package Sem_Attr is
-----------------------
Attribute_Default_Bit_Order => True,
-- Standard'Default_Bit_Order (Standard is the only permissible prefix),
-- Standard'Default_Bit_Order (Standard is the only permissible prefix)
-- provides the value System.Default_Bit_Order as a Pos value (0 for
-- High_Order_First, 1 for Low_Order_First). This is used to construct
-- the definition of Default_Bit_Order in package System. This is a
-- static attribute.
----------------------------------
-- Default_Scalar_Storage_Order --
----------------------------------
Attribute_Default_Scalar_Storage_Order => True,
-- Standard'Default_Scalar_Storage_Order (Standard is the
-- only permissible prefix) provides the current value of the
-- default scalar storage order (as specified using pragma
-- Default_Scalar_Storage_Order, or equal to Default_Bit_Order if
-- unspecified) as a System.Bit_Order value. This is a static attribute.
---------------
-- Elab_Body --
---------------
Attribute_Elab_Body => True,
-- This attribute can only be applied to a program unit name. It returns
-- the entity for the corresponding elaboration procedure for elabor-
-- ating the body of the referenced unit. This is used in the main
-- This attribute can only be applied to a program unit name. It
-- returns the entity for the corresponding elaboration procedure for
-- elaborating the body of the referenced unit. This is used in the main
-- generated elaboration procedure by the binder, and is not normally
-- used in any other context, but there may be specialized situations in
-- which it is useful to be able to call this elaboration procedure from
@ -172,13 +183,13 @@ package Sem_Attr is
Attribute_Elab_Spec => True,
-- This attribute can only be applied to a program unit name. It
-- returns the entity for the corresponding elaboration procedure
-- for elaborating the spec of the referenced unit. This is used
-- in the main generated elaboration procedure by the binder, and
-- is not normally used in any other context, but there may be
-- specialized situations in which it is useful to be able to
-- call this elaboration procedure from Ada code, e.g. if it
-- is necessary to do selective reelaboration to fix some error.
-- returns the entity for the corresponding elaboration procedure for
-- elaborating the spec of the referenced unit. This is used in the main
-- generated elaboration procedure by the binder, and is not normally
-- used in any other context, but there may be specialized situations in
-- which it is useful to be able to call this elaboration procedure from
-- Ada code, e.g. if it is necessary to do selective reelaboration to
-- fix some error.
----------------
-- Elaborated --
@ -209,8 +220,8 @@ package Sem_Attr is
--------------
Attribute_Enum_Val => True,
-- For every enumeration subtype S, S'Enum_Val denotes a function
-- with the following specification:
-- For every enumeration subtype S, S'Enum_Val denotes a function with
-- the following specification:
--
-- function S'Enum_Val (Arg : universal_integer) return S'Base;
--
@ -236,8 +247,8 @@ package Sem_Attr is
-- The effect is thus equivalent to first converting the argument to
-- the integer type used to represent S, and then doing an unchecked
-- conversion to the fixed-point type. This attribute is primarily
-- intended for use in implementation of the input-output functions for
-- fixed-point values.
-- intended for use in implementation of the input-output functions
-- for fixed-point values.
-----------------------
-- Has_Discriminants --
@ -290,10 +301,10 @@ package Sem_Attr is
-- of the type. If possible this value is an invalid value, and in fact
-- is identical to the value that would be set if Initialize_Scalars
-- mode were in effect (including the behavior of its value on
-- environment variables or binder switches). The intended use is
-- to set a value where initialization is required (e.g. as a result of
-- the coding standards in use), but logically no initialization is
-- needed, and the value should never be accessed.
-- environment variables or binder switches). The intended use is to
-- set a value where initialization is required (e.g. as a result of the
-- coding standards in use), but logically no initialization is needed,
-- and the value should never be accessed.
Attribute_Loop_Entry => True,
-- For every object of a non-limited type, S'Loop_Entry [(Loop_Name)]
@ -314,11 +325,11 @@ package Sem_Attr is
Attribute_Maximum_Alignment => True,
-- Standard'Maximum_Alignment (Standard is the only permissible prefix)
-- provides the maximum useful alignment value for the target. This
-- is a static value that can be used to specify the alignment for an
-- object, guaranteeing that it is properly aligned in all cases. The
-- time this is useful is when an external object is imported and its
-- alignment requirements are unknown. This is a static attribute.
-- provides the maximum useful alignment value for the target. This is a
-- static value that can be used to specify the alignment for an object,
-- guaranteeing that it is properly aligned in all cases. The time this
-- is useful is when an external object is imported and its alignment
-- requirements are unknown. This is a static attribute.
--------------------
-- Mechanism_Code --
@ -346,19 +357,19 @@ package Sem_Attr is
--------------------
Attribute_Null_Parameter => True,
-- A reference T'Null_Parameter denotes an (imaginary) object of type or
-- subtype T allocated at (machine) address zero. The attribute is
-- allowed only as the default expression of a formal parameter, or as
-- an actual expression of a subprogram call. In either case, the
-- A reference T'Null_Parameter denotes an (imaginary) object of type
-- or subtype T allocated at (machine) address zero. The attribute is
-- allowed only as the default expression of a formal parameter, or
-- as an actual expression of a subprogram call. In either case, the
-- subprogram must be imported.
--
-- The identity of the object is represented by the address zero in the
-- argument list, independent of the passing mechanism (explicit or
-- default).
-- The identity of the object is represented by the address zero in
-- the argument list, independent of the passing mechanism (explicit
-- or default).
--
-- The reason that this capability is needed is that for a record or
-- other composite object passed by reference, there is no other way of
-- specifying that a zero address should be passed.
-- other composite object passed by reference, there is no other way
-- of specifying that a zero address should be passed.
-----------------
-- Object_Size --

4
gcc/ada/snames.adb-tmpl
View File

@ -220,6 +220,8 @@ package body Snames is
case N is
when Name_CPU =>
return Pragma_CPU;
when Name_Default_Scalar_Storage_Order =>
return Pragma_Default_Scalar_Storage_Order;
when Name_Dispatching_Domain =>
return Pragma_Dispatching_Domain;
when Name_Fast_Math =>
@ -335,6 +337,7 @@ package body Snames is
function Is_Configuration_Pragma_Name (N : Name_Id) return Boolean is
begin
return N in First_Pragma_Name .. Last_Configuration_Pragma_Name
or else N = Name_Default_Scalar_Storage_Order
or else N = Name_Fast_Math;
end Is_Configuration_Pragma_Name;
@ -447,6 +450,7 @@ package body Snames is
begin
return N in First_Pragma_Name .. Last_Pragma_Name
or else N = Name_CPU
or else N = Name_Default_Scalar_Storage_Order
or else N = Name_Dispatching_Domain
or else N = Name_Fast_Math
or else N = Name_Interface

7
gcc/ada/snames.ads-tmpl
View File

@ -329,7 +329,7 @@ package Snames is
-- to be implementation dependent pragmas.
-- The entries marked GNAT are pragmas that are defined by GNAT and that
-- are implemented in all modes (Ada 83, Ada 95, and Ada 2005) Complete
-- are implemented in all modes (Ada 83, Ada 95, and Ada 2005). Complete
-- descriptions of the syntax of these implementation dependent pragmas may
-- be found in the appropriate section in unit Sem_Prag in file
-- sem-prag.adb, and they are documented in the GNAT reference manual.
@ -376,7 +376,6 @@ package Snames is
Name_Convention_Identifier : constant Name_Id := N + $; -- GNAT
Name_Debug_Policy : constant Name_Id := N + $; -- GNAT
Name_Detect_Blocking : constant Name_Id := N + $; -- Ada 05
Name_Default_Scalar_Storage_Order : constant Name_Id := N + $; -- GNAT
Name_Default_Storage_Pool : constant Name_Id := N + $; -- Ada 12
Name_Disable_Atomic_Synchronization : constant Name_Id := N + $; -- GNAT
Name_Discard_Names : constant Name_Id := N + $;
@ -833,6 +832,7 @@ package Snames is
Name_Constrained : constant Name_Id := N + $;
Name_Count : constant Name_Id := N + $;
Name_Default_Bit_Order : constant Name_Id := N + $; -- GNAT
Name_Default_Scalar_Storage_Order : constant Name_Id := N + $; -- GNAT
Name_Default_Iterator : constant Name_Id := N + $; -- GNAT
Name_Definite : constant Name_Id := N + $;
Name_Delta : constant Name_Id := N + $;
@ -1462,6 +1462,7 @@ package Snames is
Attribute_Constrained,
Attribute_Count,
Attribute_Default_Bit_Order,
Attribute_Default_Scalar_Storage_Order,
Attribute_Default_Iterator,
Attribute_Definite,
Attribute_Delta,
@ -1728,7 +1729,6 @@ package Snames is
Pragma_Convention_Identifier,
Pragma_Debug_Policy,
Pragma_Detect_Blocking,
Pragma_Default_Scalar_Storage_Order,
Pragma_Default_Storage_Pool,
Pragma_Disable_Atomic_Synchronization,
Pragma_Discard_Names,
@ -1929,6 +1929,7 @@ package Snames is
-- match existing attribute names.
Pragma_CPU,
Pragma_Default_Scalar_Storage_Order,
Pragma_Dispatching_Domain,
Pragma_Fast_Math,
Pragma_Interface,

3
gcc/ada/sysdep.c
View File

@ -42,6 +42,7 @@
#endif
#include "selectLib.h"
#include "vxWorks.h"
#include "version.h"
#if defined (__RTP__)
# include "vwModNum.h"
#endif /* __RTP__ */
@ -949,7 +950,7 @@ __gnat_is_file_not_found_error (int errno_val) {
/* In the case of VxWorks, we also have to take into account various
* filesystem-specific variants of this error.
*/
#if ! defined (VTHREADS)
#if ! defined (VTHREADS) && (_WRS_VXWORKS_MAJOR < 7)
case S_dosFsLib_FILE_NOT_FOUND:
#endif
#if ! defined (__RTP__) && (! defined (VTHREADS) || defined (__VXWORKSMILS__))