+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
* *
* 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- *
#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
Attribute_Class |
Attribute_Compiler_Version |
Attribute_Default_Bit_Order |
+ Attribute_Default_Scalar_Storage_Order |
Attribute_Delta |
Attribute_Denorm |
Attribute_Digits |
-- 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)));
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
-- 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
-- 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
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 =>
("\??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)
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
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;
* Attribute Compiler_Version::
* Attribute Constrained::
* Attribute Default_Bit_Order::
+* Attribute Default_Scalar_Storage_Order::
* Attribute Descriptor_Size::
* Attribute Elaborated::
* Attribute Elab_Body::
* Attribute Compiler_Version::
* Attribute Constrained::
* Attribute Default_Bit_Order::
+* Attribute Default_Scalar_Storage_Order::
* Attribute Descriptor_Size::
* Attribute Elaborated::
* Attribute Elab_Body::
@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
}
#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). */
* *
* 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- *
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];
-- 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'
-- '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 :=
Finish := Start;
while Initialization_Data (Finish) /= '#'
- and then
- Initialization_Data (Finish) /= 'D'
+ and then
+ Initialization_Data (Finish) /= 'D'
loop
Finish := Finish + 1;
end loop;
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
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;
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
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
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
-- 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 " &
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,
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
null;
when Single =>
-
case The_Variable.Kind is
when Undefined =>
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));
-- 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;
-- 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.
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
(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");
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;
with Stand; use Stand;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
+with System;
with Stringt; use Stringt;
with Style;
with Stylesw; use Stylesw;
-----------------------
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 --
--------------
-- 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;
-----------------------
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
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 --
--------------
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;
--
-- 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 --
-- 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)]
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 --
--------------------
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 --
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 =>
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;
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
-- 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.
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 + $;
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 + $;
Attribute_Constrained,
Attribute_Count,
Attribute_Default_Bit_Order,
+ Attribute_Default_Scalar_Storage_Order,
Attribute_Default_Iterator,
Attribute_Definite,
Attribute_Delta,
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,
-- match existing attribute names.
Pragma_CPU,
+ Pragma_Default_Scalar_Storage_Order,
Pragma_Dispatching_Domain,
Pragma_Fast_Math,
Pragma_Interface,
#endif
#include "selectLib.h"
#include "vxWorks.h"
+#include "version.h"
#if defined (__RTP__)
# include "vwModNum.h"
#endif /* __RTP__ */
/* 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__))
projects / platform / upstream / linaro-gcc.git / commitdiff