From 7ed571892e5a8d10c14a674e38b980f60115ceb6 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 4 Aug 2014 11:55:01 +0200 Subject: [PATCH] [multiple changes] 2014-08-04 Robert Dewar * 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 * expander.adb (Expand): Always perform special expansion in GNATprove mode, even when doing pre-analysis. 2014-08-04 Thomas Quinot * 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 * 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 * 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 * 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 * 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 --- gcc/ada/ChangeLog | 46 +++++ gcc/ada/cal.c | 4 +- gcc/ada/exp_attr.adb | 1 + gcc/ada/exp_ch3.adb | 5 +- gcc/ada/expander.adb | 479 ++++++++++++++++++++++++------------------------ gcc/ada/freeze.adb | 24 ++- gcc/ada/gnat_rm.texi | 14 ++ gcc/ada/init.c | 2 +- gcc/ada/mkdir.c | 4 +- gcc/ada/prj-attr.adb | 29 ++- gcc/ada/prj-attr.ads | 11 +- gcc/ada/prj-part.adb | 15 +- gcc/ada/prj-proc.adb | 87 +++++---- gcc/ada/prj-strt.adb | 2 +- gcc/ada/prj.adb | 1 - gcc/ada/prj.ads | 20 +- gcc/ada/repinfo.adb | 42 +++-- gcc/ada/sem_attr.adb | 161 +++++++++------- gcc/ada/sem_attr.ads | 77 ++++---- gcc/ada/snames.adb-tmpl | 4 + gcc/ada/snames.ads-tmpl | 7 +- gcc/ada/sysdep.c | 3 +- 22 files changed, 579 insertions(+), 459 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index af2af30..61ccf82 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,49 @@ +2014-08-04 Robert Dewar + + * 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 + + * expander.adb (Expand): Always perform special + expansion in GNATprove mode, even when doing pre-analysis. + +2014-08-04 Thomas Quinot + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 * exp_util.adb (Check_Float_Op_Overflow): No-op in codepeer diff --git a/gcc/ada/cal.c b/gcc/ada/cal.c index 6eb1769..a657286 100644 --- a/gcc/ada/cal.c +++ b/gcc/ada/cal.c @@ -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 #include -#if (_WRS_VXWORKS_MINOR != 0) +#if (_WRS_VXWORKS_MAJOR == 7) || (_WRS_VXWORKS_MINOR != 0) #include #endif #else diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index bb1b6b6..f9c1745 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -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 | diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index e21e9e4..e87a840 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -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))); diff --git a/gcc/ada/expander.adb b/gcc/ada/expander.adb index 4d15e09..ff19759 100644 --- a/gcc/ada/expander.adb +++ b/gcc/ada/expander.adb @@ -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. - - if GNATprove_Mode then - Expand_SPARK (N); - Set_Analyzed (N); - - -- 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; - - -- Here for normal non-SPARK mode + Debug_A_Entry ("expanding ", N); - else - -- Processing depends on node kind. For full details on the - -- expansion activity required in each case, see bodies of - -- corresponding expand routines. + -- Processing depends on node kind. For full details on the + -- expansion activity required in each case, see bodies of + -- corresponding expand routines. - case Nkind (N) is + case Nkind (N) is - when N_Abort_Statement => - Expand_N_Abort_Statement (N); + when N_Abort_Statement => + Expand_N_Abort_Statement (N); - when N_Accept_Statement => - Expand_N_Accept_Statement (N); + when N_Accept_Statement => + Expand_N_Accept_Statement (N); - when N_Aggregate => - Expand_N_Aggregate (N); + when N_Aggregate => + Expand_N_Aggregate (N); - when N_Allocator => - Expand_N_Allocator (N); + when N_Allocator => + Expand_N_Allocator (N); - when N_And_Then => - Expand_N_And_Then (N); + when N_And_Then => + Expand_N_And_Then (N); - when N_Assignment_Statement => - Expand_N_Assignment_Statement (N); + when N_Assignment_Statement => + Expand_N_Assignment_Statement (N); - when N_Asynchronous_Select => - Expand_N_Asynchronous_Select (N); + when N_Asynchronous_Select => + Expand_N_Asynchronous_Select (N); - when N_Attribute_Definition_Clause => - Expand_N_Attribute_Definition_Clause (N); + when N_Attribute_Definition_Clause => + Expand_N_Attribute_Definition_Clause (N); - when N_Attribute_Reference => - Expand_N_Attribute_Reference (N); + when N_Attribute_Reference => + Expand_N_Attribute_Reference (N); - when N_Block_Statement => - Expand_N_Block_Statement (N); + when N_Block_Statement => + Expand_N_Block_Statement (N); - when N_Case_Expression => - Expand_N_Case_Expression (N); + when N_Case_Expression => + Expand_N_Case_Expression (N); - when N_Case_Statement => - Expand_N_Case_Statement (N); + when N_Case_Statement => + Expand_N_Case_Statement (N); - when N_Conditional_Entry_Call => - Expand_N_Conditional_Entry_Call (N); + when N_Conditional_Entry_Call => + Expand_N_Conditional_Entry_Call (N); - when N_Delay_Relative_Statement => - Expand_N_Delay_Relative_Statement (N); + when N_Delay_Relative_Statement => + Expand_N_Delay_Relative_Statement (N); - when N_Delay_Until_Statement => - Expand_N_Delay_Until_Statement (N); + when N_Delay_Until_Statement => + Expand_N_Delay_Until_Statement (N); - when N_Entry_Body => - Expand_N_Entry_Body (N); + when N_Entry_Body => + Expand_N_Entry_Body (N); - when N_Entry_Call_Statement => - Expand_N_Entry_Call_Statement (N); + when N_Entry_Call_Statement => + Expand_N_Entry_Call_Statement (N); - when N_Entry_Declaration => - Expand_N_Entry_Declaration (N); + when N_Entry_Declaration => + Expand_N_Entry_Declaration (N); - when N_Exception_Declaration => - Expand_N_Exception_Declaration (N); + when N_Exception_Declaration => + Expand_N_Exception_Declaration (N); - when N_Exception_Renaming_Declaration => - Expand_N_Exception_Renaming_Declaration (N); + when N_Exception_Renaming_Declaration => + Expand_N_Exception_Renaming_Declaration (N); - when N_Exit_Statement => - Expand_N_Exit_Statement (N); + when N_Exit_Statement => + Expand_N_Exit_Statement (N); - when N_Expanded_Name => - Expand_N_Expanded_Name (N); + when N_Expanded_Name => + Expand_N_Expanded_Name (N); - when N_Explicit_Dereference => - Expand_N_Explicit_Dereference (N); + when N_Explicit_Dereference => + Expand_N_Explicit_Dereference (N); - when N_Expression_With_Actions => - Expand_N_Expression_With_Actions (N); + when N_Expression_With_Actions => + Expand_N_Expression_With_Actions (N); - when N_Extended_Return_Statement => - Expand_N_Extended_Return_Statement (N); + when N_Extended_Return_Statement => + Expand_N_Extended_Return_Statement (N); - when N_Extension_Aggregate => - Expand_N_Extension_Aggregate (N); + when N_Extension_Aggregate => + Expand_N_Extension_Aggregate (N); - when N_Free_Statement => - Expand_N_Free_Statement (N); + when N_Free_Statement => + Expand_N_Free_Statement (N); - when N_Freeze_Entity => - Expand_N_Freeze_Entity (N); + when N_Freeze_Entity => + Expand_N_Freeze_Entity (N); - when N_Full_Type_Declaration => - Expand_N_Full_Type_Declaration (N); + when N_Full_Type_Declaration => + Expand_N_Full_Type_Declaration (N); - when N_Function_Call => - Expand_N_Function_Call (N); + when N_Function_Call => + Expand_N_Function_Call (N); - when N_Generic_Instantiation => - Expand_N_Generic_Instantiation (N); + when N_Generic_Instantiation => + Expand_N_Generic_Instantiation (N); - when N_Goto_Statement => - Expand_N_Goto_Statement (N); + when N_Goto_Statement => + Expand_N_Goto_Statement (N); - when N_Handled_Sequence_Of_Statements => - Expand_N_Handled_Sequence_Of_Statements (N); + when N_Handled_Sequence_Of_Statements => + Expand_N_Handled_Sequence_Of_Statements (N); - when N_Identifier => - Expand_N_Identifier (N); + when N_Identifier => + Expand_N_Identifier (N); - when N_If_Expression => - Expand_N_If_Expression (N); + when N_If_Expression => + Expand_N_If_Expression (N); - when N_Indexed_Component => - Expand_N_Indexed_Component (N); + when N_Indexed_Component => + Expand_N_Indexed_Component (N); - when N_If_Statement => - Expand_N_If_Statement (N); + when N_If_Statement => + Expand_N_If_Statement (N); - when N_In => - Expand_N_In (N); + when N_In => + Expand_N_In (N); - when N_Loop_Statement => - Expand_N_Loop_Statement (N); + when N_Loop_Statement => + Expand_N_Loop_Statement (N); - when N_Not_In => - Expand_N_Not_In (N); + when N_Not_In => + Expand_N_Not_In (N); - when N_Null => - Expand_N_Null (N); + when N_Null => + Expand_N_Null (N); - when N_Object_Declaration => - Expand_N_Object_Declaration (N); + when N_Object_Declaration => + Expand_N_Object_Declaration (N); - when N_Object_Renaming_Declaration => - Expand_N_Object_Renaming_Declaration (N); + when N_Object_Renaming_Declaration => + Expand_N_Object_Renaming_Declaration (N); - when N_Op_Add => - Expand_N_Op_Add (N); + when N_Op_Add => + Expand_N_Op_Add (N); - when N_Op_Abs => - Expand_N_Op_Abs (N); + when N_Op_Abs => + Expand_N_Op_Abs (N); - when N_Op_And => - Expand_N_Op_And (N); + when N_Op_And => + Expand_N_Op_And (N); - when N_Op_Concat => - Expand_N_Op_Concat (N); + when N_Op_Concat => + Expand_N_Op_Concat (N); - when N_Op_Divide => - Expand_N_Op_Divide (N); + when N_Op_Divide => + Expand_N_Op_Divide (N); - when N_Op_Eq => - Expand_N_Op_Eq (N); + when N_Op_Eq => + Expand_N_Op_Eq (N); - when N_Op_Expon => - Expand_N_Op_Expon (N); + when N_Op_Expon => + Expand_N_Op_Expon (N); - when N_Op_Ge => - Expand_N_Op_Ge (N); + when N_Op_Ge => + Expand_N_Op_Ge (N); - when N_Op_Gt => - Expand_N_Op_Gt (N); + when N_Op_Gt => + Expand_N_Op_Gt (N); - when N_Op_Le => - Expand_N_Op_Le (N); + when N_Op_Le => + Expand_N_Op_Le (N); - when N_Op_Lt => - Expand_N_Op_Lt (N); + when N_Op_Lt => + Expand_N_Op_Lt (N); - when N_Op_Minus => - Expand_N_Op_Minus (N); + when N_Op_Minus => + Expand_N_Op_Minus (N); - when N_Op_Mod => - Expand_N_Op_Mod (N); + when N_Op_Mod => + Expand_N_Op_Mod (N); - when N_Op_Multiply => - Expand_N_Op_Multiply (N); + when N_Op_Multiply => + Expand_N_Op_Multiply (N); - when N_Op_Ne => - Expand_N_Op_Ne (N); + when N_Op_Ne => + Expand_N_Op_Ne (N); - when N_Op_Not => - Expand_N_Op_Not (N); + when N_Op_Not => + Expand_N_Op_Not (N); - when N_Op_Or => - Expand_N_Op_Or (N); + when N_Op_Or => + Expand_N_Op_Or (N); - when N_Op_Plus => - Expand_N_Op_Plus (N); + when N_Op_Plus => + Expand_N_Op_Plus (N); - when N_Op_Rem => - Expand_N_Op_Rem (N); + when N_Op_Rem => + Expand_N_Op_Rem (N); - when N_Op_Rotate_Left => - Expand_N_Op_Rotate_Left (N); + when N_Op_Rotate_Left => + Expand_N_Op_Rotate_Left (N); - when N_Op_Rotate_Right => - Expand_N_Op_Rotate_Right (N); + when N_Op_Rotate_Right => + Expand_N_Op_Rotate_Right (N); - when N_Op_Shift_Left => - Expand_N_Op_Shift_Left (N); + when N_Op_Shift_Left => + Expand_N_Op_Shift_Left (N); - when N_Op_Shift_Right => - Expand_N_Op_Shift_Right (N); + when N_Op_Shift_Right => + Expand_N_Op_Shift_Right (N); - when N_Op_Shift_Right_Arithmetic => - Expand_N_Op_Shift_Right_Arithmetic (N); + when N_Op_Shift_Right_Arithmetic => + Expand_N_Op_Shift_Right_Arithmetic (N); - when N_Op_Subtract => - Expand_N_Op_Subtract (N); + when N_Op_Subtract => + Expand_N_Op_Subtract (N); - when N_Op_Xor => - Expand_N_Op_Xor (N); + when N_Op_Xor => + Expand_N_Op_Xor (N); - when N_Or_Else => - Expand_N_Or_Else (N); + when N_Or_Else => + Expand_N_Or_Else (N); - when N_Package_Body => - Expand_N_Package_Body (N); + when N_Package_Body => + Expand_N_Package_Body (N); - when N_Package_Declaration => - Expand_N_Package_Declaration (N); + when N_Package_Declaration => + Expand_N_Package_Declaration (N); - when N_Package_Renaming_Declaration => - Expand_N_Package_Renaming_Declaration (N); + when N_Package_Renaming_Declaration => + Expand_N_Package_Renaming_Declaration (N); - when N_Subprogram_Renaming_Declaration => - Expand_N_Subprogram_Renaming_Declaration (N); + when N_Subprogram_Renaming_Declaration => + Expand_N_Subprogram_Renaming_Declaration (N); - when N_Pragma => - Expand_N_Pragma (N); + when N_Pragma => + Expand_N_Pragma (N); - when N_Procedure_Call_Statement => - Expand_N_Procedure_Call_Statement (N); + when N_Procedure_Call_Statement => + Expand_N_Procedure_Call_Statement (N); - when N_Protected_Type_Declaration => - Expand_N_Protected_Type_Declaration (N); + when N_Protected_Type_Declaration => + Expand_N_Protected_Type_Declaration (N); - when N_Protected_Body => - Expand_N_Protected_Body (N); + when N_Protected_Body => + Expand_N_Protected_Body (N); - when N_Qualified_Expression => - Expand_N_Qualified_Expression (N); + when N_Qualified_Expression => + Expand_N_Qualified_Expression (N); - when N_Quantified_Expression => - Expand_N_Quantified_Expression (N); + when N_Quantified_Expression => + Expand_N_Quantified_Expression (N); - when N_Raise_Statement => - Expand_N_Raise_Statement (N); + when N_Raise_Statement => + Expand_N_Raise_Statement (N); - when N_Raise_Constraint_Error => - Expand_N_Raise_Constraint_Error (N); + when N_Raise_Constraint_Error => + Expand_N_Raise_Constraint_Error (N); - when N_Raise_Expression => - Expand_N_Raise_Expression (N); + when N_Raise_Expression => + Expand_N_Raise_Expression (N); - when N_Raise_Program_Error => - Expand_N_Raise_Program_Error (N); + when N_Raise_Program_Error => + Expand_N_Raise_Program_Error (N); - when N_Raise_Storage_Error => - Expand_N_Raise_Storage_Error (N); + when N_Raise_Storage_Error => + Expand_N_Raise_Storage_Error (N); - when N_Real_Literal => - Expand_N_Real_Literal (N); + when N_Real_Literal => + Expand_N_Real_Literal (N); - when N_Record_Representation_Clause => - Expand_N_Record_Representation_Clause (N); + when N_Record_Representation_Clause => + Expand_N_Record_Representation_Clause (N); - when N_Requeue_Statement => - Expand_N_Requeue_Statement (N); + when N_Requeue_Statement => + Expand_N_Requeue_Statement (N); - when N_Simple_Return_Statement => - Expand_N_Simple_Return_Statement (N); + when N_Simple_Return_Statement => + Expand_N_Simple_Return_Statement (N); - when N_Selected_Component => - Expand_N_Selected_Component (N); + when N_Selected_Component => + Expand_N_Selected_Component (N); - when N_Selective_Accept => - Expand_N_Selective_Accept (N); + when N_Selective_Accept => + Expand_N_Selective_Accept (N); - when N_Single_Task_Declaration => - Expand_N_Single_Task_Declaration (N); + when N_Single_Task_Declaration => + Expand_N_Single_Task_Declaration (N); - when N_Slice => - Expand_N_Slice (N); + when N_Slice => + Expand_N_Slice (N); - when N_Subtype_Indication => - Expand_N_Subtype_Indication (N); + when N_Subtype_Indication => + Expand_N_Subtype_Indication (N); - when N_Subprogram_Body => - Expand_N_Subprogram_Body (N); + when N_Subprogram_Body => + Expand_N_Subprogram_Body (N); - when N_Subprogram_Body_Stub => - Expand_N_Subprogram_Body_Stub (N); + when N_Subprogram_Body_Stub => + Expand_N_Subprogram_Body_Stub (N); - when N_Subprogram_Declaration => - Expand_N_Subprogram_Declaration (N); + when N_Subprogram_Declaration => + Expand_N_Subprogram_Declaration (N); - when N_Task_Body => - Expand_N_Task_Body (N); + when N_Task_Body => + Expand_N_Task_Body (N); - when N_Task_Type_Declaration => - Expand_N_Task_Type_Declaration (N); + when N_Task_Type_Declaration => + Expand_N_Task_Type_Declaration (N); - when N_Timed_Entry_Call => - Expand_N_Timed_Entry_Call (N); + when N_Timed_Entry_Call => + Expand_N_Timed_Entry_Call (N); - when N_Type_Conversion => - Expand_N_Type_Conversion (N); + when N_Type_Conversion => + Expand_N_Type_Conversion (N); - when N_Unchecked_Expression => - Expand_N_Unchecked_Expression (N); + when N_Unchecked_Expression => + Expand_N_Unchecked_Expression (N); - when N_Unchecked_Type_Conversion => - Expand_N_Unchecked_Type_Conversion (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 => diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 971bc39..68300e1 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -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; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 1d39c87..cf44edb 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -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 diff --git a/gcc/ada/init.c b/gcc/ada/init.c index de9b34b..ad80235 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -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). */ diff --git a/gcc/ada/mkdir.c b/gcc/ada/mkdir.c index b8dba59..bdb0fa8 100644 --- a/gcc/ada/mkdir.c +++ b/gcc/ada/mkdir.c @@ -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]; diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb index 9e003e4..d515c01 100644 --- a/gcc/ada/prj-attr.adb +++ b/gcc/ada/prj-attr.adb @@ -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; diff --git a/gcc/ada/prj-attr.ads b/gcc/ada/prj-attr.ads index 5b944f9..e821a82 100644 --- a/gcc/ada/prj-attr.ads +++ b/gcc/ada/prj-attr.ads @@ -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 diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index 6d4a7f1..bc6a566 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -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, diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index bd681d6..1fd71fc 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -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 Single => - case The_Default is - when Read_Only_Value => - null; - - when Empty_Value => - The_Variable.Value := Empty_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 Target_Value => - null; - end case; - - when List => - case The_Default is - when Read_Only_Value => - null; - - when Empty_Value => - The_Variable.Values := Nil_String; - - when Dot_Value => - The_Variable.Values := - Shared.Dot_String_List; - - when Object_Dir_Value | Target_Value => - null; - end case; + when Undefined => + null; + + when Single => + case The_Default is + when Read_Only_Value => + null; + + when Empty_Value => + The_Variable.Value := Empty_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 Target_Value => + null; + end case; + + when List => + case The_Default is + when Read_Only_Value => + null; + + when Empty_Value => + The_Variable.Values := Nil_String; + + when Dot_Value => + The_Variable.Values := + Shared.Dot_String_List; + + 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 => diff --git a/gcc/ada/prj-strt.adb b/gcc/ada/prj-strt.adb index cacae77..c79c199 100644 --- a/gcc/ada/prj-strt.adb +++ b/gcc/ada/prj-strt.adb @@ -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)); diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 8e5914b..88196e1 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -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; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index b44bfa4..1beff66 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -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. diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index 5e8861e..cd76da5 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -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; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index cab75c9..d11b34e 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -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; diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads index c70eb06d..c265221 100644 --- a/gcc/ada/sem_attr.ads +++ b/gcc/ada/sem_attr.ads @@ -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 -- diff --git a/gcc/ada/snames.adb-tmpl b/gcc/ada/snames.adb-tmpl index aafa072..b0b5249 100644 --- a/gcc/ada/snames.adb-tmpl +++ b/gcc/ada/snames.adb-tmpl @@ -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 diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 473a19f..584e58c 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -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, diff --git a/gcc/ada/sysdep.c b/gcc/ada/sysdep.c index 207ef60..3008c78 100644 --- a/gcc/ada/sysdep.c +++ b/gcc/ada/sysdep.c @@ -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__)) -- 2.7.4