1 /* Process declarations and variables for GNU CHILL compiler.
2 Copyright (C) 1992, 93, 94, 98, 99, 2000 Free Software Foundation, Inc.
4 This file is part of GNU CC.
6 GNU CC is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU CC is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU CC; see the file COPYING. If not, write to
18 the Free Software Foundation, 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
22 /* Process declarations and symbol lookup for CHILL front end.
23 Also constructs types; the standard scalar types at initialization,
24 and structure, union, array and enum types when they are declared. */
26 /* NOTES on Chill name resolution
28 Chill allows one to refer to an identifier that is declared later in
29 the same Group. Hence, a single pass over the code (as in C) is
32 This implementation uses two complete passes over the source code,
33 plus some extra passes over internal data structures.
35 Loosely, during pass 1, a 'scope' object is created for each Chill
36 reach. Each scope object contains a list of 'decl' objects,
37 one for each 'defining occurrence' in the reach. (This list
38 is in the 'remembered_decls' field of each scope.)
39 The scopes and their decls are replayed in pass 2: As each reach
40 is entered, the decls saved from pass 1 are made visible.
42 There are some exceptions. Declarations that cannot be referenced
43 before their declaration (i.e. whose defining occurrence precede
44 their reach), can be deferred to pass 2. These include formal
45 parameter declarations, and names defined in a DO action.
47 During pass 2, as each scope is entered, we must make visible all
48 the declarations defined in the scope, before we generate any code.
49 We must also simplify the declarations from pass 1: For example
50 a VAR_DECL may have a array type whose bounds are expressions;
51 these need to be folded. But of course the expressions may contain
52 identifiers that may be defined later in the scope - or even in
55 The "satisfy" process has two main phases:
57 1: Binding. Each identifier *referenced* in a declaration (i.e. in
58 a mode or the RHS of a synonum declaration) must be bound to its
59 defining occurrence. This may need to be linking via
60 grants and/or seizes (which are represented by ALIAS_DECLs).
61 A further complication is handling implied name strings.
63 2: Layout. Each CONST_DECL or TYPE_DECL *referenced* in a declaration
64 must than be replaced by its value (or type). Constants must be
65 folded. Types and declarstions must be laid out. DECL_RTL must be set.
66 While doing this, we must watch out for circular dependencies.
68 If a scope contains nested modulions, then the Binding phase must be
69 done for each nested module (recursively) before the Layout phase
70 can start for that scope. As an example of why this is needed, consider:
73 DCL a ARRAY [1:y] int; -- This should have 7 elements.
83 Here, the 'x' in "x + 5" must be Bound to the 'x' in module M2.
84 This must be done before we can Layout a.
85 The reason this is an issue is that we do *not* have a lookup
86 (or hash) table per scope (or module). Instead we have a single
87 global table we we keep adding and removing bindings from.
88 (This is both for speed, and because of gcc history.)
90 Note that a SEIZE generates a declaration in the current scope,
91 linked to something in the surrounding scope. Determining (binding)
92 the link must be done in pass 2. On the other hand, a GRANT
93 generates a declaration in the surrounding scope, linked to
94 something in the current scope. This linkage is Bound in pass 1.
96 The sequence for the above example is:
97 - Enter the declarations of M1 (i.e. {a, x, y}) into the hash table.
98 - For each of {a, x, y}, examine dependent expression (the
99 rhs of x, the bounds of a), and Bind any identifiers to
100 the current declarations (as found in the hash table). Specifically,
101 the 'y' in the array bounds of 'a' is bound to the 'y' declared by
102 the SEIZE declaration. Also, 'y' is Bound to the implicit
103 declaration in the global scope (generated from the GRANT in M2).
104 - Remove the bindings for M1 (i.e. {a, x, y}) from the hash table.
105 - Enter the declarations of M2 (i.e. {x, y}) into the hash table.
106 - For each of {x, y} examine the dependent expressions (the rhs of
107 x and y), and Bind any identifiers to their current declarartions
108 (in this case the 'x' in "x + 5" is bound to the 'x' that is 2.
109 - Remove the bindings for M2 (i.e. {x, y}) from the hash table.
110 - Perform Layout for M1: This requires the size of a, which
111 requires the value of y. The 'y' is Bound to the implicit
112 declaration in the global scope, which is Bound to the declaration
113 of y in M2. We now require the value of this 'y', which is "x + 5"
114 where x is bound to the x in M2 (thanks to our previous Binding
115 phase). So we get that the value of y is 7.
116 - Perform layout of M2. This implies calculating (constant folding)
117 the value of y - but we already did that, so we're done.
119 An example illustating the problem with implied names:
123 use(e); -- e is implied by y.
135 This implies that determining the implied name e in M1
136 must be done after Binding of y to x in M2.
141 DCL a ARRAY(v:v) int;
153 This one implies that determining the implied name e in M2,
154 must be done before Layout of a in M1.
156 These two examples togother indicate the determining implieed
157 names requries yet another phase.
158 - Bind strong names in M1.
159 - Bind strong names in M2.
160 - Bind strong names in M3.
161 - Determine weak names implied by SEIZEs in M1.
162 - Bind the weak names in M1.
163 - Determine weak names implied by SEIZEs in M2.
164 - Bind the weak names in M2.
165 - Determine weak names implied by SEIZEs in M3.
166 - Bind the weak names in M3.
171 We must bind the strong names in every module before we can determine
172 weak names in any module (because of seized/granted synmode/newmodes).
173 We must bind the weak names in every module before we can do Layout
180 /* ??? not all decl nodes are given the most useful possible
181 line numbers. For example, the CONST_DECLs for enum values. */
194 #define IS_UNKNOWN_TYPE(type) (TYPE_SIZE(type)==0)
195 #define BUILTIN_NESTING_LEVEL (-1)
197 /* For backward compatibility, we define Chill INT to be the same
198 as SHORT (i.e. 16 bits), at least if C INT is the same as LONG.
200 #define CHILL_INT_IS_SHORT (INT_TYPE_SIZE==LONG_TYPE_SIZE)
202 extern int ignore_case;
203 extern tree process_type;
204 extern struct obstack *saveable_obstack;
205 extern tree signal_code;
206 extern int special_UC;
208 static tree get_next_decl PARAMS ((void));
209 static tree lookup_name_for_seizing PARAMS ((tree));
211 static tree lookup_name_current_level PARAMS ((tree));
213 static void save_decl PARAMS ((tree));
215 extern struct obstack permanent_obstack;
216 extern int in_pseudo_module;
218 struct module *current_module = NULL;
219 struct module *first_module = NULL;
220 struct module **next_module = &first_module;
222 extern int in_pseudo_module;
224 int module_number = 0;
226 /* This is only used internally (by signed_type). */
228 tree signed_boolean_type_node;
230 tree global_function_decl = NULL_TREE;
232 /* This is a temportary used by RESULT to store its value.
233 Note we cannot directly use DECL_RESULT for two reasons:
234 a) If DECL_RESULT is a register, it may get clobbered by a
235 subsequent function call; and
236 b) if the function returns a struct, we might (visibly) modify the
237 destination before we're supposed to. */
238 tree chill_result_decl;
240 int result_never_set;
242 /* forward declarations */
243 static void pushdecllist PARAMS ((tree, int));
244 static int init_nonvalue_struct PARAMS ((tree));
245 static int init_nonvalue_array PARAMS ((tree));
246 static void set_nesting_level PARAMS ((tree, int));
247 static tree make_chill_variants PARAMS ((tree, tree, tree));
248 static tree fix_identifier PARAMS ((tree));
249 static void proclaim_decl PARAMS ((tree, int));
250 static tree maybe_acons PARAMS ((tree, tree));
251 static void push_scope_decls PARAMS ((int));
252 static void pop_scope_decls PARAMS ((tree, tree));
253 static tree build_implied_names PARAMS ((tree));
254 static void bind_sub_modules PARAMS ((int));
255 static void layout_array_type PARAMS ((tree));
256 static void do_based_decl PARAMS ((tree, tree, tree));
257 static void handle_one_level PARAMS ((tree, tree));
259 int current_nesting_level = BUILTIN_NESTING_LEVEL;
260 int current_module_nesting_level = 0;
262 /* Lots of declarations copied from c-decl.c. */
263 /* ??? not all decl nodes are given the most useful possible
264 line numbers. For example, the CONST_DECLs for enum values. */
267 /* In grokdeclarator, distinguish syntactic contexts of declarators. */
269 { NORMAL, /* Ordinary declaration */
270 FUNCDEF, /* Function definition */
271 PARM, /* Declaration of parm before function body */
272 FIELD, /* Declaration inside struct or union */
273 BITFIELD, /* Likewise but with specified width */
274 TYPENAME}; /* Typename (inside cast or sizeof) */
277 #ifndef CHAR_TYPE_SIZE
278 #define CHAR_TYPE_SIZE BITS_PER_UNIT
281 #ifndef SHORT_TYPE_SIZE
282 #define SHORT_TYPE_SIZE (BITS_PER_UNIT * MIN ((UNITS_PER_WORD + 1) / 2, 2))
285 #ifndef INT_TYPE_SIZE
286 #define INT_TYPE_SIZE BITS_PER_WORD
289 #ifndef LONG_TYPE_SIZE
290 #define LONG_TYPE_SIZE BITS_PER_WORD
293 #ifndef LONG_LONG_TYPE_SIZE
294 #define LONG_LONG_TYPE_SIZE (BITS_PER_WORD * 2)
297 #ifndef WCHAR_UNSIGNED
298 #define WCHAR_UNSIGNED 0
301 #ifndef FLOAT_TYPE_SIZE
302 #define FLOAT_TYPE_SIZE BITS_PER_WORD
305 #ifndef DOUBLE_TYPE_SIZE
306 #define DOUBLE_TYPE_SIZE (BITS_PER_WORD * 2)
309 #ifndef LONG_DOUBLE_TYPE_SIZE
310 #define LONG_DOUBLE_TYPE_SIZE (BITS_PER_WORD * 2)
313 /* We let tm.h override the types used here, to handle trivial differences
314 such as the choice of unsigned int or long unsigned int for size_t.
315 When machines start needing nontrivial differences in the size type,
316 it would be best to do something here to figure out automatically
317 from other information what type to use. */
320 #define PTRDIFF_TYPE "long int"
324 #define WCHAR_TYPE "int"
327 tree wchar_type_node;
328 tree signed_wchar_type_node;
329 tree unsigned_wchar_type_node;
333 /* type of initializer structure, which points to
334 a module's module-level code, and to the next
336 tree initializer_type;
338 /* type of a CHILL predefined value builtin routine */
339 tree chill_predefined_function_type;
341 /* type `int ()' -- used for implicit declaration of functions. */
343 tree default_function_type;
345 const char **boolean_code_name;
347 /* A node for the integer constant -1. */
348 tree integer_minus_one_node;
350 /* Nodes for boolean constants TRUE and FALSE. */
351 tree boolean_true_node, boolean_false_node;
353 tree string_one_type_node; /* The type of CHARS(1). */
354 tree bitstring_one_type_node; /* The type of BOOLS(1). */
355 tree bit_zero_node; /* B'0' */
356 tree bit_one_node; /* B'1' */
358 /* Nonzero if we have seen an invalid cross reference
359 to a struct, union, or enum, but not yet printed the message. */
361 tree pending_invalid_xref;
362 /* File and line to appear in the eventual error message. */
363 char *pending_invalid_xref_file;
364 int pending_invalid_xref_line;
366 /* After parsing the declarator that starts a function definition,
367 `start_function' puts here the list of parameter names or chain of decls.
368 `store_parm_decls' finds it here. */
370 static tree current_function_parms;
372 /* Nonzero when store_parm_decls is called indicates a varargs function.
373 Value not meaningful after store_parm_decls. */
375 static int c_function_varargs;
377 /* The FUNCTION_DECL for the function currently being compiled,
378 or 0 if between functions. */
379 tree current_function_decl;
381 /* These are irrelevant for Chill, but are referenced from from c-typeck.c. */
383 int warn_traditional;
384 int warn_bad_function_cast;
386 /* Identifiers that hold VAR_LENGTH and VAR_DATA. */
387 tree var_length_id, var_data_id;
391 /* For each binding contour we allocate a scope structure
392 * which records the names defined in that contour.
395 * 1) one for each function definition,
396 * where internal declarations of the parameters appear.
397 * 2) one for each compound statement,
398 * to record its declarations.
400 * The current meaning of a name can be found by searching the levels from
401 * the current one out to the global one.
404 /* To communicate between pass 1 and 2, we maintain a list of "scopes".
405 Each scope corrresponds to a nested source scope/block that contain
406 that can contain declarations. The TREE_VALUE of the scope points
407 to the list of declarations declared in that scope.
408 The TREE_PURPOSE of the scope points to the surrounding scope.
409 (We may need to handle nested modules later. FIXME)
410 The TREE_CHAIN field contains a list of scope as they are seen
411 in chronological order. (Reverse order during first pass,
412 but it is reverse before pass 2.) */
416 /* The enclosing scope. */
417 struct scope *enclosing;
419 /* The next scope, in chronlogical order. */
422 /* A chain of DECLs constructed using save_decl during pass 1. */
423 tree remembered_decls;
425 /* A chain of _DECL nodes for all variables, constants, functions,
426 and typedef types belong to this scope. */
429 /* List of declarations that have been granted into this scope. */
432 /* List of implied (weak) names. */
435 /* For each level, a list of shadowed outer-level local definitions
436 to be restored when this level is popped.
437 Each link is a TREE_LIST whose TREE_PURPOSE is an identifier and
438 whose TREE_VALUE is its old definition (a kind of ..._DECL node). */
441 /* For each level (except not the global one),
442 a chain of BLOCK nodes for all the levels
443 that were entered and exited one level down. */
446 /* The BLOCK node for this level, if one has been preallocated.
447 If 0, the BLOCK is allocated (if needed) when the level is popped. */
450 /* The binding level which this one is contained in (inherits from). */
451 struct scope *level_chain;
453 /* Nonzero for a level that corresponds to a module. */
456 /* Zero means called from backend code. */
459 /* The modules that are directly enclosed by this scope
460 are chained together. */
461 struct scope* first_child_module;
462 struct scope** tail_child_module;
463 struct scope* next_sibling_module;
466 /* The outermost binding level, for pre-defined (builtin) names. */
468 static struct scope builtin_scope = {
469 NULL, NULL, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE,
470 NULL_TREE, NULL_TREE, NULL, 0, 0, NULL, NULL, NULL};
472 struct scope *global_scope;
474 /* The binding level currently in effect. */
476 static struct scope *current_scope = &builtin_scope;
478 /* The most recently seen scope. */
479 struct scope *last_scope = &builtin_scope;
481 /* Binding level structures are initialized by copying this one. */
483 static struct scope clear_scope = {
484 NULL, NULL, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE,
485 NULL_TREE, NULL_TREE, NULL, 0, 0, NULL, NULL, NULL};
487 /* Chain of decls accessible through IDENTIFIER_OUTER_VALUE.
488 Decls with the same DECL_NAME are adjacent in the chain. */
490 static tree outer_decls = NULL_TREE;
492 /* C-specific option variables. */
494 /* Nonzero means allow type mismatches in conditional expressions;
495 just make their values `void'. */
497 int flag_cond_mismatch;
499 /* Nonzero means give `double' the same size as `float'. */
501 int flag_short_double;
503 /* Nonzero means don't recognize the keyword `asm'. */
507 /* Nonzero means don't recognize any builtin functions. */
511 /* Nonzero means don't recognize the non-ANSI builtin functions.
514 int flag_no_nonansi_builtin;
516 /* Nonzero means do some things the same way PCC does. */
518 int flag_traditional;
520 /* Nonzero means to allow single precision math even if we're generally
521 being traditional. */
522 int flag_allow_single_precision = 0;
524 /* Nonzero means to treat bitfields as signed unless they say `unsigned'. */
526 int flag_signed_bitfields = 1;
527 int explicit_flag_signed_bitfields = 0;
529 /* Nonzero means warn about implicit declarations. */
533 /* Nonzero means give string constants the type `const char *'
534 to get extra warnings from them. These warnings will be too numerous
535 to be useful, except in thoroughly ANSIfied programs. */
537 int warn_write_strings;
539 /* Nonzero means warn about pointer casts that can drop a type qualifier
540 from the pointer target type. */
544 /* Nonzero means warn about sizeof(function) or addition/subtraction
545 of function pointers. */
547 int warn_pointer_arith;
549 /* Nonzero means warn for non-prototype function decls
550 or non-prototyped defs without previous prototype. */
552 int warn_strict_prototypes;
554 /* Nonzero means warn for any global function def
555 without separate previous prototype decl. */
557 int warn_missing_prototypes;
559 /* Nonzero means warn about multiple (redundant) decls for the same single
560 variable or function. */
562 int warn_redundant_decls = 0;
564 /* Nonzero means warn about extern declarations of objects not at
565 file-scope level and about *all* declarations of functions (whether
566 extern or static) not at file-scope level. Note that we exclude
567 implicit function declarations. To get warnings about those, use
570 int warn_nested_externs = 0;
572 /* Warn about a subscript that has type char. */
574 int warn_char_subscripts = 0;
576 /* Warn if a type conversion is done that might have confusing results. */
580 /* Warn if adding () is suggested. */
582 int warn_parentheses;
584 /* Warn if initializer is not completely bracketed. */
586 int warn_missing_braces;
588 /* Define the special tree codes that we use. */
590 /* Table indexed by tree code giving a string containing a character
591 classifying the tree code. Possibilities are
592 t, d, s, c, r, <, 1 and 2. See ch-tree.def for details. */
594 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
596 const char chill_tree_code_type[] = {
598 #include "ch-tree.def"
602 /* Table indexed by tree code giving number of expression
603 operands beyond the fixed part of the node structure.
604 Not used for types or decls. */
606 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
608 int chill_tree_code_length[] = {
610 #include "ch-tree.def"
615 /* Names of tree components.
616 Used for printing out the tree and error messages. */
617 #define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
619 const char *chill_tree_code_name[] = {
621 #include "ch-tree.def"
625 /* Nonzero means `$' can be in an identifier.
626 See cccp.c for reasons why this breaks some obscure ANSI C programs. */
628 #ifndef DOLLARS_IN_IDENTIFIERS
629 #define DOLLARS_IN_IDENTIFIERS 0
631 int dollars_in_ident = DOLLARS_IN_IDENTIFIERS > 1;
633 /* An identifier that is used internally to indicate
634 an "ALL" prefix for granting or seizing.
635 We use "*" rather than the external name "ALL", partly for convenience,
636 and partly to avoid case senstivity problems. */
641 allocate_lang_decl (t)
642 tree t ATTRIBUTE_UNUSED;
648 copy_lang_decl (node)
649 tree node ATTRIBUTE_UNUSED;
655 build_lang_decl (code, name, type)
656 enum chill_tree_code code;
660 return build_decl (code, name, type);
663 /* Decode the string P as a language-specific option for C.
664 Return the number of strings consumed for a valid option.
665 Return 0 for an invalid option. */
668 c_decode_option (argc, argv)
669 int argc ATTRIBUTE_UNUSED;
673 if (!strcmp (p, "-ftraditional") || !strcmp (p, "-traditional"))
675 flag_traditional = 1;
676 flag_writable_strings = 1;
677 #if DOLLARS_IN_IDENTIFIERS > 0
678 dollars_in_ident = 1;
681 else if (!strcmp (p, "-fnotraditional") || !strcmp (p, "-fno-traditional"))
683 flag_traditional = 0;
684 flag_writable_strings = 0;
685 dollars_in_ident = DOLLARS_IN_IDENTIFIERS > 1;
687 else if (!strcmp (p, "-fsigned-char"))
688 flag_signed_char = 1;
689 else if (!strcmp (p, "-funsigned-char"))
690 flag_signed_char = 0;
691 else if (!strcmp (p, "-fno-signed-char"))
692 flag_signed_char = 0;
693 else if (!strcmp (p, "-fno-unsigned-char"))
694 flag_signed_char = 1;
695 else if (!strcmp (p, "-fsigned-bitfields")
696 || !strcmp (p, "-fno-unsigned-bitfields"))
698 flag_signed_bitfields = 1;
699 explicit_flag_signed_bitfields = 1;
701 else if (!strcmp (p, "-funsigned-bitfields")
702 || !strcmp (p, "-fno-signed-bitfields"))
704 flag_signed_bitfields = 0;
705 explicit_flag_signed_bitfields = 1;
707 else if (!strcmp (p, "-fshort-enums"))
708 flag_short_enums = 1;
709 else if (!strcmp (p, "-fno-short-enums"))
710 flag_short_enums = 0;
711 else if (!strcmp (p, "-fcond-mismatch"))
712 flag_cond_mismatch = 1;
713 else if (!strcmp (p, "-fno-cond-mismatch"))
714 flag_cond_mismatch = 0;
715 else if (!strcmp (p, "-fshort-double"))
716 flag_short_double = 1;
717 else if (!strcmp (p, "-fno-short-double"))
718 flag_short_double = 0;
719 else if (!strcmp (p, "-fasm"))
721 else if (!strcmp (p, "-fno-asm"))
723 else if (!strcmp (p, "-fbuiltin"))
725 else if (!strcmp (p, "-fno-builtin"))
727 else if (!strcmp (p, "-ansi"))
728 flag_no_asm = 1, flag_no_nonansi_builtin = 1, dollars_in_ident = 0;
729 else if (!strcmp (p, "-Wimplicit"))
731 else if (!strcmp (p, "-Wno-implicit"))
733 else if (!strcmp (p, "-Wwrite-strings"))
734 warn_write_strings = 1;
735 else if (!strcmp (p, "-Wno-write-strings"))
736 warn_write_strings = 0;
737 else if (!strcmp (p, "-Wcast-qual"))
739 else if (!strcmp (p, "-Wno-cast-qual"))
741 else if (!strcmp (p, "-Wpointer-arith"))
742 warn_pointer_arith = 1;
743 else if (!strcmp (p, "-Wno-pointer-arith"))
744 warn_pointer_arith = 0;
745 else if (!strcmp (p, "-Wstrict-prototypes"))
746 warn_strict_prototypes = 1;
747 else if (!strcmp (p, "-Wno-strict-prototypes"))
748 warn_strict_prototypes = 0;
749 else if (!strcmp (p, "-Wmissing-prototypes"))
750 warn_missing_prototypes = 1;
751 else if (!strcmp (p, "-Wno-missing-prototypes"))
752 warn_missing_prototypes = 0;
753 else if (!strcmp (p, "-Wredundant-decls"))
754 warn_redundant_decls = 1;
755 else if (!strcmp (p, "-Wno-redundant-decls"))
756 warn_redundant_decls = 0;
757 else if (!strcmp (p, "-Wnested-externs"))
758 warn_nested_externs = 1;
759 else if (!strcmp (p, "-Wno-nested-externs"))
760 warn_nested_externs = 0;
761 else if (!strcmp (p, "-Wchar-subscripts"))
762 warn_char_subscripts = 1;
763 else if (!strcmp (p, "-Wno-char-subscripts"))
764 warn_char_subscripts = 0;
765 else if (!strcmp (p, "-Wconversion"))
767 else if (!strcmp (p, "-Wno-conversion"))
769 else if (!strcmp (p, "-Wparentheses"))
770 warn_parentheses = 1;
771 else if (!strcmp (p, "-Wno-parentheses"))
772 warn_parentheses = 0;
773 else if (!strcmp (p, "-Wreturn-type"))
774 warn_return_type = 1;
775 else if (!strcmp (p, "-Wno-return-type"))
776 warn_return_type = 0;
777 else if (!strcmp (p, "-Wcomment"))
778 ; /* cpp handles this one. */
779 else if (!strcmp (p, "-Wno-comment"))
780 ; /* cpp handles this one. */
781 else if (!strcmp (p, "-Wcomments"))
782 ; /* cpp handles this one. */
783 else if (!strcmp (p, "-Wno-comments"))
784 ; /* cpp handles this one. */
785 else if (!strcmp (p, "-Wtrigraphs"))
786 ; /* cpp handles this one. */
787 else if (!strcmp (p, "-Wno-trigraphs"))
788 ; /* cpp handles this one. */
789 else if (!strcmp (p, "-Wimport"))
790 ; /* cpp handles this one. */
791 else if (!strcmp (p, "-Wno-import"))
792 ; /* cpp handles this one. */
793 else if (!strcmp (p, "-Wmissing-braces"))
794 warn_missing_braces = 1;
795 else if (!strcmp (p, "-Wno-missing-braces"))
796 warn_missing_braces = 0;
797 else if (!strcmp (p, "-Wall"))
800 /* We save the value of warn_uninitialized, since if they put
801 -Wuninitialized on the command line, we need to generate a
802 warning about not using it without also specifying -O. */
803 if (warn_uninitialized != 1)
804 warn_uninitialized = 2;
806 warn_return_type = 1;
808 warn_char_subscripts = 1;
809 warn_parentheses = 1;
810 warn_missing_braces = 1;
818 /* Hooks for print_node. */
821 print_lang_decl (file, node, indent)
826 indent_to (file, indent + 3);
827 fputs ("nesting_level ", file);
828 fprintf (file, HOST_WIDE_INT_PRINT_DEC, DECL_NESTING_LEVEL (node));
830 if (DECL_WEAK_NAME (node))
831 fprintf (file, "weak_name ");
832 if (CH_DECL_SIGNAL (node))
833 fprintf (file, "decl_signal ");
834 print_node (file, "tasking_code",
835 (tree)DECL_TASKING_CODE_DECL (node), indent + 4);
840 print_lang_type (file, node, indent)
847 indent_to (file, indent + 3);
848 if (CH_IS_BUFFER_MODE (node))
849 fprintf (file, "buffer_mode ");
850 if (CH_IS_EVENT_MODE (node))
851 fprintf (file, "event_mode ");
853 if (CH_IS_EVENT_MODE (node) || CH_IS_BUFFER_MODE (node))
855 temp = max_queue_size (node);
857 print_node_brief (file, "qsize", temp, indent + 4);
862 print_lang_identifier (file, node, indent)
867 print_node (file, "local", IDENTIFIER_LOCAL_VALUE (node), indent + 4);
868 print_node (file, "outer", IDENTIFIER_OUTER_VALUE (node), indent + 4);
869 print_node (file, "implicit", IDENTIFIER_IMPLICIT_DECL (node), indent + 4);
870 print_node (file, "error locus", IDENTIFIER_ERROR_LOCUS (node), indent + 4);
871 print_node (file, "signal_dest", IDENTIFIER_SIGNAL_DEST (node), indent + 4);
872 indent_to (file, indent + 3);
873 if (IDENTIFIER_SIGNAL_DATA(node))
874 fprintf (file, "signal_data ");
877 /* initialise non-value struct */
880 init_nonvalue_struct (expr)
883 tree type = TREE_TYPE (expr);
887 if (CH_IS_BUFFER_MODE (type))
890 build_chill_modify_expr (
891 build_component_ref (expr, get_identifier ("__buffer_data")),
895 else if (CH_IS_EVENT_MODE (type))
898 build_chill_modify_expr (
899 build_component_ref (expr, get_identifier ("__event_data")),
903 else if (CH_IS_ASSOCIATION_MODE (type))
906 build_chill_modify_expr (expr,
907 chill_convert_for_assignment (type, association_init_value,
911 else if (CH_IS_ACCESS_MODE (type))
913 init_access_location (expr, type);
916 else if (CH_IS_TEXT_MODE (type))
918 init_text_location (expr, type);
922 for (field = TYPE_FIELDS (type); field != NULL_TREE; field = TREE_CHAIN (field))
924 type = TREE_TYPE (field);
925 if (CH_TYPE_NONVALUE_P (type))
927 tree exp = build_component_ref (expr, DECL_NAME (field));
928 if (TREE_CODE (type) == RECORD_TYPE)
929 res |= init_nonvalue_struct (exp);
930 else if (TREE_CODE (type) == ARRAY_TYPE)
931 res |= init_nonvalue_array (exp);
937 /* initialize non-value array */
938 /* do it with DO FOR unique-id IN expr; ... OD; */
940 init_nonvalue_array (expr)
943 tree tmpvar = get_unique_identifier ("NONVALINIT");
948 build_loop_iterator (tmpvar, expr, NULL_TREE, NULL_TREE, 0, 1, 0);
949 nonvalue_begin_loop_scope ();
950 build_loop_start (NULL_TREE);
951 tmpvar = lookup_name (tmpvar);
952 type = TREE_TYPE (tmpvar);
953 if (CH_TYPE_NONVALUE_P (type))
955 if (TREE_CODE (type) == RECORD_TYPE)
956 res |= init_nonvalue_struct (tmpvar);
957 else if (TREE_CODE (type) == ARRAY_TYPE)
958 res |= init_nonvalue_array (tmpvar);
961 nonvalue_end_loop_scope ();
966 /* This excessive piece of code sets DECL_NESTING_LEVEL (DECL) to LEVEL. */
969 set_nesting_level (decl, level)
973 static tree *small_ints = NULL;
974 static int max_small_ints = 0;
977 decl->decl.vindex = NULL_TREE;
980 if (level >= max_small_ints)
982 int new_max = level + 20;
983 if (small_ints == NULL)
984 small_ints = (tree*)xmalloc (new_max * sizeof(tree));
986 small_ints = (tree*)xrealloc (small_ints, new_max * sizeof(tree));
987 while (max_small_ints < new_max)
988 small_ints[max_small_ints++] = NULL_TREE;
990 if (small_ints[level] == NULL_TREE)
992 push_obstacks (&permanent_obstack, &permanent_obstack);
993 small_ints[level] = build_int_2 (level, 0);
996 /* set DECL_NESTING_LEVEL */
997 decl->decl.vindex = small_ints[level];
1001 /* OPT_EXTERNAL is non-zero when the declaration is at module level.
1002 * OPT_EXTERNAL == 2 means implicitly grant it.
1005 do_decls (names, type, opt_static, lifetime_bound, opt_init, opt_external)
1013 if (names == NULL_TREE || TREE_CODE (names) == TREE_LIST)
1015 for (; names != NULL_TREE; names = TREE_CHAIN (names))
1016 do_decl (TREE_VALUE (names), type, opt_static, lifetime_bound,
1017 opt_init, opt_external);
1019 else if (TREE_CODE (names) != ERROR_MARK)
1020 do_decl (names, type, opt_static, lifetime_bound, opt_init, opt_external);
1024 do_decl (name, type, is_static, lifetime_bound, opt_init, opt_external)
1033 if (current_function_decl == global_function_decl
1034 && ! lifetime_bound /*&& opt_init != NULL_TREE*/)
1039 push_obstacks (&permanent_obstack, &permanent_obstack);
1040 decl = make_node (VAR_DECL);
1041 DECL_NAME (decl) = name;
1042 TREE_TYPE (decl) = type;
1043 DECL_ASSEMBLER_NAME (decl) = name;
1045 /* Try to put things in common when possible.
1046 Tasking variables must go into common. */
1047 DECL_COMMON (decl) = 1;
1048 DECL_EXTERNAL (decl) = opt_external > 0;
1049 TREE_PUBLIC (decl) = opt_external > 0;
1050 TREE_STATIC (decl) = is_static;
1054 /* We have to set this here, since we build the decl w/o
1055 calling `build_decl'. */
1056 DECL_INITIAL (decl) = opt_init;
1065 DECL_INITIAL (decl) = opt_init;
1066 if (opt_external > 1 || in_pseudo_module)
1067 push_granted (DECL_NAME (decl), decl);
1069 else /* pass == 2 */
1071 tree temp = NULL_TREE;
1074 decl = get_next_decl ();
1076 if (name != DECL_NAME (decl))
1079 type = TREE_TYPE (decl);
1081 push_obstacks_nochange ();
1082 if (TYPE_READONLY_PROPERTY (type))
1084 if (CH_TYPE_NONVALUE_P (type))
1086 error_with_decl (decl, "`%s' must not be declared readonly");
1087 opt_init = NULL_TREE; /* prevent subsequent errors */
1089 else if (opt_init == NULL_TREE && !opt_external)
1090 error("declaration of readonly variable without initialization");
1092 TREE_READONLY (decl) = TYPE_READONLY (type);
1094 if (!opt_init && chill_varying_type_p (type))
1096 tree fixed_part_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type)));
1097 if (fixed_part_type != NULL_TREE && TREE_CODE (fixed_part_type) != ERROR_MARK)
1099 if (CH_CHARS_TYPE_P (fixed_part_type))
1100 opt_init = build_chill_string (0, "");
1102 opt_init = build_nt (CONSTRUCTOR, NULL_TREE, NULL_TREE);
1109 if (CH_TYPE_NONVALUE_P (type))
1111 error_with_decl (decl,
1112 "no initialisation allowed for `%s'");
1115 else if (TREE_CODE (type) == REFERENCE_TYPE)
1116 { /* A loc-identity declaration */
1117 if (! CH_LOCATION_P (opt_init))
1119 error_with_decl (decl,
1120 "value for loc-identity `%s' is not a location");
1123 else if (! CH_READ_COMPATIBLE (TREE_TYPE (type),
1124 TREE_TYPE (opt_init)))
1126 error_with_decl (decl,
1127 "location for `%s' not read-compatible");
1131 temp = convert (type, opt_init);
1134 { /* Normal location declaration */
1136 sprintf (place, "`%.60s' initializer",
1137 IDENTIFIER_POINTER (DECL_NAME (decl)));
1138 temp = chill_convert_for_assignment (type, opt_init, place);
1141 else if (CH_TYPE_NONVALUE_P (type))
1146 DECL_INITIAL (decl) = NULL_TREE;
1148 if (temp != NULL_TREE && TREE_CODE (temp) != ERROR_MARK)
1150 /* The same for stack variables (assuming no nested modules). */
1151 if (lifetime_bound || !is_static)
1153 if (is_static && ! TREE_CONSTANT (temp))
1154 error_with_decl (decl, "nonconstant initializer for `%s'");
1156 DECL_INITIAL (decl) = temp;
1160 /* Initialize the variable unless initialized statically. */
1161 if ((!is_static || ! lifetime_bound) &&
1162 temp != NULL_TREE && TREE_CODE (temp) != ERROR_MARK)
1164 int was_used = TREE_USED (decl);
1165 emit_line_note (input_filename, lineno);
1166 expand_expr_stmt (build_chill_modify_expr (decl, temp));
1167 /* Don't let the initialization count as "using" the variable. */
1168 TREE_USED (decl) = was_used;
1169 if (current_function_decl == global_function_decl)
1170 build_constructor = 1;
1172 else if (init_it && TREE_CODE (type) != ERROR_MARK)
1174 /* Initialize variables with non-value type */
1175 int was_used = TREE_USED (decl);
1176 int something_initialised = 0;
1178 emit_line_note (input_filename, lineno);
1179 if (TREE_CODE (type) == RECORD_TYPE)
1180 something_initialised = init_nonvalue_struct (decl);
1181 else if (TREE_CODE (type) == ARRAY_TYPE)
1182 something_initialised = init_nonvalue_array (decl);
1183 if (! something_initialised)
1185 error ("do_decl: internal error: don't know what to initialize");
1188 /* Don't let the initialization count as "using" the variable. */
1189 TREE_USED (decl) = was_used;
1190 if (current_function_decl == global_function_decl)
1191 build_constructor = 1;
1198 * ARGTYPES is a tree_list of formal argument types. TREE_VALUE
1199 * is the type tree for each argument, while the attribute is in
1203 build_chill_function_type (return_type, argtypes, exceptions, recurse_p)
1204 tree return_type, argtypes, exceptions, recurse_p;
1208 if (exceptions != NULL_TREE)
1210 /* if we have exceptions we add 2 arguments, callers filename
1211 and linenumber. These arguments will be added automatically
1212 when calling a function which may raise exceptions. */
1213 argtypes = chainon (argtypes,
1214 build_tree_list (NULL_TREE, ridpointers[(int) RID_PTR]));
1215 argtypes = chainon (argtypes,
1216 build_tree_list (NULL_TREE, ridpointers[(int) RID_LONG]));
1219 /* Indicate the argument list is complete. */
1220 argtypes = chainon (argtypes,
1221 build_tree_list (NULL_TREE, void_type_node));
1223 /* INOUT and OUT parameters must be a REFERENCE_TYPE since
1224 we'll be passing a temporary's address at call time. */
1225 for (arg = argtypes; arg; arg = TREE_CHAIN (arg))
1226 if (TREE_PURPOSE (arg) == ridpointers[(int) RID_LOC]
1227 || TREE_PURPOSE (arg) == ridpointers[(int) RID_OUT]
1228 || TREE_PURPOSE (arg) == ridpointers[(int) RID_INOUT]
1231 build_chill_reference_type (TREE_VALUE (arg));
1233 /* Cannot use build_function_type, because if does hash-canonlicalization. */
1234 ftype = make_node (FUNCTION_TYPE);
1235 TREE_TYPE (ftype) = return_type ? return_type : void_type_node ;
1236 TYPE_ARG_TYPES (ftype) = argtypes;
1239 ftype = build_exception_variant (ftype, exceptions);
1242 sorry ("RECURSIVE PROCs");
1248 * ARGTYPES is a tree_list of formal argument types.
1251 push_extern_function (name, typespec, argtypes, exceptions, granting)
1252 tree name, typespec, argtypes, exceptions;
1253 int granting ATTRIBUTE_UNUSED;/*If 0 do pushdecl(); if 1 do push_granted()*/
1257 push_obstacks_nochange ();
1258 end_temporary_allocation ();
1262 ftype = build_chill_function_type (typespec, argtypes,
1263 exceptions, NULL_TREE);
1265 fndecl = build_decl (FUNCTION_DECL, name, ftype);
1267 DECL_EXTERNAL(fndecl) = 1;
1268 TREE_STATIC (fndecl) = 1;
1269 TREE_PUBLIC (fndecl) = 1;
1273 finish_decl (fndecl);
1280 make_function_rtl (fndecl);
1284 fndecl = get_next_decl ();
1285 finish_decl (fndecl);
1290 push_granted (name, decl);
1300 push_extern_process (name, argtypes, exceptions, granting)
1301 tree name, argtypes, exceptions;
1304 tree decl, func, arglist;
1306 push_obstacks_nochange ();
1307 end_temporary_allocation ();
1311 tree proc_struct = make_process_struct (name, argtypes);
1312 arglist = (argtypes == NULL_TREE) ? NULL_TREE :
1313 tree_cons (NULL_TREE,
1314 build_chill_pointer_type (proc_struct), NULL_TREE);
1317 arglist = NULL_TREE;
1319 func = push_extern_function (name, NULL_TREE, arglist,
1320 exceptions, granting);
1322 /* declare the code variable */
1323 decl = generate_tasking_code_variable (name, &process_type, 1);
1324 CH_DECL_PROCESS (func) = 1;
1325 /* remember the code variable in the function decl */
1326 DECL_TASKING_CODE_DECL (func) = (struct lang_decl *)decl;
1328 add_taskstuff_to_list (decl, "_TT_Process", NULL_TREE, func, NULL_TREE);
1332 push_extern_signal (signame, sigmodelist, optsigdest)
1333 tree signame, sigmodelist, optsigdest;
1337 push_obstacks_nochange ();
1338 end_temporary_allocation ();
1341 build_signal_struct_type (signame, sigmodelist, optsigdest);
1343 /* declare the code variable outside the process */
1344 decl = generate_tasking_code_variable (signame, &signal_code, 1);
1345 add_taskstuff_to_list (decl, "_TT_Signal", NULL_TREE, sigtype, NULL_TREE);
1352 while (mode != NULL_TREE)
1354 switch (TREE_CODE (mode))
1358 mode = TREE_TYPE (mode);
1362 printf (" %s ", IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (mode))));
1367 tree itype = TYPE_DOMAIN (mode);
1368 if (CH_STRING_TYPE_P (mode))
1370 fputs (" STRING (", stdout);
1371 printf (HOST_WIDE_INT_PRINT_DEC,
1372 TREE_INT_CST_LOW (TYPE_MAX_VALUE (itype)));
1373 fputs (") OF ", stdout);
1377 fputs (" ARRAY (", stdout);
1378 printf (HOST_WIDE_INT_PRINT_DEC,
1379 TREE_INT_CST_LOW (TYPE_MIN_VALUE (itype)));
1380 fputs (":", stdout);
1381 printf (HOST_WIDE_INT_PRINT_DEC,
1382 TREE_INT_CST_LOW (TYPE_MAX_VALUE (itype)));
1383 fputs (") OF ", stdout);
1385 mode = TREE_TYPE (mode);
1390 tree fields = TYPE_FIELDS (mode);
1391 printf (" RECORD (");
1392 while (fields != NULL_TREE)
1394 printf (" %s:", IDENTIFIER_POINTER (DECL_NAME (fields)));
1395 print_mode (TREE_TYPE (fields));
1396 if (TREE_CHAIN (fields))
1398 fields = TREE_CHAIN (fields);
1411 chill_munge_params (nodes, type, attr)
1412 tree nodes, type, attr;
1417 /* Convert the list of identifiers to a list of types. */
1418 for (node = nodes; node != NULL_TREE; node = TREE_CHAIN (node))
1420 TREE_VALUE (node) = type; /* this was the identifier node */
1421 TREE_PURPOSE (node) = attr;
1427 /* Push the declarations described by SYN_DEFS into the current scope. */
1429 push_syndecl (name, mode, value)
1430 tree name, mode, value;
1434 tree decl = make_node (CONST_DECL);
1435 DECL_NAME (decl) = name;
1436 DECL_ASSEMBLER_NAME (decl) = name;
1437 TREE_TYPE (decl) = mode;
1438 DECL_INITIAL (decl) = value;
1439 TREE_READONLY (decl) = 1;
1441 if (in_pseudo_module)
1442 push_granted (DECL_NAME (decl), decl);
1444 else /* pass == 2 */
1450 /* Push the declarations described by (MODENAME,MODE) into the current scope.
1451 MAKE_NEWMODE is 1 for NEWMODE, 0 for SYNMODE, and
1452 -1 for internal use (in which case the mode does not need to be copied). */
1455 push_modedef (modename, mode, make_newmode)
1457 tree mode; /* ignored if pass==2. */
1460 tree newdecl, newmode;
1464 /* FIXME: need to check here for SYNMODE fred fred; */
1465 push_obstacks (&permanent_obstack, &permanent_obstack);
1467 newdecl = build_lang_decl (TYPE_DECL, modename, mode);
1469 if (make_newmode >= 0)
1471 newmode = make_node (LANG_TYPE);
1472 TREE_TYPE (newmode) = mode;
1473 TREE_TYPE (newdecl) = newmode;
1474 TYPE_NAME (newmode) = newdecl;
1475 if (make_newmode > 0)
1476 CH_NOVELTY (newmode) = newdecl;
1479 save_decl (newdecl);
1483 else /* pass == 2 */
1485 /* FIXME: need to check here for SYNMODE fred fred; */
1486 newdecl = get_next_decl ();
1487 if (DECL_NAME (newdecl) != modename)
1489 if (TREE_CODE (TREE_TYPE (newdecl)) != ERROR_MARK)
1491 /* ASSOCIATION, ACCESS, TEXT, BUFFER, and EVENT must not be READOnly */
1492 if (TREE_READONLY (TREE_TYPE (newdecl)) &&
1493 (CH_IS_ASSOCIATION_MODE (TREE_TYPE (newdecl)) ||
1494 CH_IS_ACCESS_MODE (TREE_TYPE (newdecl)) ||
1495 CH_IS_TEXT_MODE (TREE_TYPE (newdecl)) ||
1496 CH_IS_BUFFER_MODE (TREE_TYPE (newdecl)) ||
1497 CH_IS_EVENT_MODE (TREE_TYPE (newdecl))))
1498 error_with_decl (newdecl, "`%s' must not be READonly");
1499 rest_of_decl_compilation (newdecl, NULL_PTR,
1500 global_bindings_p (), 0);
1506 /* Return a chain of FIELD_DECLs for the names in NAMELIST. All of
1507 of type TYPE. When NAMELIST is passed in from the parser, it is
1509 LAYOUT is (NULL_TREE, integer_one_node, integer_zero_node, tree_list),
1510 meaning (default, pack, nopack, POS (...) ). */
1513 grok_chill_fixedfields (namelist, type, layout)
1514 tree namelist, type;
1517 tree decls = NULL_TREE;
1519 if (layout != NULL_TREE && TREE_CHAIN (namelist) != NULL_TREE)
1521 if (layout != integer_one_node && layout != integer_zero_node)
1524 error ("POS may not be specified for a list of field declarations");
1528 /* we build the chain of FIELD_DECLs backwards, effectively
1529 unreversing the reversed names in NAMELIST. */
1530 for (; namelist; namelist = TREE_CHAIN (namelist))
1532 tree decl = build_decl (FIELD_DECL,
1533 TREE_VALUE (namelist), type);
1534 DECL_INITIAL (decl) = layout;
1535 TREE_CHAIN (decl) = decls;
1548 static int label_value_cmp PARAMS ((struct tree_pair *,
1549 struct tree_pair *));
1551 /* Function to help qsort sort variant labels by value order. */
1553 label_value_cmp (x, y)
1554 struct tree_pair *x, *y;
1556 return TREE_INT_CST_LOW (x->value) - TREE_INT_CST_LOW (y->value);
1560 make_chill_variants (tagfields, body, variantelse)
1566 tree first = NULL_TREE;
1567 for (; body; body = TREE_CHAIN (body))
1569 tree decls = TREE_VALUE (body);
1570 tree labellist = TREE_PURPOSE (body);
1572 if (labellist != NULL_TREE
1573 && TREE_CODE (TREE_VALUE (labellist)) == TREE_LIST
1574 && TREE_VALUE (TREE_VALUE (labellist)) == case_else_node
1575 && TREE_CHAIN (labellist) == NULL_TREE)
1578 error ("(ELSE) case label as well as ELSE variant");
1579 variantelse = decls;
1583 tree rtype = start_struct (RECORD_TYPE, NULL_TREE);
1584 rtype = finish_struct (rtype, decls);
1586 first = chainon (first, build_decl (FIELD_DECL, NULL_TREE, rtype));
1588 TYPE_TAG_VALUES (rtype) = labellist;
1592 if (variantelse != NULL_TREE)
1594 tree rtype = start_struct (RECORD_TYPE, NULL_TREE);
1595 rtype = finish_struct (rtype, variantelse);
1596 first = chainon (first,
1597 build_decl (FIELD_DECL,
1598 ELSE_VARIANT_NAME, rtype));
1601 utype = start_struct (UNION_TYPE, NULL_TREE);
1602 utype = finish_struct (utype, first);
1603 TYPE_TAGFIELDS (utype) = tagfields;
1608 layout_chill_variants (utype)
1611 tree first = TYPE_FIELDS (utype);
1612 int nlabels, label_index = 0;
1613 struct tree_pair *label_value_array;
1615 extern int errorcount;
1617 if (TYPE_SIZE (utype))
1620 for (decl = first; decl; decl = TREE_CHAIN (decl))
1622 tree tagfields = TYPE_TAGFIELDS (utype);
1623 tree t = TREE_TYPE (decl);
1624 tree taglist = TYPE_TAG_VALUES (t);
1625 if (DECL_NAME (decl) == ELSE_VARIANT_NAME)
1627 if (tagfields == NULL_TREE)
1629 for ( ; tagfields != NULL_TREE && taglist != NULL_TREE;
1630 tagfields = TREE_CHAIN (tagfields), taglist = TREE_CHAIN (taglist))
1632 tree labellist = TREE_VALUE (taglist);
1633 for (; labellist; labellist = TREE_CHAIN (labellist))
1635 int compat_error = 0;
1636 tree label_value = TREE_VALUE (labellist);
1637 if (TREE_CODE (label_value) == RANGE_EXPR)
1639 if (TREE_OPERAND (label_value, 0) != NULL_TREE)
1641 if (!CH_COMPATIBLE (TREE_OPERAND (label_value, 0),
1642 TREE_TYPE (TREE_VALUE (tagfields)))
1643 || !CH_COMPATIBLE (TREE_OPERAND (label_value, 1),
1644 TREE_TYPE (TREE_VALUE (tagfields))))
1648 else if (TREE_CODE (label_value) == TYPE_DECL)
1650 if (!CH_COMPATIBLE (label_value,
1651 TREE_TYPE (TREE_VALUE (tagfields))))
1654 else if (TREE_CODE (label_value) == INTEGER_CST)
1656 if (!CH_COMPATIBLE (label_value,
1657 TREE_TYPE (TREE_VALUE (tagfields))))
1662 if (TYPE_FIELDS (t) == NULL_TREE)
1663 error ("inconsistent modes between labels and tag field");
1665 error_with_decl (TYPE_FIELDS (t),
1666 "inconsistent modes between labels and tag field");
1670 if (tagfields != NULL_TREE)
1671 error ("too few tag labels");
1672 if (taglist != NULL_TREE)
1673 error ("too many tag labels");
1676 /* Compute the number of labels to be checked for duplicates. */
1678 for (decl = first; decl; decl = TREE_CHAIN (decl))
1680 tree t = TREE_TYPE (decl);
1681 /* Only one tag (first case_label_list) supported, for now. */
1682 tree labellist = TYPE_TAG_VALUES (t);
1684 labellist = TREE_VALUE (labellist);
1686 for (; labellist != NULL_TREE; labellist = TREE_CHAIN (labellist))
1687 if (TREE_CODE (TREE_VALUE (labellist)) == INTEGER_CST)
1691 /* Check for duplicate label values. */
1692 label_value_array = (struct tree_pair *)alloca (nlabels * sizeof (struct tree_pair));
1693 for (decl = first; decl; decl = TREE_CHAIN (decl))
1695 tree t = TREE_TYPE (decl);
1696 /* Only one tag (first case_label_list) supported, for now. */
1697 tree labellist = TYPE_TAG_VALUES (t);
1699 labellist = TREE_VALUE (labellist);
1701 for (; labellist != NULL_TREE; labellist = TREE_CHAIN (labellist))
1705 tree x = TREE_VALUE (labellist);
1706 if (TREE_CODE (x) == RANGE_EXPR)
1708 if (TREE_OPERAND (x, 0) != NULL_TREE)
1710 if (TREE_CODE (TREE_OPERAND (x, 0)) != INTEGER_CST)
1711 error ("case label lower limit is not a discrete constant expression");
1712 if (TREE_CODE (TREE_OPERAND (x, 1)) != INTEGER_CST)
1713 error ("case label upper limit is not a discrete constant expression");
1717 else if (TREE_CODE (x) == TYPE_DECL)
1719 else if (TREE_CODE (x) == ERROR_MARK)
1721 else if (TREE_CODE (x) != INTEGER_CST) /* <-- FIXME: what about CONST_DECLs? */
1723 error ("case label must be a discrete constant expression");
1727 if (TREE_CODE (x) == CONST_DECL)
1728 x = DECL_INITIAL (x);
1729 if (TREE_CODE (x) != INTEGER_CST) abort ();
1732 if (p.decl == NULL_TREE)
1733 p.decl = TREE_VALUE (labellist);
1734 label_value_array[label_index++] = p;
1737 if (errorcount == 0)
1740 qsort (label_value_array,
1741 label_index, sizeof (struct tree_pair),
1742 (int (*) PARAMS ((const void *, const void *))) label_value_cmp);
1743 limit = label_index - 1;
1744 for (label_index = 0; label_index < limit; label_index++)
1746 if (tree_int_cst_equal (label_value_array[label_index].value,
1747 label_value_array[label_index+1].value))
1749 error_with_decl (label_value_array[label_index].decl,
1750 "variant label declared here...");
1751 error_with_decl (label_value_array[label_index+1].decl,
1752 "...is duplicated here");
1756 layout_type (utype);
1760 /* Convert a TREE_LIST of tag field names into a list of
1761 field decls, found from FIXED_FIELDS, re-using the input list. */
1764 lookup_tag_fields (tag_field_names, fixed_fields)
1765 tree tag_field_names;
1769 for (list = tag_field_names; list != NULL_TREE; list = TREE_CHAIN (list))
1771 tree decl = fixed_fields;
1772 for ( ; decl != NULL_TREE; decl = TREE_CHAIN (decl))
1774 if (DECL_NAME (decl) == TREE_VALUE (list))
1776 TREE_VALUE (list) = decl;
1780 if (decl == NULL_TREE)
1782 error ("no field (yet) for tag %s",
1783 IDENTIFIER_POINTER (TREE_VALUE (list)));
1784 TREE_VALUE (list) = error_mark_node;
1787 return tag_field_names;
1790 /* If non-NULL, TAGFIELDS is the tag fields for this variant record.
1791 BODY is a TREE_LIST of (optlabels, fixed fields).
1792 If non-null, VARIANTELSE is a fixed field for the else part of the
1796 grok_chill_variantdefs (tagfields, body, variantelse)
1797 tree tagfields, body, variantelse;
1801 t = make_chill_variants (tagfields, body, variantelse);
1803 t = layout_chill_variants (t);
1804 return build_decl (FIELD_DECL, NULL_TREE, t);
1808 In pass 1, PARMS is a list of types (with attributes).
1809 In pass 2, PARMS is a chain of PARM_DECLs.
1813 start_chill_function (label, rtype, parms, exceptlist, attrs)
1814 tree label, rtype, parms, exceptlist, attrs;
1816 tree decl, fndecl, type, result_type, func_type;
1817 int nested = current_function_decl != 0;
1821 = build_chill_function_type (rtype, parms, exceptlist, 0);
1822 fndecl = build_decl (FUNCTION_DECL, label, func_type);
1826 /* Make the init_value nonzero so pushdecl knows this is not tentative.
1827 error_mark_node is replaced below (in poplevel) with the BLOCK. */
1828 DECL_INITIAL (fndecl) = error_mark_node;
1830 DECL_EXTERNAL (fndecl) = 0;
1832 /* This function exists in static storage.
1833 (This does not mean `static' in the C sense!) */
1834 TREE_STATIC (fndecl) = 1;
1836 for (; attrs != NULL_TREE; attrs = TREE_CHAIN (attrs))
1838 if (TREE_VALUE (attrs) == ridpointers[RID_GENERAL])
1839 CH_DECL_GENERAL (fndecl) = 1;
1840 else if (TREE_VALUE (attrs) == ridpointers[RID_SIMPLE])
1841 CH_DECL_SIMPLE (fndecl) = 1;
1842 else if (TREE_VALUE (attrs) == ridpointers[RID_RECURSIVE])
1843 CH_DECL_RECURSIVE (fndecl) = 1;
1844 else if (TREE_VALUE (attrs) == ridpointers[RID_INLINE])
1845 DECL_INLINE (fndecl) = 1;
1850 else /* pass == 2 */
1852 fndecl = get_next_decl ();
1853 if (DECL_NAME (fndecl) != label)
1854 abort (); /* outta sync - got wrong decl */
1855 func_type = TREE_TYPE (fndecl);
1856 if (TYPE_RAISES_EXCEPTIONS (func_type) != NULL_TREE)
1858 /* In this case we have to add 2 parameters.
1859 See build_chill_function_type (pass == 1). */
1862 arg = make_node (PARM_DECL);
1863 DECL_ASSEMBLER_NAME (arg) = DECL_NAME (arg) = get_identifier (CALLER_FILE);
1864 DECL_IGNORED_P (arg) = 1;
1865 parms = chainon (parms, arg);
1867 arg = make_node (PARM_DECL);
1868 DECL_ASSEMBLER_NAME (arg) = DECL_NAME (arg) = get_identifier (CALLER_LINE);
1869 DECL_IGNORED_P (arg) = 1;
1870 parms = chainon (parms, arg);
1874 current_function_decl = fndecl;
1875 result_type = TREE_TYPE (func_type);
1876 if (CH_TYPE_NONVALUE_P (result_type))
1877 error ("non-value mode may only returned by LOC");
1879 pushlevel (1); /* Push parameters. */
1883 DECL_ARGUMENTS (fndecl) = parms;
1884 for (decl = DECL_ARGUMENTS (fndecl), type = TYPE_ARG_TYPES (func_type);
1886 decl = TREE_CHAIN (decl), type = TREE_CHAIN (type))
1888 /* check here that modes with the non-value property (like
1889 BUFFER's, EVENT's, ASSOCIATION's, ACCESS's, or TEXT's) only
1890 gets passed by LOC */
1891 tree argtype = TREE_VALUE (type);
1892 tree argattr = TREE_PURPOSE (type);
1894 if (TREE_CODE (argtype) == REFERENCE_TYPE)
1895 argtype = TREE_TYPE (argtype);
1897 if (TREE_CODE (argtype) != ERROR_MARK &&
1898 TREE_CODE_CLASS (TREE_CODE (argtype)) != 't')
1900 error_with_decl (decl, "mode of `%s' is not a mode");
1901 TREE_VALUE (type) = error_mark_node;
1904 if (CH_TYPE_NONVALUE_P (argtype) &&
1905 argattr != ridpointers[(int) RID_LOC])
1906 error_with_decl (decl, "`%s' may only be passed by LOC");
1907 TREE_TYPE (decl) = TREE_VALUE (type);
1908 DECL_ARG_TYPE (decl) = TREE_TYPE (decl);
1909 DECL_CONTEXT (decl) = fndecl;
1910 TREE_READONLY (decl) = TYPE_READONLY (argtype);
1911 layout_decl (decl, 0);
1914 pushdecllist (DECL_ARGUMENTS (fndecl), 0);
1916 DECL_RESULT (current_function_decl)
1917 = build_decl (RESULT_DECL, NULL_TREE, result_type);
1920 /* Write a record describing this function definition to the prototypes
1921 file (if requested). */
1922 gen_aux_info_record (fndecl, 1, 0, prototype);
1925 if (fndecl != global_function_decl || seen_action)
1927 /* Initialize the RTL code for the function. */
1928 init_function_start (fndecl, input_filename, lineno);
1930 /* Set up parameters and prepare for return, for the function. */
1931 expand_function_start (fndecl, 0);
1935 /* Allocate further tree nodes temporarily during compilation
1936 of this function only. */
1937 temporary_allocation ();
1939 /* If this fcn was already referenced via a block-scope `extern' decl (or
1940 an implicit decl), propagate certain information about the usage. */
1941 if (TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (current_function_decl)))
1942 TREE_ADDRESSABLE (current_function_decl) = 1;
1945 /* Z.200 requires that formal parameter names be defined in
1946 the same block as the procedure body.
1947 We could do this by keeping boths sets of DECLs in the same
1948 scope, but we would have to be careful to not merge the
1949 two chains (e.g. DECL_ARGUEMENTS musr not contains locals).
1950 Instead, we just make sure they have the same nesting_level. */
1951 current_nesting_level--;
1952 pushlevel (1); /* Push local variables. */
1954 if (pass == 2 && (fndecl != global_function_decl || seen_action))
1956 /* generate label for possible 'exit' */
1957 expand_start_bindings (1);
1959 result_never_set = 1;
1962 if (TREE_CODE (result_type) == VOID_TYPE)
1963 chill_result_decl = NULL_TREE;
1966 /* We use the same name as the keyword.
1967 This makes it easy to print and change the RESULT from gdb. */
1968 const char *result_str =
1969 (ignore_case || ! special_UC) ? "result" : "RESULT";
1970 if (pass == 2 && TREE_CODE (result_type) == ERROR_MARK)
1971 TREE_TYPE (current_scope->remembered_decls) = result_type;
1972 chill_result_decl = do_decl (get_identifier (result_str),
1973 result_type, 0, 0, 0, 0);
1974 DECL_CONTEXT (chill_result_decl) = fndecl;
1980 /* For checking purpose added pname as new argument
1981 MW Wed Oct 14 14:22:10 1992 */
1983 finish_chill_function ()
1985 register tree fndecl = current_function_decl;
1986 tree outer_function = decl_function_context (fndecl);
1988 if (outer_function == NULL_TREE && fndecl != global_function_decl)
1989 outer_function = global_function_decl;
1990 nested = current_function_decl != global_function_decl;
1991 if (pass == 2 && (fndecl != global_function_decl || seen_action))
1992 expand_end_bindings (getdecls (), 1, 0);
1994 /* pop out of function */
1996 current_nesting_level++;
1997 /* pop out of its parameters */
2002 /* TREE_READONLY (fndecl) = 1;
2003 This caused &foo to be of type ptr-to-const-function which
2004 then got a warning when stored in a ptr-to-function variable. */
2006 BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
2008 /* Must mark the RESULT_DECL as being in this function. */
2010 DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
2012 if (fndecl != global_function_decl || seen_action)
2014 /* Generate rtl for function exit. */
2015 expand_function_end (input_filename, lineno, 0);
2017 /* So we can tell if jump_optimize sets it to 1. */
2020 /* Run the optimizers and output assembler code for this function. */
2021 rest_of_compilation (fndecl);
2024 if (DECL_SAVED_INSNS (fndecl) == 0 && ! nested)
2026 /* Stop pointing to the local nodes about to be freed. */
2027 /* But DECL_INITIAL must remain nonzero so we know this
2028 was an actual function definition. */
2029 /* For a nested function, this is done in pop_chill_function_context. */
2030 DECL_INITIAL (fndecl) = error_mark_node;
2031 DECL_ARGUMENTS (fndecl) = 0;
2034 current_function_decl = outer_function;
2039 /* Points to the head of the _DECLs read from seize files. */
2041 static tree seized_decls;
2043 static tree processed_seize_files = 0;
2047 chill_seize (old_prefix, new_prefix, postfix)
2048 tree old_prefix, new_prefix, postfix;
2052 tree decl = build_alias_decl (old_prefix, new_prefix, postfix);
2053 DECL_SEIZEFILE(decl) = use_seizefile_name;
2056 else /* pass == 2 */
2058 /* Do nothing - get_next_decl automatically ignores ALIAS_DECLs */
2064 * output a debug dump of a scope structure
2070 if (sp == (struct scope *)NULL)
2072 fprintf (stderr, "null scope ptr\n");
2075 fprintf (stderr, "enclosing 0x%x ", sp->enclosing);
2076 fprintf (stderr, "next 0x%x ", sp->next);
2077 fprintf (stderr, "remembered_decls 0x%x ", sp->remembered_decls);
2078 fprintf (stderr, "decls 0x%x\n", sp->decls);
2079 fprintf (stderr, "shadowed 0x%x ", sp->shadowed);
2080 fprintf (stderr, "blocks 0x%x ", sp->blocks);
2081 fprintf (stderr, "this_block 0x%x ", sp->this_block);
2082 fprintf (stderr, "level_chain 0x%x\n", sp->level_chain);
2083 fprintf (stderr, "module_flag %c ", sp->module_flag ? 'T' : 'F');
2084 fprintf (stderr, "first_child_module 0x%x ", sp->first_child_module);
2085 fprintf (stderr, "next_sibling_module 0x%x\n", sp->next_sibling_module);
2086 if (sp->remembered_decls != NULL_TREE)
2089 fprintf (stderr, "remembered_decl chain:\n");
2090 for (temp = sp->remembered_decls; temp; temp = TREE_CHAIN (temp))
2100 if (current_function_decl != global_function_decl)
2101 DECL_CONTEXT (decl) = current_function_decl;
2103 TREE_CHAIN (decl) = current_scope->remembered_decls;
2104 current_scope->remembered_decls = decl;
2106 fprintf (stderr, "\n\nsave_decl 0x%x\n", decl);
2107 debug_scope (current_scope); /* ************* */
2109 set_nesting_level (decl, current_nesting_level);
2118 decl = current_scope->remembered_decls;
2119 current_scope->remembered_decls = TREE_CHAIN (decl);
2120 /* We ignore ALIAS_DECLs, because push_scope_decls
2121 can convert a single ALIAS_DECL representing 'SEIZE ALL'
2122 into one ALIAS_DECL for each seizeable name.
2123 This means we lose the nice one-to-one mapping
2124 between pass 1 decls and pass 2 decls.
2125 (Perhaps ALIAS_DECLs should not be on the remembered_decls list.) */
2126 } while (decl && TREE_CODE (decl) == ALIAS_DECL);
2130 /* At the end of pass 1, we reverse the chronological chain of scopes. */
2136 extern int errorcount, sorrycount;
2138 if (current_scope != &builtin_scope)
2140 last_scope = &builtin_scope;
2141 builtin_scope.remembered_decls = nreverse (builtin_scope.remembered_decls);
2142 write_grant_file ();
2145 if (errorcount || sorrycount)
2146 exit (FATAL_EXIT_CODE);
2149 if (grant_only_flag)
2150 exit (SUCCESS_EXIT_CODE);
2154 next_module = &first_module;
2158 * Called during pass 2, when we're processing actions, to
2159 * generate a temporary variable. These don't need satisfying
2160 * because they're compiler-generated and always declared
2161 * before they're used.
2164 decl_temp1 (name, type, opt_static, opt_init,
2165 opt_external, opt_public)
2169 int opt_external, opt_public;
2171 int orig_pass = pass; /* be cautious */
2175 mydecl = do_decl (name, type, opt_static, opt_static,
2176 opt_init, opt_external);
2179 TREE_PUBLIC (mydecl) = 1;
2181 do_decl (name, type, opt_static, opt_static, opt_init, opt_external);
2187 /* True if we're reading a seizefile, but we haven't seen a SPEC MODULE yet.
2188 For backwards compatibility, we treat declarations in such a context
2189 as implicity granted. */
2192 set_module_name (name)
2196 if (name == NULL_TREE)
2198 /* NOTE: build_prefix_clause assumes a generated
2199 module starts with a '_'. */
2201 sprintf (buf, "_MODULE_%d", module_number);
2202 name = get_identifier (buf);
2208 push_module (name, is_spec_module)
2212 struct module *new_module;
2215 new_module = (struct module*) permalloc (sizeof (struct module));
2216 new_module->prev_module = current_module;
2218 *next_module = new_module;
2222 new_module = *next_module;
2224 next_module = &new_module->next_module;
2226 new_module->procedure_seen = 0;
2227 new_module->is_spec_module = is_spec_module;
2228 new_module->name = name;
2230 new_module->prefix_name
2231 = get_identifier3 (IDENTIFIER_POINTER (current_module->prefix_name),
2232 "__", IDENTIFIER_POINTER (name));
2234 new_module->prefix_name = name;
2236 new_module->granted_decls = NULL_TREE;
2237 new_module->nesting_level = current_nesting_level + 1;
2239 current_module = new_module;
2240 current_module_nesting_level = new_module->nesting_level;
2241 in_pseudo_module = name ? 0 : 1;
2245 current_scope->module_flag = 1;
2247 *current_scope->enclosing->tail_child_module = current_scope;
2248 current_scope->enclosing->tail_child_module
2249 = ¤t_scope->next_sibling_module;
2251 /* Rename the global function to have the same name as
2252 the first named non-spec module. */
2254 && IDENTIFIER_POINTER (name)[0] != '_'
2255 && IDENTIFIER_POINTER (DECL_NAME (global_function_decl))[0] == '_')
2257 tree fname = get_identifier3 ("", IDENTIFIER_POINTER (name), "_");
2258 DECL_NAME (global_function_decl) = fname;
2259 DECL_ASSEMBLER_NAME (global_function_decl) = fname;
2262 return name; /* may have generated a name */
2264 /* Make a copy of the identifier NAME, replacing each '!' by '__'. */
2266 fix_identifier (name)
2269 char *buf = (char*)alloca (2 * IDENTIFIER_LENGTH (name) + 1);
2271 register char *dptr = buf;
2272 register const char *sptr = IDENTIFIER_POINTER (name);
2273 for (; *sptr; sptr++)
2285 return fixed ? get_identifier (buf) : name;
2289 find_granted_decls ()
2293 /* Match each granted name to a granted decl. */
2295 tree alias = current_module->granted_decls;
2296 tree next_alias, decl;
2297 /* This is an O(M*N) algorithm. FIXME! */
2298 for (; alias; alias = next_alias)
2301 next_alias = TREE_CHAIN (alias);
2302 for (decl = current_scope->remembered_decls;
2303 decl; decl = TREE_CHAIN (decl))
2305 tree new_name = (! DECL_NAME (decl)) ? NULL_TREE :
2306 decl_check_rename (alias,
2311 /* A Seized declaration is not grantable. */
2312 if (TREE_CODE (decl) == ALIAS_DECL && !CH_DECL_GRANTED (decl))
2315 if (global_bindings_p ())
2316 TREE_PUBLIC (decl) = 1;
2317 if (DECL_ASSEMBLER_NAME (decl) == NULL_TREE)
2318 DECL_ASSEMBLER_NAME (decl) = fix_identifier (new_name);
2319 if (DECL_POSTFIX_ALL (alias))
2322 = build_alias_decl (NULL_TREE, NULL_TREE, new_name);
2323 TREE_CHAIN (new_alias) = TREE_CHAIN (alias);
2324 TREE_CHAIN (alias) = new_alias;
2325 DECL_ABSTRACT_ORIGIN (new_alias) = decl;
2326 DECL_SOURCE_LINE (new_alias) = 0;
2327 DECL_SEIZEFILE (new_alias) = DECL_SEIZEFILE (alias);
2331 DECL_ABSTRACT_ORIGIN (alias) = decl;
2337 error_with_decl (alias, "Nothing named `%s' to grant.");
2338 DECL_ABSTRACT_ORIGIN (alias) = error_mark_node;
2348 struct scope *module_scope = current_scope;
2354 /* Write out the grant file. */
2355 if (!current_module->is_spec_module)
2357 /* After reversal, TREE_CHAIN (last_old_decl) is the oldest
2358 decl of the current module. */
2359 write_spec_module (module_scope->remembered_decls,
2360 current_module->granted_decls);
2363 /* Move the granted decls into the enclosing scope. */
2364 if (current_scope == global_scope)
2367 for (decl = current_module->granted_decls; decl; decl = next_decl)
2369 tree name = DECL_NAME (decl);
2370 next_decl = TREE_CHAIN (decl);
2371 if (name != NULL_TREE)
2373 tree old_decl = IDENTIFIER_OUTER_VALUE (name);
2374 set_nesting_level (decl, current_nesting_level);
2375 if (old_decl != NULL_TREE)
2377 pedwarn_with_decl (decl, "duplicate grant for `%s'");
2378 pedwarn_with_decl (old_decl, "previous grant for `%s'");
2379 TREE_CHAIN (decl) = TREE_CHAIN (old_decl);
2380 TREE_CHAIN (old_decl) = decl;
2384 TREE_CHAIN (decl) = outer_decls;
2386 IDENTIFIER_OUTER_VALUE (name) = decl;
2392 current_scope->granted_decls = chainon (current_module->granted_decls,
2393 current_scope->granted_decls);
2396 chill_check_no_handlers (); /* Sanity test */
2397 current_module = current_module->prev_module;
2398 current_module_nesting_level = current_module ?
2399 current_module->nesting_level : 0;
2400 in_pseudo_module = 0;
2403 /* Nonzero if we are currently in the global binding level. */
2406 global_bindings_p ()
2408 /* We return -1 here for the sake of variable_size() in ../stor-layout.c. */
2409 return (current_function_decl == NULL_TREE
2410 || current_function_decl == global_function_decl) ? -1 : 0;
2413 /* Nonzero if the current level needs to have a BLOCK made. */
2418 return current_scope->decls != 0;
2421 /* Make DECL visible.
2422 Save any existing definition.
2423 Check redefinitions at the same level.
2424 Suppress error messages if QUIET is true. */
2427 proclaim_decl (decl, quiet)
2431 tree name = DECL_NAME (decl);
2434 tree old_decl = IDENTIFIER_LOCAL_VALUE (name);
2435 if (old_decl == NULL) ; /* No duplication */
2436 else if (DECL_NESTING_LEVEL (old_decl) != current_nesting_level)
2438 /* Record for restoration when this binding level ends. */
2439 current_scope->shadowed
2440 = tree_cons (name, old_decl, current_scope->shadowed);
2442 else if (DECL_WEAK_NAME (decl))
2444 else if (!DECL_WEAK_NAME (old_decl))
2446 tree base_decl = decl, base_old_decl = old_decl;
2447 while (TREE_CODE (base_decl) == ALIAS_DECL)
2448 base_decl = DECL_ABSTRACT_ORIGIN (base_decl);
2449 while (TREE_CODE (base_old_decl) == ALIAS_DECL)
2450 base_old_decl = DECL_ABSTRACT_ORIGIN (base_old_decl);
2451 /* Note that duplicate definitions are allowed for set elements
2452 of similar set modes. See Z200 (1988) 12.2.2.
2453 However, if the types are identical, we are defining the
2454 same name multiple times in the same SET, which is naughty. */
2455 if (!quiet && base_decl != base_old_decl)
2457 if (TREE_CODE (base_decl) != CONST_DECL
2458 || TREE_CODE (base_old_decl) != CONST_DECL
2459 || !CH_DECL_ENUM (base_decl)
2460 || !CH_DECL_ENUM (base_old_decl)
2461 || TREE_TYPE (base_decl) == TREE_TYPE (base_old_decl)
2462 || !CH_SIMILAR (TREE_TYPE (base_decl),
2463 TREE_TYPE(base_old_decl)))
2465 error_with_decl (decl, "duplicate definition `%s'");
2466 error_with_decl (old_decl, "previous definition of `%s'");
2470 IDENTIFIER_LOCAL_VALUE (name) = decl;
2472 /* Should be redundant most of the time ... */
2473 set_nesting_level (decl, current_nesting_level);
2476 /* Return tree_cons (NULL_TREE, ELEMENT, LIST) unless ELEMENT
2477 is already in LIST, in which case return LIST. */
2480 maybe_acons (element, list)
2484 for (pair = list; pair; pair = TREE_CHAIN (pair))
2485 if (element == TREE_VALUE (pair))
2487 return tree_cons (NULL_TREE, element, list);
2496 static tree find_implied_types PARAMS ((tree, struct path *, tree));
2498 /* Look for implied types (enumeral types) implied by TYPE (a decl or type).
2500 Use old_path to guard against cycles. */
2503 find_implied_types (type, old_path, list)
2505 struct path *old_path;
2508 struct path path[1], *link;
2509 if (type == NULL_TREE)
2511 path[0].prev = old_path;
2512 path[0].node = type;
2514 /* Check for a cycle. Something more clever might be appropriate. FIXME? */
2515 for (link = old_path; link; link = link->prev)
2516 if (link->node == type)
2519 switch (TREE_CODE (type))
2522 return maybe_acons (type, list);
2525 case REFERENCE_TYPE:
2527 return find_implied_types (TREE_TYPE (type), path, list);
2529 return find_implied_types (TYPE_DOMAIN (type), path, list);
2535 list = find_implied_types (TREE_TYPE (type), path, list);
2536 for (t = TYPE_ARG_TYPES (type); t != NULL_TREE; t = TREE_CHAIN (t))
2537 list = find_implied_types (TREE_VALUE (t), path, list);
2541 list = find_implied_types (TYPE_DOMAIN (type), path, list);
2542 return find_implied_types (TREE_TYPE (type), path, list);
2546 for (fields = TYPE_FIELDS (type); fields != NULL_TREE;
2547 fields = TREE_CHAIN (fields))
2548 list = find_implied_types (TREE_TYPE (fields), path, list);
2552 case IDENTIFIER_NODE:
2553 return find_implied_types (lookup_name (type), path, list);
2556 return find_implied_types (DECL_ABSTRACT_ORIGIN (type), path, list);
2560 return find_implied_types (TREE_TYPE (type), path, list);
2566 /* Make declarations in current scope visible.
2567 Also, expand SEIZEs, and make correspondong ALIAS_DECLs visible. */
2570 push_scope_decls (quiet)
2571 int quiet; /* If 1, we're pre-scanning, so suppress errors. */
2575 /* First make everything except 'SEIZE ALL' names visible, before
2576 handling 'SEIZE ALL'. (This makes it easier to check 'seizable'). */
2577 for (decl = current_scope->remembered_decls; decl; decl = TREE_CHAIN (decl))
2579 if (TREE_CODE (decl) == ALIAS_DECL)
2581 if (DECL_POSTFIX_ALL (decl))
2583 if (DECL_ABSTRACT_ORIGIN (decl) == NULL_TREE)
2585 tree val = lookup_name_for_seizing (decl);
2586 if (val == NULL_TREE)
2588 error_with_file_and_line
2589 (DECL_SOURCE_FILE (decl), DECL_SOURCE_LINE (decl),
2590 "cannot SEIZE `%s'",
2591 IDENTIFIER_POINTER (DECL_OLD_NAME (decl)));
2592 val = error_mark_node;
2594 DECL_ABSTRACT_ORIGIN (decl) = val;
2597 proclaim_decl (decl, quiet);
2600 pushdecllist (current_scope->granted_decls, quiet);
2602 /* Now handle SEIZE ALLs. */
2603 for (decl = current_scope->remembered_decls; decl; )
2605 tree next_decl = TREE_CHAIN (decl);
2606 if (TREE_CODE (decl) == ALIAS_DECL
2607 && DECL_ABSTRACT_ORIGIN (decl) == NULL_TREE
2608 && DECL_POSTFIX_ALL (decl))
2610 /* We saw a "SEIZE ALL". Replace it be a SEIZE for each
2611 declaration visible in the surrounding scope.
2612 Note that this complicates get_next_decl(). */
2614 tree last_new_alias = decl;
2615 DECL_ABSTRACT_ORIGIN (decl) = error_mark_node;
2616 if (current_scope->enclosing == global_scope)
2617 candidate = outer_decls;
2619 candidate = current_scope->enclosing->decls;
2620 for ( ; candidate; candidate = TREE_CHAIN (candidate))
2622 tree seizename = DECL_NAME (candidate);
2627 new_name = decl_check_rename (decl, seizename);
2631 /* Check if candidate is seizable. */
2632 if (lookup_name (new_name) != NULL_TREE)
2635 new_alias = build_alias_decl (NULL_TREE,NULL_TREE, new_name);
2636 TREE_CHAIN (new_alias) = TREE_CHAIN (last_new_alias);
2637 TREE_CHAIN (last_new_alias) = new_alias;
2638 last_new_alias = new_alias;
2639 DECL_ABSTRACT_ORIGIN (new_alias) = candidate;
2640 DECL_SOURCE_LINE (new_alias) = 0;
2642 proclaim_decl (new_alias, quiet);
2648 /* Link current_scope->remembered_decls at the head of the
2649 current_scope->decls list (just like pushdecllist, but
2650 without calling proclaim_decl, since we've already done that). */
2651 if ((decl = current_scope->remembered_decls) != NULL_TREE)
2653 while (TREE_CHAIN (decl) != NULL_TREE)
2654 decl = TREE_CHAIN (decl);
2655 TREE_CHAIN (decl) = current_scope->decls;
2656 current_scope->decls = current_scope->remembered_decls;
2661 pop_scope_decls (decls_limit, shadowed_limit)
2662 tree decls_limit, shadowed_limit;
2664 /* Remove the temporary bindings we made. */
2665 tree link = current_scope->shadowed;
2666 tree decl = current_scope->decls;
2667 if (decl != decls_limit)
2669 while (decl != decls_limit)
2671 tree next = TREE_CHAIN (decl);
2672 if (DECL_NAME (decl))
2674 /* If the ident. was used or addressed via a local extern decl,
2675 don't forget that fact. */
2676 if (DECL_EXTERNAL (decl))
2678 if (TREE_USED (decl))
2679 TREE_USED (DECL_NAME (decl)) = 1;
2680 if (TREE_ADDRESSABLE (decl))
2681 TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (decl)) = 1;
2683 IDENTIFIER_LOCAL_VALUE (DECL_NAME (decl)) = 0;
2685 if (next == decls_limit)
2687 TREE_CHAIN (decl) = NULL_TREE;
2692 current_scope->decls = decls_limit;
2695 /* Restore all name-meanings of the outer levels
2696 that were shadowed by this level. */
2697 for ( ; link != shadowed_limit; link = TREE_CHAIN (link))
2698 IDENTIFIER_LOCAL_VALUE (TREE_PURPOSE (link)) = TREE_VALUE (link);
2699 current_scope->shadowed = shadowed_limit;
2702 /* Return list of weak names (as ALIAS_DECLs) implied by IMPLIED_TYPES. */
2705 build_implied_names (implied_types)
2708 tree aliases = NULL_TREE;
2710 for ( ; implied_types; implied_types = TREE_CHAIN (implied_types))
2712 tree enum_type = TREE_VALUE (implied_types);
2713 tree link = TYPE_VALUES (enum_type);
2714 if (TREE_CODE (enum_type) != ENUMERAL_TYPE)
2717 for ( ; link; link = TREE_CHAIN (link))
2719 /* We don't handle renaming/prefixes (Blue Book p 163) FIXME */
2720 /* Note that before enum_type is laid out, TREE_VALUE (link)
2721 is a CONST_DECL, while after it is laid out,
2722 TREE_VALUE (link) is an INTEGER_CST. Either works. */
2724 = build_alias_decl (NULL_TREE, NULL_TREE, TREE_PURPOSE (link));
2725 DECL_ABSTRACT_ORIGIN (alias) = TREE_VALUE (link);
2726 DECL_WEAK_NAME (alias) = 1;
2727 TREE_CHAIN (alias) = aliases;
2729 /* Strictlt speaking, we should have a pointer from the alias
2730 to the decl, so we can make sure that the alias is only
2731 visible when the decl is. FIXME */
2738 bind_sub_modules (do_weak)
2742 int save_module_nesting_level = current_module_nesting_level;
2743 struct scope *saved_scope = current_scope;
2744 struct scope *nested_module = current_scope->first_child_module;
2746 while (nested_module != NULL)
2748 tree saved_shadowed = nested_module->shadowed;
2749 tree saved_decls = nested_module->decls;
2750 current_nesting_level++;
2751 current_scope = nested_module;
2752 current_module_nesting_level = current_nesting_level;
2754 push_scope_decls (1);
2757 tree implied_types = NULL_TREE;
2758 /* Push weak names implied by decls in current_scope. */
2759 for (decl = current_scope->remembered_decls;
2760 decl; decl = TREE_CHAIN (decl))
2761 if (TREE_CODE (decl) == ALIAS_DECL)
2762 implied_types = find_implied_types (decl, NULL, implied_types);
2763 for (decl = current_scope->granted_decls;
2764 decl; decl = TREE_CHAIN (decl))
2765 implied_types = find_implied_types (decl, NULL, implied_types);
2766 current_scope->weak_decls = build_implied_names (implied_types);
2767 pushdecllist (current_scope->weak_decls, 1);
2770 bind_sub_modules (do_weak);
2771 for (decl = current_scope->remembered_decls;
2772 decl; decl = TREE_CHAIN (decl))
2773 satisfy_decl (decl, 1);
2774 pop_scope_decls (saved_decls, saved_shadowed);
2775 current_nesting_level--;
2776 nested_module = nested_module->next_sibling_module;
2779 current_scope = saved_scope;
2780 current_module_nesting_level = save_module_nesting_level;
2783 /* Enter a new binding level.
2784 If two_pass==0, assume we are called from non-Chill-specific parts
2785 of the compiler. These parts assume a single pass.
2786 If two_pass==1, we're called from Chill parts of the compiler.
2790 pushlevel (two_pass)
2793 register struct scope *newlevel;
2795 current_nesting_level++;
2798 newlevel = (struct scope *)xmalloc (sizeof(struct scope));
2799 *newlevel = clear_scope;
2800 newlevel->enclosing = current_scope;
2801 current_scope = newlevel;
2805 newlevel = (struct scope *)permalloc (sizeof(struct scope));
2806 *newlevel = clear_scope;
2807 newlevel->tail_child_module = &newlevel->first_child_module;
2808 newlevel->enclosing = current_scope;
2809 current_scope = newlevel;
2810 last_scope->next = newlevel;
2811 last_scope = newlevel;
2813 else /* pass == 2 */
2816 newlevel = current_scope = last_scope = last_scope->next;
2818 push_scope_decls (0);
2819 pushdecllist (current_scope->weak_decls, 0);
2821 /* If this is not a module scope, scan ahead for locally nested
2822 modules. (If this is a module, that's already done.) */
2823 if (!current_scope->module_flag)
2825 bind_sub_modules (0);
2826 bind_sub_modules (1);
2829 for (decl = current_scope->remembered_decls;
2830 decl; decl = TREE_CHAIN (decl))
2831 satisfy_decl (decl, 0);
2834 /* Add this level to the front of the chain (stack) of levels that
2837 newlevel->level_chain = current_scope;
2838 current_scope = newlevel;
2840 newlevel->two_pass = two_pass;
2843 /* Exit a binding level.
2844 Pop the level off, and restore the state of the identifier-decl mappings
2845 that were in effect when this level was entered.
2847 If KEEP is nonzero, this level had explicit declarations, so
2848 and create a "block" (a BLOCK node) for the level
2849 to record its declarations and subblocks for symbol table output.
2851 If FUNCTIONBODY is nonzero, this level is the body of a function,
2852 so create a block as if KEEP were set and also clear out all
2855 If REVERSE is nonzero, reverse the order of decls before putting
2856 them into the BLOCK. */
2859 poplevel (keep, reverse, functionbody)
2865 /* The chain of decls was accumulated in reverse order.
2866 Put it into forward order, just for cleanliness. */
2871 int block_previously_created = 0;
2873 if (current_scope == NULL)
2874 return error_mark_node;
2876 subblocks = current_scope->blocks;
2878 /* Get the decls in the order they were written.
2879 Usually current_scope->decls is in reverse order.
2880 But parameter decls were previously put in forward order. */
2883 current_scope->decls
2884 = decls = nreverse (current_scope->decls);
2886 decls = current_scope->decls;
2890 /* Output any nested inline functions within this block
2891 if they weren't already output. */
2893 for (decl = decls; decl; decl = TREE_CHAIN (decl))
2894 if (TREE_CODE (decl) == FUNCTION_DECL
2895 && ! TREE_ASM_WRITTEN (decl)
2896 && DECL_INITIAL (decl) != 0
2897 && TREE_ADDRESSABLE (decl))
2899 /* If this decl was copied from a file-scope decl
2900 on account of a block-scope extern decl,
2901 propagate TREE_ADDRESSABLE to the file-scope decl. */
2902 if (DECL_ABSTRACT_ORIGIN (decl) != 0)
2903 TREE_ADDRESSABLE (DECL_ABSTRACT_ORIGIN (decl)) = 1;
2906 push_function_context ();
2907 output_inline_function (decl);
2908 pop_function_context ();
2912 /* Clear out the meanings of the local variables of this level. */
2913 pop_scope_decls (NULL_TREE, NULL_TREE);
2915 /* If there were any declarations or structure tags in that level,
2916 or if this level is a function body,
2917 create a BLOCK to record them for the life of this function. */
2920 block_previously_created = (current_scope->this_block != 0);
2921 if (block_previously_created)
2922 block = current_scope->this_block;
2923 else if (keep || functionbody)
2924 block = make_node (BLOCK);
2928 BLOCK_VARS (block) = decls;
2930 /* Splice out ALIAS_DECL and LABEL_DECLs,
2931 since instantiate_decls can't handle them. */
2932 for (ptr = &BLOCK_VARS (block); *ptr; )
2935 if (TREE_CODE (decl) == ALIAS_DECL
2936 || TREE_CODE (decl) == LABEL_DECL)
2937 *ptr = TREE_CHAIN (decl);
2939 ptr = &TREE_CHAIN(*ptr);
2942 BLOCK_SUBBLOCKS (block) = subblocks;
2945 /* In each subblock, record that this is its superior. */
2947 for (link = subblocks; link; link = TREE_CHAIN (link))
2948 BLOCK_SUPERCONTEXT (link) = block;
2952 /* If the level being exited is the top level of a function,
2953 check over all the labels, and clear out the current
2954 (function local) meanings of their names. */
2956 if (pass == 2 && functionbody)
2958 /* If this is the top level block of a function,
2959 the vars are the function's parameters.
2960 Don't leave them in the BLOCK because they are
2961 found in the FUNCTION_DECL instead. */
2963 BLOCK_VARS (block) = 0;
2966 /* Clear out the definitions of all label names,
2967 since their scopes end here,
2968 and add them to BLOCK_VARS. */
2970 for (link = named_labels; link; link = TREE_CHAIN (link))
2972 register tree label = TREE_VALUE (link);
2974 if (DECL_INITIAL (label) == 0)
2976 error_with_decl (label, "label `%s' used but not defined");
2977 /* Avoid crashing later. */
2978 define_label (input_filename, lineno,
2981 else if (warn_unused && !TREE_USED (label))
2982 warning_with_decl (label, "label `%s' defined but not used");
2983 IDENTIFIER_LABEL_VALUE (DECL_NAME (label)) = 0;
2985 /* Put the labels into the "variables" of the
2986 top-level block, so debugger can see them. */
2987 TREE_CHAIN (label) = BLOCK_VARS (block);
2988 BLOCK_VARS (block) = label;
2995 current_scope->remembered_decls
2996 = nreverse (current_scope->remembered_decls);
2997 current_scope->granted_decls = nreverse (current_scope->granted_decls);
3000 current_scope = current_scope->enclosing;
3001 current_nesting_level--;
3008 /* Dispose of the block that we just made inside some higher level. */
3010 DECL_INITIAL (current_function_decl) = block;
3013 if (!block_previously_created)
3014 current_scope->blocks
3015 = chainon (current_scope->blocks, block);
3017 /* If we did not make a block for the level just exited,
3018 any blocks made for inner levels
3019 (since they cannot be recorded as subblocks in that level)
3020 must be carried forward so they will later become subblocks
3021 of something else. */
3023 current_scope->blocks
3024 = chainon (current_scope->blocks, subblocks);
3027 TREE_USED (block) = 1;
3031 /* Delete the node BLOCK from the current binding level.
3032 This is used for the block inside a stmt expr ({...})
3033 so that the block can be reinserted where appropriate. */
3036 delete_block (block)
3040 if (current_scope->blocks == block)
3041 current_scope->blocks = TREE_CHAIN (block);
3042 for (t = current_scope->blocks; t;)
3044 if (TREE_CHAIN (t) == block)
3045 TREE_CHAIN (t) = TREE_CHAIN (block);
3049 TREE_CHAIN (block) = NULL;
3050 /* Clear TREE_USED which is always set by poplevel.
3051 The flag is set again if insert_block is called. */
3052 TREE_USED (block) = 0;
3055 /* Insert BLOCK at the end of the list of subblocks of the
3056 current binding level. This is used when a BIND_EXPR is expanded,
3057 to handle the BLOCK node inside teh BIND_EXPR. */
3060 insert_block (block)
3063 TREE_USED (block) = 1;
3064 current_scope->blocks
3065 = chainon (current_scope->blocks, block);
3068 /* Set the BLOCK node for the innermost scope
3069 (the one we are currently in). */
3073 register tree block;
3075 current_scope->this_block = block;
3078 /* Record a decl-node X as belonging to the current lexical scope.
3079 Check for errors (such as an incompatible declaration for the same
3080 name already seen in the same scope).
3082 Returns either X or an old decl for the same name.
3083 If an old decl is returned, it may have been smashed
3084 to agree with what X says. */
3090 register tree name = DECL_NAME (x);
3091 register struct scope *b = current_scope;
3093 DECL_CONTEXT (x) = current_function_decl;
3094 /* A local extern declaration for a function doesn't constitute nesting.
3095 A local auto declaration does, since it's a forward decl
3096 for a nested function coming later. */
3097 if (TREE_CODE (x) == FUNCTION_DECL && DECL_INITIAL (x) == 0
3098 && DECL_EXTERNAL (x))
3099 DECL_CONTEXT (x) = 0;
3102 proclaim_decl (x, 0);
3104 if (TREE_CODE (x) == TYPE_DECL && DECL_SOURCE_LINE (x) == 0
3105 && TYPE_NAME (TREE_TYPE (x)) == 0)
3106 TYPE_NAME (TREE_TYPE (x)) = x;
3108 /* Put decls on list in reverse order.
3109 We will reverse them later if necessary. */
3110 TREE_CHAIN (x) = b->decls;
3116 /* Make DECLS (a chain of decls) visible in the current_scope. */
3119 pushdecllist (decls, quiet)
3123 tree last = NULL_TREE, decl;
3125 for (decl = decls; decl != NULL_TREE;
3126 last = decl, decl = TREE_CHAIN (decl))
3128 proclaim_decl (decl, quiet);
3133 TREE_CHAIN (last) = current_scope->decls;
3134 current_scope->decls = decls;
3138 /* Like pushdecl, only it places X in GLOBAL_SCOPE, if appropriate. */
3141 pushdecl_top_level (x)
3145 register struct scope *b = current_scope;
3147 current_scope = global_scope;
3153 /* Define a label, specifying the location in the source file.
3154 Return the LABEL_DECL node for the label, if the definition is valid.
3155 Otherwise return 0. */
3158 define_label (filename, line, name)
3167 decl = build_decl (LABEL_DECL, name, void_type_node);
3169 /* A label not explicitly declared must be local to where it's ref'd. */
3170 DECL_CONTEXT (decl) = current_function_decl;
3172 DECL_MODE (decl) = VOIDmode;
3174 /* Say where one reference is to the label,
3175 for the sake of the error if it is not defined. */
3176 DECL_SOURCE_LINE (decl) = line;
3177 DECL_SOURCE_FILE (decl) = filename;
3179 /* Mark label as having been defined. */
3180 DECL_INITIAL (decl) = error_mark_node;
3182 DECL_ACTION_NESTING_LEVEL (decl) = action_nesting_level;
3188 decl = get_next_decl ();
3189 /* Make sure every label has an rtx. */
3192 expand_label (decl);
3197 /* Return the list of declarations of the current level.
3198 Note that this list is in reverse order unless/until
3199 you nreverse it; and when you do nreverse it, you must
3200 store the result back using `storedecls' or you will lose. */
3205 /* This is a kludge, so that dbxout_init can get the predefined types,
3206 which are in the builtin_scope, though when it is called,
3207 the current_scope is the global_scope.. */
3208 if (current_scope == global_scope)
3209 return builtin_scope.decls;
3210 return current_scope->decls;
3214 /* Store the list of declarations of the current level.
3215 This is done for the parameter declarations of a function being defined,
3216 after they are modified in the light of any missing parameters. */
3222 current_scope->decls = decls;
3226 /* Look up NAME in the current binding level and its superiors
3227 in the namespace of variables, functions and typedefs.
3228 Return a ..._DECL node of some kind representing its definition,
3229 or return 0 if it is undefined. */
3235 register tree val = IDENTIFIER_LOCAL_VALUE (name);
3237 if (val == NULL_TREE)
3239 if (TREE_CODE_CLASS (TREE_CODE (val)) == 'c')
3241 if (DECL_NESTING_LEVEL (val) > BUILTIN_NESTING_LEVEL
3242 && DECL_NESTING_LEVEL (val) < current_module_nesting_level)
3246 while (TREE_CODE (val) == ALIAS_DECL)
3248 val = DECL_ABSTRACT_ORIGIN (val);
3249 if (TREE_CODE (val) == ERROR_MARK)
3252 if (TREE_CODE (val) == BASED_DECL)
3254 return build_chill_indirect_ref (DECL_ABSTRACT_ORIGIN (val),
3255 TREE_TYPE (val), 1);
3257 if (TREE_CODE (val) == WITH_DECL)
3258 return build_component_ref (DECL_ABSTRACT_ORIGIN (val), DECL_NAME (val));
3263 /* Similar to `lookup_name' but look only at current binding level. */
3266 lookup_name_current_level (name)
3269 register tree val = IDENTIFIER_LOCAL_VALUE (name);
3270 if (val && DECL_NESTING_LEVEL (val) == current_nesting_level)
3277 lookup_name_for_seizing (seize_decl)
3280 tree name = DECL_OLD_NAME (seize_decl);
3282 val = IDENTIFIER_LOCAL_VALUE (name);
3283 if (val == NULL_TREE || DECL_NESTING_LEVEL (val) == BUILTIN_NESTING_LEVEL)
3285 val = IDENTIFIER_OUTER_VALUE (name);
3286 if (val == NULL_TREE)
3288 if (TREE_CHAIN (val) && DECL_NAME (TREE_CHAIN (val)) == name)
3289 { /* More than one decl with the same name has been granted
3290 into the same global scope. Pick the one (we hope) that
3291 came from a seizefile the matches the most recent
3292 seizefile (as given by DECL_SEIZEFILE (seize_decl).) */
3293 tree d, best = NULL_TREE;
3294 for (d = val; d != NULL_TREE && DECL_NAME (d) == name;
3296 if (DECL_SEIZEFILE (d) == DECL_SEIZEFILE (seize_decl))
3300 error_with_decl (seize_decl,
3301 "ambiguous choice for seize `%s' -");
3302 error_with_decl (best, " - can seize this `%s' -");
3303 error_with_decl (d, " - or this granted decl `%s'");
3308 if (best == NULL_TREE)
3310 error_with_decl (seize_decl,
3311 "ambiguous choice for seize `%s' -");
3312 error_with_decl (val, " - can seize this `%s' -");
3313 error_with_decl (TREE_CHAIN (val),
3314 " - or this granted decl `%s'");
3321 /* We don't need to handle this, as long as we
3322 resolve the seize targets before pushing them. */
3323 if (DECL_NESTING_LEVEL (val) >= current_module_nesting_level)
3325 /* VAL was declared inside current module. We need something
3326 from the scope *enclosing* the current module, so search
3327 through the shadowed declarations. */
3331 if (current_module && current_module->prev_module
3332 && DECL_NESTING_LEVEL (val)
3333 < current_module->prev_module->nesting_level)
3336 /* It's declared in a scope enclosing the module enclosing
3337 the current module. Hence it's not visible. */
3340 while (TREE_CODE (val) == ALIAS_DECL)
3342 val = DECL_ABSTRACT_ORIGIN (val);
3343 if (TREE_CODE (val) == ERROR_MARK)
3349 /* Create the predefined scalar types of C,
3350 and some nodes representing standard constants (0, 1, (void *)0).
3351 Initialize the global binding level.
3352 Make definitions for built-in primitive functions. */
3355 init_decl_processing ()
3357 int wchar_type_size;
3358 tree bool_ftype_int_ptr_int;
3359 tree bool_ftype_int_ptr_int_int;
3360 tree bool_ftype_luns_ptr_luns_long;
3361 tree bool_ftype_luns_ptr_luns_long_ptr_int;
3362 tree bool_ftype_ptr_int_ptr_int;
3363 tree bool_ftype_ptr_int_ptr_int_int;
3364 tree find_bit_ftype;
3365 tree bool_ftype_ptr_ptr_int;
3366 tree bool_ftype_ptr_ptr_luns;
3367 tree bool_ftype_ptr_ptr_ptr_luns;
3370 tree int_ftype_int_int;
3371 tree int_ftype_int_ptr_int;
3373 tree int_ftype_ptr_int;
3374 tree int_ftype_ptr_int_int_ptr_int;
3375 tree int_ftype_ptr_luns_long_ptr_int;
3376 tree int_ftype_ptr_ptr_int;
3377 tree int_ftype_ptr_ptr_luns;
3378 tree long_ftype_ptr_luns;
3381 tree ptr_ftype_ptr_int_int;
3382 tree ptr_ftype_ptr_ptr_int;
3383 tree ptr_ftype_ptr_ptr_int_ptr_int;
3384 tree real_ftype_real;
3386 tree void_ftype_cptr_cptr_int;
3387 tree void_ftype_long_int_ptr_int_ptr_int;
3388 tree void_ftype_ptr;
3389 tree void_ftype_ptr_int_int_int_int;
3390 tree void_ftype_ptr_int_ptr_int_int_int;
3391 tree void_ftype_ptr_int_ptr_int_ptr_int;
3392 tree void_ftype_ptr_luns_long_long_bool_ptr_int;
3393 tree void_ftype_ptr_luns_ptr_luns_luns_luns;
3394 tree void_ftype_ptr_ptr_ptr_int;
3395 tree void_ftype_ptr_ptr_ptr_luns;
3396 tree void_ftype_refptr_int_ptr_int;
3397 tree void_ftype_void;
3398 tree void_ftype_ptr_ptr_int;
3399 tree void_ftype_ptr_luns_luns_cptr_luns_luns_luns;
3400 tree ptr_ftype_luns_ptr_int;
3401 tree double_ftype_double;
3403 /* allow 0-255 enums to occupy only a byte */
3404 flag_short_enums = 1;
3406 current_function_decl = NULL;
3408 set_alignment = BITS_PER_UNIT;
3410 ALL_POSTFIX = get_identifier ("*");
3411 string_index_type_dummy = get_identifier("%string-index%");
3413 var_length_id = get_identifier (VAR_LENGTH);
3414 var_data_id = get_identifier (VAR_DATA);
3416 build_common_tree_nodes (1);
3418 if (CHILL_INT_IS_SHORT)
3419 long_integer_type_node = integer_type_node;
3421 long_integer_type_node = make_signed_type (LONG_TYPE_SIZE);
3423 /* `unsigned long' is the standard type for sizeof.
3424 Note that stddef.h uses `unsigned long',
3425 and this must agree, even of long and int are the same size. */
3427 set_sizetype (long_unsigned_type_node);
3430 const char *size_type_c_name = SIZE_TYPE;
3431 if (strncmp (size_type_c_name, "long long ", 10) == 0)
3432 set_sizetype (long_long_unsigned_type_node);
3433 else if (strncmp (size_type_c_name, "long ", 5) == 0)
3434 set_sizetype (long_unsigned_type_node);
3436 set_sizetype (unsigned_type_node);
3440 pushdecl (build_decl (TYPE_DECL, ridpointers[(int) RID_FLOAT],
3442 pushdecl (build_decl (TYPE_DECL, ridpointers[(int) RID_DOUBLE],
3445 integer_minus_one_node = build_int_2 (-1, -1);
3446 TREE_TYPE (integer_minus_one_node) = integer_type_node;
3448 build_common_tree_nodes_2 (flag_short_double);
3450 pushdecl (build_decl (TYPE_DECL,
3451 ridpointers[(int) RID_VOID], void_type_node));
3452 /* We are not going to have real types in C with less than byte alignment,
3453 so we might as well not have any types that claim to have it. */
3454 TYPE_ALIGN (void_type_node) = BITS_PER_UNIT;
3456 /* This is for wide string constants. */
3457 wchar_type_node = short_unsigned_type_node;
3458 wchar_type_size = TYPE_PRECISION (wchar_type_node);
3459 signed_wchar_type_node = type_for_size (wchar_type_size, 0);
3460 unsigned_wchar_type_node = type_for_size (wchar_type_size, 1);
3462 default_function_type
3463 = build_function_type (integer_type_node, NULL_TREE);
3465 ptr_type_node = build_pointer_type (void_type_node);
3467 = build_pointer_type (build_type_variant (void_type_node, 1, 0));
3469 void_list_node = build_tree_list (NULL_TREE, void_type_node);
3471 boolean_type_node = make_node (BOOLEAN_TYPE);
3472 TYPE_PRECISION (boolean_type_node) = 1;
3473 fixup_unsigned_type (boolean_type_node);
3474 boolean_false_node = TYPE_MIN_VALUE (boolean_type_node);
3475 boolean_true_node = TYPE_MAX_VALUE (boolean_type_node);
3476 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_BOOL],
3477 boolean_type_node));
3479 /* TRUE and FALSE have the BOOL derived class */
3480 CH_DERIVED_FLAG (boolean_true_node) = 1;
3481 CH_DERIVED_FLAG (boolean_false_node) = 1;
3483 signed_boolean_type_node = make_node (BOOLEAN_TYPE);
3484 temp = build_int_2 (-1, -1);
3485 TREE_TYPE (temp) = signed_boolean_type_node;
3486 TYPE_MIN_VALUE (signed_boolean_type_node) = temp;
3487 temp = build_int_2 (0, 0);
3488 TREE_TYPE (temp) = signed_boolean_type_node;
3489 TYPE_MAX_VALUE (signed_boolean_type_node) = temp;
3490 layout_type (signed_boolean_type_node);
3493 bitstring_one_type_node = build_bitstring_type (integer_one_node);
3494 bit_zero_node = build (CONSTRUCTOR, bitstring_one_type_node, NULL_TREE,
3496 bit_one_node = build (CONSTRUCTOR, bitstring_one_type_node, NULL_TREE,
3497 build_tree_list (NULL_TREE, integer_zero_node));
3499 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_CHAR],
3502 if (CHILL_INT_IS_SHORT)
3504 chill_integer_type_node = short_integer_type_node;
3505 chill_unsigned_type_node = short_unsigned_type_node;
3509 chill_integer_type_node = integer_type_node;
3510 chill_unsigned_type_node = unsigned_type_node;
3513 string_one_type_node = build_string_type (char_type_node, integer_one_node);
3515 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_BYTE],
3516 signed_char_type_node));
3517 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_UBYTE],
3518 unsigned_char_type_node));
3520 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_INT],
3521 chill_integer_type_node));
3523 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_UINT],
3524 chill_unsigned_type_node));
3526 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_LONG],
3527 long_integer_type_node));
3529 set_sizetype (long_integer_type_node);
3532 = TREE_TYPE (IDENTIFIER_LOCAL_VALUE (get_identifier (PTRDIFF_TYPE)));
3534 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_ULONG],
3535 long_unsigned_type_node));
3536 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_REAL],
3538 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_LONG_REAL],
3540 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_PTR],
3543 IDENTIFIER_LOCAL_VALUE (ridpointers[(int)RID_TRUE]) =
3545 IDENTIFIER_LOCAL_VALUE (ridpointers[(int)RID_FALSE]) =
3547 IDENTIFIER_LOCAL_VALUE (ridpointers[(int)RID_NULL]) =
3550 /* The second operand is set to non-NULL to distinguish
3551 (ELSE) from (*). Used when writing grant files. */
3552 case_else_node = build (RANGE_EXPR,
3553 NULL_TREE, NULL_TREE, boolean_false_node);
3555 pushdecl (temp = build_decl (TYPE_DECL,
3556 get_identifier ("__tmp_initializer"),
3557 build_init_struct ()));
3558 DECL_SOURCE_LINE (temp) = 0;
3559 initializer_type = TREE_TYPE (temp);
3561 memcpy (tree_code_type + (int) LAST_AND_UNUSED_TREE_CODE,
3562 chill_tree_code_type,
3563 (((int) LAST_CHILL_TREE_CODE - (int) LAST_AND_UNUSED_TREE_CODE)
3565 memcpy (tree_code_length + (int) LAST_AND_UNUSED_TREE_CODE,
3566 chill_tree_code_length,
3567 (((int) LAST_CHILL_TREE_CODE - (int) LAST_AND_UNUSED_TREE_CODE)
3569 memcpy (tree_code_name + (int) LAST_AND_UNUSED_TREE_CODE,
3570 chill_tree_code_name,
3571 (((int) LAST_CHILL_TREE_CODE - (int) LAST_AND_UNUSED_TREE_CODE)
3572 * sizeof (char *)));
3573 boolean_code_name = (const char **) xcalloc (sizeof (char *),
3574 (int) LAST_CHILL_TREE_CODE);
3576 boolean_code_name[EQ_EXPR] = "=";
3577 boolean_code_name[NE_EXPR] = "/=";
3578 boolean_code_name[LT_EXPR] = "<";
3579 boolean_code_name[GT_EXPR] = ">";
3580 boolean_code_name[LE_EXPR] = "<=";
3581 boolean_code_name[GE_EXPR] = ">=";
3582 boolean_code_name[SET_IN_EXPR] = "in";
3583 boolean_code_name[TRUTH_ANDIF_EXPR] = "andif";
3584 boolean_code_name[TRUTH_ORIF_EXPR] = "orif";
3585 boolean_code_name[TRUTH_AND_EXPR] = "and";
3586 boolean_code_name[TRUTH_OR_EXPR] = "or";
3587 boolean_code_name[BIT_AND_EXPR] = "and";
3588 boolean_code_name[BIT_IOR_EXPR] = "or";
3589 boolean_code_name[BIT_XOR_EXPR] = "xor";
3591 endlink = void_list_node;
3593 chill_predefined_function_type
3594 = build_function_type (integer_type_node,
3595 tree_cons (NULL_TREE, integer_type_node,
3598 bool_ftype_int_ptr_int
3599 = build_function_type (boolean_type_node,
3600 tree_cons (NULL_TREE, integer_type_node,
3601 tree_cons (NULL_TREE, ptr_type_node,
3602 tree_cons (NULL_TREE, integer_type_node,
3604 bool_ftype_int_ptr_int
3605 = build_function_type (boolean_type_node,
3606 tree_cons (NULL_TREE, integer_type_node,
3607 tree_cons (NULL_TREE, ptr_type_node,
3608 tree_cons (NULL_TREE, integer_type_node,
3609 tree_cons (NULL_TREE, integer_type_node,
3611 bool_ftype_int_ptr_int_int
3612 = build_function_type (boolean_type_node,
3613 tree_cons (NULL_TREE, integer_type_node,
3614 tree_cons (NULL_TREE, ptr_type_node,
3615 tree_cons (NULL_TREE, integer_type_node,
3616 tree_cons (NULL_TREE, integer_type_node,
3618 bool_ftype_luns_ptr_luns_long
3619 = build_function_type (boolean_type_node,
3620 tree_cons (NULL_TREE, long_unsigned_type_node,
3621 tree_cons (NULL_TREE, ptr_type_node,
3622 tree_cons (NULL_TREE, long_unsigned_type_node,
3623 tree_cons (NULL_TREE, long_integer_type_node,
3625 bool_ftype_luns_ptr_luns_long_ptr_int
3626 = build_function_type (boolean_type_node,
3627 tree_cons (NULL_TREE, long_unsigned_type_node,
3628 tree_cons (NULL_TREE, ptr_type_node,
3629 tree_cons (NULL_TREE, long_unsigned_type_node,
3630 tree_cons (NULL_TREE, long_integer_type_node,
3631 tree_cons (NULL_TREE, ptr_type_node,
3632 tree_cons (NULL_TREE, integer_type_node,
3634 bool_ftype_ptr_ptr_int
3635 = build_function_type (boolean_type_node,
3636 tree_cons (NULL_TREE, ptr_type_node,
3637 tree_cons (NULL_TREE, ptr_type_node,
3638 tree_cons (NULL_TREE, integer_type_node,
3640 bool_ftype_ptr_ptr_luns
3641 = build_function_type (boolean_type_node,
3642 tree_cons (NULL_TREE, ptr_type_node,
3643 tree_cons (NULL_TREE, ptr_type_node,
3644 tree_cons (NULL_TREE, long_unsigned_type_node,
3646 bool_ftype_ptr_ptr_ptr_luns
3647 = build_function_type (boolean_type_node,
3648 tree_cons (NULL_TREE, ptr_type_node,
3649 tree_cons (NULL_TREE, ptr_type_node,
3650 tree_cons (NULL_TREE, ptr_type_node,
3651 tree_cons (NULL_TREE, long_unsigned_type_node,
3653 bool_ftype_ptr_int_ptr_int
3654 = build_function_type (boolean_type_node,
3655 tree_cons (NULL_TREE, ptr_type_node,
3656 tree_cons (NULL_TREE, integer_type_node,
3657 tree_cons (NULL_TREE, ptr_type_node,
3658 tree_cons (NULL_TREE, integer_type_node,
3660 bool_ftype_ptr_int_ptr_int_int
3661 = build_function_type (boolean_type_node,
3662 tree_cons (NULL_TREE, ptr_type_node,
3663 tree_cons (NULL_TREE, integer_type_node,
3664 tree_cons (NULL_TREE, ptr_type_node,
3665 tree_cons (NULL_TREE, integer_type_node,
3666 tree_cons (NULL_TREE, integer_type_node,
3669 = build_function_type (integer_type_node,
3670 tree_cons (NULL_TREE, ptr_type_node,
3671 tree_cons (NULL_TREE, long_unsigned_type_node,
3672 tree_cons (NULL_TREE, integer_type_node,
3675 = build_function_type (integer_type_node,
3676 tree_cons (NULL_TREE, integer_type_node,
3679 = build_function_type (integer_type_node,
3680 tree_cons (NULL_TREE, integer_type_node,
3681 tree_cons (NULL_TREE, integer_type_node,
3683 int_ftype_int_ptr_int
3684 = build_function_type (integer_type_node,
3685 tree_cons (NULL_TREE, integer_type_node,
3686 tree_cons (NULL_TREE, ptr_type_node,
3687 tree_cons (NULL_TREE, integer_type_node,
3690 = build_function_type (integer_type_node,
3691 tree_cons (NULL_TREE, ptr_type_node,
3694 = build_function_type (integer_type_node,
3695 tree_cons (NULL_TREE, ptr_type_node,
3696 tree_cons (NULL_TREE, integer_type_node,
3700 = build_function_type (long_integer_type_node,
3701 tree_cons (NULL_TREE, ptr_type_node,
3702 tree_cons (NULL_TREE, long_unsigned_type_node,
3705 int_ftype_ptr_int_int_ptr_int
3706 = build_function_type (integer_type_node,
3707 tree_cons (NULL_TREE, ptr_type_node,
3708 tree_cons (NULL_TREE, integer_type_node,
3709 tree_cons (NULL_TREE, integer_type_node,
3710 tree_cons (NULL_TREE, ptr_type_node,
3711 tree_cons (NULL_TREE, integer_type_node,
3714 int_ftype_ptr_luns_long_ptr_int
3715 = build_function_type (integer_type_node,
3716 tree_cons (NULL_TREE, ptr_type_node,
3717 tree_cons (NULL_TREE, long_unsigned_type_node,
3718 tree_cons (NULL_TREE, long_integer_type_node,
3719 tree_cons (NULL_TREE, ptr_type_node,
3720 tree_cons (NULL_TREE, integer_type_node,
3723 int_ftype_ptr_ptr_int
3724 = build_function_type (integer_type_node,
3725 tree_cons (NULL_TREE, ptr_type_node,
3726 tree_cons (NULL_TREE, ptr_type_node,
3727 tree_cons (NULL_TREE, integer_type_node,
3729 int_ftype_ptr_ptr_luns
3730 = build_function_type (integer_type_node,
3731 tree_cons (NULL_TREE, ptr_type_node,
3732 tree_cons (NULL_TREE, ptr_type_node,
3733 tree_cons (NULL_TREE, long_unsigned_type_node,
3735 memcpy_ftype /* memcpy/memmove prototype */
3736 = build_function_type (ptr_type_node,
3737 tree_cons (NULL_TREE, ptr_type_node,
3738 tree_cons (NULL_TREE, const_ptr_type_node,
3739 tree_cons (NULL_TREE, sizetype,
3741 memcmp_ftype /* memcmp prototype */
3742 = build_function_type (integer_type_node,
3743 tree_cons (NULL_TREE, ptr_type_node,
3744 tree_cons (NULL_TREE, ptr_type_node,
3745 tree_cons (NULL_TREE, sizetype,
3748 ptr_ftype_ptr_int_int
3749 = build_function_type (ptr_type_node,
3750 tree_cons (NULL_TREE, ptr_type_node,
3751 tree_cons (NULL_TREE, integer_type_node,
3752 tree_cons (NULL_TREE, integer_type_node,
3754 ptr_ftype_ptr_ptr_int
3755 = build_function_type (ptr_type_node,
3756 tree_cons (NULL_TREE, ptr_type_node,
3757 tree_cons (NULL_TREE, ptr_type_node,
3758 tree_cons (NULL_TREE, integer_type_node,
3760 ptr_ftype_ptr_ptr_int_ptr_int
3761 = build_function_type (void_type_node,
3762 tree_cons (NULL_TREE, ptr_type_node,
3763 tree_cons (NULL_TREE, ptr_type_node,
3764 tree_cons (NULL_TREE, integer_type_node,
3765 tree_cons (NULL_TREE, ptr_type_node,
3766 tree_cons (NULL_TREE, integer_type_node,
3769 = build_function_type (float_type_node,
3770 tree_cons (NULL_TREE, float_type_node,
3774 = build_function_type (void_type_node,
3775 tree_cons (NULL_TREE, ptr_type_node, endlink));
3777 void_ftype_cptr_cptr_int
3778 = build_function_type (void_type_node,
3779 tree_cons (NULL_TREE, const_ptr_type_node,
3780 tree_cons (NULL_TREE, const_ptr_type_node,
3781 tree_cons (NULL_TREE, integer_type_node,
3784 void_ftype_refptr_int_ptr_int
3785 = build_function_type (void_type_node,
3786 tree_cons (NULL_TREE, build_reference_type(ptr_type_node),
3787 tree_cons (NULL_TREE, integer_type_node,
3788 tree_cons (NULL_TREE, ptr_type_node,
3789 tree_cons (NULL_TREE, integer_type_node,
3792 void_ftype_ptr_ptr_ptr_int
3793 = build_function_type (void_type_node,
3794 tree_cons (NULL_TREE, ptr_type_node,
3795 tree_cons (NULL_TREE, ptr_type_node,
3796 tree_cons (NULL_TREE, ptr_type_node,
3797 tree_cons (NULL_TREE, integer_type_node,
3799 void_ftype_ptr_ptr_ptr_luns
3800 = build_function_type (void_type_node,
3801 tree_cons (NULL_TREE, ptr_type_node,
3802 tree_cons (NULL_TREE, ptr_type_node,
3803 tree_cons (NULL_TREE, ptr_type_node,
3804 tree_cons (NULL_TREE, long_unsigned_type_node,
3806 void_ftype_ptr_int_int_int_int
3807 = build_function_type (void_type_node,
3808 tree_cons (NULL_TREE, ptr_type_node,
3809 tree_cons (NULL_TREE, integer_type_node,
3810 tree_cons (NULL_TREE, integer_type_node,
3811 tree_cons (NULL_TREE, integer_type_node,
3812 tree_cons (NULL_TREE, integer_type_node,
3814 void_ftype_ptr_luns_long_long_bool_ptr_int
3815 = build_function_type (void_type_node,
3816 tree_cons (NULL_TREE, ptr_type_node,
3817 tree_cons (NULL_TREE, long_unsigned_type_node,
3818 tree_cons (NULL_TREE, long_integer_type_node,
3819 tree_cons (NULL_TREE, long_integer_type_node,
3820 tree_cons (NULL_TREE, boolean_type_node,
3821 tree_cons (NULL_TREE, ptr_type_node,
3822 tree_cons (NULL_TREE, integer_type_node,
3824 void_ftype_ptr_int_ptr_int_int_int
3825 = build_function_type (void_type_node,
3826 tree_cons (NULL_TREE, ptr_type_node,
3827 tree_cons (NULL_TREE, integer_type_node,
3828 tree_cons (NULL_TREE, ptr_type_node,
3829 tree_cons (NULL_TREE, integer_type_node,
3830 tree_cons (NULL_TREE, integer_type_node,
3831 tree_cons (NULL_TREE, integer_type_node,
3833 void_ftype_ptr_luns_ptr_luns_luns_luns
3834 = build_function_type (void_type_node,
3835 tree_cons (NULL_TREE, ptr_type_node,
3836 tree_cons (NULL_TREE, long_unsigned_type_node,
3837 tree_cons (NULL_TREE, ptr_type_node,
3838 tree_cons (NULL_TREE, long_unsigned_type_node,
3839 tree_cons (NULL_TREE, long_unsigned_type_node,
3840 tree_cons (NULL_TREE, long_unsigned_type_node,
3842 void_ftype_ptr_int_ptr_int_ptr_int
3843 = build_function_type (void_type_node,
3844 tree_cons (NULL_TREE, ptr_type_node,
3845 tree_cons (NULL_TREE, integer_type_node,
3846 tree_cons (NULL_TREE, ptr_type_node,
3847 tree_cons (NULL_TREE, integer_type_node,
3848 tree_cons (NULL_TREE, ptr_type_node,
3849 tree_cons (NULL_TREE, integer_type_node,
3851 void_ftype_long_int_ptr_int_ptr_int
3852 = build_function_type (void_type_node,
3853 tree_cons (NULL_TREE, long_integer_type_node,
3854 tree_cons (NULL_TREE, integer_type_node,
3855 tree_cons (NULL_TREE, ptr_type_node,
3856 tree_cons (NULL_TREE, integer_type_node,
3857 tree_cons (NULL_TREE, ptr_type_node,
3858 tree_cons (NULL_TREE, integer_type_node,
3861 = build_function_type (void_type_node,
3862 tree_cons (NULL_TREE, void_type_node,
3865 void_ftype_ptr_ptr_int
3866 = build_function_type (void_type_node,
3867 tree_cons (NULL_TREE, ptr_type_node,
3868 tree_cons (NULL_TREE, ptr_type_node,
3869 tree_cons (NULL_TREE, integer_type_node,
3872 void_ftype_ptr_luns_luns_cptr_luns_luns_luns
3873 = build_function_type (void_type_node,
3874 tree_cons (NULL_TREE, ptr_type_node,
3875 tree_cons (NULL_TREE, long_unsigned_type_node,
3876 tree_cons (NULL_TREE, long_unsigned_type_node,
3877 tree_cons (NULL_TREE, const_ptr_type_node,
3878 tree_cons (NULL_TREE, long_unsigned_type_node,
3879 tree_cons (NULL_TREE, long_unsigned_type_node,
3880 tree_cons (NULL_TREE, long_unsigned_type_node,
3883 ptr_ftype_luns_ptr_int
3884 = build_function_type (ptr_type_node,
3885 tree_cons (NULL_TREE, long_unsigned_type_node,
3886 tree_cons (NULL_TREE, ptr_type_node,
3887 tree_cons (NULL_TREE, integer_type_node,
3891 = build_function_type (double_type_node,
3892 tree_cons (NULL_TREE, double_type_node,
3895 /* These are compiler-internal function calls, not intended
3896 to be directly called by user code */
3897 builtin_function ("__allocate", ptr_ftype_luns_ptr_int,
3898 0, NOT_BUILT_IN, NULL_PTR);
3899 builtin_function ("_allocate_global_memory", void_ftype_refptr_int_ptr_int,
3900 0, NOT_BUILT_IN, NULL_PTR);
3901 builtin_function ("_allocate_memory", void_ftype_refptr_int_ptr_int,
3902 0, NOT_BUILT_IN, NULL_PTR);
3903 builtin_function ("__andpowerset", bool_ftype_ptr_ptr_ptr_luns,
3904 0, NOT_BUILT_IN, NULL_PTR);
3905 builtin_function ("__bitsetpowerset", void_ftype_ptr_int_int_int_int,
3906 0, NOT_BUILT_IN, NULL_PTR);
3907 builtin_function ("__cardpowerset", long_ftype_ptr_luns,
3908 0, NOT_BUILT_IN, NULL_PTR);
3909 builtin_function ("__cause_ex1", void_ftype_cptr_cptr_int,
3910 0, NOT_BUILT_IN, NULL_PTR);
3911 builtin_function ("__concatstring", ptr_ftype_ptr_ptr_int_ptr_int,
3912 0, NOT_BUILT_IN, NULL_PTR);
3913 builtin_function ("__continue", void_ftype_ptr_ptr_int,
3914 0, NOT_BUILT_IN, NULL_PTR);
3915 builtin_function ("__diffpowerset", void_ftype_ptr_ptr_ptr_luns,
3916 0, NOT_BUILT_IN, NULL_PTR);
3917 builtin_function ("__eqpowerset", bool_ftype_ptr_ptr_luns,
3918 0, NOT_BUILT_IN, NULL_PTR);
3919 builtin_function ("__ffsetclrpowerset", find_bit_ftype,
3920 0, NOT_BUILT_IN, NULL_PTR);
3921 builtin_function ("__flsetclrpowerset", find_bit_ftype,
3922 0, NOT_BUILT_IN, NULL_PTR);
3923 builtin_function ("__flsetpowerset", int_ftype_ptr_luns_long_ptr_int,
3924 0, NOT_BUILT_IN, NULL_PTR);
3925 builtin_function ("__ffsetpowerset", int_ftype_ptr_luns_long_ptr_int,
3926 0, NOT_BUILT_IN, NULL_PTR);
3927 builtin_function ("__inbitstring", bool_ftype_luns_ptr_luns_long_ptr_int,
3928 0, NOT_BUILT_IN, NULL_PTR);
3929 builtin_function ("__inpowerset", bool_ftype_luns_ptr_luns_long,
3930 0, NOT_BUILT_IN, NULL_PTR);
3931 builtin_function ("__lepowerset", bool_ftype_ptr_ptr_luns,
3932 0, NOT_BUILT_IN, NULL_PTR);
3933 builtin_function ("__ltpowerset", bool_ftype_ptr_ptr_luns,
3934 0, NOT_BUILT_IN, NULL_PTR);
3935 /* Currently under experimentation. */
3936 builtin_function ("memmove", memcpy_ftype,
3937 0, NOT_BUILT_IN, NULL_PTR);
3938 builtin_function ("memcmp", memcmp_ftype,
3939 0, NOT_BUILT_IN, NULL_PTR);
3941 /* this comes from c-decl.c (init_decl_processing) */
3942 builtin_function ("__builtin_alloca",
3943 build_function_type (ptr_type_node,
3944 tree_cons (NULL_TREE,
3947 BUILT_IN_ALLOCA, BUILT_IN_NORMAL, "alloca");
3949 builtin_function ("memset", ptr_ftype_ptr_int_int,
3950 0, NOT_BUILT_IN, NULL_PTR);
3951 builtin_function ("__notpowerset", bool_ftype_ptr_ptr_luns,
3952 0, NOT_BUILT_IN, NULL_PTR);
3953 builtin_function ("__orpowerset", bool_ftype_ptr_ptr_ptr_luns,
3954 0, NOT_BUILT_IN, NULL_PTR);
3955 builtin_function ("__psslice", void_ftype_ptr_int_ptr_int_int_int,
3956 0, NOT_BUILT_IN, NULL_PTR);
3957 builtin_function ("__pscpy", void_ftype_ptr_luns_luns_cptr_luns_luns_luns,
3958 0, NOT_BUILT_IN, NULL_PTR);
3959 builtin_function ("_return_memory", void_ftype_ptr_ptr_int,
3960 0, NOT_BUILT_IN, NULL_PTR);
3961 builtin_function ("__setbitpowerset", void_ftype_ptr_luns_long_long_bool_ptr_int,
3962 0, NOT_BUILT_IN, NULL_PTR);
3963 builtin_function ("__terminate", void_ftype_ptr_ptr_int,
3964 0, NOT_BUILT_IN, NULL_PTR);
3965 builtin_function ("__unhandled_ex", void_ftype_cptr_cptr_int,
3966 0, NOT_BUILT_IN, NULL_PTR);
3967 builtin_function ("__xorpowerset", bool_ftype_ptr_ptr_ptr_luns,
3968 0, NOT_BUILT_IN, NULL_PTR);
3970 /* declare floating point functions */
3971 builtin_function ("__sin", double_ftype_double, 0, NOT_BUILT_IN, "sin");
3972 builtin_function ("__cos", double_ftype_double, 0, NOT_BUILT_IN, "cos");
3973 builtin_function ("__tan", double_ftype_double, 0, NOT_BUILT_IN, "tan");
3974 builtin_function ("__asin", double_ftype_double, 0, NOT_BUILT_IN, "asin");
3975 builtin_function ("__acos", double_ftype_double, 0, NOT_BUILT_IN, "acos");
3976 builtin_function ("__atan", double_ftype_double, 0, NOT_BUILT_IN, "atan");
3977 builtin_function ("__exp", double_ftype_double, 0, NOT_BUILT_IN, "exp");
3978 builtin_function ("__log", double_ftype_double, 0, NOT_BUILT_IN, "log");
3979 builtin_function ("__log10", double_ftype_double, 0, NOT_BUILT_IN, "log10");
3980 builtin_function ("__sqrt", double_ftype_double, 0, NOT_BUILT_IN, "sqrt");
3986 /* These are predefined value builtin routine calls, built
3987 by the compiler, but over-ridable by user procedures of
3988 the same names. Note the lack of a leading underscore. */
3989 builtin_function ((ignore_case || ! special_UC) ? "abs" : "ABS",
3990 chill_predefined_function_type,
3991 BUILT_IN_CH_ABS, BUILT_IN_NORMAL, NULL_PTR);
3992 builtin_function ((ignore_case || ! special_UC) ? "abstime" : "ABSTIME",
3993 chill_predefined_function_type,
3994 BUILT_IN_ABSTIME, BUILT_IN_NORMAL, NULL_PTR);
3995 builtin_function ((ignore_case || ! special_UC) ? "allocate" : "ALLOCATE",
3996 chill_predefined_function_type,
3997 BUILT_IN_ALLOCATE, BUILT_IN_NORMAL, NULL_PTR);
3998 builtin_function ((ignore_case || ! special_UC) ? "allocate_memory" : "ALLOCATE_MEMORY",
3999 chill_predefined_function_type,
4000 BUILT_IN_ALLOCATE_MEMORY, BUILT_IN_NORMAL, NULL_PTR);
4001 builtin_function ((ignore_case || ! special_UC) ? "addr" : "ADDR",
4002 chill_predefined_function_type,
4003 BUILT_IN_ADDR, BUILT_IN_NORMAL, NULL_PTR);
4004 builtin_function ((ignore_case || ! special_UC) ? "allocate_global_memory" : "ALLOCATE_GLOBAL_MEMORY",
4005 chill_predefined_function_type,
4006 BUILT_IN_ALLOCATE_GLOBAL_MEMORY, BUILT_IN_NORMAL, NULL_PTR);
4007 builtin_function ((ignore_case || ! special_UC) ? "arccos" : "ARCCOS",
4008 chill_predefined_function_type,
4009 BUILT_IN_ARCCOS, BUILT_IN_NORMAL, NULL_PTR);
4010 builtin_function ((ignore_case || ! special_UC) ? "arcsin" : "ARCSIN",
4011 chill_predefined_function_type,
4012 BUILT_IN_ARCSIN, BUILT_IN_NORMAL, NULL_PTR);
4013 builtin_function ((ignore_case || ! special_UC) ? "arctan" : "ARCTAN",
4014 chill_predefined_function_type,
4015 BUILT_IN_ARCTAN, BUILT_IN_NORMAL, NULL_PTR);
4016 builtin_function ((ignore_case || ! special_UC) ? "card" : "CARD",
4017 chill_predefined_function_type,
4018 BUILT_IN_CARD, BUILT_IN_NORMAL, NULL_PTR);
4019 builtin_function ((ignore_case || ! special_UC) ? "cos" : "COS",
4020 chill_predefined_function_type,
4021 BUILT_IN_CH_COS, BUILT_IN_NORMAL, NULL_PTR);
4022 builtin_function ((ignore_case || ! special_UC) ? "days" : "DAYS",
4023 chill_predefined_function_type,
4024 BUILT_IN_DAYS, BUILT_IN_NORMAL, NULL_PTR);
4025 builtin_function ((ignore_case || ! special_UC) ? "descr" : "DESCR",
4026 chill_predefined_function_type,
4027 BUILT_IN_DESCR, BUILT_IN_NORMAL, NULL_PTR);
4028 builtin_function ((ignore_case || ! special_UC) ? "getstack" : "GETSTACK",
4029 chill_predefined_function_type,
4030 BUILT_IN_GETSTACK, BUILT_IN_NORMAL, NULL_PTR);
4031 builtin_function ((ignore_case || ! special_UC) ? "exp" : "EXP",
4032 chill_predefined_function_type,
4033 BUILT_IN_EXP, BUILT_IN_NORMAL, NULL_PTR);
4034 builtin_function ((ignore_case || ! special_UC) ? "hours" : "HOURS",
4035 chill_predefined_function_type,
4036 BUILT_IN_HOURS, BUILT_IN_NORMAL, NULL_PTR);
4037 builtin_function ((ignore_case || ! special_UC) ? "inttime" : "INTTIME",
4038 chill_predefined_function_type,
4039 BUILT_IN_INTTIME, BUILT_IN_NORMAL, NULL_PTR);
4040 builtin_function ((ignore_case || ! special_UC) ? "length" : "LENGTH",
4041 chill_predefined_function_type,
4042 BUILT_IN_LENGTH, BUILT_IN_NORMAL, NULL_PTR);
4043 builtin_function ((ignore_case || ! special_UC) ? "log" : "LOG",
4044 chill_predefined_function_type,
4045 BUILT_IN_LOG, BUILT_IN_NORMAL, NULL_PTR);
4046 builtin_function ((ignore_case || ! special_UC) ? "lower" : "LOWER",
4047 chill_predefined_function_type,
4048 BUILT_IN_LOWER, BUILT_IN_NORMAL, NULL_PTR);
4049 builtin_function ((ignore_case || ! special_UC) ? "ln" : "LN",
4050 chill_predefined_function_type,
4051 BUILT_IN_LN, BUILT_IN_NORMAL, NULL_PTR);
4052 /* Note: these are *not* the C integer MAX and MIN. They're
4053 for powerset arguments. */
4054 builtin_function ((ignore_case || ! special_UC) ? "max" : "MAX",
4055 chill_predefined_function_type,
4056 BUILT_IN_MAX, BUILT_IN_NORMAL, NULL_PTR);
4057 builtin_function ((ignore_case || ! special_UC) ? "millisecs" : "MILLISECS",
4058 chill_predefined_function_type,
4059 BUILT_IN_MILLISECS, BUILT_IN_NORMAL, NULL_PTR);
4060 builtin_function ((ignore_case || ! special_UC) ? "min" : "MIN",
4061 chill_predefined_function_type,
4062 BUILT_IN_MIN, BUILT_IN_NORMAL, NULL_PTR);
4063 builtin_function ((ignore_case || ! special_UC) ? "minutes" : "MINUTES",
4064 chill_predefined_function_type,
4065 BUILT_IN_MINUTES, BUILT_IN_NORMAL, NULL_PTR);
4066 builtin_function ((ignore_case || ! special_UC) ? "num" : "NUM",
4067 chill_predefined_function_type,
4068 BUILT_IN_NUM, BUILT_IN_NORMAL, NULL_PTR);
4069 builtin_function ((ignore_case || ! special_UC) ? "pred" : "PRED",
4070 chill_predefined_function_type,
4071 BUILT_IN_PRED, BUILT_IN_NORMAL, NULL_PTR);
4072 builtin_function ((ignore_case || ! special_UC) ? "return_memory" : "RETURN_MEMORY",
4073 chill_predefined_function_type,
4074 BUILT_IN_RETURN_MEMORY, BUILT_IN_NORMAL, NULL_PTR);
4075 builtin_function ((ignore_case || ! special_UC) ? "secs" : "SECS",
4076 chill_predefined_function_type,
4077 BUILT_IN_SECS, BUILT_IN_NORMAL, NULL_PTR);
4078 builtin_function ((ignore_case || ! special_UC) ? "sin" : "SIN",
4079 chill_predefined_function_type,
4080 BUILT_IN_CH_SIN, BUILT_IN_NORMAL, NULL_PTR);
4081 builtin_function ((ignore_case || ! special_UC) ? "size" : "SIZE",
4082 chill_predefined_function_type,
4083 BUILT_IN_SIZE, BUILT_IN_NORMAL, NULL_PTR);
4084 builtin_function ((ignore_case || ! special_UC) ? "sqrt" : "SQRT",
4085 chill_predefined_function_type,
4086 BUILT_IN_SQRT, BUILT_IN_NORMAL, NULL_PTR);
4087 builtin_function ((ignore_case || ! special_UC) ? "succ" : "SUCC",
4088 chill_predefined_function_type,
4089 BUILT_IN_SUCC, BUILT_IN_NORMAL, NULL_PTR);
4090 builtin_function ((ignore_case || ! special_UC) ? "tan" : "TAN",
4091 chill_predefined_function_type,
4092 BUILT_IN_TAN, BUILT_IN_NORMAL, NULL_PTR);
4093 builtin_function ((ignore_case || ! special_UC) ? "terminate" : "TERMINATE",
4094 chill_predefined_function_type,
4095 BUILT_IN_TERMINATE, BUILT_IN_NORMAL, NULL_PTR);
4096 builtin_function ((ignore_case || ! special_UC) ? "upper" : "UPPER",
4097 chill_predefined_function_type,
4098 BUILT_IN_UPPER, BUILT_IN_NORMAL, NULL_PTR);
4100 build_chill_descr_type ();
4101 build_chill_inttime_type ();
4103 endlink = tree_cons (NULL_TREE, void_type_node, NULL_TREE);
4105 start_identifier_warnings ();
4110 /* Return a definition for a builtin function named NAME and whose data type
4111 is TYPE. TYPE should be a function type with argument types.
4112 FUNCTION_CODE tells later passes how to compile calls to this function.
4113 See tree.h for its possible values.
4115 If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME,
4116 the name to be called if we can't opencode the function. */
4119 builtin_function (name, type, function_code, class, library_name)
4123 enum built_in_class class;
4124 const char *library_name;
4126 tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type);
4127 DECL_EXTERNAL (decl) = 1;
4128 TREE_PUBLIC (decl) = 1;
4129 /* If -traditional, permit redefining a builtin function any way you like.
4130 (Though really, if the program redefines these functions,
4131 it probably won't work right unless compiled with -fno-builtin.) */
4132 if (flag_traditional && name[0] != '_')
4133 DECL_BUILT_IN_NONANSI (decl) = 1;
4135 DECL_ASSEMBLER_NAME (decl) = get_identifier (library_name);
4136 make_decl_rtl (decl, NULL_PTR, 1);
4138 DECL_BUILT_IN_CLASS (decl) = class;
4139 DECL_FUNCTION_CODE (decl) = function_code;
4144 /* Print a warning if a constant expression had overflow in folding.
4145 Invoke this function on every expression that the language
4146 requires to be a constant expression. */
4149 constant_expression_warning (value)
4152 if ((TREE_CODE (value) == INTEGER_CST || TREE_CODE (value) == REAL_CST
4153 || TREE_CODE (value) == COMPLEX_CST)
4154 && TREE_CONSTANT_OVERFLOW (value) && pedantic)
4155 pedwarn ("overflow in constant expression");
4159 /* Finish processing of a declaration;
4160 If the length of an array type is not known before,
4161 it must be determined now, from the initial value, or it is an error. */
4167 int was_incomplete = (DECL_SIZE (decl) == 0);
4168 int temporary = allocation_temporary_p ();
4170 /* Pop back to the obstack that is current for this binding level.
4171 This is because MAXINDEX, rtl, etc. to be made below
4172 must go in the permanent obstack. But don't discard the
4173 temporary data yet. */
4175 #if 0 /* pop_obstacks was near the end; this is what was here. */
4176 if (current_scope == global_scope && temporary)
4177 end_temporary_allocation ();
4180 if (TREE_CODE (decl) == VAR_DECL)
4182 if (DECL_SIZE (decl) == 0
4183 && TYPE_SIZE (TREE_TYPE (decl)) != 0)
4184 layout_decl (decl, 0);
4186 if (DECL_SIZE (decl) == 0 && TREE_CODE (TREE_TYPE (decl)) != ERROR_MARK)
4188 error_with_decl (decl, "storage size of `%s' isn't known");
4189 TREE_TYPE (decl) = error_mark_node;
4192 if ((DECL_EXTERNAL (decl) || TREE_STATIC (decl))
4193 && DECL_SIZE (decl) != 0)
4195 if (TREE_CODE (DECL_SIZE (decl)) == INTEGER_CST)
4196 constant_expression_warning (DECL_SIZE (decl));
4200 /* Output the assembler code and/or RTL code for variables and functions,
4201 unless the type is an undefined structure or union.
4202 If not, it will get done when the type is completed. */
4204 if (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == FUNCTION_DECL)
4206 /* The last argument (at_end) is set to 1 as a kludge to force
4207 assemble_variable to be called. */
4208 if (TREE_CODE (TREE_TYPE (decl)) != ERROR_MARK)
4209 rest_of_decl_compilation (decl, (char*) 0, global_bindings_p (), 1);
4211 /* Compute the RTL of a decl if not yet set.
4212 (For normal user variables, satisfy_decl sets it.) */
4213 if (! TREE_STATIC (decl) && ! DECL_EXTERNAL (decl))
4217 /* If we used it already as memory, it must stay in memory. */
4218 TREE_ADDRESSABLE (decl) = TREE_USED (decl);
4219 /* If it's still incomplete now, no init will save it. */
4220 if (DECL_SIZE (decl) == 0)
4221 DECL_INITIAL (decl) = 0;
4227 if (TREE_CODE (decl) == TYPE_DECL)
4229 rest_of_decl_compilation (decl, NULL_PTR,
4230 global_bindings_p (), 0);
4233 /* ??? After 2.3, test (init != 0) instead of TREE_CODE. */
4234 if (!(TREE_CODE (decl) == FUNCTION_DECL && DECL_INLINE (decl))
4235 && temporary && TREE_PERMANENT (decl))
4237 /* We need to remember that this array HAD an initialization,
4238 but discard the actual temporary nodes,
4239 since we can't have a permanent node keep pointing to them. */
4240 /* We make an exception for inline functions, since it's
4241 normal for a local extern redeclaration of an inline function
4242 to have a copy of the top-level decl's DECL_INLINE. */
4243 if (DECL_INITIAL (decl) != 0)
4244 DECL_INITIAL (decl) = error_mark_node;
4248 /* Resume permanent allocation, if not within a function. */
4249 /* The corresponding push_obstacks_nochange is in start_decl,
4250 and in push_parm_decl and in grokfield. */
4254 /* If we have gone back from temporary to permanent allocation,
4255 actually free the temporary space that we no longer need. */
4256 if (temporary && !allocation_temporary_p ())
4257 permanent_allocation (0);
4259 /* At the end of a declaration, throw away any variable type sizes
4260 of types defined inside that declaration. There is no use
4261 computing them in the following function definition. */
4262 if (current_scope == global_scope)
4263 get_pending_sizes ();
4266 /* If DECL has a cleanup, build and return that cleanup here.
4267 This is a callback called by expand_expr. */
4270 maybe_build_cleanup (decl)
4271 tree decl ATTRIBUTE_UNUSED;
4273 /* There are no cleanups in C. */
4277 /* Make TYPE a complete type based on INITIAL_VALUE.
4278 Return 0 if successful, 1 if INITIAL_VALUE can't be deciphered,
4279 2 if there was no information (in which case assume 1 if DO_DEFAULT). */
4282 complete_array_type (type, initial_value, do_default)
4283 tree type ATTRIBUTE_UNUSED, initial_value ATTRIBUTE_UNUSED;
4284 int do_default ATTRIBUTE_UNUSED;
4286 /* Only needed so we can link with ../c-typeck.c. */
4290 /* Make sure that the tag NAME is defined *in the current binding level*
4291 at least as a forward reference.
4292 CODE says which kind of tag NAME ought to be.
4294 We also do a push_obstacks_nochange
4295 whose matching pop is in finish_struct. */
4298 start_struct (code, name)
4299 enum chill_tree_code code;
4300 tree name ATTRIBUTE_UNUSED;
4302 /* If there is already a tag defined at this binding level
4303 (as a forward reference), just return it. */
4305 register tree ref = 0;
4307 push_obstacks_nochange ();
4308 if (current_scope == global_scope)
4309 end_temporary_allocation ();
4311 /* Otherwise create a forward-reference just so the tag is in scope. */
4313 ref = make_node (code);
4314 /* pushtag (name, ref); */
4319 /* Function to help qsort sort FIELD_DECLs by name order. */
4322 field_decl_cmp (x, y)
4325 return (long)DECL_NAME (*x) - (long)DECL_NAME (*y);
4328 /* Fill in the fields of a RECORD_TYPE or UNION_TYPE node, T.
4329 FIELDLIST is a chain of FIELD_DECL nodes for the fields.
4331 We also do a pop_obstacks to match the push in start_struct. */
4334 finish_struct (t, fieldlist)
4335 register tree t, fieldlist;
4339 /* Install struct as DECL_CONTEXT of each field decl.
4340 Also process specified field sizes.
4341 Set DECL_FIELD_SIZE to the specified size, or 0 if none specified.
4342 The specified size is found in the DECL_INITIAL.
4343 Store 0 there, except for ": 0" fields (so we can find them
4344 and delete them, below). */
4346 for (x = fieldlist; x; x = TREE_CHAIN (x))
4348 DECL_CONTEXT (x) = t;
4349 DECL_FIELD_SIZE (x) = 0;
4352 TYPE_FIELDS (t) = fieldlist;
4355 t = layout_chill_struct_type (t);
4357 /* The matching push is in start_struct. */
4363 /* Lay out the type T, and its element type, and so on. */
4366 layout_array_type (t)
4369 if (TYPE_SIZE (t) != 0)
4371 if (TREE_CODE (TREE_TYPE (t)) == ARRAY_TYPE)
4372 layout_array_type (TREE_TYPE (t));
4376 /* Begin compiling the definition of an enumeration type.
4377 NAME is its name (or null if anonymous).
4378 Returns the type object, as yet incomplete.
4379 Also records info about it so that build_enumerator
4380 may be used to declare the individual values as they are read. */
4384 tree name ATTRIBUTE_UNUSED;
4386 register tree enumtype;
4388 /* If this is the real definition for a previous forward reference,
4389 fill in the contents in the same object that used to be the
4390 forward reference. */
4393 /* The corresponding pop_obstacks is in finish_enum. */
4394 push_obstacks_nochange ();
4395 /* If these symbols and types are global, make them permanent. */
4396 if (current_scope == global_scope)
4397 end_temporary_allocation ();
4400 enumtype = make_node (ENUMERAL_TYPE);
4401 /* pushtag (name, enumtype); */
4405 /* Determine the precision this type needs. */
4407 get_type_precision (minnode, maxnode)
4408 tree minnode, maxnode;
4410 unsigned precision = 0;
4412 if (TREE_INT_CST_HIGH (minnode) >= 0
4413 ? tree_int_cst_lt (TYPE_MAX_VALUE (unsigned_type_node), maxnode)
4414 : (tree_int_cst_lt (minnode, TYPE_MIN_VALUE (integer_type_node))
4415 || tree_int_cst_lt (TYPE_MAX_VALUE (integer_type_node), maxnode)))
4416 precision = TYPE_PRECISION (long_long_integer_type_node);
4419 HOST_WIDE_INT maxvalue = TREE_INT_CST_LOW (maxnode);
4420 HOST_WIDE_INT minvalue = TREE_INT_CST_LOW (minnode);
4423 precision = floor_log2 (maxvalue) + 1;
4426 /* Compute number of bits to represent magnitude of a negative value.
4427 Add one to MINVALUE since range of negative numbers
4428 includes the power of two. */
4429 unsigned negprecision = floor_log2 (-minvalue - 1) + 1;
4430 if (negprecision > precision)
4431 precision = negprecision;
4432 precision += 1; /* room for sign bit */
4442 layout_enum (enumtype)
4445 register tree pair, tem;
4446 tree minnode = 0, maxnode = 0;
4447 unsigned precision = 0;
4449 /* Do arithmetic using double integers, but don't use fold/build. */
4450 union tree_node enum_next_node;
4451 /* This is 1 plus the last enumerator constant value. */
4452 tree enum_next_value = &enum_next_node;
4454 /* Nonzero means that there was overflow computing enum_next_value. */
4455 int enum_overflow = 0;
4457 tree values = TYPE_VALUES (enumtype);
4459 if (TYPE_SIZE (enumtype) != NULL_TREE)
4462 /* Initialize enum_next_value to zero. */
4463 TREE_TYPE (enum_next_value) = integer_type_node;
4464 TREE_INT_CST_LOW (enum_next_value) = TREE_INT_CST_LOW (integer_zero_node);
4465 TREE_INT_CST_HIGH (enum_next_value) = TREE_INT_CST_HIGH (integer_zero_node);
4467 /* After processing and defining all the values of an enumeration type,
4468 install their decls in the enumeration type and finish it off.
4470 TYPE_VALUES currently contains a list of (purpose: NAME, value: DECL).
4471 This gets converted to a list of (purpose: NAME, value: VALUE). */
4474 /* For each enumerator, calculate values, if defaulted.
4475 Convert to correct type (the enumtype).
4476 Also, calculate the minimum and maximum values. */
4478 for (pair = values; pair; pair = TREE_CHAIN (pair))
4480 tree decl = TREE_VALUE (pair);
4481 tree value = DECL_INITIAL (decl);
4483 /* Remove no-op casts from the value. */
4484 if (value != NULL_TREE)
4485 STRIP_TYPE_NOPS (value);
4487 if (value != NULL_TREE)
4489 if (TREE_CODE (value) == INTEGER_CST)
4491 constant_expression_warning (value);
4492 if (tree_int_cst_lt (value, integer_zero_node))
4494 error ("enumerator value for `%s' is less then 0",
4495 IDENTIFIER_POINTER (DECL_NAME (decl)));
4496 value = error_mark_node;
4501 error ("enumerator value for `%s' not integer constant",
4502 IDENTIFIER_POINTER (DECL_NAME (decl)));
4503 value = error_mark_node;
4507 if (value != error_mark_node)
4509 if (value == NULL_TREE) /* Default based on previous value. */
4511 value = enum_next_value;
4513 error ("overflow in enumeration values");
4515 value = build_int_2 (TREE_INT_CST_LOW (value),
4516 TREE_INT_CST_HIGH (value));
4517 TREE_TYPE (value) = enumtype;
4518 DECL_INITIAL (decl) = value;
4519 CH_DERIVED_FLAG (value) = 1;
4522 minnode = maxnode = value;
4525 if (tree_int_cst_lt (maxnode, value))
4527 if (tree_int_cst_lt (value, minnode))
4531 /* Set basis for default for next value. */
4532 add_double (TREE_INT_CST_LOW (value), TREE_INT_CST_HIGH (value), 1, 0,
4533 &TREE_INT_CST_LOW (enum_next_value),
4534 &TREE_INT_CST_HIGH (enum_next_value));
4535 enum_overflow = tree_int_cst_lt (enum_next_value, value);
4538 DECL_INITIAL (decl) = value; /* error_mark_node */
4541 /* Fix all error_mark_nodes in enum. Increment maxnode and assign value.
4542 This is neccessary to make a duplicate value check in the enum */
4543 for (pair = values; pair; pair = TREE_CHAIN (pair))
4545 tree decl = TREE_VALUE (pair);
4546 if (DECL_INITIAL (decl) == error_mark_node)
4549 add_double (TREE_INT_CST_LOW (maxnode), TREE_INT_CST_HIGH (maxnode), 1, 0,
4550 &TREE_INT_CST_LOW (enum_next_value),
4551 &TREE_INT_CST_HIGH (enum_next_value));
4552 value = build_int_2 (TREE_INT_CST_LOW (enum_next_value),
4553 TREE_INT_CST_HIGH (enum_next_value));
4554 TREE_TYPE (value) = enumtype;
4555 CH_DERIVED_FLAG (value) = 1;
4556 DECL_INITIAL (decl) = value;
4562 /* Now check if we have duplicate values within the enum */
4563 for (pair = values; pair; pair = TREE_CHAIN (pair))
4566 tree decl1 = TREE_VALUE (pair);
4567 tree val1 = DECL_INITIAL (decl1);
4569 for (succ = TREE_CHAIN (pair); succ; succ = TREE_CHAIN (succ))
4573 tree decl2 = TREE_VALUE (succ);
4574 tree val2 = DECL_INITIAL (decl2);
4575 if (tree_int_cst_equal (val1, val2))
4576 error ("enumerators `%s' and `%s' have equal values",
4577 IDENTIFIER_POINTER (DECL_NAME (decl1)),
4578 IDENTIFIER_POINTER (DECL_NAME (decl2)));
4583 TYPE_MIN_VALUE (enumtype) = minnode;
4584 TYPE_MAX_VALUE (enumtype) = maxnode;
4586 precision = get_type_precision (minnode, maxnode);
4588 if (flag_short_enums || precision > TYPE_PRECISION (integer_type_node))
4589 /* Use the width of the narrowest normal C type which is wide enough. */
4590 TYPE_PRECISION (enumtype) = TYPE_PRECISION (type_for_size (precision, 1));
4592 TYPE_PRECISION (enumtype) = TYPE_PRECISION (integer_type_node);
4594 layout_type (enumtype);
4597 /* An enum can have some negative values; then it is signed. */
4598 TREE_UNSIGNED (enumtype) = ! tree_int_cst_lt (minnode, integer_zero_node);
4600 /* Z200/1988 page 19 says:
4601 For each pair of integer literal expression e1, e2 in the set list NUM (e1)
4602 and NUM (e2) must deliver different non-negative results */
4603 TREE_UNSIGNED (enumtype) = 1;
4606 for (pair = values; pair; pair = TREE_CHAIN (pair))
4608 tree decl = TREE_VALUE (pair);
4609 DECL_SIZE (decl) = TYPE_SIZE (enumtype);
4610 DECL_ALIGN (decl) = TYPE_ALIGN (enumtype);
4612 /* Set the TREE_VALUE to the name, rather than the decl,
4613 since that is what the rest of the compiler expects. */
4614 TREE_VALUE (pair) = DECL_INITIAL (decl);
4617 /* Fix up all variant types of this enum type. */
4618 for (tem = TYPE_MAIN_VARIANT (enumtype); tem; tem = TYPE_NEXT_VARIANT (tem))
4620 TYPE_VALUES (tem) = TYPE_VALUES (enumtype);
4621 TYPE_MIN_VALUE (tem) = TYPE_MIN_VALUE (enumtype);
4622 TYPE_MAX_VALUE (tem) = TYPE_MAX_VALUE (enumtype);
4623 TYPE_SIZE (tem) = TYPE_SIZE (enumtype);
4624 TYPE_MODE (tem) = TYPE_MODE (enumtype);
4625 TYPE_PRECISION (tem) = TYPE_PRECISION (enumtype);
4626 TYPE_ALIGN (tem) = TYPE_ALIGN (enumtype);
4627 TREE_UNSIGNED (tem) = TREE_UNSIGNED (enumtype);
4631 /* This matches a push in start_enum. */
4637 finish_enum (enumtype, values)
4638 register tree enumtype, values;
4640 TYPE_VALUES (enumtype) = values = nreverse (values);
4642 /* If satisfy_decl is called on one of the enum CONST_DECLs,
4643 this will make sure that the enumtype gets laid out then. */
4644 for ( ; values; values = TREE_CHAIN (values))
4645 TREE_TYPE (TREE_VALUE (values)) = enumtype;
4651 /* Build and install a CONST_DECL for one value of the
4652 current enumeration type (one that was begun with start_enum).
4653 Return a tree-list containing the CONST_DECL and its value.
4654 Assignment of sequential values by default is handled here. */
4657 build_enumerator (name, value)
4661 int named = name != NULL_TREE;
4666 (void) get_next_decl ();
4670 if (name == NULL_TREE)
4672 static int unnamed_value_warned = 0;
4673 static int next_dummy_enum_value = 0;
4675 if (!unnamed_value_warned)
4677 unnamed_value_warned = 1;
4678 warning ("undefined value in SET mode is obsolete and deprecated.");
4680 sprintf (buf, "__star_%d", next_dummy_enum_value++);
4681 name = get_identifier (buf);
4684 decl = build_decl (CONST_DECL, name, integer_type_node);
4685 CH_DECL_ENUM (decl) = 1;
4686 DECL_INITIAL (decl) = value;
4691 push_obstacks_nochange ();
4698 return build_tree_list (name, decl);
4701 tree old_value = lookup_name_current_level (name);
4703 if (old_value != NULL_TREE
4704 && TREE_CODE (old_value)=!= CONST_DECL
4705 && (value == NULL_TREE || operand_equal_p (value, old_value, 1)))
4707 if (value == NULL_TREE)
4709 if (TREE_CODE (old_value) == CONST_DECL)
4710 value = DECL_INITIAL (old_value);
4714 return saveable_tree_cons (old_value, value, NULL_TREE);
4719 /* Record that this function is going to be a varargs function.
4720 This is called before store_parm_decls, which is too early
4721 to call mark_varargs directly. */
4726 c_function_varargs = 1;
4729 /* Function needed for CHILL interface. */
4733 return current_function_parms;
4736 /* Save and restore the variables in this file and elsewhere
4737 that keep track of the progress of compilation of the current function.
4738 Used for nested functions. */
4742 struct c_function *next;
4743 struct scope *scope;
4744 tree chill_result_decl;
4745 int result_never_set;
4748 struct c_function *c_function_chain;
4750 /* Save and reinitialize the variables
4751 used during compilation of a C function. */
4754 push_chill_function_context ()
4756 struct c_function *p
4757 = (struct c_function *) xmalloc (sizeof (struct c_function));
4759 push_function_context ();
4761 p->next = c_function_chain;
4762 c_function_chain = p;
4764 p->scope = current_scope;
4765 p->chill_result_decl = chill_result_decl;
4766 p->result_never_set = result_never_set;
4769 /* Restore the variables used during compilation of a C function. */
4772 pop_chill_function_context ()
4774 struct c_function *p = c_function_chain;
4777 /* Bring back all the labels that were shadowed. */
4778 for (link = shadowed_labels; link; link = TREE_CHAIN (link))
4779 if (DECL_NAME (TREE_VALUE (link)) != 0)
4780 IDENTIFIER_LABEL_VALUE (DECL_NAME (TREE_VALUE (link)))
4781 = TREE_VALUE (link);
4784 pop_function_context ();
4786 c_function_chain = p->next;
4788 current_scope = p->scope;
4789 chill_result_decl = p->chill_result_decl;
4790 result_never_set = p->result_never_set;
4795 /* Following from Jukka Virtanen's GNU Pascal */
4796 /* To implement WITH statement:
4798 1) Call shadow_record_fields for each record_type element in the WITH
4799 element list. Each call creates a new binding level.
4801 2) construct a component_ref for EACH field in the record,
4802 and store it to the IDENTIFIER_LOCAL_VALUE after adding
4803 the old value to the shadow list
4805 3) let lookup_name do the rest
4807 4) pop all of the binding levels after the WITH statement ends.
4808 (restoring old local values) You have to keep track of the number
4809 of times you called it.
4813 * Save an arbitrary tree-expression as the IDENTIFIER_LOCAL_VALUE
4814 * of a name. Save the name's previous value. Check for name
4815 * collisions with another value under the same name at the same
4816 * nesting level. This is used to implement the DO WITH construct
4817 * and the temporary for the location iteration loop.
4820 save_expr_under_name (name, expr)
4823 tree alias = build_alias_decl (NULL_TREE, NULL_TREE, name);
4825 DECL_ABSTRACT_ORIGIN (alias) = expr;
4826 TREE_CHAIN (alias) = NULL_TREE;
4827 pushdecllist (alias, 0);
4831 do_based_decl (name, mode, base_var)
4832 tree name, mode, base_var;
4837 push_obstacks (&permanent_obstack, &permanent_obstack);
4838 decl = make_node (BASED_DECL);
4839 DECL_NAME (decl) = name;
4840 TREE_TYPE (decl) = mode;
4841 DECL_ABSTRACT_ORIGIN (decl) = base_var;
4848 decl = get_next_decl ();
4849 if (name != DECL_NAME (decl))
4851 /* FIXME: This isn't a complete test */
4852 base_decl = lookup_name (base_var);
4853 if (base_decl == NULL_TREE)
4854 error ("BASE variable never declared");
4855 else if (TREE_CODE (base_decl) == FUNCTION_DECL)
4856 error ("cannot BASE a variable on a PROC/PROCESS name");
4861 do_based_decls (names, mode, base_var)
4862 tree names, mode, base_var;
4864 if (names == NULL_TREE || TREE_CODE (names) == TREE_LIST)
4866 for (; names != NULL_TREE; names = TREE_CHAIN (names))
4867 do_based_decl (names, mode, base_var);
4869 else if (TREE_CODE (names) != ERROR_MARK)
4870 do_based_decl (names, mode, base_var);
4874 * Declare the fields so that lookup_name() will find them as
4875 * component refs for Pascal WITH or CHILL DO WITH.
4877 * Proceeds to the inner layers of Pascal/CHILL variant record
4879 * Internal routine of shadow_record_fields ()
4882 handle_one_level (parent, fields)
4883 tree parent, fields;
4887 switch (TREE_CODE (TREE_TYPE (parent)))
4891 for (field = fields; field; field = TREE_CHAIN (field)) {
4892 name = DECL_NAME (field);
4893 if (name == NULL_TREE || name == ELSE_VARIANT_NAME)
4894 /* proceed through variant part */
4895 handle_one_level (parent, TYPE_FIELDS (TREE_TYPE (field)));
4898 tree field_alias = make_node (WITH_DECL);
4899 DECL_NAME (field_alias) = name;
4900 TREE_TYPE (field_alias) = TREE_TYPE (field);
4901 DECL_ABSTRACT_ORIGIN (field_alias) = parent;
4902 TREE_CHAIN (field_alias) = NULL_TREE;
4903 pushdecllist (field_alias, 0);
4908 error ("INTERNAL ERROR: handle_one_level is broken");
4913 * For each FIELD_DECL node in a RECORD_TYPE, we have to declare
4914 * a name so that lookup_name will find a COMPONENT_REF node
4915 * when the name is referenced. This happens in Pascal WITH statement.
4918 shadow_record_fields (struct_val)
4921 if (pass == 1 || struct_val == NULL_TREE)
4924 handle_one_level (struct_val, TYPE_FIELDS (TREE_TYPE (struct_val)));
4927 static char exception_prefix [] = "__Ex_";
4930 build_chill_exception_decl (name)
4933 tree decl, ex_name, ex_init, ex_type;
4934 int name_len = strlen (name);
4935 char *ex_string = (char *)
4936 alloca (strlen (exception_prefix) + name_len + 1);
4938 sprintf(ex_string, "%s%s", exception_prefix, name);
4939 ex_name = get_identifier (ex_string);
4940 decl = IDENTIFIER_LOCAL_VALUE (ex_name);
4944 /* finish_decl is too eager about switching back to the
4945 ambient context. This decl's rtl must live in the permanent_obstack. */
4946 push_obstacks (&permanent_obstack, &permanent_obstack);
4947 push_obstacks_nochange ();
4948 ex_type = build_array_type (char_type_node,
4949 build_index_2_type (integer_zero_node,
4950 build_int_2 (name_len, 0)));
4951 decl = build_lang_decl (VAR_DECL, ex_name, ex_type);
4952 ex_init = build_string (name_len, name);
4953 TREE_TYPE (ex_init) = ex_type;
4954 DECL_INITIAL (decl) = ex_init;
4955 TREE_READONLY (decl) = 1;
4956 TREE_STATIC (decl) = 1;
4957 pushdecl_top_level (decl);
4959 pop_obstacks (); /* Return to the ambient context. */
4963 extern tree module_init_list;
4966 * This function is called from the parser to preface the entire
4967 * compilation. It contains module-level actions and reach-bound
4971 start_outer_function ()
4973 start_chill_function (pass < 2 ? get_identifier ("_GLOBAL_")
4974 : DECL_NAME (global_function_decl),
4975 void_type_node, NULL_TREE, NULL_TREE, NULL_TREE);
4976 global_function_decl = current_function_decl;
4977 global_scope = current_scope;
4978 chill_at_module_level = 1;
4981 /* This function finishes the global_function_decl, and if it is non-empty
4982 * (as indiacted by seen_action), adds it to module_init_list.
4985 finish_outer_function ()
4987 /* If there was module-level code in this module (not just function
4988 declarations), we allocate space for this module's init list entry,
4989 and fill in the module's function's address. */
4991 extern tree initializer_type;
4992 const char *fname_str = IDENTIFIER_POINTER (DECL_NAME (current_function_decl));
4993 char *init_entry_name = (char *)xmalloc ((unsigned)(strlen (fname_str) + 20));
4995 tree init_entry_decl;
4998 finish_chill_function ();
5000 chill_at_module_level = 0;
5006 sprintf (init_entry_name, "__tmp_%s_init_entry", fname_str);
5007 init_entry_id = get_identifier (init_entry_name);
5009 init_entry_decl = build1 (ADDR_EXPR,
5010 TREE_TYPE (TYPE_FIELDS (initializer_type)),
5011 global_function_decl);
5012 TREE_CONSTANT (init_entry_decl) = 1;
5013 initializer = build (CONSTRUCTOR, initializer_type, NULL_TREE,
5014 tree_cons (NULL_TREE, init_entry_decl,
5015 build_tree_list (NULL_TREE,
5016 null_pointer_node)));
5017 TREE_CONSTANT (initializer) = 1;
5019 = do_decl (init_entry_id, initializer_type, 1, 1, initializer, 0);
5020 DECL_SOURCE_LINE (init_entry_decl) = 0;
5022 /* tell chill_finish_compile that there's
5023 module-level code to be processed. */
5024 module_init_list = integer_one_node;
5025 else if (build_constructor)
5026 module_init_list = tree_cons (global_function_decl,
5030 make_decl_rtl (global_function_decl, NULL, 0);