1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
11 -- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- As a special exception, if other files instantiate generics from this --
25 -- unit, or you link this unit with other files to produce an executable, --
26 -- this unit does not by itself cause the resulting executable to be --
27 -- covered by the GNU General Public License. This exception does not --
28 -- however invalidate any other reasons why the executable file might be --
29 -- covered by the GNU Public License. --
31 -- GNAT was originally developed by the GNAT team at New York University. --
32 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
34 ------------------------------------------------------------------------------
36 with Namet; use Namet;
38 package body Snames is
40 -- Table of names to be set by Initialize. Each name is terminated by a
41 -- single #, and the end of the list is marked by a null entry, i.e. by
42 -- two # marks in succession. Note that the table does not include the
43 -- entries for a-z, since these are initialized by Namet itself.
45 Preset_Names : constant String :=
54 "_address_resolver#" &
64 "_local_final_list#" &
109 "finalization_root#" &
117 "get_active_partition_id#" &
118 "get_rci_package_receiver#" &
122 "partition_interface#" &
151 "component_alignment#" &
153 "elaboration_checks#" &
156 "extensions_allowed#" &
157 "external_name_casing#" &
158 "float_representation#" &
159 "initialize_scalars#" &
164 "normalize_scalars#" &
166 "propagate_exceptions#" &
169 "restricted_run_time#" &
172 "source_file_name#" &
175 "task_dispatching_policy#" &
181 "all_calls_remote#" &
186 "atomic_components#" &
190 "complex_representation#" &
202 "export_exception#" &
205 "export_procedure#" &
206 "export_valued_procedure#" &
208 "finalize_storage_only#" &
211 "import_exception#" &
214 "import_procedure#" &
215 "import_valued_procedure#" &
219 "inspection_point#" &
222 "interrupt_handler#" &
223 "interrupt_priority#" &
224 "java_constructor#" &
231 "machine_attribute#" &
245 "remote_call_interface#" &
250 "source_reference#" &
254 "suppress_debug_info#" &
255 "suppress_initialization#" &
263 "unimplemented_unit#" &
264 "unreserve_all_interrupts#" &
266 "volatile_components#" &
285 "component_size_4#" &
294 "first_optional_parameter#" &
315 "result_mechanism#" &
323 "subunit_file_name#" &
324 "task_stack_size_default#" &
326 "time_slicing_enabled#" &
358 "default_bit_order#" &
373 "has_discriminants#" &
384 "machine_mantissa#" &
385 "machine_overflows#" &
390 "max_interrupt_priority#" &
392 "max_size_in_storage_elements#" &
393 "maximum_alignment#" &
403 "passed_by_reference#" &
427 "unbiased_rounding#" &
428 "unchecked_access#" &
429 "universal_literal_string#" &
430 "unrestricted_access#" &
468 "inheritance_locking#" &
470 "priority_queuing#" &
471 "fifo_within_priorities#" &
473 "accessibility_check#" &
474 "discriminant_check#" &
476 "elaboration_check#" &
544 "enclosing_entity#" &
545 "exception_information#" &
546 "exception_message#" &
550 "import_largest_value#" &
558 "shift_right_arithmetic#" &
560 "unchecked_conversion#" &
561 "unchecked_deallocation#" &
576 "specification_append#" &
580 "source_list_file#" &
586 "library_elaboration#" &
598 ---------------------
599 -- Generated Names --
600 ---------------------
602 -- This section lists the various cases of generated names which are
603 -- built from existing names by adding unique leading and/or trailing
604 -- upper case letters. In some cases these names are built recursively,
605 -- in particular names built from types may be built from types which
606 -- themselves have generated names. In this list, xxx represents an
607 -- existing name to which identifying letters are prepended or appended,
608 -- and a trailing n represents a serial number in an external name that
609 -- has some semantic significance (e.g. the n'th index type of an array).
611 -- xxxA access type for formal xxx in entry param record (Exp_Ch9)
612 -- xxxB tag table for tagged type xxx (Exp_Ch3)
613 -- xxxB task body procedure for task xxx (Exp_Ch9)
614 -- xxxD dispatch table for tagged type xxx (Exp_Ch3)
615 -- xxxD discriminal for discriminant xxx (Sem_Ch3)
616 -- xxxDn n'th discr check function for rec type xxx (Exp_Ch3)
617 -- xxxE elaboration boolean flag for task xxx (Exp_Ch9)
618 -- xxxE dispatch table pointer type for tagged type xxx (Exp_Ch3)
619 -- xxxE parameters for accept body for entry xxx (Exp_Ch9)
620 -- xxxFn n'th primitive of a tagged type (named xxx) (Exp_Ch3)
621 -- xxxI initialization procedure for type xxx (Exp_Ch3)
622 -- xxxJ tag table type index for tagged type xxx (Exp_Ch3)
623 -- xxxM master Id value for access type xxx (Exp_Ch3)
624 -- xxxP tag table pointer type for tagged type xxx (Exp_Ch3)
625 -- xxxP parameter record type for entry xxx (Exp_Ch9)
626 -- xxxPA access to parameter record type for entry xxx (Exp_Ch9)
627 -- xxxPn pointer type for n'th primitive of tagged type xxx (Exp_Ch3)
628 -- xxxR dispatch table pointer for tagged type xxx (Exp_Ch3)
629 -- xxxT tag table type for tagged type xxx (Exp_Ch3)
630 -- xxxT literal table for enumeration type xxx (Sem_Ch3)
631 -- xxxV type for task value record for task xxx (Exp_Ch9)
632 -- xxxX entry index constant (Exp_Ch9)
633 -- xxxY dispatch table type for tagged type xxx (Exp_Ch3)
634 -- xxxZ size variable for task xxx (Exp_Ch9)
636 -- Implicit type names
638 -- TxxxT type of literal table for enumeration type xxx (Sem_Ch3)
640 -- (list not yet complete ???)
642 ----------------------
643 -- Get_Attribute_Id --
644 ----------------------
646 function Get_Attribute_Id (N : Name_Id) return Attribute_Id is
648 return Attribute_Id'Val (N - First_Attribute_Name);
649 end Get_Attribute_Id;
655 function Get_Check_Id (N : Name_Id) return Check_Id is
657 return Check_Id'Val (N - First_Check_Name);
660 -----------------------
661 -- Get_Convention_Id --
662 -----------------------
664 function Get_Convention_Id (N : Name_Id) return Convention_Id is
667 when Name_Ada => return Convention_Ada;
668 when Name_Asm => return Convention_Assembler;
669 when Name_Assembler => return Convention_Assembler;
670 when Name_C => return Convention_C;
671 when Name_COBOL => return Convention_COBOL;
672 when Name_CPP => return Convention_CPP;
673 when Name_DLL => return Convention_Stdcall;
674 when Name_Fortran => return Convention_Fortran;
675 when Name_Intrinsic => return Convention_Intrinsic;
676 when Name_Java => return Convention_Java;
677 when Name_Stdcall => return Convention_Stdcall;
678 when Name_Stubbed => return Convention_Stubbed;
679 when Name_Win32 => return Convention_Stdcall;
683 end Get_Convention_Id;
685 ---------------------------
686 -- Get_Locking_Policy_Id --
687 ---------------------------
689 function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id is
691 return Locking_Policy_Id'Val (N - First_Locking_Policy_Name);
692 end Get_Locking_Policy_Id;
698 function Get_Pragma_Id (N : Name_Id) return Pragma_Id is
700 if N = Name_AST_Entry then
701 return Pragma_AST_Entry;
702 elsif N = Name_Storage_Size then
703 return Pragma_Storage_Size;
704 elsif N = Name_Storage_Unit then
705 return Pragma_Storage_Unit;
707 return Pragma_Id'Val (N - First_Pragma_Name);
711 ---------------------------
712 -- Get_Queuing_Policy_Id --
713 ---------------------------
715 function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id is
717 return Queuing_Policy_Id'Val (N - First_Queuing_Policy_Name);
718 end Get_Queuing_Policy_Id;
720 ------------------------------------
721 -- Get_Task_Dispatching_Policy_Id --
722 ------------------------------------
724 function Get_Task_Dispatching_Policy_Id (N : Name_Id)
725 return Task_Dispatching_Policy_Id is
727 return Task_Dispatching_Policy_Id'Val
728 (N - First_Task_Dispatching_Policy_Name);
729 end Get_Task_Dispatching_Policy_Id;
735 procedure Initialize is
737 Discard_Name : Name_Id;
740 P_Index := Preset_Names'First;
745 while Preset_Names (P_Index) /= '#' loop
746 Name_Len := Name_Len + 1;
747 Name_Buffer (Name_Len) := Preset_Names (P_Index);
748 P_Index := P_Index + 1;
751 -- We do the Name_Find call to enter the name into the table, but
752 -- we don't need to do anything with the result, since we already
753 -- initialized all the preset names to have the right value (we
754 -- are depending on the order of the names and Preset_Names).
756 Discard_Name := Name_Find;
757 P_Index := P_Index + 1;
758 exit when Preset_Names (P_Index) = '#';
761 -- Make sure that number of names in standard table is correct. If
762 -- this check fails, run utility program XSNAMES to construct a new
763 -- properly matching version of the body.
765 pragma Assert (Discard_Name = Last_Predefined_Name);
768 -----------------------
769 -- Is_Attribute_Name --
770 -----------------------
772 function Is_Attribute_Name (N : Name_Id) return Boolean is
774 return N in First_Attribute_Name .. Last_Attribute_Name;
775 end Is_Attribute_Name;
781 function Is_Check_Name (N : Name_Id) return Boolean is
783 return N in First_Check_Name .. Last_Check_Name;
786 ------------------------
787 -- Is_Convention_Name --
788 ------------------------
790 function Is_Convention_Name (N : Name_Id) return Boolean is
792 return N in First_Convention_Name .. Last_Convention_Name
794 end Is_Convention_Name;
796 ------------------------------
797 -- Is_Entity_Attribute_Name --
798 ------------------------------
800 function Is_Entity_Attribute_Name (N : Name_Id) return Boolean is
802 return N in First_Entity_Attribute_Name .. Last_Entity_Attribute_Name;
803 end Is_Entity_Attribute_Name;
805 --------------------------------
806 -- Is_Function_Attribute_Name --
807 --------------------------------
809 function Is_Function_Attribute_Name (N : Name_Id) return Boolean is
812 First_Renamable_Function_Attribute ..
813 Last_Renamable_Function_Attribute;
814 end Is_Function_Attribute_Name;
816 ----------------------------
817 -- Is_Locking_Policy_Name --
818 ----------------------------
820 function Is_Locking_Policy_Name (N : Name_Id) return Boolean is
822 return N in First_Locking_Policy_Name .. Last_Locking_Policy_Name;
823 end Is_Locking_Policy_Name;
825 -----------------------------
826 -- Is_Operator_Symbol_Name --
827 -----------------------------
829 function Is_Operator_Symbol_Name (N : Name_Id) return Boolean is
831 return N in First_Operator_Name .. Last_Operator_Name;
832 end Is_Operator_Symbol_Name;
838 function Is_Pragma_Name (N : Name_Id) return Boolean is
840 return N in First_Pragma_Name .. Last_Pragma_Name
841 or else N = Name_AST_Entry
842 or else N = Name_Storage_Size
843 or else N = Name_Storage_Unit;
846 ---------------------------------
847 -- Is_Procedure_Attribute_Name --
848 ---------------------------------
850 function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean is
852 return N in First_Procedure_Attribute .. Last_Procedure_Attribute;
853 end Is_Procedure_Attribute_Name;
855 ----------------------------
856 -- Is_Queuing_Policy_Name --
857 ----------------------------
859 function Is_Queuing_Policy_Name (N : Name_Id) return Boolean is
861 return N in First_Queuing_Policy_Name .. Last_Queuing_Policy_Name;
862 end Is_Queuing_Policy_Name;
864 -------------------------------------
865 -- Is_Task_Dispatching_Policy_Name --
866 -------------------------------------
868 function Is_Task_Dispatching_Policy_Name (N : Name_Id) return Boolean is
870 return N in First_Task_Dispatching_Policy_Name ..
871 Last_Task_Dispatching_Policy_Name;
872 end Is_Task_Dispatching_Policy_Name;
874 ----------------------------
875 -- Is_Type_Attribute_Name --
876 ----------------------------
878 function Is_Type_Attribute_Name (N : Name_Id) return Boolean is
880 return N in First_Type_Attribute_Name .. Last_Type_Attribute_Name;
881 end Is_Type_Attribute_Name;