diff options
Diffstat (limited to 'gcc/ada/snames.adb')
| -rw-r--r-- | gcc/ada/snames.adb | 2091 |
1 files changed, 1049 insertions, 1042 deletions
diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb index bdb73ce1595..c80da272b76 100644 --- a/gcc/ada/snames.adb +++ b/gcc/ada/snames.adb @@ -1,1042 +1,1049 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S N A M E S -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- 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#" & - "_atcb#" & - "_chain#" & - "_clean#" & - "_controller#" & - "_entry_bodies#" & - "_expunge#" & - "_final_list#" & - "_idepth#" & - "_init#" & - "_local_final_list#" & - "_master#" & - "_object#" & - "_priority#" & - "_process_atsd#" & - "_secondary_stack#" & - "_service#" & - "_size#" & - "_stack#" & - "_tags#" & - "_task#" & - "_task_id#" & - "_task_info#" & - "_task_name#" & - "_trace_sp#" & - "initialize#" & - "adjust#" & - "finalize#" & - "next#" & - "prev#" & - "_typecode#" & - "_from_any#" & - "_to_any#" & - "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#" & - "no_dsa#" & - "garlic_dsa#" & - "polyorb_dsa#" & - "addr#" & - "async#" & - "get_active_partition_id#" & - "get_rci_package_receiver#" & - "get_rci_package_ref#" & - "origin#" & - "params#" & - "partition#" & - "partition_interface#" & - "ras#" & - "call#" & - "rci_name#" & - "receiver#" & - "result#" & - "rpc#" & - "subp_id#" & - "operation#" & - "argument#" & - "arg_modes#" & - "handler#" & - "target#" & - "req#" & - "obj_typecode#" & - "stub#" & - "Oabs#" & - "Oand#" & - "Omod#" & - "Onot#" & - "Oor#" & - "Orem#" & - "Oxor#" & - "Oeq#" & - "One#" & - "Olt#" & - "Ole#" & - "Ogt#" & - "Oge#" & - "Oadd#" & - "Osubtract#" & - "Oconcat#" & - "Omultiply#" & - "Odivide#" & - "Oexpon#" & - "ada_83#" & - "ada_95#" & - "ada_05#" & - "c_pass_by_copy#" & - "compile_time_warning#" & - "component_alignment#" & - "convention_identifier#" & - "detect_blocking#" & - "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#" & - "no_strict_aliasing#" & - "normalize_scalars#" & - "polling#" & - "persistent_data#" & - "persistent_object#" & - "profile#" & - "profile_warnings#" & - "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#" & - "boolean_entry_barriers#" & - "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#" & - "internal#" & - "link_name#" & - "lowercase#" & - "max_entry_queue_depth#" & - "max_entry_queue_length#" & - "max_size#" & - "mechanism#" & - "mixedcase#" & - "modified_gpl#" & - "name#" & - "nca#" & - "no#" & - "no_dependence#" & - "no_dynamic_attachment#" & - "no_dynamic_interrupts#" & - "no_requeue#" & - "no_requeue_statements#" & - "no_task_attributes#" & - "no_task_attributes_package#" & - "on#" & - "parameter_types#" & - "reference#" & - "restricted#" & - "result_mechanism#" & - "result_type#" & - "runtime#" & - "sb#" & - "secondary_stack_size#" & - "section#" & - "semaphore#" & - "simple_barriers#" & - "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_access_values#" & - "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#" & - "mod#" & - "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#" & - "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#" & - "ada_roots#" & - "binder#" & - "binder_driver#" & - "body_suffix#" & - "builder#" & - "compiler#" & - "compiler_driver#" & - "compiler_kind#" & - "compute_dependency#" & - "cross_reference#" & - "default_linker#" & - "default_switches#" & - "dependency_option#" & - "exec_dir#" & - "executable#" & - "executable_suffix#" & - "extends#" & - "externally_built#" & - "finder#" & - "global_configuration_pragmas#" & - "gnatls#" & - "gnatstub#" & - "implementation#" & - "implementation_exceptions#" & - "implementation_suffix#" & - "include_option#" & - "language_processing#" & - "languages#" & - "library_dir#" & - "library_auto_init#" & - "library_gcc#" & - "library_interface#" & - "library_kind#" & - "library_name#" & - "library_options#" & - "library_reference_symbol_file#" & - "library_src_dir#" & - "library_symbol_file#" & - "library_symbol_policy#" & - "library_version#" & - "linker#" & - "local_configuration_pragmas#" & - "locally_removed_files#" & - "metrics#" & - "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) - -- xxxSA array/slice assignment for controlled comp. arrays (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-2005, 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#" &
+ "_atcb#" &
+ "_chain#" &
+ "_clean#" &
+ "_controller#" &
+ "_entry_bodies#" &
+ "_expunge#" &
+ "_final_list#" &
+ "_idepth#" &
+ "_init#" &
+ "_local_final_list#" &
+ "_master#" &
+ "_object#" &
+ "_priority#" &
+ "_process_atsd#" &
+ "_secondary_stack#" &
+ "_service#" &
+ "_size#" &
+ "_stack#" &
+ "_tags#" &
+ "_task#" &
+ "_task_id#" &
+ "_task_info#" &
+ "_task_name#" &
+ "_trace_sp#" &
+ "initialize#" &
+ "adjust#" &
+ "finalize#" &
+ "next#" &
+ "prev#" &
+ "_typecode#" &
+ "_from_any#" &
+ "_to_any#" &
+ "allocate#" &
+ "deallocate#" &
+ "dereference#" &
+ "decimal_io#" &
+ "enumeration_io#" &
+ "fixed_io#" &
+ "float_io#" &
+ "integer_io#" &
+ "modular_io#" &
+ "const#" &
+ "<error>#" &
+ "go#" &
+ "put#" &
+ "put_line#" &
+ "to#" &
+ "finalization#" &
+ "finalization_root#" &
+ "interfaces#" &
+ "standard#" &
+ "system#" &
+ "text_io#" &
+ "wide_text_io#" &
+ "wide_wide_text_io#" &
+ "no_dsa#" &
+ "garlic_dsa#" &
+ "polyorb_dsa#" &
+ "addr#" &
+ "async#" &
+ "get_active_partition_id#" &
+ "get_rci_package_receiver#" &
+ "get_rci_package_ref#" &
+ "origin#" &
+ "params#" &
+ "partition#" &
+ "partition_interface#" &
+ "ras#" &
+ "call#" &
+ "rci_name#" &
+ "receiver#" &
+ "result#" &
+ "rpc#" &
+ "subp_id#" &
+ "operation#" &
+ "argument#" &
+ "arg_modes#" &
+ "handler#" &
+ "target#" &
+ "req#" &
+ "obj_typecode#" &
+ "stub#" &
+ "Oabs#" &
+ "Oand#" &
+ "Omod#" &
+ "Onot#" &
+ "Oor#" &
+ "Orem#" &
+ "Oxor#" &
+ "Oeq#" &
+ "One#" &
+ "Olt#" &
+ "Ole#" &
+ "Ogt#" &
+ "Oge#" &
+ "Oadd#" &
+ "Osubtract#" &
+ "Oconcat#" &
+ "Omultiply#" &
+ "Odivide#" &
+ "Oexpon#" &
+ "ada_83#" &
+ "ada_95#" &
+ "ada_05#" &
+ "c_pass_by_copy#" &
+ "compile_time_warning#" &
+ "component_alignment#" &
+ "convention_identifier#" &
+ "detect_blocking#" &
+ "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#" &
+ "no_strict_aliasing#" &
+ "normalize_scalars#" &
+ "polling#" &
+ "persistent_data#" &
+ "persistent_object#" &
+ "profile#" &
+ "profile_warnings#" &
+ "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_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#" &
+ "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#" &
+ "boolean_entry_barriers#" &
+ "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#" &
+ "internal#" &
+ "link_name#" &
+ "lowercase#" &
+ "max_entry_queue_depth#" &
+ "max_entry_queue_length#" &
+ "max_size#" &
+ "mechanism#" &
+ "mixedcase#" &
+ "modified_gpl#" &
+ "name#" &
+ "nca#" &
+ "no#" &
+ "no_dependence#" &
+ "no_dynamic_attachment#" &
+ "no_dynamic_interrupts#" &
+ "no_requeue#" &
+ "no_requeue_statements#" &
+ "no_task_attributes#" &
+ "no_task_attributes_package#" &
+ "on#" &
+ "parameter_types#" &
+ "reference#" &
+ "restricted#" &
+ "result_mechanism#" &
+ "result_type#" &
+ "runtime#" &
+ "sb#" &
+ "secondary_stack_size#" &
+ "section#" &
+ "semaphore#" &
+ "simple_barriers#" &
+ "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_access_values#" &
+ "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#" &
+ "mod#" &
+ "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#" &
+ "stream_size#" &
+ "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_wide_width#" &
+ "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_wide_image#" &
+ "wide_value#" &
+ "wide_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#" &
+ "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#" &
+ "ada_roots#" &
+ "binder#" &
+ "binder_driver#" &
+ "body_suffix#" &
+ "builder#" &
+ "compiler#" &
+ "compiler_driver#" &
+ "compiler_kind#" &
+ "compute_dependency#" &
+ "cross_reference#" &
+ "default_linker#" &
+ "default_switches#" &
+ "dependency_option#" &
+ "exec_dir#" &
+ "executable#" &
+ "executable_suffix#" &
+ "extends#" &
+ "externally_built#" &
+ "finder#" &
+ "global_configuration_pragmas#" &
+ "gnatls#" &
+ "gnatstub#" &
+ "implementation#" &
+ "implementation_exceptions#" &
+ "implementation_suffix#" &
+ "include_option#" &
+ "language_processing#" &
+ "languages#" &
+ "library_dir#" &
+ "library_auto_init#" &
+ "library_gcc#" &
+ "library_interface#" &
+ "library_kind#" &
+ "library_name#" &
+ "library_options#" &
+ "library_reference_symbol_file#" &
+ "library_src_dir#" &
+ "library_symbol_file#" &
+ "library_symbol_policy#" &
+ "library_version#" &
+ "linker#" &
+ "local_configuration_pragmas#" &
+ "locally_removed_files#" &
+ "metrics#" &
+ "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#" &
+ "interface#" &
+ "overriding#" &
+ "synchronized#" &
+ "#";
+
+ ---------------------
+ -- 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)
+ -- xxxSA array/slice assignment for controlled comp. arrays (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_Interface then
+ return Pragma_Interface;
+ 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_Interface
+ 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;
|