diff options
| author | Arnaud Charlet <charlet@gcc.gnu.org> | 2003-11-04 13:51:47 +0100 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2003-11-04 13:51:47 +0100 |
| commit | 12e0c41c113e68854ec71f059c7dc19e03a7dcf6 (patch) | |
| tree | 8a2906f87ff8dae462187a72710b5203b22a6c1b | |
| parent | 21e9fc4735eca1010ac051b76cd361943f3e6d4a (diff) | |
| download | gcc-12e0c41c113e68854ec71f059c7dc19e03a7dcf6.zip gcc-12e0c41c113e68854ec71f059c7dc19e03a7dcf6.tar.gz gcc-12e0c41c113e68854ec71f059c7dc19e03a7dcf6.tar.bz2 | |
re PR ada/12806 (Program_Error sinput.adb:397)
* sysdep.c: Problem discovered during IA64 VMS port.
[VMS] #include <unixio.h> to get proper prototypes.
* adaint.c:
Issues discovered/problems fixed during IA64 VMS port.
[VMS] #define _POSIX_EXIT for proper semantics.
[VMS] #include <unixio.h> for proper prototypes.
[VMS] (fork): #define IA64 version.
(__gnat_os_exit): Remove unnecessary VMS specific code.
* 3vtrasym.adb: Minor reformatting
Use terminology encoded/decoded name, rather than C++ specific notion
of mangling (this is the terminology used throughout GNAT).
* einfo.h: Regenerated
* einfo.ads, einfo.adb: Add new flag Is_Thread_Body
* exp_ch6.adb:
(Expand_N_Subprogram_Body): Handle expansion of thread body procedure
* par-prag.adb: Add dummy entry for Thread_Body pragma
* rtsfind.ads:
Add entries for System.Threads entities for thread body processing
* sem_attr.adb:
(Analyze_Pragma, Access attributes): Check these are not applied to a
thread body, since this is not permitted
* sem_prag.adb: Add processing for Thread_Body pragma.
Minor comment fix.
* sem_res.adb:
(Resolve_Call): Check for incorrect attempt to call a thread body
procedure with a direct call.
* snames.ads, snames.adb: Add entry for Thread_Body pragma
Add names associated with thread body expansion
* snames.h: Add entry for Thread_Body pragma
* s-thread.adb: Add entries for thread body processing
These are dummy bodies so far
* s-thread.ads: Add documentation on thread body handling.
Add entries for thread body processing.
* sem_ch10.adb:
(Build_Limited_Views): Return after posting an error in case of limited
with_clause on subprograms, generics, instances or generic renamings
(Install_Limited_Withed_Unit): Do nothing in case of limited with_clause
on subprograms, generics, instances or generic renamings
* raise.c (setup_to_install): Correct mistake in last revision; two
arguments out of order.
* trans.c, cuintp.c, argv.c, aux-io.c, cal.c, errno.c, exit.c,
gnatbl.c, init.c, stringt.h, utils.c, utils2.c: Update copyright
notice, missed in previous change.
Remove trailing blanks and other style errors introduced in previous
change.
* decl.c (gnat_to_gnu_field): Adjust the conditions under which we get
rid of the wrapper for a LJM type, ensuring we don't do that if the
field is addressable. This avoids potential low level type view
mismatches later on, for instance in a by-reference argument passing
process.
* decl.c (gnat_to_gnu_field): No longer check for BLKmode being
aligned at byte boundary.
* decl.c (components_to_record): Do not delete the empty variants from
the end of the union type.
* exp_ch4.adb (Expand_N_Op_Eq): Use base type when locating primitive
operation for a derived type, an explicit declaration may use a local
subtype of Boolean.
* make.adb (Gnatmake): Allow main sources on the command line with a
library project when it is only for compilation (no binding or
linking).
Part of PR ada/12806:
* ada-tree.h (TYPE_DIGITS_VALUE, SET_TYPE_DIGITS_VALUE): Save count as
tree, not integer.
* decl.c:
(gnat_to_gnu_entity, case E_Floating_Point_Type): Save count as tree,
not integer.
* targtyps.c, decl.c, misc.c,
gigi.h (fp_prec_to_size, fp_size_to_prec): Temporary
routines to work around change in FP sizing semantics in GCC.
* utils.c:
(build_vms_descriptor): TYPE_DIGITS_VALUE is tree, not integer.
* gigi.h: (enumerate_modes): New function.
* Make-lang.in: (ada/misc.o): Add real.h.
* misc.c: (enumerate_modes): New function.
From-SVN: r73250
39 files changed, 3147 insertions, 2584 deletions
diff --git a/gcc/ada/3vtrasym.adb b/gcc/ada/3vtrasym.adb index 159c03f..85f541d 100644 --- a/gcc/ada/3vtrasym.adb +++ b/gcc/ada/3vtrasym.adb @@ -97,76 +97,73 @@ package body GNAT.Traceback.Symbolic is Value, Value), User_Act_Proc); - function Demangle_Ada (Mangled : String) return String; - -- Demangles an Ada symbol. Removes leading "_ada_" and trailing + function Decode_Ada_Name (Encoded_Name : String) return String; + -- Decodes an Ada identifier name. Removes leading "_ada_" and trailing -- __{DIGIT}+ or ${DIGIT}+, converts other "__" to '.' + --------------------- + -- Decode_Ada_Name -- + --------------------- - ------------------ - -- Demangle_Ada -- - ------------------ + function Decode_Ada_Name (Encoded_Name : String) return String is + Decoded_Name : String (1 .. Encoded_Name'Length); + Pos : Integer := Encoded_Name'First; + Last : Integer := Encoded_Name'Last; + DPos : Integer := 1; - function Demangle_Ada (Mangled : String) return String is - Demangled : String (1 .. Mangled'Length); - Pos : Integer := Mangled'First; - Last : Integer := Mangled'Last; - DPos : Integer := 1; begin - if Pos > Last then return ""; end if; -- Skip leading _ada_ - if Mangled'Length > 4 and then Mangled (Pos .. Pos + 4) = "_ada_" then + if Encoded_Name'Length > 4 + and then Encoded_Name (Pos .. Pos + 4) = "_ada_" + then Pos := Pos + 5; end if; -- Skip trailing __{DIGIT}+ or ${DIGIT}+ - if Mangled (Last) in '0' .. '9' then - + if Encoded_Name (Last) in '0' .. '9' then for J in reverse Pos + 2 .. Last - 1 loop - - case Mangled (J) is + case Encoded_Name (J) is when '0' .. '9' => null; when '$' => Last := J - 1; exit; when '_' => - if Mangled (J - 1) = '_' then + if Encoded_Name (J - 1) = '_' then Last := J - 2; end if; exit; when others => exit; end case; - end loop; - end if; - -- Now just copy Mangled to Demangled, converting "__" to '.' on the fly + -- Now just copy encoded name to decoded name, converting "__" to '.' while Pos <= Last loop - - if Mangled (Pos) = '_' and then Mangled (Pos + 1) = '_' - and then Pos /= Mangled'First then - Demangled (DPos) := '.'; + if Encoded_Name (Pos) = '_' and then Encoded_Name (Pos + 1) = '_' + and then Pos /= Encoded_Name'First + then + Decoded_Name (DPos) := '.'; Pos := Pos + 2; + else - Demangled (DPos) := Mangled (Pos); + Decoded_Name (DPos) := Encoded_Name (Pos); Pos := Pos + 1; end if; DPos := DPos + 1; - end loop; - return Demangled (1 .. DPos - 1); - end Demangle_Ada; + return Decoded_Name (1 .. DPos - 1); + end Decode_Ada_Name; ------------------------ -- Symbolic_Traceback -- @@ -225,7 +222,7 @@ package body GNAT.Traceback.Symbolic is First : Integer := Len + 1; Last : Integer := First + 80 - 1; Pos : Integer; - Routine_Name_D : String := Demangle_Ada + Routine_Name_D : String := Decode_Ada_Name (To_Ada (Routine_Name.Data (1 .. size_t (Routine_Name.Count)), False)); diff --git a/gcc/ada/Make-lang.in b/gcc/ada/Make-lang.in index d9c4469..44b2f88 100644 --- a/gcc/ada/Make-lang.in +++ b/gcc/ada/Make-lang.in @@ -1201,7 +1201,7 @@ ada/misc.o : ada/misc.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) $(TREE_H) \ $(LANGHOOKS_DEF_H) libfuncs.h $(OPTABS_H) ada/ada.h ada/types.h \ ada/atree.h ada/nlists.h ada/elists.h ada/sinfo.h ada/einfo.h ada/namet.h \ ada/stringt.h ada/uintp.h ada/fe.h $(ADA_TREE_H) ada/gigi.h \ - ada/adadecode.h opts.h options.h target.h + ada/adadecode.h opts.h options.h target.h real.h ada/targtyps.o : ada/targtyps.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) \ ada/ada.h ada/types.h ada/atree.h ada/nlists.h ada/elists.h ada/uintp.h \ diff --git a/gcc/ada/ada-tree.h b/gcc/ada/ada-tree.h index 13487ff..c7574c8 100644 --- a/gcc/ada/ada-tree.h +++ b/gcc/ada/ada-tree.h @@ -174,14 +174,14 @@ struct lang_type GTY(()) #define TYPE_INDEX_TYPE(NODE) \ (&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.generic) #define SET_TYPE_INDEX_TYPE(NODE, X) \ - (TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *)(X)) + (TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *) (X)) /* For an INTEGER_TYPE with TYPE_VAX_FLOATING_POINT_P, stores the Digits_Value. */ -#define TYPE_DIGITS_VALUE(NODE) \ - ((long) TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))) +#define TYPE_DIGITS_VALUE(NODE) \ + (&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.generic) #define SET_TYPE_DIGITS_VALUE(NODE, X) \ - (TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *)(size_t)(X)) + (TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *) (X)) /* For INTEGER_TYPE, stores the RM_Size of the type. */ #define TYPE_RM_SIZE_INT(NODE) TYPE_VALUES (INTEGER_TYPE_CHECK (NODE)) @@ -271,10 +271,9 @@ struct lang_type GTY(()) discriminant number. */ #define DECL_DISCRIMINANT_NUMBER(NODE) DECL_INITIAL (FIELD_DECL_CHECK (NODE)) -/* This is a horrible kludge to store the loop_id of a loop into a tree - node. We need to find some other place to store it! */ +/* This is the loop id for a GNAT_LOOP_ID node. */ #define TREE_LOOP_ID(NODE) \ - (((union lang_tree_node *)TREE_CHECK (NODE, GNAT_LOOP_ID))->loop_id.loop_id) + ((union lang_tree_node *) TREE_CHECK (NODE, GNAT_LOOP_ID))->loop_id.loop_id /* Define fields and macros for statements. diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index cbaf1d7..674df74 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -50,6 +50,10 @@ #endif /* VxWorks */ +#ifdef VMS +#define _POSIX_EXIT 1 +#endif + #ifdef IN_RTS #include "tconfig.h" #include "tsystem.h" @@ -57,6 +61,9 @@ #include <sys/stat.h> #include <fcntl.h> #include <time.h> +#ifdef VMS +#include <unixio.h> +#endif /* We don't have libiberty, so use malloc. */ #define xmalloc(S) malloc (S) @@ -1463,8 +1470,13 @@ __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED) #ifdef VMS /* Defined in VMS header files. */ +#if defined (__ALPHA) #define fork() (decc$$alloc_vfork_blocks() >= 0 ? \ - LIB$GET_CURRENT_INVO_CONTEXT (decc$$get_vfork_jmpbuf()) : -1) + LIB$GET_CURRENT_INVO_CONTEXT (decc$$get_vfork_jmpbuf()) : -1) +#elif defined (__IA64) +#define fork() (decc$$alloc_vfork_blocks() >= 0 ? \ + LIB$I64_GET_CURR_INVO_CONTEXT(decc$$get_vfork_jmpbuf()) : -1) +#endif #endif #if defined (sun) && defined (__SVR4) @@ -1816,12 +1828,7 @@ __gnat_waitpid (int pid) void __gnat_os_exit (int status) { -#ifdef VMS - /* Exit without changing 0 to 1. */ - __posix_exit (status); -#else exit (status); -#endif } /* Locate a regular file, give a Path value. */ diff --git a/gcc/ada/argv.c b/gcc/ada/argv.c index b62011c..4f78ac2 100644 --- a/gcc/ada/argv.c +++ b/gcc/ada/argv.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2002 Free Software Foundation, Inc. * + * Copyright (C) 1992-2003 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- * @@ -83,7 +83,7 @@ __gnat_len_arg (int arg_num) } void -__gnat_fill_arg ( char *a, int i) +__gnat_fill_arg (char *a, int i) { strncpy (a, gnat_argv[i], strlen(gnat_argv[i])); } diff --git a/gcc/ada/aux-io.c b/gcc/ada/aux-io.c index 333485d..3ff9f3e 100644 --- a/gcc/ada/aux-io.c +++ b/gcc/ada/aux-io.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2001 Free Software Foundation, Inc. * + * Copyright (C) 1992-2003 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- * @@ -52,20 +52,20 @@ void *null_function (void); int c_fileno (FILE *); FILE * -c_stdin (void) -{ - return stdin; +c_stdin (void) +{ + return stdin; } FILE * -c_stdout (void) -{ +c_stdout (void) +{ return stdout; } FILE * -c_stderr (void) -{ +c_stderr (void) +{ return stderr; } @@ -75,25 +75,25 @@ c_stderr (void) #define SEEK_END 2 /* Set file pointer to the size of the file plus offset */ #endif -int -seek_set_function (void) -{ - return SEEK_SET; +int +seek_set_function (void) +{ + return SEEK_SET; } -int -seek_end_function (void) -{ - return SEEK_END; +int +seek_end_function (void) +{ + return SEEK_END; } -void *null_function (void) -{ - return NULL; +void *null_function (void) +{ + return NULL; } -int -c_fileno (FILE *s) -{ - return fileno (s); +int +c_fileno (FILE *s) +{ + return fileno (s); } diff --git a/gcc/ada/cal.c b/gcc/ada/cal.c index 7f136d6..8f8930e 100644 --- a/gcc/ada/cal.c +++ b/gcc/ada/cal.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2002, Free Software Foundation, Inc. * + * Copyright (C) 1992-2003, 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- * diff --git a/gcc/ada/cuintp.c b/gcc/ada/cuintp.c index 2c8967a..f83f518 100644 --- a/gcc/ada/cuintp.c +++ b/gcc/ada/cuintp.c @@ -62,7 +62,7 @@ UI_To_gnu (Uint Input, tree type) tree gnu_ret; if (Input <= Uint_Direct_Last) - gnu_ret = convert (type, build_int_2 (Input - Uint_Direct_Bias, + gnu_ret = convert (type, build_int_2 (Input - Uint_Direct_Bias, Input < Uint_Direct_Bias ? -1 : 0)); else { diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c index 028443f..41bcfa6 100644 --- a/gcc/ada/decl.c +++ b/gcc/ada/decl.c @@ -166,7 +166,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && UI_Is_In_Int_Range (Esize (gnat_entity))) ? MIN (UI_To_Int (Esize (gnat_entity)), IN (kind, Float_Kind) - ? LONG_DOUBLE_TYPE_SIZE + ? fp_prec_to_size (LONG_DOUBLE_TYPE_SIZE) : IN (kind, Access_Kind) ? POINTER_SIZE * 2 : LONG_LONG_TYPE_SIZE) : LONG_LONG_TYPE_SIZE); @@ -1337,14 +1337,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_type = make_signed_type (esize); TYPE_VAX_FLOATING_POINT_P (gnu_type) = 1; SET_TYPE_DIGITS_VALUE (gnu_type, - UI_To_Int (Digits_Value (gnat_entity))); + UI_To_gnu (Digits_Value (gnat_entity), + sizetype)); break; } /* The type of the Low and High bounds can be our type if this is a type from Standard, so set them at the end of the function. */ gnu_type = make_node (REAL_TYPE); - TYPE_PRECISION (gnu_type) = esize; + TYPE_PRECISION (gnu_type) = fp_size_to_prec (esize); layout_type (gnu_type); break; @@ -1560,8 +1561,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) tem = gnat_to_gnu_type (Component_Type (gnat_entity)); /* Get and validate any specified Component_Size, but if Packed, - ignore it since the front end will have taken care of it. Also, - allow sizes not a multiple of Storage_Unit if packed. */ + ignore it since the front end will have taken care of it. */ gnu_comp_size = validate_size (Component_Size (gnat_entity), tem, gnat_entity, @@ -1884,8 +1884,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } /* Get and validate any specified Component_Size, but if Packed, - ignore it since the front end will have taken care of it. Also, - allow sizes not a multiple of Storage_Unit if packed. */ + ignore it since the front end will have taken care of it. */ gnu_comp_size = validate_size (Component_Size (gnat_entity), gnu_type, gnat_entity, @@ -4924,10 +4923,14 @@ gnat_to_gnu_field (Entity_Id gnat_field, gnu_size = validate_size (Esize (gnat_field), gnu_field_type, gnat_field, FIELD_DECL, 0, 1); - /* If the field's type is a left-justified modular type, make the field - the type of the inner object unless it is aliases. We don't need - the the wrapper here and it can prevent packing. */ - if (! Is_Aliased (gnat_field) && TREE_CODE (gnu_field_type) == RECORD_TYPE + /* If the field's type is left-justified modular, the wrapper can prevent + packing so we make the field the type of the inner object unless the + situation forbids it. We may not do that when the field is addressable_p, + typically because in that case this field may later be passed by-ref for + a formal argument expecting the left justification. The condition below + is then matching the addressable_p code for COMPONENT_REF. */ + if (! Is_Aliased (gnat_field) && flag_strict_aliasing + && TREE_CODE (gnu_field_type) == RECORD_TYPE && TYPE_LEFT_JUSTIFIED_MODULAR_P (gnu_field_type)) gnu_field_type = TREE_TYPE (TYPE_FIELDS (gnu_field_type)); @@ -5050,17 +5053,6 @@ gnat_to_gnu_field (Entity_Id gnat_field, if (Is_Atomic (gnat_field)) check_ok_for_atomic (gnu_field_type, gnat_field, 0); - - if (gnu_pos != 0 && TYPE_MODE (gnu_field_type) == BLKmode - && (! integer_zerop (size_binop (TRUNC_MOD_EXPR, gnu_pos, - bitsize_unit_node))) - && TYPE_MODE (gnu_field_type) == BLKmode) - { - post_error_ne ("fields of& must start at storage unit boundary", - First_Bit (Component_Clause (gnat_field)), - Etype (gnat_field)); - gnu_pos = 0; - } } /* If the record has rep clauses and this is the tag field, make a rep @@ -5072,17 +5064,6 @@ gnat_to_gnu_field (Entity_Id gnat_field, gnu_size = TYPE_SIZE (gnu_field_type); } - /* If a size is specified and this is a BLKmode field, it must be an - integral number of bytes. */ - if (gnu_size != 0 && TYPE_MODE (gnu_field_type) == BLKmode - && ! integer_zerop (size_binop (TRUNC_MOD_EXPR, gnu_size, - bitsize_unit_node))) - { - post_error_ne ("size of fields of& must be multiple of a storage unit", - gnat_field, Etype (gnat_field)); - gnu_pos = gnu_size = 0; - } - /* We need to make the size the maximum for the type if it is self-referential and an unconstrained type. In that case, we can't pack the field since we can't make a copy to align it. */ @@ -5341,11 +5322,11 @@ components_to_record (tree gnu_record_type, gnu_variant_list = gnu_field; } - /* We can delete any empty variants from the end. This may leave none - left. Note we cannot delete variants from anywhere else. */ - while (gnu_variant_list != 0 - && TYPE_FIELDS (TREE_TYPE (gnu_variant_list)) == 0) - gnu_variant_list = TREE_CHAIN (gnu_variant_list); + /* We use to delete the empty variants from the end. However, + we no longer do that because we need them to generate complete + debugging information for the variant record. Otherwise, + the union type definition will be missing the fields associated + to these empty variants. */ /* Only make the QUAL_UNION_TYPE if there are any non-empty variants. */ if (gnu_variant_list != 0) diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 6b0c1a1..f1a9afa 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -302,6 +302,7 @@ package body Einfo is -- Is_CPP_Class Flag74 -- Has_Non_Standard_Rep Flag75 -- Is_Constructor Flag76 + -- Is_Thread_Body Flag77 -- Is_Tag Flag78 -- Has_All_Calls_Remote Flag79 -- Is_Constr_Subt_For_U_Nominal Flag80 @@ -420,7 +421,6 @@ package body Einfo is -- Remaining flags are currently unused and available - -- (unused) Flag77 -- (unused) Flag136 -- (unused) Flag183 @@ -1640,6 +1640,11 @@ package body Einfo is return Flag55 (Id); end Is_Tagged_Type; + function Is_Thread_Body (Id : E) return B is + begin + return Flag77 (Id); + end Is_Thread_Body; + function Is_True_Constant (Id : E) return B is begin return Flag163 (Id); @@ -3581,6 +3586,11 @@ package body Einfo is Set_Flag55 (Id, V); end Set_Is_Tagged_Type; + procedure Set_Is_Thread_Body (Id : E; V : B := True) is + begin + Set_Flag77 (Id, V); + end Set_Is_Thread_Body; + procedure Set_Is_True_Constant (Id : E; V : B := True) is begin Set_Flag163 (Id, V); @@ -6199,6 +6209,7 @@ package body Einfo is W ("Is_Statically_Allocated", Flag28 (Id)); W ("Is_Tag", Flag78 (Id)); W ("Is_Tagged_Type", Flag55 (Id)); + W ("Is_Thread_Body", Flag77 (Id)); W ("Is_True_Constant", Flag163 (Id)); W ("Is_Unchecked_Union", Flag117 (Id)); W ("Is_Unsigned_Type", Flag144 (Id)); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index a16063d..24be543 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2276,6 +2276,10 @@ package Einfo is -- Is_Task_Type (synthesized) -- Applies to all entities, true for task types and subtypes +-- Is_Thread_Body (Flag77) +-- Applies to subprogram entities. Set if a valid Thread_Body pragma +-- applies to this subprogram, which is thus a thread body. + -- Is_True_Constant (Flag163) -- This flag is set in constants and variables which have an initial -- value specified but which are never assigned, partially or in the @@ -4252,6 +4256,7 @@ package Einfo is -- Is_Overriding_Operation (Flag39) (non-generic case only) -- Is_Private_Descendant (Flag53) -- Is_Pure (Flag44) + -- Is_Thread_Body (Flag77) (non-generic case only) -- Is_Visible_Child_Unit (Flag116) -- Needs_No_Actuals (Flag22) -- Return_Present (Flag54) @@ -4496,6 +4501,7 @@ package Einfo is -- Is_Overriding_Operation (Flag39) (non-generic case only) -- Is_Private_Descendant (Flag53) -- Is_Pure (Flag44) + -- Is_Thread_Body (Flag77) (non-generic case only) -- Is_Valued_Procedure (Flag127) -- Is_Visible_Child_Unit (Flag116) -- Needs_No_Actuals (Flag22) @@ -5117,6 +5123,7 @@ package Einfo is function Is_Statically_Allocated (Id : E) return B; function Is_Tag (Id : E) return B; function Is_Tagged_Type (Id : E) return B; + function Is_Thread_Body (Id : E) return B; function Is_True_Constant (Id : E) return B; function Is_Unchecked_Union (Id : E) return B; function Is_Unsigned_Type (Id : E) return B; @@ -5589,6 +5596,7 @@ package Einfo is procedure Set_Is_Statically_Allocated (Id : E; V : B := True); procedure Set_Is_Tag (Id : E; V : B := True); procedure Set_Is_Tagged_Type (Id : E; V : B := True); + procedure Set_Is_Thread_Body (Id : E; V : B := True); procedure Set_Is_True_Constant (Id : E; V : B := True); procedure Set_Is_Unchecked_Union (Id : E; V : B := True); procedure Set_Is_Unsigned_Type (Id : E; V : B := True); @@ -6111,6 +6119,7 @@ package Einfo is pragma Inline (Is_Subprogram); pragma Inline (Is_Tag); pragma Inline (Is_Tagged_Type); + pragma Inline (Is_Thread_Body); pragma Inline (Is_True_Constant); pragma Inline (Is_Task_Type); pragma Inline (Is_Type); @@ -6418,6 +6427,7 @@ package Einfo is pragma Inline (Set_Is_Statically_Allocated); pragma Inline (Set_Is_Tag); pragma Inline (Set_Is_Tagged_Type); + pragma Inline (Set_Is_Thread_Body); pragma Inline (Set_Is_True_Constant); pragma Inline (Set_Is_Unchecked_Union); pragma Inline (Set_Is_Unsigned_Type); diff --git a/gcc/ada/einfo.h b/gcc/ada/einfo.h index 05db041..d34aca9 100644 --- a/gcc/ada/einfo.h +++ b/gcc/ada/einfo.h @@ -450,6 +450,7 @@ INLINE B Is_Statically_Allocated (E Id); INLINE B Is_Tag (E Id); INLINE B Is_Tagged_Type (E Id); + INLINE B Is_Thread_Body (E Id); INLINE B Is_True_Constant (E Id); INLINE B Is_Unchecked_Union (E Id); INLINE B Is_Unsigned_Type (E Id); @@ -1438,6 +1439,9 @@ INLINE B Is_Tagged_Type (E Id) { return Flag55 (Id); } + INLINE B Is_Thread_Body (E Id) + { return Flag77 (Id); } + INLINE B Is_True_Constant (E Id) { return Flag163 (Id); } diff --git a/gcc/ada/errno.c b/gcc/ada/errno.c index 112e7be..fc6964b 100644 --- a/gcc/ada/errno.c +++ b/gcc/ada/errno.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2001 Free Software Foundation, Inc. * + * Copyright (C) 1992-2003 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- * diff --git a/gcc/ada/exit.c b/gcc/ada/exit.c index 72ce28e..2f21067 100644 --- a/gcc/ada/exit.c +++ b/gcc/ada/exit.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2001 Free Software Foundation, Inc. * + * Copyright (C) 1992-2003 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- * diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 30be4d7..fd0631a2 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -3713,7 +3713,8 @@ package body Exp_Ch4 is exit when Chars (Node (Prim)) = Name_Op_Eq and then Etype (First_Formal (Node (Prim))) = Etype (Next_Formal (First_Formal (Node (Prim)))) - and then Etype (Node (Prim)) = Standard_Boolean; + and then + Base_Type (Etype (Node (Prim))) = Standard_Boolean; Next_Elmt (Prim); pragma Assert (Present (Prim)); diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index d51aaa8..9b5d3bf 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -59,12 +59,14 @@ with Sem_Ch12; use Sem_Ch12; with Sem_Ch13; use Sem_Ch13; with Sem_Disp; use Sem_Disp; with Sem_Dist; use Sem_Dist; +with Sem_Eval; use Sem_Eval; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; with Snames; use Snames; with Stand; use Stand; with Tbuild; use Tbuild; +with Ttypes; use Ttypes; with Uintp; use Uintp; with Validsw; use Validsw; @@ -2849,6 +2851,8 @@ package body Exp_Ch6 is -- Reset Pure indication if any parameter has root type System.Address + -- Wrap thread body + procedure Expand_N_Subprogram_Body (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); H : constant Node_Id := Handled_Statement_Sequence (N); @@ -2866,6 +2870,9 @@ package body Exp_Ch6 is -- the latter test is not critical, it does not matter if we add a -- few extra returns, since they get eliminated anyway later on. + procedure Expand_Thread_Body; + -- Perform required expansion of a thread body + ---------------- -- Add_Return -- ---------------- @@ -2882,6 +2889,165 @@ package body Exp_Ch6 is end if; end Add_Return; + ------------------------ + -- Expand_Thread_Body -- + ------------------------ + + -- The required expansion of a thread body is as follows + + -- procedure <thread body procedure name> is + + -- _Secondary_Stack : aliased + -- Storage_Elements.Storage_Array + -- (1 .. Storage_Offset (Sec_Stack_Size)); + -- for _Secondary_Stack'Alignment use Standard'Maximum_Alignment; + + -- _Process_ATSD : aliased System.Threads.ATSD; + + -- begin + -- System.Threads.Thread_Body_Enter; + -- (_Secondary_Stack'Address, + -- _Secondary_Stack'Length, + -- _Process_ATSD'Address); + + -- declare + -- <user declarations> + -- begin + -- <user statements> + -- <user exception handlers> + -- end; + + -- System.Threads.Thread_Body_Leave; + + -- exception + -- when E : others => + -- System.Threads.Thread_Body_Exceptional_Exit (E); + -- end; + + -- Note the exception handler is omitted if pragma Restriction + -- No_Exception_Handlers is currently active. + + procedure Expand_Thread_Body is + User_Decls : constant List_Id := Declarations (N); + Sec_Stack_Len : Node_Id; + + TB_Pragma : constant Node_Id := + Get_Rep_Pragma (Spec_Id, Name_Thread_Body); + + Ent_SS : Entity_Id; + Ent_ATSD : Entity_Id; + Ent_EO : Entity_Id; + + Decl_SS : Node_Id; + Decl_ATSD : Node_Id; + + Excep_Handlers : List_Id; + + begin + -- Get proper setting for secondary stack size + + if List_Length (Pragma_Argument_Associations (TB_Pragma)) = 2 then + Sec_Stack_Len := + Expression (Last (Pragma_Argument_Associations (TB_Pragma))); + else + Sec_Stack_Len := + Make_Integer_Literal (Loc, + Intval => + Expr_Value + (Expression (RTE (RE_Default_Secondary_Stack_Size)))); + end if; + + Sec_Stack_Len := Convert_To (RTE (RE_Storage_Offset), Sec_Stack_Len); + + -- Build and set declarations for the wrapped thread body + + Ent_SS := Make_Defining_Identifier (Loc, Name_uSecondary_Stack); + Ent_ATSD := Make_Defining_Identifier (Loc, Name_uProcess_ATSD); + + Decl_SS := + Make_Object_Declaration (Loc, + Defining_Identifier => Ent_SS, + Aliased_Present => True, + Object_Definition => + Make_Subtype_Indication (Loc, + Subtype_Mark => + New_Occurrence_Of (RTE (RE_Storage_Array), Loc), + Constraint => + Make_Index_Or_Discriminant_Constraint (Loc, + Constraints => New_List ( + Make_Range (Loc, + Low_Bound => Make_Integer_Literal (Loc, 1), + High_Bound => Sec_Stack_Len))))); + + Decl_ATSD := + Make_Object_Declaration (Loc, + Defining_Identifier => Ent_ATSD, + Aliased_Present => True, + Object_Definition => New_Occurrence_Of (RTE (RE_ATSD), Loc)); + + Set_Declarations (N, New_List (Decl_SS, Decl_ATSD)); + Analyze (Decl_SS); + Analyze (Decl_ATSD); + Set_Alignment (Ent_SS, UI_From_Int (Maximum_Alignment)); + + -- Create new exception handler + + if Restrictions (No_Exception_Handlers) then + Excep_Handlers := No_List; + + else + Check_Restriction (No_Exception_Handlers, N); + + Ent_EO := Make_Defining_Identifier (Loc, Name_uE); + + Excep_Handlers := New_List ( + Make_Exception_Handler (Loc, + Choice_Parameter => Ent_EO, + Exception_Choices => New_List ( + Make_Others_Choice (Loc)), + Statements => New_List ( + Make_Procedure_Call_Statement (Loc, + Name => + New_Occurrence_Of + (RTE (RE_Thread_Body_Exceptional_Exit), Loc), + Parameter_Associations => New_List ( + New_Occurrence_Of (Ent_EO, Loc)))))); + end if; + + -- Now build new handled statement sequence and analyze it + + Set_Handled_Statement_Sequence (N, + Make_Handled_Sequence_Of_Statements (Loc, + Statements => New_List ( + + Make_Procedure_Call_Statement (Loc, + Name => New_Occurrence_Of (RTE (RE_Thread_Body_Enter), Loc), + Parameter_Associations => New_List ( + + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Ent_SS, Loc), + Attribute_Name => Name_Address), + + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Ent_SS, Loc), + Attribute_Name => Name_Length), + + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Ent_ATSD, Loc), + Attribute_Name => Name_Address))), + + Make_Block_Statement (Loc, + Declarations => User_Decls, + Handled_Statement_Sequence => H), + + Make_Procedure_Call_Statement (Loc, + Name => New_Occurrence_Of (RTE (RE_Thread_Body_Leave), Loc))), + + Exception_Handlers => Excep_Handlers)); + + Analyze (Handled_Statement_Sequence (N)); + end Expand_Thread_Body; + -- Start of processing for Expand_N_Subprogram_Body begin @@ -3150,6 +3316,12 @@ package body Exp_Ch6 is end; end if; + -- Deal with thread body + + if Is_Thread_Body (Spec_Id) then + Expand_Thread_Body; + end if; + -- If the subprogram does not have pending instantiations, then we -- must generate the subprogram descriptor now, since the code for -- the subprogram is complete, and this is our last chance. However diff --git a/gcc/ada/gigi.h b/gcc/ada/gigi.h index cf9ccb7..4d44671 100644 --- a/gcc/ada/gigi.h +++ b/gcc/ada/gigi.h @@ -570,7 +570,7 @@ extern tree create_param_decl (tree, tree, int); INLINE_FLAG, PUBLIC_FLAG, and EXTERN_FLAG are used to set the appropriate fields in the FUNCTION_DECL. */ -extern tree create_subprog_decl (tree, tree, tree, tree, int, int, int, +extern tree create_subprog_decl (tree, tree, tree, tree, int, int, int, struct attrib *); /* Returns a LABEL_DECL node for LABEL_NAME. */ @@ -721,6 +721,25 @@ extern tree fill_vms_descriptor (tree, Entity_Id); should not be allocated in a register. Return true if successful. */ extern bool gnat_mark_addressable (tree); +/* This function is called by the front end to enumerate all the supported + modes for the machine. We pass a function which is called back with + the following integer parameters: + + FLOAT_P nonzero if this represents a floating-point mode + COMPLEX_P nonzero is this represents a complex mode + COUNT count of number of items, nonzero for vector mode + PRECISION number of bits in data representation + MANTISSA number of bits in mantissa, if FP and known, else zero. + SIZE number of bits used to store data + ALIGN number of bits to which mode is aligned. */ +extern void enumerate_modes (void (*f) (int, int, int, int, int, int, + unsigned int)); + +/* These are temporary function to deal with recent GCC changes related to + FP type sizes and precisions. */ +extern int fp_prec_to_size (int); +extern int fp_size_to_prec (int); + /* These functions return the basic data type sizes and related parameters about the target machine. */ diff --git a/gcc/ada/gnatbl.c b/gcc/ada/gnatbl.c index de75b33..8228428 100644 --- a/gcc/ada/gnatbl.c +++ b/gcc/ada/gnatbl.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2001 Free Software Foundation, Inc. * + * Copyright (C) 1992-2003 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- * @@ -289,7 +289,7 @@ main (int argc, char **argv) { if (done_an_ali) { - fprintf (stderr, + fprintf (stderr, "Sorry - cannot handle more than one ALI file\n"); exit (1); } @@ -323,7 +323,7 @@ main (int argc, char **argv) exit (retcode); } } - else + else addarg (argv[i]); } #ifdef MSDOS diff --git a/gcc/ada/init.c b/gcc/ada/init.c index ac9abca..b6161b3 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -82,17 +82,17 @@ extern struct Machine_State *(*Get_Machine_State_Addr) (void); #define Check_Abort_Status \ system__soft_links__check_abort_status -extern int (*Check_Abort_Status) (void); +extern int (*Check_Abort_Status) (void); #define Raise_From_Signal_Handler \ ada__exceptions__raise_from_signal_handler -extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *); +extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *); #define Propagate_Signal_Exception \ __gnat_propagate_sig_exc -extern void Propagate_Signal_Exception (struct Machine_State *, - struct Exception_Data *, - const char *); +extern void Propagate_Signal_Exception (struct Machine_State *, + struct Exception_Data *, + const char *); /* Copies of global values computed by the binder */ int __gl_main_priority = -1; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index e0f5998..113b8d1 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -3363,7 +3363,10 @@ package body Make is -- cannot be specified on the command line. if Osint.Number_Of_Files /= 0 then - if Projects.Table (Main_Project).Library then + if Projects.Table (Main_Project).Library + and then not Unique_Compile + and then ((not Make_Steps) or else Bind_Only or else Link_Only) + then Make_Failed ("cannot specify a main program " & "on the command line for a library project file"); diff --git a/gcc/ada/misc.c b/gcc/ada/misc.c index d2af6f2..42bb3fa 100644 --- a/gcc/ada/misc.c +++ b/gcc/ada/misc.c @@ -39,6 +39,7 @@ #include "coretypes.h" #include "tm.h" #include "tree.h" +#include "real.h" #include "rtl.h" #include "errors.h" #include "diagnostic.h" @@ -146,7 +147,7 @@ static void gnat_adjust_rli (record_layout_info); const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER; -/* Tables describing GCC tree codes used only by GNAT. +/* Tables describing GCC tree codes used only by GNAT. Table indexed by tree code giving a string containing a character classifying the tree code. Possibilities are @@ -272,7 +273,7 @@ gnat_handle_option (size_t scode, const char *arg, int value ATTRIBUTE_UNUSED) case OPT_gant: warning ("`-gnat' misspelled as `-gant'"); - + /* ... fall through ... */ case OPT_gnat: @@ -283,7 +284,7 @@ gnat_handle_option (size_t scode, const char *arg, int value ATTRIBUTE_UNUSED) gnat_argc++; if (arg[0] == 'O') - for (i = 1; i < save_argc - 1; i++) + for (i = 1; i < save_argc - 1; i++) if (!strncmp (save_argv[i], "-gnatO", 6)) if (save_argv[++i][0] != '-') { @@ -304,8 +305,8 @@ static unsigned int gnat_init_options (unsigned int argc, const char **argv) { /* Initialize gnat_argv with save_argv size. */ - gnat_argv = (char **) xmalloc ((argc + 1) * sizeof (argv[0])); - gnat_argv[0] = xstrdup (argv[0]); /* name of the command */ + gnat_argv = (char **) xmalloc ((argc + 1) * sizeof (argv[0])); + gnat_argv[0] = xstrdup (argv[0]); /* name of the command */ gnat_argc = 1; save_argc = argc; @@ -706,7 +707,7 @@ static int gnat_eh_type_covers (tree a, tree b) { /* a catches b if they represent the same exception id or if a - is an "others". + is an "others". ??? integer_zero_node for "others" is hardwired in too many places currently. */ @@ -886,3 +887,108 @@ must_pass_by_ref (tree gnu_type) || (TYPE_SIZE (gnu_type) != 0 && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST)); } + +/* This function is called by the front end to enumerate all the supported + modes for the machine. We pass a function which is called back with + the following integer parameters: + + FLOAT_P nonzero if this represents a floating-point mode + COMPLEX_P nonzero is this represents a complex mode + COUNT count of number of items, nonzero for vector mode + PRECISION number of bits in data representation + MANTISSA number of bits in mantissa, if FP and known, else zero. + SIZE number of bits used to store data + ALIGN number of bits to which mode is aligned. */ + +void +enumerate_modes (void (*f) (int, int, int, int, int, int, unsigned int)) +{ + enum machine_mode i; + + for (i = 0; i < NUM_MACHINE_MODES; i++) + { + enum machine_mode j; + bool float_p = 0; + bool complex_p = 0; + bool vector_p = 0; + bool skip_p = 0; + int mantissa = 0; + enum machine_mode inner_mode = i; + + switch (GET_MODE_CLASS (i)) + { + case MODE_INT: + break; + case MODE_FLOAT: + float_p = 1; + break; + case MODE_COMPLEX_INT: + complex_p = 1; + inner_mode = GET_MODE_INNER (i); + break; + case MODE_COMPLEX_FLOAT: + float_p = 1; + complex_p = 1; + inner_mode = GET_MODE_INNER (i); + break; + case MODE_VECTOR_INT: + vector_p = 1; + inner_mode = GET_MODE_INNER (i); + break; + case MODE_VECTOR_FLOAT: + float_p = 1; + vector_p = 1; + inner_mode = GET_MODE_INNER (i); + break; + default: + skip_p = 1; + } + + /* Skip this mode if it's one the front end doesn't need to know about + (e.g., the CC modes) or if there is no add insn for that mode (or + any wider mode), meaning it is not supported by the hardware. If + this a complex or vector mode, we care about the inner mode. */ + for (j = inner_mode; j != VOIDmode; j = GET_MODE_WIDER_MODE (j)) + if (add_optab->handlers[j].insn_code != CODE_FOR_nothing) + break; + + if (float_p) + { + const struct real_format *fmt = REAL_MODE_FORMAT (inner_mode); + + mantissa = fmt->p * fmt->log2_b; + } + + if (!skip_p && j != VOIDmode) + (*f) (float_p, complex_p, vector_p ? GET_MODE_NUNITS (i) : 0, + GET_MODE_BITSIZE (i), mantissa, + GET_MODE_SIZE (i) * BITS_PER_UNIT, GET_MODE_ALIGNMENT (i)); + } +} + +int +fp_prec_to_size (int prec) +{ + enum machine_mode mode; + + for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode; + mode = GET_MODE_WIDER_MODE (mode)) + if (GET_MODE_BITSIZE (mode) == prec) + return GET_MODE_SIZE (mode) * BITS_PER_UNIT; + + abort (); +} + +int +fp_size_to_prec (int size) +{ + enum machine_mode mode; + + for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode; + mode = GET_MODE_WIDER_MODE (mode)) + if (GET_MODE_SIZE (mode) * BITS_PER_UNIT == size) + return GET_MODE_BITSIZE (mode); + + abort (); +} + diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 2f5482f..19eefc4 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -980,6 +980,7 @@ begin Pragma_Task_Info | Pragma_Task_Name | Pragma_Task_Storage | + Pragma_Thread_Body | Pragma_Time_Slice | Pragma_Title | Pragma_Unchecked_Union | diff --git a/gcc/ada/raise.c b/gcc/ada/raise.c index f3b1f63..8b1d082 100644 --- a/gcc/ada/raise.c +++ b/gcc/ada/raise.c @@ -940,8 +940,8 @@ get_action_description_for (_Unwind_Context *uw_context, static void setup_to_install (_Unwind_Context *uw_context, _Unwind_Exception *uw_exception, - int uw_filter, - _Unwind_Ptr uw_landing_pad) + _Unwind_Ptr uw_landing_pad, + int uw_filter) { #ifndef EH_RETURN_DATA_REGNO /* We should not be called if the appropriate underlying support is not diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 000202c..3ecd948 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -298,6 +298,7 @@ package Rtsfind is System_String_Ops_Concat_5, System_Task_Info, System_Tasking, + System_Threads, System_Unsigned_Types, System_Val_Bool, System_Val_Char, @@ -1034,6 +1035,7 @@ package Rtsfind is RE_IS_Ilf, -- System.Scalar_Values RE_IS_Ill, -- System.Scalar_Values + RE_Default_Secondary_Stack_Size, -- System.Secondary_Stack RE_Mark_Id, -- System.Secondary_Stack RE_SS_Allocate, -- System.Secondary_Stack RE_SS_Pool, -- System.Secondary_Stack @@ -1164,6 +1166,11 @@ package Rtsfind is RE_Get_GNAT_Exception, -- System.Soft_Links RE_Update_Exception, -- System.Soft_Links + RE_ATSD, -- System.Threads + RE_Thread_Body_Enter, -- System.Threads + RE_Thread_Body_Exceptional_Exit, -- System.Threads + RE_Thread_Body_Leave, -- System.Threads + RE_Bits_1, -- System.Unsigned_Types RE_Bits_2, -- System.Unsigned_Types RE_Bits_4, -- System.Unsigned_Types @@ -1968,6 +1975,7 @@ package Rtsfind is RE_IS_Ilf => System_Scalar_Values, RE_IS_Ill => System_Scalar_Values, + RE_Default_Secondary_Stack_Size => System_Secondary_Stack, RE_Mark_Id => System_Secondary_Stack, RE_SS_Allocate => System_Secondary_Stack, RE_SS_Mark => System_Secondary_Stack, @@ -2098,6 +2106,11 @@ package Rtsfind is RE_Get_GNAT_Exception => System_Soft_Links, RE_Update_Exception => System_Soft_Links, + RE_ATSD => System_Threads, + RE_Thread_Body_Enter => System_Threads, + RE_Thread_Body_Exceptional_Exit => System_Threads, + RE_Thread_Body_Leave => System_Threads, + RE_Bits_1 => System_Unsigned_Types, RE_Bits_2 => System_Unsigned_Types, RE_Bits_4 => System_Unsigned_Types, diff --git a/gcc/ada/s-thread.adb b/gcc/ada/s-thread.adb index 0f3a90c..97f9e88 100644 --- a/gcc/ada/s-thread.adb +++ b/gcc/ada/s-thread.adb @@ -43,6 +43,8 @@ package body System.Threads is function From_Address is new Unchecked_Conversion (Address, ATSD_Access); + + ----------------------- -- Get_Current_Excep -- ----------------------- @@ -98,4 +100,41 @@ package body System.Threads is CTSD.Sec_Stack_Addr := Addr; end Set_Sec_Stack_Addr; + ----------------------- + -- Thread_Body_Enter -- + ----------------------- + + procedure Thread_Body_Enter + (Sec_Stack_Address : System.Address; + Sec_Stack_Size : Natural; + Process_ATSD_Address : System.Address) + is + pragma Unreferenced (Sec_Stack_Address); + pragma Unreferenced (Sec_Stack_Size); + pragma Unreferenced (Process_ATSD_Address); + begin + null; + end Thread_Body_Enter; + + ---------------------------------- + -- Thread_Body_Exceptional_Exit -- + ---------------------------------- + + procedure Thread_Body_Exceptional_Exit + (EO : Ada.Exceptions.Exception_Occurrence) + is + pragma Unreferenced (EO); + begin + null; + end Thread_Body_Exceptional_Exit; + + ----------------------- + -- Thread_Body_Leave -- + ----------------------- + + procedure Thread_Body_Leave is + begin + null; + end Thread_Body_Leave; + end System.Threads; diff --git a/gcc/ada/s-thread.ads b/gcc/ada/s-thread.ads index 6bf6aaf..a316afc 100644 --- a/gcc/ada/s-thread.ads +++ b/gcc/ada/s-thread.ads @@ -48,7 +48,7 @@ package System.Threads is type ATSD_Access is access ATSD; - -- Get/Set for the attributes of the current thread. + -- Get/Set for the attributes of the current thread function Get_Jmpbuf_Address return Address; pragma Inline (Get_Jmpbuf_Address); @@ -65,6 +65,73 @@ package System.Threads is function Get_Current_Excep return EOA; pragma Inline (Get_Current_Excep); + -------------------------- + -- Thread Body Handling -- + -------------------------- + + -- The subprograms in this section are called by the expansion of a + -- subprogram body to which a Thread_Body pragma has been applied: + + -- Given a subprogram body + + -- procedure xyz (params ....) is -- can also be a function + -- <user declarations> + -- begin + -- <user statements> + -- <user exception handlers> + -- end xyz; + + -- The expansion resulting from use of the Thread_Body pragma is: + + -- procedure xyz (params ...) is + + -- _Secondary_Stack : aliased + -- Storage_Elements.Storage_Array + -- (1 .. Storage_Offset (Sec_Stack_Size)); + -- for _Secondary_Stack'Alignment use Standard'Maximum_Alignment; + + -- _Process_ATSD : aliased System.Threads.ATSD; + + -- begin + -- System.Threads.Thread_Body_Enter; + -- (_Secondary_Stack'Address, + -- _Secondary_Stack'Length, + -- _Process_ATSD'Address); + + -- declare + -- <user declarations> + -- begin + -- <user statements> + -- <user exception handlers> + -- end; + + -- System.Threads.Thread_Body_Leave; + + -- exception + -- when E : others => + -- System.Threads.Thread_Body_Exceptional_Exit (E); + -- end; + + -- Note the exception handler is omitted if pragma Restriction + -- No_Exception_Handlers is currently active. + + -- Note: the secondary stack size (Sec_Stack_Size) comes either from + -- the pragma, if specified, or is the default value taken from + -- the declaration in System.Secondary_Stack. + + procedure Thread_Body_Enter + (Sec_Stack_Address : System.Address; + Sec_Stack_Size : Natural; + Process_ATSD_Address : System.Address); + -- Enter thread body, see above for details + + procedure Thread_Body_Leave; + -- Leave thread body (normally), see above for details + + procedure Thread_Body_Exceptional_Exit + (EO : Ada.Exceptions.Exception_Occurrence); + -- Leave thread body (abnormally on exception), see above for details + private ------------------------ diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 83833c1..efefdb8 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -372,8 +372,8 @@ package body Sem_Attr is ---------------------------------- procedure Build_Access_Subprogram_Type (P : Node_Id) is - Index : Interp_Index; - It : Interp; + Index : Interp_Index; + It : Interp; function Get_Kind (E : Entity_Id) return Entity_Kind; -- Distinguish between access to regular and protected @@ -395,6 +395,10 @@ package body Sem_Attr is -- Start of processing for Build_Access_Subprogram_Type begin + -- In the case of an access to subprogram, use the name of the + -- subprogram itself as the designated type. Type-checking in + -- this case compares the signatures of the designated types. + if not Is_Overloaded (P) then Acc_Type := New_Internal_Entity @@ -408,7 +412,6 @@ package body Sem_Attr is Set_Etype (N, Any_Type); while Present (It.Nam) loop - if not Is_Intrinsic_Subprogram (It.Nam) then Acc_Type := New_Internal_Entity @@ -437,17 +440,20 @@ package body Sem_Attr is ("prefix of % attribute cannot be enumeration literal", P); end if; - -- In the case of an access to subprogram, use the name of the - -- subprogram itself as the designated type. Type-checking in - -- this case compares the signatures of the designated types. + -- Case of access to subprogram if Is_Entity_Name (P) and then Is_Overloadable (Entity (P)) then + -- Not allowed for nested subprograms if No_Implicit_Dynamic_Code + -- restriction set (since in general a trampoline is required). + if not Is_Library_Level_Entity (Entity (P)) then Check_Restriction (No_Implicit_Dynamic_Code, P); end if; + -- Build the appropriate subprogram type + Build_Access_Subprogram_Type (P); -- For unrestricted access, kill current values, since this @@ -460,7 +466,7 @@ package body Sem_Attr is return; - -- Component is an operation of a protected type. + -- Component is an operation of a protected type elsif Nkind (P) = N_Selected_Component and then Is_Overloadable (Entity (Selector_Name (P))) @@ -6406,7 +6412,6 @@ package body Sem_Attr is end if; if Is_Entity_Name (P) then - if Is_Overloaded (P) then Get_First_Interp (P, Index, It); @@ -6437,19 +6442,18 @@ package body Sem_Attr is Resolve (P); end if; + Error_Msg_Name_1 := Aname; + if not Is_Entity_Name (P) then null; elsif Is_Abstract (Entity (P)) and then Is_Overloadable (Entity (P)) then - Error_Msg_Name_1 := Aname; Error_Msg_N ("prefix of % attribute cannot be abstract", P); Set_Etype (N, Any_Type); elsif Convention (Entity (P)) = Convention_Intrinsic then - Error_Msg_Name_1 := Aname; - if Ekind (Entity (P)) = E_Enumeration_Literal then Error_Msg_N ("prefix of % attribute cannot be enumeration literal", @@ -6460,6 +6464,10 @@ package body Sem_Attr is end if; Set_Etype (N, Any_Type); + + elsif Is_Thread_Body (Entity (P)) then + Error_Msg_N + ("prefix of % attribute cannot be a thread body", P); end if; -- Assignments, return statements, components of aggregates, diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index c780304..fbdb14a 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -3233,8 +3233,7 @@ package body Sem_Ch10 is Unum : Unit_Number_Type := Get_Source_Unit (Library_Unit (N)); P_Unit : Entity_Id := Unit (Library_Unit (N)); - P : Entity_Id := - Defining_Unit_Name (Specification (P_Unit)); + P : Entity_Id; Lim_Elmt : Elmt_Id; Lim_Typ : Entity_Id; Is_Child_Package : Boolean := False; @@ -3261,6 +3260,33 @@ package body Sem_Ch10 is -- Start of processing for Install_Limited_Withed_Unit begin + -- In case of limited with_clause on subprograms, generics, instances, + -- or generic renamings, the corresponding error was previously posted + -- and we have nothing to do here. + + case Nkind (P_Unit) is + + when N_Package_Declaration => + null; + + when N_Subprogram_Declaration | + N_Generic_Package_Declaration | + N_Generic_Subprogram_Declaration | + N_Package_Instantiation | + N_Function_Instantiation | + N_Procedure_Instantiation | + N_Generic_Package_Renaming_Declaration | + N_Generic_Procedure_Renaming_Declaration | + N_Generic_Function_Renaming_Declaration => + return; + + when others => + pragma Assert (False); + null; + end case; + + P := Defining_Unit_Name (Specification (P_Unit)); + if Nkind (P) = N_Defining_Program_Unit_Name then -- Retrieve entity of child package @@ -3803,23 +3829,27 @@ package body Sem_Ch10 is when N_Subprogram_Declaration => Error_Msg_N ("subprograms not allowed in " & "limited with_clauses", N); + return; when N_Generic_Package_Declaration | N_Generic_Subprogram_Declaration => Error_Msg_N ("generics not allowed in " & "limited with_clauses", N); + return; when N_Package_Instantiation | N_Function_Instantiation | N_Procedure_Instantiation => Error_Msg_N ("generic instantiations not allowed in " & "limited with_clauses", N); + return; when N_Generic_Package_Renaming_Declaration | N_Generic_Procedure_Renaming_Declaration | N_Generic_Function_Renaming_Declaration => Error_Msg_N ("generic renamings not allowed in " & "limited with_clauses", N); + return; when others => pragma Assert (False); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index d5d82b2..037650f 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -9082,6 +9082,80 @@ package body Sem_Prag is end if; end Task_Storage; + ----------------- + -- Thread_Body -- + ----------------- + + -- pragma Thread_Body + -- ( [Entity =>] LOCAL_NAME + -- [,[Secondary_Stack_Size =>] static_integer_EXPRESSION]); + + when Pragma_Thread_Body => Thread_Body : declare + Id : Node_Id; + SS : Node_Id; + E : Entity_Id; + + begin + GNAT_Pragma; + Check_At_Least_N_Arguments (1); + Check_At_Most_N_Arguments (2); + Check_Optional_Identifier (Arg1, Name_Entity); + Check_Arg_Is_Local_Name (Arg1); + + Id := Expression (Arg1); + + if not Is_Entity_Name (Id) + or else not Is_Subprogram (Entity (Id)) + then + Error_Pragma_Arg ("subprogram name required", Arg1); + end if; + + E := Entity (Id); + + -- Go to renamed subprogram if present, since Thread_Body applies + -- to the actual renamed entity, not to the renaming entity. + + if Present (Alias (E)) + and then Nkind (Parent (Declaration_Node (E))) = + N_Subprogram_Renaming_Declaration + then + E := Alias (E); + end if; + + -- Various error checks + + if Nkind (Parent (Declaration_Node (E))) = N_Subprogram_Body then + Error_Pragma + ("pragma% requires separate spec and must come before body"); + + elsif Rep_Item_Too_Early (E, N) + or else + Rep_Item_Too_Late (E, N) + then + raise Pragma_Exit; + + elsif Is_Thread_Body (E) then + Error_Pragma_Arg + ("only one thread body pragma allowed", Arg1); + + elsif Present (Homonym (E)) + and then Scope (Homonym (E)) = Current_Scope + then + Error_Pragma_Arg + ("thread body subprogram must not be overloaded", Arg1); + end if; + + Set_Is_Thread_Body (E); + + -- Deal with secondary stack argument + + if Arg_Count = 2 then + Check_Optional_Identifier (Arg2, Name_Secondary_Stack_Size); + SS := Expression (Arg2); + Analyze_And_Resolve (SS, Any_Integer); + end if; + end Thread_Body; + ---------------- -- Time_Slice -- ---------------- @@ -9812,6 +9886,7 @@ package body Sem_Prag is Pragma_Task_Info => -1, Pragma_Task_Name => -1, Pragma_Task_Storage => 0, + Pragma_Thread_Body => +2, Pragma_Time_Slice => -1, Pragma_Title => -1, Pragma_Unchecked_Union => -1, diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 68c45f6..88d8edc 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -3315,7 +3315,6 @@ package body Sem_Res is -- dereference made explicit in Analyze_Call. if Ekind (Etype (Subp)) = E_Subprogram_Type then - if not Is_Overloaded (Subp) then Nam := Etype (Subp); @@ -3423,6 +3422,12 @@ package body Sem_Res is end; end if; + -- Cannot call thread body directly + + if Is_Thread_Body (Nam) then + Error_Msg_N ("cannot call thread body directly", N); + end if; + -- If the subprogram is not global, then kill all checks. This is -- a bit conservative, since in many cases we could do better, but -- it is not worth the effort. Similarly, we kill constant values. diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb index 944fe9c..aa603e1 100644 --- a/gcc/ada/snames.adb +++ b/gcc/ada/snames.adb @@ -1,990 +1,994 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S N A M E S -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2003, 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- -- --- ware Foundation; either version 2, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- --- -- --- As a special exception, if other files instantiate generics from this -- --- unit, or you link this unit with other files to produce an executable, -- --- this unit does not by itself cause the resulting executable to be -- --- covered by the GNU General Public License. This exception does not -- --- however invalidate any other reasons why the executable file might be -- --- covered by the GNU Public License. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Namet; use Namet; -with Table; - -package body Snames is - - -- Table used to record convention identifiers - - type Convention_Id_Entry is record - Name : Name_Id; - Convention : Convention_Id; - end record; - - package Convention_Identifiers is new Table.Table ( - Table_Component_Type => Convention_Id_Entry, - Table_Index_Type => Int, - Table_Low_Bound => 1, - Table_Initial => 50, - Table_Increment => 200, - Table_Name => "Name_Convention_Identifiers"); - - -- Table of names to be set by Initialize. Each name is terminated by a - -- single #, and the end of the list is marked by a null entry, i.e. by - -- two # marks in succession. Note that the table does not include the - -- entries for a-z, since these are initialized by Namet itself. - - Preset_Names : constant String := - "_parent#" & - "_tag#" & - "off#" & - "space#" & - "time#" & - "_alignment#" & - "_abort_signal#" & - "_assign#" & - "_chain#" & - "_clean#" & - "_controller#" & - "_entry_bodies#" & - "_expunge#" & - "_final_list#" & - "_idepth#" & - "_init#" & - "_local_final_list#" & - "_master#" & - "_object#" & - "_priority#" & - "_service#" & - "_size#" & - "_tags#" & - "_task#" & - "_task_id#" & - "_task_info#" & - "_task_name#" & - "_trace_sp#" & - "initialize#" & - "adjust#" & - "finalize#" & - "next#" & - "prev#" & - "allocate#" & - "deallocate#" & - "dereference#" & - "decimal_io#" & - "enumeration_io#" & - "fixed_io#" & - "float_io#" & - "integer_io#" & - "modular_io#" & - "a_textio#" & - "a_witeio#" & - "const#" & - "<error>#" & - "go#" & - "put#" & - "put_line#" & - "to#" & - "finalization#" & - "finalization_root#" & - "interfaces#" & - "standard#" & - "system#" & - "text_io#" & - "wide_text_io#" & - "addr#" & - "async#" & - "get_active_partition_id#" & - "get_rci_package_receiver#" & - "origin#" & - "params#" & - "partition#" & - "partition_interface#" & - "ras#" & - "rci_name#" & - "receiver#" & - "result#" & - "rpc#" & - "subp_id#" & - "Oabs#" & - "Oand#" & - "Omod#" & - "Onot#" & - "Oor#" & - "Orem#" & - "Oxor#" & - "Oeq#" & - "One#" & - "Olt#" & - "Ole#" & - "Ogt#" & - "Oge#" & - "Oadd#" & - "Osubtract#" & - "Oconcat#" & - "Omultiply#" & - "Odivide#" & - "Oexpon#" & - "ada_83#" & - "ada_95#" & - "c_pass_by_copy#" & - "compile_time_warning#" & - "component_alignment#" & - "convention_identifier#" & - "discard_names#" & - "elaboration_checks#" & - "eliminate#" & - "explicit_overriding#" & - "extend_system#" & - "extensions_allowed#" & - "external_name_casing#" & - "float_representation#" & - "initialize_scalars#" & - "interrupt_state#" & - "license#" & - "locking_policy#" & - "long_float#" & - "no_run_time#" & - "normalize_scalars#" & - "polling#" & - "persistent_data#" & - "persistent_object#" & - "propagate_exceptions#" & - "queuing_policy#" & - "ravenscar#" & - "restricted_run_time#" & - "restrictions#" & - "restriction_warnings#" & - "reviewable#" & - "source_file_name#" & - "source_file_name_project#" & - "style_checks#" & - "suppress#" & - "suppress_exception_locations#" & - "task_dispatching_policy#" & - "universal_data#" & - "unsuppress#" & - "use_vads_size#" & - "validity_checks#" & - "warnings#" & - "abort_defer#" & - "all_calls_remote#" & - "annotate#" & - "assert#" & - "asynchronous#" & - "atomic#" & - "atomic_components#" & - "attach_handler#" & - "comment#" & - "common_object#" & - "complex_representation#" & - "controlled#" & - "convention#" & - "cpp_class#" & - "cpp_constructor#" & - "cpp_virtual#" & - "cpp_vtable#" & - "debug#" & - "elaborate#" & - "elaborate_all#" & - "elaborate_body#" & - "export#" & - "export_exception#" & - "export_function#" & - "export_object#" & - "export_procedure#" & - "export_value#" & - "export_valued_procedure#" & - "external#" & - "finalize_storage_only#" & - "ident#" & - "import#" & - "import_exception#" & - "import_function#" & - "import_object#" & - "import_procedure#" & - "import_valued_procedure#" & - "inline#" & - "inline_always#" & - "inline_generic#" & - "inspection_point#" & - "interface#" & - "interface_name#" & - "interrupt_handler#" & - "interrupt_priority#" & - "java_constructor#" & - "java_interface#" & - "keep_names#" & - "link_with#" & - "linker_alias#" & - "linker_options#" & - "linker_section#" & - "list#" & - "machine_attribute#" & - "main#" & - "main_storage#" & - "memory_size#" & - "no_return#" & - "obsolescent#" & - "optimize#" & - "optional_overriding#" & - "overriding#" & - "pack#" & - "page#" & - "passive#" & - "preelaborate#" & - "priority#" & - "psect_object#" & - "pure#" & - "pure_function#" & - "remote_call_interface#" & - "remote_types#" & - "share_generic#" & - "shared#" & - "shared_passive#" & - "source_reference#" & - "stream_convert#" & - "subtitle#" & - "suppress_all#" & - "suppress_debug_info#" & - "suppress_initialization#" & - "system_name#" & - "task_info#" & - "task_name#" & - "task_storage#" & - "time_slice#" & - "title#" & - "unchecked_union#" & - "unimplemented_unit#" & - "unreferenced#" & - "unreserve_all_interrupts#" & - "volatile#" & - "volatile_components#" & - "weak_external#" & - "ada#" & - "assembler#" & - "cobol#" & - "cpp#" & - "fortran#" & - "intrinsic#" & - "java#" & - "stdcall#" & - "stubbed#" & - "asm#" & - "assembly#" & - "default#" & - "dll#" & - "win32#" & - "as_is#" & - "body_file_name#" & - "casing#" & - "code#" & - "component#" & - "component_size_4#" & - "copy#" & - "d_float#" & - "descriptor#" & - "dot_replacement#" & - "dynamic#" & - "entity#" & - "external_name#" & - "first_optional_parameter#" & - "form#" & - "g_float#" & - "gcc#" & - "gnat#" & - "gpl#" & - "ieee_float#" & - "homonym_number#" & - "internal#" & - "link_name#" & - "lowercase#" & - "max_size#" & - "mechanism#" & - "mixedcase#" & - "modified_gpl#" & - "name#" & - "nca#" & - "no#" & - "on#" & - "parameter_types#" & - "reference#" & - "restricted#" & - "result_mechanism#" & - "result_type#" & - "runtime#" & - "sb#" & - "section#" & - "semaphore#" & - "spec_file_name#" & - "static#" & - "stack_size#" & - "subunit_file_name#" & - "task_stack_size_default#" & - "task_type#" & - "time_slicing_enabled#" & - "top_guard#" & - "uba#" & - "ubs#" & - "ubsb#" & - "unit_name#" & - "unknown#" & - "unrestricted#" & - "uppercase#" & - "user#" & - "vax_float#" & - "vms#" & - "working_storage#" & - "abort_signal#" & - "access#" & - "address#" & - "address_size#" & - "aft#" & - "alignment#" & - "asm_input#" & - "asm_output#" & - "ast_entry#" & - "bit#" & - "bit_order#" & - "bit_position#" & - "body_version#" & - "callable#" & - "caller#" & - "code_address#" & - "component_size#" & - "compose#" & - "constrained#" & - "count#" & - "default_bit_order#" & - "definite#" & - "delta#" & - "denorm#" & - "digits#" & - "elaborated#" & - "emax#" & - "enum_rep#" & - "epsilon#" & - "exponent#" & - "external_tag#" & - "first#" & - "first_bit#" & - "fixed_value#" & - "fore#" & - "has_discriminants#" & - "identity#" & - "img#" & - "integer_value#" & - "large#" & - "last#" & - "last_bit#" & - "leading_part#" & - "length#" & - "machine_emax#" & - "machine_emin#" & - "machine_mantissa#" & - "machine_overflows#" & - "machine_radix#" & - "machine_rounds#" & - "machine_size#" & - "mantissa#" & - "max_size_in_storage_elements#" & - "maximum_alignment#" & - "mechanism_code#" & - "model_emin#" & - "model_epsilon#" & - "model_mantissa#" & - "model_small#" & - "modulus#" & - "null_parameter#" & - "object_size#" & - "partition_id#" & - "passed_by_reference#" & - "pool_address#" & - "pos#" & - "position#" & - "range#" & - "range_length#" & - "round#" & - "safe_emax#" & - "safe_first#" & - "safe_large#" & - "safe_last#" & - "safe_small#" & - "scale#" & - "scaling#" & - "signed_zeros#" & - "size#" & - "small#" & - "storage_size#" & - "storage_unit#" & - "tag#" & - "target_name#" & - "terminated#" & - "to_address#" & - "type_class#" & - "uet_address#" & - "unbiased_rounding#" & - "unchecked_access#" & - "unconstrained_array#" & - "universal_literal_string#" & - "unrestricted_access#" & - "vads_size#" & - "val#" & - "valid#" & - "value_size#" & - "version#" & - "wchar_t_size#" & - "wide_width#" & - "width#" & - "word_size#" & - "adjacent#" & - "ceiling#" & - "copy_sign#" & - "floor#" & - "fraction#" & - "image#" & - "input#" & - "machine#" & - "max#" & - "min#" & - "model#" & - "pred#" & - "remainder#" & - "rounding#" & - "succ#" & - "truncation#" & - "value#" & - "wide_image#" & - "wide_value#" & - "output#" & - "read#" & - "write#" & - "elab_body#" & - "elab_spec#" & - "storage_pool#" & - "base#" & - "class#" & - "ceiling_locking#" & - "inheritance_locking#" & - "fifo_queuing#" & - "priority_queuing#" & - "fifo_within_priorities#" & - "access_check#" & - "accessibility_check#" & - "discriminant_check#" & - "division_check#" & - "elaboration_check#" & - "index_check#" & - "length_check#" & - "overflow_check#" & - "range_check#" & - "storage_check#" & - "tag_check#" & - "all_checks#" & - "abort#" & - "abs#" & - "accept#" & - "and#" & - "all#" & - "array#" & - "at#" & - "begin#" & - "body#" & - "case#" & - "constant#" & - "declare#" & - "delay#" & - "do#" & - "else#" & - "elsif#" & - "end#" & - "entry#" & - "exception#" & - "exit#" & - "for#" & - "function#" & - "generic#" & - "goto#" & - "if#" & - "in#" & - "is#" & - "limited#" & - "loop#" & - "mod#" & - "new#" & - "not#" & - "null#" & - "of#" & - "or#" & - "others#" & - "out#" & - "package#" & - "pragma#" & - "private#" & - "procedure#" & - "raise#" & - "record#" & - "rem#" & - "renames#" & - "return#" & - "reverse#" & - "select#" & - "separate#" & - "subtype#" & - "task#" & - "terminate#" & - "then#" & - "type#" & - "use#" & - "when#" & - "while#" & - "with#" & - "xor#" & - "divide#" & - "enclosing_entity#" & - "exception_information#" & - "exception_message#" & - "exception_name#" & - "file#" & - "import_address#" & - "import_largest_value#" & - "import_value#" & - "is_negative#" & - "line#" & - "rotate_left#" & - "rotate_right#" & - "shift_left#" & - "shift_right#" & - "shift_right_arithmetic#" & - "source_location#" & - "unchecked_conversion#" & - "unchecked_deallocation#" & - "to_pointer#" & - "abstract#" & - "aliased#" & - "protected#" & - "until#" & - "requeue#" & - "tagged#" & - "raise_exception#" & - "binder#" & - "body_suffix#" & - "builder#" & - "compiler#" & - "cross_reference#" & - "default_switches#" & - "exec_dir#" & - "executable#" & - "executable_suffix#" & - "extends#" & - "finder#" & - "global_configuration_pragmas#" & - "gnatls#" & - "gnatstub#" & - "implementation#" & - "implementation_exceptions#" & - "implementation_suffix#" & - "languages#" & - "library_dir#" & - "library_auto_init#" & - "library_gcc#" & - "library_interface#" & - "library_kind#" & - "library_name#" & - "library_options#" & - "library_src_dir#" & - "library_symbol_file#" & - "library_version#" & - "linker#" & - "local_configuration_pragmas#" & - "locally_removed_files#" & - "naming#" & - "object_dir#" & - "pretty_printer#" & - "project#" & - "separate_suffix#" & - "source_dirs#" & - "source_files#" & - "source_list_file#" & - "spec#" & - "spec_suffix#" & - "specification#" & - "specification_exceptions#" & - "specification_suffix#" & - "switches#" & - "unaligned_valid#" & - "#"; - - --------------------- - -- Generated Names -- - --------------------- - - -- This section lists the various cases of generated names which are - -- built from existing names by adding unique leading and/or trailing - -- upper case letters. In some cases these names are built recursively, - -- in particular names built from types may be built from types which - -- themselves have generated names. In this list, xxx represents an - -- existing name to which identifying letters are prepended or appended, - -- and a trailing n represents a serial number in an external name that - -- has some semantic significance (e.g. the n'th index type of an array). - - -- xxxA access type for formal xxx in entry param record (Exp_Ch9) - -- xxxB tag table for tagged type xxx (Exp_Ch3) - -- xxxB task body procedure for task xxx (Exp_Ch9) - -- xxxD dispatch table for tagged type xxx (Exp_Ch3) - -- xxxD discriminal for discriminant xxx (Sem_Ch3) - -- xxxDn n'th discr check function for rec type xxx (Exp_Ch3) - -- xxxE elaboration boolean flag for task xxx (Exp_Ch9) - -- xxxE dispatch table pointer type for tagged type xxx (Exp_Ch3) - -- xxxE parameters for accept body for entry xxx (Exp_Ch9) - -- xxxFn n'th primitive of a tagged type (named xxx) (Exp_Ch3) - -- xxxJ tag table type index for tagged type xxx (Exp_Ch3) - -- xxxM master Id value for access type xxx (Exp_Ch3) - -- xxxP tag table pointer type for tagged type xxx (Exp_Ch3) - -- xxxP parameter record type for entry xxx (Exp_Ch9) - -- xxxPA access to parameter record type for entry xxx (Exp_Ch9) - -- xxxPn pointer type for n'th primitive of tagged type xxx (Exp_Ch3) - -- xxxR dispatch table pointer for tagged type xxx (Exp_Ch3) - -- xxxT tag table type for tagged type xxx (Exp_Ch3) - -- xxxT literal table for enumeration type xxx (Sem_Ch3) - -- xxxV type for task value record for task xxx (Exp_Ch9) - -- xxxX entry index constant (Exp_Ch9) - -- xxxY dispatch table type for tagged type xxx (Exp_Ch3) - -- xxxZ size variable for task xxx (Exp_Ch9) - - -- TSS names - - -- xxxDA deep adjust routine for type xxx (Exp_TSS) - -- xxxDF deep finalize routine for type xxx (Exp_TSS) - -- xxxDI deep initialize routine for type xxx (Exp_TSS) - -- xxxEQ composite equality routine for record type xxx (Exp_TSS) - -- xxxIP initialization procedure for type xxx (Exp_TSS) - -- xxxRA RAs type access routine for type xxx (Exp_TSS) - -- xxxRD RAs type dereference routine for type xxx (Exp_TSS) - -- xxxRP Rep to Pos conversion for enumeration type xxx (Exp_TSS) - -- xxxSI stream input attribute subprogram for type xxx (Exp_TSS) - -- xxxSO stream output attribute subprogram for type xxx (Exp_TSS) - -- xxxSR stream read attribute subprogram for type xxx (Exp_TSS) - -- xxxSW stream write attribute subprogram for type xxx (Exp_TSS) - - -- Implicit type names - - -- TxxxT type of literal table for enumeration type xxx (Sem_Ch3) - - -- (Note: this list is not complete or accurate ???) - - ---------------------- - -- Get_Attribute_Id -- - ---------------------- - - function Get_Attribute_Id (N : Name_Id) return Attribute_Id is - begin - return Attribute_Id'Val (N - First_Attribute_Name); - end Get_Attribute_Id; - - ------------------ - -- Get_Check_Id -- - ------------------ - - function Get_Check_Id (N : Name_Id) return Check_Id is - begin - return Check_Id'Val (N - First_Check_Name); - end Get_Check_Id; - - ----------------------- - -- Get_Convention_Id -- - ----------------------- - - function Get_Convention_Id (N : Name_Id) return Convention_Id is - begin - case N is - when Name_Ada => return Convention_Ada; - when Name_Assembler => return Convention_Assembler; - when Name_C => return Convention_C; - when Name_COBOL => return Convention_COBOL; - when Name_CPP => return Convention_CPP; - when Name_Fortran => return Convention_Fortran; - when Name_Intrinsic => return Convention_Intrinsic; - when Name_Java => return Convention_Java; - when Name_Stdcall => return Convention_Stdcall; - when Name_Stubbed => return Convention_Stubbed; - - -- If no direct match, then we must have a convention - -- identifier pragma that has specified this name. - - when others => - for J in 1 .. Convention_Identifiers.Last loop - if N = Convention_Identifiers.Table (J).Name then - return Convention_Identifiers.Table (J).Convention; - end if; - end loop; - - raise Program_Error; - end case; - end Get_Convention_Id; - - --------------------------- - -- Get_Locking_Policy_Id -- - --------------------------- - - function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id is - begin - return Locking_Policy_Id'Val (N - First_Locking_Policy_Name); - end Get_Locking_Policy_Id; - - ------------------- - -- Get_Pragma_Id -- - ------------------- - - function Get_Pragma_Id (N : Name_Id) return Pragma_Id is - begin - if N = Name_AST_Entry then - return Pragma_AST_Entry; - elsif N = Name_Storage_Size then - return Pragma_Storage_Size; - elsif N = Name_Storage_Unit then - return Pragma_Storage_Unit; - elsif N not in First_Pragma_Name .. Last_Pragma_Name then - return Unknown_Pragma; - else - return Pragma_Id'Val (N - First_Pragma_Name); - end if; - end Get_Pragma_Id; - - --------------------------- - -- Get_Queuing_Policy_Id -- - --------------------------- - - function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id is - begin - return Queuing_Policy_Id'Val (N - First_Queuing_Policy_Name); - end Get_Queuing_Policy_Id; - - ------------------------------------ - -- Get_Task_Dispatching_Policy_Id -- - ------------------------------------ - - function Get_Task_Dispatching_Policy_Id (N : Name_Id) - return Task_Dispatching_Policy_Id is - begin - return Task_Dispatching_Policy_Id'Val - (N - First_Task_Dispatching_Policy_Name); - end Get_Task_Dispatching_Policy_Id; - - ---------------- - -- Initialize -- - ---------------- - - procedure Initialize is - P_Index : Natural; - Discard_Name : Name_Id; - - begin - P_Index := Preset_Names'First; - - loop - Name_Len := 0; - - while Preset_Names (P_Index) /= '#' loop - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := Preset_Names (P_Index); - P_Index := P_Index + 1; - end loop; - - -- We do the Name_Find call to enter the name into the table, but - -- we don't need to do anything with the result, since we already - -- initialized all the preset names to have the right value (we - -- are depending on the order of the names and Preset_Names). - - Discard_Name := Name_Find; - P_Index := P_Index + 1; - exit when Preset_Names (P_Index) = '#'; - end loop; - - -- Make sure that number of names in standard table is correct. If - -- this check fails, run utility program XSNAMES to construct a new - -- properly matching version of the body. - - pragma Assert (Discard_Name = Last_Predefined_Name); - - -- Initialize the convention identifiers table with the standard - -- set of synonyms that we recognize for conventions. - - Convention_Identifiers.Init; - - Convention_Identifiers.Append ((Name_Asm, Convention_Assembler)); - Convention_Identifiers.Append ((Name_Assembly, Convention_Assembler)); - - Convention_Identifiers.Append ((Name_Default, Convention_C)); - Convention_Identifiers.Append ((Name_External, Convention_C)); - - Convention_Identifiers.Append ((Name_DLL, Convention_Stdcall)); - Convention_Identifiers.Append ((Name_Win32, Convention_Stdcall)); - end Initialize; - - ----------------------- - -- Is_Attribute_Name -- - ----------------------- - - function Is_Attribute_Name (N : Name_Id) return Boolean is - begin - return N in First_Attribute_Name .. Last_Attribute_Name; - end Is_Attribute_Name; - - ------------------- - -- Is_Check_Name -- - ------------------- - - function Is_Check_Name (N : Name_Id) return Boolean is - begin - return N in First_Check_Name .. Last_Check_Name; - end Is_Check_Name; - - ------------------------ - -- Is_Convention_Name -- - ------------------------ - - function Is_Convention_Name (N : Name_Id) return Boolean is - begin - -- Check if this is one of the standard conventions - - if N in First_Convention_Name .. Last_Convention_Name - or else N = Name_C - then - return True; - - -- Otherwise check if it is in convention identifier table - - else - for J in 1 .. Convention_Identifiers.Last loop - if N = Convention_Identifiers.Table (J).Name then - return True; - end if; - end loop; - - return False; - end if; - end Is_Convention_Name; - - ------------------------------ - -- Is_Entity_Attribute_Name -- - ------------------------------ - - function Is_Entity_Attribute_Name (N : Name_Id) return Boolean is - begin - return N in First_Entity_Attribute_Name .. Last_Entity_Attribute_Name; - end Is_Entity_Attribute_Name; - - -------------------------------- - -- Is_Function_Attribute_Name -- - -------------------------------- - - function Is_Function_Attribute_Name (N : Name_Id) return Boolean is - begin - return N in - First_Renamable_Function_Attribute .. - Last_Renamable_Function_Attribute; - end Is_Function_Attribute_Name; - - ---------------------------- - -- Is_Locking_Policy_Name -- - ---------------------------- - - function Is_Locking_Policy_Name (N : Name_Id) return Boolean is - begin - return N in First_Locking_Policy_Name .. Last_Locking_Policy_Name; - end Is_Locking_Policy_Name; - - ----------------------------- - -- Is_Operator_Symbol_Name -- - ----------------------------- - - function Is_Operator_Symbol_Name (N : Name_Id) return Boolean is - begin - return N in First_Operator_Name .. Last_Operator_Name; - end Is_Operator_Symbol_Name; - - -------------------- - -- Is_Pragma_Name -- - -------------------- - - function Is_Pragma_Name (N : Name_Id) return Boolean is - begin - return N in First_Pragma_Name .. Last_Pragma_Name - or else N = Name_AST_Entry - or else N = Name_Storage_Size - or else N = Name_Storage_Unit; - end Is_Pragma_Name; - - --------------------------------- - -- Is_Procedure_Attribute_Name -- - --------------------------------- - - function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean is - begin - return N in First_Procedure_Attribute .. Last_Procedure_Attribute; - end Is_Procedure_Attribute_Name; - - ---------------------------- - -- Is_Queuing_Policy_Name -- - ---------------------------- - - function Is_Queuing_Policy_Name (N : Name_Id) return Boolean is - begin - return N in First_Queuing_Policy_Name .. Last_Queuing_Policy_Name; - end Is_Queuing_Policy_Name; - - ------------------------------------- - -- Is_Task_Dispatching_Policy_Name -- - ------------------------------------- - - function Is_Task_Dispatching_Policy_Name (N : Name_Id) return Boolean is - begin - return N in First_Task_Dispatching_Policy_Name .. - Last_Task_Dispatching_Policy_Name; - end Is_Task_Dispatching_Policy_Name; - - ---------------------------- - -- Is_Type_Attribute_Name -- - ---------------------------- - - function Is_Type_Attribute_Name (N : Name_Id) return Boolean is - begin - return N in First_Type_Attribute_Name .. Last_Type_Attribute_Name; - end Is_Type_Attribute_Name; - - ---------------------------------- - -- Record_Convention_Identifier -- - ---------------------------------- - - procedure Record_Convention_Identifier - (Id : Name_Id; - Convention : Convention_Id) - is - begin - Convention_Identifiers.Append ((Id, Convention)); - end Record_Convention_Identifier; - -end Snames; +------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S N A M E S --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2003, 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- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
+-- MA 02111-1307, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with Namet; use Namet;
+with Table;
+
+package body Snames is
+
+ -- Table used to record convention identifiers
+
+ type Convention_Id_Entry is record
+ Name : Name_Id;
+ Convention : Convention_Id;
+ end record;
+
+ package Convention_Identifiers is new Table.Table (
+ Table_Component_Type => Convention_Id_Entry,
+ Table_Index_Type => Int,
+ Table_Low_Bound => 1,
+ Table_Initial => 50,
+ Table_Increment => 200,
+ Table_Name => "Name_Convention_Identifiers");
+
+ -- Table of names to be set by Initialize. Each name is terminated by a
+ -- single #, and the end of the list is marked by a null entry, i.e. by
+ -- two # marks in succession. Note that the table does not include the
+ -- entries for a-z, since these are initialized by Namet itself.
+
+ Preset_Names : constant String :=
+ "_parent#" &
+ "_tag#" &
+ "off#" &
+ "space#" &
+ "time#" &
+ "_abort_signal#" &
+ "_alignment#" &
+ "_assign#" &
+ "_chain#" &
+ "_clean#" &
+ "_controller#" &
+ "_entry_bodies#" &
+ "_expunge#" &
+ "_final_list#" &
+ "_idepth#" &
+ "_init#" &
+ "_local_final_list#" &
+ "_master#" &
+ "_object#" &
+ "_priority#" &
+ "_process_atsd#" &
+ "_secondary_stack#" &
+ "_service#" &
+ "_size#" &
+ "_tags#" &
+ "_task#" &
+ "_task_id#" &
+ "_task_info#" &
+ "_task_name#" &
+ "_trace_sp#" &
+ "initialize#" &
+ "adjust#" &
+ "finalize#" &
+ "next#" &
+ "prev#" &
+ "allocate#" &
+ "deallocate#" &
+ "dereference#" &
+ "decimal_io#" &
+ "enumeration_io#" &
+ "fixed_io#" &
+ "float_io#" &
+ "integer_io#" &
+ "modular_io#" &
+ "a_textio#" &
+ "a_witeio#" &
+ "const#" &
+ "<error>#" &
+ "go#" &
+ "put#" &
+ "put_line#" &
+ "to#" &
+ "finalization#" &
+ "finalization_root#" &
+ "interfaces#" &
+ "standard#" &
+ "system#" &
+ "text_io#" &
+ "wide_text_io#" &
+ "addr#" &
+ "async#" &
+ "get_active_partition_id#" &
+ "get_rci_package_receiver#" &
+ "origin#" &
+ "params#" &
+ "partition#" &
+ "partition_interface#" &
+ "ras#" &
+ "rci_name#" &
+ "receiver#" &
+ "result#" &
+ "rpc#" &
+ "subp_id#" &
+ "Oabs#" &
+ "Oand#" &
+ "Omod#" &
+ "Onot#" &
+ "Oor#" &
+ "Orem#" &
+ "Oxor#" &
+ "Oeq#" &
+ "One#" &
+ "Olt#" &
+ "Ole#" &
+ "Ogt#" &
+ "Oge#" &
+ "Oadd#" &
+ "Osubtract#" &
+ "Oconcat#" &
+ "Omultiply#" &
+ "Odivide#" &
+ "Oexpon#" &
+ "ada_83#" &
+ "ada_95#" &
+ "c_pass_by_copy#" &
+ "compile_time_warning#" &
+ "component_alignment#" &
+ "convention_identifier#" &
+ "discard_names#" &
+ "elaboration_checks#" &
+ "eliminate#" &
+ "explicit_overriding#" &
+ "extend_system#" &
+ "extensions_allowed#" &
+ "external_name_casing#" &
+ "float_representation#" &
+ "initialize_scalars#" &
+ "interrupt_state#" &
+ "license#" &
+ "locking_policy#" &
+ "long_float#" &
+ "no_run_time#" &
+ "normalize_scalars#" &
+ "polling#" &
+ "persistent_data#" &
+ "persistent_object#" &
+ "propagate_exceptions#" &
+ "queuing_policy#" &
+ "ravenscar#" &
+ "restricted_run_time#" &
+ "restrictions#" &
+ "restriction_warnings#" &
+ "reviewable#" &
+ "source_file_name#" &
+ "source_file_name_project#" &
+ "style_checks#" &
+ "suppress#" &
+ "suppress_exception_locations#" &
+ "task_dispatching_policy#" &
+ "universal_data#" &
+ "unsuppress#" &
+ "use_vads_size#" &
+ "validity_checks#" &
+ "warnings#" &
+ "abort_defer#" &
+ "all_calls_remote#" &
+ "annotate#" &
+ "assert#" &
+ "asynchronous#" &
+ "atomic#" &
+ "atomic_components#" &
+ "attach_handler#" &
+ "comment#" &
+ "common_object#" &
+ "complex_representation#" &
+ "controlled#" &
+ "convention#" &
+ "cpp_class#" &
+ "cpp_constructor#" &
+ "cpp_virtual#" &
+ "cpp_vtable#" &
+ "debug#" &
+ "elaborate#" &
+ "elaborate_all#" &
+ "elaborate_body#" &
+ "export#" &
+ "export_exception#" &
+ "export_function#" &
+ "export_object#" &
+ "export_procedure#" &
+ "export_value#" &
+ "export_valued_procedure#" &
+ "external#" &
+ "finalize_storage_only#" &
+ "ident#" &
+ "import#" &
+ "import_exception#" &
+ "import_function#" &
+ "import_object#" &
+ "import_procedure#" &
+ "import_valued_procedure#" &
+ "inline#" &
+ "inline_always#" &
+ "inline_generic#" &
+ "inspection_point#" &
+ "interface#" &
+ "interface_name#" &
+ "interrupt_handler#" &
+ "interrupt_priority#" &
+ "java_constructor#" &
+ "java_interface#" &
+ "keep_names#" &
+ "link_with#" &
+ "linker_alias#" &
+ "linker_options#" &
+ "linker_section#" &
+ "list#" &
+ "machine_attribute#" &
+ "main#" &
+ "main_storage#" &
+ "memory_size#" &
+ "no_return#" &
+ "obsolescent#" &
+ "optimize#" &
+ "optional_overriding#" &
+ "overriding#" &
+ "pack#" &
+ "page#" &
+ "passive#" &
+ "preelaborate#" &
+ "priority#" &
+ "psect_object#" &
+ "pure#" &
+ "pure_function#" &
+ "remote_call_interface#" &
+ "remote_types#" &
+ "share_generic#" &
+ "shared#" &
+ "shared_passive#" &
+ "source_reference#" &
+ "stream_convert#" &
+ "subtitle#" &
+ "suppress_all#" &
+ "suppress_debug_info#" &
+ "suppress_initialization#" &
+ "system_name#" &
+ "task_info#" &
+ "task_name#" &
+ "task_storage#" &
+ "thread_body#" &
+ "time_slice#" &
+ "title#" &
+ "unchecked_union#" &
+ "unimplemented_unit#" &
+ "unreferenced#" &
+ "unreserve_all_interrupts#" &
+ "volatile#" &
+ "volatile_components#" &
+ "weak_external#" &
+ "ada#" &
+ "assembler#" &
+ "cobol#" &
+ "cpp#" &
+ "fortran#" &
+ "intrinsic#" &
+ "java#" &
+ "stdcall#" &
+ "stubbed#" &
+ "asm#" &
+ "assembly#" &
+ "default#" &
+ "dll#" &
+ "win32#" &
+ "as_is#" &
+ "body_file_name#" &
+ "casing#" &
+ "code#" &
+ "component#" &
+ "component_size_4#" &
+ "copy#" &
+ "d_float#" &
+ "descriptor#" &
+ "dot_replacement#" &
+ "dynamic#" &
+ "entity#" &
+ "external_name#" &
+ "first_optional_parameter#" &
+ "form#" &
+ "g_float#" &
+ "gcc#" &
+ "gnat#" &
+ "gpl#" &
+ "ieee_float#" &
+ "homonym_number#" &
+ "internal#" &
+ "link_name#" &
+ "lowercase#" &
+ "max_size#" &
+ "mechanism#" &
+ "mixedcase#" &
+ "modified_gpl#" &
+ "name#" &
+ "nca#" &
+ "no#" &
+ "on#" &
+ "parameter_types#" &
+ "reference#" &
+ "restricted#" &
+ "result_mechanism#" &
+ "result_type#" &
+ "runtime#" &
+ "sb#" &
+ "secondary_stack_size#" &
+ "section#" &
+ "semaphore#" &
+ "spec_file_name#" &
+ "static#" &
+ "stack_size#" &
+ "subunit_file_name#" &
+ "task_stack_size_default#" &
+ "task_type#" &
+ "time_slicing_enabled#" &
+ "top_guard#" &
+ "uba#" &
+ "ubs#" &
+ "ubsb#" &
+ "unit_name#" &
+ "unknown#" &
+ "unrestricted#" &
+ "uppercase#" &
+ "user#" &
+ "vax_float#" &
+ "vms#" &
+ "working_storage#" &
+ "abort_signal#" &
+ "access#" &
+ "address#" &
+ "address_size#" &
+ "aft#" &
+ "alignment#" &
+ "asm_input#" &
+ "asm_output#" &
+ "ast_entry#" &
+ "bit#" &
+ "bit_order#" &
+ "bit_position#" &
+ "body_version#" &
+ "callable#" &
+ "caller#" &
+ "code_address#" &
+ "component_size#" &
+ "compose#" &
+ "constrained#" &
+ "count#" &
+ "default_bit_order#" &
+ "definite#" &
+ "delta#" &
+ "denorm#" &
+ "digits#" &
+ "elaborated#" &
+ "emax#" &
+ "enum_rep#" &
+ "epsilon#" &
+ "exponent#" &
+ "external_tag#" &
+ "first#" &
+ "first_bit#" &
+ "fixed_value#" &
+ "fore#" &
+ "has_discriminants#" &
+ "identity#" &
+ "img#" &
+ "integer_value#" &
+ "large#" &
+ "last#" &
+ "last_bit#" &
+ "leading_part#" &
+ "length#" &
+ "machine_emax#" &
+ "machine_emin#" &
+ "machine_mantissa#" &
+ "machine_overflows#" &
+ "machine_radix#" &
+ "machine_rounds#" &
+ "machine_size#" &
+ "mantissa#" &
+ "max_size_in_storage_elements#" &
+ "maximum_alignment#" &
+ "mechanism_code#" &
+ "model_emin#" &
+ "model_epsilon#" &
+ "model_mantissa#" &
+ "model_small#" &
+ "modulus#" &
+ "null_parameter#" &
+ "object_size#" &
+ "partition_id#" &
+ "passed_by_reference#" &
+ "pool_address#" &
+ "pos#" &
+ "position#" &
+ "range#" &
+ "range_length#" &
+ "round#" &
+ "safe_emax#" &
+ "safe_first#" &
+ "safe_large#" &
+ "safe_last#" &
+ "safe_small#" &
+ "scale#" &
+ "scaling#" &
+ "signed_zeros#" &
+ "size#" &
+ "small#" &
+ "storage_size#" &
+ "storage_unit#" &
+ "tag#" &
+ "target_name#" &
+ "terminated#" &
+ "to_address#" &
+ "type_class#" &
+ "uet_address#" &
+ "unbiased_rounding#" &
+ "unchecked_access#" &
+ "unconstrained_array#" &
+ "universal_literal_string#" &
+ "unrestricted_access#" &
+ "vads_size#" &
+ "val#" &
+ "valid#" &
+ "value_size#" &
+ "version#" &
+ "wchar_t_size#" &
+ "wide_width#" &
+ "width#" &
+ "word_size#" &
+ "adjacent#" &
+ "ceiling#" &
+ "copy_sign#" &
+ "floor#" &
+ "fraction#" &
+ "image#" &
+ "input#" &
+ "machine#" &
+ "max#" &
+ "min#" &
+ "model#" &
+ "pred#" &
+ "remainder#" &
+ "rounding#" &
+ "succ#" &
+ "truncation#" &
+ "value#" &
+ "wide_image#" &
+ "wide_value#" &
+ "output#" &
+ "read#" &
+ "write#" &
+ "elab_body#" &
+ "elab_spec#" &
+ "storage_pool#" &
+ "base#" &
+ "class#" &
+ "ceiling_locking#" &
+ "inheritance_locking#" &
+ "fifo_queuing#" &
+ "priority_queuing#" &
+ "fifo_within_priorities#" &
+ "access_check#" &
+ "accessibility_check#" &
+ "discriminant_check#" &
+ "division_check#" &
+ "elaboration_check#" &
+ "index_check#" &
+ "length_check#" &
+ "overflow_check#" &
+ "range_check#" &
+ "storage_check#" &
+ "tag_check#" &
+ "all_checks#" &
+ "abort#" &
+ "abs#" &
+ "accept#" &
+ "and#" &
+ "all#" &
+ "array#" &
+ "at#" &
+ "begin#" &
+ "body#" &
+ "case#" &
+ "constant#" &
+ "declare#" &
+ "delay#" &
+ "do#" &
+ "else#" &
+ "elsif#" &
+ "end#" &
+ "entry#" &
+ "exception#" &
+ "exit#" &
+ "for#" &
+ "function#" &
+ "generic#" &
+ "goto#" &
+ "if#" &
+ "in#" &
+ "is#" &
+ "limited#" &
+ "loop#" &
+ "mod#" &
+ "new#" &
+ "not#" &
+ "null#" &
+ "of#" &
+ "or#" &
+ "others#" &
+ "out#" &
+ "package#" &
+ "pragma#" &
+ "private#" &
+ "procedure#" &
+ "raise#" &
+ "record#" &
+ "rem#" &
+ "renames#" &
+ "return#" &
+ "reverse#" &
+ "select#" &
+ "separate#" &
+ "subtype#" &
+ "task#" &
+ "terminate#" &
+ "then#" &
+ "type#" &
+ "use#" &
+ "when#" &
+ "while#" &
+ "with#" &
+ "xor#" &
+ "divide#" &
+ "enclosing_entity#" &
+ "exception_information#" &
+ "exception_message#" &
+ "exception_name#" &
+ "file#" &
+ "import_address#" &
+ "import_largest_value#" &
+ "import_value#" &
+ "is_negative#" &
+ "line#" &
+ "rotate_left#" &
+ "rotate_right#" &
+ "shift_left#" &
+ "shift_right#" &
+ "shift_right_arithmetic#" &
+ "source_location#" &
+ "unchecked_conversion#" &
+ "unchecked_deallocation#" &
+ "to_pointer#" &
+ "abstract#" &
+ "aliased#" &
+ "protected#" &
+ "until#" &
+ "requeue#" &
+ "tagged#" &
+ "raise_exception#" &
+ "binder#" &
+ "body_suffix#" &
+ "builder#" &
+ "compiler#" &
+ "cross_reference#" &
+ "default_switches#" &
+ "exec_dir#" &
+ "executable#" &
+ "executable_suffix#" &
+ "extends#" &
+ "finder#" &
+ "global_configuration_pragmas#" &
+ "gnatls#" &
+ "gnatstub#" &
+ "implementation#" &
+ "implementation_exceptions#" &
+ "implementation_suffix#" &
+ "languages#" &
+ "library_dir#" &
+ "library_auto_init#" &
+ "library_gcc#" &
+ "library_interface#" &
+ "library_kind#" &
+ "library_name#" &
+ "library_options#" &
+ "library_src_dir#" &
+ "library_symbol_file#" &
+ "library_version#" &
+ "linker#" &
+ "local_configuration_pragmas#" &
+ "locally_removed_files#" &
+ "naming#" &
+ "object_dir#" &
+ "pretty_printer#" &
+ "project#" &
+ "separate_suffix#" &
+ "source_dirs#" &
+ "source_files#" &
+ "source_list_file#" &
+ "spec#" &
+ "spec_suffix#" &
+ "specification#" &
+ "specification_exceptions#" &
+ "specification_suffix#" &
+ "switches#" &
+ "unaligned_valid#" &
+ "#";
+
+ ---------------------
+ -- Generated Names --
+ ---------------------
+
+ -- This section lists the various cases of generated names which are
+ -- built from existing names by adding unique leading and/or trailing
+ -- upper case letters. In some cases these names are built recursively,
+ -- in particular names built from types may be built from types which
+ -- themselves have generated names. In this list, xxx represents an
+ -- existing name to which identifying letters are prepended or appended,
+ -- and a trailing n represents a serial number in an external name that
+ -- has some semantic significance (e.g. the n'th index type of an array).
+
+ -- xxxA access type for formal xxx in entry param record (Exp_Ch9)
+ -- xxxB tag table for tagged type xxx (Exp_Ch3)
+ -- xxxB task body procedure for task xxx (Exp_Ch9)
+ -- xxxD dispatch table for tagged type xxx (Exp_Ch3)
+ -- xxxD discriminal for discriminant xxx (Sem_Ch3)
+ -- xxxDn n'th discr check function for rec type xxx (Exp_Ch3)
+ -- xxxE elaboration boolean flag for task xxx (Exp_Ch9)
+ -- xxxE dispatch table pointer type for tagged type xxx (Exp_Ch3)
+ -- xxxE parameters for accept body for entry xxx (Exp_Ch9)
+ -- xxxFn n'th primitive of a tagged type (named xxx) (Exp_Ch3)
+ -- xxxJ tag table type index for tagged type xxx (Exp_Ch3)
+ -- xxxM master Id value for access type xxx (Exp_Ch3)
+ -- xxxP tag table pointer type for tagged type xxx (Exp_Ch3)
+ -- xxxP parameter record type for entry xxx (Exp_Ch9)
+ -- xxxPA access to parameter record type for entry xxx (Exp_Ch9)
+ -- xxxPn pointer type for n'th primitive of tagged type xxx (Exp_Ch3)
+ -- xxxR dispatch table pointer for tagged type xxx (Exp_Ch3)
+ -- xxxT tag table type for tagged type xxx (Exp_Ch3)
+ -- xxxT literal table for enumeration type xxx (Sem_Ch3)
+ -- xxxV type for task value record for task xxx (Exp_Ch9)
+ -- xxxX entry index constant (Exp_Ch9)
+ -- xxxY dispatch table type for tagged type xxx (Exp_Ch3)
+ -- xxxZ size variable for task xxx (Exp_Ch9)
+
+ -- TSS names
+
+ -- xxxDA deep adjust routine for type xxx (Exp_TSS)
+ -- xxxDF deep finalize routine for type xxx (Exp_TSS)
+ -- xxxDI deep initialize routine for type xxx (Exp_TSS)
+ -- xxxEQ composite equality routine for record type xxx (Exp_TSS)
+ -- xxxIP initialization procedure for type xxx (Exp_TSS)
+ -- xxxRA RAs type access routine for type xxx (Exp_TSS)
+ -- xxxRD RAs type dereference routine for type xxx (Exp_TSS)
+ -- xxxRP Rep to Pos conversion for enumeration type xxx (Exp_TSS)
+ -- xxxSI stream input attribute subprogram for type xxx (Exp_TSS)
+ -- xxxSO stream output attribute subprogram for type xxx (Exp_TSS)
+ -- xxxSR stream read attribute subprogram for type xxx (Exp_TSS)
+ -- xxxSW stream write attribute subprogram for type xxx (Exp_TSS)
+
+ -- Implicit type names
+
+ -- TxxxT type of literal table for enumeration type xxx (Sem_Ch3)
+
+ -- (Note: this list is not complete or accurate ???)
+
+ ----------------------
+ -- Get_Attribute_Id --
+ ----------------------
+
+ function Get_Attribute_Id (N : Name_Id) return Attribute_Id is
+ begin
+ return Attribute_Id'Val (N - First_Attribute_Name);
+ end Get_Attribute_Id;
+
+ ------------------
+ -- Get_Check_Id --
+ ------------------
+
+ function Get_Check_Id (N : Name_Id) return Check_Id is
+ begin
+ return Check_Id'Val (N - First_Check_Name);
+ end Get_Check_Id;
+
+ -----------------------
+ -- Get_Convention_Id --
+ -----------------------
+
+ function Get_Convention_Id (N : Name_Id) return Convention_Id is
+ begin
+ case N is
+ when Name_Ada => return Convention_Ada;
+ when Name_Assembler => return Convention_Assembler;
+ when Name_C => return Convention_C;
+ when Name_COBOL => return Convention_COBOL;
+ when Name_CPP => return Convention_CPP;
+ when Name_Fortran => return Convention_Fortran;
+ when Name_Intrinsic => return Convention_Intrinsic;
+ when Name_Java => return Convention_Java;
+ when Name_Stdcall => return Convention_Stdcall;
+ when Name_Stubbed => return Convention_Stubbed;
+
+ -- If no direct match, then we must have a convention
+ -- identifier pragma that has specified this name.
+
+ when others =>
+ for J in 1 .. Convention_Identifiers.Last loop
+ if N = Convention_Identifiers.Table (J).Name then
+ return Convention_Identifiers.Table (J).Convention;
+ end if;
+ end loop;
+
+ raise Program_Error;
+ end case;
+ end Get_Convention_Id;
+
+ ---------------------------
+ -- Get_Locking_Policy_Id --
+ ---------------------------
+
+ function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id is
+ begin
+ return Locking_Policy_Id'Val (N - First_Locking_Policy_Name);
+ end Get_Locking_Policy_Id;
+
+ -------------------
+ -- Get_Pragma_Id --
+ -------------------
+
+ function Get_Pragma_Id (N : Name_Id) return Pragma_Id is
+ begin
+ if N = Name_AST_Entry then
+ return Pragma_AST_Entry;
+ elsif N = Name_Storage_Size then
+ return Pragma_Storage_Size;
+ elsif N = Name_Storage_Unit then
+ return Pragma_Storage_Unit;
+ elsif N not in First_Pragma_Name .. Last_Pragma_Name then
+ return Unknown_Pragma;
+ else
+ return Pragma_Id'Val (N - First_Pragma_Name);
+ end if;
+ end Get_Pragma_Id;
+
+ ---------------------------
+ -- Get_Queuing_Policy_Id --
+ ---------------------------
+
+ function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id is
+ begin
+ return Queuing_Policy_Id'Val (N - First_Queuing_Policy_Name);
+ end Get_Queuing_Policy_Id;
+
+ ------------------------------------
+ -- Get_Task_Dispatching_Policy_Id --
+ ------------------------------------
+
+ function Get_Task_Dispatching_Policy_Id (N : Name_Id)
+ return Task_Dispatching_Policy_Id is
+ begin
+ return Task_Dispatching_Policy_Id'Val
+ (N - First_Task_Dispatching_Policy_Name);
+ end Get_Task_Dispatching_Policy_Id;
+
+ ----------------
+ -- Initialize --
+ ----------------
+
+ procedure Initialize is
+ P_Index : Natural;
+ Discard_Name : Name_Id;
+
+ begin
+ P_Index := Preset_Names'First;
+
+ loop
+ Name_Len := 0;
+
+ while Preset_Names (P_Index) /= '#' loop
+ Name_Len := Name_Len + 1;
+ Name_Buffer (Name_Len) := Preset_Names (P_Index);
+ P_Index := P_Index + 1;
+ end loop;
+
+ -- We do the Name_Find call to enter the name into the table, but
+ -- we don't need to do anything with the result, since we already
+ -- initialized all the preset names to have the right value (we
+ -- are depending on the order of the names and Preset_Names).
+
+ Discard_Name := Name_Find;
+ P_Index := P_Index + 1;
+ exit when Preset_Names (P_Index) = '#';
+ end loop;
+
+ -- Make sure that number of names in standard table is correct. If
+ -- this check fails, run utility program XSNAMES to construct a new
+ -- properly matching version of the body.
+
+ pragma Assert (Discard_Name = Last_Predefined_Name);
+
+ -- Initialize the convention identifiers table with the standard
+ -- set of synonyms that we recognize for conventions.
+
+ Convention_Identifiers.Init;
+
+ Convention_Identifiers.Append ((Name_Asm, Convention_Assembler));
+ Convention_Identifiers.Append ((Name_Assembly, Convention_Assembler));
+
+ Convention_Identifiers.Append ((Name_Default, Convention_C));
+ Convention_Identifiers.Append ((Name_External, Convention_C));
+
+ Convention_Identifiers.Append ((Name_DLL, Convention_Stdcall));
+ Convention_Identifiers.Append ((Name_Win32, Convention_Stdcall));
+ end Initialize;
+
+ -----------------------
+ -- Is_Attribute_Name --
+ -----------------------
+
+ function Is_Attribute_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Attribute_Name .. Last_Attribute_Name;
+ end Is_Attribute_Name;
+
+ -------------------
+ -- Is_Check_Name --
+ -------------------
+
+ function Is_Check_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Check_Name .. Last_Check_Name;
+ end Is_Check_Name;
+
+ ------------------------
+ -- Is_Convention_Name --
+ ------------------------
+
+ function Is_Convention_Name (N : Name_Id) return Boolean is
+ begin
+ -- Check if this is one of the standard conventions
+
+ if N in First_Convention_Name .. Last_Convention_Name
+ or else N = Name_C
+ then
+ return True;
+
+ -- Otherwise check if it is in convention identifier table
+
+ else
+ for J in 1 .. Convention_Identifiers.Last loop
+ if N = Convention_Identifiers.Table (J).Name then
+ return True;
+ end if;
+ end loop;
+
+ return False;
+ end if;
+ end Is_Convention_Name;
+
+ ------------------------------
+ -- Is_Entity_Attribute_Name --
+ ------------------------------
+
+ function Is_Entity_Attribute_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Entity_Attribute_Name .. Last_Entity_Attribute_Name;
+ end Is_Entity_Attribute_Name;
+
+ --------------------------------
+ -- Is_Function_Attribute_Name --
+ --------------------------------
+
+ function Is_Function_Attribute_Name (N : Name_Id) return Boolean is
+ begin
+ return N in
+ First_Renamable_Function_Attribute ..
+ Last_Renamable_Function_Attribute;
+ end Is_Function_Attribute_Name;
+
+ ----------------------------
+ -- Is_Locking_Policy_Name --
+ ----------------------------
+
+ function Is_Locking_Policy_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Locking_Policy_Name .. Last_Locking_Policy_Name;
+ end Is_Locking_Policy_Name;
+
+ -----------------------------
+ -- Is_Operator_Symbol_Name --
+ -----------------------------
+
+ function Is_Operator_Symbol_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Operator_Name .. Last_Operator_Name;
+ end Is_Operator_Symbol_Name;
+
+ --------------------
+ -- Is_Pragma_Name --
+ --------------------
+
+ function Is_Pragma_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Pragma_Name .. Last_Pragma_Name
+ or else N = Name_AST_Entry
+ or else N = Name_Storage_Size
+ or else N = Name_Storage_Unit;
+ end Is_Pragma_Name;
+
+ ---------------------------------
+ -- Is_Procedure_Attribute_Name --
+ ---------------------------------
+
+ function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Procedure_Attribute .. Last_Procedure_Attribute;
+ end Is_Procedure_Attribute_Name;
+
+ ----------------------------
+ -- Is_Queuing_Policy_Name --
+ ----------------------------
+
+ function Is_Queuing_Policy_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Queuing_Policy_Name .. Last_Queuing_Policy_Name;
+ end Is_Queuing_Policy_Name;
+
+ -------------------------------------
+ -- Is_Task_Dispatching_Policy_Name --
+ -------------------------------------
+
+ function Is_Task_Dispatching_Policy_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Task_Dispatching_Policy_Name ..
+ Last_Task_Dispatching_Policy_Name;
+ end Is_Task_Dispatching_Policy_Name;
+
+ ----------------------------
+ -- Is_Type_Attribute_Name --
+ ----------------------------
+
+ function Is_Type_Attribute_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Type_Attribute_Name .. Last_Type_Attribute_Name;
+ end Is_Type_Attribute_Name;
+
+ ----------------------------------
+ -- Record_Convention_Identifier --
+ ----------------------------------
+
+ procedure Record_Convention_Identifier
+ (Id : Name_Id;
+ Convention : Convention_Id)
+ is
+ begin
+ Convention_Identifiers.Append ((Id, Convention));
+ end Record_Convention_Identifier;
+
+end Snames;
diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads index 3d1705e..e7ce941 100644 --- a/gcc/ada/snames.ads +++ b/gcc/ada/snames.ads @@ -1,1410 +1,1415 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S N A M E S -- --- -- --- S p e c -- --- -- --- Copyright (C) 1992-2003, 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- -- --- ware Foundation; either version 2, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- --- -- --- As a special exception, if other files instantiate generics from this -- --- unit, or you link this unit with other files to produce an executable, -- --- this unit does not by itself cause the resulting executable to be -- --- covered by the GNU General Public License. This exception does not -- --- however invalidate any other reasons why the executable file might be -- --- covered by the GNU Public License. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Types; use Types; - -package Snames is - --- This package contains definitions of standard names (i.e. entries in the --- Names table) that are used throughout the GNAT compiler). It also contains --- the definitions of some enumeration types whose definitions are tied to --- the order of these preset names. - --- WARNING: There is a C file, a-snames.h which duplicates some of the --- definitions in this file and must be kept properly synchronized. - - ------------------ - -- Preset Names -- - ------------------ - - -- The following are preset entries in the names table, which are - -- entered at the start of every compilation for easy access. Note - -- that the order of initialization of these names in the body must - -- be coordinated with the order of names in this table. - - -- Note: a name may not appear more than once in the following list. - -- If additional pragmas or attributes are introduced which might - -- otherwise cause a duplicate, then list it only once in this table, - -- and adjust the definition of the functions for testing for pragma - -- names and attribute names, and returning their ID values. Of course - -- everything is simpler if no such duplications occur! - - -- First we have the one character names used to optimize the lookup - -- process for one character identifiers (to avoid the hashing in this - -- case) There are a full 256 of these, but only the entries for lower - -- case and upper case letters have identifiers - - -- The lower case letter entries are used for one character identifiers - -- appearing in the source, for example in pragma Interface (C). - - Name_A : constant Name_Id := First_Name_Id + Character'Pos ('a'); - Name_B : constant Name_Id := First_Name_Id + Character'Pos ('b'); - Name_C : constant Name_Id := First_Name_Id + Character'Pos ('c'); - Name_D : constant Name_Id := First_Name_Id + Character'Pos ('d'); - Name_E : constant Name_Id := First_Name_Id + Character'Pos ('e'); - Name_F : constant Name_Id := First_Name_Id + Character'Pos ('f'); - Name_G : constant Name_Id := First_Name_Id + Character'Pos ('g'); - Name_H : constant Name_Id := First_Name_Id + Character'Pos ('h'); - Name_I : constant Name_Id := First_Name_Id + Character'Pos ('i'); - Name_J : constant Name_Id := First_Name_Id + Character'Pos ('j'); - Name_K : constant Name_Id := First_Name_Id + Character'Pos ('k'); - Name_L : constant Name_Id := First_Name_Id + Character'Pos ('l'); - Name_M : constant Name_Id := First_Name_Id + Character'Pos ('m'); - Name_N : constant Name_Id := First_Name_Id + Character'Pos ('n'); - Name_O : constant Name_Id := First_Name_Id + Character'Pos ('o'); - Name_P : constant Name_Id := First_Name_Id + Character'Pos ('p'); - Name_Q : constant Name_Id := First_Name_Id + Character'Pos ('q'); - Name_R : constant Name_Id := First_Name_Id + Character'Pos ('r'); - Name_S : constant Name_Id := First_Name_Id + Character'Pos ('s'); - Name_T : constant Name_Id := First_Name_Id + Character'Pos ('t'); - Name_U : constant Name_Id := First_Name_Id + Character'Pos ('u'); - Name_V : constant Name_Id := First_Name_Id + Character'Pos ('v'); - Name_W : constant Name_Id := First_Name_Id + Character'Pos ('w'); - Name_X : constant Name_Id := First_Name_Id + Character'Pos ('x'); - Name_Y : constant Name_Id := First_Name_Id + Character'Pos ('y'); - Name_Z : constant Name_Id := First_Name_Id + Character'Pos ('z'); - - -- The upper case letter entries are used by expander code for local - -- variables that do not require unique names (e.g. formal parameter - -- names in constructed procedures) - - Name_uA : constant Name_Id := First_Name_Id + Character'Pos ('A'); - Name_uB : constant Name_Id := First_Name_Id + Character'Pos ('B'); - Name_uC : constant Name_Id := First_Name_Id + Character'Pos ('C'); - Name_uD : constant Name_Id := First_Name_Id + Character'Pos ('D'); - Name_uE : constant Name_Id := First_Name_Id + Character'Pos ('E'); - Name_uF : constant Name_Id := First_Name_Id + Character'Pos ('F'); - Name_uG : constant Name_Id := First_Name_Id + Character'Pos ('G'); - Name_uH : constant Name_Id := First_Name_Id + Character'Pos ('H'); - Name_uI : constant Name_Id := First_Name_Id + Character'Pos ('I'); - Name_uJ : constant Name_Id := First_Name_Id + Character'Pos ('J'); - Name_uK : constant Name_Id := First_Name_Id + Character'Pos ('K'); - Name_uL : constant Name_Id := First_Name_Id + Character'Pos ('L'); - Name_uM : constant Name_Id := First_Name_Id + Character'Pos ('M'); - Name_uN : constant Name_Id := First_Name_Id + Character'Pos ('N'); - Name_uO : constant Name_Id := First_Name_Id + Character'Pos ('O'); - Name_uP : constant Name_Id := First_Name_Id + Character'Pos ('P'); - Name_uQ : constant Name_Id := First_Name_Id + Character'Pos ('Q'); - Name_uR : constant Name_Id := First_Name_Id + Character'Pos ('R'); - Name_uS : constant Name_Id := First_Name_Id + Character'Pos ('S'); - Name_uT : constant Name_Id := First_Name_Id + Character'Pos ('T'); - Name_uU : constant Name_Id := First_Name_Id + Character'Pos ('U'); - Name_uV : constant Name_Id := First_Name_Id + Character'Pos ('V'); - Name_uW : constant Name_Id := First_Name_Id + Character'Pos ('W'); - Name_uX : constant Name_Id := First_Name_Id + Character'Pos ('X'); - Name_uY : constant Name_Id := First_Name_Id + Character'Pos ('Y'); - Name_uZ : constant Name_Id := First_Name_Id + Character'Pos ('Z'); - - -- Note: the following table is read by the utility program XSNAMES and - -- its format should not be changed without coordinating with this program. - - N : constant Name_Id := First_Name_Id + 256; - -- Synonym used in standard name definitions - - -- Some names that are used by gigi, and whose definitions are reflected - -- in the C header file a-snames.h. They are placed at the start so that - -- the need to modify a-snames.h is minimized. - - Name_uParent : constant Name_Id := N + 000; - Name_uTag : constant Name_Id := N + 001; - Name_Off : constant Name_Id := N + 002; - Name_Space : constant Name_Id := N + 003; - Name_Time : constant Name_Id := N + 004; - - -- Some special names used by the expander. Note that the lower case u's - -- at the start of these names get translated to extra underscores. These - -- names are only referenced internally by expander generated code. - - Name_uAlignment : constant Name_Id := N + 005; - Name_uAbort_Signal : 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_uService : constant Name_Id := N + 020; - Name_uSize : constant Name_Id := N + 021; - Name_uTags : constant Name_Id := N + 022; - Name_uTask : constant Name_Id := N + 023; - Name_uTask_Id : constant Name_Id := N + 024; - Name_uTask_Info : constant Name_Id := N + 025; - Name_uTask_Name : constant Name_Id := N + 026; - Name_uTrace_Sp : constant Name_Id := N + 027; - - -- Names of routines in Ada.Finalization, needed by expander - - Name_Initialize : constant Name_Id := N + 028; - Name_Adjust : constant Name_Id := N + 029; - Name_Finalize : constant Name_Id := N + 030; - - -- Names of fields declared in System.Finalization_Implementation, - -- needed by the expander when generating code for finalization. - - Name_Next : constant Name_Id := N + 031; - Name_Prev : constant Name_Id := N + 032; - - -- Names of allocation routines, also needed by expander - - Name_Allocate : constant Name_Id := N + 033; - Name_Deallocate : constant Name_Id := N + 034; - Name_Dereference : constant Name_Id := N + 035; - - -- Names of Text_IO generic subpackages (see Rtsfind.Text_IO_Kludge) - - First_Text_IO_Package : constant Name_Id := N + 036; - Name_Decimal_IO : constant Name_Id := N + 036; - Name_Enumeration_IO : constant Name_Id := N + 037; - Name_Fixed_IO : constant Name_Id := N + 038; - Name_Float_IO : constant Name_Id := N + 039; - Name_Integer_IO : constant Name_Id := N + 040; - Name_Modular_IO : constant Name_Id := N + 041; - Last_Text_IO_Package : constant Name_Id := N + 041; - - 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 + 042; - Name_a_witeio : constant Name_Id := N + 043; - - -- Some miscellaneous names used for error detection/recovery - - Name_Const : constant Name_Id := N + 044; - Name_Error : constant Name_Id := N + 045; - Name_Go : constant Name_Id := N + 046; - Name_Put : constant Name_Id := N + 047; - Name_Put_Line : constant Name_Id := N + 048; - Name_To : constant Name_Id := N + 049; - - -- Names for packages that are treated specially by the compiler - - Name_Finalization : constant Name_Id := N + 050; - Name_Finalization_Root : constant Name_Id := N + 051; - Name_Interfaces : constant Name_Id := N + 052; - Name_Standard : constant Name_Id := N + 053; - Name_System : constant Name_Id := N + 054; - Name_Text_IO : constant Name_Id := N + 055; - Name_Wide_Text_IO : constant Name_Id := N + 056; - - -- Names of identifiers used in expanding distribution stubs - - Name_Addr : constant Name_Id := N + 057; - Name_Async : constant Name_Id := N + 058; - Name_Get_Active_Partition_ID : constant Name_Id := N + 059; - Name_Get_RCI_Package_Receiver : constant Name_Id := N + 060; - Name_Origin : constant Name_Id := N + 061; - Name_Params : constant Name_Id := N + 062; - Name_Partition : constant Name_Id := N + 063; - Name_Partition_Interface : constant Name_Id := N + 064; - Name_Ras : constant Name_Id := N + 065; - Name_RCI_Name : constant Name_Id := N + 066; - Name_Receiver : constant Name_Id := N + 067; - Name_Result : constant Name_Id := N + 068; - Name_Rpc : constant Name_Id := N + 069; - Name_Subp_Id : constant Name_Id := N + 070; - - -- 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 + 071; - Name_Op_Abs : constant Name_Id := N + 071; -- "abs" - Name_Op_And : constant Name_Id := N + 072; -- "and" - Name_Op_Mod : constant Name_Id := N + 073; -- "mod" - Name_Op_Not : constant Name_Id := N + 074; -- "not" - Name_Op_Or : constant Name_Id := N + 075; -- "or" - Name_Op_Rem : constant Name_Id := N + 076; -- "rem" - Name_Op_Xor : constant Name_Id := N + 077; -- "xor" - Name_Op_Eq : constant Name_Id := N + 078; -- "=" - Name_Op_Ne : constant Name_Id := N + 079; -- "/=" - Name_Op_Lt : constant Name_Id := N + 080; -- "<" - Name_Op_Le : constant Name_Id := N + 081; -- "<=" - Name_Op_Gt : constant Name_Id := N + 082; -- ">" - Name_Op_Ge : constant Name_Id := N + 083; -- ">=" - Name_Op_Add : constant Name_Id := N + 084; -- "+" - Name_Op_Subtract : constant Name_Id := N + 085; -- "-" - Name_Op_Concat : constant Name_Id := N + 086; -- "&" - Name_Op_Multiply : constant Name_Id := N + 087; -- "*" - Name_Op_Divide : constant Name_Id := N + 088; -- "/" - Name_Op_Expon : constant Name_Id := N + 089; -- "**" - Last_Operator_Name : constant Name_Id := N + 089; - - -- 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. - -- These pragmas are fully implemented in both Ada 83 and Ada 95 modes - -- in GNAT. - - -- The entries marked GNAT are pragmas that are defined by GNAT - -- and implemented in both Ada 83 and Ada 95 modes. Full descriptions - -- of these implementation dependent pragmas may be found in the - -- appropriate section in unit Sem_Prag in file sem-prag.adb. - - -- The entries marked VMS are VMS specific pragmas that are recognized - -- only in OpenVMS versions of GNAT. They are ignored in other versions - -- with an appropriate warning. - - -- The entries marked AAMP are AAMP specific pragmas that are recognized - -- only in GNAT for the AAMP. They are ignored in other versions with - -- appropriate warnings. - - First_Pragma_Name : constant Name_Id := N + 090; - - -- Configuration pragmas are grouped at start - - Name_Ada_83 : constant Name_Id := N + 090; -- GNAT - Name_Ada_95 : constant Name_Id := N + 091; -- GNAT - Name_C_Pass_By_Copy : constant Name_Id := N + 092; -- GNAT - Name_Compile_Time_Warning : constant Name_Id := N + 093; -- GNAT - Name_Component_Alignment : constant Name_Id := N + 094; -- GNAT - Name_Convention_Identifier : constant Name_Id := N + 095; -- GNAT - Name_Discard_Names : constant Name_Id := N + 096; - Name_Elaboration_Checks : constant Name_Id := N + 097; -- GNAT - Name_Eliminate : constant Name_Id := N + 098; -- GNAT - Name_Explicit_Overriding : constant Name_Id := N + 099; - Name_Extend_System : constant Name_Id := N + 100; -- GNAT - Name_Extensions_Allowed : constant Name_Id := N + 101; -- GNAT - Name_External_Name_Casing : constant Name_Id := N + 102; -- GNAT - Name_Float_Representation : constant Name_Id := N + 103; -- GNAT - Name_Initialize_Scalars : constant Name_Id := N + 104; -- GNAT - Name_Interrupt_State : constant Name_Id := N + 105; -- GNAT - Name_License : constant Name_Id := N + 106; -- GNAT - Name_Locking_Policy : constant Name_Id := N + 107; - Name_Long_Float : constant Name_Id := N + 108; -- VMS - Name_No_Run_Time : constant Name_Id := N + 109; -- GNAT - Name_Normalize_Scalars : constant Name_Id := N + 110; - Name_Polling : constant Name_Id := N + 111; -- GNAT - Name_Persistent_Data : constant Name_Id := N + 112; -- GNAT - Name_Persistent_Object : constant Name_Id := N + 113; -- GNAT - Name_Propagate_Exceptions : constant Name_Id := N + 114; -- GNAT - Name_Queuing_Policy : constant Name_Id := N + 115; - Name_Ravenscar : constant Name_Id := N + 116; - Name_Restricted_Run_Time : constant Name_Id := N + 117; - Name_Restrictions : constant Name_Id := N + 118; - Name_Restriction_Warnings : constant Name_Id := N + 119; -- GNAT - Name_Reviewable : constant Name_Id := N + 120; - Name_Source_File_Name : constant Name_Id := N + 121; -- GNAT - Name_Source_File_Name_Project : constant Name_Id := N + 122; -- GNAT - Name_Style_Checks : constant Name_Id := N + 123; -- GNAT - Name_Suppress : constant Name_Id := N + 124; - Name_Suppress_Exception_Locations : constant Name_Id := N + 125; -- GNAT - Name_Task_Dispatching_Policy : constant Name_Id := N + 126; - Name_Universal_Data : constant Name_Id := N + 127; -- AAMP - Name_Unsuppress : constant Name_Id := N + 128; -- GNAT - Name_Use_VADS_Size : constant Name_Id := N + 129; -- GNAT - Name_Validity_Checks : constant Name_Id := N + 130; -- GNAT - Name_Warnings : constant Name_Id := N + 131; -- GNAT - Last_Configuration_Pragma_Name : constant Name_Id := N + 131; - - -- Remaining pragma names - - Name_Abort_Defer : constant Name_Id := N + 132; -- GNAT - Name_All_Calls_Remote : constant Name_Id := N + 133; - Name_Annotate : constant Name_Id := N + 134; -- GNAT - - -- Note: AST_Entry is not in this list because its name matches the - -- name of the corresponding attribute. However, it is included in the - -- definition of the type Attribute_Id, and the functions Get_Pragma_Id - -- and Check_Pragma_Id correctly recognize and process Name_AST_Entry. - -- AST_Entry is a VMS specific pragma. - - Name_Assert : constant Name_Id := N + 135; -- GNAT - Name_Asynchronous : constant Name_Id := N + 136; - Name_Atomic : constant Name_Id := N + 137; - Name_Atomic_Components : constant Name_Id := N + 138; - Name_Attach_Handler : constant Name_Id := N + 139; - Name_Comment : constant Name_Id := N + 140; -- GNAT - Name_Common_Object : constant Name_Id := N + 141; -- GNAT - Name_Complex_Representation : constant Name_Id := N + 142; -- GNAT - Name_Controlled : constant Name_Id := N + 143; - Name_Convention : constant Name_Id := N + 144; - Name_CPP_Class : constant Name_Id := N + 145; -- GNAT - Name_CPP_Constructor : constant Name_Id := N + 146; -- GNAT - Name_CPP_Virtual : constant Name_Id := N + 147; -- GNAT - Name_CPP_Vtable : constant Name_Id := N + 148; -- GNAT - Name_Debug : constant Name_Id := N + 149; -- GNAT - Name_Elaborate : constant Name_Id := N + 150; -- Ada 83 - Name_Elaborate_All : constant Name_Id := N + 151; - Name_Elaborate_Body : constant Name_Id := N + 152; - Name_Export : constant Name_Id := N + 153; - Name_Export_Exception : constant Name_Id := N + 154; -- VMS - Name_Export_Function : constant Name_Id := N + 155; -- GNAT - Name_Export_Object : constant Name_Id := N + 156; -- GNAT - Name_Export_Procedure : constant Name_Id := N + 157; -- GNAT - Name_Export_Value : constant Name_Id := N + 158; -- GNAT - Name_Export_Valued_Procedure : constant Name_Id := N + 159; -- GNAT - Name_External : constant Name_Id := N + 160; -- GNAT - Name_Finalize_Storage_Only : constant Name_Id := N + 161; -- GNAT - Name_Ident : constant Name_Id := N + 162; -- VMS - Name_Import : constant Name_Id := N + 163; - Name_Import_Exception : constant Name_Id := N + 164; -- VMS - Name_Import_Function : constant Name_Id := N + 165; -- GNAT - Name_Import_Object : constant Name_Id := N + 166; -- GNAT - Name_Import_Procedure : constant Name_Id := N + 167; -- GNAT - Name_Import_Valued_Procedure : constant Name_Id := N + 168; -- GNAT - Name_Inline : constant Name_Id := N + 169; - Name_Inline_Always : constant Name_Id := N + 170; -- GNAT - Name_Inline_Generic : constant Name_Id := N + 171; -- GNAT - Name_Inspection_Point : constant Name_Id := N + 172; - Name_Interface : constant Name_Id := N + 173; -- Ada 83 - Name_Interface_Name : constant Name_Id := N + 174; -- GNAT - Name_Interrupt_Handler : constant Name_Id := N + 175; - Name_Interrupt_Priority : constant Name_Id := N + 176; - Name_Java_Constructor : constant Name_Id := N + 177; -- GNAT - Name_Java_Interface : constant Name_Id := N + 178; -- GNAT - Name_Keep_Names : constant Name_Id := N + 179; -- GNAT - Name_Link_With : constant Name_Id := N + 180; -- GNAT - Name_Linker_Alias : constant Name_Id := N + 181; -- GNAT - Name_Linker_Options : constant Name_Id := N + 182; - Name_Linker_Section : constant Name_Id := N + 183; -- GNAT - Name_List : constant Name_Id := N + 184; - Name_Machine_Attribute : constant Name_Id := N + 185; -- GNAT - Name_Main : constant Name_Id := N + 186; -- GNAT - Name_Main_Storage : constant Name_Id := N + 187; -- GNAT - Name_Memory_Size : constant Name_Id := N + 188; -- Ada 83 - Name_No_Return : constant Name_Id := N + 189; -- GNAT - Name_Obsolescent : constant Name_Id := N + 190; -- GNAT - Name_Optimize : constant Name_Id := N + 191; - Name_Optional_Overriding : constant Name_Id := N + 192; - Name_Overriding : constant Name_Id := N + 193; - Name_Pack : constant Name_Id := N + 194; - Name_Page : constant Name_Id := N + 195; - Name_Passive : constant Name_Id := N + 196; -- GNAT - Name_Preelaborate : constant Name_Id := N + 197; - Name_Priority : constant Name_Id := N + 198; - Name_Psect_Object : constant Name_Id := N + 199; -- VMS - Name_Pure : constant Name_Id := N + 200; - Name_Pure_Function : constant Name_Id := N + 201; -- GNAT - Name_Remote_Call_Interface : constant Name_Id := N + 202; - Name_Remote_Types : constant Name_Id := N + 203; - Name_Share_Generic : constant Name_Id := N + 204; -- GNAT - Name_Shared : constant Name_Id := N + 205; -- Ada 83 - Name_Shared_Passive : constant Name_Id := N + 206; - - -- Note: Storage_Size is not in this list because its name matches the - -- name of the corresponding attribute. However, it is included in the - -- definition of the type Attribute_Id, and the functions Get_Pragma_Id - -- and Check_Pragma_Id correctly recognize and process Name_Storage_Size. - - -- Note: Storage_Unit is also omitted from the list because of a clash - -- with an attribute name, and is treated similarly. - - Name_Source_Reference : constant Name_Id := N + 207; -- GNAT - Name_Stream_Convert : constant Name_Id := N + 208; -- GNAT - Name_Subtitle : constant Name_Id := N + 209; -- GNAT - Name_Suppress_All : constant Name_Id := N + 210; -- GNAT - Name_Suppress_Debug_Info : constant Name_Id := N + 211; -- GNAT - Name_Suppress_Initialization : constant Name_Id := N + 212; -- GNAT - Name_System_Name : constant Name_Id := N + 213; -- Ada 83 - Name_Task_Info : constant Name_Id := N + 214; -- GNAT - Name_Task_Name : constant Name_Id := N + 215; -- GNAT - Name_Task_Storage : constant Name_Id := N + 216; -- VMS - Name_Time_Slice : constant Name_Id := N + 217; -- GNAT - Name_Title : constant Name_Id := N + 218; -- GNAT - Name_Unchecked_Union : constant Name_Id := N + 219; -- GNAT - Name_Unimplemented_Unit : constant Name_Id := N + 220; -- GNAT - Name_Unreferenced : constant Name_Id := N + 221; -- GNAT - Name_Unreserve_All_Interrupts : constant Name_Id := N + 222; -- GNAT - Name_Volatile : constant Name_Id := N + 223; - Name_Volatile_Components : constant Name_Id := N + 224; - Name_Weak_External : constant Name_Id := N + 225; -- GNAT - Last_Pragma_Name : constant Name_Id := N + 225; - - -- Language convention names for pragma Convention/Export/Import/Interface - -- Note that Name_C is not included in this list, since it was already - -- declared earlier in the context of one-character identifier names - -- (where the order is critical to the fast look up process). - - -- Note: there are no convention names corresponding to the conventions - -- Entry and Protected, this is because these conventions cannot be - -- specified by a pragma. - - First_Convention_Name : constant Name_Id := N + 226; - Name_Ada : constant Name_Id := N + 226; - Name_Assembler : constant Name_Id := N + 227; - Name_COBOL : constant Name_Id := N + 228; - Name_CPP : constant Name_Id := N + 229; - Name_Fortran : constant Name_Id := N + 230; - Name_Intrinsic : constant Name_Id := N + 231; - Name_Java : constant Name_Id := N + 232; - Name_Stdcall : constant Name_Id := N + 233; - Name_Stubbed : constant Name_Id := N + 234; - Last_Convention_Name : constant Name_Id := N + 234; - - -- The following names are preset as synonyms for Assembler - - Name_Asm : constant Name_Id := N + 235; - Name_Assembly : constant Name_Id := N + 236; - - -- The following names are preset as synonyms for C - - Name_Default : constant Name_Id := N + 237; - -- Name_Exernal (previously defined as pragma) - - -- The following names are present as synonyms for Stdcall - - Name_DLL : constant Name_Id := N + 238; - Name_Win32 : constant Name_Id := N + 239; - - -- Other special names used in processing pragma arguments - - Name_As_Is : constant Name_Id := N + 240; - Name_Body_File_Name : constant Name_Id := N + 241; - Name_Casing : constant Name_Id := N + 242; - Name_Code : constant Name_Id := N + 243; - Name_Component : constant Name_Id := N + 244; - Name_Component_Size_4 : constant Name_Id := N + 245; - Name_Copy : constant Name_Id := N + 246; - Name_D_Float : constant Name_Id := N + 247; - Name_Descriptor : constant Name_Id := N + 248; - Name_Dot_Replacement : constant Name_Id := N + 249; - Name_Dynamic : constant Name_Id := N + 250; - Name_Entity : constant Name_Id := N + 251; - Name_External_Name : constant Name_Id := N + 252; - Name_First_Optional_Parameter : constant Name_Id := N + 253; - Name_Form : constant Name_Id := N + 254; - Name_G_Float : constant Name_Id := N + 255; - Name_Gcc : constant Name_Id := N + 256; - Name_Gnat : constant Name_Id := N + 257; - Name_GPL : constant Name_Id := N + 258; - Name_IEEE_Float : constant Name_Id := N + 259; - Name_Homonym_Number : constant Name_Id := N + 260; - Name_Internal : constant Name_Id := N + 261; - Name_Link_Name : constant Name_Id := N + 262; - Name_Lowercase : constant Name_Id := N + 263; - Name_Max_Size : constant Name_Id := N + 264; - Name_Mechanism : constant Name_Id := N + 265; - Name_Mixedcase : constant Name_Id := N + 266; - Name_Modified_GPL : constant Name_Id := N + 267; - Name_Name : constant Name_Id := N + 268; - Name_NCA : constant Name_Id := N + 269; - Name_No : constant Name_Id := N + 270; - Name_On : constant Name_Id := N + 271; - Name_Parameter_Types : constant Name_Id := N + 272; - Name_Reference : constant Name_Id := N + 273; - Name_Restricted : constant Name_Id := N + 274; - Name_Result_Mechanism : constant Name_Id := N + 275; - Name_Result_Type : constant Name_Id := N + 276; - Name_Runtime : constant Name_Id := N + 277; - Name_SB : constant Name_Id := N + 278; - Name_Section : constant Name_Id := N + 279; - Name_Semaphore : constant Name_Id := N + 280; - Name_Spec_File_Name : constant Name_Id := N + 281; - Name_Static : constant Name_Id := N + 282; - Name_Stack_Size : constant Name_Id := N + 283; - Name_Subunit_File_Name : constant Name_Id := N + 284; - Name_Task_Stack_Size_Default : constant Name_Id := N + 285; - Name_Task_Type : constant Name_Id := N + 286; - Name_Time_Slicing_Enabled : constant Name_Id := N + 287; - Name_Top_Guard : constant Name_Id := N + 288; - Name_UBA : constant Name_Id := N + 289; - Name_UBS : constant Name_Id := N + 290; - Name_UBSB : constant Name_Id := N + 291; - Name_Unit_Name : constant Name_Id := N + 292; - Name_Unknown : constant Name_Id := N + 293; - Name_Unrestricted : constant Name_Id := N + 294; - Name_Uppercase : constant Name_Id := N + 295; - Name_User : constant Name_Id := N + 296; - Name_VAX_Float : constant Name_Id := N + 297; - Name_VMS : constant Name_Id := N + 298; - Name_Working_Storage : constant Name_Id := N + 299; - - -- 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 - -- attributes are implemented in both Ada 83 and Ada 95 modes in GNAT. - - -- The entries marked GNAT are attributes that are defined by GNAT - -- and implemented in both Ada 83 and Ada 95 modes. Full descriptions - -- of these implementation dependent attributes may be found in the - -- appropriate section in package Sem_Attr in file sem-attr.ads. - - -- 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 + 300; - Name_Abort_Signal : constant Name_Id := N + 300; -- GNAT - Name_Access : constant Name_Id := N + 301; - Name_Address : constant Name_Id := N + 302; - Name_Address_Size : constant Name_Id := N + 303; -- GNAT - Name_Aft : constant Name_Id := N + 304; - Name_Alignment : constant Name_Id := N + 305; - Name_Asm_Input : constant Name_Id := N + 306; -- GNAT - Name_Asm_Output : constant Name_Id := N + 307; -- GNAT - Name_AST_Entry : constant Name_Id := N + 308; -- VMS - Name_Bit : constant Name_Id := N + 309; -- GNAT - Name_Bit_Order : constant Name_Id := N + 310; - Name_Bit_Position : constant Name_Id := N + 311; -- GNAT - Name_Body_Version : constant Name_Id := N + 312; - Name_Callable : constant Name_Id := N + 313; - Name_Caller : constant Name_Id := N + 314; - Name_Code_Address : constant Name_Id := N + 315; -- GNAT - Name_Component_Size : constant Name_Id := N + 316; - Name_Compose : constant Name_Id := N + 317; - Name_Constrained : constant Name_Id := N + 318; - Name_Count : constant Name_Id := N + 319; - Name_Default_Bit_Order : constant Name_Id := N + 320; -- GNAT - Name_Definite : constant Name_Id := N + 321; - Name_Delta : constant Name_Id := N + 322; - Name_Denorm : constant Name_Id := N + 323; - Name_Digits : constant Name_Id := N + 324; - Name_Elaborated : constant Name_Id := N + 325; -- GNAT - Name_Emax : constant Name_Id := N + 326; -- Ada 83 - Name_Enum_Rep : constant Name_Id := N + 327; -- GNAT - Name_Epsilon : constant Name_Id := N + 328; -- Ada 83 - Name_Exponent : constant Name_Id := N + 329; - Name_External_Tag : constant Name_Id := N + 330; - Name_First : constant Name_Id := N + 331; - Name_First_Bit : constant Name_Id := N + 332; - Name_Fixed_Value : constant Name_Id := N + 333; -- GNAT - Name_Fore : constant Name_Id := N + 334; - Name_Has_Discriminants : constant Name_Id := N + 335; -- GNAT - Name_Identity : constant Name_Id := N + 336; - Name_Img : constant Name_Id := N + 337; -- GNAT - Name_Integer_Value : constant Name_Id := N + 338; -- GNAT - Name_Large : constant Name_Id := N + 339; -- Ada 83 - Name_Last : constant Name_Id := N + 340; - Name_Last_Bit : constant Name_Id := N + 341; - Name_Leading_Part : constant Name_Id := N + 342; - Name_Length : constant Name_Id := N + 343; - Name_Machine_Emax : constant Name_Id := N + 344; - Name_Machine_Emin : constant Name_Id := N + 345; - Name_Machine_Mantissa : constant Name_Id := N + 346; - Name_Machine_Overflows : constant Name_Id := N + 347; - Name_Machine_Radix : constant Name_Id := N + 348; - Name_Machine_Rounds : constant Name_Id := N + 349; - Name_Machine_Size : constant Name_Id := N + 350; -- GNAT - Name_Mantissa : constant Name_Id := N + 351; -- Ada 83 - Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 352; - Name_Maximum_Alignment : constant Name_Id := N + 353; -- GNAT - Name_Mechanism_Code : constant Name_Id := N + 354; -- GNAT - Name_Model_Emin : constant Name_Id := N + 355; - Name_Model_Epsilon : constant Name_Id := N + 356; - Name_Model_Mantissa : constant Name_Id := N + 357; - Name_Model_Small : constant Name_Id := N + 358; - Name_Modulus : constant Name_Id := N + 359; - Name_Null_Parameter : constant Name_Id := N + 360; -- GNAT - Name_Object_Size : constant Name_Id := N + 361; -- GNAT - Name_Partition_ID : constant Name_Id := N + 362; - Name_Passed_By_Reference : constant Name_Id := N + 363; -- GNAT - Name_Pool_Address : constant Name_Id := N + 364; - Name_Pos : constant Name_Id := N + 365; - Name_Position : constant Name_Id := N + 366; - Name_Range : constant Name_Id := N + 367; - Name_Range_Length : constant Name_Id := N + 368; -- GNAT - Name_Round : constant Name_Id := N + 369; - Name_Safe_Emax : constant Name_Id := N + 370; -- Ada 83 - Name_Safe_First : constant Name_Id := N + 371; - Name_Safe_Large : constant Name_Id := N + 372; -- Ada 83 - Name_Safe_Last : constant Name_Id := N + 373; - Name_Safe_Small : constant Name_Id := N + 374; -- Ada 83 - Name_Scale : constant Name_Id := N + 375; - Name_Scaling : constant Name_Id := N + 376; - Name_Signed_Zeros : constant Name_Id := N + 377; - Name_Size : constant Name_Id := N + 378; - Name_Small : constant Name_Id := N + 379; - Name_Storage_Size : constant Name_Id := N + 380; - Name_Storage_Unit : constant Name_Id := N + 381; -- GNAT - Name_Tag : constant Name_Id := N + 382; - Name_Target_Name : constant Name_Id := N + 383; -- GNAT - Name_Terminated : constant Name_Id := N + 384; - Name_To_Address : constant Name_Id := N + 385; -- GNAT - Name_Type_Class : constant Name_Id := N + 386; -- GNAT - Name_UET_Address : constant Name_Id := N + 387; -- GNAT - Name_Unbiased_Rounding : constant Name_Id := N + 388; - Name_Unchecked_Access : constant Name_Id := N + 389; - Name_Unconstrained_Array : constant Name_Id := N + 390; - Name_Universal_Literal_String : constant Name_Id := N + 391; -- GNAT - Name_Unrestricted_Access : constant Name_Id := N + 392; -- GNAT - Name_VADS_Size : constant Name_Id := N + 393; -- GNAT - Name_Val : constant Name_Id := N + 394; - Name_Valid : constant Name_Id := N + 395; - Name_Value_Size : constant Name_Id := N + 396; -- GNAT - Name_Version : constant Name_Id := N + 397; - Name_Wchar_T_Size : constant Name_Id := N + 398; -- GNAT - Name_Wide_Width : constant Name_Id := N + 399; - Name_Width : constant Name_Id := N + 400; - Name_Word_Size : constant Name_Id := N + 401; -- 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 + 402; - Name_Adjacent : constant Name_Id := N + 402; - Name_Ceiling : constant Name_Id := N + 403; - Name_Copy_Sign : constant Name_Id := N + 404; - Name_Floor : constant Name_Id := N + 405; - Name_Fraction : constant Name_Id := N + 406; - Name_Image : constant Name_Id := N + 407; - Name_Input : constant Name_Id := N + 408; - Name_Machine : constant Name_Id := N + 409; - Name_Max : constant Name_Id := N + 410; - Name_Min : constant Name_Id := N + 411; - Name_Model : constant Name_Id := N + 412; - Name_Pred : constant Name_Id := N + 413; - Name_Remainder : constant Name_Id := N + 414; - Name_Rounding : constant Name_Id := N + 415; - Name_Succ : constant Name_Id := N + 416; - Name_Truncation : constant Name_Id := N + 417; - Name_Value : constant Name_Id := N + 418; - Name_Wide_Image : constant Name_Id := N + 419; - Name_Wide_Value : constant Name_Id := N + 420; - Last_Renamable_Function_Attribute : constant Name_Id := N + 420; - - -- Attributes that designate procedures - - First_Procedure_Attribute : constant Name_Id := N + 421; - Name_Output : constant Name_Id := N + 421; - Name_Read : constant Name_Id := N + 422; - Name_Write : constant Name_Id := N + 423; - Last_Procedure_Attribute : constant Name_Id := N + 423; - - -- Remaining attributes are ones that return entities - - First_Entity_Attribute_Name : constant Name_Id := N + 424; - Name_Elab_Body : constant Name_Id := N + 424; -- GNAT - Name_Elab_Spec : constant Name_Id := N + 425; -- GNAT - Name_Storage_Pool : constant Name_Id := N + 426; - - -- These attributes are the ones that return types - - First_Type_Attribute_Name : constant Name_Id := N + 427; - Name_Base : constant Name_Id := N + 427; - Name_Class : constant Name_Id := N + 428; - Last_Type_Attribute_Name : constant Name_Id := N + 428; - Last_Entity_Attribute_Name : constant Name_Id := N + 428; - Last_Attribute_Name : constant Name_Id := N + 428; - - -- Names of recognized locking policy identifiers - - -- Note: policies are identified by the first character of the - -- 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 + 429; - Name_Ceiling_Locking : constant Name_Id := N + 429; - Name_Inheritance_Locking : constant Name_Id := N + 430; - Last_Locking_Policy_Name : constant Name_Id := N + 430; - - -- Names of recognized queuing policy identifiers. - - -- Note: policies are identified by the first character of the - -- 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 + 431; - Name_FIFO_Queuing : constant Name_Id := N + 431; - Name_Priority_Queuing : constant Name_Id := N + 432; - Last_Queuing_Policy_Name : constant Name_Id := N + 432; - - -- Names of recognized task dispatching policy identifiers - - -- Note: policies are identified by the first character of the - -- 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 + 433; - Name_Fifo_Within_Priorities : constant Name_Id := N + 433; - Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 433; - - -- Names of recognized checks for pragma Suppress - - First_Check_Name : constant Name_Id := N + 434; - Name_Access_Check : constant Name_Id := N + 434; - Name_Accessibility_Check : constant Name_Id := N + 435; - Name_Discriminant_Check : constant Name_Id := N + 436; - Name_Division_Check : constant Name_Id := N + 437; - Name_Elaboration_Check : constant Name_Id := N + 438; - Name_Index_Check : constant Name_Id := N + 439; - Name_Length_Check : constant Name_Id := N + 440; - Name_Overflow_Check : constant Name_Id := N + 441; - Name_Range_Check : constant Name_Id := N + 442; - Name_Storage_Check : constant Name_Id := N + 443; - Name_Tag_Check : constant Name_Id := N + 444; - Name_All_Checks : constant Name_Id := N + 445; - Last_Check_Name : constant Name_Id := N + 445; - - -- Names corresponding to reserved keywords, excluding those already - -- declared in the attribute list (Access, Delta, Digits, Range). - - Name_Abort : constant Name_Id := N + 446; - Name_Abs : constant Name_Id := N + 447; - Name_Accept : constant Name_Id := N + 448; - Name_And : constant Name_Id := N + 449; - Name_All : constant Name_Id := N + 450; - Name_Array : constant Name_Id := N + 451; - Name_At : constant Name_Id := N + 452; - Name_Begin : constant Name_Id := N + 453; - Name_Body : constant Name_Id := N + 454; - Name_Case : constant Name_Id := N + 455; - Name_Constant : constant Name_Id := N + 456; - Name_Declare : constant Name_Id := N + 457; - Name_Delay : constant Name_Id := N + 458; - Name_Do : constant Name_Id := N + 459; - Name_Else : constant Name_Id := N + 460; - Name_Elsif : constant Name_Id := N + 461; - Name_End : constant Name_Id := N + 462; - Name_Entry : constant Name_Id := N + 463; - Name_Exception : constant Name_Id := N + 464; - Name_Exit : constant Name_Id := N + 465; - Name_For : constant Name_Id := N + 466; - Name_Function : constant Name_Id := N + 467; - Name_Generic : constant Name_Id := N + 468; - Name_Goto : constant Name_Id := N + 469; - Name_If : constant Name_Id := N + 470; - Name_In : constant Name_Id := N + 471; - Name_Is : constant Name_Id := N + 472; - Name_Limited : constant Name_Id := N + 473; - Name_Loop : constant Name_Id := N + 474; - Name_Mod : constant Name_Id := N + 475; - Name_New : constant Name_Id := N + 476; - Name_Not : constant Name_Id := N + 477; - Name_Null : constant Name_Id := N + 478; - Name_Of : constant Name_Id := N + 479; - Name_Or : constant Name_Id := N + 480; - Name_Others : constant Name_Id := N + 481; - Name_Out : constant Name_Id := N + 482; - Name_Package : constant Name_Id := N + 483; - Name_Pragma : constant Name_Id := N + 484; - Name_Private : constant Name_Id := N + 485; - Name_Procedure : constant Name_Id := N + 486; - Name_Raise : constant Name_Id := N + 487; - Name_Record : constant Name_Id := N + 488; - Name_Rem : constant Name_Id := N + 489; - Name_Renames : constant Name_Id := N + 490; - Name_Return : constant Name_Id := N + 491; - Name_Reverse : constant Name_Id := N + 492; - Name_Select : constant Name_Id := N + 493; - Name_Separate : constant Name_Id := N + 494; - Name_Subtype : constant Name_Id := N + 495; - Name_Task : constant Name_Id := N + 496; - Name_Terminate : constant Name_Id := N + 497; - Name_Then : constant Name_Id := N + 498; - Name_Type : constant Name_Id := N + 499; - Name_Use : constant Name_Id := N + 500; - Name_When : constant Name_Id := N + 501; - Name_While : constant Name_Id := N + 502; - Name_With : constant Name_Id := N + 503; - Name_Xor : constant Name_Id := N + 504; - - -- 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 + 505; - Name_Divide : constant Name_Id := N + 505; - Name_Enclosing_Entity : constant Name_Id := N + 506; - Name_Exception_Information : constant Name_Id := N + 507; - Name_Exception_Message : constant Name_Id := N + 508; - Name_Exception_Name : constant Name_Id := N + 509; - Name_File : constant Name_Id := N + 510; - Name_Import_Address : constant Name_Id := N + 511; - Name_Import_Largest_Value : constant Name_Id := N + 512; - Name_Import_Value : constant Name_Id := N + 513; - Name_Is_Negative : constant Name_Id := N + 514; - Name_Line : constant Name_Id := N + 515; - Name_Rotate_Left : constant Name_Id := N + 516; - Name_Rotate_Right : constant Name_Id := N + 517; - Name_Shift_Left : constant Name_Id := N + 518; - Name_Shift_Right : constant Name_Id := N + 519; - Name_Shift_Right_Arithmetic : constant Name_Id := N + 520; - Name_Source_Location : constant Name_Id := N + 521; - Name_Unchecked_Conversion : constant Name_Id := N + 522; - Name_Unchecked_Deallocation : constant Name_Id := N + 523; - Name_To_Pointer : constant Name_Id := N + 524; - Last_Intrinsic_Name : constant Name_Id := N + 524; - - -- Reserved words used only in Ada 95 - - First_95_Reserved_Word : constant Name_Id := N + 525; - Name_Abstract : constant Name_Id := N + 525; - Name_Aliased : constant Name_Id := N + 526; - Name_Protected : constant Name_Id := N + 527; - Name_Until : constant Name_Id := N + 528; - Name_Requeue : constant Name_Id := N + 529; - Name_Tagged : constant Name_Id := N + 530; - Last_95_Reserved_Word : constant Name_Id := N + 530; - - 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 + 531; - - -- Additional reserved words in GNAT Project Files - -- Note that Name_External is already previously declared - - Name_Binder : constant Name_Id := N + 532; - Name_Body_Suffix : constant Name_Id := N + 533; - Name_Builder : constant Name_Id := N + 534; - Name_Compiler : constant Name_Id := N + 535; - Name_Cross_Reference : constant Name_Id := N + 536; - Name_Default_Switches : constant Name_Id := N + 537; - Name_Exec_Dir : constant Name_Id := N + 538; - Name_Executable : constant Name_Id := N + 539; - Name_Executable_Suffix : constant Name_Id := N + 540; - Name_Extends : constant Name_Id := N + 541; - Name_Finder : constant Name_Id := N + 542; - Name_Global_Configuration_Pragmas : constant Name_Id := N + 543; - Name_Gnatls : constant Name_Id := N + 544; - Name_Gnatstub : constant Name_Id := N + 545; - Name_Implementation : constant Name_Id := N + 546; - Name_Implementation_Exceptions : constant Name_Id := N + 547; - Name_Implementation_Suffix : constant Name_Id := N + 548; - Name_Languages : constant Name_Id := N + 549; - Name_Library_Dir : constant Name_Id := N + 550; - Name_Library_Auto_Init : constant Name_Id := N + 551; - Name_Library_GCC : constant Name_Id := N + 552; - Name_Library_Interface : constant Name_Id := N + 553; - Name_Library_Kind : constant Name_Id := N + 554; - Name_Library_Name : constant Name_Id := N + 555; - Name_Library_Options : constant Name_Id := N + 556; - Name_Library_Src_Dir : constant Name_Id := N + 557; - Name_Library_Symbol_File : constant Name_Id := N + 558; - Name_Library_Version : constant Name_Id := N + 559; - Name_Linker : constant Name_Id := N + 560; - Name_Local_Configuration_Pragmas : constant Name_Id := N + 561; - Name_Locally_Removed_Files : constant Name_Id := N + 562; - Name_Naming : constant Name_Id := N + 563; - Name_Object_Dir : constant Name_Id := N + 564; - Name_Pretty_Printer : constant Name_Id := N + 565; - Name_Project : constant Name_Id := N + 566; - Name_Separate_Suffix : constant Name_Id := N + 567; - Name_Source_Dirs : constant Name_Id := N + 568; - Name_Source_Files : constant Name_Id := N + 569; - Name_Source_List_File : constant Name_Id := N + 570; - Name_Spec : constant Name_Id := N + 571; - Name_Spec_Suffix : constant Name_Id := N + 572; - Name_Specification : constant Name_Id := N + 573; - Name_Specification_Exceptions : constant Name_Id := N + 574; - Name_Specification_Suffix : constant Name_Id := N + 575; - Name_Switches : constant Name_Id := N + 576; - -- Other miscellaneous names used in front end - - Name_Unaligned_Valid : constant Name_Id := N + 577; - - -- Mark last defined name for consistency check in Snames body - - Last_Predefined_Name : constant Name_Id := N + 577; - - subtype Any_Operator_Name is Name_Id range - First_Operator_Name .. Last_Operator_Name; - - ------------------------------ - -- Attribute ID Definitions -- - ------------------------------ - - type Attribute_Id is ( - Attribute_Abort_Signal, - Attribute_Access, - Attribute_Address, - Attribute_Address_Size, - Attribute_Aft, - Attribute_Alignment, - Attribute_Asm_Input, - Attribute_Asm_Output, - Attribute_AST_Entry, - Attribute_Bit, - Attribute_Bit_Order, - Attribute_Bit_Position, - Attribute_Body_Version, - Attribute_Callable, - Attribute_Caller, - Attribute_Code_Address, - Attribute_Component_Size, - Attribute_Compose, - Attribute_Constrained, - Attribute_Count, - Attribute_Default_Bit_Order, - Attribute_Definite, - Attribute_Delta, - Attribute_Denorm, - Attribute_Digits, - Attribute_Elaborated, - Attribute_Emax, - Attribute_Enum_Rep, - Attribute_Epsilon, - Attribute_Exponent, - Attribute_External_Tag, - Attribute_First, - Attribute_First_Bit, - Attribute_Fixed_Value, - Attribute_Fore, - Attribute_Has_Discriminants, - Attribute_Identity, - Attribute_Img, - Attribute_Integer_Value, - Attribute_Large, - Attribute_Last, - Attribute_Last_Bit, - Attribute_Leading_Part, - Attribute_Length, - Attribute_Machine_Emax, - Attribute_Machine_Emin, - Attribute_Machine_Mantissa, - Attribute_Machine_Overflows, - Attribute_Machine_Radix, - Attribute_Machine_Rounds, - Attribute_Machine_Size, - Attribute_Mantissa, - Attribute_Max_Size_In_Storage_Elements, - Attribute_Maximum_Alignment, - Attribute_Mechanism_Code, - Attribute_Model_Emin, - Attribute_Model_Epsilon, - Attribute_Model_Mantissa, - Attribute_Model_Small, - Attribute_Modulus, - Attribute_Null_Parameter, - Attribute_Object_Size, - Attribute_Partition_ID, - Attribute_Passed_By_Reference, - Attribute_Pool_Address, - Attribute_Pos, - Attribute_Position, - Attribute_Range, - Attribute_Range_Length, - Attribute_Round, - Attribute_Safe_Emax, - Attribute_Safe_First, - Attribute_Safe_Large, - Attribute_Safe_Last, - Attribute_Safe_Small, - Attribute_Scale, - Attribute_Scaling, - Attribute_Signed_Zeros, - Attribute_Size, - Attribute_Small, - Attribute_Storage_Size, - Attribute_Storage_Unit, - Attribute_Tag, - Attribute_Target_Name, - Attribute_Terminated, - Attribute_To_Address, - Attribute_Type_Class, - Attribute_UET_Address, - Attribute_Unbiased_Rounding, - Attribute_Unchecked_Access, - Attribute_Unconstrained_Array, - Attribute_Universal_Literal_String, - Attribute_Unrestricted_Access, - Attribute_VADS_Size, - Attribute_Val, - Attribute_Valid, - Attribute_Value_Size, - Attribute_Version, - Attribute_Wchar_T_Size, - Attribute_Wide_Width, - Attribute_Width, - Attribute_Word_Size, - - -- Attributes designating renamable functions - - Attribute_Adjacent, - Attribute_Ceiling, - Attribute_Copy_Sign, - Attribute_Floor, - Attribute_Fraction, - Attribute_Image, - Attribute_Input, - Attribute_Machine, - Attribute_Max, - Attribute_Min, - Attribute_Model, - Attribute_Pred, - Attribute_Remainder, - Attribute_Rounding, - Attribute_Succ, - Attribute_Truncation, - Attribute_Value, - Attribute_Wide_Image, - Attribute_Wide_Value, - - -- Attributes designating procedures - - Attribute_Output, - Attribute_Read, - Attribute_Write, - - -- Entity attributes (includes type attributes) - - Attribute_Elab_Body, - Attribute_Elab_Spec, - Attribute_Storage_Pool, - - -- Type attributes - - Attribute_Base, - Attribute_Class); - - ------------------------------------ - -- Convention Name ID Definitions -- - ------------------------------------ - - type Convention_Id is ( - - -- The conventions that are defined by the RM come first - - Convention_Ada, - Convention_Intrinsic, - Convention_Entry, - Convention_Protected, - - -- The remaining conventions are foreign language conventions - - Convention_Assembler, -- also Asm, Assembly - Convention_C, -- also Default, External - Convention_COBOL, - Convention_CPP, - Convention_Fortran, - Convention_Java, - Convention_Stdcall, -- also DLL, Win32 - Convention_Stubbed); - - -- Note: Convention C_Pass_By_Copy is allowed only for record - -- types (where it is treated like C except that the appropriate - -- flag is set in the record type). Recognizion of this convention - -- is specially handled in Sem_Prag. - - for Convention_Id'Size use 8; - -- Plenty of space for expansion - - subtype Foreign_Convention is - Convention_Id range Convention_Assembler .. Convention_Stdcall; - - ----------------------------------- - -- Locking Policy ID Definitions -- - ----------------------------------- - - type Locking_Policy_Id is ( - Locking_Policy_Inheritance_Locking, - Locking_Policy_Ceiling_Locking); - - --------------------------- - -- Pragma ID Definitions -- - --------------------------- - - type Pragma_Id is ( - - -- Configuration pragmas - - Pragma_Ada_83, - Pragma_Ada_95, - Pragma_C_Pass_By_Copy, - Pragma_Compile_Time_Warning, - Pragma_Component_Alignment, - Pragma_Convention_Identifier, - Pragma_Discard_Names, - Pragma_Elaboration_Checks, - Pragma_Eliminate, - Pragma_Explicit_Overriding, - Pragma_Extend_System, - Pragma_Extensions_Allowed, - Pragma_External_Name_Casing, - Pragma_Float_Representation, - Pragma_Initialize_Scalars, - Pragma_Interrupt_State, - Pragma_License, - Pragma_Locking_Policy, - Pragma_Long_Float, - Pragma_No_Run_Time, - Pragma_Normalize_Scalars, - Pragma_Polling, - Pragma_Persistent_Data, - Pragma_Persistent_Object, - Pragma_Propagate_Exceptions, - Pragma_Queuing_Policy, - Pragma_Ravenscar, - Pragma_Restricted_Run_Time, - Pragma_Restrictions, - Pragma_Restriction_Warnings, - Pragma_Reviewable, - Pragma_Source_File_Name, - Pragma_Source_File_Name_Project, - Pragma_Style_Checks, - Pragma_Suppress, - Pragma_Suppress_Exception_Locations, - Pragma_Task_Dispatching_Policy, - Pragma_Universal_Data, - Pragma_Unsuppress, - Pragma_Use_VADS_Size, - Pragma_Validity_Checks, - Pragma_Warnings, - - -- Remaining (non-configuration) pragmas - - Pragma_Abort_Defer, - Pragma_All_Calls_Remote, - Pragma_Annotate, - Pragma_Assert, - Pragma_Asynchronous, - Pragma_Atomic, - Pragma_Atomic_Components, - Pragma_Attach_Handler, - Pragma_Comment, - Pragma_Common_Object, - Pragma_Complex_Representation, - Pragma_Controlled, - Pragma_Convention, - Pragma_CPP_Class, - Pragma_CPP_Constructor, - Pragma_CPP_Virtual, - Pragma_CPP_Vtable, - Pragma_Debug, - Pragma_Elaborate, - Pragma_Elaborate_All, - Pragma_Elaborate_Body, - Pragma_Export, - Pragma_Export_Exception, - Pragma_Export_Function, - Pragma_Export_Object, - Pragma_Export_Procedure, - Pragma_Export_Value, - Pragma_Export_Valued_Procedure, - Pragma_External, - Pragma_Finalize_Storage_Only, - Pragma_Ident, - Pragma_Import, - Pragma_Import_Exception, - Pragma_Import_Function, - Pragma_Import_Object, - Pragma_Import_Procedure, - Pragma_Import_Valued_Procedure, - Pragma_Inline, - Pragma_Inline_Always, - Pragma_Inline_Generic, - Pragma_Inspection_Point, - Pragma_Interface, - Pragma_Interface_Name, - Pragma_Interrupt_Handler, - Pragma_Interrupt_Priority, - Pragma_Java_Constructor, - Pragma_Java_Interface, - Pragma_Keep_Names, - Pragma_Link_With, - Pragma_Linker_Alias, - Pragma_Linker_Options, - Pragma_Linker_Section, - Pragma_List, - Pragma_Machine_Attribute, - Pragma_Main, - Pragma_Main_Storage, - Pragma_Memory_Size, - Pragma_No_Return, - Pragma_Obsolescent, - Pragma_Optimize, - Pragma_Optional_Overriding, - Pragma_Overriding, - Pragma_Pack, - Pragma_Page, - Pragma_Passive, - Pragma_Preelaborate, - Pragma_Priority, - Pragma_Psect_Object, - Pragma_Pure, - Pragma_Pure_Function, - Pragma_Remote_Call_Interface, - Pragma_Remote_Types, - Pragma_Share_Generic, - Pragma_Shared, - Pragma_Shared_Passive, - Pragma_Source_Reference, - Pragma_Stream_Convert, - Pragma_Subtitle, - Pragma_Suppress_All, - Pragma_Suppress_Debug_Info, - Pragma_Suppress_Initialization, - Pragma_System_Name, - Pragma_Task_Info, - Pragma_Task_Name, - Pragma_Task_Storage, - Pragma_Time_Slice, - Pragma_Title, - Pragma_Unchecked_Union, - Pragma_Unimplemented_Unit, - Pragma_Unreferenced, - Pragma_Unreserve_All_Interrupts, - Pragma_Volatile, - Pragma_Volatile_Components, - Pragma_Weak_External, - - -- The following pragmas are on their own, out of order, because of - -- the special processing required to deal with the fact that their - -- names match existing attribute names. - - Pragma_AST_Entry, - Pragma_Storage_Size, - Pragma_Storage_Unit, - - -- The value to represent an unknown or unrecognized pragma - - Unknown_Pragma); - - ----------------------------------- - -- Queuing Policy ID definitions -- - ----------------------------------- - - type Queuing_Policy_Id is ( - Queuing_Policy_FIFO_Queuing, - Queuing_Policy_Priority_Queuing); - - -------------------------------------------- - -- Task Dispatching Policy ID definitions -- - -------------------------------------------- - - type Task_Dispatching_Policy_Id is ( - Task_Dispatching_FIFO_Within_Priorities); - -- Id values used to identify task dispatching policies - - ----------------- - -- Subprograms -- - ----------------- - - procedure Initialize; - -- Called to initialize the preset names in the names table. - - function Is_Attribute_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized attribute - - function Is_Entity_Attribute_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized entity attribute, - -- i.e. an attribute reference that returns an entity. - - function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized attribute that - -- designates a procedure (and can therefore appear as a statement). - - function Is_Function_Attribute_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized attribute - -- that designates a renameable function, and can therefore appear in - -- a renaming statement. Note that not all attributes designating - -- functions are renamable, in particular, thos returning a universal - -- value cannot be renamed. - - function Is_Type_Attribute_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized type attribute, - -- i.e. an attribute reference that returns a type - - function Is_Check_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized suppress check - -- as required by pragma Suppress. - - function Is_Convention_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of one of the recognized - -- language conventions, as required by pragma Convention, Import, - -- Export, Interface. Returns True if so. Also returns True for a - -- name that has been specified by a Convention_Identifier pragma. - -- If neither case holds, returns False. - - function Is_Locking_Policy_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized locking policy - - function Is_Operator_Symbol_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of an operator symbol - - function Is_Pragma_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized pragma. Note - -- that pragmas AST_Entry, Storage_Size, and Storage_Unit are recognized - -- as pragmas by this function even though their names are separate from - -- the other pragma names. - - function Is_Queuing_Policy_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized queuing policy - - function Is_Task_Dispatching_Policy_Name (N : Name_Id) return Boolean; - -- Test to see if the name N is the name of a recognized task - -- dispatching policy. - - function Get_Attribute_Id (N : Name_Id) return Attribute_Id; - -- Returns Id of attribute corresponding to given name. It is an error to - -- call this function with a name that is not the name of a attribute. - - function Get_Convention_Id (N : Name_Id) return Convention_Id; - -- Returns Id of language convention corresponding to given name. It is an - -- to call this function with a name that is not the name of a convention, - -- or one previously given in a call to Record_Convention_Identifier. - - function Get_Check_Id (N : Name_Id) return Check_Id; - -- Returns Id of suppress check corresponding to given name. It is an error - -- to call this function with a name that is not the name of a check. - - function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id; - -- Returns Id of locking policy corresponding to given name. It is an error - -- to call this function with a name that is not the name of a check. - - function Get_Pragma_Id (N : Name_Id) return Pragma_Id; - -- Returns Id of pragma corresponding to given name. Returns Unknown_Pragma - -- if N is not a name of a known (Ada defined or GNAT-specific) pragma. - -- Note that the function also works correctly for names of pragmas that - -- are not in the main list of pragma Names (AST_Entry, Storage_Size, and - -- Storage_Unit (e.g. Name_Storage_Size returns Pragma_Storage_Size). - - function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id; - -- Returns Id of queuing policy corresponding to given name. It is an error - -- to call this function with a name that is not the name of a check. - - function Get_Task_Dispatching_Policy_Id - (N : Name_Id) - return Task_Dispatching_Policy_Id; - -- Returns Id of task dispatching policy corresponding to given name. - -- It is an error to call this function with a name that is not the - -- name of a check. - - procedure Record_Convention_Identifier - (Id : Name_Id; - Convention : Convention_Id); - -- A call to this procedure, resulting from an occurrence of a pragma - -- Convention_Identifier, records that from now on an occurrence of - -- Id will be recognized as a name for the specified convention. - -private - pragma Inline (Is_Attribute_Name); - pragma Inline (Is_Entity_Attribute_Name); - pragma Inline (Is_Type_Attribute_Name); - pragma Inline (Is_Check_Name); - pragma Inline (Is_Locking_Policy_Name); - pragma Inline (Is_Operator_Symbol_Name); - pragma Inline (Is_Queuing_Policy_Name); - pragma Inline (Is_Pragma_Name); - pragma Inline (Is_Task_Dispatching_Policy_Name); - -end Snames; +------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S N A M E S --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2003, 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- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
+-- MA 02111-1307, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with Types; use Types;
+
+package Snames is
+
+-- This package contains definitions of standard names (i.e. entries in the
+-- Names table) that are used throughout the GNAT compiler). It also contains
+-- the definitions of some enumeration types whose definitions are tied to
+-- the order of these preset names.
+
+-- WARNING: There is a C file, a-snames.h which duplicates some of the
+-- definitions in this file and must be kept properly synchronized.
+
+ ------------------
+ -- Preset Names --
+ ------------------
+
+ -- The following are preset entries in the names table, which are
+ -- entered at the start of every compilation for easy access. Note
+ -- that the order of initialization of these names in the body must
+ -- be coordinated with the order of names in this table.
+
+ -- Note: a name may not appear more than once in the following list.
+ -- If additional pragmas or attributes are introduced which might
+ -- otherwise cause a duplicate, then list it only once in this table,
+ -- and adjust the definition of the functions for testing for pragma
+ -- names and attribute names, and returning their ID values. Of course
+ -- everything is simpler if no such duplications occur!
+
+ -- First we have the one character names used to optimize the lookup
+ -- process for one character identifiers (to avoid the hashing in this
+ -- case) There are a full 256 of these, but only the entries for lower
+ -- case and upper case letters have identifiers
+
+ -- The lower case letter entries are used for one character identifiers
+ -- appearing in the source, for example in pragma Interface (C).
+
+ Name_A : constant Name_Id := First_Name_Id + Character'Pos ('a');
+ Name_B : constant Name_Id := First_Name_Id + Character'Pos ('b');
+ Name_C : constant Name_Id := First_Name_Id + Character'Pos ('c');
+ Name_D : constant Name_Id := First_Name_Id + Character'Pos ('d');
+ Name_E : constant Name_Id := First_Name_Id + Character'Pos ('e');
+ Name_F : constant Name_Id := First_Name_Id + Character'Pos ('f');
+ Name_G : constant Name_Id := First_Name_Id + Character'Pos ('g');
+ Name_H : constant Name_Id := First_Name_Id + Character'Pos ('h');
+ Name_I : constant Name_Id := First_Name_Id + Character'Pos ('i');
+ Name_J : constant Name_Id := First_Name_Id + Character'Pos ('j');
+ Name_K : constant Name_Id := First_Name_Id + Character'Pos ('k');
+ Name_L : constant Name_Id := First_Name_Id + Character'Pos ('l');
+ Name_M : constant Name_Id := First_Name_Id + Character'Pos ('m');
+ Name_N : constant Name_Id := First_Name_Id + Character'Pos ('n');
+ Name_O : constant Name_Id := First_Name_Id + Character'Pos ('o');
+ Name_P : constant Name_Id := First_Name_Id + Character'Pos ('p');
+ Name_Q : constant Name_Id := First_Name_Id + Character'Pos ('q');
+ Name_R : constant Name_Id := First_Name_Id + Character'Pos ('r');
+ Name_S : constant Name_Id := First_Name_Id + Character'Pos ('s');
+ Name_T : constant Name_Id := First_Name_Id + Character'Pos ('t');
+ Name_U : constant Name_Id := First_Name_Id + Character'Pos ('u');
+ Name_V : constant Name_Id := First_Name_Id + Character'Pos ('v');
+ Name_W : constant Name_Id := First_Name_Id + Character'Pos ('w');
+ Name_X : constant Name_Id := First_Name_Id + Character'Pos ('x');
+ Name_Y : constant Name_Id := First_Name_Id + Character'Pos ('y');
+ Name_Z : constant Name_Id := First_Name_Id + Character'Pos ('z');
+
+ -- The upper case letter entries are used by expander code for local
+ -- variables that do not require unique names (e.g. formal parameter
+ -- names in constructed procedures)
+
+ Name_uA : constant Name_Id := First_Name_Id + Character'Pos ('A');
+ Name_uB : constant Name_Id := First_Name_Id + Character'Pos ('B');
+ Name_uC : constant Name_Id := First_Name_Id + Character'Pos ('C');
+ Name_uD : constant Name_Id := First_Name_Id + Character'Pos ('D');
+ Name_uE : constant Name_Id := First_Name_Id + Character'Pos ('E');
+ Name_uF : constant Name_Id := First_Name_Id + Character'Pos ('F');
+ Name_uG : constant Name_Id := First_Name_Id + Character'Pos ('G');
+ Name_uH : constant Name_Id := First_Name_Id + Character'Pos ('H');
+ Name_uI : constant Name_Id := First_Name_Id + Character'Pos ('I');
+ Name_uJ : constant Name_Id := First_Name_Id + Character'Pos ('J');
+ Name_uK : constant Name_Id := First_Name_Id + Character'Pos ('K');
+ Name_uL : constant Name_Id := First_Name_Id + Character'Pos ('L');
+ Name_uM : constant Name_Id := First_Name_Id + Character'Pos ('M');
+ Name_uN : constant Name_Id := First_Name_Id + Character'Pos ('N');
+ Name_uO : constant Name_Id := First_Name_Id + Character'Pos ('O');
+ Name_uP : constant Name_Id := First_Name_Id + Character'Pos ('P');
+ Name_uQ : constant Name_Id := First_Name_Id + Character'Pos ('Q');
+ Name_uR : constant Name_Id := First_Name_Id + Character'Pos ('R');
+ Name_uS : constant Name_Id := First_Name_Id + Character'Pos ('S');
+ Name_uT : constant Name_Id := First_Name_Id + Character'Pos ('T');
+ Name_uU : constant Name_Id := First_Name_Id + Character'Pos ('U');
+ Name_uV : constant Name_Id := First_Name_Id + Character'Pos ('V');
+ Name_uW : constant Name_Id := First_Name_Id + Character'Pos ('W');
+ Name_uX : constant Name_Id := First_Name_Id + Character'Pos ('X');
+ Name_uY : constant Name_Id := First_Name_Id + Character'Pos ('Y');
+ Name_uZ : constant Name_Id := First_Name_Id + Character'Pos ('Z');
+
+ -- Note: the following table is read by the utility program XSNAMES and
+ -- its format should not be changed without coordinating with this program.
+
+ N : constant Name_Id := First_Name_Id + 256;
+ -- Synonym used in standard name definitions
+
+ -- Some names that are used by gigi, and whose definitions are reflected
+ -- in the C header file a-snames.h. They are placed at the start so that
+ -- the need to modify a-snames.h is minimized.
+
+ Name_uParent : constant Name_Id := N + 000;
+ Name_uTag : constant Name_Id := N + 001;
+ Name_Off : constant Name_Id := N + 002;
+ Name_Space : constant Name_Id := N + 003;
+ Name_Time : constant Name_Id := N + 004;
+
+ -- Some special names used by the expander. Note that the lower case u's
+ -- at the start of these names get translated to extra underscores. These
+ -- names are only referenced internally by expander generated code.
+
+ 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;
+
+ -- 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;
+
+ -- 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;
+
+ -- Names of allocation routines, also needed by expander
+
+ Name_Allocate : constant Name_Id := N + 035;
+ Name_Deallocate : constant Name_Id := N + 036;
+ Name_Dereference : constant Name_Id := N + 037;
+
+ -- Names of Text_IO generic subpackages (see Rtsfind.Text_IO_Kludge)
+
+ First_Text_IO_Package : constant Name_Id := N + 038;
+ Name_Decimal_IO : constant Name_Id := N + 038;
+ Name_Enumeration_IO : constant Name_Id := N + 039;
+ Name_Fixed_IO : constant Name_Id := N + 040;
+ Name_Float_IO : constant Name_Id := N + 041;
+ Name_Integer_IO : constant Name_Id := N + 042;
+ Name_Modular_IO : constant Name_Id := N + 043;
+ Last_Text_IO_Package : constant Name_Id := N + 043;
+
+ 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 + 044;
+ Name_a_witeio : constant Name_Id := N + 045;
+
+ -- Some miscellaneous names used for error detection/recovery
+
+ Name_Const : constant Name_Id := N + 046;
+ Name_Error : constant Name_Id := N + 047;
+ Name_Go : constant Name_Id := N + 048;
+ Name_Put : constant Name_Id := N + 049;
+ Name_Put_Line : constant Name_Id := N + 050;
+ Name_To : constant Name_Id := N + 051;
+
+ -- Names for packages that are treated specially by the compiler
+
+ Name_Finalization : constant Name_Id := N + 052;
+ Name_Finalization_Root : constant Name_Id := N + 053;
+ Name_Interfaces : constant Name_Id := N + 054;
+ Name_Standard : constant Name_Id := N + 055;
+ Name_System : constant Name_Id := N + 056;
+ Name_Text_IO : constant Name_Id := N + 057;
+ Name_Wide_Text_IO : constant Name_Id := N + 058;
+
+ -- Names of identifiers used in expanding distribution stubs
+
+ Name_Addr : constant Name_Id := N + 059;
+ Name_Async : constant Name_Id := N + 060;
+ Name_Get_Active_Partition_ID : constant Name_Id := N + 061;
+ Name_Get_RCI_Package_Receiver : constant Name_Id := N + 062;
+ Name_Origin : constant Name_Id := N + 063;
+ Name_Params : constant Name_Id := N + 064;
+ Name_Partition : constant Name_Id := N + 065;
+ Name_Partition_Interface : constant Name_Id := N + 066;
+ Name_Ras : constant Name_Id := N + 067;
+ Name_RCI_Name : constant Name_Id := N + 068;
+ Name_Receiver : constant Name_Id := N + 069;
+ Name_Result : constant Name_Id := N + 070;
+ Name_Rpc : constant Name_Id := N + 071;
+ Name_Subp_Id : constant Name_Id := N + 072;
+
+ -- 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 + 073;
+ Name_Op_Abs : constant Name_Id := N + 073; -- "abs"
+ Name_Op_And : constant Name_Id := N + 074; -- "and"
+ Name_Op_Mod : constant Name_Id := N + 075; -- "mod"
+ Name_Op_Not : constant Name_Id := N + 076; -- "not"
+ Name_Op_Or : constant Name_Id := N + 077; -- "or"
+ Name_Op_Rem : constant Name_Id := N + 078; -- "rem"
+ Name_Op_Xor : constant Name_Id := N + 079; -- "xor"
+ Name_Op_Eq : constant Name_Id := N + 080; -- "="
+ Name_Op_Ne : constant Name_Id := N + 081; -- "/="
+ Name_Op_Lt : constant Name_Id := N + 082; -- "<"
+ Name_Op_Le : constant Name_Id := N + 083; -- "<="
+ Name_Op_Gt : constant Name_Id := N + 084; -- ">"
+ Name_Op_Ge : constant Name_Id := N + 085; -- ">="
+ Name_Op_Add : constant Name_Id := N + 086; -- "+"
+ Name_Op_Subtract : constant Name_Id := N + 087; -- "-"
+ Name_Op_Concat : constant Name_Id := N + 088; -- "&"
+ Name_Op_Multiply : constant Name_Id := N + 089; -- "*"
+ Name_Op_Divide : constant Name_Id := N + 090; -- "/"
+ Name_Op_Expon : constant Name_Id := N + 091; -- "**"
+ Last_Operator_Name : constant Name_Id := N + 091;
+
+ -- 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.
+ -- These pragmas are fully implemented in both Ada 83 and Ada 95 modes
+ -- in GNAT.
+
+ -- The entries marked GNAT are pragmas that are defined by GNAT
+ -- and implemented in both Ada 83 and Ada 95 modes. Full descriptions
+ -- of these implementation dependent pragmas may be found in the
+ -- appropriate section in unit Sem_Prag in file sem-prag.adb.
+
+ -- The entries marked VMS are VMS specific pragmas that are recognized
+ -- only in OpenVMS versions of GNAT. They are ignored in other versions
+ -- with an appropriate warning.
+
+ -- The entries marked AAMP are AAMP specific pragmas that are recognized
+ -- only in GNAT for the AAMP. They are ignored in other versions with
+ -- appropriate warnings.
+
+ First_Pragma_Name : constant Name_Id := N + 092;
+
+ -- Configuration pragmas are grouped at start
+
+ Name_Ada_83 : constant Name_Id := N + 092; -- GNAT
+ Name_Ada_95 : constant Name_Id := N + 093; -- GNAT
+ Name_C_Pass_By_Copy : constant Name_Id := N + 094; -- GNAT
+ Name_Compile_Time_Warning : constant Name_Id := N + 095; -- GNAT
+ Name_Component_Alignment : constant Name_Id := N + 096; -- GNAT
+ Name_Convention_Identifier : constant Name_Id := N + 097; -- GNAT
+ Name_Discard_Names : constant Name_Id := N + 098;
+ Name_Elaboration_Checks : constant Name_Id := N + 099; -- GNAT
+ Name_Eliminate : constant Name_Id := N + 100; -- GNAT
+ Name_Explicit_Overriding : constant Name_Id := N + 101;
+ Name_Extend_System : constant Name_Id := N + 102; -- GNAT
+ Name_Extensions_Allowed : constant Name_Id := N + 103; -- GNAT
+ Name_External_Name_Casing : constant Name_Id := N + 104; -- GNAT
+ Name_Float_Representation : constant Name_Id := N + 105; -- GNAT
+ Name_Initialize_Scalars : constant Name_Id := N + 106; -- GNAT
+ Name_Interrupt_State : constant Name_Id := N + 107; -- GNAT
+ Name_License : constant Name_Id := N + 108; -- GNAT
+ Name_Locking_Policy : constant Name_Id := N + 109;
+ Name_Long_Float : constant Name_Id := N + 110; -- VMS
+ Name_No_Run_Time : constant Name_Id := N + 111; -- GNAT
+ Name_Normalize_Scalars : constant Name_Id := N + 112;
+ Name_Polling : constant Name_Id := N + 113; -- GNAT
+ Name_Persistent_Data : constant Name_Id := N + 114; -- GNAT
+ Name_Persistent_Object : constant Name_Id := N + 115; -- GNAT
+ Name_Propagate_Exceptions : constant Name_Id := N + 116; -- GNAT
+ Name_Queuing_Policy : constant Name_Id := N + 117;
+ Name_Ravenscar : constant Name_Id := N + 118;
+ Name_Restricted_Run_Time : constant Name_Id := N + 119;
+ Name_Restrictions : constant Name_Id := N + 120;
+ Name_Restriction_Warnings : constant Name_Id := N + 121; -- GNAT
+ Name_Reviewable : constant Name_Id := N + 122;
+ Name_Source_File_Name : constant Name_Id := N + 123; -- GNAT
+ Name_Source_File_Name_Project : constant Name_Id := N + 124; -- GNAT
+ Name_Style_Checks : constant Name_Id := N + 125; -- GNAT
+ Name_Suppress : constant Name_Id := N + 126;
+ Name_Suppress_Exception_Locations : constant Name_Id := N + 127; -- GNAT
+ Name_Task_Dispatching_Policy : constant Name_Id := N + 128;
+ Name_Universal_Data : constant Name_Id := N + 129; -- AAMP
+ Name_Unsuppress : constant Name_Id := N + 130; -- GNAT
+ Name_Use_VADS_Size : constant Name_Id := N + 131; -- GNAT
+ Name_Validity_Checks : constant Name_Id := N + 132; -- GNAT
+ Name_Warnings : constant Name_Id := N + 133; -- GNAT
+ Last_Configuration_Pragma_Name : constant Name_Id := N + 133;
+
+ -- Remaining pragma names
+
+ Name_Abort_Defer : constant Name_Id := N + 134; -- GNAT
+ Name_All_Calls_Remote : constant Name_Id := N + 135;
+ Name_Annotate : constant Name_Id := N + 136; -- GNAT
+
+ -- Note: AST_Entry is not in this list because its name matches the
+ -- name of the corresponding attribute. However, it is included in the
+ -- definition of the type Attribute_Id, and the functions Get_Pragma_Id
+ -- and Check_Pragma_Id correctly recognize and process Name_AST_Entry.
+ -- AST_Entry is a VMS specific pragma.
+
+ Name_Assert : constant Name_Id := N + 137; -- GNAT
+ Name_Asynchronous : constant Name_Id := N + 138;
+ Name_Atomic : constant Name_Id := N + 139;
+ Name_Atomic_Components : constant Name_Id := N + 140;
+ Name_Attach_Handler : constant Name_Id := N + 141;
+ Name_Comment : constant Name_Id := N + 142; -- GNAT
+ Name_Common_Object : constant Name_Id := N + 143; -- GNAT
+ Name_Complex_Representation : constant Name_Id := N + 144; -- GNAT
+ Name_Controlled : constant Name_Id := N + 145;
+ Name_Convention : constant Name_Id := N + 146;
+ Name_CPP_Class : constant Name_Id := N + 147; -- GNAT
+ Name_CPP_Constructor : constant Name_Id := N + 148; -- GNAT
+ Name_CPP_Virtual : constant Name_Id := N + 149; -- GNAT
+ Name_CPP_Vtable : constant Name_Id := N + 150; -- GNAT
+ Name_Debug : constant Name_Id := N + 151; -- GNAT
+ Name_Elaborate : constant Name_Id := N + 152; -- Ada 83
+ Name_Elaborate_All : constant Name_Id := N + 153;
+ Name_Elaborate_Body : constant Name_Id := N + 154;
+ Name_Export : constant Name_Id := N + 155;
+ Name_Export_Exception : constant Name_Id := N + 156; -- VMS
+ Name_Export_Function : constant Name_Id := N + 157; -- GNAT
+ Name_Export_Object : constant Name_Id := N + 158; -- GNAT
+ Name_Export_Procedure : constant Name_Id := N + 159; -- GNAT
+ Name_Export_Value : constant Name_Id := N + 160; -- GNAT
+ Name_Export_Valued_Procedure : constant Name_Id := N + 161; -- GNAT
+ Name_External : constant Name_Id := N + 162; -- GNAT
+ Name_Finalize_Storage_Only : constant Name_Id := N + 163; -- GNAT
+ Name_Ident : constant Name_Id := N + 164; -- VMS
+ Name_Import : constant Name_Id := N + 165;
+ Name_Import_Exception : constant Name_Id := N + 166; -- VMS
+ Name_Import_Function : constant Name_Id := N + 167; -- GNAT
+ Name_Import_Object : constant Name_Id := N + 168; -- GNAT
+ Name_Import_Procedure : constant Name_Id := N + 169; -- GNAT
+ Name_Import_Valued_Procedure : constant Name_Id := N + 170; -- GNAT
+ Name_Inline : constant Name_Id := N + 171;
+ Name_Inline_Always : constant Name_Id := N + 172; -- GNAT
+ Name_Inline_Generic : constant Name_Id := N + 173; -- GNAT
+ Name_Inspection_Point : constant Name_Id := N + 174;
+ Name_Interface : constant Name_Id := N + 175; -- Ada 83
+ Name_Interface_Name : constant Name_Id := N + 176; -- GNAT
+ Name_Interrupt_Handler : constant Name_Id := N + 177;
+ Name_Interrupt_Priority : constant Name_Id := N + 178;
+ Name_Java_Constructor : constant Name_Id := N + 179; -- GNAT
+ Name_Java_Interface : constant Name_Id := N + 180; -- GNAT
+ Name_Keep_Names : constant Name_Id := N + 181; -- GNAT
+ Name_Link_With : constant Name_Id := N + 182; -- GNAT
+ Name_Linker_Alias : constant Name_Id := N + 183; -- GNAT
+ Name_Linker_Options : constant Name_Id := N + 184;
+ Name_Linker_Section : constant Name_Id := N + 185; -- GNAT
+ Name_List : constant Name_Id := N + 186;
+ Name_Machine_Attribute : constant Name_Id := N + 187; -- GNAT
+ Name_Main : constant Name_Id := N + 188; -- GNAT
+ Name_Main_Storage : constant Name_Id := N + 189; -- GNAT
+ Name_Memory_Size : constant Name_Id := N + 190; -- Ada 83
+ Name_No_Return : constant Name_Id := N + 191; -- GNAT
+ Name_Obsolescent : constant Name_Id := N + 192; -- GNAT
+ Name_Optimize : constant Name_Id := N + 193;
+ Name_Optional_Overriding : constant Name_Id := N + 194;
+ Name_Overriding : constant Name_Id := N + 195;
+ Name_Pack : constant Name_Id := N + 196;
+ Name_Page : constant Name_Id := N + 197;
+ Name_Passive : constant Name_Id := N + 198; -- GNAT
+ Name_Preelaborate : constant Name_Id := N + 199;
+ Name_Priority : constant Name_Id := N + 200;
+ Name_Psect_Object : constant Name_Id := N + 201; -- VMS
+ Name_Pure : constant Name_Id := N + 202;
+ Name_Pure_Function : constant Name_Id := N + 203; -- GNAT
+ Name_Remote_Call_Interface : constant Name_Id := N + 204;
+ Name_Remote_Types : constant Name_Id := N + 205;
+ Name_Share_Generic : constant Name_Id := N + 206; -- GNAT
+ Name_Shared : constant Name_Id := N + 207; -- Ada 83
+ Name_Shared_Passive : constant Name_Id := N + 208;
+
+ -- Note: Storage_Size is not in this list because its name matches the
+ -- name of the corresponding attribute. However, it is included in the
+ -- definition of the type Attribute_Id, and the functions Get_Pragma_Id
+ -- and Check_Pragma_Id correctly recognize and process Name_Storage_Size.
+
+ -- Note: Storage_Unit is also omitted from the list because of a clash
+ -- with an attribute name, and is treated similarly.
+
+ Name_Source_Reference : constant Name_Id := N + 209; -- GNAT
+ Name_Stream_Convert : constant Name_Id := N + 210; -- GNAT
+ Name_Subtitle : constant Name_Id := N + 211; -- GNAT
+ Name_Suppress_All : constant Name_Id := N + 212; -- GNAT
+ Name_Suppress_Debug_Info : constant Name_Id := N + 213; -- GNAT
+ Name_Suppress_Initialization : constant Name_Id := N + 214; -- GNAT
+ Name_System_Name : constant Name_Id := N + 215; -- Ada 83
+ Name_Task_Info : constant Name_Id := N + 216; -- GNAT
+ Name_Task_Name : constant Name_Id := N + 217; -- GNAT
+ Name_Task_Storage : constant Name_Id := N + 218; -- VMS
+ Name_Thread_Body : constant Name_Id := N + 219; -- GNAT
+ Name_Time_Slice : constant Name_Id := N + 220; -- GNAT
+ Name_Title : constant Name_Id := N + 221; -- GNAT
+ Name_Unchecked_Union : constant Name_Id := N + 222; -- GNAT
+ Name_Unimplemented_Unit : constant Name_Id := N + 223; -- GNAT
+ Name_Unreferenced : constant Name_Id := N + 224; -- GNAT
+ Name_Unreserve_All_Interrupts : constant Name_Id := N + 225; -- GNAT
+ Name_Volatile : constant Name_Id := N + 226;
+ Name_Volatile_Components : constant Name_Id := N + 227;
+ Name_Weak_External : constant Name_Id := N + 228; -- GNAT
+ Last_Pragma_Name : constant Name_Id := N + 228;
+
+ -- Language convention names for pragma Convention/Export/Import/Interface
+ -- Note that Name_C is not included in this list, since it was already
+ -- declared earlier in the context of one-character identifier names
+ -- (where the order is critical to the fast look up process).
+
+ -- Note: there are no convention names corresponding to the conventions
+ -- Entry and Protected, this is because these conventions cannot be
+ -- specified by a pragma.
+
+ First_Convention_Name : constant Name_Id := N + 229;
+ Name_Ada : constant Name_Id := N + 229;
+ Name_Assembler : constant Name_Id := N + 230;
+ Name_COBOL : constant Name_Id := N + 231;
+ Name_CPP : constant Name_Id := N + 232;
+ Name_Fortran : constant Name_Id := N + 233;
+ Name_Intrinsic : constant Name_Id := N + 234;
+ Name_Java : constant Name_Id := N + 235;
+ Name_Stdcall : constant Name_Id := N + 236;
+ Name_Stubbed : constant Name_Id := N + 237;
+ Last_Convention_Name : constant Name_Id := N + 237;
+
+ -- The following names are preset as synonyms for Assembler
+
+ Name_Asm : constant Name_Id := N + 238;
+ Name_Assembly : constant Name_Id := N + 239;
+
+ -- The following names are preset as synonyms for C
+
+ Name_Default : constant Name_Id := N + 240;
+ -- Name_Exernal (previously defined as pragma)
+
+ -- The following names are present as synonyms for Stdcall
+
+ Name_DLL : constant Name_Id := N + 241;
+ Name_Win32 : constant Name_Id := N + 242;
+
+ -- Other special names used in processing pragma arguments
+
+ Name_As_Is : constant Name_Id := N + 243;
+ Name_Body_File_Name : constant Name_Id := N + 244;
+ Name_Casing : constant Name_Id := N + 245;
+ Name_Code : constant Name_Id := N + 246;
+ Name_Component : constant Name_Id := N + 247;
+ Name_Component_Size_4 : constant Name_Id := N + 248;
+ Name_Copy : constant Name_Id := N + 249;
+ Name_D_Float : constant Name_Id := N + 250;
+ Name_Descriptor : constant Name_Id := N + 251;
+ Name_Dot_Replacement : constant Name_Id := N + 252;
+ Name_Dynamic : constant Name_Id := N + 253;
+ Name_Entity : constant Name_Id := N + 254;
+ Name_External_Name : constant Name_Id := N + 255;
+ Name_First_Optional_Parameter : constant Name_Id := N + 256;
+ Name_Form : constant Name_Id := N + 257;
+ Name_G_Float : constant Name_Id := N + 258;
+ Name_Gcc : constant Name_Id := N + 259;
+ Name_Gnat : constant Name_Id := N + 260;
+ Name_GPL : constant Name_Id := N + 261;
+ Name_IEEE_Float : constant Name_Id := N + 262;
+ Name_Homonym_Number : constant Name_Id := N + 263;
+ Name_Internal : constant Name_Id := N + 264;
+ Name_Link_Name : constant Name_Id := N + 265;
+ Name_Lowercase : constant Name_Id := N + 266;
+ Name_Max_Size : constant Name_Id := N + 267;
+ Name_Mechanism : constant Name_Id := N + 268;
+ Name_Mixedcase : constant Name_Id := N + 269;
+ Name_Modified_GPL : constant Name_Id := N + 270;
+ Name_Name : constant Name_Id := N + 271;
+ Name_NCA : constant Name_Id := N + 272;
+ Name_No : constant Name_Id := N + 273;
+ Name_On : constant Name_Id := N + 274;
+ Name_Parameter_Types : constant Name_Id := N + 275;
+ Name_Reference : constant Name_Id := N + 276;
+ Name_Restricted : constant Name_Id := N + 277;
+ Name_Result_Mechanism : constant Name_Id := N + 278;
+ Name_Result_Type : constant Name_Id := N + 279;
+ Name_Runtime : constant Name_Id := N + 280;
+ Name_SB : constant Name_Id := N + 281;
+ Name_Secondary_Stack_Size : constant Name_Id := N + 282;
+ Name_Section : constant Name_Id := N + 283;
+ Name_Semaphore : constant Name_Id := N + 284;
+ Name_Spec_File_Name : constant Name_Id := N + 285;
+ Name_Static : constant Name_Id := N + 286;
+ Name_Stack_Size : constant Name_Id := N + 287;
+ Name_Subunit_File_Name : constant Name_Id := N + 288;
+ Name_Task_Stack_Size_Default : constant Name_Id := N + 289;
+ Name_Task_Type : constant Name_Id := N + 290;
+ Name_Time_Slicing_Enabled : constant Name_Id := N + 291;
+ Name_Top_Guard : constant Name_Id := N + 292;
+ Name_UBA : constant Name_Id := N + 293;
+ Name_UBS : constant Name_Id := N + 294;
+ Name_UBSB : constant Name_Id := N + 295;
+ Name_Unit_Name : constant Name_Id := N + 296;
+ Name_Unknown : constant Name_Id := N + 297;
+ Name_Unrestricted : constant Name_Id := N + 298;
+ Name_Uppercase : constant Name_Id := N + 299;
+ Name_User : constant Name_Id := N + 300;
+ Name_VAX_Float : constant Name_Id := N + 301;
+ Name_VMS : constant Name_Id := N + 302;
+ Name_Working_Storage : constant Name_Id := N + 303;
+
+ -- 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
+ -- attributes are implemented in both Ada 83 and Ada 95 modes in GNAT.
+
+ -- The entries marked GNAT are attributes that are defined by GNAT
+ -- and implemented in both Ada 83 and Ada 95 modes. Full descriptions
+ -- of these implementation dependent attributes may be found in the
+ -- appropriate section in package Sem_Attr in file sem-attr.ads.
+
+ -- 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 + 304;
+ Name_Abort_Signal : constant Name_Id := N + 304; -- GNAT
+ Name_Access : constant Name_Id := N + 305;
+ Name_Address : constant Name_Id := N + 306;
+ Name_Address_Size : constant Name_Id := N + 307; -- GNAT
+ Name_Aft : constant Name_Id := N + 308;
+ Name_Alignment : constant Name_Id := N + 309;
+ Name_Asm_Input : constant Name_Id := N + 310; -- GNAT
+ Name_Asm_Output : constant Name_Id := N + 311; -- GNAT
+ Name_AST_Entry : constant Name_Id := N + 312; -- VMS
+ Name_Bit : constant Name_Id := N + 313; -- GNAT
+ Name_Bit_Order : constant Name_Id := N + 314;
+ Name_Bit_Position : constant Name_Id := N + 315; -- GNAT
+ Name_Body_Version : constant Name_Id := N + 316;
+ Name_Callable : constant Name_Id := N + 317;
+ Name_Caller : constant Name_Id := N + 318;
+ Name_Code_Address : constant Name_Id := N + 319; -- GNAT
+ Name_Component_Size : constant Name_Id := N + 320;
+ Name_Compose : constant Name_Id := N + 321;
+ Name_Constrained : constant Name_Id := N + 322;
+ Name_Count : constant Name_Id := N + 323;
+ Name_Default_Bit_Order : constant Name_Id := N + 324; -- GNAT
+ Name_Definite : constant Name_Id := N + 325;
+ Name_Delta : constant Name_Id := N + 326;
+ Name_Denorm : constant Name_Id := N + 327;
+ Name_Digits : constant Name_Id := N + 328;
+ Name_Elaborated : constant Name_Id := N + 329; -- GNAT
+ Name_Emax : constant Name_Id := N + 330; -- Ada 83
+ Name_Enum_Rep : constant Name_Id := N + 331; -- GNAT
+ Name_Epsilon : constant Name_Id := N + 332; -- Ada 83
+ Name_Exponent : constant Name_Id := N + 333;
+ Name_External_Tag : constant Name_Id := N + 334;
+ Name_First : constant Name_Id := N + 335;
+ Name_First_Bit : constant Name_Id := N + 336;
+ Name_Fixed_Value : constant Name_Id := N + 337; -- GNAT
+ Name_Fore : constant Name_Id := N + 338;
+ Name_Has_Discriminants : constant Name_Id := N + 339; -- GNAT
+ Name_Identity : constant Name_Id := N + 340;
+ Name_Img : constant Name_Id := N + 341; -- GNAT
+ Name_Integer_Value : constant Name_Id := N + 342; -- GNAT
+ Name_Large : constant Name_Id := N + 343; -- Ada 83
+ Name_Last : constant Name_Id := N + 344;
+ Name_Last_Bit : constant Name_Id := N + 345;
+ Name_Leading_Part : constant Name_Id := N + 346;
+ Name_Length : constant Name_Id := N + 347;
+ Name_Machine_Emax : constant Name_Id := N + 348;
+ Name_Machine_Emin : constant Name_Id := N + 349;
+ Name_Machine_Mantissa : constant Name_Id := N + 350;
+ Name_Machine_Overflows : constant Name_Id := N + 351;
+ Name_Machine_Radix : constant Name_Id := N + 352;
+ Name_Machine_Rounds : constant Name_Id := N + 353;
+ Name_Machine_Size : constant Name_Id := N + 354; -- GNAT
+ Name_Mantissa : constant Name_Id := N + 355; -- Ada 83
+ Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 356;
+ Name_Maximum_Alignment : constant Name_Id := N + 357; -- GNAT
+ Name_Mechanism_Code : constant Name_Id := N + 358; -- GNAT
+ Name_Model_Emin : constant Name_Id := N + 359;
+ Name_Model_Epsilon : constant Name_Id := N + 360;
+ Name_Model_Mantissa : constant Name_Id := N + 361;
+ Name_Model_Small : constant Name_Id := N + 362;
+ Name_Modulus : constant Name_Id := N + 363;
+ Name_Null_Parameter : constant Name_Id := N + 364; -- GNAT
+ Name_Object_Size : constant Name_Id := N + 365; -- GNAT
+ Name_Partition_ID : constant Name_Id := N + 366;
+ Name_Passed_By_Reference : constant Name_Id := N + 367; -- GNAT
+ Name_Pool_Address : constant Name_Id := N + 368;
+ Name_Pos : constant Name_Id := N + 369;
+ Name_Position : constant Name_Id := N + 370;
+ Name_Range : constant Name_Id := N + 371;
+ Name_Range_Length : constant Name_Id := N + 372; -- GNAT
+ Name_Round : constant Name_Id := N + 373;
+ Name_Safe_Emax : constant Name_Id := N + 374; -- Ada 83
+ Name_Safe_First : constant Name_Id := N + 375;
+ Name_Safe_Large : constant Name_Id := N + 376; -- Ada 83
+ Name_Safe_Last : constant Name_Id := N + 377;
+ Name_Safe_Small : constant Name_Id := N + 378; -- Ada 83
+ Name_Scale : constant Name_Id := N + 379;
+ Name_Scaling : constant Name_Id := N + 380;
+ Name_Signed_Zeros : constant Name_Id := N + 381;
+ Name_Size : constant Name_Id := N + 382;
+ Name_Small : constant Name_Id := N + 383;
+ Name_Storage_Size : constant Name_Id := N + 384;
+ Name_Storage_Unit : constant Name_Id := N + 385; -- GNAT
+ Name_Tag : constant Name_Id := N + 386;
+ Name_Target_Name : constant Name_Id := N + 387; -- GNAT
+ Name_Terminated : constant Name_Id := N + 388;
+ Name_To_Address : constant Name_Id := N + 389; -- GNAT
+ Name_Type_Class : constant Name_Id := N + 390; -- GNAT
+ Name_UET_Address : constant Name_Id := N + 391; -- GNAT
+ Name_Unbiased_Rounding : constant Name_Id := N + 392;
+ Name_Unchecked_Access : constant Name_Id := N + 393;
+ Name_Unconstrained_Array : constant Name_Id := N + 394;
+ Name_Universal_Literal_String : constant Name_Id := N + 395; -- GNAT
+ Name_Unrestricted_Access : constant Name_Id := N + 396; -- GNAT
+ Name_VADS_Size : constant Name_Id := N + 397; -- GNAT
+ Name_Val : constant Name_Id := N + 398;
+ Name_Valid : constant Name_Id := N + 399;
+ Name_Value_Size : constant Name_Id := N + 400; -- GNAT
+ Name_Version : constant Name_Id := N + 401;
+ Name_Wchar_T_Size : constant Name_Id := N + 402; -- GNAT
+ Name_Wide_Width : constant Name_Id := N + 403;
+ Name_Width : constant Name_Id := N + 404;
+ Name_Word_Size : constant Name_Id := N + 405; -- 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 + 406;
+ Name_Adjacent : constant Name_Id := N + 406;
+ Name_Ceiling : constant Name_Id := N + 407;
+ Name_Copy_Sign : constant Name_Id := N + 408;
+ Name_Floor : constant Name_Id := N + 409;
+ Name_Fraction : constant Name_Id := N + 410;
+ Name_Image : constant Name_Id := N + 411;
+ Name_Input : constant Name_Id := N + 412;
+ Name_Machine : constant Name_Id := N + 413;
+ Name_Max : constant Name_Id := N + 414;
+ Name_Min : constant Name_Id := N + 415;
+ Name_Model : constant Name_Id := N + 416;
+ Name_Pred : constant Name_Id := N + 417;
+ Name_Remainder : constant Name_Id := N + 418;
+ Name_Rounding : constant Name_Id := N + 419;
+ Name_Succ : constant Name_Id := N + 420;
+ Name_Truncation : constant Name_Id := N + 421;
+ Name_Value : constant Name_Id := N + 422;
+ Name_Wide_Image : constant Name_Id := N + 423;
+ Name_Wide_Value : constant Name_Id := N + 424;
+ Last_Renamable_Function_Attribute : constant Name_Id := N + 424;
+
+ -- Attributes that designate procedures
+
+ First_Procedure_Attribute : constant Name_Id := N + 425;
+ Name_Output : constant Name_Id := N + 425;
+ Name_Read : constant Name_Id := N + 426;
+ Name_Write : constant Name_Id := N + 427;
+ Last_Procedure_Attribute : constant Name_Id := N + 427;
+
+ -- Remaining attributes are ones that return entities
+
+ First_Entity_Attribute_Name : constant Name_Id := N + 428;
+ Name_Elab_Body : constant Name_Id := N + 428; -- GNAT
+ Name_Elab_Spec : constant Name_Id := N + 429; -- GNAT
+ Name_Storage_Pool : constant Name_Id := N + 430;
+
+ -- These attributes are the ones that return types
+
+ First_Type_Attribute_Name : constant Name_Id := N + 431;
+ Name_Base : constant Name_Id := N + 431;
+ Name_Class : constant Name_Id := N + 432;
+ Last_Type_Attribute_Name : constant Name_Id := N + 432;
+ Last_Entity_Attribute_Name : constant Name_Id := N + 432;
+ Last_Attribute_Name : constant Name_Id := N + 432;
+
+ -- Names of recognized locking policy identifiers
+
+ -- Note: policies are identified by the first character of the
+ -- 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 + 433;
+ Name_Ceiling_Locking : constant Name_Id := N + 433;
+ Name_Inheritance_Locking : constant Name_Id := N + 434;
+ Last_Locking_Policy_Name : constant Name_Id := N + 434;
+
+ -- Names of recognized queuing policy identifiers.
+
+ -- Note: policies are identified by the first character of the
+ -- 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 + 435;
+ Name_FIFO_Queuing : constant Name_Id := N + 435;
+ Name_Priority_Queuing : constant Name_Id := N + 436;
+ Last_Queuing_Policy_Name : constant Name_Id := N + 436;
+
+ -- Names of recognized task dispatching policy identifiers
+
+ -- Note: policies are identified by the first character of the
+ -- 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 + 437;
+ Name_Fifo_Within_Priorities : constant Name_Id := N + 437;
+ Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 437;
+
+ -- Names of recognized checks for pragma Suppress
+
+ First_Check_Name : constant Name_Id := N + 438;
+ Name_Access_Check : constant Name_Id := N + 438;
+ Name_Accessibility_Check : constant Name_Id := N + 439;
+ Name_Discriminant_Check : constant Name_Id := N + 440;
+ Name_Division_Check : constant Name_Id := N + 441;
+ Name_Elaboration_Check : constant Name_Id := N + 442;
+ Name_Index_Check : constant Name_Id := N + 443;
+ Name_Length_Check : constant Name_Id := N + 444;
+ Name_Overflow_Check : constant Name_Id := N + 445;
+ Name_Range_Check : constant Name_Id := N + 446;
+ Name_Storage_Check : constant Name_Id := N + 447;
+ Name_Tag_Check : constant Name_Id := N + 448;
+ Name_All_Checks : constant Name_Id := N + 449;
+ Last_Check_Name : constant Name_Id := N + 449;
+
+ -- Names corresponding to reserved keywords, excluding those already
+ -- declared in the attribute list (Access, Delta, Digits, Range).
+
+ Name_Abort : constant Name_Id := N + 450;
+ Name_Abs : constant Name_Id := N + 451;
+ Name_Accept : constant Name_Id := N + 452;
+ Name_And : constant Name_Id := N + 453;
+ Name_All : constant Name_Id := N + 454;
+ Name_Array : constant Name_Id := N + 455;
+ Name_At : constant Name_Id := N + 456;
+ Name_Begin : constant Name_Id := N + 457;
+ Name_Body : constant Name_Id := N + 458;
+ Name_Case : constant Name_Id := N + 459;
+ Name_Constant : constant Name_Id := N + 460;
+ Name_Declare : constant Name_Id := N + 461;
+ Name_Delay : constant Name_Id := N + 462;
+ Name_Do : constant Name_Id := N + 463;
+ Name_Else : constant Name_Id := N + 464;
+ Name_Elsif : constant Name_Id := N + 465;
+ Name_End : constant Name_Id := N + 466;
+ Name_Entry : constant Name_Id := N + 467;
+ Name_Exception : constant Name_Id := N + 468;
+ Name_Exit : constant Name_Id := N + 469;
+ Name_For : constant Name_Id := N + 470;
+ Name_Function : constant Name_Id := N + 471;
+ Name_Generic : constant Name_Id := N + 472;
+ Name_Goto : constant Name_Id := N + 473;
+ Name_If : constant Name_Id := N + 474;
+ Name_In : constant Name_Id := N + 475;
+ Name_Is : constant Name_Id := N + 476;
+ Name_Limited : constant Name_Id := N + 477;
+ Name_Loop : constant Name_Id := N + 478;
+ Name_Mod : constant Name_Id := N + 479;
+ Name_New : constant Name_Id := N + 480;
+ Name_Not : constant Name_Id := N + 481;
+ Name_Null : constant Name_Id := N + 482;
+ Name_Of : constant Name_Id := N + 483;
+ Name_Or : constant Name_Id := N + 484;
+ Name_Others : constant Name_Id := N + 485;
+ Name_Out : constant Name_Id := N + 486;
+ Name_Package : constant Name_Id := N + 487;
+ Name_Pragma : constant Name_Id := N + 488;
+ Name_Private : constant Name_Id := N + 489;
+ Name_Procedure : constant Name_Id := N + 490;
+ Name_Raise : constant Name_Id := N + 491;
+ Name_Record : constant Name_Id := N + 492;
+ Name_Rem : constant Name_Id := N + 493;
+ Name_Renames : constant Name_Id := N + 494;
+ Name_Return : constant Name_Id := N + 495;
+ Name_Reverse : constant Name_Id := N + 496;
+ Name_Select : constant Name_Id := N + 497;
+ Name_Separate : constant Name_Id := N + 498;
+ Name_Subtype : constant Name_Id := N + 499;
+ Name_Task : constant Name_Id := N + 500;
+ Name_Terminate : constant Name_Id := N + 501;
+ Name_Then : constant Name_Id := N + 502;
+ Name_Type : constant Name_Id := N + 503;
+ Name_Use : constant Name_Id := N + 504;
+ Name_When : constant Name_Id := N + 505;
+ Name_While : constant Name_Id := N + 506;
+ Name_With : constant Name_Id := N + 507;
+ Name_Xor : constant Name_Id := N + 508;
+
+ -- 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 + 509;
+ Name_Divide : constant Name_Id := N + 509;
+ Name_Enclosing_Entity : constant Name_Id := N + 510;
+ Name_Exception_Information : constant Name_Id := N + 511;
+ Name_Exception_Message : constant Name_Id := N + 512;
+ Name_Exception_Name : constant Name_Id := N + 513;
+ Name_File : constant Name_Id := N + 514;
+ Name_Import_Address : constant Name_Id := N + 515;
+ Name_Import_Largest_Value : constant Name_Id := N + 516;
+ Name_Import_Value : constant Name_Id := N + 517;
+ Name_Is_Negative : constant Name_Id := N + 518;
+ Name_Line : constant Name_Id := N + 519;
+ Name_Rotate_Left : constant Name_Id := N + 520;
+ Name_Rotate_Right : constant Name_Id := N + 521;
+ Name_Shift_Left : constant Name_Id := N + 522;
+ Name_Shift_Right : constant Name_Id := N + 523;
+ Name_Shift_Right_Arithmetic : constant Name_Id := N + 524;
+ Name_Source_Location : constant Name_Id := N + 525;
+ Name_Unchecked_Conversion : constant Name_Id := N + 526;
+ Name_Unchecked_Deallocation : constant Name_Id := N + 527;
+ Name_To_Pointer : constant Name_Id := N + 528;
+ Last_Intrinsic_Name : constant Name_Id := N + 528;
+
+ -- Reserved words used only in Ada 95
+
+ First_95_Reserved_Word : constant Name_Id := N + 529;
+ Name_Abstract : constant Name_Id := N + 529;
+ Name_Aliased : constant Name_Id := N + 530;
+ Name_Protected : constant Name_Id := N + 531;
+ Name_Until : constant Name_Id := N + 532;
+ Name_Requeue : constant Name_Id := N + 533;
+ Name_Tagged : constant Name_Id := N + 534;
+ Last_95_Reserved_Word : constant Name_Id := N + 534;
+
+ 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 + 535;
+
+ -- Additional reserved words in GNAT Project Files
+ -- Note that Name_External is already previously declared
+
+ Name_Binder : constant Name_Id := N + 536;
+ Name_Body_Suffix : constant Name_Id := N + 537;
+ Name_Builder : constant Name_Id := N + 538;
+ Name_Compiler : constant Name_Id := N + 539;
+ Name_Cross_Reference : constant Name_Id := N + 540;
+ Name_Default_Switches : constant Name_Id := N + 541;
+ Name_Exec_Dir : constant Name_Id := N + 542;
+ Name_Executable : constant Name_Id := N + 543;
+ Name_Executable_Suffix : constant Name_Id := N + 544;
+ Name_Extends : constant Name_Id := N + 545;
+ Name_Finder : constant Name_Id := N + 546;
+ Name_Global_Configuration_Pragmas : constant Name_Id := N + 547;
+ Name_Gnatls : constant Name_Id := N + 548;
+ Name_Gnatstub : constant Name_Id := N + 549;
+ Name_Implementation : constant Name_Id := N + 550;
+ Name_Implementation_Exceptions : constant Name_Id := N + 551;
+ Name_Implementation_Suffix : constant Name_Id := N + 552;
+ Name_Languages : constant Name_Id := N + 553;
+ Name_Library_Dir : constant Name_Id := N + 554;
+ Name_Library_Auto_Init : constant Name_Id := N + 555;
+ Name_Library_GCC : constant Name_Id := N + 556;
+ Name_Library_Interface : constant Name_Id := N + 557;
+ Name_Library_Kind : constant Name_Id := N + 558;
+ Name_Library_Name : constant Name_Id := N + 559;
+ Name_Library_Options : constant Name_Id := N + 560;
+ Name_Library_Src_Dir : constant Name_Id := N + 561;
+ Name_Library_Symbol_File : constant Name_Id := N + 562;
+ Name_Library_Version : constant Name_Id := N + 563;
+ Name_Linker : constant Name_Id := N + 564;
+ Name_Local_Configuration_Pragmas : constant Name_Id := N + 565;
+ Name_Locally_Removed_Files : constant Name_Id := N + 566;
+ Name_Naming : constant Name_Id := N + 567;
+ Name_Object_Dir : constant Name_Id := N + 568;
+ Name_Pretty_Printer : constant Name_Id := N + 569;
+ Name_Project : constant Name_Id := N + 570;
+ Name_Separate_Suffix : constant Name_Id := N + 571;
+ Name_Source_Dirs : constant Name_Id := N + 572;
+ Name_Source_Files : constant Name_Id := N + 573;
+ Name_Source_List_File : constant Name_Id := N + 574;
+ Name_Spec : constant Name_Id := N + 575;
+ Name_Spec_Suffix : constant Name_Id := N + 576;
+ Name_Specification : constant Name_Id := N + 577;
+ Name_Specification_Exceptions : constant Name_Id := N + 578;
+ Name_Specification_Suffix : constant Name_Id := N + 579;
+ Name_Switches : constant Name_Id := N + 580;
+ -- Other miscellaneous names used in front end
+
+ Name_Unaligned_Valid : constant Name_Id := N + 581;
+
+ -- Mark last defined name for consistency check in Snames body
+
+ Last_Predefined_Name : constant Name_Id := N + 581;
+
+ subtype Any_Operator_Name is Name_Id range
+ First_Operator_Name .. Last_Operator_Name;
+
+ ------------------------------
+ -- Attribute ID Definitions --
+ ------------------------------
+
+ type Attribute_Id is (
+ Attribute_Abort_Signal,
+ Attribute_Access,
+ Attribute_Address,
+ Attribute_Address_Size,
+ Attribute_Aft,
+ Attribute_Alignment,
+ Attribute_Asm_Input,
+ Attribute_Asm_Output,
+ Attribute_AST_Entry,
+ Attribute_Bit,
+ Attribute_Bit_Order,
+ Attribute_Bit_Position,
+ Attribute_Body_Version,
+ Attribute_Callable,
+ Attribute_Caller,
+ Attribute_Code_Address,
+ Attribute_Component_Size,
+ Attribute_Compose,
+ Attribute_Constrained,
+ Attribute_Count,
+ Attribute_Default_Bit_Order,
+ Attribute_Definite,
+ Attribute_Delta,
+ Attribute_Denorm,
+ Attribute_Digits,
+ Attribute_Elaborated,
+ Attribute_Emax,
+ Attribute_Enum_Rep,
+ Attribute_Epsilon,
+ Attribute_Exponent,
+ Attribute_External_Tag,
+ Attribute_First,
+ Attribute_First_Bit,
+ Attribute_Fixed_Value,
+ Attribute_Fore,
+ Attribute_Has_Discriminants,
+ Attribute_Identity,
+ Attribute_Img,
+ Attribute_Integer_Value,
+ Attribute_Large,
+ Attribute_Last,
+ Attribute_Last_Bit,
+ Attribute_Leading_Part,
+ Attribute_Length,
+ Attribute_Machine_Emax,
+ Attribute_Machine_Emin,
+ Attribute_Machine_Mantissa,
+ Attribute_Machine_Overflows,
+ Attribute_Machine_Radix,
+ Attribute_Machine_Rounds,
+ Attribute_Machine_Size,
+ Attribute_Mantissa,
+ Attribute_Max_Size_In_Storage_Elements,
+ Attribute_Maximum_Alignment,
+ Attribute_Mechanism_Code,
+ Attribute_Model_Emin,
+ Attribute_Model_Epsilon,
+ Attribute_Model_Mantissa,
+ Attribute_Model_Small,
+ Attribute_Modulus,
+ Attribute_Null_Parameter,
+ Attribute_Object_Size,
+ Attribute_Partition_ID,
+ Attribute_Passed_By_Reference,
+ Attribute_Pool_Address,
+ Attribute_Pos,
+ Attribute_Position,
+ Attribute_Range,
+ Attribute_Range_Length,
+ Attribute_Round,
+ Attribute_Safe_Emax,
+ Attribute_Safe_First,
+ Attribute_Safe_Large,
+ Attribute_Safe_Last,
+ Attribute_Safe_Small,
+ Attribute_Scale,
+ Attribute_Scaling,
+ Attribute_Signed_Zeros,
+ Attribute_Size,
+ Attribute_Small,
+ Attribute_Storage_Size,
+ Attribute_Storage_Unit,
+ Attribute_Tag,
+ Attribute_Target_Name,
+ Attribute_Terminated,
+ Attribute_To_Address,
+ Attribute_Type_Class,
+ Attribute_UET_Address,
+ Attribute_Unbiased_Rounding,
+ Attribute_Unchecked_Access,
+ Attribute_Unconstrained_Array,
+ Attribute_Universal_Literal_String,
+ Attribute_Unrestricted_Access,
+ Attribute_VADS_Size,
+ Attribute_Val,
+ Attribute_Valid,
+ Attribute_Value_Size,
+ Attribute_Version,
+ Attribute_Wchar_T_Size,
+ Attribute_Wide_Width,
+ Attribute_Width,
+ Attribute_Word_Size,
+
+ -- Attributes designating renamable functions
+
+ Attribute_Adjacent,
+ Attribute_Ceiling,
+ Attribute_Copy_Sign,
+ Attribute_Floor,
+ Attribute_Fraction,
+ Attribute_Image,
+ Attribute_Input,
+ Attribute_Machine,
+ Attribute_Max,
+ Attribute_Min,
+ Attribute_Model,
+ Attribute_Pred,
+ Attribute_Remainder,
+ Attribute_Rounding,
+ Attribute_Succ,
+ Attribute_Truncation,
+ Attribute_Value,
+ Attribute_Wide_Image,
+ Attribute_Wide_Value,
+
+ -- Attributes designating procedures
+
+ Attribute_Output,
+ Attribute_Read,
+ Attribute_Write,
+
+ -- Entity attributes (includes type attributes)
+
+ Attribute_Elab_Body,
+ Attribute_Elab_Spec,
+ Attribute_Storage_Pool,
+
+ -- Type attributes
+
+ Attribute_Base,
+ Attribute_Class);
+
+ ------------------------------------
+ -- Convention Name ID Definitions --
+ ------------------------------------
+
+ type Convention_Id is (
+
+ -- The conventions that are defined by the RM come first
+
+ Convention_Ada,
+ Convention_Intrinsic,
+ Convention_Entry,
+ Convention_Protected,
+
+ -- The remaining conventions are foreign language conventions
+
+ Convention_Assembler, -- also Asm, Assembly
+ Convention_C, -- also Default, External
+ Convention_COBOL,
+ Convention_CPP,
+ Convention_Fortran,
+ Convention_Java,
+ Convention_Stdcall, -- also DLL, Win32
+ Convention_Stubbed);
+
+ -- Note: Convention C_Pass_By_Copy is allowed only for record
+ -- types (where it is treated like C except that the appropriate
+ -- flag is set in the record type). Recognizion of this convention
+ -- is specially handled in Sem_Prag.
+
+ for Convention_Id'Size use 8;
+ -- Plenty of space for expansion
+
+ subtype Foreign_Convention is
+ Convention_Id range Convention_Assembler .. Convention_Stdcall;
+
+ -----------------------------------
+ -- Locking Policy ID Definitions --
+ -----------------------------------
+
+ type Locking_Policy_Id is (
+ Locking_Policy_Inheritance_Locking,
+ Locking_Policy_Ceiling_Locking);
+
+ ---------------------------
+ -- Pragma ID Definitions --
+ ---------------------------
+
+ type Pragma_Id is (
+
+ -- Configuration pragmas
+
+ Pragma_Ada_83,
+ Pragma_Ada_95,
+ Pragma_C_Pass_By_Copy,
+ Pragma_Compile_Time_Warning,
+ Pragma_Component_Alignment,
+ Pragma_Convention_Identifier,
+ Pragma_Discard_Names,
+ Pragma_Elaboration_Checks,
+ Pragma_Eliminate,
+ Pragma_Explicit_Overriding,
+ Pragma_Extend_System,
+ Pragma_Extensions_Allowed,
+ Pragma_External_Name_Casing,
+ Pragma_Float_Representation,
+ Pragma_Initialize_Scalars,
+ Pragma_Interrupt_State,
+ Pragma_License,
+ Pragma_Locking_Policy,
+ Pragma_Long_Float,
+ Pragma_No_Run_Time,
+ Pragma_Normalize_Scalars,
+ Pragma_Polling,
+ Pragma_Persistent_Data,
+ Pragma_Persistent_Object,
+ Pragma_Propagate_Exceptions,
+ Pragma_Queuing_Policy,
+ Pragma_Ravenscar,
+ Pragma_Restricted_Run_Time,
+ Pragma_Restrictions,
+ Pragma_Restriction_Warnings,
+ Pragma_Reviewable,
+ Pragma_Source_File_Name,
+ Pragma_Source_File_Name_Project,
+ Pragma_Style_Checks,
+ Pragma_Suppress,
+ Pragma_Suppress_Exception_Locations,
+ Pragma_Task_Dispatching_Policy,
+ Pragma_Universal_Data,
+ Pragma_Unsuppress,
+ Pragma_Use_VADS_Size,
+ Pragma_Validity_Checks,
+ Pragma_Warnings,
+
+ -- Remaining (non-configuration) pragmas
+
+ Pragma_Abort_Defer,
+ Pragma_All_Calls_Remote,
+ Pragma_Annotate,
+ Pragma_Assert,
+ Pragma_Asynchronous,
+ Pragma_Atomic,
+ Pragma_Atomic_Components,
+ Pragma_Attach_Handler,
+ Pragma_Comment,
+ Pragma_Common_Object,
+ Pragma_Complex_Representation,
+ Pragma_Controlled,
+ Pragma_Convention,
+ Pragma_CPP_Class,
+ Pragma_CPP_Constructor,
+ Pragma_CPP_Virtual,
+ Pragma_CPP_Vtable,
+ Pragma_Debug,
+ Pragma_Elaborate,
+ Pragma_Elaborate_All,
+ Pragma_Elaborate_Body,
+ Pragma_Export,
+ Pragma_Export_Exception,
+ Pragma_Export_Function,
+ Pragma_Export_Object,
+ Pragma_Export_Procedure,
+ Pragma_Export_Value,
+ Pragma_Export_Valued_Procedure,
+ Pragma_External,
+ Pragma_Finalize_Storage_Only,
+ Pragma_Ident,
+ Pragma_Import,
+ Pragma_Import_Exception,
+ Pragma_Import_Function,
+ Pragma_Import_Object,
+ Pragma_Import_Procedure,
+ Pragma_Import_Valued_Procedure,
+ Pragma_Inline,
+ Pragma_Inline_Always,
+ Pragma_Inline_Generic,
+ Pragma_Inspection_Point,
+ Pragma_Interface,
+ Pragma_Interface_Name,
+ Pragma_Interrupt_Handler,
+ Pragma_Interrupt_Priority,
+ Pragma_Java_Constructor,
+ Pragma_Java_Interface,
+ Pragma_Keep_Names,
+ Pragma_Link_With,
+ Pragma_Linker_Alias,
+ Pragma_Linker_Options,
+ Pragma_Linker_Section,
+ Pragma_List,
+ Pragma_Machine_Attribute,
+ Pragma_Main,
+ Pragma_Main_Storage,
+ Pragma_Memory_Size,
+ Pragma_No_Return,
+ Pragma_Obsolescent,
+ Pragma_Optimize,
+ Pragma_Optional_Overriding,
+ Pragma_Overriding,
+ Pragma_Pack,
+ Pragma_Page,
+ Pragma_Passive,
+ Pragma_Preelaborate,
+ Pragma_Priority,
+ Pragma_Psect_Object,
+ Pragma_Pure,
+ Pragma_Pure_Function,
+ Pragma_Remote_Call_Interface,
+ Pragma_Remote_Types,
+ Pragma_Share_Generic,
+ Pragma_Shared,
+ Pragma_Shared_Passive,
+ Pragma_Source_Reference,
+ Pragma_Stream_Convert,
+ Pragma_Subtitle,
+ Pragma_Suppress_All,
+ Pragma_Suppress_Debug_Info,
+ Pragma_Suppress_Initialization,
+ Pragma_System_Name,
+ Pragma_Task_Info,
+ Pragma_Task_Name,
+ Pragma_Task_Storage,
+ Pragma_Thread_Body,
+ Pragma_Time_Slice,
+ Pragma_Title,
+ Pragma_Unchecked_Union,
+ Pragma_Unimplemented_Unit,
+ Pragma_Unreferenced,
+ Pragma_Unreserve_All_Interrupts,
+ Pragma_Volatile,
+ Pragma_Volatile_Components,
+ Pragma_Weak_External,
+
+ -- The following pragmas are on their own, out of order, because of
+ -- the special processing required to deal with the fact that their
+ -- names match existing attribute names.
+
+ Pragma_AST_Entry,
+ Pragma_Storage_Size,
+ Pragma_Storage_Unit,
+
+ -- The value to represent an unknown or unrecognized pragma
+
+ Unknown_Pragma);
+
+ -----------------------------------
+ -- Queuing Policy ID definitions --
+ -----------------------------------
+
+ type Queuing_Policy_Id is (
+ Queuing_Policy_FIFO_Queuing,
+ Queuing_Policy_Priority_Queuing);
+
+ --------------------------------------------
+ -- Task Dispatching Policy ID definitions --
+ --------------------------------------------
+
+ type Task_Dispatching_Policy_Id is (
+ Task_Dispatching_FIFO_Within_Priorities);
+ -- Id values used to identify task dispatching policies
+
+ -----------------
+ -- Subprograms --
+ -----------------
+
+ procedure Initialize;
+ -- Called to initialize the preset names in the names table.
+
+ function Is_Attribute_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized attribute
+
+ function Is_Entity_Attribute_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized entity attribute,
+ -- i.e. an attribute reference that returns an entity.
+
+ function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized attribute that
+ -- designates a procedure (and can therefore appear as a statement).
+
+ function Is_Function_Attribute_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized attribute
+ -- that designates a renameable function, and can therefore appear in
+ -- a renaming statement. Note that not all attributes designating
+ -- functions are renamable, in particular, thos returning a universal
+ -- value cannot be renamed.
+
+ function Is_Type_Attribute_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized type attribute,
+ -- i.e. an attribute reference that returns a type
+
+ function Is_Check_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized suppress check
+ -- as required by pragma Suppress.
+
+ function Is_Convention_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of one of the recognized
+ -- language conventions, as required by pragma Convention, Import,
+ -- Export, Interface. Returns True if so. Also returns True for a
+ -- name that has been specified by a Convention_Identifier pragma.
+ -- If neither case holds, returns False.
+
+ function Is_Locking_Policy_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized locking policy
+
+ function Is_Operator_Symbol_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of an operator symbol
+
+ function Is_Pragma_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized pragma. Note
+ -- that pragmas AST_Entry, Storage_Size, and Storage_Unit are recognized
+ -- as pragmas by this function even though their names are separate from
+ -- the other pragma names.
+
+ function Is_Queuing_Policy_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized queuing policy
+
+ function Is_Task_Dispatching_Policy_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized task
+ -- dispatching policy.
+
+ function Get_Attribute_Id (N : Name_Id) return Attribute_Id;
+ -- Returns Id of attribute corresponding to given name. It is an error to
+ -- call this function with a name that is not the name of a attribute.
+
+ function Get_Convention_Id (N : Name_Id) return Convention_Id;
+ -- Returns Id of language convention corresponding to given name. It is an
+ -- to call this function with a name that is not the name of a convention,
+ -- or one previously given in a call to Record_Convention_Identifier.
+
+ function Get_Check_Id (N : Name_Id) return Check_Id;
+ -- Returns Id of suppress check corresponding to given name. It is an error
+ -- to call this function with a name that is not the name of a check.
+
+ function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id;
+ -- Returns Id of locking policy corresponding to given name. It is an error
+ -- to call this function with a name that is not the name of a check.
+
+ function Get_Pragma_Id (N : Name_Id) return Pragma_Id;
+ -- Returns Id of pragma corresponding to given name. Returns Unknown_Pragma
+ -- if N is not a name of a known (Ada defined or GNAT-specific) pragma.
+ -- Note that the function also works correctly for names of pragmas that
+ -- are not in the main list of pragma Names (AST_Entry, Storage_Size, and
+ -- Storage_Unit (e.g. Name_Storage_Size returns Pragma_Storage_Size).
+
+ function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id;
+ -- Returns Id of queuing policy corresponding to given name. It is an error
+ -- to call this function with a name that is not the name of a check.
+
+ function Get_Task_Dispatching_Policy_Id
+ (N : Name_Id)
+ return Task_Dispatching_Policy_Id;
+ -- Returns Id of task dispatching policy corresponding to given name.
+ -- It is an error to call this function with a name that is not the
+ -- name of a check.
+
+ procedure Record_Convention_Identifier
+ (Id : Name_Id;
+ Convention : Convention_Id);
+ -- A call to this procedure, resulting from an occurrence of a pragma
+ -- Convention_Identifier, records that from now on an occurrence of
+ -- Id will be recognized as a name for the specified convention.
+
+private
+ pragma Inline (Is_Attribute_Name);
+ pragma Inline (Is_Entity_Attribute_Name);
+ pragma Inline (Is_Type_Attribute_Name);
+ pragma Inline (Is_Check_Name);
+ pragma Inline (Is_Locking_Policy_Name);
+ pragma Inline (Is_Operator_Symbol_Name);
+ pragma Inline (Is_Queuing_Policy_Name);
+ pragma Inline (Is_Pragma_Name);
+ pragma Inline (Is_Task_Dispatching_Policy_Name);
+
+end Snames;
diff --git a/gcc/ada/snames.h b/gcc/ada/snames.h index b71c60b..d811227 100644 --- a/gcc/ada/snames.h +++ b/gcc/ada/snames.h @@ -326,21 +326,22 @@ extern unsigned char Get_Pragma_Id (int); #define Pragma_Task_Info 124 #define Pragma_Task_Name 125 #define Pragma_Task_Storage 126 -#define Pragma_Time_Slice 127 -#define Pragma_Title 128 -#define Pragma_Unchecked_Union 129 -#define Pragma_Unimplemented_Unit 130 -#define Pragma_Unreferenced 131 -#define Pragma_Unreserve_All_Interrupts 132 -#define Pragma_Volatile 133 -#define Pragma_Volatile_Components 134 -#define Pragma_Weak_External 135 +#define Pragma_Thread_Body 127 +#define Pragma_Time_Slice 128 +#define Pragma_Title 129 +#define Pragma_Unchecked_Union 130 +#define Pragma_Unimplemented_Unit 131 +#define Pragma_Unreferenced 132 +#define Pragma_Unreserve_All_Interrupts 133 +#define Pragma_Volatile 134 +#define Pragma_Volatile_Components 135 +#define Pragma_Weak_External 136 /* The following are deliberately out of alphabetical order, see Snames */ -#define Pragma_AST_Entry 136 -#define Pragma_Storage_Size 137 -#define Pragma_Storage_Unit 138 +#define Pragma_AST_Entry 137 +#define Pragma_Storage_Size 138 +#define Pragma_Storage_Unit 139 /* Define the numeric values for the conventions. */ diff --git a/gcc/ada/stringt.h b/gcc/ada/stringt.h index 1260909..f204ea6 100644 --- a/gcc/ada/stringt.h +++ b/gcc/ada/stringt.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * Copyright (C) 1992-2001 Free Software Foundation, Inc. * + * Copyright (C) 1992-2003 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- * @@ -26,23 +26,23 @@ /* This file is the C file that corresponds to the Ada package spec Stringt. It was created manually from stringt.ads and stringt.adb - + Note: only the access functions are provided, since the tree transformer is not allowed to modify the tree or its auxiliary structures. - + This package contains routines for handling the strings table which is used to store string constants encountered in the source, and also those additional string constants generated by compile time concatenation and other similar processing. - + A string constant in this table consists of a series of Char_Code values, so that 16-bit character codes can be properly handled if this feature is implemented in the scanner. - + There is no guarantee that hashing is used in the implementation. This means that the caller cannot count on having the same Id value for two identical strings stored separately. - + The String_Id values reference entries in the Strings table, which contains String_Entry records that record the length of each stored string and its starting location in the String_Chars table. */ diff --git a/gcc/ada/sysdep.c b/gcc/ada/sysdep.c index be71095..1d2efad 100644 --- a/gcc/ada/sysdep.c +++ b/gcc/ada/sysdep.c @@ -45,6 +45,9 @@ #include <fcntl.h> #include <sys/stat.h> #include "time.h" +#ifdef VMS +#include <unixio.h> +#endif #else #include "config.h" #include "system.h" diff --git a/gcc/ada/targtyps.c b/gcc/ada/targtyps.c index 1ffaf0e..465edb6 100644 --- a/gcc/ada/targtyps.c +++ b/gcc/ada/targtyps.c @@ -120,21 +120,22 @@ get_target_long_long_size (void) Pos get_target_float_size (void) { - return FLOAT_TYPE_SIZE; + return fp_prec_to_size (FLOAT_TYPE_SIZE); } Pos get_target_double_size (void) { - return DOUBLE_TYPE_SIZE; + return fp_prec_to_size (DOUBLE_TYPE_SIZE); } Pos get_target_long_double_size (void) { - return WIDEST_HARDWARE_FP_SIZE; + return fp_prec_to_size (WIDEST_HARDWARE_FP_SIZE); } + Pos get_target_pointer_size (void) { diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c index 8f52bab..e0eec16 100644 --- a/gcc/ada/trans.c +++ b/gcc/ada/trans.c @@ -4406,7 +4406,7 @@ static void process_decls (List_Id gnat_decls, List_Id gnat_decls2, Node_Id gnat_end_list, - int pass1p, + int pass1p, int pass2p) { List_Id gnat_decl_array[2]; diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c index 85a159b..3a01bbe 100644 --- a/gcc/ada/utils.c +++ b/gcc/ada/utils.c @@ -2306,7 +2306,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) case INTEGER_TYPE: case ENUMERAL_TYPE: if (TYPE_VAX_FLOATING_POINT_P (type)) - switch ((int) TYPE_DIGITS_VALUE (type)) + switch (tree_low_cst (TYPE_DIGITS_VALUE (type), 1)) { case 6: dtype = 10; @@ -2346,7 +2346,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) case COMPLEX_TYPE: if (TREE_CODE (TREE_TYPE (type)) == INTEGER_TYPE && TYPE_VAX_FLOATING_POINT_P (type)) - switch ((int) TYPE_DIGITS_VALUE (type)) + switch (tree_low_cst (TYPE_DIGITS_VALUE (type), 1)) { case 6: dtype = 12; @@ -2544,7 +2544,8 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) /* Utility routine for above code to make a field. */ static tree -make_descriptor_field (const char *name, tree type, tree rec_type, tree initial) +make_descriptor_field (const char *name, tree type, + tree rec_type, tree initial) { tree field = create_field_decl (get_identifier (name), type, rec_type, 0, 0, 0, 0); diff --git a/gcc/ada/utils2.c b/gcc/ada/utils2.c index 736e8b7..a8f228d 100644 --- a/gcc/ada/utils2.c +++ b/gcc/ada/utils2.c @@ -153,8 +153,8 @@ known_alignment (tree exp) We always compute a type_alignment value and return the MAX of it compared with what we get from the expression tree. Just set the type_alignment value to 0 when the type information is to be ignored. */ - type_alignment - = ((POINTER_TYPE_P (TREE_TYPE (exp)) + type_alignment + = ((POINTER_TYPE_P (TREE_TYPE (exp)) && ! TYPE_IS_DUMMY_P (TREE_TYPE (TREE_TYPE (exp)))) ? TYPE_ALIGN (TREE_TYPE (TREE_TYPE (exp))) : 0); @@ -165,7 +165,7 @@ known_alignment (tree exp) case NON_LVALUE_EXPR: /* Conversions between pointers and integers don't change the alignment of the underlying object. */ - this_alignment = known_alignment (TREE_OPERAND (exp, 0)); + this_alignment = known_alignment (TREE_OPERAND (exp, 0)); break; case PLUS_EXPR: @@ -357,7 +357,7 @@ compare_arrays (tree result_type, tree a1, tree a2) tree comparison, this_a1_is_null, this_a2_is_null; /* If the length of the first array is a constant, swap our operands - unless the length of the second array is the constant zero. + unless the length of the second array is the constant zero. Note that we have set the `length' values to the length - 1. */ if (TREE_CODE (length1) == INTEGER_CST && ! integer_zerop (fold (build (PLUS_EXPR, bt, length2, @@ -406,7 +406,7 @@ compare_arrays (tree result_type, tree a1, tree a2) nbt = get_base_type (TREE_TYPE (ub1)); comparison - = build_binary_op (EQ_EXPR, result_type, + = build_binary_op (EQ_EXPR, result_type, build_binary_op (MINUS_EXPR, nbt, ub1, lb1), build_binary_op (MINUS_EXPR, nbt, ub2, lb2)); @@ -491,7 +491,7 @@ compare_arrays (tree result_type, tree a1, tree a2) modulus. */ static tree -nonbinary_modular_operation (enum tree_code op_code, +nonbinary_modular_operation (enum tree_code op_code, tree type, tree lhs, tree rhs) @@ -591,8 +591,8 @@ nonbinary_modular_operation (enum tree_code op_code, have to do here is validate the work done by SEM and handle subtypes. */ tree -build_binary_op (enum tree_code op_code, - tree result_type, +build_binary_op (enum tree_code op_code, + tree result_type, tree left_operand, tree right_operand) { @@ -937,7 +937,7 @@ build_binary_op (enum tree_code op_code, gigi_abort (505); } - /* If we are comparing a fat pointer against zero, we need to + /* If we are comparing a fat pointer against zero, we need to just compare the data pointer. */ else if (TYPE_FAT_POINTER_P (left_base_type) && TREE_CODE (right_operand) == CONSTRUCTOR @@ -1651,7 +1651,7 @@ build_simple_component_ref (tree record_variable, if (DECL_INTERNAL_P (new_field)) { tree field_ref - = build_simple_component_ref (record_variable, + = build_simple_component_ref (record_variable, NULL_TREE, new_field, no_fold_p); ref = build_simple_component_ref (field_ref, NULL_TREE, field, no_fold_p); @@ -1731,7 +1731,7 @@ build_call_alloc_dealloc (tree gnu_obj, if (Present (gnat_proc)) { - /* The storage pools are obviously always tagged types, but the + /* The storage pools are obviously always tagged types, but the secondary stack uses the same mechanism and is not tagged */ if (Is_Tagged_Type (Etype (gnat_pool))) { @@ -1763,7 +1763,7 @@ build_call_alloc_dealloc (tree gnu_obj, convert (gnu_size_type, gnu_size))); gnu_args = chainon (gnu_args, - build_tree_list (NULL_TREE, + build_tree_list (NULL_TREE, convert (gnu_size_type, gnu_align))); gnu_call = build (CALL_EXPR, TREE_TYPE (TREE_TYPE (gnu_proc)), @@ -1776,7 +1776,7 @@ build_call_alloc_dealloc (tree gnu_obj, else { /* The size is the second parameter */ - Entity_Id gnat_size_type + Entity_Id gnat_size_type = Etype (Next_Formal (First_Formal (gnat_proc))); tree gnu_size_type = gnat_to_gnu_type (gnat_size_type); tree gnu_proc = gnat_to_gnu (gnat_proc); @@ -1998,7 +1998,7 @@ build_allocator (tree type, return convert (result_type, result); } -/* Fill in a VMS descriptor for EXPR and return a constructor for it. +/* Fill in a VMS descriptor for EXPR and return a constructor for it. GNAT_FORMAL is how we find the descriptor record. */ tree |