diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/a-except-2005.adb | 38 | ||||
| -rw-r--r-- | gcc/ada/a-ngcoty.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/a-tags.adb | 75 | ||||
| -rw-r--r-- | gcc/ada/a-tags.ads | 74 | ||||
| -rw-r--r-- | gcc/ada/exp_attr.adb | 107 | ||||
| -rw-r--r-- | gcc/ada/exp_imgv.adb | 425 | ||||
| -rw-r--r-- | gcc/ada/exp_imgv.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/opt.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/par-ch10.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/par-ch2.adb | 36 | ||||
| -rw-r--r-- | gcc/ada/par-ch3.adb | 67 | ||||
| -rw-r--r-- | gcc/ada/par-ch6.adb | 30 | ||||
| -rw-r--r-- | gcc/ada/par-prag.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/par-tchk.adb | 26 | ||||
| -rw-r--r-- | gcc/ada/par-util.adb | 50 | ||||
| -rw-r--r-- | gcc/ada/par.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/s-wchstw.adb | 36 | ||||
| -rw-r--r-- | gcc/ada/s-wchstw.ads | 38 | ||||
| -rw-r--r-- | gcc/ada/s-wwdenu.adb | 72 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 248 | ||||
| -rw-r--r-- | gcc/ada/snames.adb | 27 | ||||
| -rw-r--r-- | gcc/ada/snames.ads | 1558 | ||||
| -rw-r--r-- | gcc/ada/snames.h | 516 |
23 files changed, 2072 insertions, 1427 deletions
diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb index 6af47c3686e..69e6406a634 100644 --- a/gcc/ada/a-except-2005.adb +++ b/gcc/ada/a-except-2005.adb @@ -1359,17 +1359,27 @@ package body Ada.Exceptions is -- Encoding method for source, as exported by binder function Wide_Exception_Name - (Id : Exception_Id) return Wide_String is + (Id : Exception_Id) return Wide_String + is + S : constant String := Exception_Name (Id); + W : Wide_String (1 .. S'Length); + L : Natural; begin - return String_To_Wide_String - (Exception_Name (Id), Get_WC_Encoding_Method (WC_Encoding)); + String_To_Wide_String + (S, W, L, Get_WC_Encoding_Method (WC_Encoding)); + return W (1 .. L); end Wide_Exception_Name; function Wide_Exception_Name - (X : Exception_Occurrence) return Wide_String is + (X : Exception_Occurrence) return Wide_String + is + S : constant String := Exception_Name (X); + W : Wide_String (1 .. S'Length); + L : Natural; begin - return String_To_Wide_String - (Exception_Name (X), Get_WC_Encoding_Method (WC_Encoding)); + String_To_Wide_String + (S, W, L, Get_WC_Encoding_Method (WC_Encoding)); + return W (1 .. L); end Wide_Exception_Name; ---------------------------- @@ -1379,17 +1389,25 @@ package body Ada.Exceptions is function Wide_Wide_Exception_Name (Id : Exception_Id) return Wide_Wide_String is + S : constant String := Exception_Name (Id); + W : Wide_Wide_String (1 .. S'Length); + L : Natural; begin - return String_To_Wide_Wide_String - (Exception_Name (Id), Get_WC_Encoding_Method (WC_Encoding)); + String_To_Wide_Wide_String + (S, W, L, Get_WC_Encoding_Method (WC_Encoding)); + return W (1 .. L); end Wide_Wide_Exception_Name; function Wide_Wide_Exception_Name (X : Exception_Occurrence) return Wide_Wide_String is + S : constant String := Exception_Name (X); + W : Wide_Wide_String (1 .. S'Length); + L : Natural; begin - return String_To_Wide_Wide_String - (Exception_Name (X), Get_WC_Encoding_Method (WC_Encoding)); + String_To_Wide_Wide_String + (S, W, L, Get_WC_Encoding_Method (WC_Encoding)); + return W (1 .. L); end Wide_Wide_Exception_Name; -------------------------- diff --git a/gcc/ada/a-ngcoty.adb b/gcc/ada/a-ngcoty.adb index 548f2d671ee..502a47d15cc 100644 --- a/gcc/ada/a-ngcoty.adb +++ b/gcc/ada/a-ngcoty.adb @@ -52,16 +52,18 @@ package body Ada.Numerics.Generic_Complex_Types is X := Left.Re * Right.Re - Left.Im * Right.Im; Y := Left.Re * Right.Im + Left.Im * Right.Re; - -- If either component overflows, try to scale + -- If either component overflows, try to scale (skip in fast math mode) - if abs (X) > R'Last then - X := R'(4.0) * (R'(Left.Re / 2.0) * R'(Right.Re / 2.0) - - R'(Left.Im / 2.0) * R'(Right.Im / 2.0)); - end if; + if not Standard'Fast_Math then + if abs (X) > R'Last then + X := R'(4.0) * (R'(Left.Re / 2.0) * R'(Right.Re / 2.0) + - R'(Left.Im / 2.0) * R'(Right.Im / 2.0)); + end if; - if abs (Y) > R'Last then - Y := R'(4.0) * (R'(Left.Re / 2.0) * R'(Right.Im / 2.0) - - R'(Left.Im / 2.0) * R'(Right.Re / 2.0)); + if abs (Y) > R'Last then + Y := R'(4.0) * (R'(Left.Re / 2.0) * R'(Right.Im / 2.0) + - R'(Left.Im / 2.0) * R'(Right.Re / 2.0)); + end if; end if; return (X, Y); @@ -143,7 +145,6 @@ package body Ada.Numerics.Generic_Complex_Types is -- 1.0 / infinity, and the closest model number will be zero. begin - while Exp /= 0 loop if Exp rem 2 /= 0 then Result := Result * Factor; @@ -156,7 +157,6 @@ package body Ada.Numerics.Generic_Complex_Types is return R'(1.0) / Result; exception - when Constraint_Error => return (0.0, 0.0); end; diff --git a/gcc/ada/a-tags.adb b/gcc/ada/a-tags.adb index 47e76ffac3e..522a826fc06 100644 --- a/gcc/ada/a-tags.adb +++ b/gcc/ada/a-tags.adb @@ -318,6 +318,21 @@ package body Ada.Tags is return This - Offset_To_Top (This); end Base_Address; + -------------------- + -- Descendant_Tag -- + -------------------- + + function Descendant_Tag (External : String; Ancestor : Tag) return Tag is + Int_Tag : constant Tag := Internal_Tag (External); + + begin + if not Is_Descendant_At_Same_Level (Int_Tag, Ancestor) then + raise Tag_Error; + end if; + + return Int_Tag; + end Descendant_Tag; + -------------- -- Displace -- -------------- @@ -434,21 +449,6 @@ package body Ada.Tags is return False; end IW_Membership; - -------------------- - -- Descendant_Tag -- - -------------------- - - function Descendant_Tag (External : String; Ancestor : Tag) return Tag is - Int_Tag : constant Tag := Internal_Tag (External); - - begin - if not Is_Descendant_At_Same_Level (Int_Tag, Ancestor) then - raise Tag_Error; - end if; - - return Int_Tag; - end Descendant_Tag; - ------------------- -- Expanded_Name -- ------------------- @@ -846,6 +846,35 @@ package body Ada.Tags is External_Tag_HTable.Set (T); end Register_Tag; + ------------------- + -- Secondary_Tag -- + ------------------- + + function Secondary_Tag (T, Iface : Tag) return Tag is + Iface_Table : Interface_Data_Ptr; + Obj_DT : Dispatch_Table_Ptr; + + begin + if not Is_Primary_DT (T) then + raise Program_Error; + end if; + + Obj_DT := DT (T); + Iface_Table := To_Type_Specific_Data_Ptr (Obj_DT.TSD).Interfaces_Table; + + if Iface_Table /= null then + for Id in 1 .. Iface_Table.Nb_Ifaces loop + if Iface_Table.Ifaces_Table (Id).Iface_Tag = Iface then + return Iface_Table.Ifaces_Table (Id).Secondary_DT; + end if; + end loop; + end if; + + -- If the object does not implement the interface we must raise CE + + raise Constraint_Error with "invalid interface conversion"; + end Secondary_Tag; + --------------------- -- Set_Entry_Index -- --------------------- @@ -948,9 +977,13 @@ package body Ada.Tags is -- Encoding method for source, as exported by binder function Wide_Expanded_Name (T : Tag) return Wide_String is + S : constant String := Expanded_Name (T); + W : Wide_String (1 .. S'Length); + L : Natural; begin - return String_To_Wide_String - (Expanded_Name (T), Get_WC_Encoding_Method (WC_Encoding)); + String_To_Wide_String + (S, W, L, Get_WC_Encoding_Method (WC_Encoding)); + return W (1 .. L); end Wide_Expanded_Name; ----------------------------- @@ -958,9 +991,13 @@ package body Ada.Tags is ----------------------------- function Wide_Wide_Expanded_Name (T : Tag) return Wide_Wide_String is + S : constant String := Expanded_Name (T); + W : Wide_Wide_String (1 .. S'Length); + L : Natural; begin - return String_To_Wide_Wide_String - (Expanded_Name (T), Get_WC_Encoding_Method (WC_Encoding)); + String_To_Wide_Wide_String + (S, W, L, Get_WC_Encoding_Method (WC_Encoding)); + return W (1 .. L); end Wide_Wide_Expanded_Name; end Ada.Tags; diff --git a/gcc/ada/a-tags.ads b/gcc/ada/a-tags.ads index 6630743dcca..1fc31e8a233 100644 --- a/gcc/ada/a-tags.ads +++ b/gcc/ada/a-tags.ads @@ -122,25 +122,23 @@ private -- Structure of the GNAT Secondary Dispatch Table - -- +-----------------------+ - -- | table of | - -- : predefined primitive : - -- | ops pointers | - -- +-----------------------+ - -- | Signature | - -- +-----------------------+ - -- | Tagged_Kind | - -- +-----------------------+ - -- | Offset_To_Top | - -- +-----------------------+ - -- | OSD_Ptr |---> Object Specific Data - -- Tag ---> +-----------------------+ +---------------+ - -- | table of | | num prim ops | - -- : primitive op : +---------------+ - -- | thunk pointers | | table of | - -- +-----------------------+ + primitive | - -- | op offsets | - -- +---------------+ + -- +--------------------+ + -- | Signature | + -- +--------------------+ + -- | Tagged_Kind | + -- +--------------------+ Predef Prims + -- | Predef_Prims -----------------------------> +------------+ + -- +--------------------+ | table of | + -- | Offset_To_Top | | predefined | + -- +--------------------+ | primitives | + -- | OSD_Ptr |---> Object Specific Data | thunks | + -- Tag ---> +--------------------+ +---------------+ +------------+ + -- | table of | | num prim ops | + -- : primitive op : +---------------+ + -- | thunk pointers | | table of | + -- +--------------------+ + primitive | + -- | op offsets | + -- +---------------+ -- The runtime information kept for each tagged type is separated into two -- objects: the Dispatch Table and the Type Specific Data record. @@ -165,12 +163,18 @@ private Static_Offset_To_Top : Boolean; Offset_To_Top_Value : SSE.Storage_Offset; Offset_To_Top_Func : Offset_To_Top_Function_Ptr; + Secondary_DT : Tag; end record; -- If some ancestor of the tagged type has discriminants the field -- Static_Offset_To_Top is False and the field Offset_To_Top_Func -- is used to store the access to the function generated by the -- expander which provides this value; otherwise Static_Offset_To_Top -- is True and such value is stored in the Offset_To_Top_Value field. + -- Secondary_DT references a secondary dispatch table whose contents + -- are pointers to the primitives of the tagged type that cover the + -- interface primitives. Secondary_DT gives support to dispatching + -- calls through interface types associated with Generic Dispatching + -- Constructors. type Interfaces_Array is array (Natural range <>) of Interface_Data_Element; @@ -398,6 +402,11 @@ private -- Ada 2005 (AI-251): Displace "This" to point to the secondary dispatch -- table of T. + function Secondary_Tag (T, Iface : Tag) return Tag; + -- Ada 2005 (AI-251): Given a primary tag T associated with a tagged type + -- Typ, search for the secondary tag of the interface type Iface covered + -- by Typ. + function DT (T : Tag) return Dispatch_Table_Ptr; -- Return the pointer to the TSD record associated with T @@ -495,11 +504,27 @@ private -- Ada 2005 (AI-251): Set the kind of a primitive operation in T's TSD -- table indexed by Position. - Max_Predef_Prims : constant Positive := 15; - -- Number of reserved slots for predefined ada primitives: Size, Alignment, - -- Read, Write, Input, Output, "=", assignment, deep adjust, deep finalize, - -- async select, conditional select, prim_op kind, task_id, and timed - -- select. The compiler checks that this value is correct. + Max_Predef_Prims : constant Positive := 16; + -- Number of reserved slots for the following predefined ada primitives: + -- + -- 1. Size + -- 2. Alignment, + -- 3. Read + -- 4. Write + -- 5. Input + -- 6. Output + -- 7. "=" + -- 8. assignment + -- 9. deep adjust + -- 10. deep finalize + -- 11. async select + -- 12. conditional select + -- 13. prim_op kind + -- 14. task_id + -- 15. dispatching requeue + -- 16. timed select + -- + -- The compiler checks that the value here is correct subtype Predef_Prims_Table is Address_Array (1 .. Max_Predef_Prims); type Predef_Prims_Table_Ptr is access Predef_Prims_Table; @@ -507,4 +532,5 @@ private type Addr_Ptr is access System.Address; pragma No_Strict_Aliasing (Addr_Ptr); + -- Why is this needed ??? end Ada.Tags; diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 4bb8d197a5a..4baf55e7e57 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -129,7 +129,7 @@ package body Exp_Attr is -- operand with overflow checking required. function Get_Index_Subtype (N : Node_Id) return Entity_Id; - -- Used for Last, Last, and Length, when the prefix is an array type, + -- Used for Last, Last, and Length, when the prefix is an array type. -- Obtains the corresponding index subtype. procedure Find_Fat_Info @@ -838,8 +838,12 @@ package body Exp_Attr is -- generate a call to a run-time subprogram that returns the base -- address of the object. + -- This processing is not needed in the VM case, where dispatching + -- issues are taken care of by the virtual machine. + elsif Is_Class_Wide_Type (Etype (Pref)) and then Is_Interface (Etype (Pref)) + and then VM_Target = No_VM and then not (Nkind (Pref) in N_Has_Entity and then Is_Subprogram (Entity (Pref))) then @@ -1923,8 +1927,27 @@ package body Exp_Attr is else Id_Kind := RTE (RO_AT_Task_Id); - Rewrite (N, - Unchecked_Convert_To (Id_Kind, Concurrent_Ref (Pref))); + -- If the prefix is a task interface, the Task_Id is obtained + -- dynamically through a dispatching call, as for other task + -- attributes applied to interfaces. + + if Ada_Version >= Ada_05 + and then Ekind (Etype (Pref)) = E_Class_Wide_Type + and then Is_Interface (Etype (Pref)) + and then Is_Task_Interface (Etype (Pref)) + then + Rewrite (N, + Unchecked_Convert_To (Id_Kind, + Make_Selected_Component (Loc, + Prefix => + New_Copy_Tree (Pref), + Selector_Name => + Make_Identifier (Loc, Name_uDisp_Get_Task_Id)))); + + else + Rewrite (N, + Unchecked_Convert_To (Id_Kind, Concurrent_Ref (Pref))); + end if; end if; Analyze_And_Resolve (N, Id_Kind); @@ -4052,13 +4075,17 @@ package body Exp_Attr is -- Note that Prefix'Address is recursively expanded into a call -- to Base_Address (Obj.Tag) - Rewrite (N, - Make_Explicit_Dereference (Loc, - Unchecked_Convert_To (RTE (RE_Tag_Ptr), - Make_Attribute_Reference (Loc, - Prefix => Relocate_Node (Pref), - Attribute_Name => Name_Address)))); - Analyze_And_Resolve (N, RTE (RE_Tag)); + -- Not needed for VM targets, since all handled by the VM + + if VM_Target = No_VM then + Rewrite (N, + Make_Explicit_Dereference (Loc, + Unchecked_Convert_To (RTE (RE_Tag_Ptr), + Make_Attribute_Reference (Loc, + Prefix => Relocate_Node (Pref), + Attribute_Name => Name_Address)))); + Analyze_And_Resolve (N, RTE (RE_Tag)); + end if; else Rewrite (N, @@ -4581,66 +4608,19 @@ package body Exp_Attr is -- Wide_Image -- ---------------- - -- We expand typ'Wide_Image (X) into - - -- String_To_Wide_String - -- (typ'Image (X), Wide_Character_Encoding_Method) + -- Wide_Image attribute is handled in separate unit Exp_Imgv - -- This works in all cases because String_To_Wide_String converts any - -- wide character escape sequences resulting from the Image call to the - -- proper Wide_Character equivalent - - -- not quite right for typ = Wide_Character ??? - - when Attribute_Wide_Image => Wide_Image : - begin - Rewrite (N, - Make_Function_Call (Loc, - Name => New_Reference_To (RTE (RE_String_To_Wide_String), Loc), - Parameter_Associations => New_List ( - Make_Attribute_Reference (Loc, - Prefix => Pref, - Attribute_Name => Name_Image, - Expressions => Exprs), - - Make_Integer_Literal (Loc, - Intval => Int (Wide_Character_Encoding_Method))))); - - Analyze_And_Resolve (N, Standard_Wide_String); - end Wide_Image; + when Attribute_Wide_Image => + Exp_Imgv.Expand_Wide_Image_Attribute (N); --------------------- -- Wide_Wide_Image -- --------------------- - -- We expand typ'Wide_Wide_Image (X) into - - -- String_To_Wide_Wide_String - -- (typ'Image (X), Wide_Character_Encoding_Method) - - -- This works in all cases because String_To_Wide_Wide_String converts - -- any wide character escape sequences resulting from the Image call to - -- the proper Wide_Character equivalent - - -- not quite right for typ = Wide_Wide_Character ??? - - when Attribute_Wide_Wide_Image => Wide_Wide_Image : - begin - Rewrite (N, - Make_Function_Call (Loc, - Name => New_Reference_To - (RTE (RE_String_To_Wide_Wide_String), Loc), - Parameter_Associations => New_List ( - Make_Attribute_Reference (Loc, - Prefix => Pref, - Attribute_Name => Name_Image, - Expressions => Exprs), - - Make_Integer_Literal (Loc, - Intval => Int (Wide_Character_Encoding_Method))))); + -- Wide_Wide_Image attribute is handled in separate unit Exp_Imgv - Analyze_And_Resolve (N, Standard_Wide_Wide_String); - end Wide_Wide_Image; + when Attribute_Wide_Wide_Image => + Exp_Imgv.Expand_Wide_Wide_Image_Attribute (N); ---------------- -- Wide_Value -- @@ -4935,6 +4915,7 @@ package body Exp_Attr is Attribute_Emax | Attribute_Enabled | Attribute_Epsilon | + Attribute_Fast_Math | Attribute_Has_Access_Values | Attribute_Has_Discriminants | Attribute_Large | diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index 75066208c6d..df3d7e8d33c 100644 --- a/gcc/ada/exp_imgv.adb +++ b/gcc/ada/exp_imgv.adb @@ -155,14 +155,23 @@ package body Exp_Imgv is -- Expand_Image_Attribute -- ---------------------------- - -- For all non-enumeration types, and for enumeration types declared - -- in packages Standard or System, typ'Image (Val) expands into: + -- For all cases other than user defined enumeration types, the scheme + -- is as follows. First we insert the following code: - -- Image_xx (tp (Expr) [, pm]) + -- Snn : String (1 .. rt'Width); + -- Pnn : Natural; + -- Image_xx (tv, Snn, Pnn [,pm]); + -- + -- and then Expr is replaced by Snn (1 .. Pnn) - -- The name xx and type conversion tp (Expr) (called tv below) depend on - -- the root type of Expr. The argument pm is an extra type dependent - -- parameter only used in some cases as follows: + -- In the above expansion: + + -- rt is the root type of the expression + -- tv is the expression with the value, usually a type conversion + -- pm is an extra parameter present in some cases + + -- The following table shows tv, xx, and (if used) pm for the various + -- possible types of the argument: -- For types whose root type is Character -- xx = Character @@ -194,57 +203,103 @@ package body Exp_Imgv is -- pm = Boolean, true if Ada 2005 mode, False otherwise -- For types whose root type is Wide_Wide_Character - -- xx = Wide_Wide_haracter + -- xx = Wide_Wide_Character -- tv = Wide_Wide_Character (Expr) -- For floating-point types -- xx = Floating_Point -- tv = Long_Long_Float (Expr) - -- pm = typ'Digits + -- pm = typ'Digits (typ = subtype of expression) -- For ordinary fixed-point types -- xx = Ordinary_Fixed_Point -- tv = Long_Long_Float (Expr) - -- pm = typ'Aft + -- pm = typ'Aft (typ = subtype of expression) -- For decimal fixed-point types with size = Integer'Size -- xx = Decimal -- tv = Integer (Expr) - -- pm = typ'Scale + -- pm = typ'Scale (typ = subtype of expression) -- For decimal fixed-point types with size > Integer'Size -- xx = Long_Long_Decimal - -- tv = Long_Long_Integer (Expr) - -- pm = typ'Scale - - -- Note: for the decimal fixed-point type cases, the conversion is - -- done literally without scaling (i.e. the actual expression that - -- is generated is Image_xx (tp?(Expr) [, pm]) + -- tv = Long_Long_Integer?(Expr) [convert with no scaling] + -- pm = typ'Scale (typ = subtype of expression) -- For enumeration types other than those declared packages Standard - -- or System, typ'Image (X) expands into: + -- or System, Snn, Pnn, are expanded as above, but the call looks like: + + -- Image_Enumeration_NN (rt'Pos (X), Snn, Pnn, typS, typI'Address) - -- Image_Enumeration_NN (typ'Pos (X), typS, typI'Address) + -- where rt is the root type of the expression, and typS and typI are + -- the entities constructed as described in the spec for the procedure + -- Build_Enumeration_Image_Tables and NN is 32/16/8 depending on the + -- element type of Lit_Indexes. The rewriting of the expression to + -- Snn (1 .. Pnn) then occurs as in the other cases. A special case is + -- when pragma Discard_Names applies, in which case we replace expr by: - -- where typS and typI are the entities constructed as described in - -- the spec for the procedure Build_Enumeration_Image_Tables and NN - -- is 32/16/8 depending on the element type of Lit_Indexes. + -- Missing ??? procedure Expand_Image_Attribute (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Exprs : constant List_Id := Expressions (N); - Pref : constant Node_Id := Prefix (N); - Ptyp : constant Entity_Id := Entity (Pref); - Rtyp : constant Entity_Id := Root_Type (Ptyp); - Expr : constant Node_Id := Relocate_Node (First (Exprs)); - Imid : RE_Id; - Tent : Entity_Id; - Arglist : List_Id; - Func : RE_Id; - Ttyp : Entity_Id; - Func_Ent : Entity_Id; + Loc : constant Source_Ptr := Sloc (N); + Exprs : constant List_Id := Expressions (N); + Pref : constant Node_Id := Prefix (N); + Ptyp : constant Entity_Id := Entity (Pref); + Rtyp : constant Entity_Id := Root_Type (Ptyp); + Expr : constant Node_Id := Relocate_Node (First (Exprs)); + Imid : RE_Id; + Tent : Entity_Id; + Ttyp : Entity_Id; + Proc_Ent : Entity_Id; + Enum_Case : Boolean; + + Arg_List : List_Id; + -- List of arguments for run-time procedure call + + Ins_List : List_Id; + -- List of actions to be inserted + + Snn : constant Entity_Id := + Make_Defining_Identifier (Loc, + Chars => New_Internal_Name ('S')); + + Pnn : constant Entity_Id := + Make_Defining_Identifier (Loc, + Chars => New_Internal_Name ('P')); begin + -- Build declarations of Snn and Pnn to be inserted + + Ins_List := New_List ( + + -- Snn : String (1 .. typ'Width); + + Make_Object_Declaration (Loc, + Defining_Identifier => Snn, + Object_Definition => + Make_Subtype_Indication (Loc, + Subtype_Mark => New_Occurrence_Of (Standard_String, Loc), + Constraint => + Make_Index_Or_Discriminant_Constraint (Loc, + Constraints => New_List ( + Make_Range (Loc, + Low_Bound => Make_Integer_Literal (Loc, 1), + High_Bound => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Rtyp, Loc), + Attribute_Name => Name_Width)))))), + + -- Pnn : Natural; + + Make_Object_Declaration (Loc, + Defining_Identifier => Pnn, + Object_Definition => New_Occurrence_Of (Standard_Natural, Loc))); + + -- Set Imid (RE_Id of procedure to call), and Tent, target for the + -- type conversion of the first argument for all possibilities. + + Enum_Case := False; + if Rtyp = Standard_Boolean then Imid := RE_Image_Boolean; Tent := Rtyp; @@ -315,68 +370,77 @@ package body Exp_Imgv is Attribute_Name => Name_Img)); Analyze_And_Resolve (N, Standard_String); + return; else - -- Here we get the Image of an enumeration type + -- Here for enumeration type case Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp))); if Ttyp = Standard_Integer_8 then - Func := RE_Image_Enumeration_8; + Imid := RE_Image_Enumeration_8; elsif Ttyp = Standard_Integer_16 then - Func := RE_Image_Enumeration_16; + Imid := RE_Image_Enumeration_16; else - Func := RE_Image_Enumeration_32; + Imid := RE_Image_Enumeration_32; end if; - -- Apply a validity check, since it is a bit drastic to - -- get a completely junk image value for an invalid value. + -- Apply a validity check, since it is a bit drastic to get a + -- completely junk image value for an invalid value. if not Expr_Known_Valid (Expr) then Insert_Valid_Check (Expr); end if; - Rewrite (N, - Make_Function_Call (Loc, - Name => New_Occurrence_Of (RTE (Func), Loc), - Parameter_Associations => New_List ( - Make_Attribute_Reference (Loc, - Attribute_Name => Name_Pos, - Prefix => New_Occurrence_Of (Ptyp, Loc), - Expressions => New_List (Expr)), - New_Occurrence_Of (Lit_Strings (Rtyp), Loc), - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Lit_Indexes (Rtyp), Loc), - Attribute_Name => Name_Address)))); - - Analyze_And_Resolve (N, Standard_String); + Enum_Case := True; end if; + end if; - return; + -- Build first argument for call + + if Enum_Case then + Arg_List := New_List ( + Make_Attribute_Reference (Loc, + Attribute_Name => Name_Pos, + Prefix => New_Occurrence_Of (Ptyp, Loc), + Expressions => New_List (Expr))); + + else + Arg_List := New_List (Convert_To (Tent, Expr)); end if; - -- If we fall through, we have one of the cases that is handled by - -- calling one of the System.Img_xx routines and Imid is set to the - -- RE_Id for the function to be called. + -- Append Snn, Pnn arguments - Func_Ent := RTE (Imid); + Append_To (Arg_List, New_Occurrence_Of (Snn, Loc)); + Append_To (Arg_List, New_Occurrence_Of (Pnn, Loc)); - -- If the function entity is empty, that means we have a case in + -- Get entity of procedure to call + + Proc_Ent := RTE (Imid); + + -- If the procedure entity is empty, that means we have a case in -- no run time mode where the operation is not allowed, and an -- appropriate diagnostic has already been issued. - if No (Func_Ent) then + if No (Proc_Ent) then return; end if; - -- Otherwise prepare arguments for run-time call + -- Otherwise complete preparation of arguments for run-time call - Arglist := New_List (Convert_To (Tent, Relocate_Node (Expr))); + -- Add extra arguments for Enumeration case + + if Enum_Case then + Append_To (Arg_List, New_Occurrence_Of (Lit_Strings (Rtyp), Loc)); + Append_To (Arg_List, + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Lit_Indexes (Rtyp), Loc), + Attribute_Name => Name_Address)); -- For floating-point types, append Digits argument - if Is_Floating_Point_Type (Rtyp) then - Append_To (Arglist, + elsif Is_Floating_Point_Type (Rtyp) then + Append_To (Arg_List, Make_Attribute_Reference (Loc, Prefix => New_Reference_To (Ptyp, Loc), Attribute_Name => Name_Digits)); @@ -384,7 +448,7 @@ package body Exp_Imgv is -- For ordinary fixed-point types, append Aft parameter elsif Is_Ordinary_Fixed_Point_Type (Rtyp) then - Append_To (Arglist, + Append_To (Arg_List, Make_Attribute_Reference (Loc, Prefix => New_Reference_To (Ptyp, Loc), Attribute_Name => Name_Aft)); @@ -392,27 +456,45 @@ package body Exp_Imgv is -- For decimal, append Scale and also set to do literal conversion elsif Is_Decimal_Fixed_Point_Type (Rtyp) then - Append_To (Arglist, + Append_To (Arg_List, Make_Attribute_Reference (Loc, Prefix => New_Reference_To (Ptyp, Loc), Attribute_Name => Name_Scale)); - Set_Conversion_OK (First (Arglist)); - Set_Etype (First (Arglist), Tent); + Set_Conversion_OK (First (Arg_List)); + Set_Etype (First (Arg_List), Tent); -- For Wide_Character, append Ada 2005 indication elsif Rtyp = Standard_Wide_Character then - Append_To (Arglist, + Append_To (Arg_List, New_Reference_To (Boolean_Literals (Ada_Version >= Ada_05), Loc)); end if; - Rewrite (N, - Make_Function_Call (Loc, - Name => New_Reference_To (Func_Ent, Loc), - Parameter_Associations => Arglist)); + -- Now append the procedure call to the insert list + + Append_To (Ins_List, + Make_Procedure_Call_Statement (Loc, + Name => New_Reference_To (Proc_Ent, Loc), + Parameter_Associations => Arg_List)); + + -- Insert declarations of Snn, Pnn, and the procedure call. We suppress + -- checks because we are sure that everything is in range at this stage. + + Insert_Actions (N, Ins_List, Suppress => All_Checks); + + -- Final step is to rewrite the expression as a slice and analyze, + -- again with no checks, since we are sure that everything is OK. - Analyze_And_Resolve (N, Standard_String); + Rewrite (N, + Make_Slice (Loc, + Prefix => New_Occurrence_Of (Snn, Loc), + Discrete_Range => + Make_Range (Loc, + Low_Bound => Make_Integer_Literal (Loc, 1), + High_Bound => New_Occurrence_Of (Pnn, Loc)))); + + Analyze_And_Resolve (N, Standard_String, Suppress => All_Checks); end Expand_Image_Attribute; ---------------------------- @@ -662,6 +744,201 @@ package body Exp_Imgv is Analyze_And_Resolve (N, Btyp); end Expand_Value_Attribute; + --------------------------------- + -- Expand_Wide_Image_Attribute -- + --------------------------------- + + -- We expand typ'Wide_Image (X) as follows. First we insert this code: + + -- Rnn : Wide_String (1 .. rt'Wide_Width); + -- Lnn : Natural; + -- String_To_Wide_String + -- (typ'Image (Expr), Rnn, Lnn, Wide_Character_Encoding_Method); + + -- where rt is the root type of the prefix type + + -- Now we replace the Wide_Image reference by + + -- Rnn (1 .. Lnn) + + -- This works in all cases because String_To_Wide_String converts any + -- wide character escape sequences resulting from the Image call to the + -- proper Wide_Character equivalent + + -- not quite right for typ = Wide_Character ??? + + procedure Expand_Wide_Image_Attribute (N : Node_Id) is + Loc : constant Source_Ptr := Sloc (N); + Rtyp : constant Entity_Id := Root_Type (Entity (Prefix (N))); + + Rnn : constant Entity_Id := + Make_Defining_Identifier (Loc, + Chars => New_Internal_Name ('S')); + + Lnn : constant Entity_Id := + Make_Defining_Identifier (Loc, + Chars => New_Internal_Name ('P')); + + begin + Insert_Actions (N, New_List ( + + -- Rnn : Wide_String (1 .. base_typ'Width); + + Make_Object_Declaration (Loc, + Defining_Identifier => Rnn, + Object_Definition => + Make_Subtype_Indication (Loc, + Subtype_Mark => + New_Occurrence_Of (Standard_Wide_String, Loc), + Constraint => + Make_Index_Or_Discriminant_Constraint (Loc, + Constraints => New_List ( + Make_Range (Loc, + Low_Bound => Make_Integer_Literal (Loc, 1), + High_Bound => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Rtyp, Loc), + Attribute_Name => Name_Wide_Width)))))), + + -- Lnn : Natural; + + Make_Object_Declaration (Loc, + Defining_Identifier => Lnn, + Object_Definition => New_Occurrence_Of (Standard_Natural, Loc)), + + -- String_To_Wide_String + -- (typ'Image (X), Rnn, Lnn, Wide_Character_Encoding_Method); + + Make_Procedure_Call_Statement (Loc, + Name => + New_Reference_To (RTE (RE_String_To_Wide_String), Loc), + + Parameter_Associations => New_List ( + Make_Attribute_Reference (Loc, + Prefix => Prefix (N), + Attribute_Name => Name_Image, + Expressions => Expressions (N)), + New_Reference_To (Rnn, Loc), + New_Reference_To (Lnn, Loc), + Make_Integer_Literal (Loc, + Intval => Int (Wide_Character_Encoding_Method))))), + + -- Suppress checks because we know everything is properly in range + + Suppress => All_Checks); + + -- Final step is to rewrite the expression as a slice and analyze, + -- again with no checks, since we are sure that everything is OK. + + Rewrite (N, + Make_Slice (Loc, + Prefix => New_Occurrence_Of (Rnn, Loc), + Discrete_Range => + Make_Range (Loc, + Low_Bound => Make_Integer_Literal (Loc, 1), + High_Bound => New_Occurrence_Of (Lnn, Loc)))); + + Analyze_And_Resolve (N, Standard_Wide_String, Suppress => All_Checks); + end Expand_Wide_Image_Attribute; + + -------------------------------------- + -- Expand_Wide_Wide_Image_Attribute -- + -------------------------------------- + + -- We expand typ'Wide_Wide_Image (X) as follows. First we insert this code: + + -- Rnn : Wide_Wide_String (1 .. rt'Wide_Wide_Width); + -- Lnn : Natural; + -- String_To_Wide_Wide_String + -- (typ'Image (Expr), Rnn, Lnn, Wide_Character_Encoding_Method); + + -- where rt is the root type of the prefix type + + -- Now we replace the Wide_Wide_Image reference by + + -- Rnn (1 .. Lnn) + + -- This works in all cases because String_To_Wide_Wide_String converts any + -- wide character escape sequences resulting from the Image call to the + -- proper Wide_Wide_Character equivalent + + -- not quite right for typ = Wide_Wide_Character ??? + + procedure Expand_Wide_Wide_Image_Attribute (N : Node_Id) is + Loc : constant Source_Ptr := Sloc (N); + Rtyp : constant Entity_Id := Root_Type (Entity (Prefix (N))); + + Rnn : constant Entity_Id := + Make_Defining_Identifier (Loc, + Chars => New_Internal_Name ('S')); + + Lnn : constant Entity_Id := + Make_Defining_Identifier (Loc, + Chars => New_Internal_Name ('P')); + + begin + Insert_Actions (N, New_List ( + + -- Rnn : Wide_Wide_String (1 .. rt'Wide_Wide_Width); + + Make_Object_Declaration (Loc, + Defining_Identifier => Rnn, + Object_Definition => + Make_Subtype_Indication (Loc, + Subtype_Mark => + New_Occurrence_Of (Standard_Wide_Wide_String, Loc), + Constraint => + Make_Index_Or_Discriminant_Constraint (Loc, + Constraints => New_List ( + Make_Range (Loc, + Low_Bound => Make_Integer_Literal (Loc, 1), + High_Bound => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Rtyp, Loc), + Attribute_Name => Name_Wide_Wide_Width)))))), + + -- Lnn : Natural; + + Make_Object_Declaration (Loc, + Defining_Identifier => Lnn, + Object_Definition => New_Occurrence_Of (Standard_Natural, Loc)), + + -- String_To_Wide_Wide_String + -- (typ'Image (X), Rnn, Lnn, Wide_Character_Encoding_Method); + + Make_Procedure_Call_Statement (Loc, + Name => + New_Reference_To (RTE (RE_String_To_Wide_Wide_String), Loc), + + Parameter_Associations => New_List ( + Make_Attribute_Reference (Loc, + Prefix => Prefix (N), + Attribute_Name => Name_Image, + Expressions => Expressions (N)), + New_Reference_To (Rnn, Loc), + New_Reference_To (Lnn, Loc), + Make_Integer_Literal (Loc, + Intval => Int (Wide_Character_Encoding_Method))))), + + -- Suppress checks because we know everything is properly in range + + Suppress => All_Checks); + + -- Final step is to rewrite the expression as a slice and analyze, + -- again with no checks, since we are sure that everything is OK. + + Rewrite (N, + Make_Slice (Loc, + Prefix => New_Occurrence_Of (Rnn, Loc), + Discrete_Range => + Make_Range (Loc, + Low_Bound => Make_Integer_Literal (Loc, 1), + High_Bound => New_Occurrence_Of (Lnn, Loc)))); + + Analyze_And_Resolve + (N, Standard_Wide_Wide_String, Suppress => All_Checks); + end Expand_Wide_Wide_Image_Attribute; + ---------------------------- -- Expand_Width_Attribute -- ---------------------------- diff --git a/gcc/ada/exp_imgv.ads b/gcc/ada/exp_imgv.ads index 913920a730f..27b2452ab4e 100644 --- a/gcc/ada/exp_imgv.ads +++ b/gcc/ada/exp_imgv.ads @@ -73,6 +73,14 @@ package Exp_Imgv is -- This procedure is called from Exp_Attr to expand an occurrence -- of the attribute Image. + procedure Expand_Wide_Image_Attribute (N : Node_Id); + -- This procedure is called from Exp_Attr to expand an occurrence + -- of the attribute Wide_Image. + + procedure Expand_Wide_Wide_Image_Attribute (N : Node_Id); + -- This procedure is called from Exp_Attr to expand an occurrence + -- of the attribute Wide_Wide_Image. + procedure Expand_Value_Attribute (N : Node_Id); -- This procedure is called from Exp_Attr to expand an occurrence -- of the attribute Value. diff --git a/gcc/ada/opt.adb b/gcc/ada/opt.adb index 783481245b2..df1969b4281 100644 --- a/gcc/ada/opt.adb +++ b/gcc/ada/opt.adb @@ -55,6 +55,7 @@ package body Opt is Extensions_Allowed_Config := Extensions_Allowed; External_Name_Exp_Casing_Config := External_Name_Exp_Casing; External_Name_Imp_Casing_Config := External_Name_Imp_Casing; + Fast_Math_Config := Fast_Math; Persistent_BSS_Mode_Config := Persistent_BSS_Mode; Polling_Required_Config := Polling_Required; Use_VADS_Size_Config := Use_VADS_Size; @@ -75,6 +76,7 @@ package body Opt is Extensions_Allowed := Save.Extensions_Allowed; External_Name_Exp_Casing := Save.External_Name_Exp_Casing; External_Name_Imp_Casing := Save.External_Name_Imp_Casing; + Fast_Math := Save.Fast_Math; Persistent_BSS_Mode := Save.Persistent_BSS_Mode; Polling_Required := Save.Polling_Required; Use_VADS_Size := Save.Use_VADS_Size; @@ -95,6 +97,7 @@ package body Opt is Save.Extensions_Allowed := Extensions_Allowed; Save.External_Name_Exp_Casing := External_Name_Exp_Casing; Save.External_Name_Imp_Casing := External_Name_Imp_Casing; + Save.Fast_Math := Fast_Math; Save.Persistent_BSS_Mode := Persistent_BSS_Mode; Save.Polling_Required := Polling_Required; Save.Use_VADS_Size := Use_VADS_Size; @@ -147,11 +150,13 @@ package body Opt is Extensions_Allowed := Extensions_Allowed_Config; External_Name_Exp_Casing := External_Name_Exp_Casing_Config; External_Name_Imp_Casing := External_Name_Imp_Casing_Config; + Fast_Math := Fast_Math_Config; Persistent_BSS_Mode := Persistent_BSS_Mode_Config; Use_VADS_Size := Use_VADS_Size_Config; end if; Exception_Locations_Suppressed := Exception_Locations_Suppressed_Config; + Fast_Math := Fast_Math_Config; Polling_Required := Polling_Required_Config; end Set_Opt_Config_Switches; diff --git a/gcc/ada/par-ch10.adb b/gcc/ada/par-ch10.adb index 5d86633fb0c..8fad13e3532 100644 --- a/gcc/ada/par-ch10.adb +++ b/gcc/ada/par-ch10.adb @@ -180,7 +180,7 @@ package body Ch10 is Item := P_Pragma; if Item = Error - or else Chars (Item) > Last_Configuration_Pragma_Name + or else not Is_Configuration_Pragma_Name (Chars (Item)) then Restore_Scan_State (Scan_State); exit; @@ -587,19 +587,17 @@ package body Ch10 is while Token = Tok_Pragma loop Save_Scan_State (Scan_State); - -- If we are in syntax scan mode allowing multiple units, then - -- start the next unit if we encounter a configuration pragma, - -- or a source reference pragma. We take care not to actually - -- scan the pragma in this case since we don't want it to take - -- effect for the current unit. + -- If we are in syntax scan mode allowing multiple units, then start + -- the next unit if we encounter a configuration pragma, or a source + -- reference pragma. We take care not to actually scan the pragma in + -- this case (we don't want it to take effect for the current unit). if Operating_Mode = Check_Syntax then Scan; -- past Pragma if Token = Tok_Identifier and then - (Token_Name in - First_Pragma_Name .. Last_Configuration_Pragma_Name + (Is_Configuration_Pragma_Name (Token_Name) or else Token_Name = Name_Source_Reference) then Restore_Scan_State (Scan_State); -- to Pragma @@ -1022,9 +1020,9 @@ package body Ch10 is Body_Node := Error; -- in case no good body found Scan; -- past SEPARATE; - T_Left_Paren; + U_Left_Paren; Set_Name (Subunit_Node, P_Qualified_Simple_Name); - T_Right_Paren; + U_Right_Paren; if Token = Tok_Semicolon then Error_Msg_SC ("unexpected semicolon ignored"); diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb index c778ac929bd..697cf86d834 100644 --- a/gcc/ada/par-ch2.adb +++ b/gcc/ada/par-ch2.adb @@ -227,8 +227,7 @@ package body Ch2 is -- will think there are missing bodies, and try to change ; to IS, when -- in fact the bodies ARE present, supplied by these pragmas. - function P_Pragma return Node_Id is - + function P_Pragma (Skipping : Boolean := False) return Node_Id is Interface_Check_Required : Boolean := False; -- Set True if check of pragma INTERFACE is required @@ -259,10 +258,22 @@ package body Ch2 is procedure Skip_Pragma_Semicolon is begin if Token /= Tok_Semicolon then - T_Semicolon; - Resync_Past_Semicolon; + + -- If skipping the pragma, ignore a missing semicolon + + if Skipping then + null; + + -- Otherwise demand a semicolon + + else + T_Semicolon; + end if; + + -- Scan past semicolon if present + else - Scan; -- past semicolon + Scan; end if; end Skip_Pragma_Semicolon; @@ -284,14 +295,14 @@ package body Ch2 is and then Token = Tok_Interface then Pragma_Name := Name_Interface; - Ident_Node := Token_Node; + Ident_Node := Make_Identifier (Token_Ptr, Name_Interface); Scan; -- past INTERFACE else Ident_Node := P_Identifier; - Delete_Node (Ident_Node); end if; Set_Chars (Pragma_Node, Pragma_Name); + Set_Pragma_Identifier (Pragma_Node, Ident_Node); -- See if special INTERFACE/IMPORT check is required @@ -336,10 +347,10 @@ package body Ch2 is Scan; -- past comma end loop; - -- If we have := for pragma Debug, it is worth special casing - -- the error message (it is easy to think of pragma Debug as - -- taking a statement, and an assignment statement is the most - -- likely candidate for this error) + -- If we have := for pragma Debug, it is worth special casing the + -- error message (it is easy to think of pragma Debug as taking a + -- statement, and an assignment statement is the most likely + -- candidate for this error) if Token = Tok_Colon_Equal and then Pragma_Name = Name_Debug then Error_Msg_SC ("argument for pragma Debug must be procedure call"); @@ -394,7 +405,7 @@ package body Ch2 is begin while Token = Tok_Pragma loop Error_Msg_SC ("pragma not allowed here"); - Discard_Junk_Node (P_Pragma); + Discard_Junk_Node (P_Pragma (Skipping => True)); end loop; end P_Pragmas_Misplaced; @@ -469,7 +480,6 @@ package body Ch2 is Identifier_Seen := True; Scan; -- past arrow Set_Chars (Association, Chars (Identifier_Node)); - Delete_Node (Identifier_Node); -- Case of argument with no identifier diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 910d16174fe..381ff922a48 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -174,7 +174,9 @@ package body Ch3 is if Token = Tok_Identifier then -- Ada 2005 (AI-284): Compiling in Ada95 mode we warn that INTERFACE, - -- OVERRIDING, and SYNCHRONIZED are new reserved words. + -- OVERRIDING, and SYNCHRONIZED are new reserved words. Note that + -- in the case where these keywords are misused in Ada 95 mode, + -- this routine will generally not be called at all. if Ada_Version = Ada_95 and then Warn_On_Ada_2005_Compatibility @@ -1128,7 +1130,6 @@ package body Ch3 is Make_Attribute_Reference (Prev_Token_Ptr, Prefix => Prefix, Attribute_Name => Token_Name); - Delete_Node (Token_Node); Scan; -- past type attribute identifier end if; @@ -1279,6 +1280,10 @@ package body Ch3 is -- returns True, otherwise returns False. Includes checking for some -- common error cases. + ------------- + -- No_List -- + ------------- + procedure No_List is begin if Num_Idents > 1 then @@ -1289,6 +1294,10 @@ package body Ch3 is List_OK := False; end No_List; + ---------------------- + -- Token_Is_Renames -- + ---------------------- + function Token_Is_Renames return Boolean is At_Colon : Saved_Scan_State; @@ -1922,7 +1931,6 @@ package body Ch3 is Abstract_Present => Abstract_Present (Typedef_Node), Interface_List => Interface_List (Typedef_Node)); - Delete_Node (Typedef_Node); return Typedecl_Node; -- Derived type definition with record extension part @@ -2715,27 +2723,37 @@ package body Ch3 is Scan_State : Saved_Scan_State; begin - if Token /= Tok_Left_Paren then + -- If <> right now, then this is missing left paren + + if Token = Tok_Box then + U_Left_Paren; + + -- If not <> or left paren, then definitely no box + + elsif Token /= Tok_Left_Paren then return False; + -- Left paren, so might be a box after it + else Save_Scan_State (Scan_State); Scan; -- past the left paren - if Token = Tok_Box then - if Ada_Version = Ada_83 then - Error_Msg_SC ("(Ada 83) unknown discriminant not allowed!"); - end if; - - Scan; -- past the box - T_Right_Paren; -- must be followed by right paren - return True; - - else + if Token /= Tok_Box then Restore_Scan_State (Scan_State); return False; end if; end if; + + -- We are now pointing to the box + + if Ada_Version = Ada_83 then + Error_Msg_SC ("(Ada 83) unknown discriminant not allowed!"); + end if; + + Scan; -- past the box + U_Right_Paren; -- must be followed by right paren + return True; end P_Unknown_Discriminant_Part_Opt; ---------------------------------- @@ -4039,11 +4057,28 @@ package body Ch3 is when Tok_Identifier => Check_Bad_Layout; - P_Identifier_Declarations (Decls, Done, In_Spec); + + -- Special check for misuse of overriding not in Ada 2005 mode + + if Token_Name = Name_Overriding + and then not Next_Token_Is (Tok_Colon) + then + Error_Msg_SC ("overriding indicator is an Ada 2005 extension"); + Error_Msg_SC ("\unit must be compiled with -gnat05 switch"); + + Token := Tok_Overriding; + Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub), Decls); + Done := False; + + -- Normal case, no overriding, or overriding followed by colon + + else + P_Identifier_Declarations (Decls, Done, In_Spec); + end if; -- Ada2005: A subprogram declaration can start with "not" or -- "overriding". In older versions, "overriding" is handled - -- like an identifier, with the appropriate warning. + -- like an identifier, with the appropriate messages. when Tok_Not => Check_Bad_Layout; diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb index 84e16c2e635..fee646514be 100644 --- a/gcc/ada/par-ch6.adb +++ b/gcc/ada/par-ch6.adb @@ -176,7 +176,7 @@ package body Ch6 is Scope.Table (Scope.Last).Ecol := Start_Column; Scope.Table (Scope.Last).Lreq := False; - -- Ada2005: scan leading overriding indicator + -- Ada2005: scan leading NOT OVERRIDING indicator if Token = Tok_Not then Scan; -- past NOT @@ -184,24 +184,41 @@ package body Ch6 is if Token = Tok_Overriding then Scan; -- past OVERRIDING Not_Overriding := True; + + -- Overriding keyword used in non Ada 2005 mode + + elsif Token = Tok_Identifier + and then Token_Name = Name_Overriding + then + Error_Msg_SC ("overriding indicator is an Ada 2005 extension"); + Error_Msg_SC ("\unit must be compiled with -gnat05 switch"); + Scan; -- past Overriding + Not_Overriding := True; + else Error_Msg_SC ("OVERRIDING expected!"); end if; + -- Ada 2005: scan leading OVERRIDING indicator + + -- Note: in the case of OVERRIDING keyword used in Ada 95 mode, the + -- declaration circuit already gave an error message and changed the + -- tokem to Tok_Overriding. + elsif Token = Tok_Overriding then Scan; -- past OVERRIDING Is_Overriding := True; end if; if (Is_Overriding or else Not_Overriding) then - if Ada_Version < Ada_05 then - Error_Msg_SP (" overriding indicator is an Ada 2005 extension"); - Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); + + -- Note that if we are not in Ada_05 mode, error messages have + -- already been given, so no need to give another message here. -- An overriding indicator is allowed for subprogram declarations, -- bodies, renamings, stubs, and instantiations. - elsif Pf_Flags /= Pf_Decl_Gins_Pbod_Rnam_Stub then + if Pf_Flags /= Pf_Decl_Gins_Pbod_Rnam_Stub then Error_Msg_SC ("overriding indicator not allowed here!"); elsif Token /= Tok_Function @@ -1000,7 +1017,8 @@ package body Ch6 is Specification_Loop : loop begin if Token = Tok_Pragma then - P_Pragmas_Misplaced; + Error_Msg_SC ("pragma not allowed in formal part"); + Discard_Junk_Node (P_Pragma (Skipping => True)); end if; Ignore (Tok_Left_Paren); diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index d51ed2ec20b..2114fd9c986 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1028,7 +1028,7 @@ begin end; else - raise Constraint_Error; + raise Constraint_Error; end if; exception @@ -1089,9 +1089,12 @@ begin Pragma_Extend_System | Pragma_External | Pragma_External_Name_Casing | + Pragma_Favor_Top_Level | + Pragma_Fast_Math | Pragma_Finalize_Storage_Only | Pragma_Float_Representation | Pragma_Ident | + Pragma_Implemented_By_Entry | Pragma_Implicit_Packing | Pragma_Import | Pragma_Import_Exception | diff --git a/gcc/ada/par-tchk.adb b/gcc/ada/par-tchk.adb index 6b8c46d2018..3d45932c49f 100644 --- a/gcc/ada/par-tchk.adb +++ b/gcc/ada/par-tchk.adb @@ -790,6 +790,32 @@ package body Tchk is end if; end TF_Use; + ------------------ + -- U_Left_Paren -- + ------------------ + + procedure U_Left_Paren is + begin + if Token = Tok_Left_Paren then + Scan; + else + Error_Msg_AP ("missing ""(""!"); + end if; + end U_Left_Paren; + + ------------------- + -- U_Right_Paren -- + ------------------- + + procedure U_Right_Paren is + begin + if Token = Tok_Right_Paren then + Scan; + else + Error_Msg_AP ("missing "")""!"); + end if; + end U_Right_Paren; + ----------------- -- Wrong_Token -- ----------------- diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb index d252922116d..e4b690f1788 100644 --- a/gcc/ada/par-util.adb +++ b/gcc/ada/par-util.adb @@ -23,9 +23,10 @@ -- -- ------------------------------------------------------------------------------ -with Csets; use Csets; -with Stylesw; use Stylesw; -with Uintp; use Uintp; +with Csets; use Csets; +with Namet.Sp; use Namet.Sp; +with Stylesw; use Stylesw; +with Uintp; use Uintp; with GNAT.Spelling_Checker; use GNAT.Spelling_Checker; @@ -587,6 +588,21 @@ package body Util is end Merge_Identifier; ------------------- + -- Next_Token_Is -- + ------------------- + + function Next_Token_Is (Tok : Token_Type) return Boolean is + Scan_State : Saved_Scan_State; + Result : Boolean; + begin + Save_Scan_State (Scan_State); + Scan; + Result := (Token = Tok); + Restore_Scan_State (Scan_State); + return Result; + end Next_Token_Is; + + ------------------- -- No_Constraint -- ------------------- @@ -677,27 +693,15 @@ package body Util is -- Check for possible misspelling - Get_Name_String (Token_Name); - - declare - AN : constant String := Name_Buffer (1 .. Name_Len); - - begin - Error_Msg_Name_1 := First_Attribute_Name; - while Error_Msg_Name_1 <= Last_Attribute_Name loop - Get_Name_String (Error_Msg_Name_1); - - if Is_Bad_Spelling_Of - (AN, Name_Buffer (1 .. Name_Len)) - then - Error_Msg_N - ("\possible misspelling of %", Token_Node); - exit; - end if; + Error_Msg_Name_1 := First_Attribute_Name; + while Error_Msg_Name_1 <= Last_Attribute_Name loop + if Is_Bad_Spelling_Of (Token_Name, Error_Msg_Name_1) then + Error_Msg_N ("\possible misspelling of %", Token_Node); + exit; + end if; - Error_Msg_Name_1 := Error_Msg_Name_1 + 1; - end loop; - end; + Error_Msg_Name_1 := Error_Msg_Name_1 + 1; + end loop; end Signal_Bad_Attribute; ----------------------------- diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index 9b9208ff168..e75051002eb 100644 --- a/gcc/ada/par.adb +++ b/gcc/ada/par.adb @@ -530,7 +530,10 @@ is ------------- package Ch2 is - function P_Pragma return Node_Id; + function P_Pragma (Skipping : Boolean := False) return Node_Id; + -- Scan out a pragma. If Skipping is True, then the caller is skipping + -- the pragma in the context of illegal placement (this is used to avoid + -- some junk cascaded messages). function P_Identifier (C : Id_Check := None) return Node_Id; -- Scans out an identifier. The parameter C determines the treatment @@ -965,7 +968,7 @@ is procedure T_When; procedure T_With; - -- Procedures have names of the form TF_xxx, where Tok_xxx is a token + -- Procedures having names of the form TF_xxx, where Tok_xxx is a token -- name check that the current token matches the required token, and -- if so, scan past it. If not, an error message is issued indicating -- that the required token is not present (xxx expected). @@ -987,6 +990,13 @@ is procedure TF_Semicolon; procedure TF_Then; procedure TF_Use; + + -- Procedures with names of the form U_xxx, where Tok_xxx is a token + -- name, are just like the corresponding T_xxx procedures except that + -- an error message, if given, is unconditional. + + procedure U_Left_Paren; + procedure U_Right_Paren; end Tchk; -------------- @@ -1085,6 +1095,10 @@ is -- conditions are met, an error message is issued, and the merge is -- carried out, modifying the Chars field of Prev. + function Next_Token_Is (Tok : Token_Type) return Boolean; + -- Looks at token after current one and returns True if the token type + -- matches Tok. The scan is unconditionally restored on return. + procedure No_Constraint; -- Called in a place where no constraint is allowed, but one might -- appear due to a common error (e.g. after the type mark in a procedure @@ -1242,7 +1256,7 @@ begin -- Give error if bad pragma - if Chars (P_Node) > Last_Configuration_Pragma_Name + if not Is_Configuration_Pragma_Name (Chars (P_Node)) and then Chars (P_Node) /= Name_Source_Reference then if Is_Pragma_Name (Chars (P_Node)) then diff --git a/gcc/ada/s-wchstw.adb b/gcc/ada/s-wchstw.adb index 2f09ba25e61..33f6674c6cb 100644 --- a/gcc/ada/s-wchstw.adb +++ b/gcc/ada/s-wchstw.adb @@ -121,18 +121,20 @@ package body System.WCh_StW is -- String_To_Wide_String -- --------------------------- - function String_To_Wide_String + procedure String_To_Wide_String (S : String; - EM : WC_Encoding_Method) return Wide_String + R : out Wide_String; + L : out Natural; + EM : System.WCh_Con.WC_Encoding_Method) is - R : Wide_String (1 .. S'Length); - RP : Natural; SP : Natural; V : UTF_32_Code; begin + pragma Assert (S'First = 1); + SP := S'First; - RP := 0; + L := 0; while SP <= S'Last loop Get_Next_Code (S, SP, V, EM); @@ -141,36 +143,34 @@ package body System.WCh_StW is with "out of range value for wide character"; end if; - RP := RP + 1; - R (RP) := Wide_Character'Val (V); + L := L + 1; + R (L) := Wide_Character'Val (V); end loop; - - return R (1 .. RP); end String_To_Wide_String; -------------------------------- -- String_To_Wide_Wide_String -- -------------------------------- - function String_To_Wide_Wide_String + procedure String_To_Wide_Wide_String (S : String; - EM : WC_Encoding_Method) return Wide_Wide_String + R : out Wide_Wide_String; + L : out Natural; + EM : System.WCh_Con.WC_Encoding_Method) is - R : Wide_Wide_String (1 .. S'Length); - RP : Natural; + pragma Assert (S'First = 1); + SP : Natural; V : UTF_32_Code; begin SP := S'First; - RP := 0; + L := 0; while SP <= S'Last loop Get_Next_Code (S, SP, V, EM); - RP := RP + 1; - R (RP) := Wide_Wide_Character'Val (V); + L := L + 1; + R (L) := Wide_Wide_Character'Val (V); end loop; - - return R (1 .. RP); end String_To_Wide_Wide_String; end System.WCh_StW; diff --git a/gcc/ada/s-wchstw.ads b/gcc/ada/s-wchstw.ads index b965e2fce52..7bd3529586d 100644 --- a/gcc/ada/s-wchstw.ads +++ b/gcc/ada/s-wchstw.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -32,33 +32,39 @@ ------------------------------------------------------------------------------ -- This package contains the routine used to convert strings to wide (wide) --- strings for use by wide (wide) character attributes (value, image etc.) +-- strings for use by wide (wide) image attribute. with System.WCh_Con; package System.WCh_StW is pragma Pure; - function String_To_Wide_String + procedure String_To_Wide_String (S : String; - EM : System.WCh_Con.WC_Encoding_Method) return Wide_String; + R : out Wide_String; + L : out Natural; + EM : System.WCh_Con.WC_Encoding_Method); -- This routine simply takes its argument and converts it to wide string - -- format. In the context of the Wide_Image attribute, the argument is - -- the corresponding 'Image attribute. Any wide character escape sequences - -- in the string are converted to the corresponding wide character value. - -- No syntax checks are made, it is assumed that any such sequences are - -- validly formed (this must be assured by the caller), and results from - -- the fact that Wide_Image is only used on strings that have been built - -- by the compiler, such as images of enumeration literals. If the method - -- for encoding is a shift-in, shift-out convention, then it is assumed - -- that normal (non-wide character) mode holds at the start and end of - -- the argument string. EM indicates the wide character encoding method. + -- format, storing the result in R (1 .. L), with L being set appropriately + -- on return. The caller guarantees that R is long enough to accomodate the + -- result. This is used in the context of the Wide_Image attribute, where + -- the argument is the corresponding 'Image attribute. Any wide character + -- escape sequences in the string are converted to the corresponding wide + -- character value. No syntax checks are made, it is assumed that any such + -- sequences are validly formed (this must be assured by the caller), and + -- results from the fact that Wide_Image is only used on strings that have + -- been built by the compiler, such as images of enumeration literals. If + -- the method for encoding is a shift-in, shift-out convention, then it is + -- assumed that normal (non-wide character) mode holds at the start and end + -- of the argument string. EM indicates the wide character encoding method. -- Note: in the WCEM_Brackets case, the brackets escape sequence is used -- only for codes greater than 16#FF#. - function String_To_Wide_Wide_String + procedure String_To_Wide_Wide_String (S : String; - EM : System.WCh_Con.WC_Encoding_Method) return Wide_Wide_String; + R : out Wide_Wide_String; + L : out Natural; + EM : System.WCh_Con.WC_Encoding_Method); -- Same function with Wide_Wide_String output end System.WCh_StW; diff --git a/gcc/ada/s-wwdenu.adb b/gcc/ada/s-wwdenu.adb index f79b62b2524..47848c549f4 100644 --- a/gcc/ada/s-wwdenu.adb +++ b/gcc/ada/s-wwdenu.adb @@ -63,12 +63,14 @@ package body System.WWd_Enum is W := 0; for J in Lo .. Hi loop declare - WS : constant Wide_Wide_String := - String_To_Wide_Wide_String - (Names (Natural (IndexesT (J)) .. - Natural (IndexesT (J + 1)) - 1), EM); + S : constant String := + Names (Natural (IndexesT (J)) .. + Natural (IndexesT (J + 1)) - 1); + WS : Wide_Wide_String (1 .. S'Length); + L : Natural; begin - W := Natural'Max (W, WS'Length); + String_To_Wide_Wide_String (S, WS, L, EM); + W := Natural'Max (W, L); end; end loop; @@ -100,12 +102,14 @@ package body System.WWd_Enum is W := 0; for J in Lo .. Hi loop declare - WS : constant Wide_Wide_String := - String_To_Wide_Wide_String - (Names (Natural (IndexesT (J)) .. - Natural (IndexesT (J + 1)) - 1), EM); + S : constant String := + Names (Natural (IndexesT (J)) .. + Natural (IndexesT (J + 1)) - 1); + WS : Wide_Wide_String (1 .. S'Length); + L : Natural; begin - W := Natural'Max (W, WS'Length); + String_To_Wide_Wide_String (S, WS, L, EM); + W := Natural'Max (W, L); end; end loop; @@ -137,12 +141,14 @@ package body System.WWd_Enum is W := 0; for J in Lo .. Hi loop declare - WS : constant Wide_Wide_String := - String_To_Wide_Wide_String - (Names (Natural (IndexesT (J)) .. - Natural (IndexesT (J + 1)) - 1), EM); + S : constant String := + Names (Natural (IndexesT (J)) .. + Natural (IndexesT (J + 1)) - 1); + WS : Wide_Wide_String (1 .. S'Length); + L : Natural; begin - W := Natural'Max (W, WS'Length); + String_To_Wide_Wide_String (S, WS, L, EM); + W := Natural'Max (W, L); end; end loop; @@ -174,12 +180,14 @@ package body System.WWd_Enum is W := 0; for J in Lo .. Hi loop declare - WS : constant Wide_String := - String_To_Wide_String - (Names (Natural (IndexesT (J)) .. - Natural (IndexesT (J + 1)) - 1), EM); + S : constant String := + Names (Natural (IndexesT (J)) .. + Natural (IndexesT (J + 1)) - 1); + WS : Wide_String (1 .. S'Length); + L : Natural; begin - W := Natural'Max (W, WS'Length); + String_To_Wide_String (S, WS, L, EM); + W := Natural'Max (W, L); end; end loop; @@ -211,12 +219,14 @@ package body System.WWd_Enum is W := 0; for J in Lo .. Hi loop declare - WS : constant Wide_String := - String_To_Wide_String - (Names (Natural (IndexesT (J)) .. - Natural (IndexesT (J + 1)) - 1), EM); + S : constant String := + Names (Natural (IndexesT (J)) .. + Natural (IndexesT (J + 1)) - 1); + WS : Wide_String (1 .. S'Length); + L : Natural; begin - W := Natural'Max (W, WS'Length); + String_To_Wide_String (S, WS, L, EM); + W := Natural'Max (W, L); end; end loop; @@ -248,12 +258,14 @@ package body System.WWd_Enum is W := 0; for J in Lo .. Hi loop declare - WS : constant Wide_String := - String_To_Wide_String - (Names (Natural (IndexesT (J)) .. - Natural (IndexesT (J + 1)) - 1), EM); + S : constant String := + Names (Natural (IndexesT (J)) .. + Natural (IndexesT (J + 1)) - 1); + WS : Wide_String (1 .. S'Length); + L : Natural; begin - W := Natural'Max (W, WS'Length); + String_To_Wide_String (S, WS, L, EM); + W := Natural'Max (W, L); end; end loop; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 8195c8bc8ad..7432a3bd04c 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -41,6 +41,7 @@ with Lib; use Lib; with Lib.Writ; use Lib.Writ; with Lib.Xref; use Lib.Xref; with Namet; use Namet; +with Namet.Sp; use Namet.Sp; with Nlists; use Nlists; with Nmake; use Nmake; with Opt; use Opt; @@ -77,8 +78,6 @@ with Uintp; use Uintp; with Urealp; use Urealp; with Validsw; use Validsw; -with GNAT.Spelling_Checker; use GNAT.Spelling_Checker; - package body Sem_Prag is ---------------------------------------------- @@ -91,12 +90,12 @@ package body Sem_Prag is -- form and processing: -- pragma Export_xxx - -- [Internal =>] LOCAL_NAME, + -- [Internal =>] LOCAL_NAME -- [, [External =>] EXTERNAL_SYMBOL] -- [, other optional parameters ]); -- pragma Import_xxx - -- [Internal =>] LOCAL_NAME, + -- [Internal =>] LOCAL_NAME -- [, [External =>] EXTERNAL_SYMBOL] -- [, other optional parameters ]); @@ -420,7 +419,7 @@ package body Sem_Prag is procedure Error_Pragma (Msg : String); pragma No_Return (Error_Pragma); - -- Outputs error message for current pragma. The message contains an % + -- Outputs error message for current pragma. The message contains a % -- that will be replaced with the pragma name, and the flag is placed -- on the pragma itself. Pragma_Exit is then raised. @@ -1725,8 +1724,7 @@ package body Sem_Prag is for Index1 in Names'Range loop if Is_Bad_Spelling_Of - (Get_Name_String (Chars (Arg)), - Get_Name_String (Names (Index1))) + (Chars (Arg), Names (Index1)) then Error_Msg_Name_1 := Names (Index1); Error_Msg_N ("\possible misspelling of%", Arg); @@ -2267,6 +2265,8 @@ package body Sem_Prag is Error_Pragma ("enumeration literal not allowed for pragma%"); end if; + -- Check for rep item appearing too early or too late + if Etype (E) = Any_Type or else Rep_Item_Too_Early (E, N) then @@ -2353,10 +2353,6 @@ package body Sem_Prag is E1 := Homonym (E1); exit when No (E1) or else Scope (E1) /= Current_Scope; - -- Note: below we are missing a check for Rep_Item_Too_Late. - -- That is deliberate, we cannot chain the rep item on more - -- than one Rep_Item chain, to be fixed later ??? - if Comes_From_Source (E1) and then Comp_Unit = Get_Source_Unit (E1) and then Nkind (Original_Node (Parent (E1))) /= @@ -2821,7 +2817,6 @@ package body Sem_Prag is if Is_Generic_Subprogram (Entity (Arg_Internal)) then Error_Pragma ("pragma% cannot be given for generic subprogram"); - else Error_Pragma ("pragma% does not identify local subprogram"); @@ -3345,7 +3340,8 @@ package body Sem_Prag is -- corresponding body, if there is one present. procedure Set_Inline_Flags (Subp : Entity_Id); - -- Sets Is_Inlined and Has_Pragma_Inline flags for Subp + -- Sets Is_Inlined and Has_Pragma_Inline flags for Subp and also + -- Has_Pragma_Inline_Always for the Inline_Always case. function Inlining_Not_Possible (Subp : Entity_Id) return Boolean; -- Returns True if it can be determined at this stage that inlining @@ -3354,6 +3350,7 @@ package body Sem_Prag is -- get undefined symbols at link time. This function also emits a -- warning if front-end inlining is enabled and the pragma appears -- too late. + -- -- ??? is business with link symbols still valid, or does it relate -- to front end ZCX which is being phased out ??? @@ -3417,7 +3414,16 @@ package body Sem_Prag is Inner_Subp : Entity_Id := Subp; begin + -- Ignore if bad type, avoid cascaded error + if Etype (Subp) = Any_Type then + Applies := True; + return; + + -- Ignore if all inlining is suppressed + + elsif Suppress_All_Inlining then + Applies := True; return; -- If inlining is not possible, for now do not treat as an error @@ -3515,10 +3521,12 @@ package body Sem_Prag is if not Has_Pragma_Inline (Subp) then Set_Has_Pragma_Inline (Subp); - Set_Next_Rep_Item (N, First_Rep_Item (Subp)); - Set_First_Rep_Item (Subp, N); Effective := True; end if; + + if Prag_Id = Pragma_Inline_Always then + Set_Has_Pragma_Inline_Always (Subp); + end if; end Set_Inline_Flags; -- Start of processing for Process_Inline @@ -3565,6 +3573,7 @@ package body Sem_Prag is elsif not Effective and then Warn_On_Redundant_Constructs + and then not Suppress_All_Inlining then if Inlining_Not_Possible (Subp) then Error_Msg_NE @@ -4519,15 +4528,13 @@ package body Sem_Prag is if not Is_Pragma_Name (Chars (N)) then if Warn_On_Unrecognized_Pragma then Error_Msg_Name_1 := Chars (N); - Error_Msg_N ("?unrecognized pragma%!", N); + Error_Msg_N ("?unrecognized pragma%!", Pragma_Identifier (N)); for PN in First_Pragma_Name .. Last_Pragma_Name loop - if Is_Bad_Spelling_Of - (Get_Name_String (Chars (N)), - Get_Name_String (PN)) - then + if Is_Bad_Spelling_Of (Chars (N), PN) then Error_Msg_Name_1 := PN; - Error_Msg_N ("\?possible misspelling of %!", N); + Error_Msg_N + ("\?possible misspelling of %!", Pragma_Identifier (N)); exit; end if; end loop; @@ -4796,6 +4803,7 @@ package body Sem_Prag is when Pragma_Assert => Assert : declare Expr : Node_Id; + Eloc : Source_Ptr; begin Ada_2005_Pragma; @@ -4816,23 +4824,30 @@ package body Sem_Prag is -- null; -- end if; - -- The reason we do this rewriting during semantic analysis - -- rather than as part of normal expansion is that we cannot - -- analyze and expand the code for the boolean expression - -- directly, or it may cause insertion of actions that would - -- escape the attempt to suppress the assertion code. + -- The reason we do this rewriting during semantic analysis rather + -- than as part of normal expansion is that we cannot analyze and + -- expand the code for the boolean expression directly, or it may + -- cause insertion of actions that would escape the attempt to + -- suppress the assertion code. + + -- Note that the Sloc for the if statement corresponds to the + -- argument condition, not the pragma itself. The reason for this + -- is that we may generate a warning if the condition is False at + -- compile time, and we do not want to delete this warning when we + -- delete the if statement. Expr := Expression (Arg1); + Eloc := Sloc (Expr); if Expander_Active and not Assertions_Enabled then Rewrite (N, - Make_If_Statement (Loc, + Make_If_Statement (Eloc, Condition => - Make_And_Then (Loc, - Left_Opnd => New_Occurrence_Of (Standard_False, Loc), + Make_And_Then (Eloc, + Left_Opnd => New_Occurrence_Of (Standard_False, Eloc), Right_Opnd => Expr), Then_Statements => New_List ( - Make_Null_Statement (Loc)))); + Make_Null_Statement (Eloc)))); Analyze (N); @@ -5284,7 +5299,7 @@ package body Sem_Prag is ------------------- -- pragma Common_Object ( - -- [Internal =>] LOCAL_NAME, + -- [Internal =>] LOCAL_NAME -- [, [External =>] EXTERNAL_SYMBOL] -- [, [Size =>] EXTERNAL_SYMBOL]); @@ -5372,8 +5387,8 @@ package body Sem_Prag is or else Etype (Ent) /= Etype (Next_Entity (Ent)) then Error_Pragma_Arg - ("record for pragma% must have two fields of same fpt type", - Arg1); + ("record for pragma% must have two fields of the same " + & "floating-point type", Arg1); else Set_Has_Complex_Representation (Base_Type (E)); @@ -6179,8 +6194,8 @@ package body Sem_Prag is ---------------------- -- pragma Export_Exception ( - -- [Internal =>] LOCAL_NAME, - -- [, [External =>] EXTERNAL_SYMBOL,] + -- [Internal =>] LOCAL_NAME + -- [, [External =>] EXTERNAL_SYMBOL] -- [, [Form =>] Ada | VMS] -- [, [Code =>] static_integer_EXPRESSION]); @@ -6219,8 +6234,8 @@ package body Sem_Prag is --------------------- -- pragma Export_Function ( - -- [Internal =>] LOCAL_NAME, - -- [, [External =>] EXTERNAL_SYMBOL,] + -- [Internal =>] LOCAL_NAME + -- [, [External =>] EXTERNAL_SYMBOL] -- [, [Parameter_Types =>] (PARAMETER_TYPES)] -- [, [Result_Type =>] TYPE_DESIGNATOR] -- [, [Mechanism =>] MECHANISM] @@ -6286,7 +6301,7 @@ package body Sem_Prag is ------------------- -- pragma Export_Object ( - -- [Internal =>] LOCAL_NAME, + -- [Internal =>] LOCAL_NAME -- [, [External =>] EXTERNAL_SYMBOL] -- [, [Size =>] EXTERNAL_SYMBOL]); @@ -6341,8 +6356,8 @@ package body Sem_Prag is ---------------------- -- pragma Export_Procedure ( - -- [Internal =>] LOCAL_NAME, - -- [, [External =>] EXTERNAL_SYMBOL,] + -- [Internal =>] LOCAL_NAME + -- [, [External =>] EXTERNAL_SYMBOL] -- [, [Parameter_Types =>] (PARAMETER_TYPES)] -- [, [Mechanism =>] MECHANISM]); @@ -6419,7 +6434,7 @@ package body Sem_Prag is ----------------------------- -- pragma Export_Valued_Procedure ( - -- [Internal =>] LOCAL_NAME, + -- [Internal =>] LOCAL_NAME -- [, [External =>] EXTERNAL_SYMBOL,] -- [, [Parameter_Types =>] (PARAMETER_TYPES)] -- [, [Mechanism =>] MECHANISM]); @@ -6613,6 +6628,48 @@ package body Sem_Prag is end case; end External_Name_Casing; + -------------------------- + -- Favor_Top_Level -- + -------------------------- + + -- pragma Favor_Top_Level (type_NAME); + + when Pragma_Favor_Top_Level => Favor_Top_Level : declare + Named_Entity : Entity_Id; + + begin + GNAT_Pragma; + Check_No_Identifiers; + Check_Arg_Count (1); + Check_Arg_Is_Local_Name (Arg1); + Named_Entity := Entity (Expression (Arg1)); + + -- If it's an access-to-subprogram type (in particular, not a + -- subtype), set the flag on that type. + + if Ekind (Named_Entity) in Access_Subprogram_Type_Kind then + Set_Can_Use_Internal_Rep (Named_Entity, False); + + -- Otherwise it's an error (name denotes the wrong sort of entity) + + else + Error_Pragma_Arg + ("access-to-subprogram type expected", Expression (Arg1)); + end if; + end Favor_Top_Level; + + --------------- + -- Fast_Math -- + --------------- + + -- pragma Fast_Math; + + when Pragma_Fast_Math => + GNAT_Pragma; + Check_No_Identifiers; + Check_Valid_Configuration_Pragma; + Fast_Math := True; + --------------------------- -- Finalize_Storage_Only -- --------------------------- @@ -6862,6 +6919,46 @@ package body Sem_Prag is end; end Ident; + -------------------------- + -- Implemented_By_Entry -- + -------------------------- + + -- pragma Implemented_By_Entry (DIRECT_NAME); + + when Pragma_Implemented_By_Entry => Implemented_By_Entry : declare + Ent : Entity_Id; + + begin + Ada_2005_Pragma; + Check_Arg_Count (1); + Check_No_Identifiers; + Check_Arg_Is_Identifier (Arg1); + Check_Arg_Is_Local_Name (Arg1); + Ent := Entity (Expression (Arg1)); + + -- Pragma Implemented_By_Entry must be applied only to protected + -- synchronized or task interface primitives. + + if (Ekind (Ent) /= E_Function + and then Ekind (Ent) /= E_Procedure) + or else not Present (First_Formal (Ent)) + or else not Is_Concurrent_Interface (Etype (First_Formal (Ent))) + then + Error_Pragma_Arg + ("pragma % must be applied to a concurrent interface " & + "primitive", Arg1); + + else + if Einfo.Implemented_By_Entry (Ent) + and then Warn_On_Redundant_Constructs + then + Error_Pragma ("?duplicate pragma%!"); + else + Set_Implemented_By_Entry (Ent); + end if; + end if; + end Implemented_By_Entry; + ----------------------- -- Implicit_Packing -- ----------------------- @@ -6878,8 +6975,8 @@ package body Sem_Prag is ------------ -- pragma Import ( - -- [ Convention =>] convention_IDENTIFIER, - -- [ Entity =>] local_NAME + -- [Convention =>] convention_IDENTIFIER, + -- [Entity =>] local_NAME -- [, [External_Name =>] static_string_EXPRESSION ] -- [, [Link_Name =>] static_string_EXPRESSION ]); @@ -6899,8 +6996,8 @@ package body Sem_Prag is ---------------------- -- pragma Import_Exception ( - -- [Internal =>] LOCAL_NAME, - -- [, [External =>] EXTERNAL_SYMBOL,] + -- [Internal =>] LOCAL_NAME + -- [, [External =>] EXTERNAL_SYMBOL] -- [, [Form =>] Ada | VMS] -- [, [Code =>] static_integer_EXPRESSION]); @@ -7012,7 +7109,7 @@ package body Sem_Prag is ------------------- -- pragma Import_Object ( - -- [Internal =>] LOCAL_NAME, + -- [Internal =>] LOCAL_NAME -- [, [External =>] EXTERNAL_SYMBOL] -- [, [Size =>] EXTERNAL_SYMBOL]); @@ -7045,7 +7142,7 @@ package body Sem_Prag is ---------------------- -- pragma Import_Procedure ( - -- [Internal =>] LOCAL_NAME, + -- [Internal =>] LOCAL_NAME -- [, [External =>] EXTERNAL_SYMBOL] -- [, [Parameter_Types =>] (PARAMETER_TYPES)] -- [, [Mechanism =>] MECHANISM] @@ -7108,7 +7205,7 @@ package body Sem_Prag is ----------------------------- -- pragma Import_Valued_Procedure ( - -- [Internal =>] LOCAL_NAME, + -- [Internal =>] LOCAL_NAME -- [, [External =>] EXTERNAL_SYMBOL] -- [, [Parameter_Types =>] (PARAMETER_TYPES)] -- [, [Mechanism =>] MECHANISM] @@ -8070,9 +8167,9 @@ package body Sem_Prag is ----------------------- -- pragma Machine_Attribute ( - -- [Entity =>] LOCAL_NAME, - -- [Attribute_Name =>] static_string_EXPRESSION - -- [,[Info =>] static_string_EXPRESSION] ); + -- [Entity =>] LOCAL_NAME, + -- [Attribute_Name =>] static_string_EXPRESSION + -- [, [Info =>] static_string_EXPRESSION] ); when Pragma_Machine_Attribute => Machine_Attribute : declare Def_Id : Entity_Id; @@ -8282,6 +8379,13 @@ package body Sem_Prag is or else Ekind (E) = E_Generic_Procedure then Set_No_Return (E); + + -- Set flag on any alias as well + + if Is_Overloadable (E) and then Present (Alias (E)) then + Set_No_Return (Alias (E)); + end if; + Found := True; end if; @@ -8550,13 +8654,13 @@ package body Sem_Prag is No_Run_Time_Mode := True; Configurable_Run_Time_Mode := True; - declare - Word32 : constant Boolean := Ttypes.System_Word_Size = 32; - begin - if Word32 then - Duration_32_Bits_On_Target := True; - end if; - end; + -- Set Duration to 32 bits if word size is 32 + + if Ttypes.System_Word_Size = 32 then + Duration_32_Bits_On_Target := True; + end if; + + -- Set appropriate restrictions Set_Restriction (No_Finalization, N); Set_Restriction (No_Exception_Handlers, N); @@ -8744,12 +8848,31 @@ package body Sem_Prag is Check_First_Subtype (Arg1); Ent := Entity (Expression (Arg1)); - if not Is_Private_Type (Ent) then + if not Is_Private_Type (Ent) + and then not Is_Protected_Type (Ent) + then Error_Pragma_Arg - ("pragma % can only be applied to private type", Arg1); + ("pragma % can only be applied to private or protected type", + Arg1); end if; - Set_Known_To_Have_Preelab_Init (Ent); + -- Give an error if the pragma is applied to a protected type that + -- does not qualify (due to having entries, or due to components + -- that do not qualify). + + if Is_Protected_Type (Ent) + and then not Has_Preelaborable_Initialization (Ent) + then + Error_Msg_N + ("protected type & does not have preelaborable " & + "initialization", Ent); + + -- Otherwise mark the type as definitely having preelaborable + -- initialization. + + else + Set_Known_To_Have_Preelab_Init (Ent); + end if; if Has_Pragma_Preelab_Init (Ent) and then Warn_On_Redundant_Constructs @@ -11277,10 +11400,13 @@ package body Sem_Prag is Pragma_Extend_System => -1, Pragma_Extensions_Allowed => -1, Pragma_External => -1, + Pragma_Favor_Top_Level => -1, Pragma_External_Name_Casing => -1, + Pragma_Fast_Math => -1, Pragma_Finalize_Storage_Only => 0, Pragma_Float_Representation => 0, Pragma_Ident => -1, + Pragma_Implemented_By_Entry => -1, Pragma_Implicit_Packing => 0, Pragma_Import => +2, Pragma_Import_Exception => 0, diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb index a6693a73af6..b02f7645154 100644 --- a/gcc/ada/snames.adb +++ b/gcc/ada/snames.adb @@ -93,8 +93,9 @@ package body Snames is "_disp_asynchronous_select#" & "_disp_conditional_select#" & "_disp_get_prim_op_kind#" & - "_disp_timed_select#" & "_disp_get_task_id#" & + "_disp_requeue#" & + "_disp_timed_select#" & "initialize#" & "adjust#" & "finalize#" & @@ -194,6 +195,7 @@ package body Snames is "extend_system#" & "extensions_allowed#" & "external_name_casing#" & + "favor_top_level#" & "float_representation#" & "implicit_packing#" & "initialize_scalars#" & @@ -261,6 +263,7 @@ package body Snames is "external#" & "finalize_storage_only#" & "ident#" & + "implemented_by_entry#" & "import#" & "import_exception#" & "import_function#" & @@ -456,6 +459,7 @@ package body Snames is "epsilon#" & "exponent#" & "external_tag#" & + "fast_math#" & "first#" & "first_bit#" & "fixed_value#" & @@ -569,7 +573,6 @@ package body Snames is "priority_queuing#" & "edf_across_priorities#" & "fifo_within_priorities#" & - "non_preemptive_within_priorities#" & "round_robin_within_priorities#" & "access_check#" & "accessibility_check#" & @@ -927,6 +930,8 @@ package body Snames is begin if N = Name_AST_Entry then return Pragma_AST_Entry; + elsif N = Name_Fast_Math then + return Pragma_Fast_Math; elsif N = Name_Interface then return Pragma_Interface; elsif N = Name_Priority then @@ -955,8 +960,9 @@ package body Snames is -- Get_Task_Dispatching_Policy_Id -- ------------------------------------ - function Get_Task_Dispatching_Policy_Id (N : Name_Id) - return Task_Dispatching_Policy_Id is + function Get_Task_Dispatching_Policy_Id + (N : Name_Id) return Task_Dispatching_Policy_Id + is begin return Task_Dispatching_Policy_Id'Val (N - First_Task_Dispatching_Policy_Name); @@ -972,10 +978,8 @@ package body Snames is begin P_Index := Preset_Names'First; - loop Name_Len := 0; - while Preset_Names (P_Index) /= '#' loop Name_Len := Name_Len + 1; Name_Buffer (Name_Len) := Preset_Names (P_Index); @@ -1024,6 +1028,16 @@ package body Snames is return N in First_Attribute_Name .. Last_Attribute_Name; end Is_Attribute_Name; + ---------------------------------- + -- Is_Configuration_Pragma_Name -- + ---------------------------------- + + 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_Fast_Math; + end Is_Configuration_Pragma_Name; + ------------------------ -- Is_Convention_Name -- ------------------------ @@ -1109,6 +1123,7 @@ package body Snames is begin return N in First_Pragma_Name .. Last_Pragma_Name or else N = Name_AST_Entry + or else N = Name_Fast_Math or else N = Name_Interface or else N = Name_Priority or else N = Name_Storage_Size diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads index f2e7be91568..494e79f1223 100644 --- a/gcc/ada/snames.ads +++ b/gcc/ada/snames.ads @@ -42,6 +42,7 @@ package Snames is -- WARNING: There is a C file, a-snames.h which duplicates some of the -- definitions in this file and must be kept properly synchronized. +-- If you change this package, you should run xsnames. ------------------ -- Preset Names -- @@ -173,142 +174,139 @@ package Snames is Name_uTask_Name : constant Name_Id := N + 030; Name_uTrace_Sp : constant Name_Id := N + 031; - -- Names of routines used in the expansion of asynchronous, conditional - -- and timed dispatching selects. + -- Names of predefined primitives used in the expansion of dispatching + -- requeue and select statements, Abort, 'Callable and 'Terminated. Name_uDisp_Asynchronous_Select : constant Name_Id := N + 032; Name_uDisp_Conditional_Select : constant Name_Id := N + 033; Name_uDisp_Get_Prim_Op_Kind : constant Name_Id := N + 034; - Name_uDisp_Timed_Select : constant Name_Id := N + 035; - - -- Names of routines used in the expansion of Abort, attributes 'Callable - -- and 'Terminated for task interface class-wide types. - - Name_uDisp_Get_Task_Id : constant Name_Id := N + 036; + Name_uDisp_Get_Task_Id : constant Name_Id := N + 035; + Name_uDisp_Requeue : constant Name_Id := N + 036; + Name_uDisp_Timed_Select : constant Name_Id := N + 037; -- Names of routines in Ada.Finalization, needed by expander - Name_Initialize : constant Name_Id := N + 037; - Name_Adjust : constant Name_Id := N + 038; - Name_Finalize : constant Name_Id := N + 039; + Name_Initialize : constant Name_Id := N + 038; + Name_Adjust : constant Name_Id := N + 039; + Name_Finalize : constant Name_Id := N + 040; -- Names of fields declared in System.Finalization_Implementation, -- needed by the expander when generating code for finalization. - Name_Next : constant Name_Id := N + 040; - Name_Prev : constant Name_Id := N + 041; + Name_Next : constant Name_Id := N + 041; + Name_Prev : constant Name_Id := N + 042; -- Names of TSS routines for implementation of DSA over PolyORB - Name_uTypeCode : constant Name_Id := N + 042; - Name_uFrom_Any : constant Name_Id := N + 043; - Name_uTo_Any : constant Name_Id := N + 044; + Name_uTypeCode : constant Name_Id := N + 043; + Name_uFrom_Any : constant Name_Id := N + 044; + Name_uTo_Any : constant Name_Id := N + 045; -- Names of allocation routines, also needed by expander - Name_Allocate : constant Name_Id := N + 045; - Name_Deallocate : constant Name_Id := N + 046; - Name_Dereference : constant Name_Id := N + 047; + Name_Allocate : constant Name_Id := N + 046; + Name_Deallocate : constant Name_Id := N + 047; + Name_Dereference : constant Name_Id := N + 048; -- Names of Text_IO generic subpackages (see Rtsfind.Text_IO_Kludge) - First_Text_IO_Package : constant Name_Id := N + 048; - Name_Decimal_IO : constant Name_Id := N + 048; - Name_Enumeration_IO : constant Name_Id := N + 049; - Name_Fixed_IO : constant Name_Id := N + 050; - Name_Float_IO : constant Name_Id := N + 051; - Name_Integer_IO : constant Name_Id := N + 052; - Name_Modular_IO : constant Name_Id := N + 053; - Last_Text_IO_Package : constant Name_Id := N + 053; + First_Text_IO_Package : constant Name_Id := N + 049; + Name_Decimal_IO : constant Name_Id := N + 049; + Name_Enumeration_IO : constant Name_Id := N + 050; + Name_Fixed_IO : constant Name_Id := N + 051; + Name_Float_IO : constant Name_Id := N + 052; + Name_Integer_IO : constant Name_Id := N + 053; + Name_Modular_IO : constant Name_Id := N + 054; + Last_Text_IO_Package : constant Name_Id := N + 054; subtype Text_IO_Package_Name is Name_Id range First_Text_IO_Package .. Last_Text_IO_Package; -- Some miscellaneous names used for error detection/recovery - Name_Const : constant Name_Id := N + 054; - Name_Error : constant Name_Id := N + 055; - Name_Go : constant Name_Id := N + 056; - Name_Put : constant Name_Id := N + 057; - Name_Put_Line : constant Name_Id := N + 058; - Name_To : constant Name_Id := N + 059; + Name_Const : constant Name_Id := N + 055; + Name_Error : constant Name_Id := N + 056; + Name_Go : constant Name_Id := N + 057; + Name_Put : constant Name_Id := N + 058; + Name_Put_Line : constant Name_Id := N + 059; + Name_To : constant Name_Id := N + 060; -- Names for packages that are treated specially by the compiler - Name_Exception_Traces : constant Name_Id := N + 060; - Name_Finalization : constant Name_Id := N + 061; - Name_Finalization_Root : constant Name_Id := N + 062; - Name_Interfaces : constant Name_Id := N + 063; - Name_Most_Recent_Exception : constant Name_Id := N + 064; - Name_Standard : constant Name_Id := N + 065; - Name_System : constant Name_Id := N + 066; - Name_Text_IO : constant Name_Id := N + 067; - Name_Wide_Text_IO : constant Name_Id := N + 068; - Name_Wide_Wide_Text_IO : constant Name_Id := N + 069; + Name_Exception_Traces : constant Name_Id := N + 061; + Name_Finalization : constant Name_Id := N + 062; + Name_Finalization_Root : constant Name_Id := N + 063; + Name_Interfaces : constant Name_Id := N + 064; + Name_Most_Recent_Exception : constant Name_Id := N + 065; + Name_Standard : constant Name_Id := N + 066; + Name_System : constant Name_Id := N + 067; + Name_Text_IO : constant Name_Id := N + 068; + Name_Wide_Text_IO : constant Name_Id := N + 069; + Name_Wide_Wide_Text_IO : constant Name_Id := N + 070; -- Names of implementations of the distributed systems annex - First_PCS_Name : constant Name_Id := N + 070; - Name_No_DSA : constant Name_Id := N + 070; - Name_GARLIC_DSA : constant Name_Id := N + 071; - Name_PolyORB_DSA : constant Name_Id := N + 072; - Last_PCS_Name : constant Name_Id := N + 072; + First_PCS_Name : constant Name_Id := N + 071; + Name_No_DSA : constant Name_Id := N + 071; + Name_GARLIC_DSA : constant Name_Id := N + 072; + Name_PolyORB_DSA : constant Name_Id := N + 073; + Last_PCS_Name : constant Name_Id := N + 073; subtype PCS_Names is Name_Id range First_PCS_Name .. Last_PCS_Name; -- Names of identifiers used in expanding distribution stubs - Name_Addr : constant Name_Id := N + 073; - Name_Async : constant Name_Id := N + 074; - Name_Get_Active_Partition_ID : constant Name_Id := N + 075; - Name_Get_RCI_Package_Receiver : constant Name_Id := N + 076; - Name_Get_RCI_Package_Ref : constant Name_Id := N + 077; - Name_Origin : constant Name_Id := N + 078; - Name_Params : constant Name_Id := N + 079; - Name_Partition : constant Name_Id := N + 080; - Name_Partition_Interface : constant Name_Id := N + 081; - Name_Ras : constant Name_Id := N + 082; - Name_uCall : constant Name_Id := N + 083; - Name_RCI_Name : constant Name_Id := N + 084; - Name_Receiver : constant Name_Id := N + 085; - Name_Result : constant Name_Id := N + 086; - Name_Rpc : constant Name_Id := N + 087; - Name_Subp_Id : constant Name_Id := N + 088; - Name_Operation : constant Name_Id := N + 089; - Name_Argument : constant Name_Id := N + 090; - Name_Arg_Modes : constant Name_Id := N + 091; - Name_Handler : constant Name_Id := N + 092; - Name_Target : constant Name_Id := N + 093; - Name_Req : constant Name_Id := N + 094; - Name_Obj_TypeCode : constant Name_Id := N + 095; - Name_Stub : constant Name_Id := N + 096; + Name_Addr : constant Name_Id := N + 074; + Name_Async : constant Name_Id := N + 075; + Name_Get_Active_Partition_ID : constant Name_Id := N + 076; + Name_Get_RCI_Package_Receiver : constant Name_Id := N + 077; + Name_Get_RCI_Package_Ref : constant Name_Id := N + 078; + Name_Origin : constant Name_Id := N + 079; + Name_Params : constant Name_Id := N + 080; + Name_Partition : constant Name_Id := N + 081; + Name_Partition_Interface : constant Name_Id := N + 082; + Name_Ras : constant Name_Id := N + 083; + Name_uCall : constant Name_Id := N + 084; + Name_RCI_Name : constant Name_Id := N + 085; + Name_Receiver : constant Name_Id := N + 086; + Name_Result : constant Name_Id := N + 087; + Name_Rpc : constant Name_Id := N + 088; + Name_Subp_Id : constant Name_Id := N + 089; + Name_Operation : constant Name_Id := N + 090; + Name_Argument : constant Name_Id := N + 091; + Name_Arg_Modes : constant Name_Id := N + 092; + Name_Handler : constant Name_Id := N + 093; + Name_Target : constant Name_Id := N + 094; + Name_Req : constant Name_Id := N + 095; + Name_Obj_TypeCode : constant Name_Id := N + 096; + Name_Stub : constant Name_Id := N + 097; -- Operator Symbol entries. The actual names have an upper case O at -- the start in place of the Op_ prefix (e.g. the actual name that -- corresponds to Name_Op_Abs is "Oabs". - First_Operator_Name : constant Name_Id := N + 097; - Name_Op_Abs : constant Name_Id := N + 097; -- "abs" - Name_Op_And : constant Name_Id := N + 098; -- "and" - Name_Op_Mod : constant Name_Id := N + 099; -- "mod" - Name_Op_Not : constant Name_Id := N + 100; -- "not" - Name_Op_Or : constant Name_Id := N + 101; -- "or" - Name_Op_Rem : constant Name_Id := N + 102; -- "rem" - Name_Op_Xor : constant Name_Id := N + 103; -- "xor" - Name_Op_Eq : constant Name_Id := N + 104; -- "=" - Name_Op_Ne : constant Name_Id := N + 105; -- "/=" - Name_Op_Lt : constant Name_Id := N + 106; -- "<" - Name_Op_Le : constant Name_Id := N + 107; -- "<=" - Name_Op_Gt : constant Name_Id := N + 108; -- ">" - Name_Op_Ge : constant Name_Id := N + 109; -- ">=" - Name_Op_Add : constant Name_Id := N + 110; -- "+" - Name_Op_Subtract : constant Name_Id := N + 111; -- "-" - Name_Op_Concat : constant Name_Id := N + 112; -- "&" - Name_Op_Multiply : constant Name_Id := N + 113; -- "*" - Name_Op_Divide : constant Name_Id := N + 114; -- "/" - Name_Op_Expon : constant Name_Id := N + 115; -- "**" - Last_Operator_Name : constant Name_Id := N + 115; + First_Operator_Name : constant Name_Id := N + 098; + Name_Op_Abs : constant Name_Id := N + 098; -- "abs" + Name_Op_And : constant Name_Id := N + 099; -- "and" + Name_Op_Mod : constant Name_Id := N + 100; -- "mod" + Name_Op_Not : constant Name_Id := N + 101; -- "not" + Name_Op_Or : constant Name_Id := N + 102; -- "or" + Name_Op_Rem : constant Name_Id := N + 103; -- "rem" + Name_Op_Xor : constant Name_Id := N + 104; -- "xor" + Name_Op_Eq : constant Name_Id := N + 105; -- "=" + Name_Op_Ne : constant Name_Id := N + 106; -- "/=" + Name_Op_Lt : constant Name_Id := N + 107; -- "<" + Name_Op_Le : constant Name_Id := N + 108; -- "<=" + Name_Op_Gt : constant Name_Id := N + 109; -- ">" + Name_Op_Ge : constant Name_Id := N + 110; -- ">=" + Name_Op_Add : constant Name_Id := N + 111; -- "+" + Name_Op_Subtract : constant Name_Id := N + 112; -- "-" + Name_Op_Concat : constant Name_Id := N + 113; -- "&" + Name_Op_Multiply : constant Name_Id := N + 114; -- "*" + Name_Op_Divide : constant Name_Id := N + 115; -- "/" + Name_Op_Expon : constant Name_Id := N + 116; -- "**" + Last_Operator_Name : constant Name_Id := N + 116; -- Names for all pragmas recognized by GNAT. The entries with the comment -- "Ada 83" are pragmas that are defined in Ada 83, but not in Ada 95. @@ -331,193 +329,203 @@ package Snames is -- only in GNAT for the AAMP. They are ignored in other versions with -- appropriate warnings. - First_Pragma_Name : constant Name_Id := N + 116; + First_Pragma_Name : constant Name_Id := N + 117; -- Configuration pragmas are grouped at start - Name_Ada_83 : constant Name_Id := N + 116; -- GNAT - Name_Ada_95 : constant Name_Id := N + 117; -- GNAT - Name_Ada_05 : constant Name_Id := N + 118; -- GNAT - Name_Ada_2005 : constant Name_Id := N + 119; -- GNAT - Name_Assertion_Policy : constant Name_Id := N + 120; -- Ada 05 - Name_C_Pass_By_Copy : constant Name_Id := N + 121; -- GNAT - Name_Check_Name : constant Name_Id := N + 122; -- GNAT - Name_Compile_Time_Error : constant Name_Id := N + 123; -- GNAT - Name_Compile_Time_Warning : constant Name_Id := N + 124; -- GNAT - Name_Compiler_Unit : constant Name_Id := N + 125; -- GNAT - Name_Component_Alignment : constant Name_Id := N + 126; -- GNAT - Name_Convention_Identifier : constant Name_Id := N + 127; -- GNAT - Name_Debug_Policy : constant Name_Id := N + 128; -- GNAT - Name_Detect_Blocking : constant Name_Id := N + 129; -- Ada 05 - Name_Discard_Names : constant Name_Id := N + 130; - Name_Elaboration_Checks : constant Name_Id := N + 131; -- GNAT - Name_Eliminate : constant Name_Id := N + 132; -- GNAT - Name_Extend_System : constant Name_Id := N + 133; -- GNAT - Name_Extensions_Allowed : constant Name_Id := N + 134; -- GNAT - Name_External_Name_Casing : constant Name_Id := N + 135; -- GNAT - Name_Float_Representation : constant Name_Id := N + 136; -- GNAT - Name_Implicit_Packing : constant Name_Id := N + 137; -- GNAT - Name_Initialize_Scalars : constant Name_Id := N + 138; -- GNAT - Name_Interrupt_State : constant Name_Id := N + 139; -- GNAT - Name_License : constant Name_Id := N + 140; -- GNAT - Name_Locking_Policy : constant Name_Id := N + 141; - Name_Long_Float : constant Name_Id := N + 142; -- VMS - Name_No_Run_Time : constant Name_Id := N + 143; -- GNAT - Name_No_Strict_Aliasing : constant Name_Id := N + 144; -- GNAT - Name_Normalize_Scalars : constant Name_Id := N + 145; - Name_Polling : constant Name_Id := N + 146; -- GNAT - Name_Persistent_BSS : constant Name_Id := N + 147; -- GNAT - Name_Priority_Specific_Dispatching : constant Name_Id := N + 148; -- Ada 05 - Name_Profile : constant Name_Id := N + 149; -- Ada 05 - Name_Profile_Warnings : constant Name_Id := N + 150; -- GNAT - Name_Propagate_Exceptions : constant Name_Id := N + 151; -- GNAT - Name_Queuing_Policy : constant Name_Id := N + 152; - Name_Ravenscar : constant Name_Id := N + 153; -- GNAT - Name_Restricted_Run_Time : constant Name_Id := N + 154; -- GNAT - Name_Restrictions : constant Name_Id := N + 155; - Name_Restriction_Warnings : constant Name_Id := N + 156; -- GNAT - Name_Reviewable : constant Name_Id := N + 157; - Name_Source_File_Name : constant Name_Id := N + 158; -- GNAT - Name_Source_File_Name_Project : constant Name_Id := N + 159; -- GNAT - Name_Style_Checks : constant Name_Id := N + 160; -- GNAT - Name_Suppress : constant Name_Id := N + 161; - Name_Suppress_Exception_Locations : constant Name_Id := N + 162; -- GNAT - Name_Task_Dispatching_Policy : constant Name_Id := N + 163; - Name_Universal_Data : constant Name_Id := N + 164; -- AAMP - Name_Unsuppress : constant Name_Id := N + 165; -- GNAT - Name_Use_VADS_Size : constant Name_Id := N + 166; -- GNAT - Name_Validity_Checks : constant Name_Id := N + 167; -- GNAT - Name_Warnings : constant Name_Id := N + 168; -- GNAT - Name_Wide_Character_Encoding : constant Name_Id := N + 169; -- GNAT - Last_Configuration_Pragma_Name : constant Name_Id := N + 169; + Name_Ada_83 : constant Name_Id := N + 117; -- GNAT + Name_Ada_95 : constant Name_Id := N + 118; -- GNAT + Name_Ada_05 : constant Name_Id := N + 119; -- GNAT + Name_Ada_2005 : constant Name_Id := N + 120; -- GNAT + Name_Assertion_Policy : constant Name_Id := N + 121; -- Ada 05 + Name_C_Pass_By_Copy : constant Name_Id := N + 122; -- GNAT + Name_Check_Name : constant Name_Id := N + 123; -- GNAT + Name_Compile_Time_Error : constant Name_Id := N + 124; -- GNAT + Name_Compile_Time_Warning : constant Name_Id := N + 125; -- GNAT + Name_Compiler_Unit : constant Name_Id := N + 126; -- GNAT + Name_Component_Alignment : constant Name_Id := N + 127; -- GNAT + Name_Convention_Identifier : constant Name_Id := N + 128; -- GNAT + Name_Debug_Policy : constant Name_Id := N + 129; -- GNAT + Name_Detect_Blocking : constant Name_Id := N + 130; -- Ada 05 + Name_Discard_Names : constant Name_Id := N + 131; + Name_Elaboration_Checks : constant Name_Id := N + 132; -- GNAT + Name_Eliminate : constant Name_Id := N + 133; -- GNAT + Name_Extend_System : constant Name_Id := N + 134; -- GNAT + Name_Extensions_Allowed : constant Name_Id := N + 135; -- GNAT + Name_External_Name_Casing : constant Name_Id := N + 136; -- GNAT + Name_Favor_Top_Level : constant Name_Id := N + 137; -- GNAT + + -- Note: Fast_Math is not in this list because its name matches -- GNAT + -- the name of the corresponding attribute. However, it is + -- included in the definition of the type Pragma_Id, and the + -- functions Get_Pragma_Id, Is_[Configuration_]Pragma_Id, and + -- correctly recognize and process Fast_Math. + + Name_Float_Representation : constant Name_Id := N + 138; -- GNAT + Name_Implicit_Packing : constant Name_Id := N + 139; -- GNAT + Name_Initialize_Scalars : constant Name_Id := N + 140; -- GNAT + Name_Interrupt_State : constant Name_Id := N + 141; -- GNAT + Name_License : constant Name_Id := N + 142; -- GNAT + Name_Locking_Policy : constant Name_Id := N + 143; + Name_Long_Float : constant Name_Id := N + 144; -- VMS + Name_No_Run_Time : constant Name_Id := N + 145; -- GNAT + Name_No_Strict_Aliasing : constant Name_Id := N + 146; -- GNAT + Name_Normalize_Scalars : constant Name_Id := N + 147; + Name_Polling : constant Name_Id := N + 148; -- GNAT + Name_Persistent_BSS : constant Name_Id := N + 149; -- GNAT + Name_Priority_Specific_Dispatching : constant Name_Id := N + 150; -- Ada 05 + Name_Profile : constant Name_Id := N + 151; -- Ada 05 + Name_Profile_Warnings : constant Name_Id := N + 152; -- GNAT + Name_Propagate_Exceptions : constant Name_Id := N + 153; -- GNAT + Name_Queuing_Policy : constant Name_Id := N + 154; + Name_Ravenscar : constant Name_Id := N + 155; -- GNAT + Name_Restricted_Run_Time : constant Name_Id := N + 156; -- GNAT + Name_Restrictions : constant Name_Id := N + 157; + Name_Restriction_Warnings : constant Name_Id := N + 158; -- GNAT + Name_Reviewable : constant Name_Id := N + 159; + Name_Source_File_Name : constant Name_Id := N + 160; -- GNAT + Name_Source_File_Name_Project : constant Name_Id := N + 161; -- GNAT + Name_Style_Checks : constant Name_Id := N + 162; -- GNAT + Name_Suppress : constant Name_Id := N + 163; + Name_Suppress_Exception_Locations : constant Name_Id := N + 164; -- GNAT + Name_Task_Dispatching_Policy : constant Name_Id := N + 165; + Name_Universal_Data : constant Name_Id := N + 166; -- AAMP + Name_Unsuppress : constant Name_Id := N + 167; -- GNAT + Name_Use_VADS_Size : constant Name_Id := N + 168; -- GNAT + Name_Validity_Checks : constant Name_Id := N + 169; -- GNAT + Name_Warnings : constant Name_Id := N + 170; -- GNAT + Name_Wide_Character_Encoding : constant Name_Id := N + 171; -- GNAT + Last_Configuration_Pragma_Name : constant Name_Id := N + 171; -- Remaining pragma names - Name_Abort_Defer : constant Name_Id := N + 170; -- GNAT - Name_All_Calls_Remote : constant Name_Id := N + 171; - Name_Annotate : constant Name_Id := N + 172; -- GNAT - - -- Note: AST_Entry is not in this list because its name matches the - -- name of the corresponding attribute. However, it is included in the - -- definition of the type Pragma_Id, and the functions Get_Pragma_Id - -- and Check_Pragma_Id correctly recognize and process Name_AST_Entry. - -- AST_Entry is a VMS specific pragma. - - Name_Assert : constant Name_Id := N + 173; -- Ada 05 - Name_Asynchronous : constant Name_Id := N + 174; - Name_Atomic : constant Name_Id := N + 175; - Name_Atomic_Components : constant Name_Id := N + 176; - Name_Attach_Handler : constant Name_Id := N + 177; - Name_CIL_Constructor : constant Name_Id := N + 178; -- GNAT - Name_Comment : constant Name_Id := N + 179; -- GNAT - Name_Common_Object : constant Name_Id := N + 180; -- GNAT - Name_Complete_Representation : constant Name_Id := N + 181; -- GNAT - Name_Complex_Representation : constant Name_Id := N + 182; -- GNAT - Name_Controlled : constant Name_Id := N + 183; - Name_Convention : constant Name_Id := N + 184; - Name_CPP_Class : constant Name_Id := N + 185; -- GNAT - Name_CPP_Constructor : constant Name_Id := N + 186; -- GNAT - Name_CPP_Virtual : constant Name_Id := N + 187; -- GNAT - Name_CPP_Vtable : constant Name_Id := N + 188; -- GNAT - Name_Debug : constant Name_Id := N + 189; -- GNAT - Name_Elaborate : constant Name_Id := N + 190; -- Ada 83 - Name_Elaborate_All : constant Name_Id := N + 191; - Name_Elaborate_Body : constant Name_Id := N + 192; - Name_Export : constant Name_Id := N + 193; - Name_Export_Exception : constant Name_Id := N + 194; -- VMS - Name_Export_Function : constant Name_Id := N + 195; -- GNAT - Name_Export_Object : constant Name_Id := N + 196; -- GNAT - Name_Export_Procedure : constant Name_Id := N + 197; -- GNAT - Name_Export_Value : constant Name_Id := N + 198; -- GNAT - Name_Export_Valued_Procedure : constant Name_Id := N + 199; -- GNAT - Name_External : constant Name_Id := N + 200; -- GNAT - Name_Finalize_Storage_Only : constant Name_Id := N + 201; -- GNAT - Name_Ident : constant Name_Id := N + 202; -- VMS - Name_Import : constant Name_Id := N + 203; - Name_Import_Exception : constant Name_Id := N + 204; -- VMS - Name_Import_Function : constant Name_Id := N + 205; -- GNAT - Name_Import_Object : constant Name_Id := N + 206; -- GNAT - Name_Import_Procedure : constant Name_Id := N + 207; -- GNAT - Name_Import_Valued_Procedure : constant Name_Id := N + 208; -- GNAT - Name_Inline : constant Name_Id := N + 209; - Name_Inline_Always : constant Name_Id := N + 210; -- GNAT - Name_Inline_Generic : constant Name_Id := N + 211; -- GNAT - Name_Inspection_Point : constant Name_Id := N + 212; - Name_Interface_Name : constant Name_Id := N + 213; -- GNAT - Name_Interrupt_Handler : constant Name_Id := N + 214; - Name_Interrupt_Priority : constant Name_Id := N + 215; - Name_Java_Constructor : constant Name_Id := N + 216; -- GNAT - Name_Java_Interface : constant Name_Id := N + 217; -- GNAT - Name_Keep_Names : constant Name_Id := N + 218; -- GNAT - Name_Link_With : constant Name_Id := N + 219; -- GNAT - Name_Linker_Alias : constant Name_Id := N + 220; -- GNAT - Name_Linker_Constructor : constant Name_Id := N + 221; -- GNAT - Name_Linker_Destructor : constant Name_Id := N + 222; -- GNAT - Name_Linker_Options : constant Name_Id := N + 223; - Name_Linker_Section : constant Name_Id := N + 224; -- GNAT - Name_List : constant Name_Id := N + 225; - Name_Machine_Attribute : constant Name_Id := N + 226; -- GNAT - Name_Main : constant Name_Id := N + 227; -- GNAT - Name_Main_Storage : constant Name_Id := N + 228; -- GNAT - Name_Memory_Size : constant Name_Id := N + 229; -- Ada 83 - Name_No_Body : constant Name_Id := N + 230; -- GNAT - Name_No_Return : constant Name_Id := N + 231; -- GNAT - Name_Obsolescent : constant Name_Id := N + 232; -- GNAT - Name_Optimize : constant Name_Id := N + 233; - Name_Pack : constant Name_Id := N + 234; - Name_Page : constant Name_Id := N + 235; - Name_Passive : constant Name_Id := N + 236; -- GNAT - Name_Preelaborable_Initialization : constant Name_Id := N + 237; -- Ada 05 - Name_Preelaborate : constant Name_Id := N + 238; - Name_Preelaborate_05 : constant Name_Id := N + 239; -- GNAT - - -- Note: Priority is not in this list because its name matches the - -- name of the corresponding attribute. However, it is included in the - -- definition of the type Pragma_Id, and the functions Get_Pragma_Id - -- and Check_Pragma_Id correctly recognize and process Priority. - -- Priority is a standard Ada 95 pragma. - - Name_Psect_Object : constant Name_Id := N + 240; -- VMS - Name_Pure : constant Name_Id := N + 241; - Name_Pure_05 : constant Name_Id := N + 242; -- GNAT - Name_Pure_Function : constant Name_Id := N + 243; -- GNAT - Name_Remote_Call_Interface : constant Name_Id := N + 244; - Name_Remote_Types : constant Name_Id := N + 245; - Name_Share_Generic : constant Name_Id := N + 246; -- GNAT - Name_Shared : constant Name_Id := N + 247; -- Ada 83 - Name_Shared_Passive : constant Name_Id := N + 248; - - -- Note: Storage_Size is not in this list because its name matches the - -- name of the corresponding attribute. However, it is included in the - -- definition of the type Attribute_Id, and the functions Get_Pragma_Id - -- and Check_Pragma_Id correctly recognize and process Name_Storage_Size. - - -- Note: Storage_Unit is also omitted from the list because of a clash - -- with an attribute name, and is treated similarly. - - Name_Source_Reference : constant Name_Id := N + 249; -- GNAT - Name_Static_Elaboration_Desired : constant Name_Id := N + 250; -- GNAT - Name_Stream_Convert : constant Name_Id := N + 251; -- GNAT - Name_Subtitle : constant Name_Id := N + 252; -- GNAT - Name_Suppress_All : constant Name_Id := N + 253; -- GNAT - Name_Suppress_Debug_Info : constant Name_Id := N + 254; -- GNAT - Name_Suppress_Initialization : constant Name_Id := N + 255; -- GNAT - Name_System_Name : constant Name_Id := N + 256; -- Ada 83 - Name_Task_Info : constant Name_Id := N + 257; -- GNAT - Name_Task_Name : constant Name_Id := N + 258; -- GNAT - Name_Task_Storage : constant Name_Id := N + 259; -- VMS - Name_Time_Slice : constant Name_Id := N + 260; -- GNAT - Name_Title : constant Name_Id := N + 261; -- GNAT - Name_Unchecked_Union : constant Name_Id := N + 262; -- GNAT - Name_Unimplemented_Unit : constant Name_Id := N + 263; -- GNAT - Name_Universal_Aliasing : constant Name_Id := N + 264; -- GNAT - Name_Unreferenced : constant Name_Id := N + 265; -- GNAT - Name_Unreferenced_Objects : constant Name_Id := N + 266; -- GNAT - Name_Unreserve_All_Interrupts : constant Name_Id := N + 267; -- GNAT - Name_Volatile : constant Name_Id := N + 268; - Name_Volatile_Components : constant Name_Id := N + 269; - Name_Weak_External : constant Name_Id := N + 270; -- GNAT - Last_Pragma_Name : constant Name_Id := N + 270; + Name_Abort_Defer : constant Name_Id := N + 172; -- GNAT + Name_All_Calls_Remote : constant Name_Id := N + 173; + Name_Annotate : constant Name_Id := N + 174; -- GNAT + + -- Note: AST_Entry is not in this list because its name matches -- VMS + -- the name of the corresponding attribute. However, it is + -- included in the definition of the type Pragma_Id, and the + -- functions Get_Pragma_Id and Is_Pragma_Id correctly recognize + -- and process Name_AST_Entry. + + Name_Assert : constant Name_Id := N + 175; -- Ada 05 + Name_Asynchronous : constant Name_Id := N + 176; + Name_Atomic : constant Name_Id := N + 177; + Name_Atomic_Components : constant Name_Id := N + 178; + Name_Attach_Handler : constant Name_Id := N + 179; + Name_CIL_Constructor : constant Name_Id := N + 180; -- GNAT + Name_Comment : constant Name_Id := N + 181; -- GNAT + Name_Common_Object : constant Name_Id := N + 182; -- GNAT + Name_Complete_Representation : constant Name_Id := N + 183; -- GNAT + Name_Complex_Representation : constant Name_Id := N + 184; -- GNAT + Name_Controlled : constant Name_Id := N + 185; + Name_Convention : constant Name_Id := N + 186; + Name_CPP_Class : constant Name_Id := N + 187; -- GNAT + Name_CPP_Constructor : constant Name_Id := N + 188; -- GNAT + Name_CPP_Virtual : constant Name_Id := N + 189; -- GNAT + Name_CPP_Vtable : constant Name_Id := N + 190; -- GNAT + Name_Debug : constant Name_Id := N + 191; -- GNAT + Name_Elaborate : constant Name_Id := N + 192; -- Ada 83 + Name_Elaborate_All : constant Name_Id := N + 193; + Name_Elaborate_Body : constant Name_Id := N + 194; + Name_Export : constant Name_Id := N + 195; + Name_Export_Exception : constant Name_Id := N + 196; -- VMS + Name_Export_Function : constant Name_Id := N + 197; -- GNAT + Name_Export_Object : constant Name_Id := N + 198; -- GNAT + Name_Export_Procedure : constant Name_Id := N + 199; -- GNAT + Name_Export_Value : constant Name_Id := N + 200; -- GNAT + Name_Export_Valued_Procedure : constant Name_Id := N + 201; -- GNAT + Name_External : constant Name_Id := N + 202; -- GNAT + Name_Finalize_Storage_Only : constant Name_Id := N + 203; -- GNAT + Name_Ident : constant Name_Id := N + 204; -- VMS + Name_Implemented_By_Entry : constant Name_Id := N + 205; -- Ada 05 + Name_Import : constant Name_Id := N + 206; + Name_Import_Exception : constant Name_Id := N + 207; -- VMS + Name_Import_Function : constant Name_Id := N + 208; -- GNAT + Name_Import_Object : constant Name_Id := N + 209; -- GNAT + Name_Import_Procedure : constant Name_Id := N + 210; -- GNAT + Name_Import_Valued_Procedure : constant Name_Id := N + 211; -- GNAT + Name_Inline : constant Name_Id := N + 212; + Name_Inline_Always : constant Name_Id := N + 213; -- GNAT + Name_Inline_Generic : constant Name_Id := N + 214; -- GNAT + Name_Inspection_Point : constant Name_Id := N + 215; + Name_Interface_Name : constant Name_Id := N + 216; -- GNAT + Name_Interrupt_Handler : constant Name_Id := N + 217; + Name_Interrupt_Priority : constant Name_Id := N + 218; + Name_Java_Constructor : constant Name_Id := N + 219; -- GNAT + Name_Java_Interface : constant Name_Id := N + 220; -- GNAT + Name_Keep_Names : constant Name_Id := N + 221; -- GNAT + Name_Link_With : constant Name_Id := N + 222; -- GNAT + Name_Linker_Alias : constant Name_Id := N + 223; -- GNAT + Name_Linker_Constructor : constant Name_Id := N + 224; -- GNAT + Name_Linker_Destructor : constant Name_Id := N + 225; -- GNAT + Name_Linker_Options : constant Name_Id := N + 226; + Name_Linker_Section : constant Name_Id := N + 227; -- GNAT + Name_List : constant Name_Id := N + 228; + Name_Machine_Attribute : constant Name_Id := N + 229; -- GNAT + Name_Main : constant Name_Id := N + 230; -- GNAT + Name_Main_Storage : constant Name_Id := N + 231; -- GNAT + Name_Memory_Size : constant Name_Id := N + 232; -- Ada 83 + Name_No_Body : constant Name_Id := N + 233; -- GNAT + Name_No_Return : constant Name_Id := N + 234; -- GNAT + Name_Obsolescent : constant Name_Id := N + 235; -- GNAT + Name_Optimize : constant Name_Id := N + 236; + Name_Pack : constant Name_Id := N + 237; + Name_Page : constant Name_Id := N + 238; + Name_Passive : constant Name_Id := N + 239; -- GNAT + Name_Preelaborable_Initialization : constant Name_Id := N + 240; -- Ada 05 + Name_Preelaborate : constant Name_Id := N + 241; + Name_Preelaborate_05 : constant Name_Id := N + 242; -- GNAT + + -- Note: Priority is not in this list because its name matches + -- the name of the corresponding attribute. However, it is + -- included in the definition of the type Pragma_Id, and the + -- functions Get_Pragma_Id and Is_Pragma_Id correctly recognize + -- and process Priority. Priority is a standard Ada 95 pragma. + + Name_Psect_Object : constant Name_Id := N + 243; -- VMS + Name_Pure : constant Name_Id := N + 244; + Name_Pure_05 : constant Name_Id := N + 245; -- GNAT + Name_Pure_Function : constant Name_Id := N + 246; -- GNAT + Name_Remote_Call_Interface : constant Name_Id := N + 247; + Name_Remote_Types : constant Name_Id := N + 248; + Name_Share_Generic : constant Name_Id := N + 249; -- GNAT + Name_Shared : constant Name_Id := N + 250; -- Ada 83 + Name_Shared_Passive : constant Name_Id := N + 251; + + -- Note: Storage_Size is not in this list because its name + -- matches the name of the corresponding attribute. However, + -- it is included in the definition of the type Attribute_Id, + -- and the functions Get_Pragma_Id and Is_Pragma_Id correctly + -- recognize and process Name_Storage_Size. + + -- Note: Storage_Unit is also omitted from the list because + -- of a clash with an attribute name, and is treated similarly. + + Name_Source_Reference : constant Name_Id := N + 252; -- GNAT + Name_Static_Elaboration_Desired : constant Name_Id := N + 253; -- GNAT + Name_Stream_Convert : constant Name_Id := N + 254; -- GNAT + Name_Subtitle : constant Name_Id := N + 255; -- GNAT + Name_Suppress_All : constant Name_Id := N + 256; -- GNAT + Name_Suppress_Debug_Info : constant Name_Id := N + 257; -- GNAT + Name_Suppress_Initialization : constant Name_Id := N + 258; -- GNAT + Name_System_Name : constant Name_Id := N + 259; -- Ada 83 + Name_Task_Info : constant Name_Id := N + 260; -- GNAT + Name_Task_Name : constant Name_Id := N + 261; -- GNAT + Name_Task_Storage : constant Name_Id := N + 262; -- VMS + Name_Time_Slice : constant Name_Id := N + 263; -- GNAT + Name_Title : constant Name_Id := N + 264; -- GNAT + Name_Unchecked_Union : constant Name_Id := N + 265; -- GNAT + Name_Unimplemented_Unit : constant Name_Id := N + 266; -- GNAT + Name_Universal_Aliasing : constant Name_Id := N + 267; -- GNAT + Name_Unreferenced : constant Name_Id := N + 268; -- GNAT + Name_Unreferenced_Objects : constant Name_Id := N + 269; -- GNAT + Name_Unreserve_All_Interrupts : constant Name_Id := N + 270; -- GNAT + Name_Volatile : constant Name_Id := N + 271; + Name_Volatile_Components : constant Name_Id := N + 272; + Name_Weak_External : constant Name_Id := N + 273; -- GNAT + Last_Pragma_Name : constant Name_Id := N + 273; -- Language convention names for pragma Convention/Export/Import/Interface -- Note that Name_C is not included in this list, since it was already @@ -528,119 +536,119 @@ package Snames is -- Entry and Protected, this is because these conventions cannot be -- specified by a pragma. - First_Convention_Name : constant Name_Id := N + 271; - Name_Ada : constant Name_Id := N + 271; - Name_Assembler : constant Name_Id := N + 272; - Name_CIL : constant Name_Id := N + 273; - Name_COBOL : constant Name_Id := N + 274; - Name_CPP : constant Name_Id := N + 275; - Name_Fortran : constant Name_Id := N + 276; - Name_Intrinsic : constant Name_Id := N + 277; - Name_Java : constant Name_Id := N + 278; - Name_Stdcall : constant Name_Id := N + 279; - Name_Stubbed : constant Name_Id := N + 280; - Last_Convention_Name : constant Name_Id := N + 280; + First_Convention_Name : constant Name_Id := N + 274; + Name_Ada : constant Name_Id := N + 274; + Name_Assembler : constant Name_Id := N + 275; + Name_CIL : constant Name_Id := N + 276; + Name_COBOL : constant Name_Id := N + 277; + Name_CPP : constant Name_Id := N + 278; + Name_Fortran : constant Name_Id := N + 279; + Name_Intrinsic : constant Name_Id := N + 280; + Name_Java : constant Name_Id := N + 281; + Name_Stdcall : constant Name_Id := N + 282; + Name_Stubbed : constant Name_Id := N + 283; + Last_Convention_Name : constant Name_Id := N + 283; -- The following names are preset as synonyms for Assembler - Name_Asm : constant Name_Id := N + 281; - Name_Assembly : constant Name_Id := N + 282; + Name_Asm : constant Name_Id := N + 284; + Name_Assembly : constant Name_Id := N + 285; -- The following names are preset as synonyms for C - Name_Default : constant Name_Id := N + 283; + Name_Default : constant Name_Id := N + 286; -- Name_Exernal (previously defined as pragma) -- The following names are preset as synonyms for CPP - Name_C_Plus_Plus : constant Name_Id := N + 284; + Name_C_Plus_Plus : constant Name_Id := N + 287; -- The following names are present as synonyms for Stdcall - Name_DLL : constant Name_Id := N + 285; - Name_Win32 : constant Name_Id := N + 286; + Name_DLL : constant Name_Id := N + 288; + Name_Win32 : constant Name_Id := N + 289; -- Other special names used in processing pragmas - Name_As_Is : constant Name_Id := N + 287; - Name_Attribute_Name : constant Name_Id := N + 288; - Name_Body_File_Name : constant Name_Id := N + 289; - Name_Boolean_Entry_Barriers : constant Name_Id := N + 290; - Name_Check : constant Name_Id := N + 291; - Name_Casing : constant Name_Id := N + 292; - Name_Code : constant Name_Id := N + 293; - Name_Component : constant Name_Id := N + 294; - Name_Component_Size_4 : constant Name_Id := N + 295; - Name_Copy : constant Name_Id := N + 296; - Name_D_Float : constant Name_Id := N + 297; - Name_Descriptor : constant Name_Id := N + 298; - Name_Dot_Replacement : constant Name_Id := N + 299; - Name_Dynamic : constant Name_Id := N + 300; - Name_Entity : constant Name_Id := N + 301; - Name_Entry_Count : constant Name_Id := N + 302; - Name_External_Name : constant Name_Id := N + 303; - Name_First_Optional_Parameter : constant Name_Id := N + 304; - Name_Form : constant Name_Id := N + 305; - Name_G_Float : constant Name_Id := N + 306; - Name_Gcc : constant Name_Id := N + 307; - Name_Gnat : constant Name_Id := N + 308; - Name_GPL : constant Name_Id := N + 309; - Name_IEEE_Float : constant Name_Id := N + 310; - Name_Ignore : constant Name_Id := N + 311; - Name_Info : constant Name_Id := N + 312; - Name_Internal : constant Name_Id := N + 313; - Name_Link_Name : constant Name_Id := N + 314; - Name_Lowercase : constant Name_Id := N + 315; - Name_Max_Entry_Queue_Depth : constant Name_Id := N + 316; - Name_Max_Entry_Queue_Length : constant Name_Id := N + 317; - Name_Max_Size : constant Name_Id := N + 318; - Name_Mechanism : constant Name_Id := N + 319; - Name_Message : constant Name_Id := N + 320; - Name_Mixedcase : constant Name_Id := N + 321; - Name_Modified_GPL : constant Name_Id := N + 322; - Name_Name : constant Name_Id := N + 323; - Name_NCA : constant Name_Id := N + 324; - Name_No : constant Name_Id := N + 325; - Name_No_Dependence : constant Name_Id := N + 326; - Name_No_Dynamic_Attachment : constant Name_Id := N + 327; - Name_No_Dynamic_Interrupts : constant Name_Id := N + 328; - Name_No_Requeue : constant Name_Id := N + 329; - Name_No_Requeue_Statements : constant Name_Id := N + 330; - Name_No_Task_Attributes : constant Name_Id := N + 331; - Name_No_Task_Attributes_Package : constant Name_Id := N + 332; - Name_On : constant Name_Id := N + 333; - Name_Parameter_Types : constant Name_Id := N + 334; - Name_Reference : constant Name_Id := N + 335; - Name_Restricted : constant Name_Id := N + 336; - Name_Result_Mechanism : constant Name_Id := N + 337; - Name_Result_Type : constant Name_Id := N + 338; - Name_Runtime : constant Name_Id := N + 339; - Name_SB : constant Name_Id := N + 340; - Name_Secondary_Stack_Size : constant Name_Id := N + 341; - Name_Section : constant Name_Id := N + 342; - Name_Semaphore : constant Name_Id := N + 343; - Name_Simple_Barriers : constant Name_Id := N + 344; - Name_Spec_File_Name : constant Name_Id := N + 345; - Name_State : constant Name_Id := N + 346; - Name_Static : constant Name_Id := N + 347; - Name_Stack_Size : constant Name_Id := N + 348; - Name_Subunit_File_Name : constant Name_Id := N + 349; - Name_Task_Stack_Size_Default : constant Name_Id := N + 350; - Name_Task_Type : constant Name_Id := N + 351; - Name_Time_Slicing_Enabled : constant Name_Id := N + 352; - Name_Top_Guard : constant Name_Id := N + 353; - Name_UBA : constant Name_Id := N + 354; - Name_UBS : constant Name_Id := N + 355; - Name_UBSB : constant Name_Id := N + 356; - Name_Unit_Name : constant Name_Id := N + 357; - Name_Unknown : constant Name_Id := N + 358; - Name_Unrestricted : constant Name_Id := N + 359; - Name_Uppercase : constant Name_Id := N + 360; - Name_User : constant Name_Id := N + 361; - Name_VAX_Float : constant Name_Id := N + 362; - Name_VMS : constant Name_Id := N + 363; - Name_Vtable_Ptr : constant Name_Id := N + 364; - Name_Working_Storage : constant Name_Id := N + 365; + Name_As_Is : constant Name_Id := N + 290; + Name_Attribute_Name : constant Name_Id := N + 291; + Name_Body_File_Name : constant Name_Id := N + 292; + Name_Boolean_Entry_Barriers : constant Name_Id := N + 293; + Name_Check : constant Name_Id := N + 294; + Name_Casing : constant Name_Id := N + 295; + Name_Code : constant Name_Id := N + 296; + Name_Component : constant Name_Id := N + 297; + Name_Component_Size_4 : constant Name_Id := N + 298; + Name_Copy : constant Name_Id := N + 299; + Name_D_Float : constant Name_Id := N + 300; + Name_Descriptor : constant Name_Id := N + 301; + Name_Dot_Replacement : constant Name_Id := N + 302; + Name_Dynamic : constant Name_Id := N + 303; + Name_Entity : constant Name_Id := N + 304; + Name_Entry_Count : constant Name_Id := N + 305; + Name_External_Name : constant Name_Id := N + 306; + Name_First_Optional_Parameter : constant Name_Id := N + 307; + Name_Form : constant Name_Id := N + 308; + Name_G_Float : constant Name_Id := N + 309; + Name_Gcc : constant Name_Id := N + 310; + Name_Gnat : constant Name_Id := N + 311; + Name_GPL : constant Name_Id := N + 312; + Name_IEEE_Float : constant Name_Id := N + 313; + Name_Ignore : constant Name_Id := N + 314; + Name_Info : constant Name_Id := N + 315; + Name_Internal : constant Name_Id := N + 316; + Name_Link_Name : constant Name_Id := N + 317; + Name_Lowercase : constant Name_Id := N + 318; + Name_Max_Entry_Queue_Depth : constant Name_Id := N + 319; + Name_Max_Entry_Queue_Length : constant Name_Id := N + 320; + Name_Max_Size : constant Name_Id := N + 321; + Name_Mechanism : constant Name_Id := N + 322; + Name_Message : constant Name_Id := N + 323; + Name_Mixedcase : constant Name_Id := N + 324; + Name_Modified_GPL : constant Name_Id := N + 325; + Name_Name : constant Name_Id := N + 326; + Name_NCA : constant Name_Id := N + 327; + Name_No : constant Name_Id := N + 328; + Name_No_Dependence : constant Name_Id := N + 329; + Name_No_Dynamic_Attachment : constant Name_Id := N + 330; + Name_No_Dynamic_Interrupts : constant Name_Id := N + 331; + Name_No_Requeue : constant Name_Id := N + 332; + Name_No_Requeue_Statements : constant Name_Id := N + 333; + Name_No_Task_Attributes : constant Name_Id := N + 334; + Name_No_Task_Attributes_Package : constant Name_Id := N + 335; + Name_On : constant Name_Id := N + 336; + Name_Parameter_Types : constant Name_Id := N + 337; + Name_Reference : constant Name_Id := N + 338; + Name_Restricted : constant Name_Id := N + 339; + Name_Result_Mechanism : constant Name_Id := N + 340; + Name_Result_Type : constant Name_Id := N + 341; + Name_Runtime : constant Name_Id := N + 342; + Name_SB : constant Name_Id := N + 343; + Name_Secondary_Stack_Size : constant Name_Id := N + 344; + Name_Section : constant Name_Id := N + 345; + Name_Semaphore : constant Name_Id := N + 346; + Name_Simple_Barriers : constant Name_Id := N + 347; + Name_Spec_File_Name : constant Name_Id := N + 348; + Name_State : constant Name_Id := N + 349; + Name_Static : constant Name_Id := N + 350; + Name_Stack_Size : constant Name_Id := N + 351; + Name_Subunit_File_Name : constant Name_Id := N + 352; + Name_Task_Stack_Size_Default : constant Name_Id := N + 353; + Name_Task_Type : constant Name_Id := N + 354; + Name_Time_Slicing_Enabled : constant Name_Id := N + 355; + Name_Top_Guard : constant Name_Id := N + 356; + Name_UBA : constant Name_Id := N + 357; + Name_UBS : constant Name_Id := N + 358; + Name_UBSB : constant Name_Id := N + 359; + Name_Unit_Name : constant Name_Id := N + 360; + Name_Unknown : constant Name_Id := N + 361; + Name_Unrestricted : constant Name_Id := N + 362; + Name_Uppercase : constant Name_Id := N + 363; + Name_User : constant Name_Id := N + 364; + Name_VAX_Float : constant Name_Id := N + 365; + Name_VMS : constant Name_Id := N + 366; + Name_Vtable_Ptr : constant Name_Id := N + 367; + Name_Working_Storage : constant Name_Id := N + 368; -- Names of recognized attributes. The entries with the comment "Ada 83" -- are attributes that are defined in Ada 83, but not in Ada 95. These @@ -654,169 +662,170 @@ package Snames is -- The entries marked VMS are recognized only in OpenVMS implementations -- of GNAT, and are treated as illegal in all other contexts. - First_Attribute_Name : constant Name_Id := N + 366; - Name_Abort_Signal : constant Name_Id := N + 366; -- GNAT - Name_Access : constant Name_Id := N + 367; - Name_Address : constant Name_Id := N + 368; - Name_Address_Size : constant Name_Id := N + 369; -- GNAT - Name_Aft : constant Name_Id := N + 370; - Name_Alignment : constant Name_Id := N + 371; - Name_Asm_Input : constant Name_Id := N + 372; -- GNAT - Name_Asm_Output : constant Name_Id := N + 373; -- GNAT - Name_AST_Entry : constant Name_Id := N + 374; -- VMS - Name_Bit : constant Name_Id := N + 375; -- GNAT - Name_Bit_Order : constant Name_Id := N + 376; - Name_Bit_Position : constant Name_Id := N + 377; -- GNAT - Name_Body_Version : constant Name_Id := N + 378; - Name_Callable : constant Name_Id := N + 379; - Name_Caller : constant Name_Id := N + 380; - Name_Code_Address : constant Name_Id := N + 381; -- GNAT - Name_Component_Size : constant Name_Id := N + 382; - Name_Compose : constant Name_Id := N + 383; - Name_Constrained : constant Name_Id := N + 384; - Name_Count : constant Name_Id := N + 385; - Name_Default_Bit_Order : constant Name_Id := N + 386; -- GNAT - Name_Definite : constant Name_Id := N + 387; - Name_Delta : constant Name_Id := N + 388; - Name_Denorm : constant Name_Id := N + 389; - Name_Digits : constant Name_Id := N + 390; - Name_Elaborated : constant Name_Id := N + 391; -- GNAT - Name_Emax : constant Name_Id := N + 392; -- Ada 83 - Name_Enabled : constant Name_Id := N + 393; -- GNAT - Name_Enum_Rep : constant Name_Id := N + 394; -- GNAT - Name_Epsilon : constant Name_Id := N + 395; -- Ada 83 - Name_Exponent : constant Name_Id := N + 396; - Name_External_Tag : constant Name_Id := N + 397; - Name_First : constant Name_Id := N + 398; - Name_First_Bit : constant Name_Id := N + 399; - Name_Fixed_Value : constant Name_Id := N + 400; -- GNAT - Name_Fore : constant Name_Id := N + 401; - Name_Has_Access_Values : constant Name_Id := N + 402; -- GNAT - Name_Has_Discriminants : constant Name_Id := N + 403; -- GNAT - Name_Identity : constant Name_Id := N + 404; - Name_Img : constant Name_Id := N + 405; -- GNAT - Name_Integer_Value : constant Name_Id := N + 406; -- GNAT - Name_Large : constant Name_Id := N + 407; -- Ada 83 - Name_Last : constant Name_Id := N + 408; - Name_Last_Bit : constant Name_Id := N + 409; - Name_Leading_Part : constant Name_Id := N + 410; - Name_Length : constant Name_Id := N + 411; - Name_Machine_Emax : constant Name_Id := N + 412; - Name_Machine_Emin : constant Name_Id := N + 413; - Name_Machine_Mantissa : constant Name_Id := N + 414; - Name_Machine_Overflows : constant Name_Id := N + 415; - Name_Machine_Radix : constant Name_Id := N + 416; - Name_Machine_Rounding : constant Name_Id := N + 417; -- Ada 05 - Name_Machine_Rounds : constant Name_Id := N + 418; - Name_Machine_Size : constant Name_Id := N + 419; -- GNAT - Name_Mantissa : constant Name_Id := N + 420; -- Ada 83 - Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 421; - Name_Maximum_Alignment : constant Name_Id := N + 422; -- GNAT - Name_Mechanism_Code : constant Name_Id := N + 423; -- GNAT - Name_Mod : constant Name_Id := N + 424; -- Ada 05 - Name_Model_Emin : constant Name_Id := N + 425; - Name_Model_Epsilon : constant Name_Id := N + 426; - Name_Model_Mantissa : constant Name_Id := N + 427; - Name_Model_Small : constant Name_Id := N + 428; - Name_Modulus : constant Name_Id := N + 429; - Name_Null_Parameter : constant Name_Id := N + 430; -- GNAT - Name_Object_Size : constant Name_Id := N + 431; -- GNAT - Name_Partition_ID : constant Name_Id := N + 432; - Name_Passed_By_Reference : constant Name_Id := N + 433; -- GNAT - Name_Pool_Address : constant Name_Id := N + 434; - Name_Pos : constant Name_Id := N + 435; - Name_Position : constant Name_Id := N + 436; - Name_Priority : constant Name_Id := N + 437; -- Ada 05 - Name_Range : constant Name_Id := N + 438; - Name_Range_Length : constant Name_Id := N + 439; -- GNAT - Name_Round : constant Name_Id := N + 440; - Name_Safe_Emax : constant Name_Id := N + 441; -- Ada 83 - Name_Safe_First : constant Name_Id := N + 442; - Name_Safe_Large : constant Name_Id := N + 443; -- Ada 83 - Name_Safe_Last : constant Name_Id := N + 444; - Name_Safe_Small : constant Name_Id := N + 445; -- Ada 83 - Name_Scale : constant Name_Id := N + 446; - Name_Scaling : constant Name_Id := N + 447; - Name_Signed_Zeros : constant Name_Id := N + 448; - Name_Size : constant Name_Id := N + 449; - Name_Small : constant Name_Id := N + 450; - Name_Storage_Size : constant Name_Id := N + 451; - Name_Storage_Unit : constant Name_Id := N + 452; -- GNAT - Name_Stream_Size : constant Name_Id := N + 453; -- Ada 05 - Name_Tag : constant Name_Id := N + 454; - Name_Target_Name : constant Name_Id := N + 455; -- GNAT - Name_Terminated : constant Name_Id := N + 456; - Name_To_Address : constant Name_Id := N + 457; -- GNAT - Name_Type_Class : constant Name_Id := N + 458; -- GNAT - Name_UET_Address : constant Name_Id := N + 459; -- GNAT - Name_Unbiased_Rounding : constant Name_Id := N + 460; - Name_Unchecked_Access : constant Name_Id := N + 461; - Name_Unconstrained_Array : constant Name_Id := N + 462; - Name_Universal_Literal_String : constant Name_Id := N + 463; -- GNAT - Name_Unrestricted_Access : constant Name_Id := N + 464; -- GNAT - Name_VADS_Size : constant Name_Id := N + 465; -- GNAT - Name_Val : constant Name_Id := N + 466; - Name_Valid : constant Name_Id := N + 467; - Name_Value_Size : constant Name_Id := N + 468; -- GNAT - Name_Version : constant Name_Id := N + 469; - Name_Wchar_T_Size : constant Name_Id := N + 470; -- GNAT - Name_Wide_Wide_Width : constant Name_Id := N + 471; -- Ada 05 - Name_Wide_Width : constant Name_Id := N + 472; - Name_Width : constant Name_Id := N + 473; - Name_Word_Size : constant Name_Id := N + 474; -- GNAT + First_Attribute_Name : constant Name_Id := N + 369; + Name_Abort_Signal : constant Name_Id := N + 369; -- GNAT + Name_Access : constant Name_Id := N + 370; + Name_Address : constant Name_Id := N + 371; + Name_Address_Size : constant Name_Id := N + 372; -- GNAT + Name_Aft : constant Name_Id := N + 373; + Name_Alignment : constant Name_Id := N + 374; + Name_Asm_Input : constant Name_Id := N + 375; -- GNAT + Name_Asm_Output : constant Name_Id := N + 376; -- GNAT + Name_AST_Entry : constant Name_Id := N + 377; -- VMS + Name_Bit : constant Name_Id := N + 378; -- GNAT + Name_Bit_Order : constant Name_Id := N + 379; + Name_Bit_Position : constant Name_Id := N + 380; -- GNAT + Name_Body_Version : constant Name_Id := N + 381; + Name_Callable : constant Name_Id := N + 382; + Name_Caller : constant Name_Id := N + 383; + Name_Code_Address : constant Name_Id := N + 384; -- GNAT + Name_Component_Size : constant Name_Id := N + 385; + Name_Compose : constant Name_Id := N + 386; + Name_Constrained : constant Name_Id := N + 387; + Name_Count : constant Name_Id := N + 388; + Name_Default_Bit_Order : constant Name_Id := N + 389; -- GNAT + Name_Definite : constant Name_Id := N + 390; + Name_Delta : constant Name_Id := N + 391; + Name_Denorm : constant Name_Id := N + 392; + Name_Digits : constant Name_Id := N + 393; + Name_Elaborated : constant Name_Id := N + 394; -- GNAT + Name_Emax : constant Name_Id := N + 395; -- Ada 83 + Name_Enabled : constant Name_Id := N + 396; -- GNAT + Name_Enum_Rep : constant Name_Id := N + 397; -- GNAT + Name_Epsilon : constant Name_Id := N + 398; -- Ada 83 + Name_Exponent : constant Name_Id := N + 399; + Name_External_Tag : constant Name_Id := N + 400; + Name_Fast_Math : constant Name_Id := N + 401; -- GNAT + Name_First : constant Name_Id := N + 402; + Name_First_Bit : constant Name_Id := N + 403; + Name_Fixed_Value : constant Name_Id := N + 404; -- GNAT + Name_Fore : constant Name_Id := N + 405; + Name_Has_Access_Values : constant Name_Id := N + 406; -- GNAT + Name_Has_Discriminants : constant Name_Id := N + 407; -- GNAT + Name_Identity : constant Name_Id := N + 408; + Name_Img : constant Name_Id := N + 409; -- GNAT + Name_Integer_Value : constant Name_Id := N + 410; -- GNAT + Name_Large : constant Name_Id := N + 411; -- Ada 83 + Name_Last : constant Name_Id := N + 412; + Name_Last_Bit : constant Name_Id := N + 413; + Name_Leading_Part : constant Name_Id := N + 414; + Name_Length : constant Name_Id := N + 415; + Name_Machine_Emax : constant Name_Id := N + 416; + Name_Machine_Emin : constant Name_Id := N + 417; + Name_Machine_Mantissa : constant Name_Id := N + 418; + Name_Machine_Overflows : constant Name_Id := N + 419; + Name_Machine_Radix : constant Name_Id := N + 420; + Name_Machine_Rounding : constant Name_Id := N + 421; -- Ada 05 + Name_Machine_Rounds : constant Name_Id := N + 422; + Name_Machine_Size : constant Name_Id := N + 423; -- GNAT + Name_Mantissa : constant Name_Id := N + 424; -- Ada 83 + Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 425; + Name_Maximum_Alignment : constant Name_Id := N + 426; -- GNAT + Name_Mechanism_Code : constant Name_Id := N + 427; -- GNAT + Name_Mod : constant Name_Id := N + 428; -- Ada 05 + Name_Model_Emin : constant Name_Id := N + 429; + Name_Model_Epsilon : constant Name_Id := N + 430; + Name_Model_Mantissa : constant Name_Id := N + 431; + Name_Model_Small : constant Name_Id := N + 432; + Name_Modulus : constant Name_Id := N + 433; + Name_Null_Parameter : constant Name_Id := N + 434; -- GNAT + Name_Object_Size : constant Name_Id := N + 435; -- GNAT + Name_Partition_ID : constant Name_Id := N + 436; + Name_Passed_By_Reference : constant Name_Id := N + 437; -- GNAT + Name_Pool_Address : constant Name_Id := N + 438; + Name_Pos : constant Name_Id := N + 439; + Name_Position : constant Name_Id := N + 440; + Name_Priority : constant Name_Id := N + 441; -- Ada 05 + Name_Range : constant Name_Id := N + 442; + Name_Range_Length : constant Name_Id := N + 443; -- GNAT + Name_Round : constant Name_Id := N + 444; + Name_Safe_Emax : constant Name_Id := N + 445; -- Ada 83 + Name_Safe_First : constant Name_Id := N + 446; + Name_Safe_Large : constant Name_Id := N + 447; -- Ada 83 + Name_Safe_Last : constant Name_Id := N + 448; + Name_Safe_Small : constant Name_Id := N + 449; -- Ada 83 + Name_Scale : constant Name_Id := N + 450; + Name_Scaling : constant Name_Id := N + 451; + Name_Signed_Zeros : constant Name_Id := N + 452; + Name_Size : constant Name_Id := N + 453; + Name_Small : constant Name_Id := N + 454; + Name_Storage_Size : constant Name_Id := N + 455; + Name_Storage_Unit : constant Name_Id := N + 456; -- GNAT + Name_Stream_Size : constant Name_Id := N + 457; -- Ada 05 + Name_Tag : constant Name_Id := N + 458; + Name_Target_Name : constant Name_Id := N + 459; -- GNAT + Name_Terminated : constant Name_Id := N + 460; + Name_To_Address : constant Name_Id := N + 461; -- GNAT + Name_Type_Class : constant Name_Id := N + 462; -- GNAT + Name_UET_Address : constant Name_Id := N + 463; -- GNAT + Name_Unbiased_Rounding : constant Name_Id := N + 464; + Name_Unchecked_Access : constant Name_Id := N + 465; + Name_Unconstrained_Array : constant Name_Id := N + 466; + Name_Universal_Literal_String : constant Name_Id := N + 467; -- GNAT + Name_Unrestricted_Access : constant Name_Id := N + 468; -- GNAT + Name_VADS_Size : constant Name_Id := N + 469; -- GNAT + Name_Val : constant Name_Id := N + 470; + Name_Valid : constant Name_Id := N + 471; + Name_Value_Size : constant Name_Id := N + 472; -- GNAT + Name_Version : constant Name_Id := N + 473; + Name_Wchar_T_Size : constant Name_Id := N + 474; -- GNAT + Name_Wide_Wide_Width : constant Name_Id := N + 475; -- Ada 05 + Name_Wide_Width : constant Name_Id := N + 476; + Name_Width : constant Name_Id := N + 477; + Name_Word_Size : constant Name_Id := N + 478; -- GNAT -- Attributes that designate attributes returning renamable functions, -- i.e. functions that return other than a universal value and that -- have non-universal arguments. - First_Renamable_Function_Attribute : constant Name_Id := N + 475; - Name_Adjacent : constant Name_Id := N + 475; - Name_Ceiling : constant Name_Id := N + 476; - Name_Copy_Sign : constant Name_Id := N + 477; - Name_Floor : constant Name_Id := N + 478; - Name_Fraction : constant Name_Id := N + 479; - Name_Image : constant Name_Id := N + 480; - Name_Input : constant Name_Id := N + 481; - Name_Machine : constant Name_Id := N + 482; - Name_Max : constant Name_Id := N + 483; - Name_Min : constant Name_Id := N + 484; - Name_Model : constant Name_Id := N + 485; - Name_Pred : constant Name_Id := N + 486; - Name_Remainder : constant Name_Id := N + 487; - Name_Rounding : constant Name_Id := N + 488; - Name_Succ : constant Name_Id := N + 489; - Name_Truncation : constant Name_Id := N + 490; - Name_Value : constant Name_Id := N + 491; - Name_Wide_Image : constant Name_Id := N + 492; - Name_Wide_Wide_Image : constant Name_Id := N + 493; - Name_Wide_Value : constant Name_Id := N + 494; - Name_Wide_Wide_Value : constant Name_Id := N + 495; - Last_Renamable_Function_Attribute : constant Name_Id := N + 495; + First_Renamable_Function_Attribute : constant Name_Id := N + 479; + Name_Adjacent : constant Name_Id := N + 479; + Name_Ceiling : constant Name_Id := N + 480; + Name_Copy_Sign : constant Name_Id := N + 481; + Name_Floor : constant Name_Id := N + 482; + Name_Fraction : constant Name_Id := N + 483; + Name_Image : constant Name_Id := N + 484; + Name_Input : constant Name_Id := N + 485; + Name_Machine : constant Name_Id := N + 486; + Name_Max : constant Name_Id := N + 487; + Name_Min : constant Name_Id := N + 488; + Name_Model : constant Name_Id := N + 489; + Name_Pred : constant Name_Id := N + 490; + Name_Remainder : constant Name_Id := N + 491; + Name_Rounding : constant Name_Id := N + 492; + Name_Succ : constant Name_Id := N + 493; + Name_Truncation : constant Name_Id := N + 494; + Name_Value : constant Name_Id := N + 495; + Name_Wide_Image : constant Name_Id := N + 496; + Name_Wide_Wide_Image : constant Name_Id := N + 497; + Name_Wide_Value : constant Name_Id := N + 498; + Name_Wide_Wide_Value : constant Name_Id := N + 499; + Last_Renamable_Function_Attribute : constant Name_Id := N + 499; -- Attributes that designate procedures - First_Procedure_Attribute : constant Name_Id := N + 496; - Name_Output : constant Name_Id := N + 496; - Name_Read : constant Name_Id := N + 497; - Name_Write : constant Name_Id := N + 498; - Last_Procedure_Attribute : constant Name_Id := N + 498; + First_Procedure_Attribute : constant Name_Id := N + 500; + Name_Output : constant Name_Id := N + 500; + Name_Read : constant Name_Id := N + 501; + Name_Write : constant Name_Id := N + 502; + Last_Procedure_Attribute : constant Name_Id := N + 502; -- Remaining attributes are ones that return entities - First_Entity_Attribute_Name : constant Name_Id := N + 499; - Name_Elab_Body : constant Name_Id := N + 499; -- GNAT - Name_Elab_Spec : constant Name_Id := N + 500; -- GNAT - Name_Storage_Pool : constant Name_Id := N + 501; + First_Entity_Attribute_Name : constant Name_Id := N + 503; + Name_Elab_Body : constant Name_Id := N + 503; -- GNAT + Name_Elab_Spec : constant Name_Id := N + 504; -- GNAT + Name_Storage_Pool : constant Name_Id := N + 505; -- These attributes are the ones that return types - First_Type_Attribute_Name : constant Name_Id := N + 502; - Name_Base : constant Name_Id := N + 502; - Name_Class : constant Name_Id := N + 503; - Name_Stub_Type : constant Name_Id := N + 504; - Last_Type_Attribute_Name : constant Name_Id := N + 504; - Last_Entity_Attribute_Name : constant Name_Id := N + 504; - Last_Attribute_Name : constant Name_Id := N + 504; + First_Type_Attribute_Name : constant Name_Id := N + 506; + Name_Base : constant Name_Id := N + 506; + Name_Class : constant Name_Id := N + 507; + Name_Stub_Type : constant Name_Id := N + 508; + Last_Type_Attribute_Name : constant Name_Id := N + 508; + Last_Entity_Attribute_Name : constant Name_Id := N + 508; + Last_Attribute_Name : constant Name_Id := N + 508; -- Names of recognized locking policy identifiers @@ -824,10 +833,10 @@ package Snames is -- name (e.g. C for Ceiling_Locking). If new policy names are added, -- the first character must be distinct. - First_Locking_Policy_Name : constant Name_Id := N + 505; - Name_Ceiling_Locking : constant Name_Id := N + 505; - Name_Inheritance_Locking : constant Name_Id := N + 506; - Last_Locking_Policy_Name : constant Name_Id := N + 506; + First_Locking_Policy_Name : constant Name_Id := N + 509; + Name_Ceiling_Locking : constant Name_Id := N + 509; + Name_Inheritance_Locking : constant Name_Id := N + 510; + Last_Locking_Policy_Name : constant Name_Id := N + 510; -- Names of recognized queuing policy identifiers @@ -835,10 +844,10 @@ package Snames is -- name (e.g. F for FIFO_Queuing). If new policy names are added, -- the first character must be distinct. - First_Queuing_Policy_Name : constant Name_Id := N + 507; - Name_FIFO_Queuing : constant Name_Id := N + 507; - Name_Priority_Queuing : constant Name_Id := N + 508; - Last_Queuing_Policy_Name : constant Name_Id := N + 508; + First_Queuing_Policy_Name : constant Name_Id := N + 511; + Name_FIFO_Queuing : constant Name_Id := N + 511; + Name_Priority_Queuing : constant Name_Id := N + 512; + Last_Queuing_Policy_Name : constant Name_Id := N + 512; -- Names of recognized task dispatching policy identifiers @@ -846,272 +855,273 @@ package Snames is -- name (e.g. F for FIFO_Within_Priorities). If new policy names -- are added, the first character must be distinct. - First_Task_Dispatching_Policy_Name : constant Name_Id := N + 509; - Name_EDF_Across_Priorities : constant Name_Id := N + 509; - Name_FIFO_Within_Priorities : constant Name_Id := N + 510; - Name_Non_Preemptive_Within_Priorities : constant Name_Id := N + 511; - Name_Round_Robin_Within_Priorities : constant Name_Id := N + 512; - Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 512; + First_Task_Dispatching_Policy_Name : constant Name_Id := N + 513; + Name_EDF_Across_Priorities : constant Name_Id := N + 513; + Name_FIFO_Within_Priorities : constant Name_Id := N + 514; + Name_Non_Preemptive_Within_Priorities + : constant Name_Id := N + 513; + Name_Round_Robin_Within_Priorities : constant Name_Id := N + 515; + Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 515; -- Names of recognized checks for pragma Suppress - First_Check_Name : constant Name_Id := N + 513; - Name_Access_Check : constant Name_Id := N + 513; - Name_Accessibility_Check : constant Name_Id := N + 514; - Name_Alignment_Check : constant Name_Id := N + 515; -- GNAT - Name_Discriminant_Check : constant Name_Id := N + 516; - Name_Division_Check : constant Name_Id := N + 517; - Name_Elaboration_Check : constant Name_Id := N + 518; - Name_Index_Check : constant Name_Id := N + 519; - Name_Length_Check : constant Name_Id := N + 520; - Name_Overflow_Check : constant Name_Id := N + 521; - Name_Range_Check : constant Name_Id := N + 522; - Name_Storage_Check : constant Name_Id := N + 523; - Name_Tag_Check : constant Name_Id := N + 524; - Name_Validity_Check : constant Name_Id := N + 525; -- GNAT - Name_All_Checks : constant Name_Id := N + 526; - Last_Check_Name : constant Name_Id := N + 526; + First_Check_Name : constant Name_Id := N + 516; + Name_Access_Check : constant Name_Id := N + 516; + Name_Accessibility_Check : constant Name_Id := N + 517; + Name_Alignment_Check : constant Name_Id := N + 518; -- GNAT + Name_Discriminant_Check : constant Name_Id := N + 519; + Name_Division_Check : constant Name_Id := N + 520; + Name_Elaboration_Check : constant Name_Id := N + 521; + Name_Index_Check : constant Name_Id := N + 522; + Name_Length_Check : constant Name_Id := N + 523; + Name_Overflow_Check : constant Name_Id := N + 524; + Name_Range_Check : constant Name_Id := N + 525; + Name_Storage_Check : constant Name_Id := N + 526; + Name_Tag_Check : constant Name_Id := N + 527; + Name_Validity_Check : constant Name_Id := N + 528; -- GNAT + Name_All_Checks : constant Name_Id := N + 529; + Last_Check_Name : constant Name_Id := N + 529; -- Names corresponding to reserved keywords, excluding those already -- declared in the attribute list (Access, Delta, Digits, Mod, Range). - Name_Abort : constant Name_Id := N + 527; - Name_Abs : constant Name_Id := N + 528; - Name_Accept : constant Name_Id := N + 529; - Name_And : constant Name_Id := N + 530; - Name_All : constant Name_Id := N + 531; - Name_Array : constant Name_Id := N + 532; - Name_At : constant Name_Id := N + 533; - Name_Begin : constant Name_Id := N + 534; - Name_Body : constant Name_Id := N + 535; - Name_Case : constant Name_Id := N + 536; - Name_Constant : constant Name_Id := N + 537; - Name_Declare : constant Name_Id := N + 538; - Name_Delay : constant Name_Id := N + 539; - Name_Do : constant Name_Id := N + 540; - Name_Else : constant Name_Id := N + 541; - Name_Elsif : constant Name_Id := N + 542; - Name_End : constant Name_Id := N + 543; - Name_Entry : constant Name_Id := N + 544; - Name_Exception : constant Name_Id := N + 545; - Name_Exit : constant Name_Id := N + 546; - Name_For : constant Name_Id := N + 547; - Name_Function : constant Name_Id := N + 548; - Name_Generic : constant Name_Id := N + 549; - Name_Goto : constant Name_Id := N + 550; - Name_If : constant Name_Id := N + 551; - Name_In : constant Name_Id := N + 552; - Name_Is : constant Name_Id := N + 553; - Name_Limited : constant Name_Id := N + 554; - Name_Loop : constant Name_Id := N + 555; - Name_New : constant Name_Id := N + 556; - Name_Not : constant Name_Id := N + 557; - Name_Null : constant Name_Id := N + 558; - Name_Of : constant Name_Id := N + 559; - Name_Or : constant Name_Id := N + 560; - Name_Others : constant Name_Id := N + 561; - Name_Out : constant Name_Id := N + 562; - Name_Package : constant Name_Id := N + 563; - Name_Pragma : constant Name_Id := N + 564; - Name_Private : constant Name_Id := N + 565; - Name_Procedure : constant Name_Id := N + 566; - Name_Raise : constant Name_Id := N + 567; - Name_Record : constant Name_Id := N + 568; - Name_Rem : constant Name_Id := N + 569; - Name_Renames : constant Name_Id := N + 570; - Name_Return : constant Name_Id := N + 571; - Name_Reverse : constant Name_Id := N + 572; - Name_Select : constant Name_Id := N + 573; - Name_Separate : constant Name_Id := N + 574; - Name_Subtype : constant Name_Id := N + 575; - Name_Task : constant Name_Id := N + 576; - Name_Terminate : constant Name_Id := N + 577; - Name_Then : constant Name_Id := N + 578; - Name_Type : constant Name_Id := N + 579; - Name_Use : constant Name_Id := N + 580; - Name_When : constant Name_Id := N + 581; - Name_While : constant Name_Id := N + 582; - Name_With : constant Name_Id := N + 583; - Name_Xor : constant Name_Id := N + 584; + Name_Abort : constant Name_Id := N + 530; + Name_Abs : constant Name_Id := N + 531; + Name_Accept : constant Name_Id := N + 532; + Name_And : constant Name_Id := N + 533; + Name_All : constant Name_Id := N + 534; + Name_Array : constant Name_Id := N + 535; + Name_At : constant Name_Id := N + 536; + Name_Begin : constant Name_Id := N + 537; + Name_Body : constant Name_Id := N + 538; + Name_Case : constant Name_Id := N + 539; + Name_Constant : constant Name_Id := N + 540; + Name_Declare : constant Name_Id := N + 541; + Name_Delay : constant Name_Id := N + 542; + Name_Do : constant Name_Id := N + 543; + Name_Else : constant Name_Id := N + 544; + Name_Elsif : constant Name_Id := N + 545; + Name_End : constant Name_Id := N + 546; + Name_Entry : constant Name_Id := N + 547; + Name_Exception : constant Name_Id := N + 548; + Name_Exit : constant Name_Id := N + 549; + Name_For : constant Name_Id := N + 550; + Name_Function : constant Name_Id := N + 551; + Name_Generic : constant Name_Id := N + 552; + Name_Goto : constant Name_Id := N + 553; + Name_If : constant Name_Id := N + 554; + Name_In : constant Name_Id := N + 555; + Name_Is : constant Name_Id := N + 556; + Name_Limited : constant Name_Id := N + 557; + Name_Loop : constant Name_Id := N + 558; + Name_New : constant Name_Id := N + 559; + Name_Not : constant Name_Id := N + 560; + Name_Null : constant Name_Id := N + 561; + Name_Of : constant Name_Id := N + 562; + Name_Or : constant Name_Id := N + 563; + Name_Others : constant Name_Id := N + 564; + Name_Out : constant Name_Id := N + 565; + Name_Package : constant Name_Id := N + 566; + Name_Pragma : constant Name_Id := N + 567; + Name_Private : constant Name_Id := N + 568; + Name_Procedure : constant Name_Id := N + 569; + Name_Raise : constant Name_Id := N + 570; + Name_Record : constant Name_Id := N + 571; + Name_Rem : constant Name_Id := N + 572; + Name_Renames : constant Name_Id := N + 573; + Name_Return : constant Name_Id := N + 574; + Name_Reverse : constant Name_Id := N + 575; + Name_Select : constant Name_Id := N + 576; + Name_Separate : constant Name_Id := N + 577; + Name_Subtype : constant Name_Id := N + 578; + Name_Task : constant Name_Id := N + 579; + Name_Terminate : constant Name_Id := N + 580; + Name_Then : constant Name_Id := N + 581; + Name_Type : constant Name_Id := N + 582; + Name_Use : constant Name_Id := N + 583; + Name_When : constant Name_Id := N + 584; + Name_While : constant Name_Id := N + 585; + Name_With : constant Name_Id := N + 586; + Name_Xor : constant Name_Id := N + 587; -- Names of intrinsic subprograms -- Note: Asm is missing from this list, since Asm is a legitimate -- convention name. So is To_Adress, which is a GNAT attribute. - First_Intrinsic_Name : constant Name_Id := N + 585; - Name_Divide : constant Name_Id := N + 585; - Name_Enclosing_Entity : constant Name_Id := N + 586; - Name_Exception_Information : constant Name_Id := N + 587; - Name_Exception_Message : constant Name_Id := N + 588; - Name_Exception_Name : constant Name_Id := N + 589; - Name_File : constant Name_Id := N + 590; - Name_Generic_Dispatching_Constructor : constant Name_Id := N + 591; - Name_Import_Address : constant Name_Id := N + 592; - Name_Import_Largest_Value : constant Name_Id := N + 593; - Name_Import_Value : constant Name_Id := N + 594; - Name_Is_Negative : constant Name_Id := N + 595; - Name_Line : constant Name_Id := N + 596; - Name_Rotate_Left : constant Name_Id := N + 597; - Name_Rotate_Right : constant Name_Id := N + 598; - Name_Shift_Left : constant Name_Id := N + 599; - Name_Shift_Right : constant Name_Id := N + 600; - Name_Shift_Right_Arithmetic : constant Name_Id := N + 601; - Name_Source_Location : constant Name_Id := N + 602; - Name_Unchecked_Conversion : constant Name_Id := N + 603; - Name_Unchecked_Deallocation : constant Name_Id := N + 604; - Name_To_Pointer : constant Name_Id := N + 605; - Last_Intrinsic_Name : constant Name_Id := N + 605; + First_Intrinsic_Name : constant Name_Id := N + 588; + Name_Divide : constant Name_Id := N + 588; + Name_Enclosing_Entity : constant Name_Id := N + 589; + Name_Exception_Information : constant Name_Id := N + 590; + Name_Exception_Message : constant Name_Id := N + 591; + Name_Exception_Name : constant Name_Id := N + 592; + Name_File : constant Name_Id := N + 593; + Name_Generic_Dispatching_Constructor : constant Name_Id := N + 594; + Name_Import_Address : constant Name_Id := N + 595; + Name_Import_Largest_Value : constant Name_Id := N + 596; + Name_Import_Value : constant Name_Id := N + 597; + Name_Is_Negative : constant Name_Id := N + 598; + Name_Line : constant Name_Id := N + 599; + Name_Rotate_Left : constant Name_Id := N + 600; + Name_Rotate_Right : constant Name_Id := N + 601; + Name_Shift_Left : constant Name_Id := N + 602; + Name_Shift_Right : constant Name_Id := N + 603; + Name_Shift_Right_Arithmetic : constant Name_Id := N + 604; + Name_Source_Location : constant Name_Id := N + 605; + Name_Unchecked_Conversion : constant Name_Id := N + 606; + Name_Unchecked_Deallocation : constant Name_Id := N + 607; + Name_To_Pointer : constant Name_Id := N + 608; + Last_Intrinsic_Name : constant Name_Id := N + 608; -- Names used in processing intrinsic calls - Name_Free : constant Name_Id := N + 606; + Name_Free : constant Name_Id := N + 609; -- Reserved words used only in Ada 95 - First_95_Reserved_Word : constant Name_Id := N + 607; - Name_Abstract : constant Name_Id := N + 607; - Name_Aliased : constant Name_Id := N + 608; - Name_Protected : constant Name_Id := N + 609; - Name_Until : constant Name_Id := N + 610; - Name_Requeue : constant Name_Id := N + 611; - Name_Tagged : constant Name_Id := N + 612; - Last_95_Reserved_Word : constant Name_Id := N + 612; + First_95_Reserved_Word : constant Name_Id := N + 610; + Name_Abstract : constant Name_Id := N + 610; + Name_Aliased : constant Name_Id := N + 611; + Name_Protected : constant Name_Id := N + 612; + Name_Until : constant Name_Id := N + 613; + Name_Requeue : constant Name_Id := N + 614; + Name_Tagged : constant Name_Id := N + 615; + Last_95_Reserved_Word : constant Name_Id := N + 615; subtype Ada_95_Reserved_Words is Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word; -- Miscellaneous names used in semantic checking - Name_Raise_Exception : constant Name_Id := N + 613; + Name_Raise_Exception : constant Name_Id := N + 616; -- Additional reserved words and identifiers used in GNAT Project Files -- Note that Name_External is already previously declared - Name_Ada_Roots : constant Name_Id := N + 614; - Name_Archive_Builder : constant Name_Id := N + 615; - Name_Archive_Indexer : constant Name_Id := N + 616; - Name_Archive_Suffix : constant Name_Id := N + 617; - Name_Binder : constant Name_Id := N + 618; - Name_Binder_Prefix : constant Name_Id := N + 619; - Name_Body_Suffix : constant Name_Id := N + 620; - Name_Builder : constant Name_Id := N + 621; - Name_Builder_Switches : constant Name_Id := N + 622; - Name_Compiler : constant Name_Id := N + 623; - Name_Compiler_Kind : constant Name_Id := N + 624; - Name_Config_Body_File_Name : constant Name_Id := N + 625; - Name_Config_Body_File_Name_Pattern : constant Name_Id := N + 626; - Name_Config_File_Switches : constant Name_Id := N + 627; - Name_Config_File_Unique : constant Name_Id := N + 628; - Name_Config_Spec_File_Name : constant Name_Id := N + 629; - Name_Config_Spec_File_Name_Pattern : constant Name_Id := N + 630; - Name_Cross_Reference : constant Name_Id := N + 631; - Name_Default_Language : constant Name_Id := N + 632; - Name_Default_Switches : constant Name_Id := N + 633; - Name_Dependency_Driver : constant Name_Id := N + 634; - Name_Dependency_File_Kind : constant Name_Id := N + 635; - Name_Dependency_Switches : constant Name_Id := N + 636; - Name_Driver : constant Name_Id := N + 637; - Name_Excluded_Source_Dirs : constant Name_Id := N + 638; - Name_Excluded_Source_Files : constant Name_Id := N + 639; - Name_Exec_Dir : constant Name_Id := N + 640; - Name_Executable : constant Name_Id := N + 641; - Name_Executable_Suffix : constant Name_Id := N + 642; - Name_Extends : constant Name_Id := N + 643; - Name_Externally_Built : constant Name_Id := N + 644; - Name_Finder : constant Name_Id := N + 645; - Name_Global_Configuration_Pragmas : constant Name_Id := N + 646; - Name_Global_Config_File : constant Name_Id := N + 647; - Name_Gnatls : constant Name_Id := N + 648; - Name_Gnatstub : constant Name_Id := N + 649; - Name_Implementation : constant Name_Id := N + 650; - Name_Implementation_Exceptions : constant Name_Id := N + 651; - Name_Implementation_Suffix : constant Name_Id := N + 652; - Name_Include_Switches : constant Name_Id := N + 653; - Name_Include_Path : constant Name_Id := N + 654; - Name_Include_Path_File : constant Name_Id := N + 655; - Name_Language_Kind : constant Name_Id := N + 656; - Name_Language_Processing : constant Name_Id := N + 657; - Name_Languages : constant Name_Id := N + 658; - Name_Library_Ali_Dir : constant Name_Id := N + 659; - Name_Library_Auto_Init : constant Name_Id := N + 660; - Name_Library_Auto_Init_Supported : constant Name_Id := N + 661; - Name_Library_Builder : constant Name_Id := N + 662; - Name_Library_Dir : constant Name_Id := N + 663; - Name_Library_GCC : constant Name_Id := N + 664; - Name_Library_Interface : constant Name_Id := N + 665; - Name_Library_Kind : constant Name_Id := N + 666; - Name_Library_Name : constant Name_Id := N + 667; - Name_Library_Major_Minor_Id_Supported : constant Name_Id := N + 668; - Name_Library_Options : constant Name_Id := N + 669; - Name_Library_Partial_Linker : constant Name_Id := N + 670; - Name_Library_Reference_Symbol_File : constant Name_Id := N + 671; - Name_Library_Src_Dir : constant Name_Id := N + 672; - Name_Library_Support : constant Name_Id := N + 673; - Name_Library_Symbol_File : constant Name_Id := N + 674; - Name_Library_Symbol_Policy : constant Name_Id := N + 675; - Name_Library_Version : constant Name_Id := N + 676; - Name_Library_Version_Switches : constant Name_Id := N + 677; - Name_Linker : constant Name_Id := N + 678; - Name_Linker_Executable_Option : constant Name_Id := N + 679; - Name_Linker_Lib_Dir_Option : constant Name_Id := N + 680; - Name_Linker_Lib_Name_Option : constant Name_Id := N + 681; - Name_Local_Config_File : constant Name_Id := N + 682; - Name_Local_Configuration_Pragmas : constant Name_Id := N + 683; - Name_Locally_Removed_Files : constant Name_Id := N + 684; - Name_Mapping_File_Switches : constant Name_Id := N + 685; - Name_Mapping_Spec_Suffix : constant Name_Id := N + 686; - Name_Mapping_Body_Suffix : constant Name_Id := N + 687; - Name_Metrics : constant Name_Id := N + 688; - Name_Naming : constant Name_Id := N + 689; - Name_Objects_Path : constant Name_Id := N + 690; - Name_Objects_Path_File : constant Name_Id := N + 691; - Name_Object_Dir : constant Name_Id := N + 692; - Name_Pic_Option : constant Name_Id := N + 693; - Name_Pretty_Printer : constant Name_Id := N + 694; - Name_Prefix : constant Name_Id := N + 695; - Name_Project : constant Name_Id := N + 696; - Name_Roots : constant Name_Id := N + 697; - Name_Required_Switches : constant Name_Id := N + 698; - Name_Run_Path_Option : constant Name_Id := N + 699; - Name_Runtime_Project : constant Name_Id := N + 700; - Name_Shared_Library_Minimum_Switches : constant Name_Id := N + 701; - Name_Shared_Library_Prefix : constant Name_Id := N + 702; - Name_Shared_Library_Suffix : constant Name_Id := N + 703; - Name_Separate_Suffix : constant Name_Id := N + 704; - Name_Source_Dirs : constant Name_Id := N + 705; - Name_Source_Files : constant Name_Id := N + 706; - Name_Source_List_File : constant Name_Id := N + 707; - Name_Spec : constant Name_Id := N + 708; - Name_Spec_Suffix : constant Name_Id := N + 709; - Name_Specification : constant Name_Id := N + 710; - Name_Specification_Exceptions : constant Name_Id := N + 711; - Name_Specification_Suffix : constant Name_Id := N + 712; - Name_Stack : constant Name_Id := N + 713; - Name_Switches : constant Name_Id := N + 714; - Name_Symbolic_Link_Supported : constant Name_Id := N + 715; - Name_Toolchain_Description : constant Name_Id := N + 716; - Name_Toolchain_Version : constant Name_Id := N + 717; - Name_Runtime_Library_Dir : constant Name_Id := N + 718; + Name_Ada_Roots : constant Name_Id := N + 617; + Name_Archive_Builder : constant Name_Id := N + 618; + Name_Archive_Indexer : constant Name_Id := N + 619; + Name_Archive_Suffix : constant Name_Id := N + 620; + Name_Binder : constant Name_Id := N + 621; + Name_Binder_Prefix : constant Name_Id := N + 622; + Name_Body_Suffix : constant Name_Id := N + 623; + Name_Builder : constant Name_Id := N + 624; + Name_Builder_Switches : constant Name_Id := N + 625; + Name_Compiler : constant Name_Id := N + 626; + Name_Compiler_Kind : constant Name_Id := N + 627; + Name_Config_Body_File_Name : constant Name_Id := N + 628; + Name_Config_Body_File_Name_Pattern : constant Name_Id := N + 629; + Name_Config_File_Switches : constant Name_Id := N + 630; + Name_Config_File_Unique : constant Name_Id := N + 631; + Name_Config_Spec_File_Name : constant Name_Id := N + 632; + Name_Config_Spec_File_Name_Pattern : constant Name_Id := N + 633; + Name_Cross_Reference : constant Name_Id := N + 634; + Name_Default_Language : constant Name_Id := N + 635; + Name_Default_Switches : constant Name_Id := N + 636; + Name_Dependency_Driver : constant Name_Id := N + 637; + Name_Dependency_File_Kind : constant Name_Id := N + 638; + Name_Dependency_Switches : constant Name_Id := N + 639; + Name_Driver : constant Name_Id := N + 640; + Name_Excluded_Source_Dirs : constant Name_Id := N + 641; + Name_Excluded_Source_Files : constant Name_Id := N + 642; + Name_Exec_Dir : constant Name_Id := N + 643; + Name_Executable : constant Name_Id := N + 644; + Name_Executable_Suffix : constant Name_Id := N + 645; + Name_Extends : constant Name_Id := N + 646; + Name_Externally_Built : constant Name_Id := N + 647; + Name_Finder : constant Name_Id := N + 648; + Name_Global_Configuration_Pragmas : constant Name_Id := N + 649; + Name_Global_Config_File : constant Name_Id := N + 650; + Name_Gnatls : constant Name_Id := N + 651; + Name_Gnatstub : constant Name_Id := N + 652; + Name_Implementation : constant Name_Id := N + 653; + Name_Implementation_Exceptions : constant Name_Id := N + 654; + Name_Implementation_Suffix : constant Name_Id := N + 655; + Name_Include_Switches : constant Name_Id := N + 656; + Name_Include_Path : constant Name_Id := N + 657; + Name_Include_Path_File : constant Name_Id := N + 658; + Name_Language_Kind : constant Name_Id := N + 659; + Name_Language_Processing : constant Name_Id := N + 660; + Name_Languages : constant Name_Id := N + 661; + Name_Library_Ali_Dir : constant Name_Id := N + 662; + Name_Library_Auto_Init : constant Name_Id := N + 663; + Name_Library_Auto_Init_Supported : constant Name_Id := N + 664; + Name_Library_Builder : constant Name_Id := N + 665; + Name_Library_Dir : constant Name_Id := N + 666; + Name_Library_GCC : constant Name_Id := N + 667; + Name_Library_Interface : constant Name_Id := N + 668; + Name_Library_Kind : constant Name_Id := N + 669; + Name_Library_Name : constant Name_Id := N + 670; + Name_Library_Major_Minor_Id_Supported : constant Name_Id := N + 671; + Name_Library_Options : constant Name_Id := N + 672; + Name_Library_Partial_Linker : constant Name_Id := N + 673; + Name_Library_Reference_Symbol_File : constant Name_Id := N + 674; + Name_Library_Src_Dir : constant Name_Id := N + 675; + Name_Library_Support : constant Name_Id := N + 676; + Name_Library_Symbol_File : constant Name_Id := N + 677; + Name_Library_Symbol_Policy : constant Name_Id := N + 678; + Name_Library_Version : constant Name_Id := N + 679; + Name_Library_Version_Switches : constant Name_Id := N + 680; + Name_Linker : constant Name_Id := N + 681; + Name_Linker_Executable_Option : constant Name_Id := N + 682; + Name_Linker_Lib_Dir_Option : constant Name_Id := N + 683; + Name_Linker_Lib_Name_Option : constant Name_Id := N + 684; + Name_Local_Config_File : constant Name_Id := N + 685; + Name_Local_Configuration_Pragmas : constant Name_Id := N + 686; + Name_Locally_Removed_Files : constant Name_Id := N + 687; + Name_Mapping_File_Switches : constant Name_Id := N + 688; + Name_Mapping_Spec_Suffix : constant Name_Id := N + 689; + Name_Mapping_Body_Suffix : constant Name_Id := N + 690; + Name_Metrics : constant Name_Id := N + 691; + Name_Naming : constant Name_Id := N + 692; + Name_Objects_Path : constant Name_Id := N + 693; + Name_Objects_Path_File : constant Name_Id := N + 694; + Name_Object_Dir : constant Name_Id := N + 695; + Name_Pic_Option : constant Name_Id := N + 696; + Name_Pretty_Printer : constant Name_Id := N + 697; + Name_Prefix : constant Name_Id := N + 698; + Name_Project : constant Name_Id := N + 699; + Name_Roots : constant Name_Id := N + 700; + Name_Required_Switches : constant Name_Id := N + 701; + Name_Run_Path_Option : constant Name_Id := N + 702; + Name_Runtime_Project : constant Name_Id := N + 703; + Name_Shared_Library_Minimum_Switches : constant Name_Id := N + 704; + Name_Shared_Library_Prefix : constant Name_Id := N + 705; + Name_Shared_Library_Suffix : constant Name_Id := N + 706; + Name_Separate_Suffix : constant Name_Id := N + 707; + Name_Source_Dirs : constant Name_Id := N + 708; + Name_Source_Files : constant Name_Id := N + 709; + Name_Source_List_File : constant Name_Id := N + 710; + Name_Spec : constant Name_Id := N + 711; + Name_Spec_Suffix : constant Name_Id := N + 712; + Name_Specification : constant Name_Id := N + 713; + Name_Specification_Exceptions : constant Name_Id := N + 714; + Name_Specification_Suffix : constant Name_Id := N + 715; + Name_Stack : constant Name_Id := N + 716; + Name_Switches : constant Name_Id := N + 717; + Name_Symbolic_Link_Supported : constant Name_Id := N + 718; + Name_Toolchain_Description : constant Name_Id := N + 719; + Name_Toolchain_Version : constant Name_Id := N + 720; + Name_Runtime_Library_Dir : constant Name_Id := N + 721; -- Other miscellaneous names used in front end - Name_Unaligned_Valid : constant Name_Id := N + 719; + Name_Unaligned_Valid : constant Name_Id := N + 722; -- Ada 2005 reserved words - First_2005_Reserved_Word : constant Name_Id := N + 720; - Name_Interface : constant Name_Id := N + 720; - Name_Overriding : constant Name_Id := N + 721; - Name_Synchronized : constant Name_Id := N + 722; - Last_2005_Reserved_Word : constant Name_Id := N + 722; + First_2005_Reserved_Word : constant Name_Id := N + 723; + Name_Interface : constant Name_Id := N + 723; + Name_Overriding : constant Name_Id := N + 724; + Name_Synchronized : constant Name_Id := N + 725; + Last_2005_Reserved_Word : constant Name_Id := N + 725; subtype Ada_2005_Reserved_Words is Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word; -- Mark last defined name for consistency check in Snames body - Last_Predefined_Name : constant Name_Id := N + 722; + Last_Predefined_Name : constant Name_Id := N + 725; --------------------------------------- -- Subtypes Defining Name Categories -- @@ -1160,6 +1170,7 @@ package Snames is Attribute_Epsilon, Attribute_Exponent, Attribute_External_Tag, + Attribute_Fast_Math, Attribute_First, Attribute_First_Bit, Attribute_Fixed_Value, @@ -1286,12 +1297,14 @@ package Snames is type Convention_Id is ( - -- The conventions that are defined by the RM come first + -- The native-to-Ada (non-foreign) conventions come first. These include + -- the ones defined in the RM, plus Stubbed. Convention_Ada, Convention_Intrinsic, Convention_Entry, Convention_Protected, + Convention_Stubbed, -- The remaining conventions are foreign language conventions @@ -1302,8 +1315,7 @@ package Snames is Convention_CPP, Convention_Fortran, Convention_Java, - Convention_Stdcall, -- also DLL, Win32 - Convention_Stubbed); + Convention_Stdcall); -- also DLL, Win32 -- Note: Convention C_Pass_By_Copy is allowed only for record -- types (where it is treated like C except that the appropriate @@ -1314,7 +1326,7 @@ package Snames is -- Plenty of space for expansion subtype Foreign_Convention is - Convention_Id range Convention_Assembler .. Convention_Stdcall; + Convention_Id range Convention_Assembler .. Convention_Id'Last; ----------------------------------- -- Locking Policy ID Definitions -- @@ -1352,6 +1364,7 @@ package Snames is Pragma_Extend_System, Pragma_Extensions_Allowed, Pragma_External_Name_Casing, + Pragma_Favor_Top_Level, Pragma_Float_Representation, Pragma_Implicit_Packing, Pragma_Initialize_Scalars, @@ -1422,6 +1435,7 @@ package Snames is Pragma_External, Pragma_Finalize_Storage_Only, Pragma_Ident, + Pragma_Implemented_By_Entry, Pragma_Import, Pragma_Import_Exception, Pragma_Import_Function, @@ -1496,6 +1510,7 @@ package Snames is -- match existing attribute names. Pragma_AST_Entry, + Pragma_Fast_Math, Pragma_Interface, Pragma_Priority, Pragma_Storage_Size, @@ -1578,10 +1593,18 @@ package Snames is -- Test to see if the name N is the name of an operator symbol function Is_Pragma_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized pragma. Note - -- that pragmas AST_Entry, Priority, Storage_Size, and Storage_Unit are - -- recognized as pragmas by this function even though their names are - -- separate from the other pragma names. + -- Test to see if the name N is the name of a recognized pragma. Note that + -- pragmas AST_Entry, Fast_Math, Priority, Storage_Size, and Storage_Unit + -- are recognized as pragmas by this function even though their names are + -- separate from the other pragma names. For this reason, clients should + -- always use this function, rather than do range tests on Name_Id values. + + function Is_Configuration_Pragma_Name (N : Name_Id) return Boolean; + -- Test to see if the name N is the name of a recognized configuration + -- pragma. Note that pragma Fast_Math is recognized as a configuration + -- pragma by this function even though its name is separate from other + -- configuration pragma names. For this reason, clients should always + -- use this function, rather than do range tests on Name_Id values. function Is_Queuing_Policy_Name (N : Name_Id) return Boolean; -- Test to see if the name N is the name of a recognized queuing policy @@ -1620,18 +1643,17 @@ package Snames is -- to call this function with a name that is not the name of a check. function Get_Task_Dispatching_Policy_Id - (N : Name_Id) - return Task_Dispatching_Policy_Id; - -- Returns Id of task dispatching policy corresponding to given name. - -- It is an error to call this function with a name that is not the - -- name of a check. + (N : Name_Id) return Task_Dispatching_Policy_Id; + -- Returns Id of task dispatching policy corresponding to given name. It + -- is an error to call this function with a name that is not the name of + -- a defined check. procedure Record_Convention_Identifier (Id : Name_Id; Convention : Convention_Id); -- A call to this procedure, resulting from an occurrence of a pragma - -- Convention_Identifier, records that from now on an occurrence of - -- Id will be recognized as a name for the specified convention. + -- Convention_Identifier, records that from now on an occurrence of Id + -- will be recognized as a name for the specified convention. private pragma Inline (Is_Attribute_Name); diff --git a/gcc/ada/snames.h b/gcc/ada/snames.h index f94e0a2ef64..131ed99b4c9 100644 --- a/gcc/ada/snames.h +++ b/gcc/ada/snames.h @@ -76,113 +76,114 @@ extern unsigned char Get_Attribute_Id (int); #define Attr_Epsilon 29 #define Attr_Exponent 30 #define Attr_External_Tag 31 -#define Attr_First 32 -#define Attr_First_Bit 33 -#define Attr_Fixed_Value 34 -#define Attr_Fore 35 -#define Attr_Has_Access_Values 36 -#define Attr_Has_Discriminants 37 -#define Attr_Identity 38 -#define Attr_Img 39 -#define Attr_Integer_Value 40 -#define Attr_Large 41 -#define Attr_Last 42 -#define Attr_Last_Bit 43 -#define Attr_Leading_Part 44 -#define Attr_Length 45 -#define Attr_Machine_Emax 46 -#define Attr_Machine_Emin 47 -#define Attr_Machine_Mantissa 48 -#define Attr_Machine_Overflows 49 -#define Attr_Machine_Radix 50 -#define Attr_Machine_Rounding 51 -#define Attr_Machine_Rounds 52 -#define Attr_Machine_Size 53 -#define Attr_Mantissa 54 -#define Attr_Max_Size_In_Storage_Elements 55 -#define Attr_Maximum_Alignment 56 -#define Attr_Mechanism_Code 57 -#define Attr_Mod 58 -#define Attr_Model_Emin 59 -#define Attr_Model_Epsilon 60 -#define Attr_Model_Mantissa 61 -#define Attr_Model_Small 62 -#define Attr_Modulus 63 -#define Attr_Null_Parameter 64 -#define Attr_Object_Size 65 -#define Attr_Partition_ID 66 -#define Attr_Passed_By_Reference 67 -#define Attr_Pool_Address 68 -#define Attr_Pos 69 -#define Attr_Position 70 -#define Attr_Priority 71 -#define Attr_Range 72 -#define Attr_Range_Length 73 -#define Attr_Round 74 -#define Attr_Safe_Emax 75 -#define Attr_Safe_First 76 -#define Attr_Safe_Large 77 -#define Attr_Safe_Last 78 -#define Attr_Safe_Small 79 -#define Attr_Scale 80 -#define Attr_Scaling 81 -#define Attr_Signed_Zeros 82 -#define Attr_Size 83 -#define Attr_Small 84 -#define Attr_Storage_Size 85 -#define Attr_Storage_Unit 86 -#define Attr_Stream_Size 87 -#define Attr_Tag 88 -#define Attr_Target_Name 89 -#define Attr_Terminated 90 -#define Attr_To_Address 91 -#define Attr_Type_Class 92 -#define Attr_UET_Address 93 -#define Attr_Unbiased_Rounding 94 -#define Attr_Unchecked_Access 95 -#define Attr_Unconstrained_Array 96 -#define Attr_Universal_Literal_String 97 -#define Attr_Unrestricted_Access 98 -#define Attr_VADS_Size 99 -#define Attr_Val 100 -#define Attr_Valid 101 -#define Attr_Value_Size 102 -#define Attr_Version 103 -#define Attr_Wchar_T_Size 104 -#define Attr_Wide_Wide_Width 105 -#define Attr_Wide_Width 106 -#define Attr_Width 107 -#define Attr_Word_Size 108 -#define Attr_Adjacent 109 -#define Attr_Ceiling 110 -#define Attr_Copy_Sign 111 -#define Attr_Floor 112 -#define Attr_Fraction 113 -#define Attr_Image 114 -#define Attr_Input 115 -#define Attr_Machine 116 -#define Attr_Max 117 -#define Attr_Min 118 -#define Attr_Model 119 -#define Attr_Pred 120 -#define Attr_Remainder 121 -#define Attr_Rounding 122 -#define Attr_Succ 123 -#define Attr_Truncation 124 -#define Attr_Value 125 -#define Attr_Wide_Image 126 -#define Attr_Wide_Wide_Image 127 -#define Attr_Wide_Value 128 -#define Attr_Wide_Wide_Value 129 -#define Attr_Output 130 -#define Attr_Read 131 -#define Attr_Write 132 -#define Attr_Elab_Body 133 -#define Attr_Elab_Spec 134 -#define Attr_Storage_Pool 135 -#define Attr_Base 136 -#define Attr_Class 137 -#define Attr_Stub_Type 138 +#define Attr_Fast_Math 32 +#define Attr_First 33 +#define Attr_First_Bit 34 +#define Attr_Fixed_Value 35 +#define Attr_Fore 36 +#define Attr_Has_Access_Values 37 +#define Attr_Has_Discriminants 38 +#define Attr_Identity 39 +#define Attr_Img 40 +#define Attr_Integer_Value 41 +#define Attr_Large 42 +#define Attr_Last 43 +#define Attr_Last_Bit 44 +#define Attr_Leading_Part 45 +#define Attr_Length 46 +#define Attr_Machine_Emax 47 +#define Attr_Machine_Emin 48 +#define Attr_Machine_Mantissa 49 +#define Attr_Machine_Overflows 50 +#define Attr_Machine_Radix 51 +#define Attr_Machine_Rounding 52 +#define Attr_Machine_Rounds 53 +#define Attr_Machine_Size 54 +#define Attr_Mantissa 55 +#define Attr_Max_Size_In_Storage_Elements 56 +#define Attr_Maximum_Alignment 57 +#define Attr_Mechanism_Code 58 +#define Attr_Mod 59 +#define Attr_Model_Emin 60 +#define Attr_Model_Epsilon 61 +#define Attr_Model_Mantissa 62 +#define Attr_Model_Small 63 +#define Attr_Modulus 64 +#define Attr_Null_Parameter 65 +#define Attr_Object_Size 66 +#define Attr_Partition_ID 67 +#define Attr_Passed_By_Reference 68 +#define Attr_Pool_Address 69 +#define Attr_Pos 70 +#define Attr_Position 71 +#define Attr_Priority 72 +#define Attr_Range 73 +#define Attr_Range_Length 74 +#define Attr_Round 75 +#define Attr_Safe_Emax 76 +#define Attr_Safe_First 77 +#define Attr_Safe_Large 78 +#define Attr_Safe_Last 79 +#define Attr_Safe_Small 80 +#define Attr_Scale 81 +#define Attr_Scaling 82 +#define Attr_Signed_Zeros 83 +#define Attr_Size 84 +#define Attr_Small 85 +#define Attr_Storage_Size 86 +#define Attr_Storage_Unit 87 +#define Attr_Stream_Size 88 +#define Attr_Tag 89 +#define Attr_Target_Name 90 +#define Attr_Terminated 91 +#define Attr_To_Address 92 +#define Attr_Type_Class 93 +#define Attr_UET_Address 94 +#define Attr_Unbiased_Rounding 95 +#define Attr_Unchecked_Access 96 +#define Attr_Unconstrained_Array 97 +#define Attr_Universal_Literal_String 98 +#define Attr_Unrestricted_Access 99 +#define Attr_VADS_Size 100 +#define Attr_Val 101 +#define Attr_Valid 102 +#define Attr_Value_Size 103 +#define Attr_Version 104 +#define Attr_Wchar_T_Size 105 +#define Attr_Wide_Wide_Width 106 +#define Attr_Wide_Width 107 +#define Attr_Width 108 +#define Attr_Word_Size 109 +#define Attr_Adjacent 110 +#define Attr_Ceiling 111 +#define Attr_Copy_Sign 112 +#define Attr_Floor 113 +#define Attr_Fraction 114 +#define Attr_Image 115 +#define Attr_Input 116 +#define Attr_Machine 117 +#define Attr_Max 118 +#define Attr_Min 119 +#define Attr_Model 120 +#define Attr_Pred 121 +#define Attr_Remainder 122 +#define Attr_Rounding 123 +#define Attr_Succ 124 +#define Attr_Truncation 125 +#define Attr_Value 126 +#define Attr_Wide_Image 127 +#define Attr_Wide_Wide_Image 128 +#define Attr_Wide_Value 129 +#define Attr_Wide_Wide_Value 130 +#define Attr_Output 131 +#define Attr_Read 132 +#define Attr_Write 133 +#define Attr_Elab_Body 134 +#define Attr_Elab_Spec 135 +#define Attr_Storage_Pool 136 +#define Attr_Base 137 +#define Attr_Class 138 +#define Attr_Stub_Type 139 /* Define the numeric values for the conventions. */ @@ -190,15 +191,15 @@ extern unsigned char Get_Attribute_Id (int); #define Convention_Intrinsic 1 #define Convention_Entry 2 #define Convention_Protected 3 -#define Convention_Assembler 4 -#define Convention_C 5 -#define Convention_CIL 6 -#define Convention_COBOL 7 -#define Convention_CPP 8 -#define Convention_Fortran 9 -#define Convention_Java 10 -#define Convention_Stdcall 11 -#define Convention_Stubbed 12 +#define Convention_Stubbed 4 +#define Convention_Assembler 5 +#define Convention_C 6 +#define Convention_CIL 7 +#define Convention_COBOL 8 +#define Convention_CPP 9 +#define Convention_Fortran 10 +#define Convention_Java 11 +#define Convention_Stdcall 12 /* Define the function to check if a Name_Id value is a valid pragma */ @@ -235,145 +236,148 @@ extern unsigned char Get_Pragma_Id (int); #define Pragma_Extend_System 17 #define Pragma_Extensions_Allowed 18 #define Pragma_External_Name_Casing 19 -#define Pragma_Float_Representation 20 -#define Pragma_Implicit_Packing 21 -#define Pragma_Initialize_Scalars 22 -#define Pragma_Interrupt_State 23 -#define Pragma_License 24 -#define Pragma_Locking_Policy 25 -#define Pragma_Long_Float 26 -#define Pragma_No_Run_Time 27 -#define Pragma_No_Strict_Aliasing 28 -#define Pragma_Normalize_Scalars 29 -#define Pragma_Polling 30 -#define Pragma_Persistent_BSS 31 -#define Pragma_Priority_Specific_Dispatching 32 -#define Pragma_Profile 33 -#define Pragma_Profile_Warnings 34 -#define Pragma_Propagate_Exceptions 35 -#define Pragma_Queuing_Policy 36 -#define Pragma_Ravenscar 37 -#define Pragma_Restricted_Run_Time 38 -#define Pragma_Restrictions 39 -#define Pragma_Restriction_Warnings 40 -#define Pragma_Reviewable 41 -#define Pragma_Source_File_Name 42 -#define Pragma_Source_File_Name_Project 43 -#define Pragma_Style_Checks 44 -#define Pragma_Suppress 45 -#define Pragma_Suppress_Exception_Locations 46 -#define Pragma_Task_Dispatching_Policy 47 -#define Pragma_Universal_Data 48 -#define Pragma_Unsuppress 49 -#define Pragma_Use_VADS_Size 50 -#define Pragma_Validity_Checks 51 -#define Pragma_Warnings 52 -#define Pragma_Wide_Character_Encoding 53 -#define Pragma_Abort_Defer 54 -#define Pragma_All_Calls_Remote 55 -#define Pragma_Annotate 56 -#define Pragma_Assert 57 -#define Pragma_Asynchronous 58 -#define Pragma_Atomic 59 -#define Pragma_Atomic_Components 60 -#define Pragma_Attach_Handler 61 -#define Pragma_CIL_Constructor 62 -#define Pragma_Comment 63 -#define Pragma_Common_Object 64 -#define Pragma_Complete_Representation 65 -#define Pragma_Complex_Representation 66 -#define Pragma_Controlled 67 -#define Pragma_Convention 68 -#define Pragma_CPP_Class 69 -#define Pragma_CPP_Constructor 70 -#define Pragma_CPP_Virtual 71 -#define Pragma_CPP_Vtable 72 -#define Pragma_Debug 73 -#define Pragma_Elaborate 74 -#define Pragma_Elaborate_All 75 -#define Pragma_Elaborate_Body 76 -#define Pragma_Export 77 -#define Pragma_Export_Exception 78 -#define Pragma_Export_Function 79 -#define Pragma_Export_Object 80 -#define Pragma_Export_Procedure 81 -#define Pragma_Export_Value 82 -#define Pragma_Export_Valued_Procedure 83 -#define Pragma_External 84 -#define Pragma_Finalize_Storage_Only 85 -#define Pragma_Ident 86 -#define Pragma_Import 87 -#define Pragma_Import_Exception 88 -#define Pragma_Import_Function 89 -#define Pragma_Import_Object 90 -#define Pragma_Import_Procedure 91 -#define Pragma_Import_Valued_Procedure 92 -#define Pragma_Inline 93 -#define Pragma_Inline_Always 94 -#define Pragma_Inline_Generic 95 -#define Pragma_Inspection_Point 96 -#define Pragma_Interface_Name 97 -#define Pragma_Interrupt_Handler 98 -#define Pragma_Interrupt_Priority 99 -#define Pragma_Java_Constructor 100 -#define Pragma_Java_Interface 101 -#define Pragma_Keep_Names 102 -#define Pragma_Link_With 103 -#define Pragma_Linker_Alias 104 -#define Pragma_Linker_Constructor 105 -#define Pragma_Linker_Destructor 106 -#define Pragma_Linker_Options 107 -#define Pragma_Linker_Section 108 -#define Pragma_List 109 -#define Pragma_Machine_Attribute 110 -#define Pragma_Main 111 -#define Pragma_Main_Storage 112 -#define Pragma_Memory_Size 113 -#define Pragma_No_Body 114 -#define Pragma_No_Return 115 -#define Pragma_Obsolescent 116 -#define Pragma_Optimize 117 -#define Pragma_Pack 118 -#define Pragma_Page 119 -#define Pragma_Passive 120 -#define Pragma_Preelaborable_Initialization 121 -#define Pragma_Preelaborate 122 -#define Pragma_Preelaborate_05 123 -#define Pragma_Psect_Object 124 -#define Pragma_Pure 125 -#define Pragma_Pure_05 126 -#define Pragma_Pure_Function 127 -#define Pragma_Remote_Call_Interface 128 -#define Pragma_Remote_Types 129 -#define Pragma_Share_Generic 130 -#define Pragma_Shared 131 -#define Pragma_Shared_Passive 132 -#define Pragma_Source_Reference 133 -#define Pragma_Static_Elaboration_Desired 134 -#define Pragma_Stream_Convert 135 -#define Pragma_Subtitle 136 -#define Pragma_Suppress_All 137 -#define Pragma_Suppress_Debug_Info 138 -#define Pragma_Suppress_Initialization 139 -#define Pragma_System_Name 140 -#define Pragma_Task_Info 141 -#define Pragma_Task_Name 142 -#define Pragma_Task_Storage 143 -#define Pragma_Time_Slice 144 -#define Pragma_Title 145 -#define Pragma_Unchecked_Union 146 -#define Pragma_Unimplemented_Unit 147 -#define Pragma_Universal_Aliasing 148 -#define Pragma_Unreferenced 149 -#define Pragma_Unreferenced_Objects 150 -#define Pragma_Unreserve_All_Interrupts 151 -#define Pragma_Volatile 152 -#define Pragma_Volatile_Components 153 -#define Pragma_Weak_External 154 -#define Pragma_AST_Entry 155 -#define Pragma_Interface 156 -#define Pragma_Priority 157 -#define Pragma_Storage_Size 158 -#define Pragma_Storage_Unit 159 +#define Pragma_Favor_Top_Level 20 +#define Pragma_Float_Representation 21 +#define Pragma_Implicit_Packing 22 +#define Pragma_Initialize_Scalars 23 +#define Pragma_Interrupt_State 24 +#define Pragma_License 25 +#define Pragma_Locking_Policy 26 +#define Pragma_Long_Float 27 +#define Pragma_No_Run_Time 28 +#define Pragma_No_Strict_Aliasing 29 +#define Pragma_Normalize_Scalars 30 +#define Pragma_Polling 31 +#define Pragma_Persistent_BSS 32 +#define Pragma_Priority_Specific_Dispatching 33 +#define Pragma_Profile 34 +#define Pragma_Profile_Warnings 35 +#define Pragma_Propagate_Exceptions 36 +#define Pragma_Queuing_Policy 37 +#define Pragma_Ravenscar 38 +#define Pragma_Restricted_Run_Time 39 +#define Pragma_Restrictions 40 +#define Pragma_Restriction_Warnings 41 +#define Pragma_Reviewable 42 +#define Pragma_Source_File_Name 43 +#define Pragma_Source_File_Name_Project 44 +#define Pragma_Style_Checks 45 +#define Pragma_Suppress 46 +#define Pragma_Suppress_Exception_Locations 47 +#define Pragma_Task_Dispatching_Policy 48 +#define Pragma_Universal_Data 49 +#define Pragma_Unsuppress 50 +#define Pragma_Use_VADS_Size 51 +#define Pragma_Validity_Checks 52 +#define Pragma_Warnings 53 +#define Pragma_Wide_Character_Encoding 54 +#define Pragma_Abort_Defer 55 +#define Pragma_All_Calls_Remote 56 +#define Pragma_Annotate 57 +#define Pragma_Assert 58 +#define Pragma_Asynchronous 59 +#define Pragma_Atomic 60 +#define Pragma_Atomic_Components 61 +#define Pragma_Attach_Handler 62 +#define Pragma_CIL_Constructor 63 +#define Pragma_Comment 64 +#define Pragma_Common_Object 65 +#define Pragma_Complete_Representation 66 +#define Pragma_Complex_Representation 67 +#define Pragma_Controlled 68 +#define Pragma_Convention 69 +#define Pragma_CPP_Class 70 +#define Pragma_CPP_Constructor 71 +#define Pragma_CPP_Virtual 72 +#define Pragma_CPP_Vtable 73 +#define Pragma_Debug 74 +#define Pragma_Elaborate 75 +#define Pragma_Elaborate_All 76 +#define Pragma_Elaborate_Body 77 +#define Pragma_Export 78 +#define Pragma_Export_Exception 79 +#define Pragma_Export_Function 80 +#define Pragma_Export_Object 81 +#define Pragma_Export_Procedure 82 +#define Pragma_Export_Value 83 +#define Pragma_Export_Valued_Procedure 84 +#define Pragma_External 85 +#define Pragma_Finalize_Storage_Only 86 +#define Pragma_Ident 87 +#define Pragma_Implemented_By_Entry 88 +#define Pragma_Import 89 +#define Pragma_Import_Exception 90 +#define Pragma_Import_Function 91 +#define Pragma_Import_Object 92 +#define Pragma_Import_Procedure 93 +#define Pragma_Import_Valued_Procedure 94 +#define Pragma_Inline 95 +#define Pragma_Inline_Always 96 +#define Pragma_Inline_Generic 97 +#define Pragma_Inspection_Point 98 +#define Pragma_Interface_Name 99 +#define Pragma_Interrupt_Handler 100 +#define Pragma_Interrupt_Priority 101 +#define Pragma_Java_Constructor 102 +#define Pragma_Java_Interface 103 +#define Pragma_Keep_Names 104 +#define Pragma_Link_With 105 +#define Pragma_Linker_Alias 106 +#define Pragma_Linker_Constructor 107 +#define Pragma_Linker_Destructor 108 +#define Pragma_Linker_Options 109 +#define Pragma_Linker_Section 110 +#define Pragma_List 111 +#define Pragma_Machine_Attribute 112 +#define Pragma_Main 113 +#define Pragma_Main_Storage 114 +#define Pragma_Memory_Size 115 +#define Pragma_No_Body 116 +#define Pragma_No_Return 117 +#define Pragma_Obsolescent 118 +#define Pragma_Optimize 119 +#define Pragma_Pack 120 +#define Pragma_Page 121 +#define Pragma_Passive 122 +#define Pragma_Preelaborable_Initialization 123 +#define Pragma_Preelaborate 124 +#define Pragma_Preelaborate_05 125 +#define Pragma_Psect_Object 126 +#define Pragma_Pure 127 +#define Pragma_Pure_05 128 +#define Pragma_Pure_Function 129 +#define Pragma_Remote_Call_Interface 130 +#define Pragma_Remote_Types 131 +#define Pragma_Share_Generic 132 +#define Pragma_Shared 133 +#define Pragma_Shared_Passive 134 +#define Pragma_Source_Reference 135 +#define Pragma_Static_Elaboration_Desired 136 +#define Pragma_Stream_Convert 137 +#define Pragma_Subtitle 138 +#define Pragma_Suppress_All 139 +#define Pragma_Suppress_Debug_Info 140 +#define Pragma_Suppress_Initialization 141 +#define Pragma_System_Name 142 +#define Pragma_Task_Info 143 +#define Pragma_Task_Name 144 +#define Pragma_Task_Storage 145 +#define Pragma_Time_Slice 146 +#define Pragma_Title 147 +#define Pragma_Unchecked_Union 148 +#define Pragma_Unimplemented_Unit 149 +#define Pragma_Universal_Aliasing 150 +#define Pragma_Unreferenced 151 +#define Pragma_Unreferenced_Objects 152 +#define Pragma_Unreserve_All_Interrupts 153 +#define Pragma_Volatile 154 +#define Pragma_Volatile_Components 155 +#define Pragma_Weak_External 156 +#define Pragma_AST_Entry 157 +#define Pragma_Fast_Math 158 +#define Pragma_Interface 159 +#define Pragma_Priority 160 +#define Pragma_Storage_Size 161 +#define Pragma_Storage_Unit 162 /* End of snames.h (C version of Snames package spec) */ |