-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 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- --
Partition_ID'Image (Partition));
Garbage_Collector.Allocate (Anonymous);
- -- We substracted the size of the header from the size of the
+ -- We subtracted the size of the header from the size of the
-- global message in order to provide immediatly Params size
Anonymous.Element.Start
-Wed Jul 14 23:16:59 2004 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
+2004-07-15 Robert Dewar <dewar@gnat.com>
+
+ * makegpr.adb, s-secsta.ads, sem_ch3.adb, sem_case.adb: Minor
+ reformatting
+
+ * gnat_ugn.texi: Add instantiation of direct_io or sequential_io with
+ access values as an example of a warning.
+
+ * gnat_rm.texi: Document new attribute Has_Access_Values
+
+ * gnat-style.texi: Document that box comments belong on nested
+ subprograms
+
+ * sem_util.ads (Has_Access_Values): Improved documentation
+
+ * s-finimp.ads, s-finimp.adb: Fix spelling error in comment
+
+ * sem_prag.adb (Check_Duplicated_Export_Name): New procedure
+ (Process_Interface_Name): Call to this new procedure
+ (Set_Extended_Import_Export_External_Name): Call to this new procedure
+
+ * s-mastop-x86.adb, 9drpc.adb: Fix spelling error in comment
+
+ * a-direio.ads, a-sequio.ads: Warn if Element_Type has access values
+
+ * einfo.ads: Minor comment typo fixed
+
+2004-07-15 Jose Ruiz <ruiz@act-europe.fr>
+
+ * snames.adb: Add _atcb.
+
+ * snames.ads: Add Name_uATCB.
+
+ * s-tarest.adb (Create_Restricted_Task): ATCBs are always preallocated
+ (in the expanded code) when using the restricted run time.
+
+ * s-tarest.ads (Create_Restricted_Task): Created_Task transformed into
+ a in parameter in order to allow ATCBs to be preallocated (in the
+ expanded code).
+
+ * s-taskin.adb (Initialize_ATCB): T converted into a in parameter in
+ order to allow ATCBs to be preallocated. In case of error, the ATCB is
+ deallocated in System.Tasking.Stages.
+
+ * s-taskin.ads (Initialize_ATCB): T converted into a in parameter in
+ order to allow ATCBs to be preallocated.
+
+ * s-tassta.adb (Create_Task): In case of error the ATCB is deallocated
+ here. It was previously done in Initialize_ATCB.
+
+ * rtsfind.ads: Make the Ada_Task_Control_Block visible.
+
+ * exp_ch9.adb: Preallocate the Ada_Task_Control_Block when using the
+ Restricted run time.
+
+ * exp_ch3.adb: When using the Restricted run time, pass the
+ preallocated Ada_Task_Control_Block when creating a task.
+
+2004-07-15 Ed Schonberg <schonberg@gnat.com>
+
+ * sem_util.adb (Normalize_Actuals): If there are no actuals on a
+ function call that is itself an actual in an enclosing call, diagnose
+ problem here rather than assuming that resolution will catch it.
+
+ * sem_ch7.adb (Analyze_Package_Specification): If the specification is
+ the local copy of a generic unit for a formal package, and the generic
+ is a child unit, install private part of ancestors before compiling
+ private part of spec.
+
+ * sem_cat.adb (Validate_Categorization_Dependency): Simplify code to
+ use scope entities rather than tree structures, to handle properly
+ parent units that are instances rewritten as bodies for inlining
+ purposes.
+
+ * sem_ch10.adb (Get_Parent_Entity, Implicit_With_On_Parent,
+ Remove_Parents): Handle properly a parent unit that is an
+ instantiation, when the unit has been rewritten as a body for inlining
+ purposes.
+
+ * par.adb (Goto_List): Global variable to collect goto statements in a
+ given unit, for use in detecting natural loops.
+
+ * par-ch5.adb (P_Goto_Statement): Add goto to global Goto_List, for
+ use in detecting natural loops.
+
+ * par-labl.adb (Find_Natural_Loops): Recognize loops create by
+ backwards goto's, and rewrite as a infinite loop, to improve locality
+ of temporaries.
+
+ * exp_util.adb (Force_Evaluation): Recognize a left-hand side
+ subcomponent that includes an indexed reference, to prevent the
+ generation of copies that would miscompile the desired assignment
+ statement.
+ (Build_Task_Image_Decls): Add a numeric suffix to
+ generated name for string variable, to avoid spurious conflicts with
+ the name of the type of a single protected object.
+
+ * exp_ch4.adb (Expand_Array_Equality): If indices are distinct, use a
+ loop with an explicit exit statement, to avoid generating an
+ out-of-range value with 'Succ leading to spurious constraint_errors
+ when compiling with -gnatVo.
+
+2004-07-15 Thomas Quinot <quinot@act-europe.fr>
+
+ * sem_ch4.adb (Analyze_Slice): Always call Analyze on the prefix: it
+ might not be analyzed yet, even if its Etype is already set (case of an
+ unchecked conversion built using Unchecked_Convert_To, for example).
+ If the prefix has already been analyzed, this will be a nop anyway.
+
+ * exp_ch5.adb (Make_Tag_Ctrl_Assignment): For an assignment of a
+ controller type, or an assignment of a record type with controlled
+ components, copy only user data, and leave the finalization chain
+ pointers untouched.
+
+2004-07-15 Vincent Celier <celier@gnat.com>
+
+ * make.adb (Collect_Arguments): Improve error message when attempting
+ to compile a source not part of any project, when -x is not used.
+
+ * prj.ads: (Defined_Variable_Kind): New subtype
+
+ * prj-attr.adb (Register_New_Package): Two new procedures to register
+ a package with or without its attributes.
+ (Register_New_Attribute): Mew procedure to register a new attribute in a
+ package.
+ New attribute oriented subprograms: Attribute_Node_Id_Of,
+ Attribute_Kind_Of, Set_Attribute_Kind_Of, Attribute_Name_Of,
+ Variable_Kind_Of, Set_Variable_Kind_Of, Optional_Index_Of,
+ Next_Attribute.
+ New package oriented subprograms: Package_Node_Id_Of,
+ Add_Unknown_Package, First_Attribute_Of, Add_Attribute.
+
+ * prj-attr.ads (Attribute_Node_Id): Now a private, self initialized
+ type.
+ (Package_Node_Id): Now a private, self initialized type
+ (Register_New_Package): New procedure to register a package with its
+ attributes.
+ New attribute oriented subprograms: Attribute_Node_Id_Of,
+ Attribute_Kind_Of, Set_Attribute_Kind_Of, Attribute_Name_Of,
+ Variable_Kind_Of, Set_Variable_Kind_Of, Optional_Index_Of,
+ Next_Attribute.
+ New package oriented subprograms: Package_Node_Id_Of,
+ Add_Unknown_Package, First_Attribute_Of, Add_Attribute.
+
+ * prj-dect.adb (Parse_Attribute_Declaration,
+ Parse_Package_Declaration): Adapt to new spec of Prj.Attr.
+
+ * prj-makr.adb (Make): Parse existing project file before creating
+ other files. Fail if there was an error during parsing.
+
+ * prj-proc.adb (Add_Attributes, Process_Declarative_Items): Adapt to
+ new spec of Prj.Attr.
+
+ * prj-strt.adb (Attribute_Reference, Parse_Variable_Reference): Adapt
+ to new spec of Prj.Attr.
+
+2004-07-15 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
+
+ * utils2.c: Fix typo in comment.
+
+2004-07-14 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
* trans.c (add_decl_expr): Clear TREE_READONLY if clear DECL_INITIAL.
* utils.c (unchecked_convert): Don't do two VIEW_CONVERT_EXPRs.
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1999 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
package Ada.Direct_IO is
+ pragma Compile_Time_Warning
+ (Element_Type'Has_Access_Values,
+ "?Element_Type for Direct_'I'O instance has access values");
+
type File_Type is limited private;
type File_Mode is (In_File, Inout_File, Out_File);
-- used in this package and System.File_IO.
for File_Mode use
- (In_File => 0, -- System.File_IO.File_Mode'Pos (In_File)
- Inout_File => 1, -- System.File_IO.File_Mode'Pos (Inout_File);
- Out_File => 2); -- System.File_IO.File_Mode'Pos (Out_File)
+ (In_File => 0, -- System.File_IO.File_Mode'Pos (In_File)
+ Inout_File => 1, -- System.File_IO.File_Mode'Pos (Inout_File);
+ Out_File => 2); -- System.File_IO.File_Mode'Pos (Out_File)
type Count is range 0 .. System.Direct_IO.Count'Last;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1997 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
package Ada.Sequential_IO is
+ pragma Compile_Time_Warning
+ (Element_Type'Has_Access_Values,
+ "?Element_Type for Sequential_'I'O instance has access values");
+
type File_Type is limited private;
type File_Mode is (In_File, Out_File, Append_File);
-- If the IF/ELSIF condition has the form "[NOT] OBJ RELOP VAL",
-- where OBJ is a reference to an entity with a Current_Value field,
-- RELOP is one of the six relational operators, and VAL is a compile-
--- time known valoue, then the Current_Value field if OBJ is set to
+-- time known value, then the Current_Value field if OBJ is set to
-- point to the N_If_Statement or N_Elsif_Part node of the relevant
-- construct. For more details on this usage, see the procedure
-- Exp_Util.Get_Current_Value_Condition.
-- to bind any interrupt (signal) entries.
if Is_Task_Record_Type (Rec_Type) then
+
+ -- In the case of the restricted run time the ATCB has already
+ -- been preallocated.
+
+ if Restricted_Profile then
+ Append_To (Statement_List,
+ Make_Assignment_Statement (Loc,
+ Name => Make_Selected_Component (Loc,
+ Prefix => Make_Identifier (Loc, Name_uInit),
+ Selector_Name => Make_Identifier (Loc, Name_uTask_Id)),
+ Expression => Make_Attribute_Reference (Loc,
+ Prefix =>
+ Make_Selected_Component (Loc,
+ Prefix => Make_Identifier (Loc, Name_uInit),
+ Selector_Name =>
+ Make_Identifier (Loc, Name_uATCB)),
+ Attribute_Name => Name_Unchecked_Access)));
+ end if;
+
Append_To (Statement_List, Make_Task_Create_Call (Rec_Type));
declare
-- end if;
-- declare
- -- B1 : Index_T1 := B'first (1)
+ -- A1 : Index_T1 := A'first (1);
+ -- B1 : Index_T1 := B'first (1);
-- begin
- -- for A1 in A'range (1) loop
+ -- loop
-- declare
- -- B2 : Index_T2 := B'first (2)
+ -- A2 : Index_T2 := A'first (2);
+ -- B2 : Index_T2 := B'first (2);
-- begin
- -- for A2 in A'range (2) loop
+ -- loop
-- if A (A1, A2) /= B (B1, B2) then
-- return False;
-- end if;
+ -- exit when A2 = A'last (2);
+ -- A2 := Index_T2'succ (A2);
-- B2 := Index_T2'succ (B2);
-- end loop;
-- end;
+ -- exit when A1 = A'last (1);
+ -- A1 := Index_T1'succ (A1);
-- B1 := Index_T1'succ (B1);
-- end loop;
-- end;
-- has a bound depending on a discriminant, then we use the base type
-- since otherwise we have an escaped discriminant in the function.
+ -- If both arrays are constrained and have the same bounds, we can
+ -- generate a loop with an explicit iteration scheme using a 'Range
+ -- attribute over the first array.
+
function Expand_Array_Equality
(Nod : Node_Id;
Lhs : Node_Id;
-- This procedure returns the following code
--
-- declare
- -- Bn : Index_T := B'First (n);
+ -- Bn : Index_T := B'First (N);
-- begin
- -- for An in A'range (n) loop
+ -- loop
-- xxx
+ -- exit when An = A'Last (N);
+ -- An := Index_T'Succ (An)
-- Bn := Index_T'Succ (Bn)
-- end loop;
-- end;
--
- -- Note: we don't need Bn or the declare block when the index types
- -- of the two arrays are constrained and identical.
+ -- If both indices are constrained and identical, the procedure
+ -- returns a simpler loop:
+ --
+ -- for An in A'Range (N) loop
+ -- xxx
+ -- end loop
--
- -- where N is the value of "n" in the above code. Index is the
+ -- N is the dimension for which we are generating a loop. Index is the
-- N'th index node, whose Etype is Index_Type_n in the above code.
-- The xxx statement is either the loop or declare for the next
-- dimension or if this is the last dimension the comparison
-- of corresponding components of the arrays.
--
- -- Note: if the index types are identical and constrained, we
- -- need only one index, so we generate only An and we do not
- -- need the declare block.
- --
-- The actual way the code works is to return the comparison
-- of corresponding components for the N+1 call. That's neater!
Handle_One_Dimension (N + 1, Next_Index (Index)));
if Need_Separate_Indexes then
+ -- Generate guard for loop, followed by increments of indices.
+
+ Append_To (Stm_List,
+ Make_Exit_Statement (Loc,
+ Condition =>
+ Make_Op_Eq (Loc,
+ Left_Opnd => New_Reference_To (An, Loc),
+ Right_Opnd => Arr_Attr (A, Name_Last, N))));
+
+ Append_To (Stm_List,
+ Make_Assignment_Statement (Loc,
+ Name => New_Reference_To (An, Loc),
+ Expression =>
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Reference_To (Index_T, Loc),
+ Attribute_Name => Name_Succ,
+ Expressions => New_List (New_Reference_To (An, Loc)))));
+
Append_To (Stm_List,
Make_Assignment_Statement (Loc,
Name => New_Reference_To (Bn, Loc),
Expressions => New_List (New_Reference_To (Bn, Loc)))));
end if;
- Loop_Stm :=
- Make_Implicit_Loop_Statement (Nod,
- Statements => Stm_List,
- Iteration_Scheme =>
- Make_Iteration_Scheme (Loc,
- Loop_Parameter_Specification =>
- Make_Loop_Parameter_Specification (Loc,
- Defining_Identifier => An,
- Discrete_Subtype_Definition =>
- Arr_Attr (A, Name_Range, N))));
-
- -- If separate indexes, need a declare block to declare Bn
+ -- If separate indexes, we need a declare block for An and Bn,
+ -- and a loop without an iteration scheme.
if Need_Separate_Indexes then
+ Loop_Stm :=
+ Make_Implicit_Loop_Statement (Nod, Statements => Stm_List);
+
return
Make_Block_Statement (Loc,
Declarations => New_List (
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => An,
+ Object_Definition => New_Reference_To (Index_T, Loc),
+ Expression => Arr_Attr (A, Name_First, N)),
+
Make_Object_Declaration (Loc,
Defining_Identifier => Bn,
Object_Definition => New_Reference_To (Index_T, Loc),
Expression => Arr_Attr (B, Name_First, N))),
+
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (Loop_Stm)));
- -- If no separate indexes, return loop statement on its own
+ -- If no separate indexes, return loop statement with explicit
+ -- iteration scheme on its own
else
+ Loop_Stm :=
+ Make_Implicit_Loop_Statement (Nod,
+ Statements => Stm_List,
+ Iteration_Scheme =>
+ Make_Iteration_Scheme (Loc,
+ Loop_Parameter_Specification =>
+ Make_Loop_Parameter_Specification (Loc,
+ Defining_Identifier => An,
+ Discrete_Subtype_Definition =>
+ Arr_Attr (A, Name_Range, N))));
return Loop_Stm;
end if;
end Handle_One_Dimension;
with Stand; use Stand;
with Stringt; use Stringt;
with Tbuild; use Tbuild;
+with Ttypes; use Ttypes;
with Uintp; use Uintp;
with Validsw; use Validsw;
-- of representation.
function Make_Tag_Ctrl_Assignment (N : Node_Id) return List_Id;
- -- Generate the necessary code for controlled and Tagged assignment,
+ -- Generate the necessary code for controlled and tagged assignment,
-- that is to say, finalization of the target before, adjustement of
-- the target after and save and restore of the tag and finalization
-- pointers which are not 'part of the value' and must not be changed
Res : List_Id;
Tag_Tmp : Entity_Id;
- Prev_Tmp : Entity_Id;
- Next_Tmp : Entity_Id;
- Ctrl_Ref : Node_Id;
- Ctrl_Ref2 : Node_Id := Empty;
- Prev_Tmp2 : Entity_Id := Empty; -- prevent warning
- Next_Tmp2 : Entity_Id := Empty; -- prevent warning
+ Original_Size, Range_Type, Opaque_Type : Entity_Id;
begin
Res := New_List;
With_Detach => New_Reference_To (Standard_False, Loc)));
end if;
- Next_Tmp := Make_Defining_Identifier (Loc, New_Internal_Name ('C'));
-
-- Save the Tag in a local variable Tag_Tmp
if Save_Tag then
Tag_Tmp := Empty;
end if;
- -- Save the Finalization Pointers in local variables Prev_Tmp and
- -- Next_Tmp. For objects with Has_Controlled_Component set, these
- -- pointers are in the Record_Controller and if it is also
- -- Is_Controlled, we need to save the object pointers as well.
+ -- We really need a comment here ???
if Ctrl_Act then
- Ctrl_Ref := Duplicate_Subexpr_No_Checks (L);
- if Has_Controlled_Component (T) then
- Ctrl_Ref :=
- Make_Selected_Component (Loc,
- Prefix => Ctrl_Ref,
- Selector_Name =>
- New_Reference_To (Controller_Component (T), Loc));
+ -- subtype G is Storage_Offset range 1 .. Expr'Size
- if Is_Controlled (T) then
- Ctrl_Ref2 := Duplicate_Subexpr_No_Checks (L);
- end if;
- end if;
-
- Prev_Tmp := Make_Defining_Identifier (Loc, New_Internal_Name ('B'));
+ Original_Size :=
+ Make_Defining_Identifier (Loc,
+ New_Internal_Name ('S'));
Append_To (Res,
Make_Object_Declaration (Loc,
- Defining_Identifier => Prev_Tmp,
+ Defining_Identifier => Original_Size,
+ Constant_Present => True,
+ Object_Definition => New_Occurrence_Of (
+ RTE (RE_Storage_Offset), Loc),
+ Expression =>
+ Make_Op_Divide (Loc,
+ Left_Opnd =>
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ Duplicate_Subexpr_No_Checks (L),
+ Attribute_Name => Name_Size),
+ Right_Opnd => Make_Integer_Literal (Loc,
+ Intval => System_Storage_Unit))));
+
+ Range_Type :=
+ Make_Defining_Identifier (Loc,
+ New_Internal_Name ('G'));
- Object_Definition =>
- New_Reference_To (RTE (RE_Finalizable_Ptr), Loc),
+ Append_To (Res,
+ Make_Subtype_Declaration (Loc,
+ Defining_Identifier => Range_Type,
+ Subtype_Indication =>
+ Make_Subtype_Indication (Loc,
+ Subtype_Mark =>
+ New_Reference_To (RTE (RE_Storage_Offset), Loc),
+ Constraint => Make_Range_Constraint (Loc,
+ Range_Expression =>
+ Make_Range (Loc,
+ Low_Bound => Make_Integer_Literal (Loc, 1),
+ High_Bound => New_Occurrence_Of (
+ Original_Size, Loc))))));
+
+ -- subtype S is Storage_Array (G)
- Expression =>
- Make_Selected_Component (Loc,
- Prefix =>
- Unchecked_Convert_To (RTE (RE_Finalizable), Ctrl_Ref),
- Selector_Name => Make_Identifier (Loc, Name_Prev))));
+ Append_To (Res,
+ Make_Subtype_Declaration (Loc,
+ Defining_Identifier =>
+ Make_Defining_Identifier (Loc,
+ New_Internal_Name ('S')),
+ Subtype_Indication =>
+ Make_Subtype_Indication (Loc,
+ Subtype_Mark =>
+ New_Reference_To (RTE (RE_Storage_Array), Loc),
+ Constraint =>
+ Make_Index_Or_Discriminant_Constraint (Loc,
+ Constraints =>
+ New_List (New_Reference_To (Range_Type, Loc))))));
+
+ -- type A is access S
+
+ Opaque_Type := Make_Defining_Identifier (Loc,
+ New_Internal_Name ('A'));
+ Append_To (Res,
+ Make_Full_Type_Declaration (Loc,
+ Defining_Identifier => Opaque_Type,
+ Type_Definition =>
+ Make_Access_To_Object_Definition (Loc,
+ Subtype_Indication =>
+ New_Occurrence_Of (
+ Defining_Identifier (Last (Res)), Loc))));
- Next_Tmp := Make_Defining_Identifier (Loc, New_Internal_Name ('C'));
+ -- Give a label name to this declare block, and add comments here???
- Append_To (Res,
- Make_Object_Declaration (Loc,
- Defining_Identifier => Next_Tmp,
+ declare
+ Prev_Ref : Node_Id;
- Object_Definition =>
- New_Reference_To (RTE (RE_Finalizable_Ptr), Loc),
+ First_After_Root : Node_Id := Empty;
+ -- Index of first byte to be copied (used to skip
+ -- Root_Controlled in controlled objects).
- Expression =>
- Make_Selected_Component (Loc,
+ Last_Before_Hole : Node_Id := Empty;
+ -- Index of last byte to be copied before outermost record
+ -- controller data.
+
+ Hole_Length : Node_Id := Empty;
+ -- Length of record controller data (Prev and Next pointers)
+
+ First_After_Hole : Node_Id := Empty;
+ -- Index of first byte to be copied after outermost record
+ -- controller data.
+
+ function Build_Slice
+ (Rec : Entity_Id;
+ Lo, Hi : Node_Id) return Node_Id;
+ -- Function specs must have comments, saying what all the
+ -- parameters are and what the function does ???
+
+ -----------------
+ -- Build_Slice --
+ -----------------
+
+ function Build_Slice
+ (Rec : Node_Id;
+ Lo, Hi : Node_Id) return Node_Id
+ is
+ Lo_Bound, Hi_Bound : Node_Id;
+
+ Opaque : constant Node_Id :=
+ Unchecked_Convert_To (Opaque_Type,
+ Make_Attribute_Reference (Loc,
+ Prefix => Rec,
+ Attribute_Name => Name_Address));
+ -- Comment required, what is this???
+
+ begin
+ -- Comments required in this body ???
+
+ if No (Lo) then
+ Lo_Bound := Make_Integer_Literal (Loc, 1);
+ else
+ Lo_Bound := Lo;
+ end if;
+
+ if No (Hi) then
+ Hi_Bound := Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Range_Type, Loc),
+ Attribute_Name => Name_Last);
+ else
+ Hi_Bound := Hi;
+ end if;
+
+ return Make_Slice (Loc,
Prefix =>
- Unchecked_Convert_To (RTE (RE_Finalizable),
- New_Copy_Tree (Ctrl_Ref)),
- Selector_Name => Make_Identifier (Loc, Name_Next))));
+ Opaque,
+ Discrete_Range => Make_Range (Loc,
+ Lo_Bound, Hi_Bound));
+ end Build_Slice;
- if Present (Ctrl_Ref2) then
- Prev_Tmp2 :=
- Make_Defining_Identifier (Loc, New_Internal_Name ('B'));
+ -- Start of processing for ??? (name of block)
- Append_To (Res,
- Make_Object_Declaration (Loc,
- Defining_Identifier => Prev_Tmp2,
+ begin
+ First_After_Root := Make_Integer_Literal (Loc, 1);
- Object_Definition =>
- New_Reference_To (RTE (RE_Finalizable_Ptr), Loc),
+ -- Comment ???
- Expression =>
- Make_Selected_Component (Loc,
- Prefix =>
- Unchecked_Convert_To (RTE (RE_Finalizable), Ctrl_Ref2),
- Selector_Name => Make_Identifier (Loc, Name_Prev))));
+ if Is_Controlled (T) then
+ First_After_Root :=
+ Make_Op_Add (Loc,
+ First_After_Root,
+ Make_Op_Divide (Loc,
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ New_Occurrence_Of (RTE (RE_Root_Controlled), Loc),
+ Attribute_Name => Name_Size),
+ Make_Integer_Literal (Loc, System_Storage_Unit)));
+ end if;
- Next_Tmp2 :=
- Make_Defining_Identifier (Loc, New_Internal_Name ('C'));
+ if Has_Controlled_Component (T) then
- Append_To (Res,
- Make_Object_Declaration (Loc,
- Defining_Identifier => Next_Tmp2,
+ -- The record controller Prev and Next pointers must be left
+ -- intact in the target object, not copied. Compute the bounds
+ -- of the hole to be skipped in copying the objecct.
- Object_Definition =>
- New_Reference_To (RTE (RE_Finalizable_Ptr), Loc),
+ Prev_Ref :=
+ Make_Selected_Component (Loc,
+ Prefix =>
+ Make_Selected_Component (Loc,
+ Prefix => Duplicate_Subexpr_No_Checks (L),
+ Selector_Name =>
+ New_Reference_To (Controller_Component (T), Loc)),
+ Selector_Name => Make_Identifier (Loc, Name_Prev));
- Expression =>
- Make_Selected_Component (Loc,
- Prefix =>
- Unchecked_Convert_To (RTE (RE_Finalizable),
- New_Copy_Tree (Ctrl_Ref2)),
- Selector_Name => Make_Identifier (Loc, Name_Next))));
- end if;
+ -- Last index before hole
- -- If not controlled type, then Prev_Tmp and Ctrl_Ref unused
+ Last_Before_Hole :=
+ Make_Defining_Identifier (Loc,
+ New_Internal_Name ('L'));
- else
- Prev_Tmp := Empty;
- Ctrl_Ref := Empty;
- end if;
+ Append_To (Res,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Last_Before_Hole,
+ Object_Definition => New_Occurrence_Of (
+ RTE (RE_Storage_Offset), Loc),
+ Constant_Present => True,
+ Expression => Make_Op_Add (Loc,
+ Make_Attribute_Reference (Loc,
+ Prefix => Prev_Ref,
+ Attribute_Name => Name_Position),
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Copy_Tree (Prefix (Prev_Ref)),
+ Attribute_Name => Name_Position))));
- -- Do the Assignment
+ -- Hole length
+
+ Hole_Length :=
+ Make_Op_Multiply (Loc,
+ Make_Integer_Literal (Loc, Uint_2),
+ Make_Op_Divide (Loc,
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ New_Copy_Tree (Prev_Ref),
+ Attribute_Name =>
+ Name_Size),
+ Make_Integer_Literal (Loc, System_Storage_Unit)));
+
+ -- First index after hole
+
+ First_After_Hole :=
+ Make_Defining_Identifier (Loc,
+ New_Internal_Name ('F'));
+
+ Append_To (Res,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => First_After_Hole,
+ Object_Definition => New_Occurrence_Of (
+ RTE (RE_Storage_Offset), Loc),
+ Constant_Present => True,
+ Expression =>
+ Make_Op_Add (Loc,
+ Make_Op_Add (Loc,
+ New_Occurrence_Of (Last_Before_Hole, Loc),
+ Hole_Length),
+ Make_Integer_Literal (Loc, 1))));
+
+ Last_Before_Hole := New_Occurrence_Of (Last_Before_Hole, Loc);
+ First_After_Hole := New_Occurrence_Of (First_After_Hole, Loc);
+ end if;
- Append_To (Res, Relocate_Node (N));
+ -- More comments needed everywhere ???
+
+ Append_To (Res, Make_Assignment_Statement (Loc,
+ Name => Build_Slice (Duplicate_Subexpr_No_Checks (L),
+ First_After_Root,
+ Last_Before_Hole),
+
+ Expression => Build_Slice (Expression (N),
+ First_After_Root,
+ New_Copy_Tree (Last_Before_Hole))));
+
+
+ if Present (First_After_Hole) then
+ Remove_Side_Effects (Expression (N));
+ Append_To (Res, Make_Assignment_Statement (Loc,
+ Name => Build_Slice (Duplicate_Subexpr_No_Checks (L),
+ First_After_Hole,
+ Empty),
+ Expression => Build_Slice (New_Copy_Tree (Expression (N)),
+ New_Copy_Tree (First_After_Hole),
+ Empty)));
+ end if;
+ end;
+
+ else
+ Append_To (Res, Relocate_Node (N));
+ end if;
-- Restore the Tag
Expression => New_Reference_To (Tag_Tmp, Loc)));
end if;
- -- Restore the finalization pointers
-
- if Ctrl_Act then
- Append_To (Res,
- Make_Assignment_Statement (Loc,
- Name =>
- Make_Selected_Component (Loc,
- Prefix =>
- Unchecked_Convert_To (RTE (RE_Finalizable),
- New_Copy_Tree (Ctrl_Ref)),
- Selector_Name => Make_Identifier (Loc, Name_Prev)),
- Expression => New_Reference_To (Prev_Tmp, Loc)));
-
- Append_To (Res,
- Make_Assignment_Statement (Loc,
- Name =>
- Make_Selected_Component (Loc,
- Prefix =>
- Unchecked_Convert_To (RTE (RE_Finalizable),
- New_Copy_Tree (Ctrl_Ref)),
- Selector_Name => Make_Identifier (Loc, Name_Next)),
- Expression => New_Reference_To (Next_Tmp, Loc)));
-
- if Present (Ctrl_Ref2) then
- Append_To (Res,
- Make_Assignment_Statement (Loc,
- Name =>
- Make_Selected_Component (Loc,
- Prefix =>
- Unchecked_Convert_To (RTE (RE_Finalizable),
- New_Copy_Tree (Ctrl_Ref2)),
- Selector_Name => Make_Identifier (Loc, Name_Prev)),
- Expression => New_Reference_To (Prev_Tmp2, Loc)));
-
- Append_To (Res,
- Make_Assignment_Statement (Loc,
- Name =>
- Make_Selected_Component (Loc,
- Prefix =>
- Unchecked_Convert_To (RTE (RE_Finalizable),
- New_Copy_Tree (Ctrl_Ref2)),
- Selector_Name => Make_Identifier (Loc, Name_Next)),
- Expression => New_Reference_To (Next_Tmp2, Loc)));
- end if;
- end if;
-
- -- Adjust the target after the assignment when controlled. (not in
- -- the init proc since it is an initialization more than an
- -- assignment)
+ -- Adjust the target after the assignment when controlled (not in the
+ -- init proc since it is an initialization more than an assignment).
if Ctrl_Act then
Append_List_To (Res,
return Res;
exception
+ -- Could use comment here ???
+
when RE_Not_Available =>
return Empty_List;
end Make_Tag_Ctrl_Assignment;
Subtype_Indication => New_Reference_To (RTE (RO_ST_Task_Id),
Loc))));
+ -- Declare static ATCB (that is, created by the expander) if we
+ -- are using the Restricted run time.
+
+ if Restricted_Profile then
+ Append_To (Cdecls,
+ Make_Component_Declaration (Loc,
+ Defining_Identifier =>
+ Make_Defining_Identifier (Loc, Name_uATCB),
+
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => True,
+ Subtype_Indication => Make_Subtype_Indication (Loc,
+ Subtype_Mark => New_Occurrence_Of
+ (RTE (RE_Ada_Task_Control_Block), Loc),
+
+ Constraint =>
+ Make_Index_Or_Discriminant_Constraint (Loc,
+ Constraints =>
+ New_List (Make_Integer_Literal (Loc, 0)))))));
+
+ end if;
+
-- Add components for entry families
Collect_Entry_Families (Loc, Cdecls, Size_Decl, Tasktyp);
if Nkind (Id_Ref) = N_Identifier
or else Nkind (Id_Ref) = N_Defining_Identifier
then
- -- For a simple variable, the image of the task is the name
- -- of the variable.
+ -- For a simple variable, the image of the task is built from
+ -- the name of the variable. To avoid possible conflict with
+ -- the anonymous type created for a single protected object,
+ -- add a numeric suffix.
T_Id :=
Make_Defining_Identifier (Loc,
- New_External_Name (Chars (Id_Ref), 'T'));
+ New_External_Name (Chars (Id_Ref), 'T', 1));
Get_Name_String (Chars (Id_Ref));
Par := Exp;
while Present (Par)
- and then Nkind (Par) = N_Selected_Component
+ and then
+ (Nkind (Par) = N_Selected_Component
+ or else
+ Nkind (Par) = N_Indexed_Component)
loop
if Nkind (Parent (Par)) = N_Assignment_Statement
and then Par = Name (Parent (Par))
@noindent
Note that the name in the header is preceded by a single space,
-not two spaces as for other comments.
+not two spaces as for other comments. These headers are used on
+nested subprograms as well as outer level subprograms. They may
+also be used as headers for sections of comments, or collections
+of declarations that are related.
@item
Every subprogram body must have a preceding @syntax{subprogram_declaration}.
* Enum_Rep::
* Epsilon::
* Fixed_Value::
+* Has_Access_Values::
* Has_Discriminants::
* Img::
* Integer_Value::
* Enum_Rep::
* Epsilon::
* Fixed_Value::
+* Has_Access_Values::
* Has_Discriminants::
* Img::
* Integer_Value::
This attribute is primarily intended for use in implementation of the
input-output functions for fixed-point values.
+@node Has_Access_Values
+@unnumberedsec Has_Access_Values
+@cindex Access values, testing for
+@findex Has_Access_Values
+@noindent
+The prefix of the @code{Has_Access_Values} attribute is a type. The result
+is a Boolean value which is True if the is an access type, or is a composite
+type with a component (at any nesting depth) that is an access type, and is
+False otherwise.
+The intended use of this attribute is in conjunction with generic
+definitions. If the attribute is applied to a generic private type, it
+indicates whether or not the corresponding actual type has access values.
+
@node Has_Discriminants
@unnumberedsec Has_Discriminants
@cindex Discriminants, testing for
@item
Fixed-point type declarations with a null range
+@item
+Direct_IO or Sequential_IO instantiated with a type that has access values
+
@item
Variables that are never assigned a value
if Arguments_Project = No_Project then
if not External_Unit_Compilation_Allowed then
- Make_Failed ("external source, not part of any projects, " &
- "cannot be compiled (", Source_File_Name, ")");
+ Make_Failed ("external source (", Source_File_Name,
+ ") is not part of any project; cannot be " &
+ "compiled without gnatmake switch -x");
end if;
-- If it is allowed, simply add the saved gcc switches
Global_Archive_Exists := Last_Argument > First_Object;
if Global_Archive_Exists then
+
-- If the archive is built, then linking will need to occur
-- unconditionally.
-- Spawn the archive builder (ar)
Saved_Last_Argument := Last_Argument;
-
Last_Argument := First_Object + Max_In_Archives;
-
loop
if Last_Argument > Saved_Last_Argument then
Last_Argument := Saved_Last_Argument;
Goto_Node := New_Node (N_Goto_Statement, Token_Ptr);
Scan; -- past GOTO (or TO)
Set_Name (Goto_Node, P_Qualified_Simple_Name_Resync);
+ Append_Elmt (Goto_Node, Goto_List);
No_Constraint;
TF_Semicolon;
return Goto_Node;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, 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- --
-- Checks the rule in RM-5.1(11), which requires distinct identifiers
-- for all the labels in a given body.
+ procedure Find_Natural_Loops;
+ -- Recognizes loops created by backward gotos, and rewrites the
+ -- corresponding statements into a proper loop, for optimization
+ -- purposes (for example, to control reclaiming local storage).
+
---------------------------
-- Check_Distinct_Labels --
---------------------------
return Result;
end Find_Enclosing_Body_Or_Block;
+ ------------------------
+ -- Find_Natural_Loops --
+ ------------------------
+
+ procedure Find_Natural_Loops is
+ Node_List : constant Elist_Id := New_Elmt_List;
+ N : Elmt_Id;
+ Succ : Elmt_Id;
+
+ function Goto_Id (Goto_Node : Node_Id) return Name_Id;
+ -- Find Name_Id of goto statement, which may be an expanded name.
+
+ function Matches
+ (Label_Node : Node_Id;
+ Goto_Node : Node_Id) return Boolean;
+ -- A label and a goto are candidates for a loop if the names match,
+ -- and both nodes appear in the same body. In addition, both must
+ -- appear in the same statement list. If they are not in the same
+ -- statement list, the goto is from within an nested structure, and
+ -- the label is not a header. We ignore the case where the goto is
+ -- within a conditional structure, and capture only infinite loops.
+
+ procedure Merge;
+ -- Merge labels and goto statements in order of increasing sloc value.
+ -- Discard labels of loop and block statements.
+
+ procedure No_Header (N : Elmt_Id);
+ -- The label N is known not to be a loop header. Scan forward and
+ -- remove all subsequent goto's that may have this node as a target.
+
+ procedure Process_Goto (N : Elmt_Id);
+ -- N is a forward jump. Scan forward and remove all subsequent goto's
+ -- that may have the same target, to preclude spurious loops.
+
+ procedure Rewrite_As_Loop
+ (Loop_Header : Node_Id;
+ Loop_End : Node_Id);
+ -- Given a label and a backwards goto, rewrite intervening statements
+ -- as a loop. Remove the label from the node list, and rewrite the
+ -- goto with the body of the new loop.
+
+ procedure Try_Loop (N : Elmt_Id);
+ -- N is a label that may be a loop header. Scan forward to find some
+ -- backwards goto with which to make a loop. Do nothing if there is
+ -- an intervening label that is not part of a loop, or more than one
+ -- goto with this target.
+
+ -------------
+ -- Goto_Id --
+ -------------
+
+ function Goto_Id (Goto_Node : Node_Id) return Name_Id is
+ begin
+ if Nkind (Name (Goto_Node)) = N_Identifier then
+ return Chars (Name (Goto_Node));
+
+ elsif Nkind (Name (Goto_Node)) = N_Selected_Component then
+ return Chars (Selector_Name (Name (Goto_Node)));
+ else
+
+ -- In case of error, return Id that can't match anything
+
+ return Name_Null;
+ end if;
+ end Goto_Id;
+
+ -------------
+ -- Matches --
+ -------------
+
+ function Matches
+ (Label_Node : Node_Id;
+ Goto_Node : Node_Id) return Boolean
+ is
+ begin
+ return Chars (Identifier (Label_Node)) = Goto_Id (Goto_Node)
+ and then Find_Enclosing_Body (Label_Node) =
+ Find_Enclosing_Body (Goto_Node);
+ end Matches;
+
+ -----------
+ -- Merge --
+ -----------
+
+ procedure Merge is
+ L1 : Elmt_Id;
+ G1 : Elmt_Id;
+
+ begin
+ L1 := First_Elmt (Label_List);
+ G1 := First_Elmt (Goto_List);
+
+ while Present (L1)
+ and then Present (G1)
+ loop
+ if Sloc (Node (L1)) < Sloc (Node (G1)) then
+
+ -- Optimization: remove labels of loops and blocks, which
+ -- play no role in what follows.
+
+ if Nkind (Node (L1)) /= N_Loop_Statement
+ and then Nkind (Node (L1)) /= N_Block_Statement
+ then
+ Append_Elmt (Node (L1), Node_List);
+ end if;
+
+ Next_Elmt (L1);
+
+ else
+ Append_Elmt (Node (G1), Node_List);
+ Next_Elmt (G1);
+ end if;
+ end loop;
+
+ while Present (L1) loop
+ Append_Elmt (Node (L1), Node_List);
+ Next_Elmt (L1);
+ end loop;
+
+ while Present (G1) loop
+ Append_Elmt (Node (G1), Node_List);
+ Next_Elmt (G1);
+ end loop;
+ end Merge;
+
+ ---------------
+ -- No_Header --
+ ---------------
+
+ procedure No_Header (N : Elmt_Id) is
+ S1, S2 : Elmt_Id;
+
+ begin
+ S1 := Next_Elmt (N);
+ while Present (S1) loop
+ S2 := Next_Elmt (S1);
+ if Nkind (Node (S1)) = N_Goto_Statement
+ and then Matches (Node (N), Node (S1))
+ then
+ Remove_Elmt (Node_List, S1);
+ end if;
+
+ S1 := S2;
+ end loop;
+ end No_Header;
+
+ ------------------
+ -- Process_Goto --
+ ------------------
+
+ procedure Process_Goto (N : Elmt_Id) is
+ Goto1 : constant Node_Id := Node (N);
+ Goto2 : Node_Id;
+ S, S1 : Elmt_Id;
+
+ begin
+ S := Next_Elmt (N);
+
+ while Present (S) loop
+ S1 := Next_Elmt (S);
+ Goto2 := Node (S);
+
+ if Nkind (Goto2) = N_Goto_Statement
+ and then Goto_Id (Goto1) = Goto_Id (Goto2)
+ and then Find_Enclosing_Body (Goto1) =
+ Find_Enclosing_Body (Goto2)
+ then
+
+ -- Goto2 may have the same target, remove it from
+ -- consideration.
+
+ Remove_Elmt (Node_List, S);
+ end if;
+
+ S := S1;
+ end loop;
+ end Process_Goto;
+
+ ---------------------
+ -- Rewrite_As_Loop --
+ ---------------------
+
+ procedure Rewrite_As_Loop
+ (Loop_Header : Node_Id;
+ Loop_End : Node_Id)
+ is
+ Loop_Body : constant List_Id := New_List;
+ Loop_Stmt : constant Node_Id :=
+ New_Node (N_Loop_Statement, Sloc (Loop_Header));
+ Stat : Node_Id;
+ Next_Stat : Node_Id;
+ begin
+ Stat := Next (Loop_Header);
+ while Stat /= Loop_End loop
+ Next_Stat := Next (Stat);
+ Remove (Stat);
+ Append (Stat, Loop_Body);
+ Stat := Next_Stat;
+ end loop;
+
+ Set_Statements (Loop_Stmt, Loop_Body);
+ Set_Identifier (Loop_Stmt, Identifier (Loop_Header));
+
+ Remove (Loop_Header);
+ Rewrite (Loop_End, Loop_Stmt);
+ Error_Msg_N
+ ("code between label and backwards goto rewritten as loop?",
+ Loop_End);
+ end Rewrite_As_Loop;
+
+ --------------
+ -- Try_Loop --
+ --------------
+
+ procedure Try_Loop (N : Elmt_Id) is
+ Source : Elmt_Id;
+ Found : Boolean := False;
+ S1 : Elmt_Id;
+
+ begin
+ S1 := Next_Elmt (N);
+ while Present (S1) loop
+ if Nkind (Node (S1)) = N_Goto_Statement
+ and then Matches (Node (N), Node (S1))
+ then
+ if not Found then
+ if Parent (Node (N)) = Parent (Node (S1)) then
+ Source := S1;
+ Found := True;
+
+ else
+ -- The goto is within some nested structure
+
+ No_Header (N);
+ return;
+ end if;
+
+ else
+ -- More than one goto with the same target
+
+ No_Header (N);
+ return;
+ end if;
+
+ elsif Nkind (Node (S1)) = N_Label
+ and then not Found
+ then
+ -- Intervening label before possible end of loop. Current
+ -- label is not a candidate. This is conservative, because
+ -- the label might not be the target of any jumps, but not
+ -- worth dealing with useless labels!
+
+ No_Header (N);
+ return;
+
+ else
+ -- If the node is a loop_statement, it corresponds to a
+ -- label-goto pair rewritten as a loop. Continue forward scan.
+
+ null;
+ end if;
+
+ Next_Elmt (S1);
+ end loop;
+
+ if Found then
+ Rewrite_As_Loop (Node (N), Node (Source));
+ Remove_Elmt (Node_List, N);
+ Remove_Elmt (Node_List, Source);
+ end if;
+ end Try_Loop;
+
+ begin
+ -- Start of processing for Find_Natural_Loops
+
+ Merge;
+
+ N := First_Elmt (Node_List);
+ while Present (N) loop
+ Succ := Next_Elmt (N);
+
+ if Nkind (Node (N)) = N_Label then
+ if No (Succ) then
+ exit;
+
+ elsif Nkind (Node (Succ)) = N_Label then
+ Try_Loop (Succ);
+
+ -- If a loop was found, the label has been removed, and
+ -- the following goto rewritten as the loop body.
+
+ Succ := Next_Elmt (N);
+
+ if Nkind (Node (Succ)) = N_Label then
+
+ -- Following label was not removed, so current label
+ -- is not a candidate header.
+
+ No_Header (N);
+
+ else
+
+ -- Following label was part of inner loop. Current
+ -- label is still a candidate.
+
+ Try_Loop (N);
+ Succ := Next_Elmt (N);
+ end if;
+
+ elsif Nkind (Node (Succ)) = N_Goto_Statement then
+ Try_Loop (N);
+ Succ := Next_Elmt (N);
+ end if;
+
+ elsif Nkind (Node (N)) = N_Goto_Statement then
+ Process_Goto (N);
+ Succ := Next_Elmt (N);
+ end if;
+
+ N := Succ;
+ end loop;
+ end Find_Natural_Loops;
+
-- Start of processing for Par.Labl
begin
Next_Elmt (Next_Label_Elmt);
end loop;
+ Find_Natural_Loops;
+
end Labl;
SS_Whtm : constant SS_Rec := SS_Rec'(F, F, F, F, F, F, T, F);
SS_Unco : constant SS_Rec := SS_Rec'(F, F, F, F, F, F, F, T);
+ Goto_List : Elist_Id;
+ -- List of goto nodes appearing in the current compilation. Used to
+ -- recognize natural loops and convert them into bona fide loops for
+ -- optimization purposes.
+
Label_List : Elist_Id;
-- List of label nodes for labels appearing in the current compilation.
-- Used by Par.Labl to construct the corresponding implicit declarations.
SIS_Entry_Active := False;
Last_Resync_Point := No_Location;
+ Goto_List := New_Elmt_List;
Label_List := New_Elmt_List;
-- If in multiple unit per file mode, skip past ignored unit
-- --
------------------------------------------------------------------------------
-with Ada.Characters.Handling; use Ada.Characters.Handling;
-with Namet; use Namet;
-with Osint; use Osint;
-with Output; use Output;
+with Namet; use Namet;
+with Osint; use Osint;
+with Table;
+
+with System.Case_Util; use System.Case_Util;
package body Prj.Attr is
+ -- Data for predefined attributes and packages
+
-- Names end with '#'
-- Package names are preceded by 'P'
- -- Attribute names are preceded by two letters
-
+ -- Attribute names are preceded by two letters:
-- The first letter is one of
-- 'S' for Single
-- 's' for Single with optional index
-- 'L' for List
-- 'l' for List of strings with optional indexes
-
-- The second letter is one of
-- 'V' for single variable
-- 'A' for associative array
"#";
+ Initialized : Boolean := False;
+ -- A flag to avoid multiple initialization
+
+ ----------------
+ -- Attributes --
+ ----------------
+
+ type Attribute_Record is record
+ Name : Name_Id;
+ Var_Kind : Variable_Kind;
+ Optional_Index : Boolean;
+ Attr_Kind : Attribute_Kind;
+ Next : Attr_Node_Id;
+ end record;
+ -- Data for an attribute
+
+ package Attrs is
+ new Table.Table (Table_Component_Type => Attribute_Record,
+ Table_Index_Type => Attr_Node_Id,
+ Table_Low_Bound => First_Attribute,
+ Table_Initial => Attributes_Initial,
+ Table_Increment => Attributes_Increment,
+ Table_Name => "Prj.Attr.Attrs");
+ -- The table of the attributes
+
+ --------------
+ -- Packages --
+ --------------
+
+ type Package_Record is record
+ Name : Name_Id;
+ Known : Boolean := True;
+ First_Attribute : Attr_Node_Id;
+ end record;
+ -- Data for a package
+
+ package Package_Attributes is
+ new Table.Table (Table_Component_Type => Package_Record,
+ Table_Index_Type => Pkg_Node_Id,
+ Table_Low_Bound => First_Package,
+ Table_Initial => Packages_Initial,
+ Table_Increment => Packages_Increment,
+ Table_Name => "Prj.Attr.Packages");
+ -- The table of the packages
+
+ function Name_Id_Of (Name : String) return Name_Id;
+ -- Returns the Name_Id for Name in lower case
+
+ -------------------
+ -- Add_Attribute --
+ -------------------
+
+ procedure Add_Attribute
+ (To_Package : Package_Node_Id;
+ Attribute_Name : Name_Id;
+ Attribute_Node : out Attribute_Node_Id)
+ is
+ begin
+ -- Only add the attribute if the package is already defined
+
+ if To_Package /= Empty_Package then
+ Attrs.Increment_Last;
+ Attrs.Table (Attrs.Last) :=
+ (Name => Attribute_Name,
+ Var_Kind => Undefined,
+ Optional_Index => False,
+ Attr_Kind => Unknown,
+ Next =>
+ Package_Attributes.Table (To_Package.Value).First_Attribute);
+ Package_Attributes.Table (To_Package.Value).First_Attribute :=
+ Attrs.Last;
+ Attribute_Node := (Value => Attrs.Last);
+ end if;
+ end Add_Attribute;
+
+ -------------------------
+ -- Add_Unknown_Package --
+ -------------------------
+
+ procedure Add_Unknown_Package (Name : Name_Id; Id : out Package_Node_Id) is
+ begin
+ Package_Attributes.Increment_Last;
+ Id := (Value => Package_Attributes.Last);
+ Package_Attributes.Table (Id.Value) :=
+ (Name => Name, Known => False, First_Attribute => Empty_Attr);
+ end Add_Unknown_Package;
+
+ -----------------------
+ -- Attribute_Kind_Of --
+ -----------------------
+
+ function Attribute_Kind_Of
+ (Attribute : Attribute_Node_Id) return Attribute_Kind
+ is
+ begin
+ if Attribute = Empty_Attribute then
+ return Unknown;
+ else
+ return Attrs.Table (Attribute.Value).Attr_Kind;
+ end if;
+ end Attribute_Kind_Of;
+
+ -----------------------
+ -- Attribute_Name_Of --
+ -----------------------
+
+ function Attribute_Name_Of (Attribute : Attribute_Node_Id) return Name_Id is
+ begin
+ if Attribute = Empty_Attribute then
+ return No_Name;
+ else
+ return Attrs.Table (Attribute.Value).Name;
+ end if;
+ end Attribute_Name_Of;
+
+ --------------------------
+ -- Attribute_Node_Id_Of --
+ --------------------------
+
+ function Attribute_Node_Id_Of
+ (Name : Name_Id;
+ Starting_At : Attribute_Node_Id) return Attribute_Node_Id
+ is
+ Id : Attr_Node_Id := Starting_At.Value;
+ begin
+ while Id /= Empty_Attr
+ and then Attrs.Table (Id).Name /= Name
+ loop
+ Id := Attrs.Table (Id).Next;
+ end loop;
+
+ return (Value => Id);
+ end Attribute_Node_Id_Of;
+
----------------
-- Initialize --
----------------
procedure Initialize is
- Start : Positive := Initialization_Data'First;
- Finish : Positive := Start;
- Current_Package : Package_Node_Id := Empty_Package;
- Current_Attribute : Attribute_Node_Id := Empty_Attribute;
- Is_An_Attribute : Boolean := False;
- Kind_1 : Variable_Kind := Undefined;
- Optional_Index : Boolean := False;
- Kind_2 : Attribute_Kind := Single;
- Package_Name : Name_Id := No_Name;
- Attribute_Name : Name_Id := No_Name;
- First_Attribute : Attribute_Node_Id := Attribute_First;
+ Start : Positive := Initialization_Data'First;
+ Finish : Positive := Start;
+ Current_Package : Pkg_Node_Id := Empty_Pkg;
+ Current_Attribute : Attr_Node_Id := Empty_Attr;
+ Is_An_Attribute : Boolean := False;
+ Var_Kind : Variable_Kind := Undefined;
+ Optional_Index : Boolean := False;
+ Attr_Kind : Attribute_Kind := Single;
+ Package_Name : Name_Id := No_Name;
+ Attribute_Name : Name_Id := No_Name;
+ First_Attribute : Attr_Node_Id := Attr.First_Attribute;
+
+ function Attribute_Location return String;
+ -- Returns a string depending if we are in the project level attributes
+ -- or in the attributes of a package.
+
+ ------------------------
+ -- Attribute_Location --
+ ------------------------
+
+ function Attribute_Location return String is
+ begin
+ if Package_Name = No_Name then
+ return "project level attributes";
+
+ else
+ return "attribute of package """ &
+ Get_Name_String (Package_Name) & """";
+ end if;
+ end Attribute_Location;
+
+ -- Start of processing for Initialize
begin
+ -- Don't allow Initialize action to be repeated
+
+ if Initialized then
+ return;
+ end if;
+
-- Make sure the two tables are empty
- Attributes.Init;
+ Attrs.Init;
Package_Attributes.Init;
while Initialization_Data (Start) /= '#' loop
Finish := Finish + 1;
end loop;
- Name_Len := Finish - Start;
- Name_Buffer (1 .. Name_Len) :=
- To_Lower (Initialization_Data (Start .. Finish - 1));
- Package_Name := Name_Find;
+ Package_Name :=
+ Name_Id_Of (Initialization_Data (Start .. Finish - 1));
- for Index in Package_First .. Package_Attributes.Last loop
+ for Index in First_Package .. Package_Attributes.Last loop
if Package_Name = Package_Attributes.Table (Index).Name then
- Write_Line ("Duplicate package name """ &
- Initialization_Data (Start .. Finish - 1) &
- """ in Prj.Attr body.");
- raise Program_Error;
+ Fail ("duplicate name """,
+ Initialization_Data (Start .. Finish - 1),
+ """ in predefined packages.");
end if;
end loop;
Is_An_Attribute := False;
- Current_Attribute := Empty_Attribute;
+ Current_Attribute := Empty_Attr;
Package_Attributes.Increment_Last;
Current_Package := Package_Attributes.Last;
- Package_Attributes.Table (Current_Package).Name :=
- Package_Name;
+ Package_Attributes.Table (Current_Package) :=
+ (Name => Package_Name,
+ Known => True,
+ First_Attribute => Empty_Attr);
Start := Finish + 1;
when 'S' =>
- Kind_1 := Single;
+ Var_Kind := Single;
Optional_Index := False;
when 's' =>
- Kind_1 := Single;
+ Var_Kind := Single;
Optional_Index := True;
when 'L' =>
- Kind_1 := List;
+ Var_Kind := List;
Optional_Index := False;
when 'l' =>
- Kind_1 := List;
+ Var_Kind := List;
Optional_Index := True;
when others =>
Start := Start + 1;
case Initialization_Data (Start) is
when 'V' =>
- Kind_2 := Single;
+ Attr_Kind := Single;
when 'A' =>
- Kind_2 := Associative_Array;
+ Attr_Kind := Associative_Array;
when 'a' =>
- Kind_2 := Case_Insensitive_Associative_Array;
+ Attr_Kind := Case_Insensitive_Associative_Array;
when 'b' =>
if File_Names_Case_Sensitive then
- Kind_2 := Associative_Array;
+ Attr_Kind := Associative_Array;
else
- Kind_2 := Case_Insensitive_Associative_Array;
+ Attr_Kind := Case_Insensitive_Associative_Array;
end if;
when 'c' =>
if File_Names_Case_Sensitive then
- Kind_2 := Optional_Index_Associative_Array;
+ Attr_Kind := Optional_Index_Associative_Array;
else
- Kind_2 :=
+ Attr_Kind :=
Optional_Index_Case_Insensitive_Associative_Array;
end if;
Finish := Finish + 1;
end loop;
- Name_Len := Finish - Start;
- Name_Buffer (1 .. Name_Len) :=
- To_Lower (Initialization_Data (Start .. Finish - 1));
- Attribute_Name := Name_Find;
- Attributes.Increment_Last;
+ Attribute_Name :=
+ Name_Id_Of (Initialization_Data (Start .. Finish - 1));
+ Attrs.Increment_Last;
- if Current_Attribute = Empty_Attribute then
- First_Attribute := Attributes.Last;
+ if Current_Attribute = Empty_Attr then
+ First_Attribute := Attrs.Last;
- if Current_Package /= Empty_Package then
+ if Current_Package /= Empty_Pkg then
Package_Attributes.Table (Current_Package).First_Attribute
- := Attributes.Last;
+ := Attrs.Last;
end if;
else
-- Check that there are no duplicate attributes
- for Index in First_Attribute .. Attributes.Last - 1 loop
- if Attribute_Name =
- Attributes.Table (Index).Name then
- Write_Line ("Duplicate attribute name """ &
- Initialization_Data (Start .. Finish - 1) &
- """ in Prj.Attr body.");
- raise Program_Error;
+ for Index in First_Attribute .. Attrs.Last - 1 loop
+ if Attribute_Name = Attrs.Table (Index).Name then
+ Fail ("duplicate attribute """,
+ Initialization_Data (Start .. Finish - 1),
+ """ in " & Attribute_Location);
end if;
end loop;
- Attributes.Table (Current_Attribute).Next :=
- Attributes.Last;
+ Attrs.Table (Current_Attribute).Next :=
+ Attrs.Last;
end if;
- Current_Attribute := Attributes.Last;
- Attributes.Table (Current_Attribute) :=
+ Current_Attribute := Attrs.Last;
+ Attrs.Table (Current_Attribute) :=
(Name => Attribute_Name,
- Kind_1 => Kind_1,
+ Var_Kind => Var_Kind,
Optional_Index => Optional_Index,
- Kind_2 => Kind_2,
- Next => Empty_Attribute);
+ Attr_Kind => Attr_Kind,
+ Next => Empty_Attr);
Start := Finish + 1;
end if;
end loop;
+
+ Initialized := True;
end Initialize;
+ ----------------
+ -- Name_Id_Of --
+ ----------------
+
+ function Name_Id_Of (Name : String) return Name_Id is
+ begin
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (Name);
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ return Name_Find;
+ end Name_Id_Of;
+
+ --------------------
+ -- Next_Attribute --
+ --------------------
+
+ function Next_Attribute
+ (After : Attribute_Node_Id) return Attribute_Node_Id
+ is
+ begin
+ if After = Empty_Attribute then
+ return Empty_Attribute;
+ else
+ return (Value => Attrs.Table (After.Value).Next);
+ end if;
+ end Next_Attribute;
+
+ -----------------------
+ -- Optional_Index_Of --
+ -----------------------
+
+ function Optional_Index_Of (Attribute : Attribute_Node_Id) return Boolean is
+ begin
+ if Attribute = Empty_Attribute then
+ return False;
+ else
+ return Attrs.Table (Attribute.Value).Optional_Index;
+ end if;
+ end Optional_Index_Of;
+
+ ------------------------
+ -- Package_Node_Id_Of --
+ ------------------------
+
+ function Package_Node_Id_Of (Name : Name_Id) return Package_Node_Id is
+ begin
+ for Index in Package_Attributes.First .. Package_Attributes.Last loop
+ if Package_Attributes.Table (Index).Name = Name then
+ return (Value => Index);
+ end if;
+ end loop;
+
+ -- If there is no package with this name, return Empty_Package
+
+ return Empty_Package;
+ end Package_Node_Id_Of;
+
+ ----------------------------
+ -- Register_New_Attribute --
+ ----------------------------
+
+ procedure Register_New_Attribute
+ (Name : String;
+ In_Package : Package_Node_Id;
+ Attr_Kind : Defined_Attribute_Kind;
+ Var_Kind : Defined_Variable_Kind;
+ Index_Is_File_Name : Boolean := False;
+ Opt_Index : Boolean := False)
+ is
+ Attr_Name : Name_Id;
+ First_Attr : Attr_Node_Id := Empty_Attr;
+ Curr_Attr : Attr_Node_Id;
+ Real_Attr_Kind : Attribute_Kind;
+
+ begin
+ if Name'Length = 0 then
+ Fail ("cannot register an attribute with no name");
+ end if;
+
+ if In_Package = Empty_Package then
+ Fail ("attempt to add attribute """, Name,
+ """ to an undefined package");
+ end if;
+
+ Attr_Name := Name_Id_Of (Name);
+
+ First_Attr :=
+ Package_Attributes.Table (In_Package.Value).First_Attribute;
+
+ -- Check if attribute name is a duplicate
+
+ Curr_Attr := First_Attr;
+ while Curr_Attr /= Empty_Attr loop
+ if Attrs.Table (Curr_Attr).Name = Attr_Name then
+ Fail ("duplicate attribute name """, Name,
+ """ in package """ &
+ Get_Name_String
+ (Package_Attributes.Table (In_Package.Value).Name) &
+ """");
+ exit;
+ end if;
+
+ Curr_Attr := Attrs.Table (Curr_Attr).Next;
+ end loop;
+
+ Real_Attr_Kind := Attr_Kind;
+
+ -- If Index_Is_File_Name, change the attribute kind if necessary
+
+ if Index_Is_File_Name and then not File_Names_Case_Sensitive then
+ case Attr_Kind is
+ when Associative_Array =>
+ Real_Attr_Kind := Case_Insensitive_Associative_Array;
+
+ when Optional_Index_Associative_Array =>
+ Real_Attr_Kind :=
+ Optional_Index_Case_Insensitive_Associative_Array;
+
+ when others =>
+ null;
+ end case;
+ end if;
+
+ -- Add the new attribute
+
+ Attrs.Increment_Last;
+ Attrs.Table (Attrs.Last) :=
+ (Name => Attr_Name,
+ Var_Kind => Var_Kind,
+ Optional_Index => Opt_Index,
+ Attr_Kind => Real_Attr_Kind,
+ Next => First_Attr);
+ Package_Attributes.Table (In_Package.Value).First_Attribute :=
+ Attrs.Last;
+ end Register_New_Attribute;
+
+ --------------------------
+ -- Register_New_Package --
+ --------------------------
+
+ procedure Register_New_Package (Name : String; Id : out Package_Node_Id) is
+ Pkg_Name : Name_Id;
+
+ begin
+ if Name'Length = 0 then
+ Fail ("cannot register a package with no name");
+ end if;
+
+ Pkg_Name := Name_Id_Of (Name);
+ Package_Attributes.Increment_Last;
+ Id := (Value => Package_Attributes.Last);
+ Package_Attributes.Table (Package_Attributes.Last) :=
+ (Name => Pkg_Name, Known => True, First_Attribute => Empty_Attr);
+ end Register_New_Package;
+
+ procedure Register_New_Package
+ (Name : String;
+ Attributes : Attribute_Data_Array)
+ is
+ Pkg_Name : Name_Id;
+ Attr_Name : Name_Id;
+ First_Attr : Attr_Node_Id := Empty_Attr;
+ Curr_Attr : Attr_Node_Id;
+ Attr_Kind : Attribute_Kind;
+
+ begin
+ if Name'Length = 0 then
+ Fail ("cannot register a package with no name");
+ end if;
+
+ Pkg_Name := Name_Id_Of (Name);
+
+ for Index in Package_Attributes.First .. Package_Attributes.Last loop
+ if Package_Attributes.Table (Index).Name = Pkg_Name then
+ Fail ("cannot register a package with a non unique name""",
+ Name, """");
+ exit;
+ end if;
+ end loop;
+
+ for Index in Attributes'Range loop
+ Attr_Name := Name_Id_Of (Attributes (Index).Name);
+
+ Curr_Attr := First_Attr;
+ while Curr_Attr /= Empty_Attr loop
+ if Attrs.Table (Curr_Attr).Name = Attr_Name then
+ Fail ("duplicate attribute name """, Attributes (Index).Name,
+ """ in new package """ & Name & """");
+ exit;
+ end if;
+
+ Curr_Attr := Attrs.Table (Curr_Attr).Next;
+ end loop;
+
+ Attr_Kind := Attributes (Index).Attr_Kind;
+
+ if Attributes (Index).Index_Is_File_Name
+ and then not File_Names_Case_Sensitive
+ then
+ case Attr_Kind is
+ when Associative_Array =>
+ Attr_Kind := Case_Insensitive_Associative_Array;
+
+ when Optional_Index_Associative_Array =>
+ Attr_Kind :=
+ Optional_Index_Case_Insensitive_Associative_Array;
+
+ when others =>
+ null;
+ end case;
+ end if;
+
+ Attrs.Increment_Last;
+ Attrs.Table (Attrs.Last) :=
+ (Name => Attr_Name,
+ Var_Kind => Attributes (Index).Var_Kind,
+ Optional_Index => Attributes (Index).Opt_Index,
+ Attr_Kind => Attr_Kind,
+ Next => First_Attr);
+ First_Attr := Attrs.Last;
+ end loop;
+
+ Package_Attributes.Increment_Last;
+ Package_Attributes.Table (Package_Attributes.Last) :=
+ (Name => Pkg_Name, Known => True, First_Attribute => First_Attr);
+ end Register_New_Package;
+
+ ---------------------------
+ -- Set_Attribute_Kind_Of --
+ ---------------------------
+
+ procedure Set_Attribute_Kind_Of
+ (Attribute : Attribute_Node_Id;
+ To : Attribute_Kind)
+ is
+ begin
+ if Attribute /= Empty_Attribute then
+ Attrs.Table (Attribute.Value).Attr_Kind := To;
+ end if;
+ end Set_Attribute_Kind_Of;
+
+ --------------------------
+ -- Set_Variable_Kind_Of --
+ --------------------------
+
+ procedure Set_Variable_Kind_Of
+ (Attribute : Attribute_Node_Id;
+ To : Variable_Kind)
+ is
+ begin
+ if Attribute /= Empty_Attribute then
+ Attrs.Table (Attribute.Value).Var_Kind := To;
+ end if;
+ end Set_Variable_Kind_Of;
+
+ ----------------------
+ -- Variable_Kind_Of --
+ ----------------------
+
+ function Variable_Kind_Of
+ (Attribute : Attribute_Node_Id) return Variable_Kind
+ is
+ begin
+ if Attribute = Empty_Attribute then
+ return Undefined;
+ else
+ return Attrs.Table (Attribute.Value).Var_Kind;
+ end if;
+ end Variable_Kind_Of;
+
+ ------------------------
+ -- First_Attribute_Of --
+ ------------------------
+
+ function First_Attribute_Of
+ (Pkg : Package_Node_Id) return Attribute_Node_Id
+ is
+ begin
+ if Pkg = Empty_Package then
+ return Empty_Attribute;
+ else
+ return
+ (Value => Package_Attributes.Table (Pkg.Value).First_Attribute);
+ end if;
+ end First_Attribute_Of;
+
end Prj.Attr;
-- --
------------------------------------------------------------------------------
--- This package defines allowed packages and attributes in GNAT project files
+-- This package defines packages and attributes in GNAT project files.
+-- There are predefined packages and attributes.
+-- It is also possible to define new packages with their attributes.
with Types; use Types;
-with Table;
package Prj.Attr is
- -- Define the allowed attributes
+ procedure Initialize;
+ -- Initialize the predefined project level attributes and the predefined
+ -- packages and their attribute. This procedure should be called by
+ -- Prj.Initialize.
+
+ type Attribute_Kind is
+ (Unknown,
+ Single,
+ Associative_Array,
+ Optional_Index_Associative_Array,
+ Case_Insensitive_Associative_Array,
+ Optional_Index_Case_Insensitive_Associative_Array);
+ -- Characteristics of an attribute. Optional_Index indicates that there
+ -- may be an optional index in the index of the associative array, as in
+ -- for Switches ("files.ada" at 2) use ...
+
+ subtype Defined_Attribute_Kind is Attribute_Kind
+ range Single .. Optional_Index_Case_Insensitive_Associative_Array;
+ -- Subset of Attribute_Kinds that may be used for the attributes that is
+ -- used when defining a new package.
+
+ Max_Attribute_Name_Length : constant := 64;
+ -- The maximum length of attribute names
+
+ subtype Attribute_Name_Length is
+ Positive range 1 .. Max_Attribute_Name_Length;
+
+ type Attribute_Data (Name_Length : Attribute_Name_Length := 1) is record
+ Name : String (1 .. Name_Length);
+ -- The name of the attribute
+
+ Attr_Kind : Defined_Attribute_Kind;
+ -- The type of the attribute
+
+ Index_Is_File_Name : Boolean;
+ -- For associative arrays, indicate if the index is a file name, so
+ -- that the attribute kind may be modified depending on the case
+ -- sensitivity of file names. This is only taken into account when
+ -- Attr_Kind is Associative_Array or Optional_Index_Associative_Array.
+
+ Opt_Index : Boolean;
+ -- True if there may be an optional index in the value of the index,
+ -- as in:
+ -- "file.ada" at 2
+ -- ("main.adb", "file.ada" at 1)
+
+ Var_Kind : Defined_Variable_Kind;
+ -- The attribute value kind: single or list
+
+ end record;
+ -- Name and characteristics of an attribute in a package registered
+ -- explicitly with Register_New_Package (see below).
+
+ type Attribute_Data_Array is array (Positive range <>) of Attribute_Data;
+
+ procedure Register_New_Package
+ (Name : String;
+ Attributes : Attribute_Data_Array);
+ -- Add a new package with its attributes.
+ -- This procedure can only be called after Initialize, but before any
+ -- other call to a service of the Project Managers.
+ -- The name of the package must be unique. The names of the attributes
+ -- must be different.
+
+ -- The following declarations are only for the Project Manager, that is
+ -- the packages of the Prj or MLib hierarchies.
+
+ ----------------
+ -- Attributes --
+ ----------------
+
+ type Attribute_Node_Id is private;
+ -- The type to refers to an attribute, self-initialized
+
+ Empty_Attribute : constant Attribute_Node_Id;
+ -- Indicates no attribute. Default value of Attribute_Node_Id objects.
+
+ Attribute_First : constant Attribute_Node_Id;
+ -- First attribute node id of project level attributes
+
+ function Attribute_Node_Id_Of
+ (Name : Name_Id;
+ Starting_At : Attribute_Node_Id) return Attribute_Node_Id;
+ -- Returns the node id of an attribute at the project level or in
+ -- a package. Starting_At indicates the first known attribute node where
+ -- to start the search. Returns Empty_Attribute if the attribute cannot
+ -- be found.
+
+ function Attribute_Kind_Of
+ (Attribute : Attribute_Node_Id) return Attribute_Kind;
+ -- Returns the attribute kind of a known attribute. Returns Unknown if
+ -- Attribute is Empty_Attribute.
+
+ procedure Set_Attribute_Kind_Of
+ (Attribute : Attribute_Node_Id;
+ To : Attribute_Kind);
+ -- Set the attribute kind of a known attribute. Does nothing if
+ -- Attribute is Empty_Attribute.
+
+ function Attribute_Name_Of (Attribute : Attribute_Node_Id) return Name_Id;
+ -- Returns the name of a known attribute. Returns No_Name if Attribute is
+ -- Empty_Attribute.
- -- All these declarations are uncommented, they all need comments ???
+ function Variable_Kind_Of
+ (Attribute : Attribute_Node_Id) return Variable_Kind;
+ -- Returns the variable kind of a known attribute. Returns Undefined if
+ -- Attribute is Empty_Attribute.
+
+ procedure Set_Variable_Kind_Of
+ (Attribute : Attribute_Node_Id;
+ To : Variable_Kind);
+ -- Set the variable kind of a known attribute. Does nothing if Attribute is
+ -- Empty_Attribute.
+
+ function Optional_Index_Of (Attribute : Attribute_Node_Id) return Boolean;
+ -- Returns True if Attribute is a known attribute and may have an
+ -- optional index. Returns False otherwise.
+
+ function Next_Attribute
+ (After : Attribute_Node_Id) return Attribute_Node_Id;
+ -- Returns the attribute that follow After in the list of project level
+ -- attributes or the list of attributes in a package.
+ -- Returns Empty_Attribute if After is either Empty_Attribute or is the
+ -- last of the list.
+
+ --------------
+ -- Packages --
+ --------------
+
+ type Package_Node_Id is private;
+ -- Type to refer to a package, self initialized
+
+ Empty_Package : constant Package_Node_Id;
+ -- Default value of Package_Node_Id objects
+
+ procedure Register_New_Package (Name : String; Id : out Package_Node_Id);
+ -- Add a new package. Fails if the package has a duplicate name.
+ -- Initially, the new package has no attributes. Id may be used to add
+ -- attributes using procedure Register_New_Attribute below.
+
+ procedure Register_New_Attribute
+ (Name : String;
+ In_Package : Package_Node_Id;
+ Attr_Kind : Defined_Attribute_Kind;
+ Var_Kind : Defined_Variable_Kind;
+ Index_Is_File_Name : Boolean := False;
+ Opt_Index : Boolean := False);
+ -- Add a new attribute to registered package In_Package. Fails if the
+ -- attribute has a duplicate name. See definition of type Attribute_Data
+ -- above for the meaning of parameters Attr_Kind, Var_Kind,
+ -- Index_Is_File_Name and Opt_Index.
+
+ function Package_Node_Id_Of (Name : Name_Id) return Package_Node_Id;
+ -- Returns the package node id of the package with name Name. Returns
+ -- Empty_Package if there is no package with this name.
+
+ procedure Add_Unknown_Package (Name : Name_Id; Id : out Package_Node_Id);
+ -- Add a new package. The Name cannot be the name of a predefined or
+ -- already registered package.
+
+ function First_Attribute_Of
+ (Pkg : Package_Node_Id) return Attribute_Node_Id;
+ -- Returns the first attribute in the list of attributes of package Pkg.
+ -- Returns Empty_Attribute if Pkg is Empty_Package.
+
+ procedure Add_Attribute
+ (To_Package : Package_Node_Id;
+ Attribute_Name : Name_Id;
+ Attribute_Node : out Attribute_Node_Id);
+ -- Add an attribute to the list for package To_Package. Attribute_Name
+ -- cannot be the name of an existing attribute of the package.
+ -- Does nothing if To_Package is Empty_Package.
+
+private
+ ----------------
+ -- Attributes --
+ ----------------
Attributes_Initial : constant := 50;
Attributes_Increment : constant := 50;
Attribute_Node_Low_Bound : constant := 0;
Attribute_Node_High_Bound : constant := 099_999_999;
- type Attribute_Node_Id is
+ type Attr_Node_Id is
range Attribute_Node_Low_Bound .. Attribute_Node_High_Bound;
+ -- Index type for table Attrs in the body
- First_Attribute_Node_Id : constant Attribute_Node_Id :=
- Attribute_Node_Low_Bound + 1;
+ type Attribute_Node_Id is record
+ Value : Attr_Node_Id := Attribute_Node_Low_Bound;
+ end record;
+ -- Full declaration of self-initialized private type
- Empty_Attribute : constant Attribute_Node_Id :=
- Attribute_Node_Low_Bound;
+ Empty_Attr : constant Attr_Node_Id := Attribute_Node_Low_Bound;
- type Attribute_Kind is
- (Single,
- Associative_Array,
- Optional_Index_Associative_Array,
- Case_Insensitive_Associative_Array,
- Optional_Index_Case_Insensitive_Associative_Array);
+ Empty_Attribute : constant Attribute_Node_Id := (Value => Empty_Attr);
- type Attribute_Record is record
- Name : Name_Id;
- Kind_1 : Variable_Kind;
- Optional_Index : Boolean;
- Kind_2 : Attribute_Kind;
- Next : Attribute_Node_Id;
- end record;
+ First_Attribute : constant Attr_Node_Id := Attribute_Node_Low_Bound + 1;
- package Attributes is
- new Table.Table (Table_Component_Type => Attribute_Record,
- Table_Index_Type => Attribute_Node_Id,
- Table_Low_Bound => First_Attribute_Node_Id,
- Table_Initial => Attributes_Initial,
- Table_Increment => Attributes_Increment,
- Table_Name => "Prj.Attr.Attributes");
+ First_Attribute_Node_Id : constant Attribute_Node_Id :=
+ (Value => First_Attribute);
Attribute_First : constant Attribute_Node_Id := First_Attribute_Node_Id;
- -- Define the allowed packages
+ --------------
+ -- Packages --
+ --------------
Packages_Initial : constant := 10;
Packages_Increment : constant := 50;
Package_Node_Low_Bound : constant := 0;
Package_Node_High_Bound : constant := 099_999_999;
- type Package_Node_Id is
+ type Pkg_Node_Id is
range Package_Node_Low_Bound .. Package_Node_High_Bound;
+ -- Index type for table Package_Attributes in the body
- First_Package_Node_Id : constant Package_Node_Id :=
- Package_Node_Low_Bound + 1;
+ type Package_Node_Id is record
+ Value : Pkg_Node_Id := Package_Node_Low_Bound;
+ end record;
+ -- Full declaration of self-initialized private type
- Empty_Package : constant Package_Node_Id := Package_Node_Low_Bound;
+ Empty_Pkg : constant Pkg_Node_Id := Package_Node_Low_Bound;
- type Package_Record is record
- Name : Name_Id;
- First_Attribute : Attribute_Node_Id;
- end record;
+ Empty_Package : constant Package_Node_Id := (Value => Empty_Pkg);
- package Package_Attributes is
- new Table.Table (Table_Component_Type => Package_Record,
- Table_Index_Type => Package_Node_Id,
- Table_Low_Bound => First_Package_Node_Id,
- Table_Initial => Packages_Initial,
- Table_Increment => Packages_Increment,
- Table_Name => "Prj.Attr.Packages");
+ First_Package : constant Pkg_Node_Id := Package_Node_Low_Bound + 1;
- Package_First : constant Package_Node_Id := First_Package_Node_Id;
+ First_Package_Node_Id : constant Package_Node_Id :=
+ (Value => First_Package);
- procedure Initialize;
- -- Initialize the two tables above (Attributes and Package_Attributes).
- -- This procedure should be called by Prj.Initialize.
+ Package_First : constant Package_Node_Id := First_Package_Node_Id;
end Prj.Attr;
Full_Associative_Array : Boolean := False;
Attribute_Name : Name_Id := No_Name;
Optional_Index : Boolean := False;
+ Pkg_Id : Package_Node_Id := Empty_Package;
+ Warning : Boolean := False;
begin
Attribute := Default_Project_Node (Of_Kind => N_Attribute_Declaration);
-- Find the attribute
- while Current_Attribute /= Empty_Attribute
- and then
- Attributes.Table (Current_Attribute).Name /= Token_Name
- loop
- Current_Attribute := Attributes.Table (Current_Attribute).Next;
- end loop;
+ Current_Attribute :=
+ Attribute_Node_Id_Of (Token_Name, First_Attribute);
- -- If not a valid attribute name, issue an error, or a warning
- -- if inside a package that does not need to be checked.
+ -- If the attribute cannot be found, create the attribute if inside
+ -- an unknown package.
if Current_Attribute = Empty_Attribute then
- declare
- Message : constant String :=
- "undefined attribute """ &
- Get_Name_String (Name_Of (Attribute)) & '"';
+ if Current_Package /= Empty_Node
+ and then Expression_Kind_Of (Current_Package) = Ignored
+ then
+ Pkg_Id := Package_Id_Of (Current_Package);
+ Add_Attribute (Pkg_Id, Token_Name, Current_Attribute);
+ Error_Msg_Name_1 := Token_Name;
+ Error_Msg ("?unknown attribute {", Token_Ptr);
- Warning : Boolean :=
- Current_Package /= Empty_Node
- and then Current_Packages_To_Check /= All_Packages;
+ else
+ -- If not a valid attribute name, issue an error, or a warning
+ -- if inside a package that does not need to be checked.
+
+ Warning := Current_Package /= Empty_Node and then
+ Current_Packages_To_Check /= All_Packages;
- begin
if Warning then
-- Check that we are not in a package to check
end loop;
end if;
+ Error_Msg_Name_1 := Token_Name;
+
if Warning then
- Error_Msg ('?' & Message, Token_Ptr);
+ Error_Msg ("?undefined attribute {", Token_Ptr);
else
- Error_Msg (Message, Token_Ptr);
+ Error_Msg ("undefined attribute {", Token_Ptr);
end if;
- end;
+ end if;
-- Set, if appropriate the index case insensitivity flag
- elsif Attributes.Table (Current_Attribute).Kind_2 in
+ elsif Attribute_Kind_Of (Current_Attribute) in
Case_Insensitive_Associative_Array ..
Optional_Index_Case_Insensitive_Associative_Array
then
-- Change obsolete names of attributes to the new names
- case Name_Of (Attribute) is
+ if Current_Package /= Empty_Node
+ and then Expression_Kind_Of (Current_Package) /= Ignored
+ then
+ case Name_Of (Attribute) is
when Snames.Name_Specification =>
Set_Name_Of (Attribute, To => Snames.Name_Spec);
when others =>
null;
- end case;
+ end case;
+ end if;
-- Associative array attributes
if Token = Tok_Left_Paren then
-- If the attribute is not an associative array attribute, report
- -- an error.
+ -- an error. If this information is still unknown, set the kind
+ -- to Associative_Array.
if Current_Attribute /= Empty_Attribute
- and then Attributes.Table (Current_Attribute).Kind_2 = Single
+ and then Attribute_Kind_Of (Current_Attribute) = Single
then
Error_Msg ("the attribute """ &
Get_Name_String
- (Attributes.Table (Current_Attribute).Name) &
+ (Attribute_Name_Of (Current_Attribute)) &
""" cannot be an associative array",
Location_Of (Attribute));
+
+ elsif Attribute_Kind_Of (Current_Attribute) = Unknown then
+ Set_Attribute_Kind_Of (Current_Attribute, To => Associative_Array);
end if;
Scan; -- past the left parenthesis
Scan; -- past the literal string index
if Token = Tok_At then
- case Attributes.Table (Current_Attribute).Kind_2 is
+ case Attribute_Kind_Of (Current_Attribute) is
when Optional_Index_Associative_Array |
Optional_Index_Case_Insensitive_Associative_Array =>
Scan;
if Current_Attribute /= Empty_Attribute
and then
- Attributes.Table (Current_Attribute).Kind_2 /= Single
+ Attribute_Kind_Of (Current_Attribute) /= Single
then
- Full_Associative_Array := True;
+ if Attribute_Kind_Of (Current_Attribute) = Unknown then
+ Set_Attribute_Kind_Of (Current_Attribute, To => Single);
+
+ else
+ Full_Associative_Array := True;
+ end if;
end if;
end if;
if Current_Attribute /= Empty_Attribute then
Set_Expression_Kind_Of
- (Attribute, To => Attributes.Table (Current_Attribute).Kind_1);
- Optional_Index := Attributes.Table (Current_Attribute).Optional_Index;
+ (Attribute, To => Variable_Kind_Of (Current_Attribute));
+ Optional_Index := Optional_Index_Of (Current_Attribute);
end if;
Expect (Tok_Use, "USE");
if Current_Attribute /= Empty_Attribute
and then Expression /= Empty_Node
- and then Attributes.Table (Current_Attribute).Kind_1 /=
+ and then Variable_Kind_Of (Current_Attribute) /=
Expression_Kind_Of (Expression)
then
- Error_Msg
- ("wrong expression kind for attribute """ &
- Get_Name_String
- (Attributes.Table (Current_Attribute).Name) &
- """",
- Expression_Location);
+ if Variable_Kind_Of (Current_Attribute) = Undefined then
+ Set_Variable_Kind_Of
+ (Current_Attribute,
+ To => Expression_Kind_Of (Expression));
+
+ else
+ Error_Msg
+ ("wrong expression kind for attribute """ &
+ Get_Name_String
+ (Attribute_Name_Of (Current_Attribute)) &
+ """",
+ Expression_Location);
+ end if;
end if;
end;
end if;
Set_Name_Of (Package_Declaration, To => Token_Name);
- for Index in Package_Attributes.First .. Package_Attributes.Last loop
- if Token_Name = Package_Attributes.Table (Index).Name then
- First_Attribute :=
- Package_Attributes.Table (Index).First_Attribute;
- Current_Package := Index;
- exit;
- end if;
- end loop;
+ Current_Package := Package_Node_Id_Of (Token_Name);
- if Current_Package = Empty_Package then
+ if Current_Package /= Empty_Package then
+ First_Attribute := First_Attribute_Of (Current_Package);
+
+ else
Error_Msg ("?""" &
Get_Name_String (Name_Of (Package_Declaration)) &
- """ is not an allowed package name",
+ """ is not a known package name",
Token_Ptr);
-- Set the package declaration to "ignored" so that it is not
Set_Expression_Kind_Of (Package_Declaration, Ignored);
- else
- Set_Package_Id_Of (Package_Declaration, To => Current_Package);
+ -- Add the unknown package in the list of packages
- declare
- Current : Project_Node_Id := First_Package_Of (Current_Project);
+ Add_Unknown_Package (Token_Name, Current_Package);
+ end if;
- begin
- while Current /= Empty_Node
- and then Name_Of (Current) /= Token_Name
- loop
- Current := Next_Package_In_Project (Current);
- end loop;
+ Set_Package_Id_Of (Package_Declaration, To => Current_Package);
- if Current /= Empty_Node then
- Error_Msg
- ("package """ &
- Get_Name_String (Name_Of (Package_Declaration)) &
- """ is declared twice in the same project",
- Token_Ptr);
+ declare
+ Current : Project_Node_Id := First_Package_Of (Current_Project);
- else
- -- Add the package to the project list
+ begin
+ while Current /= Empty_Node
+ and then Name_Of (Current) /= Token_Name
+ loop
+ Current := Next_Package_In_Project (Current);
+ end loop;
- Set_Next_Package_In_Project
- (Package_Declaration,
- To => First_Package_Of (Current_Project));
- Set_First_Package_Of
- (Current_Project, To => Package_Declaration);
- end if;
- end;
- end if;
+ if Current /= Empty_Node then
+ Error_Msg
+ ("package """ &
+ Get_Name_String (Name_Of (Package_Declaration)) &
+ """ is declared twice in the same project",
+ Token_Ptr);
+
+ else
+ -- Add the package to the project list
+
+ Set_Next_Package_In_Project
+ (Package_Declaration,
+ To => First_Package_Of (Current_Project));
+ Set_First_Package_Of
+ (Current_Project, To => Package_Declaration);
+ end if;
+ end;
-- Scan past the package name
Output_Name (1 .. Path_Last) := To_Lower (Path_Name (1 .. Path_Last));
Output_Name_Last := Path_Last - Project_File_Extension'Length;
+ -- If there is already a project file with the specified name, parse
+ -- it to get the components that are not automatically generated.
+
+ if Is_Regular_File (Output_Name (1 .. Path_Last)) then
+ if Opt.Verbose_Mode then
+ Output.Write_Str ("Parsing already existing project file """);
+ Output.Write_Str (Output_Name (1 .. Output_Name_Last));
+ Output.Write_Line ("""");
+ end if;
+
+ Part.Parse
+ (Project => Project_Node,
+ Project_File_Name => Output_Name (1 .. Output_Name_Last),
+ Always_Errout_Finalize => False);
+
+ -- Fail if parsing was not successful
+
+ if Project_Node = Empty_Node then
+ Fail ("parsing of existing project file failed");
+
+ else
+ -- If parsing was successful, remove the components that are
+ -- automatically generated, if any, so that they will be
+ -- unconditionally added later.
+
+ -- Remove the with clause for the naming project file
+
+ declare
+ With_Clause : Project_Node_Id :=
+ First_With_Clause_Of (Project_Node);
+ Previous : Project_Node_Id := Empty_Node;
+
+ begin
+ while With_Clause /= Empty_Node loop
+ if Tree.Name_Of (With_Clause) = Project_Naming_Id then
+ if Previous = Empty_Node then
+ Set_First_With_Clause_Of
+ (Project_Node,
+ To => Next_With_Clause_Of (With_Clause));
+ else
+ Set_Next_With_Clause_Of
+ (Previous,
+ To => Next_With_Clause_Of (With_Clause));
+ end if;
+
+ exit;
+ end if;
+
+ Previous := With_Clause;
+ With_Clause := Next_With_Clause_Of (With_Clause);
+ end loop;
+ end;
+
+ -- Remove attribute declarations of Source_Files,
+ -- Source_List_File, Source_Dirs, and the declaration of
+ -- package Naming, if they exist.
+
+ declare
+ Declaration : Project_Node_Id :=
+ First_Declarative_Item_Of
+ (Project_Declaration_Of
+ (Project_Node));
+ Previous : Project_Node_Id := Empty_Node;
+ Current_Node : Project_Node_Id := Empty_Node;
+
+ begin
+ while Declaration /= Empty_Node loop
+ Current_Node := Current_Item_Node (Declaration);
+
+ if (Kind_Of (Current_Node) = N_Attribute_Declaration
+ and then
+ (Tree.Name_Of (Current_Node) = Name_Source_Files
+ or else Tree.Name_Of (Current_Node) =
+ Name_Source_List_File
+ or else Tree.Name_Of (Current_Node) =
+ Name_Source_Dirs))
+ or else
+ (Kind_Of (Current_Node) = N_Package_Declaration
+ and then Tree.Name_Of (Current_Node) = Name_Naming)
+ then
+ if Previous = Empty_Node then
+ Set_First_Declarative_Item_Of
+ (Project_Declaration_Of (Project_Node),
+ To => Next_Declarative_Item (Declaration));
+
+ else
+ Set_Next_Declarative_Item
+ (Previous,
+ To => Next_Declarative_Item (Declaration));
+ end if;
+
+ else
+ Previous := Declaration;
+ end if;
+
+ Declaration := Next_Declarative_Item (Declaration);
+ end loop;
+ end;
+ end if;
+ end if;
+
if Directory_Last /= 0 then
Output_Name (1 .. Output_Name_Last - Directory_Last) :=
Output_Name (Directory_Last + 1 .. Output_Name_Last);
Output.Write_Line ("""");
end if;
- -- If there is already a project file with the specified name,
- -- parse it to get the components that are not automatically
- -- generated.
-
- if Is_Regular_File (Output_Name (1 .. Output_Name_Last)) then
- if Opt.Verbose_Mode then
- Output.Write_Str ("Parsing already existing project file """);
- Output.Write_Str (Output_Name (1 .. Output_Name_Last));
- Output.Write_Line ("""");
- end if;
-
- Part.Parse
- (Project => Project_Node,
- Project_File_Name => Output_Name (1 .. Output_Name_Last),
- Always_Errout_Finalize => False);
-
- -- If parsing was successful, remove the components that are
- -- automatically generated, if any, so that they will be
- -- unconditionally added later.
-
- if Project_Node /= Empty_Node then
-
- -- Remove the with clause for the naming project file
-
- declare
- With_Clause : Project_Node_Id :=
- First_With_Clause_Of (Project_Node);
- Previous : Project_Node_Id := Empty_Node;
-
- begin
- while With_Clause /= Empty_Node loop
- if Tree.Name_Of (With_Clause) = Project_Naming_Id then
- if Previous = Empty_Node then
- Set_First_With_Clause_Of
- (Project_Node,
- To => Next_With_Clause_Of (With_Clause));
- else
- Set_Next_With_Clause_Of
- (Previous,
- To => Next_With_Clause_Of (With_Clause));
- end if;
-
- exit;
- end if;
-
- Previous := With_Clause;
- With_Clause := Next_With_Clause_Of (With_Clause);
- end loop;
- end;
-
- -- Remove attribute declarations of Source_Files,
- -- Source_List_File, Source_Dirs, and the declaration of
- -- package Naming, if they exist.
-
- declare
- Declaration : Project_Node_Id :=
- First_Declarative_Item_Of
- (Project_Declaration_Of
- (Project_Node));
- Previous : Project_Node_Id := Empty_Node;
- Current_Node : Project_Node_Id := Empty_Node;
-
- begin
- while Declaration /= Empty_Node loop
- Current_Node := Current_Item_Node (Declaration);
-
- if (Kind_Of (Current_Node) = N_Attribute_Declaration
- and then
- (Tree.Name_Of (Current_Node) = Name_Source_Files
- or else Tree.Name_Of (Current_Node) =
- Name_Source_List_File
- or else Tree.Name_Of (Current_Node) =
- Name_Source_Dirs))
- or else
- (Kind_Of (Current_Node) = N_Package_Declaration
- and then Tree.Name_Of (Current_Node) = Name_Naming)
- then
- if Previous = Empty_Node then
- Set_First_Declarative_Item_Of
- (Project_Declaration_Of (Project_Node),
- To => Next_Declarative_Item (Declaration));
-
- else
- Set_Next_Declarative_Item
- (Previous,
- To => Next_Declarative_Item (Declaration));
- end if;
-
- else
- Previous := Declaration;
- end if;
-
- Declaration := Next_Declarative_Item (Declaration);
- end loop;
- end;
- end if;
- end if;
-
-- If there were no already existing project file, or if the parsing
-- was unsuccessful, create an empty project node with the correct
-- name and its project declaration node.
First : Attribute_Node_Id)
is
The_Attribute : Attribute_Node_Id := First;
- Attribute_Data : Attribute_Record;
begin
while The_Attribute /= Empty_Attribute loop
- Attribute_Data := Attributes.Table (The_Attribute);
-
- if Attribute_Data.Kind_2 = Single then
+ if Attribute_Kind_Of (The_Attribute) = Single then
declare
New_Attribute : Variable_Value;
begin
- case Attribute_Data.Kind_1 is
+ case Variable_Kind_Of (The_Attribute) is
-- Undefined should not happen
Variable_Elements.Increment_Last;
Variable_Elements.Table (Variable_Elements.Last) :=
(Next => Decl.Attributes,
- Name => Attribute_Data.Name,
+ Name => Attribute_Name_Of (The_Attribute),
Value => New_Attribute);
Decl.Attributes := Variable_Elements.Last;
end;
end if;
- The_Attribute := Attributes.Table (The_Attribute).Next;
+ The_Attribute := Next_Attribute (After => The_Attribute);
end loop;
end Add_Attributes;
Add_Attributes
(Project,
Packages.Table (New_Pkg).Decl,
- Package_Attributes.Table
- (Package_Id_Of (Current_Item)).First_Attribute);
+ First_Attribute_Of
+ (Package_Id_Of (Current_Item)));
-- And process declarative items of the new package
-- Check if the identifier is one of the attribute identifiers in the
-- context (package or project level attributes).
- while Current_Attribute /= Empty_Attribute
- and then
- Attributes.Table (Current_Attribute).Name /= Token_Name
- loop
- Current_Attribute := Attributes.Table (Current_Attribute).Next;
- end loop;
+ Current_Attribute :=
+ Attribute_Node_Id_Of (Token_Name, Starting_At => First_Attribute);
-- If the identifier is not allowed, report an error
Set_Project_Node_Of (Reference, To => Current_Project);
Set_Package_Node_Of (Reference, To => Current_Package);
Set_Expression_Kind_Of
- (Reference, To => Attributes.Table (Current_Attribute).Kind_1);
+ (Reference, To => Variable_Kind_Of (Current_Attribute));
Set_Case_Insensitive
- (Reference, To => Attributes.Table (Current_Attribute).Kind_2 =
+ (Reference, To => Attribute_Kind_Of (Current_Attribute) =
Case_Insensitive_Associative_Array);
-- Scan past the attribute name
-- If the attribute is an associative array, get the index
- if Attributes.Table (Current_Attribute).Kind_2 /= Single then
+ if Attribute_Kind_Of (Current_Attribute) /= Single then
Expect (Tok_Left_Paren, "`(`");
if Token = Tok_Left_Paren then
-- First, look if it can be a package name
- for Index in Package_First .. Package_Attributes.Last loop
- if Package_Attributes.Table (Index).Name =
- Names.Table (1).Name
- then
- First_Attribute :=
- Package_Attributes.Table (Index).First_Attribute;
- exit;
- end if;
- end loop;
+ First_Attribute :=
+ First_Attribute_Of
+ (Package_Node_Id_Of (Names.Table (1).Name));
-- Now, look if it can be a project name
-- package.
First_Attribute :=
- Package_Attributes.Table
- (Package_Id_Of (The_Package)).First_Attribute;
+ First_Attribute_Of
+ (Package_Id_Of (The_Package));
end if;
end if;
end if;
function Empty_Project return Project_Data is
begin
- Initialize;
+ Prj.Initialize;
return Project_Empty;
end Empty_Project;
function Standard_Naming_Data return Naming_Data is
begin
- Initialize;
+ Prj.Initialize;
return Std_Naming_Data;
end Standard_Naming_Data;
type Variable_Kind is (Undefined, List, Single);
-- Different kinds of variables
+ subtype Defined_Variable_Kind is Variable_Kind range List .. Single;
+ -- The defined kinds of variables
+
Ignored : constant Variable_Kind := Single;
-- Used to indicate that a package declaration must be ignored
-- while processing the project tree (unknown package name).
RE_Asynchronous_Call, -- System.Tasking
RE_Timed_Call, -- System.Tasking
+ RE_Ada_Task_Control_Block, -- System.Tasking
+
RE_Task_List, -- System.Tasking
RE_Accept_Alternative, -- System.Tasking
RE_Asynchronous_Call => System_Tasking,
RE_Timed_Call => System_Tasking,
+ RE_Ada_Task_Control_Block => System_Tasking,
+
RE_Task_List => System_Tasking,
RE_Accept_Alternative => System_Tasking,
Object.My_Address - Object'Address;
procedure Ptr_Adjust (Ptr : in out Finalizable_Ptr);
- -- Substract the offset to the pointer
+ -- Subtract the offset to the pointer
procedure Reverse_Adjust (P : Finalizable_Ptr);
-- Ajust the components in the reverse order in which they are stored
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 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- --
-- Initialize the field My_Address to the Object'Address
procedure Adjust (Object : in out Record_Controller);
- -- Adjust the components and their finalization pointers by substracting
+ -- Adjust the components and their finalization pointers by subtracting
-- by the offset of the target and the source addresses of the assignment.
-- Inherit Finalize from Limited_Record_Controller
return To_Address (MS.eip);
else
-- When doing a call the return address is pushed to the stack.
- -- We want to return the call point address, so we substract
+ -- We want to return the call point address, so we subtract
-- Asm_Call_Size from the return address. This value is set
-- to 5 as an asm call takes 5 bytes on x86 architectures.
-- to System.Null_Address.
type Mark_Id is private;
- -- Type used to mark the stack.
+ -- Type used to mark the stack
function SS_Mark return Mark_Id;
-- Return the Mark corresponding to the current state of the stack
Elaborated : Access_Boolean;
Chain : in out Activation_Chain;
Task_Image : String;
- Created_Task : out Task_Id)
+ Created_Task : Task_Id)
is
- T : Task_Id;
Self_ID : constant Task_Id := STPO.Self;
Base_Priority : System.Any_Priority;
Success : Boolean;
Base_Priority := System.Any_Priority (Priority);
end if;
- T := New_ATCB (0);
-
if Single_Lock then
Lock_RTS;
end if;
Initialize_ATCB
(Self_ID, State, Discriminants, Self_ID, Elaborated, Base_Priority,
- Task_Info, Size, T, Success);
+ Task_Info, Size, Created_Task, Success);
-- If we do our job right then there should never be any failures,
-- which was probably said about the Titanic; so just to be safe,
raise Program_Error;
end if;
- T.Entry_Calls (1).Self := T;
+ Created_Task.Entry_Calls (1).Self := Created_Task;
- T.Common.Task_Image_Len :=
- Integer'Min (T.Common.Task_Image'Length, Task_Image'Length);
- T.Common.Task_Image (1 .. T.Common.Task_Image_Len) := Task_Image;
+ Created_Task.Common.Task_Image_Len :=
+ Integer'Min (Created_Task.Common.Task_Image'Length, Task_Image'Length);
+ Created_Task.Common.Task_Image
+ (1 .. Created_Task.Common.Task_Image_Len) := Task_Image;
Unlock (Self_ID);
-- Create TSD as early as possible in the creation of a task, since it
-- may be used by the operation of Ada code within the task.
- SSL.Create_TSD (T.Common.Compiler_Data);
- T.Common.Activation_Link := Chain.T_ID;
- Chain.T_ID := T;
- Created_Task := T;
+ SSL.Create_TSD (Created_Task.Common.Compiler_Data);
+ Created_Task.Common.Activation_Link := Chain.T_ID;
+ Chain.T_ID := Created_Task;
end Create_Restricted_Task;
---------------------------
-- task type t (discr : integer);
-- tE : aliased boolean := false;
-- tZ : size_type := unspecified_size;
+
-- type tV (discr : integer) is limited record
-- _task_id : task_id;
+ -- _atcb : aliased system__tasking__ada_task_control_block (0);
-- end record;
+
-- procedure tB (_task : access tV);
-- freeze tV [
-- procedure tVIP (_init : in out tV; _master : master_id;
-- begin
-- _init.discr := discr;
-- _init._task_id := null;
+ -- system__tasking__ada_task_control_blockIP (_init._atcb, 0);
+ -- _init._task_id := _init._atcb'unchecked_access;
-- create_restricted_task (unspecified_priority, tZ,
-- unspecified_task_info, task_procedure_access!(tB'address),
-- _init'address, tE'unchecked_access, _chain, _task_name, _init.
-- _task_id);
-- return;
-- end tVIP;
- -- ]
-- _chain : aliased activation_chain;
-- activation_chainIP (_chain);
-- procedure tB (_task : access tV) is
-- discr : integer renames _task.discr;
- --
+
-- procedure _clean is
-- begin
-- complete_restricted_task;
-- finalize_list (F14b);
-- return;
-- end _clean;
+
-- begin
-- ...declarations...
-- complete_restricted_activation;
Elaborated : Access_Boolean;
Chain : in out Activation_Chain;
Task_Image : String;
- Created_Task : out Task_Id);
+ Created_Task : Task_Id);
-- Compiler interface only. Do not call from within the RTS.
-- This must be called to create a new task.
--
with System.Task_Primitives.Operations;
-- used for Self
-with Unchecked_Deallocation;
--- To recover from failure of ATCB initialization.
-
with System.Storage_Elements;
-- Needed for initializing Stack_Info.Size
package STPO renames System.Task_Primitives.Operations;
- procedure Free is new
- Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id);
-
----------
-- Self --
----------
Base_Priority : System.Any_Priority;
Task_Info : System.Task_Info.Task_Info_Type;
Stack_Size : System.Parameters.Size_Type;
- T : in out Task_Id;
+ T : Task_Id;
Success : out Boolean) is
begin
T.Common.State := Unactivated;
STPO.Initialize_TCB (T, Success);
if not Success then
- Free (T);
return;
end if;
Base_Priority : System.Any_Priority;
Task_Info : System.Task_Info.Task_Info_Type;
Stack_Size : System.Parameters.Size_Type;
- T : in out Task_Id;
+ T : Task_Id;
Success : out Boolean);
-- Initialize fields of a TCB and link into global TCB structures
-- Call this only with abort deferred and holding RTS_Lock.
+ -- Need more documentation, mention T, and describe Success ???
private
-
Null_Task : constant Task_Id := null;
type Activation_Chain is record
with System.Traces.Tasking;
-- used for Send_Trace_Info
+with Unchecked_Deallocation;
+-- To recover from failure of ATCB initialization.
+
package body System.Tasking.Stages is
package STPO renames System.Task_Primitives.Operations;
-- Local Subprograms --
-----------------------
+ procedure Free is new
+ Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id);
+
procedure Trace_Unhandled_Exception_In_Task (Self_Id : Task_Id);
-- This procedure outputs the task specific message for exception
-- tracing purposes.
Base_Priority, Task_Info, Size, T, Success);
if not Success then
+ Free (T);
Unlock (Self_ID);
Unlock_RTS;
Initialization.Undefer_Abort_Nestable (Self_ID);
function Number_Of_Choices (N : Node_Id) return Nat is
Alt : Node_Id;
- -- A case statement alternative or a record variant.
+ -- A case statement alternative or a record variant
Choice : Node_Id;
Count : Nat := 0;
K = N_Subprogram_Renaming_Declaration)
and then Present (Parent_Spec (N))
then
- declare
- Parent_Lib_U : constant Node_Id := Parent_Spec (N);
- Parent_Kind : constant Node_Kind :=
- Nkind (Unit (Parent_Lib_U));
- Parent_Entity : Entity_Id;
-
- begin
- if Parent_Kind = N_Package_Instantiation
- or else Parent_Kind = N_Procedure_Instantiation
- or else Parent_Kind = N_Function_Instantiation
- or else Parent_Kind = N_Package_Renaming_Declaration
- or else Parent_Kind in N_Generic_Renaming_Declaration
- then
- Parent_Entity := Defining_Entity (Unit (Parent_Lib_U));
-
- else
- Parent_Entity :=
- Defining_Entity (Specification (Unit (Parent_Lib_U)));
- end if;
-
- Check_Categorization_Dependencies (E, Parent_Entity, N, False);
+ Check_Categorization_Dependencies (E, Scope (E), N, False);
- -- Verify that public child of an RCI library unit
- -- must also be an RCI library unit (RM E.2.3(15)).
+ -- Verify that public child of an RCI library unit
+ -- must also be an RCI library unit (RM E.2.3(15)).
- if Is_Remote_Call_Interface (Parent_Entity)
- and then not Private_Present (P)
- and then not Is_Remote_Call_Interface (E)
- then
- Error_Msg_N
- ("public child of rci unit must also be rci unit", N);
- return;
- end if;
- end;
+ if Is_Remote_Call_Interface (Scope (E))
+ and then not Private_Present (P)
+ and then not Is_Remote_Call_Interface (E)
+ then
+ Error_Msg_N ("public child of rci unit must also be rci unit", N);
+ end if;
end if;
-
end Validate_Categorization_Dependency;
--------------------------------
function Get_Parent_Entity (Unit : Node_Id) return Entity_Id is
begin
- if Nkind (Unit) = N_Package_Instantiation then
+ if Nkind (Unit) = N_Package_Body
+ and then Nkind (Original_Node (Unit)) = N_Package_Instantiation
+ then
+ return
+ Defining_Entity
+ (Specification (Instance_Spec (Original_Node (Unit))));
+
+ elsif Nkind (Unit) = N_Package_Instantiation then
return Defining_Entity (Specification (Instance_Spec (Unit)));
+
else
return Defining_Entity (Unit);
end if;
is
Loc : constant Source_Ptr := Sloc (N);
P : constant Node_Id := Parent_Spec (Child_Unit);
- P_Unit : constant Node_Id := Unit (P);
+
+ P_Unit : Node_Id := Unit (P);
+
P_Name : constant Entity_Id := Get_Parent_Entity (P_Unit);
Withn : Node_Id;
-- Start of processing for Implicit_With_On_Parent
begin
+ -- The unit of the current compilation may be a package body
+ -- that replaces an instance node. In this case we need the
+ -- original instance node to construct the proper parent name.
+
+ if Nkind (P_Unit) = N_Package_Body
+ and then Nkind (Original_Node (P_Unit)) = N_Package_Instantiation
+ then
+ P_Unit := Original_Node (P_Unit);
+ end if;
+
New_Nodes_OK := New_Nodes_OK + 1;
Withn := Make_With_Clause (Loc, Name => Build_Unit_Name);
procedure Remove_Parents (Lib_Unit : Node_Id) is
P : Node_Id;
P_Name : Entity_Id;
+ P_Spec : Node_Id := Empty;
E : Entity_Id;
Vis : constant Boolean :=
Scope_Stack.Table (Scope_Stack.Last).Previous_Visibility;
begin
if Is_Child_Spec (Lib_Unit) then
- P := Unit (Parent_Spec (Lib_Unit));
- P_Name := Get_Parent_Entity (P);
+ P_Spec := Parent_Spec (Lib_Unit);
- Remove_Context_Clauses (Parent_Spec (Lib_Unit));
+ elsif Nkind (Lib_Unit) = N_Package_Body
+ and then Nkind (Original_Node (Lib_Unit)) = N_Package_Instantiation
+ then
+ P_Spec := Parent_Spec (Original_Node (Lib_Unit));
+ end if;
+
+ if Present (P_Spec) then
+
+ P := Unit (P_Spec);
+ P_Name := Get_Parent_Entity (P);
+ Remove_Context_Clauses (P_Spec);
End_Package_Scope (P_Name);
Set_Is_Immediately_Visible (P_Name, Vis);
-- appear in the private part of a package, for a private type that has
-- already been declared.
- -- In this case, the discriminants (if any) must match.
+ -- In this case, the discriminants (if any) must match
T := Find_Type_Name (N);
-- Start of processing for Analyze_Slice
begin
- -- Analyze the prefix if not done already
-
- if No (Etype (P)) then
- Analyze (P);
- end if;
+ Analyze (P);
Analyze (D);
if Is_Overloaded (P) then
Public_Child := False;
- if Present (Parent_Spec (Parent (N))) then
- Generate_Parent_References;
+ declare
+ Par : Entity_Id;
+ Pack_Decl : Node_Id;
+ Par_Spec : Node_Id;
- declare
- Par : Entity_Id := Id;
- Pack_Decl : Node_Id;
+ begin
+ Par := Id;
+ Par_Spec := Parent_Spec (Parent (N));
+
+ -- If the package is formal package of an enclosing generic, is is
+ -- transformed into a local generic declaration, and compiled to make
+ -- its spec available. We need to retrieve the original generic to
+ -- determine whether it is a child unit, and install its parents.
+
+ if No (Par_Spec)
+ and then
+ Nkind (Original_Node (Parent (N))) = N_Formal_Package_Declaration
+ then
+ Par := Entity (Name (Original_Node (Parent (N))));
+ Par_Spec := Parent_Spec (Unit_Declaration_Node (Par));
+ end if;
+
+ if Present (Par_Spec) then
+ Generate_Parent_References;
- begin
while Scope (Par) /= Standard_Standard
and then Is_Public_Child (Id, Par)
loop
Pack_Decl := Unit_Declaration_Node (Par);
Set_Use (Private_Declarations (Specification (Pack_Decl)));
end loop;
- end;
- end if;
+ end if;
+ end;
if Is_Compilation_Unit (Id) then
Install_Private_With_Clauses (Id);
with Snames; use Snames;
with Stringt; use Stringt;
with Stylesw; use Stylesw;
+with Table;
with Targparm; use Targparm;
with Tbuild; use Tbuild;
with Ttypes;
-- design and implementation and are intended to be fully compatible
-- with the use of these pragmas in the DEC Ada compiler.
+ --------------------------------------------
+ -- Checking for Duplicated External Names --
+ --------------------------------------------
+
+ -- It is suspicious if two separate Export pragmas use the same external
+ -- name. The following table is used to diagnose this situation so that
+ -- an appropriate warning can be issued.
+
+ -- The Node_Id stored is for the N_String_Literal node created to
+ -- hold the value of the external name. The Sloc of this node is
+ -- used to cross-reference the location of the duplication.
+
+ package Externals is new Table.Table (
+ Table_Component_Type => Node_Id,
+ Table_Index_Type => Int,
+ Table_Low_Bound => 0,
+ Table_Initial => 100,
+ Table_Increment => 100,
+ Table_Name => "Name_Externals");
+
-------------------------------------
-- Local Subprograms and Variables --
-------------------------------------
procedure Check_At_Most_N_Arguments (N : Nat);
-- Check there are no more than N arguments present
+ procedure Check_Duplicated_Export_Name (Nam : Node_Id);
+ -- Nam is an N_String_Literal node containing the external name set
+ -- by an Import or Export pragma (or extended Import or Export pragma).
+ -- This procedure checks for possible duplications if this is the
+ -- export case, and if found, issues an appropriate error message.
+
procedure Check_First_Subtype (Arg : Node_Id);
-- Checks that Arg, whose expression is an entity name referencing
-- a subtype, does not reference a type that is not a first subtype.
end if;
end Check_At_Most_N_Arguments;
+ ----------------------------------
+ -- Check_Duplicated_Export_Name --
+ ----------------------------------
+
+ procedure Check_Duplicated_Export_Name (Nam : Node_Id) is
+ String_Val : constant String_Id := Strval (Nam);
+
+ begin
+ -- We are only interested in the export case, and in the case of
+ -- generics, it is the instance, not the template, that is the
+ -- problem (the template will generate a warning in any case).
+
+ if not Inside_A_Generic
+ and then (Prag_Id = Pragma_Export
+ or else
+ Prag_Id = Pragma_Export_Procedure
+ or else
+ Prag_Id = Pragma_Export_Valued_Procedure
+ or else
+ Prag_Id = Pragma_Export_Function)
+ then
+ for J in Externals.First .. Externals.Last loop
+ if String_Equal (String_Val, Strval (Externals.Table (J))) then
+ Error_Msg_Sloc := Sloc (Externals.Table (J));
+ Error_Msg_N ("external name duplicates name given#", Nam);
+ exit;
+ end if;
+ end loop;
+
+ Externals.Append (Nam);
+ end if;
+ end Check_Duplicated_Export_Name;
+
-------------------------
-- Check_First_Subtype --
-------------------------
-- If there is no link name, just set the external name
if No (Link_Nam) then
- Set_Encoded_Interface_Name
- (Get_Base_Subprogram (Subprogram_Def),
- Adjust_External_Name_Case (Expr_Value_S (Ext_Nam)));
+ Link_Nam := Adjust_External_Name_Case (Expr_Value_S (Ext_Nam));
-- For the Link_Name case, the given literal is preceded by an
-- asterisk, which indicates to GCC that the given name should
Link_Nam :=
Make_String_Literal (Sloc (Link_Nam), End_String);
-
- Set_Encoded_Interface_Name
- (Get_Base_Subprogram (Subprogram_Def), Link_Nam);
end if;
+
+ Set_Encoded_Interface_Name
+ (Get_Base_Subprogram (Subprogram_Def), Link_Nam);
+ Check_Duplicated_Export_Name (Link_Nam);
end Process_Interface_Name;
-----------------------------------------
else
Set_Encoded_Interface_Name (Internal_Ent, New_Name);
+ Check_Duplicated_Export_Name (New_Name);
end if;
-
end Set_Extended_Import_Export_External_Name;
------------------
or else
(Nkind (Parent (N)) = N_Function_Call
or else
- Nkind (Parent (N)) = N_Parameter_Association))
+ Nkind (Parent (N)) = N_Parameter_Association))
+ and then Ekind (S) /= E_Function
then
Set_Etype (N, Etype (S));
else
then
return True;
- -- Record type. OK if none of the component types requires a transient
- -- scope. Note that we already know that this is a definite type (i.e.
- -- has discriminant defaults if it is a discriminated record).
+ -- Record type
elsif Is_Record_Type (Typ) then
- if Has_Discriminants (Typ) then
+
+ -- In GCC 2, discriminated records always require a transient
+ -- scope because the back end otherwise tries to allocate a
+ -- variable length temporary for the particular variant.
+
+ if Opt.GCC_Version = 2
+ and then Has_Discriminants (Typ)
+ then
return True;
- end if;
- declare
- Comp : Entity_Id;
- begin
- Comp := First_Entity (Typ);
- while Present (Comp) loop
- if Requires_Transient_Scope (Etype (Comp)) then
- return True;
- else
- Next_Entity (Comp);
- end if;
- end loop;
- end;
+ -- For GCC 3, or for a non-discriminated record in GCC 2, we are
+ -- OK if none of the component types requires a transient scope.
+ -- Note that we already know that this is a definite type (i.e.
+ -- has discriminant defaults if it is a discriminated record).
- return False;
+ else
+ declare
+ Comp : Entity_Id;
+ begin
+ Comp := First_Entity (Typ);
+ while Present (Comp) loop
+ if Requires_Transient_Scope (Etype (Comp)) then
+ return True;
+ else
+ Next_Entity (Comp);
+ end if;
+ end loop;
+ end;
+
+ return False;
+ end if;
-- String literal types never require transient scope
function Has_Access_Values (T : Entity_Id) return Boolean;
-- Returns true if type or subtype T is an access type, or has a
- -- component (at any recursive level) that is an access type.
+ -- component (at any recursive level) that is an access type. This
+ -- is a conservative predicate, if it is not known whether or not
+ -- T contains access values (happens for generic formals in some
+ -- cases), then False is returned.
function Has_Declarations (N : Node_Id) return Boolean;
-- Determines if the node can have declarations
"_abort_signal#" &
"_alignment#" &
"_assign#" &
+ "_atcb#" &
"_chain#" &
"_clean#" &
"_controller#" &
Name_uAbort_Signal : constant Name_Id := N + 005;
Name_uAlignment : constant Name_Id := N + 006;
Name_uAssign : constant Name_Id := N + 007;
- Name_uChain : constant Name_Id := N + 008;
- Name_uClean : constant Name_Id := N + 009;
- Name_uController : constant Name_Id := N + 010;
- Name_uEntry_Bodies : constant Name_Id := N + 011;
- Name_uExpunge : constant Name_Id := N + 012;
- Name_uFinal_List : constant Name_Id := N + 013;
- Name_uIdepth : constant Name_Id := N + 014;
- Name_uInit : constant Name_Id := N + 015;
- Name_uLocal_Final_List : constant Name_Id := N + 016;
- Name_uMaster : constant Name_Id := N + 017;
- Name_uObject : constant Name_Id := N + 018;
- Name_uPriority : constant Name_Id := N + 019;
- Name_uProcess_ATSD : constant Name_Id := N + 020;
- Name_uSecondary_Stack : constant Name_Id := N + 021;
- Name_uService : constant Name_Id := N + 022;
- Name_uSize : constant Name_Id := N + 023;
- Name_uTags : constant Name_Id := N + 024;
- Name_uTask : constant Name_Id := N + 025;
- Name_uTask_Id : constant Name_Id := N + 026;
- Name_uTask_Info : constant Name_Id := N + 027;
- Name_uTask_Name : constant Name_Id := N + 028;
- Name_uTrace_Sp : constant Name_Id := N + 029;
+ Name_uATCB : constant Name_Id := N + 008;
+ Name_uChain : constant Name_Id := N + 009;
+ Name_uClean : constant Name_Id := N + 010;
+ Name_uController : constant Name_Id := N + 011;
+ Name_uEntry_Bodies : constant Name_Id := N + 012;
+ Name_uExpunge : constant Name_Id := N + 013;
+ Name_uFinal_List : constant Name_Id := N + 014;
+ Name_uIdepth : constant Name_Id := N + 015;
+ Name_uInit : constant Name_Id := N + 016;
+ Name_uLocal_Final_List : constant Name_Id := N + 017;
+ Name_uMaster : constant Name_Id := N + 018;
+ Name_uObject : constant Name_Id := N + 019;
+ Name_uPriority : constant Name_Id := N + 020;
+ Name_uProcess_ATSD : constant Name_Id := N + 021;
+ Name_uSecondary_Stack : constant Name_Id := N + 022;
+ Name_uService : constant Name_Id := N + 023;
+ Name_uSize : constant Name_Id := N + 024;
+ Name_uTags : constant Name_Id := N + 025;
+ Name_uTask : constant Name_Id := N + 026;
+ Name_uTask_Id : constant Name_Id := N + 027;
+ Name_uTask_Info : constant Name_Id := N + 028;
+ Name_uTask_Name : constant Name_Id := N + 029;
+ Name_uTrace_Sp : constant Name_Id := N + 030;
-- Names of routines in Ada.Finalization, needed by expander
- Name_Initialize : constant Name_Id := N + 030;
- Name_Adjust : constant Name_Id := N + 031;
- Name_Finalize : constant Name_Id := N + 032;
+ Name_Initialize : constant Name_Id := N + 031;
+ Name_Adjust : constant Name_Id := N + 032;
+ Name_Finalize : constant Name_Id := N + 033;
-- Names of fields declared in System.Finalization_Implementation,
-- needed by the expander when generating code for finalization.
- Name_Next : constant Name_Id := N + 033;
- Name_Prev : constant Name_Id := N + 034;
+ Name_Next : constant Name_Id := N + 034;
+ Name_Prev : constant Name_Id := N + 035;
-- Names of TSS routines for implementation of DSA over PolyORB
- Name_uTypeCode : constant Name_Id := N + 035;
- Name_uFrom_Any : constant Name_Id := N + 036;
- Name_uTo_Any : constant Name_Id := N + 037;
+ Name_uTypeCode : constant Name_Id := N + 036;
+ Name_uFrom_Any : constant Name_Id := N + 037;
+ Name_uTo_Any : constant Name_Id := N + 038;
-- Names of allocation routines, also needed by expander
- Name_Allocate : constant Name_Id := N + 038;
- Name_Deallocate : constant Name_Id := N + 039;
- Name_Dereference : constant Name_Id := N + 040;
+ Name_Allocate : constant Name_Id := N + 039;
+ Name_Deallocate : constant Name_Id := N + 040;
+ Name_Dereference : constant Name_Id := N + 041;
-- Names of Text_IO generic subpackages (see Rtsfind.Text_IO_Kludge)
- First_Text_IO_Package : constant Name_Id := N + 041;
- Name_Decimal_IO : constant Name_Id := N + 041;
- Name_Enumeration_IO : constant Name_Id := N + 042;
- Name_Fixed_IO : constant Name_Id := N + 043;
- Name_Float_IO : constant Name_Id := N + 044;
- Name_Integer_IO : constant Name_Id := N + 045;
- Name_Modular_IO : constant Name_Id := N + 046;
- Last_Text_IO_Package : constant Name_Id := N + 046;
+ First_Text_IO_Package : constant Name_Id := N + 042;
+ Name_Decimal_IO : constant Name_Id := N + 042;
+ Name_Enumeration_IO : constant Name_Id := N + 043;
+ Name_Fixed_IO : constant Name_Id := N + 044;
+ Name_Float_IO : constant Name_Id := N + 045;
+ Name_Integer_IO : constant Name_Id := N + 046;
+ Name_Modular_IO : constant Name_Id := N + 047;
+ Last_Text_IO_Package : constant Name_Id := N + 047;
subtype Text_IO_Package_Name is Name_Id
range First_Text_IO_Package .. Last_Text_IO_Package;
-- Names of files in library for Ada.Text_IO and Ada.Wide_Text_IO
- Name_a_textio : constant Name_Id := N + 047;
- Name_a_witeio : constant Name_Id := N + 048;
+ Name_a_textio : constant Name_Id := N + 048;
+ Name_a_witeio : constant Name_Id := N + 049;
-- Some miscellaneous names used for error detection/recovery
- Name_Const : constant Name_Id := N + 049;
- Name_Error : constant Name_Id := N + 050;
- Name_Go : constant Name_Id := N + 051;
- Name_Put : constant Name_Id := N + 052;
- Name_Put_Line : constant Name_Id := N + 053;
- Name_To : constant Name_Id := N + 054;
+ Name_Const : constant Name_Id := N + 050;
+ Name_Error : constant Name_Id := N + 051;
+ Name_Go : constant Name_Id := N + 052;
+ Name_Put : constant Name_Id := N + 053;
+ Name_Put_Line : constant Name_Id := N + 054;
+ Name_To : constant Name_Id := N + 055;
-- Names for packages that are treated specially by the compiler
- Name_Finalization : constant Name_Id := N + 055;
- Name_Finalization_Root : constant Name_Id := N + 056;
- Name_Interfaces : constant Name_Id := N + 057;
- Name_Standard : constant Name_Id := N + 058;
- Name_System : constant Name_Id := N + 059;
- Name_Text_IO : constant Name_Id := N + 060;
- Name_Wide_Text_IO : constant Name_Id := N + 061;
+ Name_Finalization : constant Name_Id := N + 056;
+ Name_Finalization_Root : constant Name_Id := N + 057;
+ Name_Interfaces : constant Name_Id := N + 058;
+ Name_Standard : constant Name_Id := N + 059;
+ Name_System : constant Name_Id := N + 060;
+ Name_Text_IO : constant Name_Id := N + 061;
+ Name_Wide_Text_IO : constant Name_Id := N + 062;
-- Names of implementations of the distributed systems annex
- Name_No_DSA : constant Name_Id := N + 062;
- Name_GLADE_DSA : constant Name_Id := N + 063;
- Name_PolyORB_DSA : constant Name_Id := N + 064;
+ Name_No_DSA : constant Name_Id := N + 063;
+ Name_GLADE_DSA : constant Name_Id := N + 064;
+ Name_PolyORB_DSA : constant Name_Id := N + 065;
-- Names of identifiers used in expanding distribution stubs
- Name_Addr : constant Name_Id := N + 065;
- Name_Async : constant Name_Id := N + 066;
- Name_Get_Active_Partition_ID : constant Name_Id := N + 067;
- Name_Get_RCI_Package_Receiver : constant Name_Id := N + 068;
- Name_Get_RCI_Package_Ref : constant Name_Id := N + 069;
- Name_Origin : constant Name_Id := N + 070;
- Name_Params : constant Name_Id := N + 071;
- Name_Partition : constant Name_Id := N + 072;
- Name_Partition_Interface : constant Name_Id := N + 073;
- Name_Ras : constant Name_Id := N + 074;
- Name_Call : constant Name_Id := N + 075;
- Name_RCI_Name : constant Name_Id := N + 076;
- Name_Receiver : constant Name_Id := N + 077;
- Name_Result : constant Name_Id := N + 078;
- Name_Rpc : constant Name_Id := N + 079;
- Name_Subp_Id : constant Name_Id := N + 080;
- Name_Operation : constant Name_Id := N + 081;
- Name_Argument : constant Name_Id := N + 082;
- Name_Arg_Modes : constant Name_Id := N + 083;
- Name_Handler : constant Name_Id := N + 084;
- Name_Target : constant Name_Id := N + 085;
- Name_Req : constant Name_Id := N + 086;
- Name_Obj_TypeCode : constant Name_Id := N + 087;
- Name_Stub : constant Name_Id := N + 088;
+ Name_Addr : constant Name_Id := N + 066;
+ Name_Async : constant Name_Id := N + 067;
+ Name_Get_Active_Partition_ID : constant Name_Id := N + 068;
+ Name_Get_RCI_Package_Receiver : constant Name_Id := N + 069;
+ Name_Get_RCI_Package_Ref : constant Name_Id := N + 070;
+ Name_Origin : constant Name_Id := N + 071;
+ Name_Params : constant Name_Id := N + 072;
+ Name_Partition : constant Name_Id := N + 073;
+ Name_Partition_Interface : constant Name_Id := N + 074;
+ Name_Ras : constant Name_Id := N + 075;
+ Name_Call : constant Name_Id := N + 076;
+ Name_RCI_Name : constant Name_Id := N + 077;
+ Name_Receiver : constant Name_Id := N + 078;
+ Name_Result : constant Name_Id := N + 079;
+ Name_Rpc : constant Name_Id := N + 080;
+ Name_Subp_Id : constant Name_Id := N + 081;
+ Name_Operation : constant Name_Id := N + 082;
+ Name_Argument : constant Name_Id := N + 083;
+ Name_Arg_Modes : constant Name_Id := N + 084;
+ Name_Handler : constant Name_Id := N + 085;
+ Name_Target : constant Name_Id := N + 086;
+ Name_Req : constant Name_Id := N + 087;
+ Name_Obj_TypeCode : constant Name_Id := N + 088;
+ Name_Stub : constant Name_Id := N + 089;
-- 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 + 089;
- Name_Op_Abs : constant Name_Id := N + 089; -- "abs"
- Name_Op_And : constant Name_Id := N + 090; -- "and"
- Name_Op_Mod : constant Name_Id := N + 091; -- "mod"
- Name_Op_Not : constant Name_Id := N + 092; -- "not"
- Name_Op_Or : constant Name_Id := N + 093; -- "or"
- Name_Op_Rem : constant Name_Id := N + 094; -- "rem"
- Name_Op_Xor : constant Name_Id := N + 095; -- "xor"
- Name_Op_Eq : constant Name_Id := N + 096; -- "="
- Name_Op_Ne : constant Name_Id := N + 097; -- "/="
- Name_Op_Lt : constant Name_Id := N + 098; -- "<"
- Name_Op_Le : constant Name_Id := N + 099; -- "<="
- Name_Op_Gt : constant Name_Id := N + 100; -- ">"
- Name_Op_Ge : constant Name_Id := N + 101; -- ">="
- Name_Op_Add : constant Name_Id := N + 102; -- "+"
- Name_Op_Subtract : constant Name_Id := N + 103; -- "-"
- Name_Op_Concat : constant Name_Id := N + 104; -- "&"
- Name_Op_Multiply : constant Name_Id := N + 105; -- "*"
- Name_Op_Divide : constant Name_Id := N + 106; -- "/"
- Name_Op_Expon : constant Name_Id := N + 107; -- "**"
- Last_Operator_Name : constant Name_Id := N + 107;
+ First_Operator_Name : constant Name_Id := N + 090;
+ Name_Op_Abs : constant Name_Id := N + 090; -- "abs"
+ Name_Op_And : constant Name_Id := N + 091; -- "and"
+ Name_Op_Mod : constant Name_Id := N + 092; -- "mod"
+ Name_Op_Not : constant Name_Id := N + 093; -- "not"
+ Name_Op_Or : constant Name_Id := N + 094; -- "or"
+ Name_Op_Rem : constant Name_Id := N + 095; -- "rem"
+ Name_Op_Xor : constant Name_Id := N + 096; -- "xor"
+ Name_Op_Eq : constant Name_Id := N + 097; -- "="
+ Name_Op_Ne : constant Name_Id := N + 098; -- "/="
+ Name_Op_Lt : constant Name_Id := N + 099; -- "<"
+ Name_Op_Le : constant Name_Id := N + 100; -- "<="
+ Name_Op_Gt : constant Name_Id := N + 101; -- ">"
+ Name_Op_Ge : constant Name_Id := N + 102; -- ">="
+ Name_Op_Add : constant Name_Id := N + 103; -- "+"
+ Name_Op_Subtract : constant Name_Id := N + 104; -- "-"
+ Name_Op_Concat : constant Name_Id := N + 105; -- "&"
+ Name_Op_Multiply : constant Name_Id := N + 106; -- "*"
+ Name_Op_Divide : constant Name_Id := N + 107; -- "/"
+ Name_Op_Expon : constant Name_Id := N + 108; -- "**"
+ Last_Operator_Name : constant Name_Id := N + 108;
-- 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.
-- only in GNAT for the AAMP. They are ignored in other versions with
-- appropriate warnings.
- First_Pragma_Name : constant Name_Id := N + 108;
+ First_Pragma_Name : constant Name_Id := N + 109;
-- Configuration pragmas are grouped at start
- Name_Ada_83 : constant Name_Id := N + 108; -- GNAT
- Name_Ada_95 : constant Name_Id := N + 109; -- GNAT
- Name_Ada_05 : constant Name_Id := N + 110; -- GNAT
- Name_C_Pass_By_Copy : constant Name_Id := N + 111; -- GNAT
- Name_Compile_Time_Warning : constant Name_Id := N + 112; -- GNAT
- Name_Component_Alignment : constant Name_Id := N + 113; -- GNAT
- Name_Convention_Identifier : constant Name_Id := N + 114; -- GNAT
- Name_Detect_Blocking : constant Name_Id := N + 115; -- Ada05
- Name_Discard_Names : constant Name_Id := N + 116;
- Name_Elaboration_Checks : constant Name_Id := N + 117; -- GNAT
- Name_Eliminate : constant Name_Id := N + 118; -- GNAT
- Name_Explicit_Overriding : constant Name_Id := N + 119;
- Name_Extend_System : constant Name_Id := N + 120; -- GNAT
- Name_Extensions_Allowed : constant Name_Id := N + 121; -- GNAT
- Name_External_Name_Casing : constant Name_Id := N + 122; -- GNAT
- Name_Float_Representation : constant Name_Id := N + 123; -- GNAT
- Name_Initialize_Scalars : constant Name_Id := N + 124; -- GNAT
- Name_Interrupt_State : constant Name_Id := N + 125; -- GNAT
- Name_License : constant Name_Id := N + 126; -- GNAT
- Name_Locking_Policy : constant Name_Id := N + 127;
- Name_Long_Float : constant Name_Id := N + 128; -- VMS
- Name_No_Run_Time : constant Name_Id := N + 129; -- GNAT
- Name_No_Strict_Aliasing : constant Name_Id := N + 130; -- GNAT
- Name_Normalize_Scalars : constant Name_Id := N + 131;
- Name_Polling : constant Name_Id := N + 132; -- GNAT
- Name_Persistent_Data : constant Name_Id := N + 133; -- GNAT
- Name_Persistent_Object : constant Name_Id := N + 134; -- GNAT
- Name_Profile : constant Name_Id := N + 135; -- Ada05
- Name_Profile_Warnings : constant Name_Id := N + 136; -- GNAT
- Name_Propagate_Exceptions : constant Name_Id := N + 137; -- GNAT
- Name_Queuing_Policy : constant Name_Id := N + 138;
- Name_Ravenscar : constant Name_Id := N + 139;
- Name_Restricted_Run_Time : constant Name_Id := N + 140;
- Name_Restrictions : constant Name_Id := N + 141;
- Name_Restriction_Warnings : constant Name_Id := N + 142; -- GNAT
- Name_Reviewable : constant Name_Id := N + 143;
- Name_Source_File_Name : constant Name_Id := N + 144; -- GNAT
- Name_Source_File_Name_Project : constant Name_Id := N + 145; -- GNAT
- Name_Style_Checks : constant Name_Id := N + 146; -- GNAT
- Name_Suppress : constant Name_Id := N + 147;
- Name_Suppress_Exception_Locations : constant Name_Id := N + 148; -- GNAT
- Name_Task_Dispatching_Policy : constant Name_Id := N + 149;
- Name_Universal_Data : constant Name_Id := N + 150; -- AAMP
- Name_Unsuppress : constant Name_Id := N + 151; -- GNAT
- Name_Use_VADS_Size : constant Name_Id := N + 152; -- GNAT
- Name_Validity_Checks : constant Name_Id := N + 153; -- GNAT
- Name_Warnings : constant Name_Id := N + 154; -- GNAT
- Last_Configuration_Pragma_Name : constant Name_Id := N + 154;
+ Name_Ada_83 : constant Name_Id := N + 109; -- GNAT
+ Name_Ada_95 : constant Name_Id := N + 110; -- GNAT
+ Name_Ada_05 : constant Name_Id := N + 111; -- GNAT
+ Name_C_Pass_By_Copy : constant Name_Id := N + 112; -- GNAT
+ Name_Compile_Time_Warning : constant Name_Id := N + 113; -- GNAT
+ Name_Component_Alignment : constant Name_Id := N + 114; -- GNAT
+ Name_Convention_Identifier : constant Name_Id := N + 115; -- GNAT
+ Name_Detect_Blocking : constant Name_Id := N + 116; -- Ada05
+ Name_Discard_Names : constant Name_Id := N + 117;
+ Name_Elaboration_Checks : constant Name_Id := N + 118; -- GNAT
+ Name_Eliminate : constant Name_Id := N + 119; -- GNAT
+ Name_Explicit_Overriding : constant Name_Id := N + 120;
+ Name_Extend_System : constant Name_Id := N + 121; -- GNAT
+ Name_Extensions_Allowed : constant Name_Id := N + 122; -- GNAT
+ Name_External_Name_Casing : constant Name_Id := N + 123; -- GNAT
+ Name_Float_Representation : constant Name_Id := N + 124; -- GNAT
+ Name_Initialize_Scalars : constant Name_Id := N + 125; -- GNAT
+ Name_Interrupt_State : constant Name_Id := N + 126; -- GNAT
+ Name_License : constant Name_Id := N + 127; -- GNAT
+ Name_Locking_Policy : constant Name_Id := N + 128;
+ Name_Long_Float : constant Name_Id := N + 129; -- VMS
+ Name_No_Run_Time : constant Name_Id := N + 130; -- GNAT
+ Name_No_Strict_Aliasing : constant Name_Id := N + 131; -- GNAT
+ Name_Normalize_Scalars : constant Name_Id := N + 132;
+ Name_Polling : constant Name_Id := N + 133; -- GNAT
+ Name_Persistent_Data : constant Name_Id := N + 134; -- GNAT
+ Name_Persistent_Object : constant Name_Id := N + 135; -- GNAT
+ Name_Profile : constant Name_Id := N + 136; -- Ada05
+ Name_Profile_Warnings : constant Name_Id := N + 137; -- GNAT
+ Name_Propagate_Exceptions : constant Name_Id := N + 138; -- GNAT
+ Name_Queuing_Policy : constant Name_Id := N + 139;
+ Name_Ravenscar : constant Name_Id := N + 140;
+ Name_Restricted_Run_Time : constant Name_Id := N + 141;
+ Name_Restrictions : constant Name_Id := N + 142;
+ Name_Restriction_Warnings : constant Name_Id := N + 143; -- GNAT
+ Name_Reviewable : constant Name_Id := N + 144;
+ Name_Source_File_Name : constant Name_Id := N + 145; -- GNAT
+ Name_Source_File_Name_Project : constant Name_Id := N + 146; -- GNAT
+ Name_Style_Checks : constant Name_Id := N + 147; -- GNAT
+ Name_Suppress : constant Name_Id := N + 148;
+ Name_Suppress_Exception_Locations : constant Name_Id := N + 149; -- GNAT
+ Name_Task_Dispatching_Policy : constant Name_Id := N + 150;
+ Name_Universal_Data : constant Name_Id := N + 151; -- AAMP
+ Name_Unsuppress : constant Name_Id := N + 152; -- GNAT
+ Name_Use_VADS_Size : constant Name_Id := N + 153; -- GNAT
+ Name_Validity_Checks : constant Name_Id := N + 154; -- GNAT
+ Name_Warnings : constant Name_Id := N + 155; -- GNAT
+ Last_Configuration_Pragma_Name : constant Name_Id := N + 155;
-- Remaining pragma names
- Name_Abort_Defer : constant Name_Id := N + 155; -- GNAT
- Name_All_Calls_Remote : constant Name_Id := N + 156;
- Name_Annotate : constant Name_Id := N + 157; -- GNAT
+ Name_Abort_Defer : constant Name_Id := N + 156; -- GNAT
+ Name_All_Calls_Remote : constant Name_Id := N + 157;
+ Name_Annotate : constant Name_Id := N + 158; -- 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
-- and Check_Pragma_Id correctly recognize and process Name_AST_Entry.
-- AST_Entry is a VMS specific pragma.
- Name_Assert : constant Name_Id := N + 158; -- GNAT
- Name_Asynchronous : constant Name_Id := N + 159;
- Name_Atomic : constant Name_Id := N + 160;
- Name_Atomic_Components : constant Name_Id := N + 161;
- Name_Attach_Handler : constant Name_Id := N + 162;
- Name_Comment : constant Name_Id := N + 163; -- GNAT
- Name_Common_Object : constant Name_Id := N + 164; -- GNAT
- Name_Complex_Representation : constant Name_Id := N + 165; -- GNAT
- Name_Controlled : constant Name_Id := N + 166;
- Name_Convention : constant Name_Id := N + 167;
- Name_CPP_Class : constant Name_Id := N + 168; -- GNAT
- Name_CPP_Constructor : constant Name_Id := N + 169; -- GNAT
- Name_CPP_Virtual : constant Name_Id := N + 170; -- GNAT
- Name_CPP_Vtable : constant Name_Id := N + 171; -- GNAT
- Name_Debug : constant Name_Id := N + 172; -- GNAT
- Name_Elaborate : constant Name_Id := N + 173; -- Ada 83
- Name_Elaborate_All : constant Name_Id := N + 174;
- Name_Elaborate_Body : constant Name_Id := N + 175;
- Name_Export : constant Name_Id := N + 176;
- Name_Export_Exception : constant Name_Id := N + 177; -- VMS
- Name_Export_Function : constant Name_Id := N + 178; -- GNAT
- Name_Export_Object : constant Name_Id := N + 179; -- GNAT
- Name_Export_Procedure : constant Name_Id := N + 180; -- GNAT
- Name_Export_Value : constant Name_Id := N + 181; -- GNAT
- Name_Export_Valued_Procedure : constant Name_Id := N + 182; -- GNAT
- Name_External : constant Name_Id := N + 183; -- GNAT
- Name_Finalize_Storage_Only : constant Name_Id := N + 184; -- GNAT
- Name_Ident : constant Name_Id := N + 185; -- VMS
- Name_Import : constant Name_Id := N + 186;
- Name_Import_Exception : constant Name_Id := N + 187; -- VMS
- Name_Import_Function : constant Name_Id := N + 188; -- GNAT
- Name_Import_Object : constant Name_Id := N + 189; -- GNAT
- Name_Import_Procedure : constant Name_Id := N + 190; -- GNAT
- Name_Import_Valued_Procedure : constant Name_Id := N + 191; -- GNAT
- Name_Inline : constant Name_Id := N + 192;
- Name_Inline_Always : constant Name_Id := N + 193; -- GNAT
- Name_Inline_Generic : constant Name_Id := N + 194; -- GNAT
- Name_Inspection_Point : constant Name_Id := N + 195;
- Name_Interface : constant Name_Id := N + 196; -- Ada 83
- Name_Interface_Name : constant Name_Id := N + 197; -- GNAT
- Name_Interrupt_Handler : constant Name_Id := N + 198;
- Name_Interrupt_Priority : constant Name_Id := N + 199;
- Name_Java_Constructor : constant Name_Id := N + 200; -- GNAT
- Name_Java_Interface : constant Name_Id := N + 201; -- GNAT
- Name_Keep_Names : constant Name_Id := N + 202; -- GNAT
- Name_Link_With : constant Name_Id := N + 203; -- GNAT
- Name_Linker_Alias : constant Name_Id := N + 204; -- GNAT
- Name_Linker_Options : constant Name_Id := N + 205;
- Name_Linker_Section : constant Name_Id := N + 206; -- GNAT
- Name_List : constant Name_Id := N + 207;
- Name_Machine_Attribute : constant Name_Id := N + 208; -- GNAT
- Name_Main : constant Name_Id := N + 209; -- GNAT
- Name_Main_Storage : constant Name_Id := N + 210; -- GNAT
- Name_Memory_Size : constant Name_Id := N + 211; -- Ada 83
- Name_No_Return : constant Name_Id := N + 212; -- GNAT
- Name_Obsolescent : constant Name_Id := N + 213; -- GNAT
- Name_Optimize : constant Name_Id := N + 214;
- Name_Optional_Overriding : constant Name_Id := N + 215;
- Name_Overriding : constant Name_Id := N + 216;
- Name_Pack : constant Name_Id := N + 217;
- Name_Page : constant Name_Id := N + 218;
- Name_Passive : constant Name_Id := N + 219; -- GNAT
- Name_Preelaborate : constant Name_Id := N + 220;
- Name_Priority : constant Name_Id := N + 221;
- Name_Psect_Object : constant Name_Id := N + 222; -- VMS
- Name_Pure : constant Name_Id := N + 223;
- Name_Pure_Function : constant Name_Id := N + 224; -- GNAT
- Name_Remote_Call_Interface : constant Name_Id := N + 225;
- Name_Remote_Types : constant Name_Id := N + 226;
- Name_Share_Generic : constant Name_Id := N + 227; -- GNAT
- Name_Shared : constant Name_Id := N + 228; -- Ada 83
- Name_Shared_Passive : constant Name_Id := N + 229;
+ Name_Assert : constant Name_Id := N + 159; -- GNAT
+ Name_Asynchronous : constant Name_Id := N + 160;
+ Name_Atomic : constant Name_Id := N + 161;
+ Name_Atomic_Components : constant Name_Id := N + 162;
+ Name_Attach_Handler : constant Name_Id := N + 163;
+ Name_Comment : constant Name_Id := N + 164; -- GNAT
+ Name_Common_Object : constant Name_Id := N + 165; -- GNAT
+ Name_Complex_Representation : constant Name_Id := N + 166; -- GNAT
+ Name_Controlled : constant Name_Id := N + 167;
+ Name_Convention : constant Name_Id := N + 168;
+ Name_CPP_Class : constant Name_Id := N + 169; -- GNAT
+ Name_CPP_Constructor : constant Name_Id := N + 170; -- GNAT
+ Name_CPP_Virtual : constant Name_Id := N + 171; -- GNAT
+ Name_CPP_Vtable : constant Name_Id := N + 172; -- GNAT
+ Name_Debug : constant Name_Id := N + 173; -- GNAT
+ Name_Elaborate : constant Name_Id := N + 174; -- Ada 83
+ Name_Elaborate_All : constant Name_Id := N + 175;
+ Name_Elaborate_Body : constant Name_Id := N + 176;
+ Name_Export : constant Name_Id := N + 177;
+ Name_Export_Exception : constant Name_Id := N + 178; -- VMS
+ Name_Export_Function : constant Name_Id := N + 179; -- GNAT
+ Name_Export_Object : constant Name_Id := N + 180; -- GNAT
+ Name_Export_Procedure : constant Name_Id := N + 181; -- GNAT
+ Name_Export_Value : constant Name_Id := N + 182; -- GNAT
+ Name_Export_Valued_Procedure : constant Name_Id := N + 183; -- GNAT
+ Name_External : constant Name_Id := N + 184; -- GNAT
+ Name_Finalize_Storage_Only : constant Name_Id := N + 185; -- GNAT
+ Name_Ident : constant Name_Id := N + 186; -- VMS
+ Name_Import : constant Name_Id := N + 187;
+ Name_Import_Exception : constant Name_Id := N + 188; -- VMS
+ Name_Import_Function : constant Name_Id := N + 189; -- GNAT
+ Name_Import_Object : constant Name_Id := N + 190; -- GNAT
+ Name_Import_Procedure : constant Name_Id := N + 191; -- GNAT
+ Name_Import_Valued_Procedure : constant Name_Id := N + 192; -- GNAT
+ Name_Inline : constant Name_Id := N + 193;
+ Name_Inline_Always : constant Name_Id := N + 194; -- GNAT
+ Name_Inline_Generic : constant Name_Id := N + 195; -- GNAT
+ Name_Inspection_Point : constant Name_Id := N + 196;
+ Name_Interface : constant Name_Id := N + 197; -- Ada 83
+ Name_Interface_Name : constant Name_Id := N + 198; -- GNAT
+ Name_Interrupt_Handler : constant Name_Id := N + 199;
+ Name_Interrupt_Priority : constant Name_Id := N + 200;
+ Name_Java_Constructor : constant Name_Id := N + 201; -- GNAT
+ Name_Java_Interface : constant Name_Id := N + 202; -- GNAT
+ Name_Keep_Names : constant Name_Id := N + 203; -- GNAT
+ Name_Link_With : constant Name_Id := N + 204; -- GNAT
+ Name_Linker_Alias : constant Name_Id := N + 205; -- GNAT
+ Name_Linker_Options : constant Name_Id := N + 206;
+ Name_Linker_Section : constant Name_Id := N + 207; -- GNAT
+ Name_List : constant Name_Id := N + 208;
+ Name_Machine_Attribute : constant Name_Id := N + 209; -- GNAT
+ Name_Main : constant Name_Id := N + 210; -- GNAT
+ Name_Main_Storage : constant Name_Id := N + 211; -- GNAT
+ Name_Memory_Size : constant Name_Id := N + 212; -- Ada 83
+ Name_No_Return : constant Name_Id := N + 213; -- GNAT
+ Name_Obsolescent : constant Name_Id := N + 214; -- GNAT
+ Name_Optimize : constant Name_Id := N + 215;
+ Name_Optional_Overriding : constant Name_Id := N + 216;
+ Name_Overriding : constant Name_Id := N + 217;
+ Name_Pack : constant Name_Id := N + 218;
+ Name_Page : constant Name_Id := N + 219;
+ Name_Passive : constant Name_Id := N + 220; -- GNAT
+ Name_Preelaborate : constant Name_Id := N + 221;
+ Name_Priority : constant Name_Id := N + 222;
+ Name_Psect_Object : constant Name_Id := N + 223; -- VMS
+ Name_Pure : constant Name_Id := N + 224;
+ Name_Pure_Function : constant Name_Id := N + 225; -- GNAT
+ Name_Remote_Call_Interface : constant Name_Id := N + 226;
+ Name_Remote_Types : constant Name_Id := N + 227;
+ Name_Share_Generic : constant Name_Id := N + 228; -- GNAT
+ Name_Shared : constant Name_Id := N + 229; -- Ada 83
+ Name_Shared_Passive : constant Name_Id := N + 230;
-- Note: Storage_Size is not in this list because its name matches the
-- name of the corresponding attribute. However, it is included in the
-- 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 + 230; -- GNAT
- Name_Stream_Convert : constant Name_Id := N + 231; -- GNAT
- Name_Subtitle : constant Name_Id := N + 232; -- GNAT
- Name_Suppress_All : constant Name_Id := N + 233; -- GNAT
- Name_Suppress_Debug_Info : constant Name_Id := N + 234; -- GNAT
- Name_Suppress_Initialization : constant Name_Id := N + 235; -- GNAT
- Name_System_Name : constant Name_Id := N + 236; -- Ada 83
- Name_Task_Info : constant Name_Id := N + 237; -- GNAT
- Name_Task_Name : constant Name_Id := N + 238; -- GNAT
- Name_Task_Storage : constant Name_Id := N + 239; -- VMS
- Name_Thread_Body : constant Name_Id := N + 240; -- GNAT
- Name_Time_Slice : constant Name_Id := N + 241; -- GNAT
- Name_Title : constant Name_Id := N + 242; -- GNAT
- Name_Unchecked_Union : constant Name_Id := N + 243; -- GNAT
- Name_Unimplemented_Unit : constant Name_Id := N + 244; -- GNAT
- Name_Unreferenced : constant Name_Id := N + 245; -- GNAT
- Name_Unreserve_All_Interrupts : constant Name_Id := N + 246; -- GNAT
- Name_Volatile : constant Name_Id := N + 247;
- Name_Volatile_Components : constant Name_Id := N + 248;
- Name_Weak_External : constant Name_Id := N + 249; -- GNAT
- Last_Pragma_Name : constant Name_Id := N + 249;
+ Name_Source_Reference : constant Name_Id := N + 231; -- GNAT
+ Name_Stream_Convert : constant Name_Id := N + 232; -- GNAT
+ Name_Subtitle : constant Name_Id := N + 233; -- GNAT
+ Name_Suppress_All : constant Name_Id := N + 234; -- GNAT
+ Name_Suppress_Debug_Info : constant Name_Id := N + 235; -- GNAT
+ Name_Suppress_Initialization : constant Name_Id := N + 236; -- GNAT
+ Name_System_Name : constant Name_Id := N + 237; -- Ada 83
+ Name_Task_Info : constant Name_Id := N + 238; -- GNAT
+ Name_Task_Name : constant Name_Id := N + 239; -- GNAT
+ Name_Task_Storage : constant Name_Id := N + 240; -- VMS
+ Name_Thread_Body : constant Name_Id := N + 241; -- GNAT
+ Name_Time_Slice : constant Name_Id := N + 242; -- GNAT
+ Name_Title : constant Name_Id := N + 243; -- GNAT
+ Name_Unchecked_Union : constant Name_Id := N + 244; -- GNAT
+ Name_Unimplemented_Unit : constant Name_Id := N + 245; -- GNAT
+ Name_Unreferenced : constant Name_Id := N + 246; -- GNAT
+ Name_Unreserve_All_Interrupts : constant Name_Id := N + 247; -- GNAT
+ Name_Volatile : constant Name_Id := N + 248;
+ Name_Volatile_Components : constant Name_Id := N + 249;
+ Name_Weak_External : constant Name_Id := N + 250; -- GNAT
+ Last_Pragma_Name : constant Name_Id := N + 250;
-- Language convention names for pragma Convention/Export/Import/Interface
-- Note that Name_C is not included in this list, since it was already
-- Entry and Protected, this is because these conventions cannot be
-- specified by a pragma.
- First_Convention_Name : constant Name_Id := N + 250;
- Name_Ada : constant Name_Id := N + 250;
- Name_Assembler : constant Name_Id := N + 251;
- Name_COBOL : constant Name_Id := N + 252;
- Name_CPP : constant Name_Id := N + 253;
- Name_Fortran : constant Name_Id := N + 254;
- Name_Intrinsic : constant Name_Id := N + 255;
- Name_Java : constant Name_Id := N + 256;
- Name_Stdcall : constant Name_Id := N + 257;
- Name_Stubbed : constant Name_Id := N + 258;
- Last_Convention_Name : constant Name_Id := N + 258;
+ First_Convention_Name : constant Name_Id := N + 251;
+ Name_Ada : constant Name_Id := N + 251;
+ Name_Assembler : constant Name_Id := N + 252;
+ Name_COBOL : constant Name_Id := N + 253;
+ Name_CPP : constant Name_Id := N + 254;
+ Name_Fortran : constant Name_Id := N + 255;
+ Name_Intrinsic : constant Name_Id := N + 256;
+ Name_Java : constant Name_Id := N + 257;
+ Name_Stdcall : constant Name_Id := N + 258;
+ Name_Stubbed : constant Name_Id := N + 259;
+ Last_Convention_Name : constant Name_Id := N + 259;
-- The following names are preset as synonyms for Assembler
- Name_Asm : constant Name_Id := N + 259;
- Name_Assembly : constant Name_Id := N + 260;
+ Name_Asm : constant Name_Id := N + 260;
+ Name_Assembly : constant Name_Id := N + 261;
-- The following names are preset as synonyms for C
- Name_Default : constant Name_Id := N + 261;
+ Name_Default : constant Name_Id := N + 262;
-- Name_Exernal (previously defined as pragma)
-- The following names are present as synonyms for Stdcall
- Name_DLL : constant Name_Id := N + 262;
- Name_Win32 : constant Name_Id := N + 263;
+ Name_DLL : constant Name_Id := N + 263;
+ Name_Win32 : constant Name_Id := N + 264;
-- Other special names used in processing pragmas
- Name_As_Is : constant Name_Id := N + 264;
- Name_Body_File_Name : constant Name_Id := N + 265;
- Name_Boolean_Entry_Barriers : constant Name_Id := N + 266;
- Name_Casing : constant Name_Id := N + 267;
- Name_Code : constant Name_Id := N + 268;
- Name_Component : constant Name_Id := N + 269;
- Name_Component_Size_4 : constant Name_Id := N + 270;
- Name_Copy : constant Name_Id := N + 271;
- Name_D_Float : constant Name_Id := N + 272;
- Name_Descriptor : constant Name_Id := N + 273;
- Name_Dot_Replacement : constant Name_Id := N + 274;
- Name_Dynamic : constant Name_Id := N + 275;
- Name_Entity : constant Name_Id := N + 276;
- Name_External_Name : constant Name_Id := N + 277;
- Name_First_Optional_Parameter : constant Name_Id := N + 278;
- Name_Form : constant Name_Id := N + 279;
- Name_G_Float : constant Name_Id := N + 280;
- Name_Gcc : constant Name_Id := N + 281;
- Name_Gnat : constant Name_Id := N + 282;
- Name_GPL : constant Name_Id := N + 283;
- Name_IEEE_Float : constant Name_Id := N + 284;
- Name_Internal : constant Name_Id := N + 285;
- Name_Link_Name : constant Name_Id := N + 286;
- Name_Lowercase : constant Name_Id := N + 287;
- Name_Max_Entry_Queue_Depth : constant Name_Id := N + 288;
- Name_Max_Entry_Queue_Length : constant Name_Id := N + 289;
- Name_Max_Size : constant Name_Id := N + 290;
- Name_Mechanism : constant Name_Id := N + 291;
- Name_Mixedcase : constant Name_Id := N + 292;
- Name_Modified_GPL : constant Name_Id := N + 293;
- Name_Name : constant Name_Id := N + 294;
- Name_NCA : constant Name_Id := N + 295;
- Name_No : constant Name_Id := N + 296;
- Name_On : constant Name_Id := N + 297;
- Name_Parameter_Types : constant Name_Id := N + 298;
- Name_Reference : constant Name_Id := N + 299;
- Name_No_Dynamic_Attachment : constant Name_Id := N + 300;
- Name_No_Dynamic_Interrupts : constant Name_Id := N + 301;
- Name_No_Requeue : constant Name_Id := N + 302;
- Name_No_Requeue_Statements : constant Name_Id := N + 303;
- Name_No_Task_Attributes : constant Name_Id := N + 304;
- Name_No_Task_Attributes_Package : constant Name_Id := N + 305;
- Name_Restricted : constant Name_Id := N + 306;
- Name_Result_Mechanism : constant Name_Id := N + 307;
- Name_Result_Type : constant Name_Id := N + 308;
- Name_Runtime : constant Name_Id := N + 309;
- Name_SB : constant Name_Id := N + 310;
- Name_Secondary_Stack_Size : constant Name_Id := N + 311;
- Name_Section : constant Name_Id := N + 312;
- Name_Semaphore : constant Name_Id := N + 313;
- Name_Simple_Barriers : constant Name_Id := N + 314;
- Name_Spec_File_Name : constant Name_Id := N + 315;
- Name_Static : constant Name_Id := N + 316;
- Name_Stack_Size : constant Name_Id := N + 317;
- Name_Subunit_File_Name : constant Name_Id := N + 318;
- Name_Task_Stack_Size_Default : constant Name_Id := N + 319;
- Name_Task_Type : constant Name_Id := N + 320;
- Name_Time_Slicing_Enabled : constant Name_Id := N + 321;
- Name_Top_Guard : constant Name_Id := N + 322;
- Name_UBA : constant Name_Id := N + 323;
- Name_UBS : constant Name_Id := N + 324;
- Name_UBSB : constant Name_Id := N + 325;
- Name_Unit_Name : constant Name_Id := N + 326;
- Name_Unknown : constant Name_Id := N + 327;
- Name_Unrestricted : constant Name_Id := N + 328;
- Name_Uppercase : constant Name_Id := N + 329;
- Name_User : constant Name_Id := N + 330;
- Name_VAX_Float : constant Name_Id := N + 331;
- Name_VMS : constant Name_Id := N + 332;
- Name_Working_Storage : constant Name_Id := N + 333;
+ Name_As_Is : constant Name_Id := N + 265;
+ Name_Body_File_Name : constant Name_Id := N + 266;
+ Name_Boolean_Entry_Barriers : constant Name_Id := N + 267;
+ Name_Casing : constant Name_Id := N + 268;
+ Name_Code : constant Name_Id := N + 269;
+ Name_Component : constant Name_Id := N + 270;
+ Name_Component_Size_4 : constant Name_Id := N + 271;
+ Name_Copy : constant Name_Id := N + 272;
+ Name_D_Float : constant Name_Id := N + 273;
+ Name_Descriptor : constant Name_Id := N + 274;
+ Name_Dot_Replacement : constant Name_Id := N + 275;
+ Name_Dynamic : constant Name_Id := N + 276;
+ Name_Entity : constant Name_Id := N + 277;
+ Name_External_Name : constant Name_Id := N + 278;
+ Name_First_Optional_Parameter : constant Name_Id := N + 279;
+ Name_Form : constant Name_Id := N + 280;
+ Name_G_Float : constant Name_Id := N + 281;
+ Name_Gcc : constant Name_Id := N + 282;
+ Name_Gnat : constant Name_Id := N + 283;
+ Name_GPL : constant Name_Id := N + 284;
+ Name_IEEE_Float : constant Name_Id := N + 285;
+ Name_Internal : constant Name_Id := N + 286;
+ Name_Link_Name : constant Name_Id := N + 287;
+ Name_Lowercase : constant Name_Id := N + 288;
+ Name_Max_Entry_Queue_Depth : constant Name_Id := N + 289;
+ Name_Max_Entry_Queue_Length : constant Name_Id := N + 290;
+ Name_Max_Size : constant Name_Id := N + 291;
+ Name_Mechanism : constant Name_Id := N + 292;
+ Name_Mixedcase : constant Name_Id := N + 293;
+ Name_Modified_GPL : constant Name_Id := N + 294;
+ Name_Name : constant Name_Id := N + 295;
+ Name_NCA : constant Name_Id := N + 296;
+ Name_No : constant Name_Id := N + 297;
+ Name_On : constant Name_Id := N + 298;
+ Name_Parameter_Types : constant Name_Id := N + 299;
+ Name_Reference : constant Name_Id := N + 300;
+ Name_No_Dynamic_Attachment : constant Name_Id := N + 301;
+ Name_No_Dynamic_Interrupts : constant Name_Id := N + 302;
+ Name_No_Requeue : constant Name_Id := N + 303;
+ Name_No_Requeue_Statements : constant Name_Id := N + 304;
+ Name_No_Task_Attributes : constant Name_Id := N + 305;
+ Name_No_Task_Attributes_Package : constant Name_Id := N + 306;
+ Name_Restricted : constant Name_Id := N + 307;
+ Name_Result_Mechanism : constant Name_Id := N + 308;
+ Name_Result_Type : constant Name_Id := N + 309;
+ Name_Runtime : constant Name_Id := N + 310;
+ Name_SB : constant Name_Id := N + 311;
+ Name_Secondary_Stack_Size : constant Name_Id := N + 312;
+ Name_Section : constant Name_Id := N + 313;
+ Name_Semaphore : constant Name_Id := N + 314;
+ Name_Simple_Barriers : constant Name_Id := N + 315;
+ Name_Spec_File_Name : constant Name_Id := N + 316;
+ Name_Static : constant Name_Id := N + 317;
+ Name_Stack_Size : constant Name_Id := N + 318;
+ Name_Subunit_File_Name : constant Name_Id := N + 319;
+ Name_Task_Stack_Size_Default : constant Name_Id := N + 320;
+ Name_Task_Type : constant Name_Id := N + 321;
+ Name_Time_Slicing_Enabled : constant Name_Id := N + 322;
+ Name_Top_Guard : constant Name_Id := N + 323;
+ Name_UBA : constant Name_Id := N + 324;
+ Name_UBS : constant Name_Id := N + 325;
+ Name_UBSB : constant Name_Id := N + 326;
+ Name_Unit_Name : constant Name_Id := N + 327;
+ Name_Unknown : constant Name_Id := N + 328;
+ Name_Unrestricted : constant Name_Id := N + 329;
+ Name_Uppercase : constant Name_Id := N + 330;
+ Name_User : constant Name_Id := N + 331;
+ Name_VAX_Float : constant Name_Id := N + 332;
+ Name_VMS : constant Name_Id := N + 333;
+ Name_Working_Storage : constant Name_Id := N + 334;
-- 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
-- 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 + 334;
- Name_Abort_Signal : constant Name_Id := N + 334; -- GNAT
- Name_Access : constant Name_Id := N + 335;
- Name_Address : constant Name_Id := N + 336;
- Name_Address_Size : constant Name_Id := N + 337; -- GNAT
- Name_Aft : constant Name_Id := N + 338;
- Name_Alignment : constant Name_Id := N + 339;
- Name_Asm_Input : constant Name_Id := N + 340; -- GNAT
- Name_Asm_Output : constant Name_Id := N + 341; -- GNAT
- Name_AST_Entry : constant Name_Id := N + 342; -- VMS
- Name_Bit : constant Name_Id := N + 343; -- GNAT
- Name_Bit_Order : constant Name_Id := N + 344;
- Name_Bit_Position : constant Name_Id := N + 345; -- GNAT
- Name_Body_Version : constant Name_Id := N + 346;
- Name_Callable : constant Name_Id := N + 347;
- Name_Caller : constant Name_Id := N + 348;
- Name_Code_Address : constant Name_Id := N + 349; -- GNAT
- Name_Component_Size : constant Name_Id := N + 350;
- Name_Compose : constant Name_Id := N + 351;
- Name_Constrained : constant Name_Id := N + 352;
- Name_Count : constant Name_Id := N + 353;
- Name_Default_Bit_Order : constant Name_Id := N + 354; -- GNAT
- Name_Definite : constant Name_Id := N + 355;
- Name_Delta : constant Name_Id := N + 356;
- Name_Denorm : constant Name_Id := N + 357;
- Name_Digits : constant Name_Id := N + 358;
- Name_Elaborated : constant Name_Id := N + 359; -- GNAT
- Name_Emax : constant Name_Id := N + 360; -- Ada 83
- Name_Enum_Rep : constant Name_Id := N + 361; -- GNAT
- Name_Epsilon : constant Name_Id := N + 362; -- Ada 83
- Name_Exponent : constant Name_Id := N + 363;
- Name_External_Tag : constant Name_Id := N + 364;
- Name_First : constant Name_Id := N + 365;
- Name_First_Bit : constant Name_Id := N + 366;
- Name_Fixed_Value : constant Name_Id := N + 367; -- GNAT
- Name_Fore : constant Name_Id := N + 368;
- Name_Has_Access_Values : constant Name_Id := N + 369; -- GNAT
- Name_Has_Discriminants : constant Name_Id := N + 370; -- GNAT
- Name_Identity : constant Name_Id := N + 371;
- Name_Img : constant Name_Id := N + 372; -- GNAT
- Name_Integer_Value : constant Name_Id := N + 373; -- GNAT
- Name_Large : constant Name_Id := N + 374; -- Ada 83
- Name_Last : constant Name_Id := N + 375;
- Name_Last_Bit : constant Name_Id := N + 376;
- Name_Leading_Part : constant Name_Id := N + 377;
- Name_Length : constant Name_Id := N + 378;
- Name_Machine_Emax : constant Name_Id := N + 379;
- Name_Machine_Emin : constant Name_Id := N + 380;
- Name_Machine_Mantissa : constant Name_Id := N + 381;
- Name_Machine_Overflows : constant Name_Id := N + 382;
- Name_Machine_Radix : constant Name_Id := N + 383;
- Name_Machine_Rounds : constant Name_Id := N + 384;
- Name_Machine_Size : constant Name_Id := N + 385; -- GNAT
- Name_Mantissa : constant Name_Id := N + 386; -- Ada 83
- Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 387;
- Name_Maximum_Alignment : constant Name_Id := N + 388; -- GNAT
- Name_Mechanism_Code : constant Name_Id := N + 389; -- GNAT
- Name_Model_Emin : constant Name_Id := N + 390;
- Name_Model_Epsilon : constant Name_Id := N + 391;
- Name_Model_Mantissa : constant Name_Id := N + 392;
- Name_Model_Small : constant Name_Id := N + 393;
- Name_Modulus : constant Name_Id := N + 394;
- Name_Null_Parameter : constant Name_Id := N + 395; -- GNAT
- Name_Object_Size : constant Name_Id := N + 396; -- GNAT
- Name_Partition_ID : constant Name_Id := N + 397;
- Name_Passed_By_Reference : constant Name_Id := N + 398; -- GNAT
- Name_Pool_Address : constant Name_Id := N + 399;
- Name_Pos : constant Name_Id := N + 400;
- Name_Position : constant Name_Id := N + 401;
- Name_Range : constant Name_Id := N + 402;
- Name_Range_Length : constant Name_Id := N + 403; -- GNAT
- Name_Round : constant Name_Id := N + 404;
- Name_Safe_Emax : constant Name_Id := N + 405; -- Ada 83
- Name_Safe_First : constant Name_Id := N + 406;
- Name_Safe_Large : constant Name_Id := N + 407; -- Ada 83
- Name_Safe_Last : constant Name_Id := N + 408;
- Name_Safe_Small : constant Name_Id := N + 409; -- Ada 83
- Name_Scale : constant Name_Id := N + 410;
- Name_Scaling : constant Name_Id := N + 411;
- Name_Signed_Zeros : constant Name_Id := N + 412;
- Name_Size : constant Name_Id := N + 413;
- Name_Small : constant Name_Id := N + 414;
- Name_Storage_Size : constant Name_Id := N + 415;
- Name_Storage_Unit : constant Name_Id := N + 416; -- GNAT
- Name_Tag : constant Name_Id := N + 417;
- Name_Target_Name : constant Name_Id := N + 418; -- GNAT
- Name_Terminated : constant Name_Id := N + 419;
- Name_To_Address : constant Name_Id := N + 420; -- GNAT
- Name_Type_Class : constant Name_Id := N + 421; -- GNAT
- Name_UET_Address : constant Name_Id := N + 422; -- GNAT
- Name_Unbiased_Rounding : constant Name_Id := N + 423;
- Name_Unchecked_Access : constant Name_Id := N + 424;
- Name_Unconstrained_Array : constant Name_Id := N + 425;
- Name_Universal_Literal_String : constant Name_Id := N + 426; -- GNAT
- Name_Unrestricted_Access : constant Name_Id := N + 427; -- GNAT
- Name_VADS_Size : constant Name_Id := N + 428; -- GNAT
- Name_Val : constant Name_Id := N + 429;
- Name_Valid : constant Name_Id := N + 430;
- Name_Value_Size : constant Name_Id := N + 431; -- GNAT
- Name_Version : constant Name_Id := N + 432;
- Name_Wchar_T_Size : constant Name_Id := N + 433; -- GNAT
- Name_Wide_Width : constant Name_Id := N + 434;
- Name_Width : constant Name_Id := N + 435;
- Name_Word_Size : constant Name_Id := N + 436; -- GNAT
+ First_Attribute_Name : constant Name_Id := N + 335;
+ Name_Abort_Signal : constant Name_Id := N + 335; -- GNAT
+ Name_Access : constant Name_Id := N + 336;
+ Name_Address : constant Name_Id := N + 337;
+ Name_Address_Size : constant Name_Id := N + 338; -- GNAT
+ Name_Aft : constant Name_Id := N + 339;
+ Name_Alignment : constant Name_Id := N + 340;
+ Name_Asm_Input : constant Name_Id := N + 341; -- GNAT
+ Name_Asm_Output : constant Name_Id := N + 342; -- GNAT
+ Name_AST_Entry : constant Name_Id := N + 343; -- VMS
+ Name_Bit : constant Name_Id := N + 344; -- GNAT
+ Name_Bit_Order : constant Name_Id := N + 345;
+ Name_Bit_Position : constant Name_Id := N + 346; -- GNAT
+ Name_Body_Version : constant Name_Id := N + 347;
+ Name_Callable : constant Name_Id := N + 348;
+ Name_Caller : constant Name_Id := N + 349;
+ Name_Code_Address : constant Name_Id := N + 350; -- GNAT
+ Name_Component_Size : constant Name_Id := N + 351;
+ Name_Compose : constant Name_Id := N + 352;
+ Name_Constrained : constant Name_Id := N + 353;
+ Name_Count : constant Name_Id := N + 354;
+ Name_Default_Bit_Order : constant Name_Id := N + 355; -- GNAT
+ Name_Definite : constant Name_Id := N + 356;
+ Name_Delta : constant Name_Id := N + 357;
+ Name_Denorm : constant Name_Id := N + 358;
+ Name_Digits : constant Name_Id := N + 359;
+ Name_Elaborated : constant Name_Id := N + 360; -- GNAT
+ Name_Emax : constant Name_Id := N + 361; -- Ada 83
+ Name_Enum_Rep : constant Name_Id := N + 362; -- GNAT
+ Name_Epsilon : constant Name_Id := N + 363; -- Ada 83
+ Name_Exponent : constant Name_Id := N + 364;
+ Name_External_Tag : constant Name_Id := N + 365;
+ Name_First : constant Name_Id := N + 366;
+ Name_First_Bit : constant Name_Id := N + 367;
+ Name_Fixed_Value : constant Name_Id := N + 368; -- GNAT
+ Name_Fore : constant Name_Id := N + 369;
+ Name_Has_Access_Values : constant Name_Id := N + 370; -- GNAT
+ Name_Has_Discriminants : constant Name_Id := N + 371; -- GNAT
+ Name_Identity : constant Name_Id := N + 372;
+ Name_Img : constant Name_Id := N + 373; -- GNAT
+ Name_Integer_Value : constant Name_Id := N + 374; -- GNAT
+ Name_Large : constant Name_Id := N + 375; -- Ada 83
+ Name_Last : constant Name_Id := N + 376;
+ Name_Last_Bit : constant Name_Id := N + 377;
+ Name_Leading_Part : constant Name_Id := N + 378;
+ Name_Length : constant Name_Id := N + 379;
+ Name_Machine_Emax : constant Name_Id := N + 380;
+ Name_Machine_Emin : constant Name_Id := N + 381;
+ Name_Machine_Mantissa : constant Name_Id := N + 382;
+ Name_Machine_Overflows : constant Name_Id := N + 383;
+ Name_Machine_Radix : constant Name_Id := N + 384;
+ Name_Machine_Rounds : constant Name_Id := N + 385;
+ Name_Machine_Size : constant Name_Id := N + 386; -- GNAT
+ Name_Mantissa : constant Name_Id := N + 387; -- Ada 83
+ Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 388;
+ Name_Maximum_Alignment : constant Name_Id := N + 389; -- GNAT
+ Name_Mechanism_Code : constant Name_Id := N + 390; -- GNAT
+ Name_Model_Emin : constant Name_Id := N + 391;
+ Name_Model_Epsilon : constant Name_Id := N + 392;
+ Name_Model_Mantissa : constant Name_Id := N + 393;
+ Name_Model_Small : constant Name_Id := N + 394;
+ Name_Modulus : constant Name_Id := N + 395;
+ Name_Null_Parameter : constant Name_Id := N + 396; -- GNAT
+ Name_Object_Size : constant Name_Id := N + 397; -- GNAT
+ Name_Partition_ID : constant Name_Id := N + 398;
+ Name_Passed_By_Reference : constant Name_Id := N + 399; -- GNAT
+ Name_Pool_Address : constant Name_Id := N + 400;
+ Name_Pos : constant Name_Id := N + 401;
+ Name_Position : constant Name_Id := N + 402;
+ Name_Range : constant Name_Id := N + 403;
+ Name_Range_Length : constant Name_Id := N + 404; -- GNAT
+ Name_Round : constant Name_Id := N + 405;
+ Name_Safe_Emax : constant Name_Id := N + 406; -- Ada 83
+ Name_Safe_First : constant Name_Id := N + 407;
+ Name_Safe_Large : constant Name_Id := N + 408; -- Ada 83
+ Name_Safe_Last : constant Name_Id := N + 409;
+ Name_Safe_Small : constant Name_Id := N + 410; -- Ada 83
+ Name_Scale : constant Name_Id := N + 411;
+ Name_Scaling : constant Name_Id := N + 412;
+ Name_Signed_Zeros : constant Name_Id := N + 413;
+ Name_Size : constant Name_Id := N + 414;
+ Name_Small : constant Name_Id := N + 415;
+ Name_Storage_Size : constant Name_Id := N + 416;
+ Name_Storage_Unit : constant Name_Id := N + 417; -- GNAT
+ Name_Tag : constant Name_Id := N + 418;
+ Name_Target_Name : constant Name_Id := N + 419; -- GNAT
+ Name_Terminated : constant Name_Id := N + 420;
+ Name_To_Address : constant Name_Id := N + 421; -- GNAT
+ Name_Type_Class : constant Name_Id := N + 422; -- GNAT
+ Name_UET_Address : constant Name_Id := N + 423; -- GNAT
+ Name_Unbiased_Rounding : constant Name_Id := N + 424;
+ Name_Unchecked_Access : constant Name_Id := N + 425;
+ Name_Unconstrained_Array : constant Name_Id := N + 426;
+ Name_Universal_Literal_String : constant Name_Id := N + 427; -- GNAT
+ Name_Unrestricted_Access : constant Name_Id := N + 428; -- GNAT
+ Name_VADS_Size : constant Name_Id := N + 429; -- GNAT
+ Name_Val : constant Name_Id := N + 430;
+ Name_Valid : constant Name_Id := N + 431;
+ Name_Value_Size : constant Name_Id := N + 432; -- GNAT
+ Name_Version : constant Name_Id := N + 433;
+ Name_Wchar_T_Size : constant Name_Id := N + 434; -- GNAT
+ Name_Wide_Width : constant Name_Id := N + 435;
+ Name_Width : constant Name_Id := N + 436;
+ Name_Word_Size : constant Name_Id := N + 437; -- GNAT
-- Attributes that designate attributes returning renamable functions,
-- i.e. functions that return other than a universal value.
- First_Renamable_Function_Attribute : constant Name_Id := N + 437;
- Name_Adjacent : constant Name_Id := N + 437;
- Name_Ceiling : constant Name_Id := N + 438;
- Name_Copy_Sign : constant Name_Id := N + 439;
- Name_Floor : constant Name_Id := N + 440;
- Name_Fraction : constant Name_Id := N + 441;
- Name_Image : constant Name_Id := N + 442;
- Name_Input : constant Name_Id := N + 443;
- Name_Machine : constant Name_Id := N + 444;
- Name_Max : constant Name_Id := N + 445;
- Name_Min : constant Name_Id := N + 446;
- Name_Model : constant Name_Id := N + 447;
- Name_Pred : constant Name_Id := N + 448;
- Name_Remainder : constant Name_Id := N + 449;
- Name_Rounding : constant Name_Id := N + 450;
- Name_Succ : constant Name_Id := N + 451;
- Name_Truncation : constant Name_Id := N + 452;
- Name_Value : constant Name_Id := N + 453;
- Name_Wide_Image : constant Name_Id := N + 454;
- Name_Wide_Value : constant Name_Id := N + 455;
- Last_Renamable_Function_Attribute : constant Name_Id := N + 455;
+ First_Renamable_Function_Attribute : constant Name_Id := N + 438;
+ Name_Adjacent : constant Name_Id := N + 438;
+ Name_Ceiling : constant Name_Id := N + 439;
+ Name_Copy_Sign : constant Name_Id := N + 440;
+ Name_Floor : constant Name_Id := N + 441;
+ Name_Fraction : constant Name_Id := N + 442;
+ Name_Image : constant Name_Id := N + 443;
+ Name_Input : constant Name_Id := N + 444;
+ Name_Machine : constant Name_Id := N + 445;
+ Name_Max : constant Name_Id := N + 446;
+ Name_Min : constant Name_Id := N + 447;
+ Name_Model : constant Name_Id := N + 448;
+ Name_Pred : constant Name_Id := N + 449;
+ Name_Remainder : constant Name_Id := N + 450;
+ Name_Rounding : constant Name_Id := N + 451;
+ Name_Succ : constant Name_Id := N + 452;
+ Name_Truncation : constant Name_Id := N + 453;
+ Name_Value : constant Name_Id := N + 454;
+ Name_Wide_Image : constant Name_Id := N + 455;
+ Name_Wide_Value : constant Name_Id := N + 456;
+ Last_Renamable_Function_Attribute : constant Name_Id := N + 456;
-- Attributes that designate procedures
- First_Procedure_Attribute : constant Name_Id := N + 456;
- Name_Output : constant Name_Id := N + 456;
- Name_Read : constant Name_Id := N + 457;
- Name_Write : constant Name_Id := N + 458;
- Last_Procedure_Attribute : constant Name_Id := N + 458;
+ First_Procedure_Attribute : constant Name_Id := N + 457;
+ Name_Output : constant Name_Id := N + 457;
+ Name_Read : constant Name_Id := N + 458;
+ Name_Write : constant Name_Id := N + 459;
+ Last_Procedure_Attribute : constant Name_Id := N + 459;
-- Remaining attributes are ones that return entities
- First_Entity_Attribute_Name : constant Name_Id := N + 459;
- Name_Elab_Body : constant Name_Id := N + 459; -- GNAT
- Name_Elab_Spec : constant Name_Id := N + 460; -- GNAT
- Name_Storage_Pool : constant Name_Id := N + 461;
+ First_Entity_Attribute_Name : constant Name_Id := N + 460;
+ Name_Elab_Body : constant Name_Id := N + 460; -- GNAT
+ Name_Elab_Spec : constant Name_Id := N + 461; -- GNAT
+ Name_Storage_Pool : constant Name_Id := N + 462;
-- These attributes are the ones that return types
- First_Type_Attribute_Name : constant Name_Id := N + 462;
- Name_Base : constant Name_Id := N + 462;
- Name_Class : constant Name_Id := N + 463;
- Last_Type_Attribute_Name : constant Name_Id := N + 463;
- Last_Entity_Attribute_Name : constant Name_Id := N + 463;
- Last_Attribute_Name : constant Name_Id := N + 463;
+ First_Type_Attribute_Name : constant Name_Id := N + 463;
+ Name_Base : constant Name_Id := N + 463;
+ Name_Class : constant Name_Id := N + 464;
+ Last_Type_Attribute_Name : constant Name_Id := N + 464;
+ Last_Entity_Attribute_Name : constant Name_Id := N + 464;
+ Last_Attribute_Name : constant Name_Id := N + 464;
-- Names of recognized locking policy identifiers
-- 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 + 464;
- Name_Ceiling_Locking : constant Name_Id := N + 464;
- Name_Inheritance_Locking : constant Name_Id := N + 465;
- Last_Locking_Policy_Name : constant Name_Id := N + 465;
+ First_Locking_Policy_Name : constant Name_Id := N + 465;
+ Name_Ceiling_Locking : constant Name_Id := N + 465;
+ Name_Inheritance_Locking : constant Name_Id := N + 466;
+ Last_Locking_Policy_Name : constant Name_Id := N + 466;
-- Names of recognized queuing policy identifiers.
-- 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 + 466;
- Name_FIFO_Queuing : constant Name_Id := N + 466;
- Name_Priority_Queuing : constant Name_Id := N + 467;
- Last_Queuing_Policy_Name : constant Name_Id := N + 467;
+ First_Queuing_Policy_Name : constant Name_Id := N + 467;
+ Name_FIFO_Queuing : constant Name_Id := N + 467;
+ Name_Priority_Queuing : constant Name_Id := N + 468;
+ Last_Queuing_Policy_Name : constant Name_Id := N + 468;
-- Names of recognized task dispatching policy identifiers
-- name (e.g. F for FIFO_WIthinn_Priorities). If new policy names
-- are added, the first character must be distinct.
- First_Task_Dispatching_Policy_Name : constant Name_Id := N + 468;
- Name_FIFO_Within_Priorities : constant Name_Id := N + 468;
- Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 468;
+ First_Task_Dispatching_Policy_Name : constant Name_Id := N + 469;
+ Name_FIFO_Within_Priorities : constant Name_Id := N + 469;
+ Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 469;
-- Names of recognized checks for pragma Suppress
- First_Check_Name : constant Name_Id := N + 469;
- Name_Access_Check : constant Name_Id := N + 469;
- Name_Accessibility_Check : constant Name_Id := N + 470;
- Name_Discriminant_Check : constant Name_Id := N + 471;
- Name_Division_Check : constant Name_Id := N + 472;
- Name_Elaboration_Check : constant Name_Id := N + 473;
- Name_Index_Check : constant Name_Id := N + 474;
- Name_Length_Check : constant Name_Id := N + 475;
- Name_Overflow_Check : constant Name_Id := N + 476;
- Name_Range_Check : constant Name_Id := N + 477;
- Name_Storage_Check : constant Name_Id := N + 478;
- Name_Tag_Check : constant Name_Id := N + 479;
- Name_All_Checks : constant Name_Id := N + 480;
- Last_Check_Name : constant Name_Id := N + 480;
+ First_Check_Name : constant Name_Id := N + 470;
+ Name_Access_Check : constant Name_Id := N + 470;
+ Name_Accessibility_Check : constant Name_Id := N + 471;
+ Name_Discriminant_Check : constant Name_Id := N + 472;
+ Name_Division_Check : constant Name_Id := N + 473;
+ Name_Elaboration_Check : constant Name_Id := N + 474;
+ Name_Index_Check : constant Name_Id := N + 475;
+ Name_Length_Check : constant Name_Id := N + 476;
+ Name_Overflow_Check : constant Name_Id := N + 477;
+ Name_Range_Check : constant Name_Id := N + 478;
+ Name_Storage_Check : constant Name_Id := N + 479;
+ Name_Tag_Check : constant Name_Id := N + 480;
+ Name_All_Checks : constant Name_Id := N + 481;
+ Last_Check_Name : constant Name_Id := N + 481;
-- Names corresponding to reserved keywords, excluding those already
-- declared in the attribute list (Access, Delta, Digits, Range).
- Name_Abort : constant Name_Id := N + 481;
- Name_Abs : constant Name_Id := N + 482;
- Name_Accept : constant Name_Id := N + 483;
- Name_And : constant Name_Id := N + 484;
- Name_All : constant Name_Id := N + 485;
- Name_Array : constant Name_Id := N + 486;
- Name_At : constant Name_Id := N + 487;
- Name_Begin : constant Name_Id := N + 488;
- Name_Body : constant Name_Id := N + 489;
- Name_Case : constant Name_Id := N + 490;
- Name_Constant : constant Name_Id := N + 491;
- Name_Declare : constant Name_Id := N + 492;
- Name_Delay : constant Name_Id := N + 493;
- Name_Do : constant Name_Id := N + 494;
- Name_Else : constant Name_Id := N + 495;
- Name_Elsif : constant Name_Id := N + 496;
- Name_End : constant Name_Id := N + 497;
- Name_Entry : constant Name_Id := N + 498;
- Name_Exception : constant Name_Id := N + 499;
- Name_Exit : constant Name_Id := N + 500;
- Name_For : constant Name_Id := N + 501;
- Name_Function : constant Name_Id := N + 502;
- Name_Generic : constant Name_Id := N + 503;
- Name_Goto : constant Name_Id := N + 504;
- Name_If : constant Name_Id := N + 505;
- Name_In : constant Name_Id := N + 506;
- Name_Is : constant Name_Id := N + 507;
- Name_Limited : constant Name_Id := N + 508;
- Name_Loop : constant Name_Id := N + 509;
- Name_Mod : constant Name_Id := N + 510;
- Name_New : constant Name_Id := N + 511;
- Name_Not : constant Name_Id := N + 512;
- Name_Null : constant Name_Id := N + 513;
- Name_Of : constant Name_Id := N + 514;
- Name_Or : constant Name_Id := N + 515;
- Name_Others : constant Name_Id := N + 516;
- Name_Out : constant Name_Id := N + 517;
- Name_Package : constant Name_Id := N + 518;
- Name_Pragma : constant Name_Id := N + 519;
- Name_Private : constant Name_Id := N + 520;
- Name_Procedure : constant Name_Id := N + 521;
- Name_Raise : constant Name_Id := N + 522;
- Name_Record : constant Name_Id := N + 523;
- Name_Rem : constant Name_Id := N + 524;
- Name_Renames : constant Name_Id := N + 525;
- Name_Return : constant Name_Id := N + 526;
- Name_Reverse : constant Name_Id := N + 527;
- Name_Select : constant Name_Id := N + 528;
- Name_Separate : constant Name_Id := N + 529;
- Name_Subtype : constant Name_Id := N + 530;
- Name_Task : constant Name_Id := N + 531;
- Name_Terminate : constant Name_Id := N + 532;
- Name_Then : constant Name_Id := N + 533;
- Name_Type : constant Name_Id := N + 534;
- Name_Use : constant Name_Id := N + 535;
- Name_When : constant Name_Id := N + 536;
- Name_While : constant Name_Id := N + 537;
- Name_With : constant Name_Id := N + 538;
- Name_Xor : constant Name_Id := N + 539;
+ Name_Abort : constant Name_Id := N + 482;
+ Name_Abs : constant Name_Id := N + 483;
+ Name_Accept : constant Name_Id := N + 484;
+ Name_And : constant Name_Id := N + 485;
+ Name_All : constant Name_Id := N + 486;
+ Name_Array : constant Name_Id := N + 487;
+ Name_At : constant Name_Id := N + 488;
+ Name_Begin : constant Name_Id := N + 489;
+ Name_Body : constant Name_Id := N + 490;
+ Name_Case : constant Name_Id := N + 491;
+ Name_Constant : constant Name_Id := N + 492;
+ Name_Declare : constant Name_Id := N + 493;
+ Name_Delay : constant Name_Id := N + 494;
+ Name_Do : constant Name_Id := N + 495;
+ Name_Else : constant Name_Id := N + 496;
+ Name_Elsif : constant Name_Id := N + 497;
+ Name_End : constant Name_Id := N + 498;
+ Name_Entry : constant Name_Id := N + 499;
+ Name_Exception : constant Name_Id := N + 500;
+ Name_Exit : constant Name_Id := N + 501;
+ Name_For : constant Name_Id := N + 502;
+ Name_Function : constant Name_Id := N + 503;
+ Name_Generic : constant Name_Id := N + 504;
+ Name_Goto : constant Name_Id := N + 505;
+ Name_If : constant Name_Id := N + 506;
+ Name_In : constant Name_Id := N + 507;
+ Name_Is : constant Name_Id := N + 508;
+ Name_Limited : constant Name_Id := N + 509;
+ Name_Loop : constant Name_Id := N + 510;
+ Name_Mod : constant Name_Id := N + 511;
+ Name_New : constant Name_Id := N + 512;
+ Name_Not : constant Name_Id := N + 513;
+ Name_Null : constant Name_Id := N + 514;
+ Name_Of : constant Name_Id := N + 515;
+ Name_Or : constant Name_Id := N + 516;
+ Name_Others : constant Name_Id := N + 517;
+ Name_Out : constant Name_Id := N + 518;
+ Name_Package : constant Name_Id := N + 519;
+ Name_Pragma : constant Name_Id := N + 520;
+ Name_Private : constant Name_Id := N + 521;
+ Name_Procedure : constant Name_Id := N + 522;
+ Name_Raise : constant Name_Id := N + 523;
+ Name_Record : constant Name_Id := N + 524;
+ Name_Rem : constant Name_Id := N + 525;
+ Name_Renames : constant Name_Id := N + 526;
+ Name_Return : constant Name_Id := N + 527;
+ Name_Reverse : constant Name_Id := N + 528;
+ Name_Select : constant Name_Id := N + 529;
+ Name_Separate : constant Name_Id := N + 530;
+ Name_Subtype : constant Name_Id := N + 531;
+ Name_Task : constant Name_Id := N + 532;
+ Name_Terminate : constant Name_Id := N + 533;
+ Name_Then : constant Name_Id := N + 534;
+ Name_Type : constant Name_Id := N + 535;
+ Name_Use : constant Name_Id := N + 536;
+ Name_When : constant Name_Id := N + 537;
+ Name_While : constant Name_Id := N + 538;
+ Name_With : constant Name_Id := N + 539;
+ Name_Xor : constant Name_Id := N + 540;
-- 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 + 540;
- Name_Divide : constant Name_Id := N + 540;
- Name_Enclosing_Entity : constant Name_Id := N + 541;
- Name_Exception_Information : constant Name_Id := N + 542;
- Name_Exception_Message : constant Name_Id := N + 543;
- Name_Exception_Name : constant Name_Id := N + 544;
- Name_File : constant Name_Id := N + 545;
- Name_Import_Address : constant Name_Id := N + 546;
- Name_Import_Largest_Value : constant Name_Id := N + 547;
- Name_Import_Value : constant Name_Id := N + 548;
- Name_Is_Negative : constant Name_Id := N + 549;
- Name_Line : constant Name_Id := N + 550;
- Name_Rotate_Left : constant Name_Id := N + 551;
- Name_Rotate_Right : constant Name_Id := N + 552;
- Name_Shift_Left : constant Name_Id := N + 553;
- Name_Shift_Right : constant Name_Id := N + 554;
- Name_Shift_Right_Arithmetic : constant Name_Id := N + 555;
- Name_Source_Location : constant Name_Id := N + 556;
- Name_Unchecked_Conversion : constant Name_Id := N + 557;
- Name_Unchecked_Deallocation : constant Name_Id := N + 558;
- Name_To_Pointer : constant Name_Id := N + 559;
- Last_Intrinsic_Name : constant Name_Id := N + 559;
+ First_Intrinsic_Name : constant Name_Id := N + 541;
+ Name_Divide : constant Name_Id := N + 541;
+ Name_Enclosing_Entity : constant Name_Id := N + 542;
+ Name_Exception_Information : constant Name_Id := N + 543;
+ Name_Exception_Message : constant Name_Id := N + 544;
+ Name_Exception_Name : constant Name_Id := N + 545;
+ Name_File : constant Name_Id := N + 546;
+ Name_Import_Address : constant Name_Id := N + 547;
+ Name_Import_Largest_Value : constant Name_Id := N + 548;
+ Name_Import_Value : constant Name_Id := N + 549;
+ Name_Is_Negative : constant Name_Id := N + 550;
+ Name_Line : constant Name_Id := N + 551;
+ Name_Rotate_Left : constant Name_Id := N + 552;
+ Name_Rotate_Right : constant Name_Id := N + 553;
+ Name_Shift_Left : constant Name_Id := N + 554;
+ Name_Shift_Right : constant Name_Id := N + 555;
+ Name_Shift_Right_Arithmetic : constant Name_Id := N + 556;
+ Name_Source_Location : constant Name_Id := N + 557;
+ Name_Unchecked_Conversion : constant Name_Id := N + 558;
+ Name_Unchecked_Deallocation : constant Name_Id := N + 559;
+ Name_To_Pointer : constant Name_Id := N + 560;
+ Last_Intrinsic_Name : constant Name_Id := N + 560;
-- Reserved words used only in Ada 95
- First_95_Reserved_Word : constant Name_Id := N + 560;
- Name_Abstract : constant Name_Id := N + 560;
- Name_Aliased : constant Name_Id := N + 561;
- Name_Protected : constant Name_Id := N + 562;
- Name_Until : constant Name_Id := N + 563;
- Name_Requeue : constant Name_Id := N + 564;
- Name_Tagged : constant Name_Id := N + 565;
- Last_95_Reserved_Word : constant Name_Id := N + 565;
+ First_95_Reserved_Word : constant Name_Id := N + 561;
+ Name_Abstract : constant Name_Id := N + 561;
+ Name_Aliased : constant Name_Id := N + 562;
+ Name_Protected : constant Name_Id := N + 563;
+ Name_Until : constant Name_Id := N + 564;
+ Name_Requeue : constant Name_Id := N + 565;
+ Name_Tagged : constant Name_Id := N + 566;
+ Last_95_Reserved_Word : constant Name_Id := N + 566;
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 + 566;
+ Name_Raise_Exception : constant Name_Id := N + 567;
-- Additional reserved words in GNAT Project Files
-- Note that Name_External is already previously declared
- Name_Binder : constant Name_Id := N + 567;
- Name_Body_Suffix : constant Name_Id := N + 568;
- Name_Builder : constant Name_Id := N + 569;
- Name_Compiler : constant Name_Id := N + 570;
- Name_Cross_Reference : constant Name_Id := N + 571;
- Name_Default_Switches : constant Name_Id := N + 572;
- Name_Exec_Dir : constant Name_Id := N + 573;
- Name_Executable : constant Name_Id := N + 574;
- Name_Executable_Suffix : constant Name_Id := N + 575;
- Name_Extends : constant Name_Id := N + 576;
- Name_Finder : constant Name_Id := N + 577;
- Name_Global_Configuration_Pragmas : constant Name_Id := N + 578;
- Name_Gnatls : constant Name_Id := N + 579;
- Name_Gnatstub : constant Name_Id := N + 580;
- Name_Implementation : constant Name_Id := N + 581;
- Name_Implementation_Exceptions : constant Name_Id := N + 582;
- Name_Implementation_Suffix : constant Name_Id := N + 583;
- Name_Languages : constant Name_Id := N + 584;
- Name_Library_Dir : constant Name_Id := N + 585;
- Name_Library_Auto_Init : constant Name_Id := N + 586;
- Name_Library_GCC : constant Name_Id := N + 587;
- Name_Library_Interface : constant Name_Id := N + 588;
- Name_Library_Kind : constant Name_Id := N + 589;
- Name_Library_Name : constant Name_Id := N + 590;
- Name_Library_Options : constant Name_Id := N + 591;
- Name_Library_Reference_Symbol_File : constant Name_Id := N + 592;
- Name_Library_Src_Dir : constant Name_Id := N + 593;
- Name_Library_Symbol_File : constant Name_Id := N + 594;
- Name_Library_Symbol_Policy : constant Name_Id := N + 595;
- Name_Library_Version : constant Name_Id := N + 596;
- Name_Linker : constant Name_Id := N + 597;
- Name_Local_Configuration_Pragmas : constant Name_Id := N + 598;
- Name_Locally_Removed_Files : constant Name_Id := N + 599;
- Name_Metrics : constant Name_Id := N + 600;
- Name_Naming : constant Name_Id := N + 601;
- Name_Object_Dir : constant Name_Id := N + 602;
- Name_Pretty_Printer : constant Name_Id := N + 603;
- Name_Project : constant Name_Id := N + 604;
- Name_Separate_Suffix : constant Name_Id := N + 605;
- Name_Source_Dirs : constant Name_Id := N + 606;
- Name_Source_Files : constant Name_Id := N + 607;
- Name_Source_List_File : constant Name_Id := N + 608;
- Name_Spec : constant Name_Id := N + 609;
- Name_Spec_Suffix : constant Name_Id := N + 610;
- Name_Specification : constant Name_Id := N + 611;
- Name_Specification_Exceptions : constant Name_Id := N + 612;
- Name_Specification_Suffix : constant Name_Id := N + 613;
- Name_Switches : constant Name_Id := N + 614;
+ Name_Binder : constant Name_Id := N + 568;
+ Name_Body_Suffix : constant Name_Id := N + 569;
+ Name_Builder : constant Name_Id := N + 570;
+ Name_Compiler : constant Name_Id := N + 571;
+ Name_Cross_Reference : constant Name_Id := N + 572;
+ Name_Default_Switches : constant Name_Id := N + 573;
+ Name_Exec_Dir : constant Name_Id := N + 574;
+ Name_Executable : constant Name_Id := N + 575;
+ Name_Executable_Suffix : constant Name_Id := N + 576;
+ Name_Extends : constant Name_Id := N + 577;
+ Name_Finder : constant Name_Id := N + 578;
+ Name_Global_Configuration_Pragmas : constant Name_Id := N + 579;
+ Name_Gnatls : constant Name_Id := N + 580;
+ Name_Gnatstub : constant Name_Id := N + 581;
+ Name_Implementation : constant Name_Id := N + 582;
+ Name_Implementation_Exceptions : constant Name_Id := N + 583;
+ Name_Implementation_Suffix : constant Name_Id := N + 584;
+ Name_Languages : constant Name_Id := N + 585;
+ Name_Library_Dir : constant Name_Id := N + 586;
+ Name_Library_Auto_Init : constant Name_Id := N + 587;
+ Name_Library_GCC : constant Name_Id := N + 588;
+ Name_Library_Interface : constant Name_Id := N + 589;
+ Name_Library_Kind : constant Name_Id := N + 590;
+ Name_Library_Name : constant Name_Id := N + 591;
+ Name_Library_Options : constant Name_Id := N + 592;
+ Name_Library_Reference_Symbol_File : constant Name_Id := N + 593;
+ Name_Library_Src_Dir : constant Name_Id := N + 594;
+ Name_Library_Symbol_File : constant Name_Id := N + 595;
+ Name_Library_Symbol_Policy : constant Name_Id := N + 596;
+ Name_Library_Version : constant Name_Id := N + 597;
+ Name_Linker : constant Name_Id := N + 598;
+ Name_Local_Configuration_Pragmas : constant Name_Id := N + 599;
+ Name_Locally_Removed_Files : constant Name_Id := N + 600;
+ Name_Metrics : constant Name_Id := N + 601;
+ Name_Naming : constant Name_Id := N + 602;
+ Name_Object_Dir : constant Name_Id := N + 603;
+ Name_Pretty_Printer : constant Name_Id := N + 604;
+ Name_Project : constant Name_Id := N + 605;
+ Name_Separate_Suffix : constant Name_Id := N + 606;
+ Name_Source_Dirs : constant Name_Id := N + 607;
+ Name_Source_Files : constant Name_Id := N + 608;
+ Name_Source_List_File : constant Name_Id := N + 609;
+ Name_Spec : constant Name_Id := N + 610;
+ Name_Spec_Suffix : constant Name_Id := N + 611;
+ Name_Specification : constant Name_Id := N + 612;
+ Name_Specification_Exceptions : constant Name_Id := N + 613;
+ Name_Specification_Suffix : constant Name_Id := N + 614;
+ Name_Switches : constant Name_Id := N + 615;
-- Other miscellaneous names used in front end
- Name_Unaligned_Valid : constant Name_Id := N + 615;
+ Name_Unaligned_Valid : constant Name_Id := N + 616;
-- Mark last defined name for consistency check in Snames body
- Last_Predefined_Name : constant Name_Id := N + 615;
+ Last_Predefined_Name : constant Name_Id := N + 616;
subtype Any_Operator_Name is Name_Id range
First_Operator_Name .. Last_Operator_Name;
case ARRAY_RANGE_REF:
/* First convert the right operand to its base type. This will
- prevent unneed signedness conversions when sizetype is wider than
+ prevent unneeded signedness conversions when sizetype is wider than
integer. */
right_operand = convert (right_base_type, right_operand);
right_operand = convert (TYPE_DOMAIN (left_type), right_operand);
projects / gcc.git / commitdiff