]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/ada/snames.adb
trans-array.c (gfc_conv_descriptor_data_get): Rename from gfc_conv_descriptor_data.
[thirdparty/gcc.git] / gcc / ada / snames.adb
CommitLineData
1a49cf99
AC
1------------------------------------------------------------------------------
2-- --
3-- GNAT COMPILER COMPONENTS --
4-- --
5-- S N A M E S --
6-- --
7-- B o d y --
8-- --
9-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
10-- --
11-- GNAT is free software; you can redistribute it and/or modify it under --
12-- terms of the GNU General Public License as published by the Free Soft- --
13-- ware Foundation; either version 2, or (at your option) any later ver- --
14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17-- for more details. You should have received a copy of the GNU General --
18-- Public License distributed with GNAT; see file COPYING. If not, write --
19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20-- MA 02111-1307, USA. --
21-- --
22-- As a special exception, if other files instantiate generics from this --
23-- unit, or you link this unit with other files to produce an executable, --
24-- this unit does not by itself cause the resulting executable to be --
25-- covered by the GNU General Public License. This exception does not --
26-- however invalidate any other reasons why the executable file might be --
27-- covered by the GNU Public License. --
28-- --
29-- GNAT was originally developed by the GNAT team at New York University. --
30-- Extensive contributions were provided by Ada Core Technologies Inc. --
31-- --
32------------------------------------------------------------------------------
33
34with Namet; use Namet;
35with Table;
36
37package body Snames is
38
39 -- Table used to record convention identifiers
40
41 type Convention_Id_Entry is record
42 Name : Name_Id;
43 Convention : Convention_Id;
44 end record;
45
46 package Convention_Identifiers is new Table.Table (
47 Table_Component_Type => Convention_Id_Entry,
48 Table_Index_Type => Int,
49 Table_Low_Bound => 1,
50 Table_Initial => 50,
51 Table_Increment => 200,
52 Table_Name => "Name_Convention_Identifiers");
53
54 -- Table of names to be set by Initialize. Each name is terminated by a
55 -- single #, and the end of the list is marked by a null entry, i.e. by
56 -- two # marks in succession. Note that the table does not include the
57 -- entries for a-z, since these are initialized by Namet itself.
58
59 Preset_Names : constant String :=
60 "_parent#" &
61 "_tag#" &
62 "off#" &
63 "space#" &
64 "time#" &
65 "_abort_signal#" &
66 "_alignment#" &
67 "_assign#" &
68 "_atcb#" &
69 "_chain#" &
70 "_clean#" &
71 "_controller#" &
72 "_entry_bodies#" &
73 "_expunge#" &
74 "_final_list#" &
75 "_idepth#" &
76 "_init#" &
77 "_local_final_list#" &
78 "_master#" &
79 "_object#" &
80 "_priority#" &
81 "_process_atsd#" &
82 "_secondary_stack#" &
83 "_service#" &
84 "_size#" &
85 "_stack#" &
86 "_tags#" &
87 "_task#" &
88 "_task_id#" &
89 "_task_info#" &
90 "_task_name#" &
91 "_trace_sp#" &
92 "initialize#" &
93 "adjust#" &
94 "finalize#" &
95 "next#" &
96 "prev#" &
97 "_typecode#" &
98 "_from_any#" &
99 "_to_any#" &
100 "allocate#" &
101 "deallocate#" &
102 "dereference#" &
103 "decimal_io#" &
104 "enumeration_io#" &
105 "fixed_io#" &
106 "float_io#" &
107 "integer_io#" &
108 "modular_io#" &
109 "const#" &
110 "<error>#" &
111 "go#" &
112 "put#" &
113 "put_line#" &
114 "to#" &
115 "finalization#" &
116 "finalization_root#" &
117 "interfaces#" &
118 "standard#" &
119 "system#" &
120 "text_io#" &
121 "wide_text_io#" &
122 "wide_wide_text_io#" &
123 "no_dsa#" &
124 "garlic_dsa#" &
125 "polyorb_dsa#" &
126 "addr#" &
127 "async#" &
128 "get_active_partition_id#" &
129 "get_rci_package_receiver#" &
130 "get_rci_package_ref#" &
131 "origin#" &
132 "params#" &
133 "partition#" &
134 "partition_interface#" &
135 "ras#" &
136 "call#" &
137 "rci_name#" &
138 "receiver#" &
139 "result#" &
140 "rpc#" &
141 "subp_id#" &
142 "operation#" &
143 "argument#" &
144 "arg_modes#" &
145 "handler#" &
146 "target#" &
147 "req#" &
148 "obj_typecode#" &
149 "stub#" &
150 "Oabs#" &
151 "Oand#" &
152 "Omod#" &
153 "Onot#" &
154 "Oor#" &
155 "Orem#" &
156 "Oxor#" &
157 "Oeq#" &
158 "One#" &
159 "Olt#" &
160 "Ole#" &
161 "Ogt#" &
162 "Oge#" &
163 "Oadd#" &
164 "Osubtract#" &
165 "Oconcat#" &
166 "Omultiply#" &
167 "Odivide#" &
168 "Oexpon#" &
169 "ada_83#" &
170 "ada_95#" &
171 "ada_05#" &
172 "c_pass_by_copy#" &
173 "compile_time_warning#" &
174 "component_alignment#" &
175 "convention_identifier#" &
176 "detect_blocking#" &
177 "discard_names#" &
178 "elaboration_checks#" &
179 "eliminate#" &
180 "explicit_overriding#" &
181 "extend_system#" &
182 "extensions_allowed#" &
183 "external_name_casing#" &
184 "float_representation#" &
185 "initialize_scalars#" &
186 "interrupt_state#" &
187 "license#" &
188 "locking_policy#" &
189 "long_float#" &
190 "no_run_time#" &
191 "no_strict_aliasing#" &
192 "normalize_scalars#" &
193 "polling#" &
194 "persistent_data#" &
195 "persistent_object#" &
196 "profile#" &
197 "profile_warnings#" &
198 "propagate_exceptions#" &
199 "queuing_policy#" &
200 "ravenscar#" &
201 "restricted_run_time#" &
202 "restrictions#" &
203 "restriction_warnings#" &
204 "reviewable#" &
205 "source_file_name#" &
206 "source_file_name_project#" &
207 "style_checks#" &
208 "suppress#" &
209 "suppress_exception_locations#" &
210 "task_dispatching_policy#" &
211 "universal_data#" &
212 "unsuppress#" &
213 "use_vads_size#" &
214 "validity_checks#" &
215 "warnings#" &
216 "abort_defer#" &
217 "all_calls_remote#" &
218 "annotate#" &
219 "assert#" &
220 "asynchronous#" &
221 "atomic#" &
222 "atomic_components#" &
223 "attach_handler#" &
224 "comment#" &
225 "common_object#" &
226 "complex_representation#" &
227 "controlled#" &
228 "convention#" &
229 "cpp_class#" &
230 "cpp_constructor#" &
231 "cpp_virtual#" &
232 "cpp_vtable#" &
233 "debug#" &
234 "elaborate#" &
235 "elaborate_all#" &
236 "elaborate_body#" &
237 "export#" &
238 "export_exception#" &
239 "export_function#" &
240 "export_object#" &
241 "export_procedure#" &
242 "export_value#" &
243 "export_valued_procedure#" &
244 "external#" &
245 "finalize_storage_only#" &
246 "ident#" &
247 "import#" &
248 "import_exception#" &
249 "import_function#" &
250 "import_object#" &
251 "import_procedure#" &
252 "import_valued_procedure#" &
253 "inline#" &
254 "inline_always#" &
255 "inline_generic#" &
256 "inspection_point#" &
257 "interface_name#" &
258 "interrupt_handler#" &
259 "interrupt_priority#" &
260 "java_constructor#" &
261 "java_interface#" &
262 "keep_names#" &
263 "link_with#" &
264 "linker_alias#" &
265 "linker_options#" &
266 "linker_section#" &
267 "list#" &
268 "machine_attribute#" &
269 "main#" &
270 "main_storage#" &
271 "memory_size#" &
272 "no_return#" &
273 "obsolescent#" &
274 "optimize#" &
275 "optional_overriding#" &
276 "pack#" &
277 "page#" &
278 "passive#" &
279 "preelaborate#" &
280 "priority#" &
281 "psect_object#" &
282 "pure#" &
283 "pure_function#" &
284 "remote_call_interface#" &
285 "remote_types#" &
286 "share_generic#" &
287 "shared#" &
288 "shared_passive#" &
289 "source_reference#" &
290 "stream_convert#" &
291 "subtitle#" &
292 "suppress_all#" &
293 "suppress_debug_info#" &
294 "suppress_initialization#" &
295 "system_name#" &
296 "task_info#" &
297 "task_name#" &
298 "task_storage#" &
299 "thread_body#" &
300 "time_slice#" &
301 "title#" &
302 "unchecked_union#" &
303 "unimplemented_unit#" &
304 "unreferenced#" &
305 "unreserve_all_interrupts#" &
306 "volatile#" &
307 "volatile_components#" &
308 "weak_external#" &
309 "ada#" &
310 "assembler#" &
311 "cobol#" &
312 "cpp#" &
313 "fortran#" &
314 "intrinsic#" &
315 "java#" &
316 "stdcall#" &
317 "stubbed#" &
318 "asm#" &
319 "assembly#" &
320 "default#" &
321 "dll#" &
322 "win32#" &
323 "as_is#" &
324 "body_file_name#" &
325 "boolean_entry_barriers#" &
326 "casing#" &
327 "code#" &
328 "component#" &
329 "component_size_4#" &
330 "copy#" &
331 "d_float#" &
332 "descriptor#" &
333 "dot_replacement#" &
334 "dynamic#" &
335 "entity#" &
336 "external_name#" &
337 "first_optional_parameter#" &
338 "form#" &
339 "g_float#" &
340 "gcc#" &
341 "gnat#" &
342 "gpl#" &
343 "ieee_float#" &
344 "internal#" &
345 "link_name#" &
346 "lowercase#" &
347 "max_entry_queue_depth#" &
348 "max_entry_queue_length#" &
349 "max_size#" &
350 "mechanism#" &
351 "mixedcase#" &
352 "modified_gpl#" &
353 "name#" &
354 "nca#" &
355 "no#" &
356 "no_dependence#" &
357 "no_dynamic_attachment#" &
358 "no_dynamic_interrupts#" &
359 "no_requeue#" &
360 "no_requeue_statements#" &
361 "no_task_attributes#" &
362 "no_task_attributes_package#" &
363 "on#" &
364 "parameter_types#" &
365 "reference#" &
366 "restricted#" &
367 "result_mechanism#" &
368 "result_type#" &
369 "runtime#" &
370 "sb#" &
371 "secondary_stack_size#" &
372 "section#" &
373 "semaphore#" &
374 "simple_barriers#" &
375 "spec_file_name#" &
376 "static#" &
377 "stack_size#" &
378 "subunit_file_name#" &
379 "task_stack_size_default#" &
380 "task_type#" &
381 "time_slicing_enabled#" &
382 "top_guard#" &
383 "uba#" &
384 "ubs#" &
385 "ubsb#" &
386 "unit_name#" &
387 "unknown#" &
388 "unrestricted#" &
389 "uppercase#" &
390 "user#" &
391 "vax_float#" &
392 "vms#" &
393 "working_storage#" &
394 "abort_signal#" &
395 "access#" &
396 "address#" &
397 "address_size#" &
398 "aft#" &
399 "alignment#" &
400 "asm_input#" &
401 "asm_output#" &
402 "ast_entry#" &
403 "bit#" &
404 "bit_order#" &
405 "bit_position#" &
406 "body_version#" &
407 "callable#" &
408 "caller#" &
409 "code_address#" &
410 "component_size#" &
411 "compose#" &
412 "constrained#" &
413 "count#" &
414 "default_bit_order#" &
415 "definite#" &
416 "delta#" &
417 "denorm#" &
418 "digits#" &
419 "elaborated#" &
420 "emax#" &
421 "enum_rep#" &
422 "epsilon#" &
423 "exponent#" &
424 "external_tag#" &
425 "first#" &
426 "first_bit#" &
427 "fixed_value#" &
428 "fore#" &
429 "has_access_values#" &
430 "has_discriminants#" &
431 "identity#" &
432 "img#" &
433 "integer_value#" &
434 "large#" &
435 "last#" &
436 "last_bit#" &
437 "leading_part#" &
438 "length#" &
439 "machine_emax#" &
440 "machine_emin#" &
441 "machine_mantissa#" &
442 "machine_overflows#" &
443 "machine_radix#" &
444 "machine_rounds#" &
445 "machine_size#" &
446 "mantissa#" &
447 "max_size_in_storage_elements#" &
448 "maximum_alignment#" &
449 "mechanism_code#" &
450 "mod#" &
451 "model_emin#" &
452 "model_epsilon#" &
453 "model_mantissa#" &
454 "model_small#" &
455 "modulus#" &
456 "null_parameter#" &
457 "object_size#" &
458 "partition_id#" &
459 "passed_by_reference#" &
460 "pool_address#" &
461 "pos#" &
462 "position#" &
463 "range#" &
464 "range_length#" &
465 "round#" &
466 "safe_emax#" &
467 "safe_first#" &
468 "safe_large#" &
469 "safe_last#" &
470 "safe_small#" &
471 "scale#" &
472 "scaling#" &
473 "signed_zeros#" &
474 "size#" &
475 "small#" &
476 "storage_size#" &
477 "storage_unit#" &
478 "stream_size#" &
479 "tag#" &
480 "target_name#" &
481 "terminated#" &
482 "to_address#" &
483 "type_class#" &
484 "uet_address#" &
485 "unbiased_rounding#" &
486 "unchecked_access#" &
487 "unconstrained_array#" &
488 "universal_literal_string#" &
489 "unrestricted_access#" &
490 "vads_size#" &
491 "val#" &
492 "valid#" &
493 "value_size#" &
494 "version#" &
495 "wchar_t_size#" &
496 "wide_wide_width#" &
497 "wide_width#" &
498 "width#" &
499 "word_size#" &
500 "adjacent#" &
501 "ceiling#" &
502 "copy_sign#" &
503 "floor#" &
504 "fraction#" &
505 "image#" &
506 "input#" &
507 "machine#" &
508 "max#" &
509 "min#" &
510 "model#" &
511 "pred#" &
512 "remainder#" &
513 "rounding#" &
514 "succ#" &
515 "truncation#" &
516 "value#" &
517 "wide_image#" &
518 "wide_wide_image#" &
519 "wide_value#" &
520 "wide_wide_value#" &
521 "output#" &
522 "read#" &
523 "write#" &
524 "elab_body#" &
525 "elab_spec#" &
526 "storage_pool#" &
527 "base#" &
528 "class#" &
529 "ceiling_locking#" &
530 "inheritance_locking#" &
531 "fifo_queuing#" &
532 "priority_queuing#" &
533 "fifo_within_priorities#" &
534 "access_check#" &
535 "accessibility_check#" &
536 "discriminant_check#" &
537 "division_check#" &
538 "elaboration_check#" &
539 "index_check#" &
540 "length_check#" &
541 "overflow_check#" &
542 "range_check#" &
543 "storage_check#" &
544 "tag_check#" &
545 "all_checks#" &
546 "abort#" &
547 "abs#" &
548 "accept#" &
549 "and#" &
550 "all#" &
551 "array#" &
552 "at#" &
553 "begin#" &
554 "body#" &
555 "case#" &
556 "constant#" &
557 "declare#" &
558 "delay#" &
559 "do#" &
560 "else#" &
561 "elsif#" &
562 "end#" &
563 "entry#" &
564 "exception#" &
565 "exit#" &
566 "for#" &
567 "function#" &
568 "generic#" &
569 "goto#" &
570 "if#" &
571 "in#" &
572 "is#" &
573 "limited#" &
574 "loop#" &
575 "new#" &
576 "not#" &
577 "null#" &
578 "of#" &
579 "or#" &
580 "others#" &
581 "out#" &
582 "package#" &
583 "pragma#" &
584 "private#" &
585 "procedure#" &
586 "raise#" &
587 "record#" &
588 "rem#" &
589 "renames#" &
590 "return#" &
591 "reverse#" &
592 "select#" &
593 "separate#" &
594 "subtype#" &
595 "task#" &
596 "terminate#" &
597 "then#" &
598 "type#" &
599 "use#" &
600 "when#" &
601 "while#" &
602 "with#" &
603 "xor#" &
604 "divide#" &
605 "enclosing_entity#" &
606 "exception_information#" &
607 "exception_message#" &
608 "exception_name#" &
609 "file#" &
d239991f 610 "generic_dispatching_constructor#" &
1a49cf99
AC
611 "import_address#" &
612 "import_largest_value#" &
613 "import_value#" &
614 "is_negative#" &
615 "line#" &
616 "rotate_left#" &
617 "rotate_right#" &
618 "shift_left#" &
619 "shift_right#" &
620 "shift_right_arithmetic#" &
621 "source_location#" &
622 "unchecked_conversion#" &
623 "unchecked_deallocation#" &
624 "to_pointer#" &
625 "abstract#" &
626 "aliased#" &
627 "protected#" &
628 "until#" &
629 "requeue#" &
630 "tagged#" &
631 "raise_exception#" &
632 "ada_roots#" &
633 "binder#" &
634 "binder_driver#" &
635 "body_suffix#" &
636 "builder#" &
637 "compiler#" &
638 "compiler_driver#" &
639 "compiler_kind#" &
640 "compute_dependency#" &
641 "cross_reference#" &
642 "default_linker#" &
643 "default_switches#" &
644 "dependency_option#" &
645 "exec_dir#" &
646 "executable#" &
647 "executable_suffix#" &
648 "extends#" &
649 "externally_built#" &
650 "finder#" &
651 "global_configuration_pragmas#" &
652 "gnatls#" &
653 "gnatstub#" &
654 "implementation#" &
655 "implementation_exceptions#" &
656 "implementation_suffix#" &
657 "include_option#" &
658 "language_processing#" &
659 "languages#" &
660 "library_dir#" &
661 "library_auto_init#" &
662 "library_gcc#" &
663 "library_interface#" &
664 "library_kind#" &
665 "library_name#" &
666 "library_options#" &
667 "library_reference_symbol_file#" &
668 "library_src_dir#" &
669 "library_symbol_file#" &
670 "library_symbol_policy#" &
671 "library_version#" &
672 "linker#" &
673 "local_configuration_pragmas#" &
674 "locally_removed_files#" &
675 "metrics#" &
676 "naming#" &
677 "object_dir#" &
678 "pretty_printer#" &
679 "project#" &
680 "separate_suffix#" &
681 "source_dirs#" &
682 "source_files#" &
683 "source_list_file#" &
684 "spec#" &
685 "spec_suffix#" &
686 "specification#" &
687 "specification_exceptions#" &
688 "specification_suffix#" &
689 "switches#" &
690 "unaligned_valid#" &
691 "interface#" &
692 "overriding#" &
693 "synchronized#" &
694 "#";
695
696 ---------------------
697 -- Generated Names --
698 ---------------------
699
700 -- This section lists the various cases of generated names which are
701 -- built from existing names by adding unique leading and/or trailing
702 -- upper case letters. In some cases these names are built recursively,
703 -- in particular names built from types may be built from types which
704 -- themselves have generated names. In this list, xxx represents an
705 -- existing name to which identifying letters are prepended or appended,
706 -- and a trailing n represents a serial number in an external name that
707 -- has some semantic significance (e.g. the n'th index type of an array).
708
709 -- xxxA access type for formal xxx in entry param record (Exp_Ch9)
710 -- xxxB tag table for tagged type xxx (Exp_Ch3)
711 -- xxxB task body procedure for task xxx (Exp_Ch9)
712 -- xxxD dispatch table for tagged type xxx (Exp_Ch3)
713 -- xxxD discriminal for discriminant xxx (Sem_Ch3)
714 -- xxxDn n'th discr check function for rec type xxx (Exp_Ch3)
715 -- xxxE elaboration boolean flag for task xxx (Exp_Ch9)
716 -- xxxE dispatch table pointer type for tagged type xxx (Exp_Ch3)
717 -- xxxE parameters for accept body for entry xxx (Exp_Ch9)
718 -- xxxFn n'th primitive of a tagged type (named xxx) (Exp_Ch3)
719 -- xxxJ tag table type index for tagged type xxx (Exp_Ch3)
720 -- xxxM master Id value for access type xxx (Exp_Ch3)
721 -- xxxP tag table pointer type for tagged type xxx (Exp_Ch3)
722 -- xxxP parameter record type for entry xxx (Exp_Ch9)
723 -- xxxPA access to parameter record type for entry xxx (Exp_Ch9)
724 -- xxxPn pointer type for n'th primitive of tagged type xxx (Exp_Ch3)
725 -- xxxR dispatch table pointer for tagged type xxx (Exp_Ch3)
726 -- xxxT tag table type for tagged type xxx (Exp_Ch3)
727 -- xxxT literal table for enumeration type xxx (Sem_Ch3)
728 -- xxxV type for task value record for task xxx (Exp_Ch9)
729 -- xxxX entry index constant (Exp_Ch9)
730 -- xxxY dispatch table type for tagged type xxx (Exp_Ch3)
731 -- xxxZ size variable for task xxx (Exp_Ch9)
732
733 -- TSS names
734
735 -- xxxDA deep adjust routine for type xxx (Exp_TSS)
736 -- xxxDF deep finalize routine for type xxx (Exp_TSS)
737 -- xxxDI deep initialize routine for type xxx (Exp_TSS)
738 -- xxxEQ composite equality routine for record type xxx (Exp_TSS)
fa7c4d23 739 -- xxxFA PolyORB/DSA From_Any converter for type xxx (Exp_TSS)
1a49cf99 740 -- xxxIP initialization procedure for type xxx (Exp_TSS)
fa7c4d23
AC
741 -- xxxRA RAS type access routine for type xxx (Exp_TSS)
742 -- xxxRD RAS type dereference routine for type xxx (Exp_TSS)
1a49cf99
AC
743 -- xxxRP Rep to Pos conversion for enumeration type xxx (Exp_TSS)
744 -- xxxSA array/slice assignment for controlled comp. arrays (Exp_TSS)
745 -- xxxSI stream input attribute subprogram for type xxx (Exp_TSS)
746 -- xxxSO stream output attribute subprogram for type xxx (Exp_TSS)
747 -- xxxSR stream read attribute subprogram for type xxx (Exp_TSS)
748 -- xxxSW stream write attribute subprogram for type xxx (Exp_TSS)
fa7c4d23
AC
749 -- xxxTA PolyORB/DSA To_Any converter for type xxx (Exp_TSS)
750 -- xxxTC PolyORB/DSA Typecode for type xxx (Exp_TSS)
1a49cf99
AC
751
752 -- Implicit type names
753
754 -- TxxxT type of literal table for enumeration type xxx (Sem_Ch3)
755
756 -- (Note: this list is not complete or accurate ???)
757
758 ----------------------
759 -- Get_Attribute_Id --
760 ----------------------
761
762 function Get_Attribute_Id (N : Name_Id) return Attribute_Id is
763 begin
764 return Attribute_Id'Val (N - First_Attribute_Name);
765 end Get_Attribute_Id;
766
767 ------------------
768 -- Get_Check_Id --
769 ------------------
770
771 function Get_Check_Id (N : Name_Id) return Check_Id is
772 begin
773 return Check_Id'Val (N - First_Check_Name);
774 end Get_Check_Id;
775
776 -----------------------
777 -- Get_Convention_Id --
778 -----------------------
779
780 function Get_Convention_Id (N : Name_Id) return Convention_Id is
781 begin
782 case N is
783 when Name_Ada => return Convention_Ada;
784 when Name_Assembler => return Convention_Assembler;
785 when Name_C => return Convention_C;
786 when Name_COBOL => return Convention_COBOL;
787 when Name_CPP => return Convention_CPP;
788 when Name_Fortran => return Convention_Fortran;
789 when Name_Intrinsic => return Convention_Intrinsic;
790 when Name_Java => return Convention_Java;
791 when Name_Stdcall => return Convention_Stdcall;
792 when Name_Stubbed => return Convention_Stubbed;
793
794 -- If no direct match, then we must have a convention
795 -- identifier pragma that has specified this name.
796
797 when others =>
798 for J in 1 .. Convention_Identifiers.Last loop
799 if N = Convention_Identifiers.Table (J).Name then
800 return Convention_Identifiers.Table (J).Convention;
801 end if;
802 end loop;
803
804 raise Program_Error;
805 end case;
806 end Get_Convention_Id;
807
808 ---------------------------
809 -- Get_Locking_Policy_Id --
810 ---------------------------
811
812 function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id is
813 begin
814 return Locking_Policy_Id'Val (N - First_Locking_Policy_Name);
815 end Get_Locking_Policy_Id;
816
817 -------------------
818 -- Get_Pragma_Id --
819 -------------------
820
821 function Get_Pragma_Id (N : Name_Id) return Pragma_Id is
822 begin
823 if N = Name_AST_Entry then
824 return Pragma_AST_Entry;
825 elsif N = Name_Interface then
826 return Pragma_Interface;
827 elsif N = Name_Storage_Size then
828 return Pragma_Storage_Size;
829 elsif N = Name_Storage_Unit then
830 return Pragma_Storage_Unit;
831 elsif N not in First_Pragma_Name .. Last_Pragma_Name then
832 return Unknown_Pragma;
833 else
834 return Pragma_Id'Val (N - First_Pragma_Name);
835 end if;
836 end Get_Pragma_Id;
837
838 ---------------------------
839 -- Get_Queuing_Policy_Id --
840 ---------------------------
841
842 function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id is
843 begin
844 return Queuing_Policy_Id'Val (N - First_Queuing_Policy_Name);
845 end Get_Queuing_Policy_Id;
846
847 ------------------------------------
848 -- Get_Task_Dispatching_Policy_Id --
849 ------------------------------------
850
851 function Get_Task_Dispatching_Policy_Id (N : Name_Id)
852 return Task_Dispatching_Policy_Id is
853 begin
854 return Task_Dispatching_Policy_Id'Val
855 (N - First_Task_Dispatching_Policy_Name);
856 end Get_Task_Dispatching_Policy_Id;
857
858 ----------------
859 -- Initialize --
860 ----------------
861
862 procedure Initialize is
863 P_Index : Natural;
864 Discard_Name : Name_Id;
865
866 begin
867 P_Index := Preset_Names'First;
868
869 loop
870 Name_Len := 0;
871
872 while Preset_Names (P_Index) /= '#' loop
873 Name_Len := Name_Len + 1;
874 Name_Buffer (Name_Len) := Preset_Names (P_Index);
875 P_Index := P_Index + 1;
876 end loop;
877
878 -- We do the Name_Find call to enter the name into the table, but
879 -- we don't need to do anything with the result, since we already
880 -- initialized all the preset names to have the right value (we
881 -- are depending on the order of the names and Preset_Names).
882
883 Discard_Name := Name_Find;
884 P_Index := P_Index + 1;
885 exit when Preset_Names (P_Index) = '#';
886 end loop;
887
888 -- Make sure that number of names in standard table is correct. If
889 -- this check fails, run utility program XSNAMES to construct a new
890 -- properly matching version of the body.
891
892 pragma Assert (Discard_Name = Last_Predefined_Name);
893
894 -- Initialize the convention identifiers table with the standard
895 -- set of synonyms that we recognize for conventions.
896
897 Convention_Identifiers.Init;
898
899 Convention_Identifiers.Append ((Name_Asm, Convention_Assembler));
900 Convention_Identifiers.Append ((Name_Assembly, Convention_Assembler));
901
902 Convention_Identifiers.Append ((Name_Default, Convention_C));
903 Convention_Identifiers.Append ((Name_External, Convention_C));
904
905 Convention_Identifiers.Append ((Name_DLL, Convention_Stdcall));
906 Convention_Identifiers.Append ((Name_Win32, Convention_Stdcall));
907 end Initialize;
908
909 -----------------------
910 -- Is_Attribute_Name --
911 -----------------------
912
913 function Is_Attribute_Name (N : Name_Id) return Boolean is
914 begin
915 return N in First_Attribute_Name .. Last_Attribute_Name;
916 end Is_Attribute_Name;
917
918 -------------------
919 -- Is_Check_Name --
920 -------------------
921
922 function Is_Check_Name (N : Name_Id) return Boolean is
923 begin
924 return N in First_Check_Name .. Last_Check_Name;
925 end Is_Check_Name;
926
927 ------------------------
928 -- Is_Convention_Name --
929 ------------------------
930
931 function Is_Convention_Name (N : Name_Id) return Boolean is
932 begin
933 -- Check if this is one of the standard conventions
934
935 if N in First_Convention_Name .. Last_Convention_Name
936 or else N = Name_C
937 then
938 return True;
939
940 -- Otherwise check if it is in convention identifier table
941
942 else
943 for J in 1 .. Convention_Identifiers.Last loop
944 if N = Convention_Identifiers.Table (J).Name then
945 return True;
946 end if;
947 end loop;
948
949 return False;
950 end if;
951 end Is_Convention_Name;
952
953 ------------------------------
954 -- Is_Entity_Attribute_Name --
955 ------------------------------
956
957 function Is_Entity_Attribute_Name (N : Name_Id) return Boolean is
958 begin
959 return N in First_Entity_Attribute_Name .. Last_Entity_Attribute_Name;
960 end Is_Entity_Attribute_Name;
961
962 --------------------------------
963 -- Is_Function_Attribute_Name --
964 --------------------------------
965
966 function Is_Function_Attribute_Name (N : Name_Id) return Boolean is
967 begin
968 return N in
969 First_Renamable_Function_Attribute ..
970 Last_Renamable_Function_Attribute;
971 end Is_Function_Attribute_Name;
972
973 ----------------------------
974 -- Is_Locking_Policy_Name --
975 ----------------------------
976
977 function Is_Locking_Policy_Name (N : Name_Id) return Boolean is
978 begin
979 return N in First_Locking_Policy_Name .. Last_Locking_Policy_Name;
980 end Is_Locking_Policy_Name;
981
982 -----------------------------
983 -- Is_Operator_Symbol_Name --
984 -----------------------------
985
986 function Is_Operator_Symbol_Name (N : Name_Id) return Boolean is
987 begin
988 return N in First_Operator_Name .. Last_Operator_Name;
989 end Is_Operator_Symbol_Name;
990
991 --------------------
992 -- Is_Pragma_Name --
993 --------------------
994
995 function Is_Pragma_Name (N : Name_Id) return Boolean is
996 begin
997 return N in First_Pragma_Name .. Last_Pragma_Name
998 or else N = Name_AST_Entry
999 or else N = Name_Interface
1000 or else N = Name_Storage_Size
1001 or else N = Name_Storage_Unit;
1002 end Is_Pragma_Name;
1003
1004 ---------------------------------
1005 -- Is_Procedure_Attribute_Name --
1006 ---------------------------------
1007
1008 function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean is
1009 begin
1010 return N in First_Procedure_Attribute .. Last_Procedure_Attribute;
1011 end Is_Procedure_Attribute_Name;
1012
1013 ----------------------------
1014 -- Is_Queuing_Policy_Name --
1015 ----------------------------
1016
1017 function Is_Queuing_Policy_Name (N : Name_Id) return Boolean is
1018 begin
1019 return N in First_Queuing_Policy_Name .. Last_Queuing_Policy_Name;
1020 end Is_Queuing_Policy_Name;
1021
1022 -------------------------------------
1023 -- Is_Task_Dispatching_Policy_Name --
1024 -------------------------------------
1025
1026 function Is_Task_Dispatching_Policy_Name (N : Name_Id) return Boolean is
1027 begin
1028 return N in First_Task_Dispatching_Policy_Name ..
1029 Last_Task_Dispatching_Policy_Name;
1030 end Is_Task_Dispatching_Policy_Name;
1031
1032 ----------------------------
1033 -- Is_Type_Attribute_Name --
1034 ----------------------------
1035
1036 function Is_Type_Attribute_Name (N : Name_Id) return Boolean is
1037 begin
1038 return N in First_Type_Attribute_Name .. Last_Type_Attribute_Name;
1039 end Is_Type_Attribute_Name;
1040
1041 ----------------------------------
1042 -- Record_Convention_Identifier --
1043 ----------------------------------
1044
1045 procedure Record_Convention_Identifier
1046 (Id : Name_Id;
1047 Convention : Convention_Id)
1048 is
1049 begin
1050 Convention_Identifiers.Append ((Id, Convention));
1051 end Record_Convention_Identifier;
1052
1053end Snames;