1 /* Process declarations and variables for GNU CHILL compiler.
2 Copyright (C) 1992, 1993, 1994, 1998, 1999, 2000
3 Free Software Foundation, Inc.
5 This file is part of GNU CC.
7 GNU CC is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU CC is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU CC; see the file COPYING. If not, write to
19 the Free Software Foundation, 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
23 /* Process declarations and symbol lookup for CHILL front end.
24 Also constructs types; the standard scalar types at initialization,
25 and structure, union, array and enum types when they are declared. */
27 /* NOTES on Chill name resolution
29 Chill allows one to refer to an identifier that is declared later in
30 the same Group. Hence, a single pass over the code (as in C) is
33 This implementation uses two complete passes over the source code,
34 plus some extra passes over internal data structures.
36 Loosely, during pass 1, a 'scope' object is created for each Chill
37 reach. Each scope object contains a list of 'decl' objects,
38 one for each 'defining occurrence' in the reach. (This list
39 is in the 'remembered_decls' field of each scope.)
40 The scopes and their decls are replayed in pass 2: As each reach
41 is entered, the decls saved from pass 1 are made visible.
43 There are some exceptions. Declarations that cannot be referenced
44 before their declaration (i.e. whose defining occurrence precede
45 their reach), can be deferred to pass 2. These include formal
46 parameter declarations, and names defined in a DO action.
48 During pass 2, as each scope is entered, we must make visible all
49 the declarations defined in the scope, before we generate any code.
50 We must also simplify the declarations from pass 1: For example
51 a VAR_DECL may have a array type whose bounds are expressions;
52 these need to be folded. But of course the expressions may contain
53 identifiers that may be defined later in the scope - or even in
56 The "satisfy" process has two main phases:
58 1: Binding. Each identifier *referenced* in a declaration (i.e. in
59 a mode or the RHS of a synonum declaration) must be bound to its
60 defining occurrence. This may need to be linking via
61 grants and/or seizes (which are represented by ALIAS_DECLs).
62 A further complication is handling implied name strings.
64 2: Layout. Each CONST_DECL or TYPE_DECL *referenced* in a declaration
65 must than be replaced by its value (or type). Constants must be
66 folded. Types and declarstions must be laid out. DECL_RTL must be set.
67 While doing this, we must watch out for circular dependencies.
69 If a scope contains nested modulions, then the Binding phase must be
70 done for each nested module (recursively) before the Layout phase
71 can start for that scope. As an example of why this is needed, consider:
74 DCL a ARRAY [1:y] int; -- This should have 7 elements.
84 Here, the 'x' in "x + 5" must be Bound to the 'x' in module M2.
85 This must be done before we can Layout a.
86 The reason this is an issue is that we do *not* have a lookup
87 (or hash) table per scope (or module). Instead we have a single
88 global table we we keep adding and removing bindings from.
89 (This is both for speed, and because of gcc history.)
91 Note that a SEIZE generates a declaration in the current scope,
92 linked to something in the surrounding scope. Determining (binding)
93 the link must be done in pass 2. On the other hand, a GRANT
94 generates a declaration in the surrounding scope, linked to
95 something in the current scope. This linkage is Bound in pass 1.
97 The sequence for the above example is:
98 - Enter the declarations of M1 (i.e. {a, x, y}) into the hash table.
99 - For each of {a, x, y}, examine dependent expression (the
100 rhs of x, the bounds of a), and Bind any identifiers to
101 the current declarations (as found in the hash table). Specifically,
102 the 'y' in the array bounds of 'a' is bound to the 'y' declared by
103 the SEIZE declaration. Also, 'y' is Bound to the implicit
104 declaration in the global scope (generated from the GRANT in M2).
105 - Remove the bindings for M1 (i.e. {a, x, y}) from the hash table.
106 - Enter the declarations of M2 (i.e. {x, y}) into the hash table.
107 - For each of {x, y} examine the dependent expressions (the rhs of
108 x and y), and Bind any identifiers to their current declarartions
109 (in this case the 'x' in "x + 5" is bound to the 'x' that is 2.
110 - Remove the bindings for M2 (i.e. {x, y}) from the hash table.
111 - Perform Layout for M1: This requires the size of a, which
112 requires the value of y. The 'y' is Bound to the implicit
113 declaration in the global scope, which is Bound to the declaration
114 of y in M2. We now require the value of this 'y', which is "x + 5"
115 where x is bound to the x in M2 (thanks to our previous Binding
116 phase). So we get that the value of y is 7.
117 - Perform layout of M2. This implies calculating (constant folding)
118 the value of y - but we already did that, so we're done.
120 An example illustating the problem with implied names:
124 use(e); -- e is implied by y.
136 This implies that determining the implied name e in M1
137 must be done after Binding of y to x in M2.
142 DCL a ARRAY(v:v) int;
154 This one implies that determining the implied name e in M2,
155 must be done before Layout of a in M1.
157 These two examples togother indicate the determining implieed
158 names requries yet another phase.
159 - Bind strong names in M1.
160 - Bind strong names in M2.
161 - Bind strong names in M3.
162 - Determine weak names implied by SEIZEs in M1.
163 - Bind the weak names in M1.
164 - Determine weak names implied by SEIZEs in M2.
165 - Bind the weak names in M2.
166 - Determine weak names implied by SEIZEs in M3.
167 - Bind the weak names in M3.
172 We must bind the strong names in every module before we can determine
173 weak names in any module (because of seized/granted synmode/newmodes).
174 We must bind the weak names in every module before we can do Layout
181 /* ??? not all decl nodes are given the most useful possible
182 line numbers. For example, the CONST_DECLs for enum values. */
195 #define IS_UNKNOWN_TYPE(type) (TYPE_SIZE(type)==0)
196 #define BUILTIN_NESTING_LEVEL (-1)
198 /* For backward compatibility, we define Chill INT to be the same
199 as SHORT (i.e. 16 bits), at least if C INT is the same as LONG.
201 #define CHILL_INT_IS_SHORT (INT_TYPE_SIZE==LONG_TYPE_SIZE)
203 extern int ignore_case;
204 extern tree process_type;
205 extern struct obstack *saveable_obstack;
206 extern tree signal_code;
207 extern int special_UC;
209 static tree get_next_decl PARAMS ((void));
210 static tree lookup_name_for_seizing PARAMS ((tree));
212 static tree lookup_name_current_level PARAMS ((tree));
214 static void save_decl PARAMS ((tree));
216 extern struct obstack permanent_obstack;
217 extern int in_pseudo_module;
219 struct module *current_module = NULL;
220 struct module *first_module = NULL;
221 struct module **next_module = &first_module;
223 extern int in_pseudo_module;
225 int module_number = 0;
227 /* This is only used internally (by signed_type). */
229 tree signed_boolean_type_node;
231 tree global_function_decl = NULL_TREE;
233 /* This is a temportary used by RESULT to store its value.
234 Note we cannot directly use DECL_RESULT for two reasons:
235 a) If DECL_RESULT is a register, it may get clobbered by a
236 subsequent function call; and
237 b) if the function returns a struct, we might (visibly) modify the
238 destination before we're supposed to. */
239 tree chill_result_decl;
241 int result_never_set;
243 /* forward declarations */
244 static void pushdecllist PARAMS ((tree, int));
245 static int init_nonvalue_struct PARAMS ((tree));
246 static int init_nonvalue_array PARAMS ((tree));
247 static void set_nesting_level PARAMS ((tree, int));
248 static tree make_chill_variants PARAMS ((tree, tree, tree));
249 static tree fix_identifier PARAMS ((tree));
250 static void proclaim_decl PARAMS ((tree, int));
251 static tree maybe_acons PARAMS ((tree, tree));
252 static void push_scope_decls PARAMS ((int));
253 static void pop_scope_decls PARAMS ((tree, tree));
254 static tree build_implied_names PARAMS ((tree));
255 static void bind_sub_modules PARAMS ((int));
256 static void layout_array_type PARAMS ((tree));
257 static void do_based_decl PARAMS ((tree, tree, tree));
258 static void handle_one_level PARAMS ((tree, tree));
260 int current_nesting_level = BUILTIN_NESTING_LEVEL;
261 int current_module_nesting_level = 0;
263 /* Lots of declarations copied from c-decl.c. */
264 /* ??? not all decl nodes are given the most useful possible
265 line numbers. For example, the CONST_DECLs for enum values. */
268 /* In grokdeclarator, distinguish syntactic contexts of declarators. */
270 { NORMAL, /* Ordinary declaration */
271 FUNCDEF, /* Function definition */
272 PARM, /* Declaration of parm before function body */
273 FIELD, /* Declaration inside struct or union */
274 BITFIELD, /* Likewise but with specified width */
275 TYPENAME}; /* Typename (inside cast or sizeof) */
278 #ifndef CHAR_TYPE_SIZE
279 #define CHAR_TYPE_SIZE BITS_PER_UNIT
282 #ifndef SHORT_TYPE_SIZE
283 #define SHORT_TYPE_SIZE (BITS_PER_UNIT * MIN ((UNITS_PER_WORD + 1) / 2, 2))
286 #ifndef INT_TYPE_SIZE
287 #define INT_TYPE_SIZE BITS_PER_WORD
290 #ifndef LONG_TYPE_SIZE
291 #define LONG_TYPE_SIZE BITS_PER_WORD
294 #ifndef LONG_LONG_TYPE_SIZE
295 #define LONG_LONG_TYPE_SIZE (BITS_PER_WORD * 2)
298 #ifndef WCHAR_UNSIGNED
299 #define WCHAR_UNSIGNED 0
302 #ifndef FLOAT_TYPE_SIZE
303 #define FLOAT_TYPE_SIZE BITS_PER_WORD
306 #ifndef DOUBLE_TYPE_SIZE
307 #define DOUBLE_TYPE_SIZE (BITS_PER_WORD * 2)
310 #ifndef LONG_DOUBLE_TYPE_SIZE
311 #define LONG_DOUBLE_TYPE_SIZE (BITS_PER_WORD * 2)
314 /* We let tm.h override the types used here, to handle trivial differences
315 such as the choice of unsigned int or long unsigned int for size_t.
316 When machines start needing nontrivial differences in the size type,
317 it would be best to do something here to figure out automatically
318 from other information what type to use. */
321 #define PTRDIFF_TYPE "long int"
325 #define WCHAR_TYPE "int"
328 tree wchar_type_node;
329 tree signed_wchar_type_node;
330 tree unsigned_wchar_type_node;
334 /* type of initializer structure, which points to
335 a module's module-level code, and to the next
337 tree initializer_type;
339 /* type of a CHILL predefined value builtin routine */
340 tree chill_predefined_function_type;
342 /* type `int ()' -- used for implicit declaration of functions. */
344 tree default_function_type;
346 const char **boolean_code_name;
348 /* A node for the integer constant -1. */
349 tree integer_minus_one_node;
351 /* Nodes for boolean constants TRUE and FALSE. */
352 tree boolean_true_node, boolean_false_node;
354 tree string_one_type_node; /* The type of CHARS(1). */
355 tree bitstring_one_type_node; /* The type of BOOLS(1). */
356 tree bit_zero_node; /* B'0' */
357 tree bit_one_node; /* B'1' */
359 /* Nonzero if we have seen an invalid cross reference
360 to a struct, union, or enum, but not yet printed the message. */
362 tree pending_invalid_xref;
363 /* File and line to appear in the eventual error message. */
364 char *pending_invalid_xref_file;
365 int pending_invalid_xref_line;
367 /* After parsing the declarator that starts a function definition,
368 `start_function' puts here the list of parameter names or chain of decls.
369 `store_parm_decls' finds it here. */
371 static tree current_function_parms;
373 /* Nonzero when store_parm_decls is called indicates a varargs function.
374 Value not meaningful after store_parm_decls. */
376 static int c_function_varargs;
378 /* These are irrelevant for Chill, but are referenced from from c-typeck.c. */
380 int warn_traditional;
381 int warn_bad_function_cast;
383 /* Identifiers that hold VAR_LENGTH and VAR_DATA. */
384 tree var_length_id, var_data_id;
388 /* For each binding contour we allocate a scope structure
389 * which records the names defined in that contour.
392 * 1) one for each function definition,
393 * where internal declarations of the parameters appear.
394 * 2) one for each compound statement,
395 * to record its declarations.
397 * The current meaning of a name can be found by searching the levels from
398 * the current one out to the global one.
401 /* To communicate between pass 1 and 2, we maintain a list of "scopes".
402 Each scope corrresponds to a nested source scope/block that contain
403 that can contain declarations. The TREE_VALUE of the scope points
404 to the list of declarations declared in that scope.
405 The TREE_PURPOSE of the scope points to the surrounding scope.
406 (We may need to handle nested modules later. FIXME)
407 The TREE_CHAIN field contains a list of scope as they are seen
408 in chronological order. (Reverse order during first pass,
409 but it is reverse before pass 2.) */
413 /* The enclosing scope. */
414 struct scope *enclosing;
416 /* The next scope, in chronlogical order. */
419 /* A chain of DECLs constructed using save_decl during pass 1. */
420 tree remembered_decls;
422 /* A chain of _DECL nodes for all variables, constants, functions,
423 and typedef types belong to this scope. */
426 /* List of declarations that have been granted into this scope. */
429 /* List of implied (weak) names. */
432 /* For each level, a list of shadowed outer-level local definitions
433 to be restored when this level is popped.
434 Each link is a TREE_LIST whose TREE_PURPOSE is an identifier and
435 whose TREE_VALUE is its old definition (a kind of ..._DECL node). */
438 /* For each level (except not the global one),
439 a chain of BLOCK nodes for all the levels
440 that were entered and exited one level down. */
443 /* The BLOCK node for this level, if one has been preallocated.
444 If 0, the BLOCK is allocated (if needed) when the level is popped. */
447 /* The binding level which this one is contained in (inherits from). */
448 struct scope *level_chain;
450 /* Nonzero for a level that corresponds to a module. */
453 /* Zero means called from backend code. */
456 /* The modules that are directly enclosed by this scope
457 are chained together. */
458 struct scope* first_child_module;
459 struct scope** tail_child_module;
460 struct scope* next_sibling_module;
463 /* The outermost binding level, for pre-defined (builtin) names. */
465 static struct scope builtin_scope = {
466 NULL, NULL, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE,
467 NULL_TREE, NULL_TREE, NULL, 0, 0, NULL, NULL, NULL};
469 struct scope *global_scope;
471 /* The binding level currently in effect. */
473 static struct scope *current_scope = &builtin_scope;
475 /* The most recently seen scope. */
476 struct scope *last_scope = &builtin_scope;
478 /* Binding level structures are initialized by copying this one. */
480 static struct scope clear_scope = {
481 NULL, NULL, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE,
482 NULL_TREE, NULL_TREE, NULL, 0, 0, NULL, NULL, NULL};
484 /* Chain of decls accessible through IDENTIFIER_OUTER_VALUE.
485 Decls with the same DECL_NAME are adjacent in the chain. */
487 static tree outer_decls = NULL_TREE;
489 /* C-specific option variables. */
491 /* Nonzero means allow type mismatches in conditional expressions;
492 just make their values `void'. */
494 int flag_cond_mismatch;
496 /* Nonzero means give `double' the same size as `float'. */
498 int flag_short_double;
500 /* Nonzero means don't recognize the keyword `asm'. */
504 /* Nonzero means don't recognize any builtin functions. */
508 /* Nonzero means don't recognize the non-ANSI builtin functions.
511 int flag_no_nonansi_builtin;
513 /* Nonzero means do some things the same way PCC does. */
515 int flag_traditional;
517 /* Nonzero means to allow single precision math even if we're generally
518 being traditional. */
519 int flag_allow_single_precision = 0;
521 /* Nonzero means to treat bitfields as signed unless they say `unsigned'. */
523 int flag_signed_bitfields = 1;
524 int explicit_flag_signed_bitfields = 0;
526 /* Nonzero means warn about implicit declarations. */
530 /* Nonzero means give string constants the type `const char *'
531 to get extra warnings from them. These warnings will be too numerous
532 to be useful, except in thoroughly ANSIfied programs. */
534 int warn_write_strings;
536 /* Nonzero means warn about pointer casts that can drop a type qualifier
537 from the pointer target type. */
541 /* Nonzero means warn about sizeof(function) or addition/subtraction
542 of function pointers. */
544 int warn_pointer_arith;
546 /* Nonzero means warn for non-prototype function decls
547 or non-prototyped defs without previous prototype. */
549 int warn_strict_prototypes;
551 /* Nonzero means warn for any global function def
552 without separate previous prototype decl. */
554 int warn_missing_prototypes;
556 /* Nonzero means warn about multiple (redundant) decls for the same single
557 variable or function. */
559 int warn_redundant_decls = 0;
561 /* Nonzero means warn about extern declarations of objects not at
562 file-scope level and about *all* declarations of functions (whether
563 extern or static) not at file-scope level. Note that we exclude
564 implicit function declarations. To get warnings about those, use
567 int warn_nested_externs = 0;
569 /* Warn about a subscript that has type char. */
571 int warn_char_subscripts = 0;
573 /* Warn if a type conversion is done that might have confusing results. */
577 /* Warn if adding () is suggested. */
579 int warn_parentheses;
581 /* Warn if initializer is not completely bracketed. */
583 int warn_missing_braces;
585 /* Define the special tree codes that we use. */
587 /* Table indexed by tree code giving a string containing a character
588 classifying the tree code. Possibilities are
589 t, d, s, c, r, <, 1 and 2. See ch-tree.def for details. */
591 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
593 const char chill_tree_code_type[] = {
595 #include "ch-tree.def"
599 /* Table indexed by tree code giving number of expression
600 operands beyond the fixed part of the node structure.
601 Not used for types or decls. */
603 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
605 int chill_tree_code_length[] = {
607 #include "ch-tree.def"
612 /* Names of tree components.
613 Used for printing out the tree and error messages. */
614 #define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
616 const char *chill_tree_code_name[] = {
618 #include "ch-tree.def"
622 /* Nonzero means `$' can be in an identifier.
623 See cccp.c for reasons why this breaks some obscure ANSI C programs. */
625 #ifndef DOLLARS_IN_IDENTIFIERS
626 #define DOLLARS_IN_IDENTIFIERS 0
628 int dollars_in_ident = DOLLARS_IN_IDENTIFIERS > 1;
630 /* An identifier that is used internally to indicate
631 an "ALL" prefix for granting or seizing.
632 We use "*" rather than the external name "ALL", partly for convenience,
633 and partly to avoid case senstivity problems. */
638 allocate_lang_decl (t)
639 tree t ATTRIBUTE_UNUSED;
645 copy_lang_decl (node)
646 tree node ATTRIBUTE_UNUSED;
652 build_lang_decl (code, name, type)
653 enum chill_tree_code code;
657 return build_decl (code, name, type);
660 /* Decode the string P as a language-specific option for C.
661 Return the number of strings consumed for a valid option.
662 Return 0 for an invalid option. */
665 c_decode_option (argc, argv)
666 int argc ATTRIBUTE_UNUSED;
670 if (!strcmp (p, "-ftraditional") || !strcmp (p, "-traditional"))
672 flag_traditional = 1;
673 flag_writable_strings = 1;
674 #if DOLLARS_IN_IDENTIFIERS > 0
675 dollars_in_ident = 1;
678 else if (!strcmp (p, "-fnotraditional") || !strcmp (p, "-fno-traditional"))
680 flag_traditional = 0;
681 flag_writable_strings = 0;
682 dollars_in_ident = DOLLARS_IN_IDENTIFIERS > 1;
684 else if (!strcmp (p, "-fsigned-char"))
685 flag_signed_char = 1;
686 else if (!strcmp (p, "-funsigned-char"))
687 flag_signed_char = 0;
688 else if (!strcmp (p, "-fno-signed-char"))
689 flag_signed_char = 0;
690 else if (!strcmp (p, "-fno-unsigned-char"))
691 flag_signed_char = 1;
692 else if (!strcmp (p, "-fsigned-bitfields")
693 || !strcmp (p, "-fno-unsigned-bitfields"))
695 flag_signed_bitfields = 1;
696 explicit_flag_signed_bitfields = 1;
698 else if (!strcmp (p, "-funsigned-bitfields")
699 || !strcmp (p, "-fno-signed-bitfields"))
701 flag_signed_bitfields = 0;
702 explicit_flag_signed_bitfields = 1;
704 else if (!strcmp (p, "-fshort-enums"))
705 flag_short_enums = 1;
706 else if (!strcmp (p, "-fno-short-enums"))
707 flag_short_enums = 0;
708 else if (!strcmp (p, "-fcond-mismatch"))
709 flag_cond_mismatch = 1;
710 else if (!strcmp (p, "-fno-cond-mismatch"))
711 flag_cond_mismatch = 0;
712 else if (!strcmp (p, "-fshort-double"))
713 flag_short_double = 1;
714 else if (!strcmp (p, "-fno-short-double"))
715 flag_short_double = 0;
716 else if (!strcmp (p, "-fasm"))
718 else if (!strcmp (p, "-fno-asm"))
720 else if (!strcmp (p, "-fbuiltin"))
722 else if (!strcmp (p, "-fno-builtin"))
724 else if (!strcmp (p, "-ansi"))
725 flag_no_asm = 1, flag_no_nonansi_builtin = 1, dollars_in_ident = 0;
726 else if (!strcmp (p, "-Wimplicit"))
728 else if (!strcmp (p, "-Wno-implicit"))
730 else if (!strcmp (p, "-Wwrite-strings"))
731 warn_write_strings = 1;
732 else if (!strcmp (p, "-Wno-write-strings"))
733 warn_write_strings = 0;
734 else if (!strcmp (p, "-Wcast-qual"))
736 else if (!strcmp (p, "-Wno-cast-qual"))
738 else if (!strcmp (p, "-Wpointer-arith"))
739 warn_pointer_arith = 1;
740 else if (!strcmp (p, "-Wno-pointer-arith"))
741 warn_pointer_arith = 0;
742 else if (!strcmp (p, "-Wstrict-prototypes"))
743 warn_strict_prototypes = 1;
744 else if (!strcmp (p, "-Wno-strict-prototypes"))
745 warn_strict_prototypes = 0;
746 else if (!strcmp (p, "-Wmissing-prototypes"))
747 warn_missing_prototypes = 1;
748 else if (!strcmp (p, "-Wno-missing-prototypes"))
749 warn_missing_prototypes = 0;
750 else if (!strcmp (p, "-Wredundant-decls"))
751 warn_redundant_decls = 1;
752 else if (!strcmp (p, "-Wno-redundant-decls"))
753 warn_redundant_decls = 0;
754 else if (!strcmp (p, "-Wnested-externs"))
755 warn_nested_externs = 1;
756 else if (!strcmp (p, "-Wno-nested-externs"))
757 warn_nested_externs = 0;
758 else if (!strcmp (p, "-Wchar-subscripts"))
759 warn_char_subscripts = 1;
760 else if (!strcmp (p, "-Wno-char-subscripts"))
761 warn_char_subscripts = 0;
762 else if (!strcmp (p, "-Wconversion"))
764 else if (!strcmp (p, "-Wno-conversion"))
766 else if (!strcmp (p, "-Wparentheses"))
767 warn_parentheses = 1;
768 else if (!strcmp (p, "-Wno-parentheses"))
769 warn_parentheses = 0;
770 else if (!strcmp (p, "-Wreturn-type"))
771 warn_return_type = 1;
772 else if (!strcmp (p, "-Wno-return-type"))
773 warn_return_type = 0;
774 else if (!strcmp (p, "-Wcomment"))
775 ; /* cpp handles this one. */
776 else if (!strcmp (p, "-Wno-comment"))
777 ; /* cpp handles this one. */
778 else if (!strcmp (p, "-Wcomments"))
779 ; /* cpp handles this one. */
780 else if (!strcmp (p, "-Wno-comments"))
781 ; /* cpp handles this one. */
782 else if (!strcmp (p, "-Wtrigraphs"))
783 ; /* cpp handles this one. */
784 else if (!strcmp (p, "-Wno-trigraphs"))
785 ; /* cpp handles this one. */
786 else if (!strcmp (p, "-Wimport"))
787 ; /* cpp handles this one. */
788 else if (!strcmp (p, "-Wno-import"))
789 ; /* cpp handles this one. */
790 else if (!strcmp (p, "-Wmissing-braces"))
791 warn_missing_braces = 1;
792 else if (!strcmp (p, "-Wno-missing-braces"))
793 warn_missing_braces = 0;
794 else if (!strcmp (p, "-Wall"))
797 /* We save the value of warn_uninitialized, since if they put
798 -Wuninitialized on the command line, we need to generate a
799 warning about not using it without also specifying -O. */
800 if (warn_uninitialized != 1)
801 warn_uninitialized = 2;
803 warn_return_type = 1;
805 warn_char_subscripts = 1;
806 warn_parentheses = 1;
807 warn_missing_braces = 1;
815 /* Hooks for print_node. */
818 print_lang_decl (file, node, indent)
823 indent_to (file, indent + 3);
824 fputs ("nesting_level ", file);
825 fprintf (file, HOST_WIDE_INT_PRINT_DEC, DECL_NESTING_LEVEL (node));
827 if (DECL_WEAK_NAME (node))
828 fprintf (file, "weak_name ");
829 if (CH_DECL_SIGNAL (node))
830 fprintf (file, "decl_signal ");
831 print_node (file, "tasking_code",
832 (tree)DECL_TASKING_CODE_DECL (node), indent + 4);
837 print_lang_type (file, node, indent)
844 indent_to (file, indent + 3);
845 if (CH_IS_BUFFER_MODE (node))
846 fprintf (file, "buffer_mode ");
847 if (CH_IS_EVENT_MODE (node))
848 fprintf (file, "event_mode ");
850 if (CH_IS_EVENT_MODE (node) || CH_IS_BUFFER_MODE (node))
852 temp = max_queue_size (node);
854 print_node_brief (file, "qsize", temp, indent + 4);
859 print_lang_identifier (file, node, indent)
864 print_node (file, "local", IDENTIFIER_LOCAL_VALUE (node), indent + 4);
865 print_node (file, "outer", IDENTIFIER_OUTER_VALUE (node), indent + 4);
866 print_node (file, "implicit", IDENTIFIER_IMPLICIT_DECL (node), indent + 4);
867 print_node (file, "error locus", IDENTIFIER_ERROR_LOCUS (node), indent + 4);
868 print_node (file, "signal_dest", IDENTIFIER_SIGNAL_DEST (node), indent + 4);
869 indent_to (file, indent + 3);
870 if (IDENTIFIER_SIGNAL_DATA(node))
871 fprintf (file, "signal_data ");
874 /* initialise non-value struct */
877 init_nonvalue_struct (expr)
880 tree type = TREE_TYPE (expr);
884 if (CH_IS_BUFFER_MODE (type))
887 build_chill_modify_expr (
888 build_component_ref (expr, get_identifier ("__buffer_data")),
892 else if (CH_IS_EVENT_MODE (type))
895 build_chill_modify_expr (
896 build_component_ref (expr, get_identifier ("__event_data")),
900 else if (CH_IS_ASSOCIATION_MODE (type))
903 build_chill_modify_expr (expr,
904 chill_convert_for_assignment (type, association_init_value,
908 else if (CH_IS_ACCESS_MODE (type))
910 init_access_location (expr, type);
913 else if (CH_IS_TEXT_MODE (type))
915 init_text_location (expr, type);
919 for (field = TYPE_FIELDS (type); field != NULL_TREE; field = TREE_CHAIN (field))
921 type = TREE_TYPE (field);
922 if (CH_TYPE_NONVALUE_P (type))
924 tree exp = build_component_ref (expr, DECL_NAME (field));
925 if (TREE_CODE (type) == RECORD_TYPE)
926 res |= init_nonvalue_struct (exp);
927 else if (TREE_CODE (type) == ARRAY_TYPE)
928 res |= init_nonvalue_array (exp);
934 /* initialize non-value array */
935 /* do it with DO FOR unique-id IN expr; ... OD; */
937 init_nonvalue_array (expr)
940 tree tmpvar = get_unique_identifier ("NONVALINIT");
945 build_loop_iterator (tmpvar, expr, NULL_TREE, NULL_TREE, 0, 1, 0);
946 nonvalue_begin_loop_scope ();
947 build_loop_start (NULL_TREE);
948 tmpvar = lookup_name (tmpvar);
949 type = TREE_TYPE (tmpvar);
950 if (CH_TYPE_NONVALUE_P (type))
952 if (TREE_CODE (type) == RECORD_TYPE)
953 res |= init_nonvalue_struct (tmpvar);
954 else if (TREE_CODE (type) == ARRAY_TYPE)
955 res |= init_nonvalue_array (tmpvar);
958 nonvalue_end_loop_scope ();
963 /* This excessive piece of code sets DECL_NESTING_LEVEL (DECL) to LEVEL. */
966 set_nesting_level (decl, level)
970 static tree *small_ints = NULL;
971 static int max_small_ints = 0;
974 decl->decl.vindex = NULL_TREE;
977 if (level >= max_small_ints)
979 int new_max = level + 20;
980 if (small_ints == NULL)
981 small_ints = (tree*)xmalloc (new_max * sizeof(tree));
983 small_ints = (tree*)xrealloc (small_ints, new_max * sizeof(tree));
984 while (max_small_ints < new_max)
985 small_ints[max_small_ints++] = NULL_TREE;
987 if (small_ints[level] == NULL_TREE)
989 push_obstacks (&permanent_obstack, &permanent_obstack);
990 small_ints[level] = build_int_2 (level, 0);
993 /* set DECL_NESTING_LEVEL */
994 decl->decl.vindex = small_ints[level];
998 /* OPT_EXTERNAL is non-zero when the declaration is at module level.
999 * OPT_EXTERNAL == 2 means implicitly grant it.
1002 do_decls (names, type, opt_static, lifetime_bound, opt_init, opt_external)
1010 if (names == NULL_TREE || TREE_CODE (names) == TREE_LIST)
1012 for (; names != NULL_TREE; names = TREE_CHAIN (names))
1013 do_decl (TREE_VALUE (names), type, opt_static, lifetime_bound,
1014 opt_init, opt_external);
1016 else if (TREE_CODE (names) != ERROR_MARK)
1017 do_decl (names, type, opt_static, lifetime_bound, opt_init, opt_external);
1021 do_decl (name, type, is_static, lifetime_bound, opt_init, opt_external)
1030 if (current_function_decl == global_function_decl
1031 && ! lifetime_bound /*&& opt_init != NULL_TREE*/)
1036 push_obstacks (&permanent_obstack, &permanent_obstack);
1037 decl = make_node (VAR_DECL);
1038 DECL_NAME (decl) = name;
1039 TREE_TYPE (decl) = type;
1040 DECL_ASSEMBLER_NAME (decl) = name;
1042 /* Try to put things in common when possible.
1043 Tasking variables must go into common. */
1044 DECL_COMMON (decl) = 1;
1045 DECL_EXTERNAL (decl) = opt_external > 0;
1046 TREE_PUBLIC (decl) = opt_external > 0;
1047 TREE_STATIC (decl) = is_static;
1051 /* We have to set this here, since we build the decl w/o
1052 calling `build_decl'. */
1053 DECL_INITIAL (decl) = opt_init;
1062 DECL_INITIAL (decl) = opt_init;
1063 if (opt_external > 1 || in_pseudo_module)
1064 push_granted (DECL_NAME (decl), decl);
1066 else /* pass == 2 */
1068 tree temp = NULL_TREE;
1071 decl = get_next_decl ();
1073 if (name != DECL_NAME (decl))
1076 type = TREE_TYPE (decl);
1078 push_obstacks_nochange ();
1079 if (TYPE_READONLY_PROPERTY (type))
1081 if (CH_TYPE_NONVALUE_P (type))
1083 error_with_decl (decl, "`%s' must not be declared readonly");
1084 opt_init = NULL_TREE; /* prevent subsequent errors */
1086 else if (opt_init == NULL_TREE && !opt_external)
1087 error("declaration of readonly variable without initialization");
1089 TREE_READONLY (decl) = TYPE_READONLY (type);
1091 if (!opt_init && chill_varying_type_p (type))
1093 tree fixed_part_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type)));
1094 if (fixed_part_type != NULL_TREE && TREE_CODE (fixed_part_type) != ERROR_MARK)
1096 if (CH_CHARS_TYPE_P (fixed_part_type))
1097 opt_init = build_chill_string (0, "");
1099 opt_init = build_nt (CONSTRUCTOR, NULL_TREE, NULL_TREE);
1106 if (CH_TYPE_NONVALUE_P (type))
1108 error_with_decl (decl,
1109 "no initialisation allowed for `%s'");
1112 else if (TREE_CODE (type) == REFERENCE_TYPE)
1113 { /* A loc-identity declaration */
1114 if (! CH_LOCATION_P (opt_init))
1116 error_with_decl (decl,
1117 "value for loc-identity `%s' is not a location");
1120 else if (! CH_READ_COMPATIBLE (TREE_TYPE (type),
1121 TREE_TYPE (opt_init)))
1123 error_with_decl (decl,
1124 "location for `%s' not read-compatible");
1128 temp = convert (type, opt_init);
1131 { /* Normal location declaration */
1133 sprintf (place, "`%.60s' initializer",
1134 IDENTIFIER_POINTER (DECL_NAME (decl)));
1135 temp = chill_convert_for_assignment (type, opt_init, place);
1138 else if (CH_TYPE_NONVALUE_P (type))
1143 DECL_INITIAL (decl) = NULL_TREE;
1145 if (temp != NULL_TREE && TREE_CODE (temp) != ERROR_MARK)
1147 /* The same for stack variables (assuming no nested modules). */
1148 if (lifetime_bound || !is_static)
1150 if (is_static && ! TREE_CONSTANT (temp))
1151 error_with_decl (decl, "nonconstant initializer for `%s'");
1153 DECL_INITIAL (decl) = temp;
1157 /* Initialize the variable unless initialized statically. */
1158 if ((!is_static || ! lifetime_bound) &&
1159 temp != NULL_TREE && TREE_CODE (temp) != ERROR_MARK)
1161 int was_used = TREE_USED (decl);
1162 emit_line_note (input_filename, lineno);
1163 expand_expr_stmt (build_chill_modify_expr (decl, temp));
1164 /* Don't let the initialization count as "using" the variable. */
1165 TREE_USED (decl) = was_used;
1166 if (current_function_decl == global_function_decl)
1167 build_constructor = 1;
1169 else if (init_it && TREE_CODE (type) != ERROR_MARK)
1171 /* Initialize variables with non-value type */
1172 int was_used = TREE_USED (decl);
1173 int something_initialised = 0;
1175 emit_line_note (input_filename, lineno);
1176 if (TREE_CODE (type) == RECORD_TYPE)
1177 something_initialised = init_nonvalue_struct (decl);
1178 else if (TREE_CODE (type) == ARRAY_TYPE)
1179 something_initialised = init_nonvalue_array (decl);
1180 if (! something_initialised)
1182 error ("do_decl: internal error: don't know what to initialize");
1185 /* Don't let the initialization count as "using" the variable. */
1186 TREE_USED (decl) = was_used;
1187 if (current_function_decl == global_function_decl)
1188 build_constructor = 1;
1195 * ARGTYPES is a tree_list of formal argument types. TREE_VALUE
1196 * is the type tree for each argument, while the attribute is in
1200 build_chill_function_type (return_type, argtypes, exceptions, recurse_p)
1201 tree return_type, argtypes, exceptions, recurse_p;
1205 if (exceptions != NULL_TREE)
1207 /* if we have exceptions we add 2 arguments, callers filename
1208 and linenumber. These arguments will be added automatically
1209 when calling a function which may raise exceptions. */
1210 argtypes = chainon (argtypes,
1211 build_tree_list (NULL_TREE, ridpointers[(int) RID_PTR]));
1212 argtypes = chainon (argtypes,
1213 build_tree_list (NULL_TREE, ridpointers[(int) RID_LONG]));
1216 /* Indicate the argument list is complete. */
1217 argtypes = chainon (argtypes,
1218 build_tree_list (NULL_TREE, void_type_node));
1220 /* INOUT and OUT parameters must be a REFERENCE_TYPE since
1221 we'll be passing a temporary's address at call time. */
1222 for (arg = argtypes; arg; arg = TREE_CHAIN (arg))
1223 if (TREE_PURPOSE (arg) == ridpointers[(int) RID_LOC]
1224 || TREE_PURPOSE (arg) == ridpointers[(int) RID_OUT]
1225 || TREE_PURPOSE (arg) == ridpointers[(int) RID_INOUT]
1228 build_chill_reference_type (TREE_VALUE (arg));
1230 /* Cannot use build_function_type, because if does hash-canonlicalization. */
1231 ftype = make_node (FUNCTION_TYPE);
1232 TREE_TYPE (ftype) = return_type ? return_type : void_type_node ;
1233 TYPE_ARG_TYPES (ftype) = argtypes;
1236 ftype = build_exception_variant (ftype, exceptions);
1239 sorry ("RECURSIVE PROCs");
1245 * ARGTYPES is a tree_list of formal argument types.
1248 push_extern_function (name, typespec, argtypes, exceptions, granting)
1249 tree name, typespec, argtypes, exceptions;
1250 int granting ATTRIBUTE_UNUSED;/*If 0 do pushdecl(); if 1 do push_granted()*/
1254 push_obstacks_nochange ();
1255 end_temporary_allocation ();
1259 ftype = build_chill_function_type (typespec, argtypes,
1260 exceptions, NULL_TREE);
1262 fndecl = build_decl (FUNCTION_DECL, name, ftype);
1264 DECL_EXTERNAL(fndecl) = 1;
1265 TREE_STATIC (fndecl) = 1;
1266 TREE_PUBLIC (fndecl) = 1;
1270 finish_decl (fndecl);
1277 make_function_rtl (fndecl);
1281 fndecl = get_next_decl ();
1282 finish_decl (fndecl);
1287 push_granted (name, decl);
1297 push_extern_process (name, argtypes, exceptions, granting)
1298 tree name, argtypes, exceptions;
1301 tree decl, func, arglist;
1303 push_obstacks_nochange ();
1304 end_temporary_allocation ();
1308 tree proc_struct = make_process_struct (name, argtypes);
1309 arglist = (argtypes == NULL_TREE) ? NULL_TREE :
1310 tree_cons (NULL_TREE,
1311 build_chill_pointer_type (proc_struct), NULL_TREE);
1314 arglist = NULL_TREE;
1316 func = push_extern_function (name, NULL_TREE, arglist,
1317 exceptions, granting);
1319 /* declare the code variable */
1320 decl = generate_tasking_code_variable (name, &process_type, 1);
1321 CH_DECL_PROCESS (func) = 1;
1322 /* remember the code variable in the function decl */
1323 DECL_TASKING_CODE_DECL (func) = (struct lang_decl *)decl;
1325 add_taskstuff_to_list (decl, "_TT_Process", NULL_TREE, func, NULL_TREE);
1329 push_extern_signal (signame, sigmodelist, optsigdest)
1330 tree signame, sigmodelist, optsigdest;
1334 push_obstacks_nochange ();
1335 end_temporary_allocation ();
1338 build_signal_struct_type (signame, sigmodelist, optsigdest);
1340 /* declare the code variable outside the process */
1341 decl = generate_tasking_code_variable (signame, &signal_code, 1);
1342 add_taskstuff_to_list (decl, "_TT_Signal", NULL_TREE, sigtype, NULL_TREE);
1349 while (mode != NULL_TREE)
1351 switch (TREE_CODE (mode))
1355 mode = TREE_TYPE (mode);
1359 printf (" %s ", IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (mode))));
1364 tree itype = TYPE_DOMAIN (mode);
1365 if (CH_STRING_TYPE_P (mode))
1367 fputs (" STRING (", stdout);
1368 printf (HOST_WIDE_INT_PRINT_DEC,
1369 TREE_INT_CST_LOW (TYPE_MAX_VALUE (itype)));
1370 fputs (") OF ", stdout);
1374 fputs (" ARRAY (", stdout);
1375 printf (HOST_WIDE_INT_PRINT_DEC,
1376 TREE_INT_CST_LOW (TYPE_MIN_VALUE (itype)));
1377 fputs (":", stdout);
1378 printf (HOST_WIDE_INT_PRINT_DEC,
1379 TREE_INT_CST_LOW (TYPE_MAX_VALUE (itype)));
1380 fputs (") OF ", stdout);
1382 mode = TREE_TYPE (mode);
1387 tree fields = TYPE_FIELDS (mode);
1388 printf (" RECORD (");
1389 while (fields != NULL_TREE)
1391 printf (" %s:", IDENTIFIER_POINTER (DECL_NAME (fields)));
1392 print_mode (TREE_TYPE (fields));
1393 if (TREE_CHAIN (fields))
1395 fields = TREE_CHAIN (fields);
1408 chill_munge_params (nodes, type, attr)
1409 tree nodes, type, attr;
1414 /* Convert the list of identifiers to a list of types. */
1415 for (node = nodes; node != NULL_TREE; node = TREE_CHAIN (node))
1417 TREE_VALUE (node) = type; /* this was the identifier node */
1418 TREE_PURPOSE (node) = attr;
1424 /* Push the declarations described by SYN_DEFS into the current scope. */
1426 push_syndecl (name, mode, value)
1427 tree name, mode, value;
1431 tree decl = make_node (CONST_DECL);
1432 DECL_NAME (decl) = name;
1433 DECL_ASSEMBLER_NAME (decl) = name;
1434 TREE_TYPE (decl) = mode;
1435 DECL_INITIAL (decl) = value;
1436 TREE_READONLY (decl) = 1;
1438 if (in_pseudo_module)
1439 push_granted (DECL_NAME (decl), decl);
1441 else /* pass == 2 */
1447 /* Push the declarations described by (MODENAME,MODE) into the current scope.
1448 MAKE_NEWMODE is 1 for NEWMODE, 0 for SYNMODE, and
1449 -1 for internal use (in which case the mode does not need to be copied). */
1452 push_modedef (modename, mode, make_newmode)
1454 tree mode; /* ignored if pass==2. */
1457 tree newdecl, newmode;
1461 /* FIXME: need to check here for SYNMODE fred fred; */
1462 push_obstacks (&permanent_obstack, &permanent_obstack);
1464 newdecl = build_lang_decl (TYPE_DECL, modename, mode);
1466 if (make_newmode >= 0)
1468 newmode = make_node (LANG_TYPE);
1469 TREE_TYPE (newmode) = mode;
1470 TREE_TYPE (newdecl) = newmode;
1471 TYPE_NAME (newmode) = newdecl;
1472 if (make_newmode > 0)
1473 CH_NOVELTY (newmode) = newdecl;
1476 save_decl (newdecl);
1480 else /* pass == 2 */
1482 /* FIXME: need to check here for SYNMODE fred fred; */
1483 newdecl = get_next_decl ();
1484 if (DECL_NAME (newdecl) != modename)
1486 if (TREE_CODE (TREE_TYPE (newdecl)) != ERROR_MARK)
1488 /* ASSOCIATION, ACCESS, TEXT, BUFFER, and EVENT must not be READOnly */
1489 if (TREE_READONLY (TREE_TYPE (newdecl)) &&
1490 (CH_IS_ASSOCIATION_MODE (TREE_TYPE (newdecl)) ||
1491 CH_IS_ACCESS_MODE (TREE_TYPE (newdecl)) ||
1492 CH_IS_TEXT_MODE (TREE_TYPE (newdecl)) ||
1493 CH_IS_BUFFER_MODE (TREE_TYPE (newdecl)) ||
1494 CH_IS_EVENT_MODE (TREE_TYPE (newdecl))))
1495 error_with_decl (newdecl, "`%s' must not be READonly");
1496 rest_of_decl_compilation (newdecl, NULL_PTR,
1497 global_bindings_p (), 0);
1503 /* Return a chain of FIELD_DECLs for the names in NAMELIST. All of
1504 of type TYPE. When NAMELIST is passed in from the parser, it is
1506 LAYOUT is (NULL_TREE, integer_one_node, integer_zero_node, tree_list),
1507 meaning (default, pack, nopack, POS (...) ). */
1510 grok_chill_fixedfields (namelist, type, layout)
1511 tree namelist, type;
1514 tree decls = NULL_TREE;
1516 if (layout != NULL_TREE && TREE_CHAIN (namelist) != NULL_TREE)
1518 if (layout != integer_one_node && layout != integer_zero_node)
1521 error ("POS may not be specified for a list of field declarations");
1525 /* we build the chain of FIELD_DECLs backwards, effectively
1526 unreversing the reversed names in NAMELIST. */
1527 for (; namelist; namelist = TREE_CHAIN (namelist))
1529 tree decl = build_decl (FIELD_DECL,
1530 TREE_VALUE (namelist), type);
1531 DECL_INITIAL (decl) = layout;
1532 TREE_CHAIN (decl) = decls;
1545 static int label_value_cmp PARAMS ((struct tree_pair *,
1546 struct tree_pair *));
1548 /* Function to help qsort sort variant labels by value order. */
1550 label_value_cmp (x, y)
1551 struct tree_pair *x, *y;
1553 return TREE_INT_CST_LOW (x->value) - TREE_INT_CST_LOW (y->value);
1557 make_chill_variants (tagfields, body, variantelse)
1563 tree first = NULL_TREE;
1564 for (; body; body = TREE_CHAIN (body))
1566 tree decls = TREE_VALUE (body);
1567 tree labellist = TREE_PURPOSE (body);
1569 if (labellist != NULL_TREE
1570 && TREE_CODE (TREE_VALUE (labellist)) == TREE_LIST
1571 && TREE_VALUE (TREE_VALUE (labellist)) == case_else_node
1572 && TREE_CHAIN (labellist) == NULL_TREE)
1575 error ("(ELSE) case label as well as ELSE variant");
1576 variantelse = decls;
1580 tree rtype = start_struct (RECORD_TYPE, NULL_TREE);
1581 rtype = finish_struct (rtype, decls);
1583 first = chainon (first, build_decl (FIELD_DECL, NULL_TREE, rtype));
1585 TYPE_TAG_VALUES (rtype) = labellist;
1589 if (variantelse != NULL_TREE)
1591 tree rtype = start_struct (RECORD_TYPE, NULL_TREE);
1592 rtype = finish_struct (rtype, variantelse);
1593 first = chainon (first,
1594 build_decl (FIELD_DECL,
1595 ELSE_VARIANT_NAME, rtype));
1598 utype = start_struct (UNION_TYPE, NULL_TREE);
1599 utype = finish_struct (utype, first);
1600 TYPE_TAGFIELDS (utype) = tagfields;
1605 layout_chill_variants (utype)
1608 tree first = TYPE_FIELDS (utype);
1609 int nlabels, label_index = 0;
1610 struct tree_pair *label_value_array;
1612 extern int errorcount;
1614 if (TYPE_SIZE (utype))
1617 for (decl = first; decl; decl = TREE_CHAIN (decl))
1619 tree tagfields = TYPE_TAGFIELDS (utype);
1620 tree t = TREE_TYPE (decl);
1621 tree taglist = TYPE_TAG_VALUES (t);
1622 if (DECL_NAME (decl) == ELSE_VARIANT_NAME)
1624 if (tagfields == NULL_TREE)
1626 for ( ; tagfields != NULL_TREE && taglist != NULL_TREE;
1627 tagfields = TREE_CHAIN (tagfields), taglist = TREE_CHAIN (taglist))
1629 tree labellist = TREE_VALUE (taglist);
1630 for (; labellist; labellist = TREE_CHAIN (labellist))
1632 int compat_error = 0;
1633 tree label_value = TREE_VALUE (labellist);
1634 if (TREE_CODE (label_value) == RANGE_EXPR)
1636 if (TREE_OPERAND (label_value, 0) != NULL_TREE)
1638 if (!CH_COMPATIBLE (TREE_OPERAND (label_value, 0),
1639 TREE_TYPE (TREE_VALUE (tagfields)))
1640 || !CH_COMPATIBLE (TREE_OPERAND (label_value, 1),
1641 TREE_TYPE (TREE_VALUE (tagfields))))
1645 else if (TREE_CODE (label_value) == TYPE_DECL)
1647 if (!CH_COMPATIBLE (label_value,
1648 TREE_TYPE (TREE_VALUE (tagfields))))
1651 else if (TREE_CODE (label_value) == INTEGER_CST)
1653 if (!CH_COMPATIBLE (label_value,
1654 TREE_TYPE (TREE_VALUE (tagfields))))
1659 if (TYPE_FIELDS (t) == NULL_TREE)
1660 error ("inconsistent modes between labels and tag field");
1662 error_with_decl (TYPE_FIELDS (t),
1663 "inconsistent modes between labels and tag field");
1667 if (tagfields != NULL_TREE)
1668 error ("too few tag labels");
1669 if (taglist != NULL_TREE)
1670 error ("too many tag labels");
1673 /* Compute the number of labels to be checked for duplicates. */
1675 for (decl = first; decl; decl = TREE_CHAIN (decl))
1677 tree t = TREE_TYPE (decl);
1678 /* Only one tag (first case_label_list) supported, for now. */
1679 tree labellist = TYPE_TAG_VALUES (t);
1681 labellist = TREE_VALUE (labellist);
1683 for (; labellist != NULL_TREE; labellist = TREE_CHAIN (labellist))
1684 if (TREE_CODE (TREE_VALUE (labellist)) == INTEGER_CST)
1688 /* Check for duplicate label values. */
1689 label_value_array = (struct tree_pair *)alloca (nlabels * sizeof (struct tree_pair));
1690 for (decl = first; decl; decl = TREE_CHAIN (decl))
1692 tree t = TREE_TYPE (decl);
1693 /* Only one tag (first case_label_list) supported, for now. */
1694 tree labellist = TYPE_TAG_VALUES (t);
1696 labellist = TREE_VALUE (labellist);
1698 for (; labellist != NULL_TREE; labellist = TREE_CHAIN (labellist))
1702 tree x = TREE_VALUE (labellist);
1703 if (TREE_CODE (x) == RANGE_EXPR)
1705 if (TREE_OPERAND (x, 0) != NULL_TREE)
1707 if (TREE_CODE (TREE_OPERAND (x, 0)) != INTEGER_CST)
1708 error ("case label lower limit is not a discrete constant expression");
1709 if (TREE_CODE (TREE_OPERAND (x, 1)) != INTEGER_CST)
1710 error ("case label upper limit is not a discrete constant expression");
1714 else if (TREE_CODE (x) == TYPE_DECL)
1716 else if (TREE_CODE (x) == ERROR_MARK)
1718 else if (TREE_CODE (x) != INTEGER_CST) /* <-- FIXME: what about CONST_DECLs? */
1720 error ("case label must be a discrete constant expression");
1724 if (TREE_CODE (x) == CONST_DECL)
1725 x = DECL_INITIAL (x);
1726 if (TREE_CODE (x) != INTEGER_CST) abort ();
1729 if (p.decl == NULL_TREE)
1730 p.decl = TREE_VALUE (labellist);
1731 label_value_array[label_index++] = p;
1734 if (errorcount == 0)
1737 qsort (label_value_array,
1738 label_index, sizeof (struct tree_pair),
1739 (int (*) PARAMS ((const void *, const void *))) label_value_cmp);
1740 limit = label_index - 1;
1741 for (label_index = 0; label_index < limit; label_index++)
1743 if (tree_int_cst_equal (label_value_array[label_index].value,
1744 label_value_array[label_index+1].value))
1746 error_with_decl (label_value_array[label_index].decl,
1747 "variant label declared here...");
1748 error_with_decl (label_value_array[label_index+1].decl,
1749 "...is duplicated here");
1753 layout_type (utype);
1757 /* Convert a TREE_LIST of tag field names into a list of
1758 field decls, found from FIXED_FIELDS, re-using the input list. */
1761 lookup_tag_fields (tag_field_names, fixed_fields)
1762 tree tag_field_names;
1766 for (list = tag_field_names; list != NULL_TREE; list = TREE_CHAIN (list))
1768 tree decl = fixed_fields;
1769 for ( ; decl != NULL_TREE; decl = TREE_CHAIN (decl))
1771 if (DECL_NAME (decl) == TREE_VALUE (list))
1773 TREE_VALUE (list) = decl;
1777 if (decl == NULL_TREE)
1779 error ("no field (yet) for tag %s",
1780 IDENTIFIER_POINTER (TREE_VALUE (list)));
1781 TREE_VALUE (list) = error_mark_node;
1784 return tag_field_names;
1787 /* If non-NULL, TAGFIELDS is the tag fields for this variant record.
1788 BODY is a TREE_LIST of (optlabels, fixed fields).
1789 If non-null, VARIANTELSE is a fixed field for the else part of the
1793 grok_chill_variantdefs (tagfields, body, variantelse)
1794 tree tagfields, body, variantelse;
1798 t = make_chill_variants (tagfields, body, variantelse);
1800 t = layout_chill_variants (t);
1801 return build_decl (FIELD_DECL, NULL_TREE, t);
1805 In pass 1, PARMS is a list of types (with attributes).
1806 In pass 2, PARMS is a chain of PARM_DECLs.
1810 start_chill_function (label, rtype, parms, exceptlist, attrs)
1811 tree label, rtype, parms, exceptlist, attrs;
1813 tree decl, fndecl, type, result_type, func_type;
1814 int nested = current_function_decl != 0;
1818 = build_chill_function_type (rtype, parms, exceptlist, 0);
1819 fndecl = build_decl (FUNCTION_DECL, label, func_type);
1823 /* Make the init_value nonzero so pushdecl knows this is not tentative.
1824 error_mark_node is replaced below (in poplevel) with the BLOCK. */
1825 DECL_INITIAL (fndecl) = error_mark_node;
1827 DECL_EXTERNAL (fndecl) = 0;
1829 /* This function exists in static storage.
1830 (This does not mean `static' in the C sense!) */
1831 TREE_STATIC (fndecl) = 1;
1833 for (; attrs != NULL_TREE; attrs = TREE_CHAIN (attrs))
1835 if (TREE_VALUE (attrs) == ridpointers[RID_GENERAL])
1836 CH_DECL_GENERAL (fndecl) = 1;
1837 else if (TREE_VALUE (attrs) == ridpointers[RID_SIMPLE])
1838 CH_DECL_SIMPLE (fndecl) = 1;
1839 else if (TREE_VALUE (attrs) == ridpointers[RID_RECURSIVE])
1840 CH_DECL_RECURSIVE (fndecl) = 1;
1841 else if (TREE_VALUE (attrs) == ridpointers[RID_INLINE])
1842 DECL_INLINE (fndecl) = 1;
1847 else /* pass == 2 */
1849 fndecl = get_next_decl ();
1850 if (DECL_NAME (fndecl) != label)
1851 abort (); /* outta sync - got wrong decl */
1852 func_type = TREE_TYPE (fndecl);
1853 if (TYPE_RAISES_EXCEPTIONS (func_type) != NULL_TREE)
1855 /* In this case we have to add 2 parameters.
1856 See build_chill_function_type (pass == 1). */
1859 arg = make_node (PARM_DECL);
1860 DECL_ASSEMBLER_NAME (arg) = DECL_NAME (arg) = get_identifier (CALLER_FILE);
1861 DECL_IGNORED_P (arg) = 1;
1862 parms = chainon (parms, arg);
1864 arg = make_node (PARM_DECL);
1865 DECL_ASSEMBLER_NAME (arg) = DECL_NAME (arg) = get_identifier (CALLER_LINE);
1866 DECL_IGNORED_P (arg) = 1;
1867 parms = chainon (parms, arg);
1871 current_function_decl = fndecl;
1872 result_type = TREE_TYPE (func_type);
1873 if (CH_TYPE_NONVALUE_P (result_type))
1874 error ("non-value mode may only returned by LOC");
1876 pushlevel (1); /* Push parameters. */
1880 DECL_ARGUMENTS (fndecl) = parms;
1881 for (decl = DECL_ARGUMENTS (fndecl), type = TYPE_ARG_TYPES (func_type);
1883 decl = TREE_CHAIN (decl), type = TREE_CHAIN (type))
1885 /* check here that modes with the non-value property (like
1886 BUFFER's, EVENT's, ASSOCIATION's, ACCESS's, or TEXT's) only
1887 gets passed by LOC */
1888 tree argtype = TREE_VALUE (type);
1889 tree argattr = TREE_PURPOSE (type);
1891 if (TREE_CODE (argtype) == REFERENCE_TYPE)
1892 argtype = TREE_TYPE (argtype);
1894 if (TREE_CODE (argtype) != ERROR_MARK &&
1895 TREE_CODE_CLASS (TREE_CODE (argtype)) != 't')
1897 error_with_decl (decl, "mode of `%s' is not a mode");
1898 TREE_VALUE (type) = error_mark_node;
1901 if (CH_TYPE_NONVALUE_P (argtype) &&
1902 argattr != ridpointers[(int) RID_LOC])
1903 error_with_decl (decl, "`%s' may only be passed by LOC");
1904 TREE_TYPE (decl) = TREE_VALUE (type);
1905 DECL_ARG_TYPE (decl) = TREE_TYPE (decl);
1906 DECL_CONTEXT (decl) = fndecl;
1907 TREE_READONLY (decl) = TYPE_READONLY (argtype);
1908 layout_decl (decl, 0);
1911 pushdecllist (DECL_ARGUMENTS (fndecl), 0);
1913 DECL_RESULT (current_function_decl)
1914 = build_decl (RESULT_DECL, NULL_TREE, result_type);
1917 /* Write a record describing this function definition to the prototypes
1918 file (if requested). */
1919 gen_aux_info_record (fndecl, 1, 0, prototype);
1922 if (fndecl != global_function_decl || seen_action)
1924 /* Initialize the RTL code for the function. */
1925 init_function_start (fndecl, input_filename, lineno);
1927 /* Set up parameters and prepare for return, for the function. */
1928 expand_function_start (fndecl, 0);
1932 /* Allocate further tree nodes temporarily during compilation
1933 of this function only. */
1934 temporary_allocation ();
1936 /* If this fcn was already referenced via a block-scope `extern' decl (or
1937 an implicit decl), propagate certain information about the usage. */
1938 if (TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (current_function_decl)))
1939 TREE_ADDRESSABLE (current_function_decl) = 1;
1942 /* Z.200 requires that formal parameter names be defined in
1943 the same block as the procedure body.
1944 We could do this by keeping boths sets of DECLs in the same
1945 scope, but we would have to be careful to not merge the
1946 two chains (e.g. DECL_ARGUEMENTS musr not contains locals).
1947 Instead, we just make sure they have the same nesting_level. */
1948 current_nesting_level--;
1949 pushlevel (1); /* Push local variables. */
1951 if (pass == 2 && (fndecl != global_function_decl || seen_action))
1953 /* generate label for possible 'exit' */
1954 expand_start_bindings (1);
1956 result_never_set = 1;
1959 if (TREE_CODE (result_type) == VOID_TYPE)
1960 chill_result_decl = NULL_TREE;
1963 /* We use the same name as the keyword.
1964 This makes it easy to print and change the RESULT from gdb. */
1965 const char *result_str =
1966 (ignore_case || ! special_UC) ? "result" : "RESULT";
1967 if (pass == 2 && TREE_CODE (result_type) == ERROR_MARK)
1968 TREE_TYPE (current_scope->remembered_decls) = result_type;
1969 chill_result_decl = do_decl (get_identifier (result_str),
1970 result_type, 0, 0, 0, 0);
1971 DECL_CONTEXT (chill_result_decl) = fndecl;
1977 /* For checking purpose added pname as new argument
1978 MW Wed Oct 14 14:22:10 1992 */
1980 finish_chill_function ()
1982 register tree fndecl = current_function_decl;
1983 tree outer_function = decl_function_context (fndecl);
1985 if (outer_function == NULL_TREE && fndecl != global_function_decl)
1986 outer_function = global_function_decl;
1987 nested = current_function_decl != global_function_decl;
1988 if (pass == 2 && (fndecl != global_function_decl || seen_action))
1989 expand_end_bindings (getdecls (), 1, 0);
1991 /* pop out of function */
1993 current_nesting_level++;
1994 /* pop out of its parameters */
1999 /* TREE_READONLY (fndecl) = 1;
2000 This caused &foo to be of type ptr-to-const-function which
2001 then got a warning when stored in a ptr-to-function variable. */
2003 BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
2005 /* Must mark the RESULT_DECL as being in this function. */
2007 DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
2009 if (fndecl != global_function_decl || seen_action)
2011 /* Generate rtl for function exit. */
2012 expand_function_end (input_filename, lineno, 0);
2014 /* So we can tell if jump_optimize sets it to 1. */
2017 /* Run the optimizers and output assembler code for this function. */
2018 rest_of_compilation (fndecl);
2021 if (DECL_SAVED_INSNS (fndecl) == 0 && ! nested)
2023 /* Stop pointing to the local nodes about to be freed. */
2024 /* But DECL_INITIAL must remain nonzero so we know this
2025 was an actual function definition. */
2026 /* For a nested function, this is done in pop_chill_function_context. */
2027 DECL_INITIAL (fndecl) = error_mark_node;
2028 DECL_ARGUMENTS (fndecl) = 0;
2031 current_function_decl = outer_function;
2036 /* Points to the head of the _DECLs read from seize files. */
2038 static tree seized_decls;
2040 static tree processed_seize_files = 0;
2044 chill_seize (old_prefix, new_prefix, postfix)
2045 tree old_prefix, new_prefix, postfix;
2049 tree decl = build_alias_decl (old_prefix, new_prefix, postfix);
2050 DECL_SEIZEFILE(decl) = use_seizefile_name;
2053 else /* pass == 2 */
2055 /* Do nothing - get_next_decl automatically ignores ALIAS_DECLs */
2061 * output a debug dump of a scope structure
2067 if (sp == (struct scope *)NULL)
2069 fprintf (stderr, "null scope ptr\n");
2072 fprintf (stderr, "enclosing 0x%x ", sp->enclosing);
2073 fprintf (stderr, "next 0x%x ", sp->next);
2074 fprintf (stderr, "remembered_decls 0x%x ", sp->remembered_decls);
2075 fprintf (stderr, "decls 0x%x\n", sp->decls);
2076 fprintf (stderr, "shadowed 0x%x ", sp->shadowed);
2077 fprintf (stderr, "blocks 0x%x ", sp->blocks);
2078 fprintf (stderr, "this_block 0x%x ", sp->this_block);
2079 fprintf (stderr, "level_chain 0x%x\n", sp->level_chain);
2080 fprintf (stderr, "module_flag %c ", sp->module_flag ? 'T' : 'F');
2081 fprintf (stderr, "first_child_module 0x%x ", sp->first_child_module);
2082 fprintf (stderr, "next_sibling_module 0x%x\n", sp->next_sibling_module);
2083 if (sp->remembered_decls != NULL_TREE)
2086 fprintf (stderr, "remembered_decl chain:\n");
2087 for (temp = sp->remembered_decls; temp; temp = TREE_CHAIN (temp))
2097 if (current_function_decl != global_function_decl)
2098 DECL_CONTEXT (decl) = current_function_decl;
2100 TREE_CHAIN (decl) = current_scope->remembered_decls;
2101 current_scope->remembered_decls = decl;
2103 fprintf (stderr, "\n\nsave_decl 0x%x\n", decl);
2104 debug_scope (current_scope); /* ************* */
2106 set_nesting_level (decl, current_nesting_level);
2115 decl = current_scope->remembered_decls;
2116 current_scope->remembered_decls = TREE_CHAIN (decl);
2117 /* We ignore ALIAS_DECLs, because push_scope_decls
2118 can convert a single ALIAS_DECL representing 'SEIZE ALL'
2119 into one ALIAS_DECL for each seizeable name.
2120 This means we lose the nice one-to-one mapping
2121 between pass 1 decls and pass 2 decls.
2122 (Perhaps ALIAS_DECLs should not be on the remembered_decls list.) */
2123 } while (decl && TREE_CODE (decl) == ALIAS_DECL);
2127 /* At the end of pass 1, we reverse the chronological chain of scopes. */
2133 extern int errorcount, sorrycount;
2135 if (current_scope != &builtin_scope)
2137 last_scope = &builtin_scope;
2138 builtin_scope.remembered_decls = nreverse (builtin_scope.remembered_decls);
2139 write_grant_file ();
2142 if (errorcount || sorrycount)
2143 exit (FATAL_EXIT_CODE);
2146 if (grant_only_flag)
2147 exit (SUCCESS_EXIT_CODE);
2151 next_module = &first_module;
2155 * Called during pass 2, when we're processing actions, to
2156 * generate a temporary variable. These don't need satisfying
2157 * because they're compiler-generated and always declared
2158 * before they're used.
2161 decl_temp1 (name, type, opt_static, opt_init,
2162 opt_external, opt_public)
2166 int opt_external, opt_public;
2168 int orig_pass = pass; /* be cautious */
2172 mydecl = do_decl (name, type, opt_static, opt_static,
2173 opt_init, opt_external);
2176 TREE_PUBLIC (mydecl) = 1;
2178 do_decl (name, type, opt_static, opt_static, opt_init, opt_external);
2184 /* True if we're reading a seizefile, but we haven't seen a SPEC MODULE yet.
2185 For backwards compatibility, we treat declarations in such a context
2186 as implicity granted. */
2189 set_module_name (name)
2193 if (name == NULL_TREE)
2195 /* NOTE: build_prefix_clause assumes a generated
2196 module starts with a '_'. */
2198 sprintf (buf, "_MODULE_%d", module_number);
2199 name = get_identifier (buf);
2205 push_module (name, is_spec_module)
2209 struct module *new_module;
2212 new_module = (struct module*) permalloc (sizeof (struct module));
2213 new_module->prev_module = current_module;
2215 *next_module = new_module;
2219 new_module = *next_module;
2221 next_module = &new_module->next_module;
2223 new_module->procedure_seen = 0;
2224 new_module->is_spec_module = is_spec_module;
2225 new_module->name = name;
2227 new_module->prefix_name
2228 = get_identifier3 (IDENTIFIER_POINTER (current_module->prefix_name),
2229 "__", IDENTIFIER_POINTER (name));
2231 new_module->prefix_name = name;
2233 new_module->granted_decls = NULL_TREE;
2234 new_module->nesting_level = current_nesting_level + 1;
2236 current_module = new_module;
2237 current_module_nesting_level = new_module->nesting_level;
2238 in_pseudo_module = name ? 0 : 1;
2242 current_scope->module_flag = 1;
2244 *current_scope->enclosing->tail_child_module = current_scope;
2245 current_scope->enclosing->tail_child_module
2246 = ¤t_scope->next_sibling_module;
2248 /* Rename the global function to have the same name as
2249 the first named non-spec module. */
2251 && IDENTIFIER_POINTER (name)[0] != '_'
2252 && IDENTIFIER_POINTER (DECL_NAME (global_function_decl))[0] == '_')
2254 tree fname = get_identifier3 ("", IDENTIFIER_POINTER (name), "_");
2255 DECL_NAME (global_function_decl) = fname;
2256 DECL_ASSEMBLER_NAME (global_function_decl) = fname;
2259 return name; /* may have generated a name */
2261 /* Make a copy of the identifier NAME, replacing each '!' by '__'. */
2263 fix_identifier (name)
2266 char *buf = (char*)alloca (2 * IDENTIFIER_LENGTH (name) + 1);
2268 register char *dptr = buf;
2269 register const char *sptr = IDENTIFIER_POINTER (name);
2270 for (; *sptr; sptr++)
2282 return fixed ? get_identifier (buf) : name;
2286 find_granted_decls ()
2290 /* Match each granted name to a granted decl. */
2292 tree alias = current_module->granted_decls;
2293 tree next_alias, decl;
2294 /* This is an O(M*N) algorithm. FIXME! */
2295 for (; alias; alias = next_alias)
2298 next_alias = TREE_CHAIN (alias);
2299 for (decl = current_scope->remembered_decls;
2300 decl; decl = TREE_CHAIN (decl))
2302 tree new_name = (! DECL_NAME (decl)) ? NULL_TREE :
2303 decl_check_rename (alias,
2308 /* A Seized declaration is not grantable. */
2309 if (TREE_CODE (decl) == ALIAS_DECL && !CH_DECL_GRANTED (decl))
2312 if (global_bindings_p ())
2313 TREE_PUBLIC (decl) = 1;
2314 if (DECL_ASSEMBLER_NAME (decl) == NULL_TREE)
2315 DECL_ASSEMBLER_NAME (decl) = fix_identifier (new_name);
2316 if (DECL_POSTFIX_ALL (alias))
2319 = build_alias_decl (NULL_TREE, NULL_TREE, new_name);
2320 TREE_CHAIN (new_alias) = TREE_CHAIN (alias);
2321 TREE_CHAIN (alias) = new_alias;
2322 DECL_ABSTRACT_ORIGIN (new_alias) = decl;
2323 DECL_SOURCE_LINE (new_alias) = 0;
2324 DECL_SEIZEFILE (new_alias) = DECL_SEIZEFILE (alias);
2328 DECL_ABSTRACT_ORIGIN (alias) = decl;
2334 error_with_decl (alias, "Nothing named `%s' to grant.");
2335 DECL_ABSTRACT_ORIGIN (alias) = error_mark_node;
2345 struct scope *module_scope = current_scope;
2351 /* Write out the grant file. */
2352 if (!current_module->is_spec_module)
2354 /* After reversal, TREE_CHAIN (last_old_decl) is the oldest
2355 decl of the current module. */
2356 write_spec_module (module_scope->remembered_decls,
2357 current_module->granted_decls);
2360 /* Move the granted decls into the enclosing scope. */
2361 if (current_scope == global_scope)
2364 for (decl = current_module->granted_decls; decl; decl = next_decl)
2366 tree name = DECL_NAME (decl);
2367 next_decl = TREE_CHAIN (decl);
2368 if (name != NULL_TREE)
2370 tree old_decl = IDENTIFIER_OUTER_VALUE (name);
2371 set_nesting_level (decl, current_nesting_level);
2372 if (old_decl != NULL_TREE)
2374 pedwarn_with_decl (decl, "duplicate grant for `%s'");
2375 pedwarn_with_decl (old_decl, "previous grant for `%s'");
2376 TREE_CHAIN (decl) = TREE_CHAIN (old_decl);
2377 TREE_CHAIN (old_decl) = decl;
2381 TREE_CHAIN (decl) = outer_decls;
2383 IDENTIFIER_OUTER_VALUE (name) = decl;
2389 current_scope->granted_decls = chainon (current_module->granted_decls,
2390 current_scope->granted_decls);
2393 chill_check_no_handlers (); /* Sanity test */
2394 current_module = current_module->prev_module;
2395 current_module_nesting_level = current_module ?
2396 current_module->nesting_level : 0;
2397 in_pseudo_module = 0;
2400 /* Nonzero if we are currently in the global binding level. */
2403 global_bindings_p ()
2405 /* We return -1 here for the sake of variable_size() in ../stor-layout.c. */
2406 return (current_function_decl == NULL_TREE
2407 || current_function_decl == global_function_decl) ? -1 : 0;
2410 /* Nonzero if the current level needs to have a BLOCK made. */
2415 return current_scope->decls != 0;
2418 /* Make DECL visible.
2419 Save any existing definition.
2420 Check redefinitions at the same level.
2421 Suppress error messages if QUIET is true. */
2424 proclaim_decl (decl, quiet)
2428 tree name = DECL_NAME (decl);
2431 tree old_decl = IDENTIFIER_LOCAL_VALUE (name);
2432 if (old_decl == NULL) ; /* No duplication */
2433 else if (DECL_NESTING_LEVEL (old_decl) != current_nesting_level)
2435 /* Record for restoration when this binding level ends. */
2436 current_scope->shadowed
2437 = tree_cons (name, old_decl, current_scope->shadowed);
2439 else if (DECL_WEAK_NAME (decl))
2441 else if (!DECL_WEAK_NAME (old_decl))
2443 tree base_decl = decl, base_old_decl = old_decl;
2444 while (TREE_CODE (base_decl) == ALIAS_DECL)
2445 base_decl = DECL_ABSTRACT_ORIGIN (base_decl);
2446 while (TREE_CODE (base_old_decl) == ALIAS_DECL)
2447 base_old_decl = DECL_ABSTRACT_ORIGIN (base_old_decl);
2448 /* Note that duplicate definitions are allowed for set elements
2449 of similar set modes. See Z200 (1988) 12.2.2.
2450 However, if the types are identical, we are defining the
2451 same name multiple times in the same SET, which is naughty. */
2452 if (!quiet && base_decl != base_old_decl)
2454 if (TREE_CODE (base_decl) != CONST_DECL
2455 || TREE_CODE (base_old_decl) != CONST_DECL
2456 || !CH_DECL_ENUM (base_decl)
2457 || !CH_DECL_ENUM (base_old_decl)
2458 || TREE_TYPE (base_decl) == TREE_TYPE (base_old_decl)
2459 || !CH_SIMILAR (TREE_TYPE (base_decl),
2460 TREE_TYPE(base_old_decl)))
2462 error_with_decl (decl, "duplicate definition `%s'");
2463 error_with_decl (old_decl, "previous definition of `%s'");
2467 IDENTIFIER_LOCAL_VALUE (name) = decl;
2469 /* Should be redundant most of the time ... */
2470 set_nesting_level (decl, current_nesting_level);
2473 /* Return tree_cons (NULL_TREE, ELEMENT, LIST) unless ELEMENT
2474 is already in LIST, in which case return LIST. */
2477 maybe_acons (element, list)
2481 for (pair = list; pair; pair = TREE_CHAIN (pair))
2482 if (element == TREE_VALUE (pair))
2484 return tree_cons (NULL_TREE, element, list);
2493 static tree find_implied_types PARAMS ((tree, struct path *, tree));
2495 /* Look for implied types (enumeral types) implied by TYPE (a decl or type).
2497 Use old_path to guard against cycles. */
2500 find_implied_types (type, old_path, list)
2502 struct path *old_path;
2505 struct path path[1], *link;
2506 if (type == NULL_TREE)
2508 path[0].prev = old_path;
2509 path[0].node = type;
2511 /* Check for a cycle. Something more clever might be appropriate. FIXME? */
2512 for (link = old_path; link; link = link->prev)
2513 if (link->node == type)
2516 switch (TREE_CODE (type))
2519 return maybe_acons (type, list);
2522 case REFERENCE_TYPE:
2524 return find_implied_types (TREE_TYPE (type), path, list);
2526 return find_implied_types (TYPE_DOMAIN (type), path, list);
2532 list = find_implied_types (TREE_TYPE (type), path, list);
2533 for (t = TYPE_ARG_TYPES (type); t != NULL_TREE; t = TREE_CHAIN (t))
2534 list = find_implied_types (TREE_VALUE (t), path, list);
2538 list = find_implied_types (TYPE_DOMAIN (type), path, list);
2539 return find_implied_types (TREE_TYPE (type), path, list);
2543 for (fields = TYPE_FIELDS (type); fields != NULL_TREE;
2544 fields = TREE_CHAIN (fields))
2545 list = find_implied_types (TREE_TYPE (fields), path, list);
2549 case IDENTIFIER_NODE:
2550 return find_implied_types (lookup_name (type), path, list);
2553 return find_implied_types (DECL_ABSTRACT_ORIGIN (type), path, list);
2557 return find_implied_types (TREE_TYPE (type), path, list);
2563 /* Make declarations in current scope visible.
2564 Also, expand SEIZEs, and make correspondong ALIAS_DECLs visible. */
2567 push_scope_decls (quiet)
2568 int quiet; /* If 1, we're pre-scanning, so suppress errors. */
2572 /* First make everything except 'SEIZE ALL' names visible, before
2573 handling 'SEIZE ALL'. (This makes it easier to check 'seizable'). */
2574 for (decl = current_scope->remembered_decls; decl; decl = TREE_CHAIN (decl))
2576 if (TREE_CODE (decl) == ALIAS_DECL)
2578 if (DECL_POSTFIX_ALL (decl))
2580 if (DECL_ABSTRACT_ORIGIN (decl) == NULL_TREE)
2582 tree val = lookup_name_for_seizing (decl);
2583 if (val == NULL_TREE)
2585 error_with_file_and_line
2586 (DECL_SOURCE_FILE (decl), DECL_SOURCE_LINE (decl),
2587 "cannot SEIZE `%s'",
2588 IDENTIFIER_POINTER (DECL_OLD_NAME (decl)));
2589 val = error_mark_node;
2591 DECL_ABSTRACT_ORIGIN (decl) = val;
2594 proclaim_decl (decl, quiet);
2597 pushdecllist (current_scope->granted_decls, quiet);
2599 /* Now handle SEIZE ALLs. */
2600 for (decl = current_scope->remembered_decls; decl; )
2602 tree next_decl = TREE_CHAIN (decl);
2603 if (TREE_CODE (decl) == ALIAS_DECL
2604 && DECL_ABSTRACT_ORIGIN (decl) == NULL_TREE
2605 && DECL_POSTFIX_ALL (decl))
2607 /* We saw a "SEIZE ALL". Replace it be a SEIZE for each
2608 declaration visible in the surrounding scope.
2609 Note that this complicates get_next_decl(). */
2611 tree last_new_alias = decl;
2612 DECL_ABSTRACT_ORIGIN (decl) = error_mark_node;
2613 if (current_scope->enclosing == global_scope)
2614 candidate = outer_decls;
2616 candidate = current_scope->enclosing->decls;
2617 for ( ; candidate; candidate = TREE_CHAIN (candidate))
2619 tree seizename = DECL_NAME (candidate);
2624 new_name = decl_check_rename (decl, seizename);
2628 /* Check if candidate is seizable. */
2629 if (lookup_name (new_name) != NULL_TREE)
2632 new_alias = build_alias_decl (NULL_TREE,NULL_TREE, new_name);
2633 TREE_CHAIN (new_alias) = TREE_CHAIN (last_new_alias);
2634 TREE_CHAIN (last_new_alias) = new_alias;
2635 last_new_alias = new_alias;
2636 DECL_ABSTRACT_ORIGIN (new_alias) = candidate;
2637 DECL_SOURCE_LINE (new_alias) = 0;
2639 proclaim_decl (new_alias, quiet);
2645 /* Link current_scope->remembered_decls at the head of the
2646 current_scope->decls list (just like pushdecllist, but
2647 without calling proclaim_decl, since we've already done that). */
2648 if ((decl = current_scope->remembered_decls) != NULL_TREE)
2650 while (TREE_CHAIN (decl) != NULL_TREE)
2651 decl = TREE_CHAIN (decl);
2652 TREE_CHAIN (decl) = current_scope->decls;
2653 current_scope->decls = current_scope->remembered_decls;
2658 pop_scope_decls (decls_limit, shadowed_limit)
2659 tree decls_limit, shadowed_limit;
2661 /* Remove the temporary bindings we made. */
2662 tree link = current_scope->shadowed;
2663 tree decl = current_scope->decls;
2664 if (decl != decls_limit)
2666 while (decl != decls_limit)
2668 tree next = TREE_CHAIN (decl);
2669 if (DECL_NAME (decl))
2671 /* If the ident. was used or addressed via a local extern decl,
2672 don't forget that fact. */
2673 if (DECL_EXTERNAL (decl))
2675 if (TREE_USED (decl))
2676 TREE_USED (DECL_NAME (decl)) = 1;
2677 if (TREE_ADDRESSABLE (decl))
2678 TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (decl)) = 1;
2680 IDENTIFIER_LOCAL_VALUE (DECL_NAME (decl)) = 0;
2682 if (next == decls_limit)
2684 TREE_CHAIN (decl) = NULL_TREE;
2689 current_scope->decls = decls_limit;
2692 /* Restore all name-meanings of the outer levels
2693 that were shadowed by this level. */
2694 for ( ; link != shadowed_limit; link = TREE_CHAIN (link))
2695 IDENTIFIER_LOCAL_VALUE (TREE_PURPOSE (link)) = TREE_VALUE (link);
2696 current_scope->shadowed = shadowed_limit;
2699 /* Return list of weak names (as ALIAS_DECLs) implied by IMPLIED_TYPES. */
2702 build_implied_names (implied_types)
2705 tree aliases = NULL_TREE;
2707 for ( ; implied_types; implied_types = TREE_CHAIN (implied_types))
2709 tree enum_type = TREE_VALUE (implied_types);
2710 tree link = TYPE_VALUES (enum_type);
2711 if (TREE_CODE (enum_type) != ENUMERAL_TYPE)
2714 for ( ; link; link = TREE_CHAIN (link))
2716 /* We don't handle renaming/prefixes (Blue Book p 163) FIXME */
2717 /* Note that before enum_type is laid out, TREE_VALUE (link)
2718 is a CONST_DECL, while after it is laid out,
2719 TREE_VALUE (link) is an INTEGER_CST. Either works. */
2721 = build_alias_decl (NULL_TREE, NULL_TREE, TREE_PURPOSE (link));
2722 DECL_ABSTRACT_ORIGIN (alias) = TREE_VALUE (link);
2723 DECL_WEAK_NAME (alias) = 1;
2724 TREE_CHAIN (alias) = aliases;
2726 /* Strictlt speaking, we should have a pointer from the alias
2727 to the decl, so we can make sure that the alias is only
2728 visible when the decl is. FIXME */
2735 bind_sub_modules (do_weak)
2739 int save_module_nesting_level = current_module_nesting_level;
2740 struct scope *saved_scope = current_scope;
2741 struct scope *nested_module = current_scope->first_child_module;
2743 while (nested_module != NULL)
2745 tree saved_shadowed = nested_module->shadowed;
2746 tree saved_decls = nested_module->decls;
2747 current_nesting_level++;
2748 current_scope = nested_module;
2749 current_module_nesting_level = current_nesting_level;
2751 push_scope_decls (1);
2754 tree implied_types = NULL_TREE;
2755 /* Push weak names implied by decls in current_scope. */
2756 for (decl = current_scope->remembered_decls;
2757 decl; decl = TREE_CHAIN (decl))
2758 if (TREE_CODE (decl) == ALIAS_DECL)
2759 implied_types = find_implied_types (decl, NULL, implied_types);
2760 for (decl = current_scope->granted_decls;
2761 decl; decl = TREE_CHAIN (decl))
2762 implied_types = find_implied_types (decl, NULL, implied_types);
2763 current_scope->weak_decls = build_implied_names (implied_types);
2764 pushdecllist (current_scope->weak_decls, 1);
2767 bind_sub_modules (do_weak);
2768 for (decl = current_scope->remembered_decls;
2769 decl; decl = TREE_CHAIN (decl))
2770 satisfy_decl (decl, 1);
2771 pop_scope_decls (saved_decls, saved_shadowed);
2772 current_nesting_level--;
2773 nested_module = nested_module->next_sibling_module;
2776 current_scope = saved_scope;
2777 current_module_nesting_level = save_module_nesting_level;
2780 /* Enter a new binding level.
2781 If two_pass==0, assume we are called from non-Chill-specific parts
2782 of the compiler. These parts assume a single pass.
2783 If two_pass==1, we're called from Chill parts of the compiler.
2787 pushlevel (two_pass)
2790 register struct scope *newlevel;
2792 current_nesting_level++;
2795 newlevel = (struct scope *)xmalloc (sizeof(struct scope));
2796 *newlevel = clear_scope;
2797 newlevel->enclosing = current_scope;
2798 current_scope = newlevel;
2802 newlevel = (struct scope *)permalloc (sizeof(struct scope));
2803 *newlevel = clear_scope;
2804 newlevel->tail_child_module = &newlevel->first_child_module;
2805 newlevel->enclosing = current_scope;
2806 current_scope = newlevel;
2807 last_scope->next = newlevel;
2808 last_scope = newlevel;
2810 else /* pass == 2 */
2813 newlevel = current_scope = last_scope = last_scope->next;
2815 push_scope_decls (0);
2816 pushdecllist (current_scope->weak_decls, 0);
2818 /* If this is not a module scope, scan ahead for locally nested
2819 modules. (If this is a module, that's already done.) */
2820 if (!current_scope->module_flag)
2822 bind_sub_modules (0);
2823 bind_sub_modules (1);
2826 for (decl = current_scope->remembered_decls;
2827 decl; decl = TREE_CHAIN (decl))
2828 satisfy_decl (decl, 0);
2831 /* Add this level to the front of the chain (stack) of levels that
2834 newlevel->level_chain = current_scope;
2835 current_scope = newlevel;
2837 newlevel->two_pass = two_pass;
2840 /* Exit a binding level.
2841 Pop the level off, and restore the state of the identifier-decl mappings
2842 that were in effect when this level was entered.
2844 If KEEP is nonzero, this level had explicit declarations, so
2845 and create a "block" (a BLOCK node) for the level
2846 to record its declarations and subblocks for symbol table output.
2848 If FUNCTIONBODY is nonzero, this level is the body of a function,
2849 so create a block as if KEEP were set and also clear out all
2852 If REVERSE is nonzero, reverse the order of decls before putting
2853 them into the BLOCK. */
2856 poplevel (keep, reverse, functionbody)
2862 /* The chain of decls was accumulated in reverse order.
2863 Put it into forward order, just for cleanliness. */
2868 int block_previously_created = 0;
2870 if (current_scope == NULL)
2871 return error_mark_node;
2873 subblocks = current_scope->blocks;
2875 /* Get the decls in the order they were written.
2876 Usually current_scope->decls is in reverse order.
2877 But parameter decls were previously put in forward order. */
2880 current_scope->decls
2881 = decls = nreverse (current_scope->decls);
2883 decls = current_scope->decls;
2887 /* Output any nested inline functions within this block
2888 if they weren't already output. */
2890 for (decl = decls; decl; decl = TREE_CHAIN (decl))
2891 if (TREE_CODE (decl) == FUNCTION_DECL
2892 && ! TREE_ASM_WRITTEN (decl)
2893 && DECL_INITIAL (decl) != 0
2894 && TREE_ADDRESSABLE (decl))
2896 /* If this decl was copied from a file-scope decl
2897 on account of a block-scope extern decl,
2898 propagate TREE_ADDRESSABLE to the file-scope decl. */
2899 if (DECL_ABSTRACT_ORIGIN (decl) != 0)
2900 TREE_ADDRESSABLE (DECL_ABSTRACT_ORIGIN (decl)) = 1;
2903 push_function_context ();
2904 output_inline_function (decl);
2905 pop_function_context ();
2909 /* Clear out the meanings of the local variables of this level. */
2910 pop_scope_decls (NULL_TREE, NULL_TREE);
2912 /* If there were any declarations or structure tags in that level,
2913 or if this level is a function body,
2914 create a BLOCK to record them for the life of this function. */
2917 block_previously_created = (current_scope->this_block != 0);
2918 if (block_previously_created)
2919 block = current_scope->this_block;
2920 else if (keep || functionbody)
2921 block = make_node (BLOCK);
2925 BLOCK_VARS (block) = decls;
2927 /* Splice out ALIAS_DECL and LABEL_DECLs,
2928 since instantiate_decls can't handle them. */
2929 for (ptr = &BLOCK_VARS (block); *ptr; )
2932 if (TREE_CODE (decl) == ALIAS_DECL
2933 || TREE_CODE (decl) == LABEL_DECL)
2934 *ptr = TREE_CHAIN (decl);
2936 ptr = &TREE_CHAIN(*ptr);
2939 BLOCK_SUBBLOCKS (block) = subblocks;
2942 /* In each subblock, record that this is its superior. */
2944 for (link = subblocks; link; link = TREE_CHAIN (link))
2945 BLOCK_SUPERCONTEXT (link) = block;
2949 /* If the level being exited is the top level of a function,
2950 check over all the labels, and clear out the current
2951 (function local) meanings of their names. */
2953 if (pass == 2 && functionbody)
2955 /* If this is the top level block of a function,
2956 the vars are the function's parameters.
2957 Don't leave them in the BLOCK because they are
2958 found in the FUNCTION_DECL instead. */
2960 BLOCK_VARS (block) = 0;
2963 /* Clear out the definitions of all label names,
2964 since their scopes end here,
2965 and add them to BLOCK_VARS. */
2967 for (link = named_labels; link; link = TREE_CHAIN (link))
2969 register tree label = TREE_VALUE (link);
2971 if (DECL_INITIAL (label) == 0)
2973 error_with_decl (label, "label `%s' used but not defined");
2974 /* Avoid crashing later. */
2975 define_label (input_filename, lineno,
2978 else if (warn_unused && !TREE_USED (label))
2979 warning_with_decl (label, "label `%s' defined but not used");
2980 IDENTIFIER_LABEL_VALUE (DECL_NAME (label)) = 0;
2982 /* Put the labels into the "variables" of the
2983 top-level block, so debugger can see them. */
2984 TREE_CHAIN (label) = BLOCK_VARS (block);
2985 BLOCK_VARS (block) = label;
2992 current_scope->remembered_decls
2993 = nreverse (current_scope->remembered_decls);
2994 current_scope->granted_decls = nreverse (current_scope->granted_decls);
2997 current_scope = current_scope->enclosing;
2998 current_nesting_level--;
3005 /* Dispose of the block that we just made inside some higher level. */
3007 DECL_INITIAL (current_function_decl) = block;
3010 if (!block_previously_created)
3011 current_scope->blocks
3012 = chainon (current_scope->blocks, block);
3014 /* If we did not make a block for the level just exited,
3015 any blocks made for inner levels
3016 (since they cannot be recorded as subblocks in that level)
3017 must be carried forward so they will later become subblocks
3018 of something else. */
3020 current_scope->blocks
3021 = chainon (current_scope->blocks, subblocks);
3024 TREE_USED (block) = 1;
3028 /* Delete the node BLOCK from the current binding level.
3029 This is used for the block inside a stmt expr ({...})
3030 so that the block can be reinserted where appropriate. */
3033 delete_block (block)
3037 if (current_scope->blocks == block)
3038 current_scope->blocks = TREE_CHAIN (block);
3039 for (t = current_scope->blocks; t;)
3041 if (TREE_CHAIN (t) == block)
3042 TREE_CHAIN (t) = TREE_CHAIN (block);
3046 TREE_CHAIN (block) = NULL;
3047 /* Clear TREE_USED which is always set by poplevel.
3048 The flag is set again if insert_block is called. */
3049 TREE_USED (block) = 0;
3052 /* Insert BLOCK at the end of the list of subblocks of the
3053 current binding level. This is used when a BIND_EXPR is expanded,
3054 to handle the BLOCK node inside teh BIND_EXPR. */
3057 insert_block (block)
3060 TREE_USED (block) = 1;
3061 current_scope->blocks
3062 = chainon (current_scope->blocks, block);
3065 /* Set the BLOCK node for the innermost scope
3066 (the one we are currently in). */
3070 register tree block;
3072 current_scope->this_block = block;
3075 /* Record a decl-node X as belonging to the current lexical scope.
3076 Check for errors (such as an incompatible declaration for the same
3077 name already seen in the same scope).
3079 Returns either X or an old decl for the same name.
3080 If an old decl is returned, it may have been smashed
3081 to agree with what X says. */
3087 register tree name = DECL_NAME (x);
3088 register struct scope *b = current_scope;
3090 DECL_CONTEXT (x) = current_function_decl;
3091 /* A local extern declaration for a function doesn't constitute nesting.
3092 A local auto declaration does, since it's a forward decl
3093 for a nested function coming later. */
3094 if (TREE_CODE (x) == FUNCTION_DECL && DECL_INITIAL (x) == 0
3095 && DECL_EXTERNAL (x))
3096 DECL_CONTEXT (x) = 0;
3099 proclaim_decl (x, 0);
3101 if (TREE_CODE (x) == TYPE_DECL && DECL_SOURCE_LINE (x) == 0
3102 && TYPE_NAME (TREE_TYPE (x)) == 0)
3103 TYPE_NAME (TREE_TYPE (x)) = x;
3105 /* Put decls on list in reverse order.
3106 We will reverse them later if necessary. */
3107 TREE_CHAIN (x) = b->decls;
3113 /* Make DECLS (a chain of decls) visible in the current_scope. */
3116 pushdecllist (decls, quiet)
3120 tree last = NULL_TREE, decl;
3122 for (decl = decls; decl != NULL_TREE;
3123 last = decl, decl = TREE_CHAIN (decl))
3125 proclaim_decl (decl, quiet);
3130 TREE_CHAIN (last) = current_scope->decls;
3131 current_scope->decls = decls;
3135 /* Like pushdecl, only it places X in GLOBAL_SCOPE, if appropriate. */
3138 pushdecl_top_level (x)
3142 register struct scope *b = current_scope;
3144 current_scope = global_scope;
3150 /* Define a label, specifying the location in the source file.
3151 Return the LABEL_DECL node for the label, if the definition is valid.
3152 Otherwise return 0. */
3155 define_label (filename, line, name)
3164 decl = build_decl (LABEL_DECL, name, void_type_node);
3166 /* A label not explicitly declared must be local to where it's ref'd. */
3167 DECL_CONTEXT (decl) = current_function_decl;
3169 DECL_MODE (decl) = VOIDmode;
3171 /* Say where one reference is to the label,
3172 for the sake of the error if it is not defined. */
3173 DECL_SOURCE_LINE (decl) = line;
3174 DECL_SOURCE_FILE (decl) = filename;
3176 /* Mark label as having been defined. */
3177 DECL_INITIAL (decl) = error_mark_node;
3179 DECL_ACTION_NESTING_LEVEL (decl) = action_nesting_level;
3185 decl = get_next_decl ();
3186 /* Make sure every label has an rtx. */
3189 expand_label (decl);
3194 /* Return the list of declarations of the current level.
3195 Note that this list is in reverse order unless/until
3196 you nreverse it; and when you do nreverse it, you must
3197 store the result back using `storedecls' or you will lose. */
3202 /* This is a kludge, so that dbxout_init can get the predefined types,
3203 which are in the builtin_scope, though when it is called,
3204 the current_scope is the global_scope.. */
3205 if (current_scope == global_scope)
3206 return builtin_scope.decls;
3207 return current_scope->decls;
3211 /* Store the list of declarations of the current level.
3212 This is done for the parameter declarations of a function being defined,
3213 after they are modified in the light of any missing parameters. */
3219 current_scope->decls = decls;
3223 /* Look up NAME in the current binding level and its superiors
3224 in the namespace of variables, functions and typedefs.
3225 Return a ..._DECL node of some kind representing its definition,
3226 or return 0 if it is undefined. */
3232 register tree val = IDENTIFIER_LOCAL_VALUE (name);
3234 if (val == NULL_TREE)
3236 if (TREE_CODE_CLASS (TREE_CODE (val)) == 'c')
3238 if (DECL_NESTING_LEVEL (val) > BUILTIN_NESTING_LEVEL
3239 && DECL_NESTING_LEVEL (val) < current_module_nesting_level)
3243 while (TREE_CODE (val) == ALIAS_DECL)
3245 val = DECL_ABSTRACT_ORIGIN (val);
3246 if (TREE_CODE (val) == ERROR_MARK)
3249 if (TREE_CODE (val) == BASED_DECL)
3251 return build_chill_indirect_ref (DECL_ABSTRACT_ORIGIN (val),
3252 TREE_TYPE (val), 1);
3254 if (TREE_CODE (val) == WITH_DECL)
3255 return build_component_ref (DECL_ABSTRACT_ORIGIN (val), DECL_NAME (val));
3260 /* Similar to `lookup_name' but look only at current binding level. */
3263 lookup_name_current_level (name)
3266 register tree val = IDENTIFIER_LOCAL_VALUE (name);
3267 if (val && DECL_NESTING_LEVEL (val) == current_nesting_level)
3274 lookup_name_for_seizing (seize_decl)
3277 tree name = DECL_OLD_NAME (seize_decl);
3279 val = IDENTIFIER_LOCAL_VALUE (name);
3280 if (val == NULL_TREE || DECL_NESTING_LEVEL (val) == BUILTIN_NESTING_LEVEL)
3282 val = IDENTIFIER_OUTER_VALUE (name);
3283 if (val == NULL_TREE)
3285 if (TREE_CHAIN (val) && DECL_NAME (TREE_CHAIN (val)) == name)
3286 { /* More than one decl with the same name has been granted
3287 into the same global scope. Pick the one (we hope) that
3288 came from a seizefile the matches the most recent
3289 seizefile (as given by DECL_SEIZEFILE (seize_decl).) */
3290 tree d, best = NULL_TREE;
3291 for (d = val; d != NULL_TREE && DECL_NAME (d) == name;
3293 if (DECL_SEIZEFILE (d) == DECL_SEIZEFILE (seize_decl))
3297 error_with_decl (seize_decl,
3298 "ambiguous choice for seize `%s' -");
3299 error_with_decl (best, " - can seize this `%s' -");
3300 error_with_decl (d, " - or this granted decl `%s'");
3305 if (best == NULL_TREE)
3307 error_with_decl (seize_decl,
3308 "ambiguous choice for seize `%s' -");
3309 error_with_decl (val, " - can seize this `%s' -");
3310 error_with_decl (TREE_CHAIN (val),
3311 " - or this granted decl `%s'");
3318 /* We don't need to handle this, as long as we
3319 resolve the seize targets before pushing them. */
3320 if (DECL_NESTING_LEVEL (val) >= current_module_nesting_level)
3322 /* VAL was declared inside current module. We need something
3323 from the scope *enclosing* the current module, so search
3324 through the shadowed declarations. */
3328 if (current_module && current_module->prev_module
3329 && DECL_NESTING_LEVEL (val)
3330 < current_module->prev_module->nesting_level)
3333 /* It's declared in a scope enclosing the module enclosing
3334 the current module. Hence it's not visible. */
3337 while (TREE_CODE (val) == ALIAS_DECL)
3339 val = DECL_ABSTRACT_ORIGIN (val);
3340 if (TREE_CODE (val) == ERROR_MARK)
3346 /* Create the predefined scalar types of C,
3347 and some nodes representing standard constants (0, 1, (void *)0).
3348 Initialize the global binding level.
3349 Make definitions for built-in primitive functions. */
3352 init_decl_processing ()
3354 int wchar_type_size;
3355 tree bool_ftype_int_ptr_int;
3356 tree bool_ftype_int_ptr_int_int;
3357 tree bool_ftype_luns_ptr_luns_long;
3358 tree bool_ftype_luns_ptr_luns_long_ptr_int;
3359 tree bool_ftype_ptr_int_ptr_int;
3360 tree bool_ftype_ptr_int_ptr_int_int;
3361 tree find_bit_ftype;
3362 tree bool_ftype_ptr_ptr_int;
3363 tree bool_ftype_ptr_ptr_luns;
3364 tree bool_ftype_ptr_ptr_ptr_luns;
3367 tree int_ftype_int_int;
3368 tree int_ftype_int_ptr_int;
3370 tree int_ftype_ptr_int;
3371 tree int_ftype_ptr_int_int_ptr_int;
3372 tree int_ftype_ptr_luns_long_ptr_int;
3373 tree int_ftype_ptr_ptr_int;
3374 tree int_ftype_ptr_ptr_luns;
3375 tree long_ftype_ptr_luns;
3378 tree ptr_ftype_ptr_int_int;
3379 tree ptr_ftype_ptr_ptr_int;
3380 tree ptr_ftype_ptr_ptr_int_ptr_int;
3381 tree real_ftype_real;
3383 tree void_ftype_cptr_cptr_int;
3384 tree void_ftype_long_int_ptr_int_ptr_int;
3385 tree void_ftype_ptr;
3386 tree void_ftype_ptr_int_int_int_int;
3387 tree void_ftype_ptr_int_ptr_int_int_int;
3388 tree void_ftype_ptr_int_ptr_int_ptr_int;
3389 tree void_ftype_ptr_luns_long_long_bool_ptr_int;
3390 tree void_ftype_ptr_luns_ptr_luns_luns_luns;
3391 tree void_ftype_ptr_ptr_ptr_int;
3392 tree void_ftype_ptr_ptr_ptr_luns;
3393 tree void_ftype_refptr_int_ptr_int;
3394 tree void_ftype_void;
3395 tree void_ftype_ptr_ptr_int;
3396 tree void_ftype_ptr_luns_luns_cptr_luns_luns_luns;
3397 tree ptr_ftype_luns_ptr_int;
3398 tree double_ftype_double;
3400 /* allow 0-255 enums to occupy only a byte */
3401 flag_short_enums = 1;
3403 current_function_decl = NULL;
3405 set_alignment = BITS_PER_UNIT;
3407 ALL_POSTFIX = get_identifier ("*");
3408 string_index_type_dummy = get_identifier("%string-index%");
3410 var_length_id = get_identifier (VAR_LENGTH);
3411 var_data_id = get_identifier (VAR_DATA);
3413 build_common_tree_nodes (1);
3415 if (CHILL_INT_IS_SHORT)
3416 long_integer_type_node = integer_type_node;
3418 long_integer_type_node = make_signed_type (LONG_TYPE_SIZE);
3420 /* `unsigned long' is the standard type for sizeof.
3421 Note that stddef.h uses `unsigned long',
3422 and this must agree, even of long and int are the same size. */
3424 set_sizetype (long_unsigned_type_node);
3427 const char *size_type_c_name = SIZE_TYPE;
3428 if (strncmp (size_type_c_name, "long long ", 10) == 0)
3429 set_sizetype (long_long_unsigned_type_node);
3430 else if (strncmp (size_type_c_name, "long ", 5) == 0)
3431 set_sizetype (long_unsigned_type_node);
3433 set_sizetype (unsigned_type_node);
3437 pushdecl (build_decl (TYPE_DECL, ridpointers[(int) RID_FLOAT],
3439 pushdecl (build_decl (TYPE_DECL, ridpointers[(int) RID_DOUBLE],
3442 integer_minus_one_node = build_int_2 (-1, -1);
3443 TREE_TYPE (integer_minus_one_node) = integer_type_node;
3445 build_common_tree_nodes_2 (flag_short_double);
3447 pushdecl (build_decl (TYPE_DECL,
3448 ridpointers[(int) RID_VOID], void_type_node));
3449 /* We are not going to have real types in C with less than byte alignment,
3450 so we might as well not have any types that claim to have it. */
3451 TYPE_ALIGN (void_type_node) = BITS_PER_UNIT;
3453 /* This is for wide string constants. */
3454 wchar_type_node = short_unsigned_type_node;
3455 wchar_type_size = TYPE_PRECISION (wchar_type_node);
3456 signed_wchar_type_node = type_for_size (wchar_type_size, 0);
3457 unsigned_wchar_type_node = type_for_size (wchar_type_size, 1);
3459 default_function_type
3460 = build_function_type (integer_type_node, NULL_TREE);
3462 ptr_type_node = build_pointer_type (void_type_node);
3464 = build_pointer_type (build_type_variant (void_type_node, 1, 0));
3466 void_list_node = build_tree_list (NULL_TREE, void_type_node);
3468 boolean_type_node = make_node (BOOLEAN_TYPE);
3469 TYPE_PRECISION (boolean_type_node) = 1;
3470 fixup_unsigned_type (boolean_type_node);
3471 boolean_false_node = TYPE_MIN_VALUE (boolean_type_node);
3472 boolean_true_node = TYPE_MAX_VALUE (boolean_type_node);
3473 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_BOOL],
3474 boolean_type_node));
3476 /* TRUE and FALSE have the BOOL derived class */
3477 CH_DERIVED_FLAG (boolean_true_node) = 1;
3478 CH_DERIVED_FLAG (boolean_false_node) = 1;
3480 signed_boolean_type_node = make_node (BOOLEAN_TYPE);
3481 temp = build_int_2 (-1, -1);
3482 TREE_TYPE (temp) = signed_boolean_type_node;
3483 TYPE_MIN_VALUE (signed_boolean_type_node) = temp;
3484 temp = build_int_2 (0, 0);
3485 TREE_TYPE (temp) = signed_boolean_type_node;
3486 TYPE_MAX_VALUE (signed_boolean_type_node) = temp;
3487 layout_type (signed_boolean_type_node);
3490 bitstring_one_type_node = build_bitstring_type (integer_one_node);
3491 bit_zero_node = build (CONSTRUCTOR, bitstring_one_type_node, NULL_TREE,
3493 bit_one_node = build (CONSTRUCTOR, bitstring_one_type_node, NULL_TREE,
3494 build_tree_list (NULL_TREE, integer_zero_node));
3496 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_CHAR],
3499 if (CHILL_INT_IS_SHORT)
3501 chill_integer_type_node = short_integer_type_node;
3502 chill_unsigned_type_node = short_unsigned_type_node;
3506 chill_integer_type_node = integer_type_node;
3507 chill_unsigned_type_node = unsigned_type_node;
3510 string_one_type_node = build_string_type (char_type_node, integer_one_node);
3512 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_BYTE],
3513 signed_char_type_node));
3514 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_UBYTE],
3515 unsigned_char_type_node));
3517 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_INT],
3518 chill_integer_type_node));
3520 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_UINT],
3521 chill_unsigned_type_node));
3523 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_LONG],
3524 long_integer_type_node));
3526 set_sizetype (long_integer_type_node);
3529 = TREE_TYPE (IDENTIFIER_LOCAL_VALUE (get_identifier (PTRDIFF_TYPE)));
3531 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_ULONG],
3532 long_unsigned_type_node));
3533 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_REAL],
3535 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_LONG_REAL],
3537 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_PTR],
3540 IDENTIFIER_LOCAL_VALUE (ridpointers[(int)RID_TRUE]) =
3542 IDENTIFIER_LOCAL_VALUE (ridpointers[(int)RID_FALSE]) =
3544 IDENTIFIER_LOCAL_VALUE (ridpointers[(int)RID_NULL]) =
3547 /* The second operand is set to non-NULL to distinguish
3548 (ELSE) from (*). Used when writing grant files. */
3549 case_else_node = build (RANGE_EXPR,
3550 NULL_TREE, NULL_TREE, boolean_false_node);
3552 pushdecl (temp = build_decl (TYPE_DECL,
3553 get_identifier ("__tmp_initializer"),
3554 build_init_struct ()));
3555 DECL_SOURCE_LINE (temp) = 0;
3556 initializer_type = TREE_TYPE (temp);
3558 memcpy (tree_code_type + (int) LAST_AND_UNUSED_TREE_CODE,
3559 chill_tree_code_type,
3560 (((int) LAST_CHILL_TREE_CODE - (int) LAST_AND_UNUSED_TREE_CODE)
3562 memcpy (tree_code_length + (int) LAST_AND_UNUSED_TREE_CODE,
3563 chill_tree_code_length,
3564 (((int) LAST_CHILL_TREE_CODE - (int) LAST_AND_UNUSED_TREE_CODE)
3566 memcpy (tree_code_name + (int) LAST_AND_UNUSED_TREE_CODE,
3567 chill_tree_code_name,
3568 (((int) LAST_CHILL_TREE_CODE - (int) LAST_AND_UNUSED_TREE_CODE)
3569 * sizeof (char *)));
3570 boolean_code_name = (const char **) xcalloc (sizeof (char *),
3571 (int) LAST_CHILL_TREE_CODE);
3573 boolean_code_name[EQ_EXPR] = "=";
3574 boolean_code_name[NE_EXPR] = "/=";
3575 boolean_code_name[LT_EXPR] = "<";
3576 boolean_code_name[GT_EXPR] = ">";
3577 boolean_code_name[LE_EXPR] = "<=";
3578 boolean_code_name[GE_EXPR] = ">=";
3579 boolean_code_name[SET_IN_EXPR] = "in";
3580 boolean_code_name[TRUTH_ANDIF_EXPR] = "andif";
3581 boolean_code_name[TRUTH_ORIF_EXPR] = "orif";
3582 boolean_code_name[TRUTH_AND_EXPR] = "and";
3583 boolean_code_name[TRUTH_OR_EXPR] = "or";
3584 boolean_code_name[BIT_AND_EXPR] = "and";
3585 boolean_code_name[BIT_IOR_EXPR] = "or";
3586 boolean_code_name[BIT_XOR_EXPR] = "xor";
3588 endlink = void_list_node;
3590 chill_predefined_function_type
3591 = build_function_type (integer_type_node,
3592 tree_cons (NULL_TREE, integer_type_node,
3595 bool_ftype_int_ptr_int
3596 = build_function_type (boolean_type_node,
3597 tree_cons (NULL_TREE, integer_type_node,
3598 tree_cons (NULL_TREE, ptr_type_node,
3599 tree_cons (NULL_TREE, integer_type_node,
3601 bool_ftype_int_ptr_int
3602 = build_function_type (boolean_type_node,
3603 tree_cons (NULL_TREE, integer_type_node,
3604 tree_cons (NULL_TREE, ptr_type_node,
3605 tree_cons (NULL_TREE, integer_type_node,
3606 tree_cons (NULL_TREE, integer_type_node,
3608 bool_ftype_int_ptr_int_int
3609 = build_function_type (boolean_type_node,
3610 tree_cons (NULL_TREE, integer_type_node,
3611 tree_cons (NULL_TREE, ptr_type_node,
3612 tree_cons (NULL_TREE, integer_type_node,
3613 tree_cons (NULL_TREE, integer_type_node,
3615 bool_ftype_luns_ptr_luns_long
3616 = build_function_type (boolean_type_node,
3617 tree_cons (NULL_TREE, long_unsigned_type_node,
3618 tree_cons (NULL_TREE, ptr_type_node,
3619 tree_cons (NULL_TREE, long_unsigned_type_node,
3620 tree_cons (NULL_TREE, long_integer_type_node,
3622 bool_ftype_luns_ptr_luns_long_ptr_int
3623 = build_function_type (boolean_type_node,
3624 tree_cons (NULL_TREE, long_unsigned_type_node,
3625 tree_cons (NULL_TREE, ptr_type_node,
3626 tree_cons (NULL_TREE, long_unsigned_type_node,
3627 tree_cons (NULL_TREE, long_integer_type_node,
3628 tree_cons (NULL_TREE, ptr_type_node,
3629 tree_cons (NULL_TREE, integer_type_node,
3631 bool_ftype_ptr_ptr_int
3632 = build_function_type (boolean_type_node,
3633 tree_cons (NULL_TREE, ptr_type_node,
3634 tree_cons (NULL_TREE, ptr_type_node,
3635 tree_cons (NULL_TREE, integer_type_node,
3637 bool_ftype_ptr_ptr_luns
3638 = build_function_type (boolean_type_node,
3639 tree_cons (NULL_TREE, ptr_type_node,
3640 tree_cons (NULL_TREE, ptr_type_node,
3641 tree_cons (NULL_TREE, long_unsigned_type_node,
3643 bool_ftype_ptr_ptr_ptr_luns
3644 = build_function_type (boolean_type_node,
3645 tree_cons (NULL_TREE, ptr_type_node,
3646 tree_cons (NULL_TREE, ptr_type_node,
3647 tree_cons (NULL_TREE, ptr_type_node,
3648 tree_cons (NULL_TREE, long_unsigned_type_node,
3650 bool_ftype_ptr_int_ptr_int
3651 = build_function_type (boolean_type_node,
3652 tree_cons (NULL_TREE, ptr_type_node,
3653 tree_cons (NULL_TREE, integer_type_node,
3654 tree_cons (NULL_TREE, ptr_type_node,
3655 tree_cons (NULL_TREE, integer_type_node,
3657 bool_ftype_ptr_int_ptr_int_int
3658 = build_function_type (boolean_type_node,
3659 tree_cons (NULL_TREE, ptr_type_node,
3660 tree_cons (NULL_TREE, integer_type_node,
3661 tree_cons (NULL_TREE, ptr_type_node,
3662 tree_cons (NULL_TREE, integer_type_node,
3663 tree_cons (NULL_TREE, integer_type_node,
3666 = build_function_type (integer_type_node,
3667 tree_cons (NULL_TREE, ptr_type_node,
3668 tree_cons (NULL_TREE, long_unsigned_type_node,
3669 tree_cons (NULL_TREE, integer_type_node,
3672 = build_function_type (integer_type_node,
3673 tree_cons (NULL_TREE, integer_type_node,
3676 = build_function_type (integer_type_node,
3677 tree_cons (NULL_TREE, integer_type_node,
3678 tree_cons (NULL_TREE, integer_type_node,
3680 int_ftype_int_ptr_int
3681 = build_function_type (integer_type_node,
3682 tree_cons (NULL_TREE, integer_type_node,
3683 tree_cons (NULL_TREE, ptr_type_node,
3684 tree_cons (NULL_TREE, integer_type_node,
3687 = build_function_type (integer_type_node,
3688 tree_cons (NULL_TREE, ptr_type_node,
3691 = build_function_type (integer_type_node,
3692 tree_cons (NULL_TREE, ptr_type_node,
3693 tree_cons (NULL_TREE, integer_type_node,
3697 = build_function_type (long_integer_type_node,
3698 tree_cons (NULL_TREE, ptr_type_node,
3699 tree_cons (NULL_TREE, long_unsigned_type_node,
3702 int_ftype_ptr_int_int_ptr_int
3703 = build_function_type (integer_type_node,
3704 tree_cons (NULL_TREE, ptr_type_node,
3705 tree_cons (NULL_TREE, integer_type_node,
3706 tree_cons (NULL_TREE, integer_type_node,
3707 tree_cons (NULL_TREE, ptr_type_node,
3708 tree_cons (NULL_TREE, integer_type_node,
3711 int_ftype_ptr_luns_long_ptr_int
3712 = build_function_type (integer_type_node,
3713 tree_cons (NULL_TREE, ptr_type_node,
3714 tree_cons (NULL_TREE, long_unsigned_type_node,
3715 tree_cons (NULL_TREE, long_integer_type_node,
3716 tree_cons (NULL_TREE, ptr_type_node,
3717 tree_cons (NULL_TREE, integer_type_node,
3720 int_ftype_ptr_ptr_int
3721 = build_function_type (integer_type_node,
3722 tree_cons (NULL_TREE, ptr_type_node,
3723 tree_cons (NULL_TREE, ptr_type_node,
3724 tree_cons (NULL_TREE, integer_type_node,
3726 int_ftype_ptr_ptr_luns
3727 = build_function_type (integer_type_node,
3728 tree_cons (NULL_TREE, ptr_type_node,
3729 tree_cons (NULL_TREE, ptr_type_node,
3730 tree_cons (NULL_TREE, long_unsigned_type_node,
3732 memcpy_ftype /* memcpy/memmove prototype */
3733 = build_function_type (ptr_type_node,
3734 tree_cons (NULL_TREE, ptr_type_node,
3735 tree_cons (NULL_TREE, const_ptr_type_node,
3736 tree_cons (NULL_TREE, sizetype,
3738 memcmp_ftype /* memcmp prototype */
3739 = build_function_type (integer_type_node,
3740 tree_cons (NULL_TREE, ptr_type_node,
3741 tree_cons (NULL_TREE, ptr_type_node,
3742 tree_cons (NULL_TREE, sizetype,
3745 ptr_ftype_ptr_int_int
3746 = build_function_type (ptr_type_node,
3747 tree_cons (NULL_TREE, ptr_type_node,
3748 tree_cons (NULL_TREE, integer_type_node,
3749 tree_cons (NULL_TREE, integer_type_node,
3751 ptr_ftype_ptr_ptr_int
3752 = build_function_type (ptr_type_node,
3753 tree_cons (NULL_TREE, ptr_type_node,
3754 tree_cons (NULL_TREE, ptr_type_node,
3755 tree_cons (NULL_TREE, integer_type_node,
3757 ptr_ftype_ptr_ptr_int_ptr_int
3758 = build_function_type (void_type_node,
3759 tree_cons (NULL_TREE, ptr_type_node,
3760 tree_cons (NULL_TREE, ptr_type_node,
3761 tree_cons (NULL_TREE, integer_type_node,
3762 tree_cons (NULL_TREE, ptr_type_node,
3763 tree_cons (NULL_TREE, integer_type_node,
3766 = build_function_type (float_type_node,
3767 tree_cons (NULL_TREE, float_type_node,
3771 = build_function_type (void_type_node,
3772 tree_cons (NULL_TREE, ptr_type_node, endlink));
3774 void_ftype_cptr_cptr_int
3775 = build_function_type (void_type_node,
3776 tree_cons (NULL_TREE, const_ptr_type_node,
3777 tree_cons (NULL_TREE, const_ptr_type_node,
3778 tree_cons (NULL_TREE, integer_type_node,
3781 void_ftype_refptr_int_ptr_int
3782 = build_function_type (void_type_node,
3783 tree_cons (NULL_TREE, build_reference_type(ptr_type_node),
3784 tree_cons (NULL_TREE, integer_type_node,
3785 tree_cons (NULL_TREE, ptr_type_node,
3786 tree_cons (NULL_TREE, integer_type_node,
3789 void_ftype_ptr_ptr_ptr_int
3790 = build_function_type (void_type_node,
3791 tree_cons (NULL_TREE, ptr_type_node,
3792 tree_cons (NULL_TREE, ptr_type_node,
3793 tree_cons (NULL_TREE, ptr_type_node,
3794 tree_cons (NULL_TREE, integer_type_node,
3796 void_ftype_ptr_ptr_ptr_luns
3797 = build_function_type (void_type_node,
3798 tree_cons (NULL_TREE, ptr_type_node,
3799 tree_cons (NULL_TREE, ptr_type_node,
3800 tree_cons (NULL_TREE, ptr_type_node,
3801 tree_cons (NULL_TREE, long_unsigned_type_node,
3803 void_ftype_ptr_int_int_int_int
3804 = build_function_type (void_type_node,
3805 tree_cons (NULL_TREE, ptr_type_node,
3806 tree_cons (NULL_TREE, integer_type_node,
3807 tree_cons (NULL_TREE, integer_type_node,
3808 tree_cons (NULL_TREE, integer_type_node,
3809 tree_cons (NULL_TREE, integer_type_node,
3811 void_ftype_ptr_luns_long_long_bool_ptr_int
3812 = build_function_type (void_type_node,
3813 tree_cons (NULL_TREE, ptr_type_node,
3814 tree_cons (NULL_TREE, long_unsigned_type_node,
3815 tree_cons (NULL_TREE, long_integer_type_node,
3816 tree_cons (NULL_TREE, long_integer_type_node,
3817 tree_cons (NULL_TREE, boolean_type_node,
3818 tree_cons (NULL_TREE, ptr_type_node,
3819 tree_cons (NULL_TREE, integer_type_node,
3821 void_ftype_ptr_int_ptr_int_int_int
3822 = build_function_type (void_type_node,
3823 tree_cons (NULL_TREE, ptr_type_node,
3824 tree_cons (NULL_TREE, integer_type_node,
3825 tree_cons (NULL_TREE, ptr_type_node,
3826 tree_cons (NULL_TREE, integer_type_node,
3827 tree_cons (NULL_TREE, integer_type_node,
3828 tree_cons (NULL_TREE, integer_type_node,
3830 void_ftype_ptr_luns_ptr_luns_luns_luns
3831 = build_function_type (void_type_node,
3832 tree_cons (NULL_TREE, ptr_type_node,
3833 tree_cons (NULL_TREE, long_unsigned_type_node,
3834 tree_cons (NULL_TREE, ptr_type_node,
3835 tree_cons (NULL_TREE, long_unsigned_type_node,
3836 tree_cons (NULL_TREE, long_unsigned_type_node,
3837 tree_cons (NULL_TREE, long_unsigned_type_node,
3839 void_ftype_ptr_int_ptr_int_ptr_int
3840 = build_function_type (void_type_node,
3841 tree_cons (NULL_TREE, ptr_type_node,
3842 tree_cons (NULL_TREE, integer_type_node,
3843 tree_cons (NULL_TREE, ptr_type_node,
3844 tree_cons (NULL_TREE, integer_type_node,
3845 tree_cons (NULL_TREE, ptr_type_node,
3846 tree_cons (NULL_TREE, integer_type_node,
3848 void_ftype_long_int_ptr_int_ptr_int
3849 = build_function_type (void_type_node,
3850 tree_cons (NULL_TREE, long_integer_type_node,
3851 tree_cons (NULL_TREE, integer_type_node,
3852 tree_cons (NULL_TREE, ptr_type_node,
3853 tree_cons (NULL_TREE, integer_type_node,
3854 tree_cons (NULL_TREE, ptr_type_node,
3855 tree_cons (NULL_TREE, integer_type_node,
3858 = build_function_type (void_type_node,
3859 tree_cons (NULL_TREE, void_type_node,
3862 void_ftype_ptr_ptr_int
3863 = build_function_type (void_type_node,
3864 tree_cons (NULL_TREE, ptr_type_node,
3865 tree_cons (NULL_TREE, ptr_type_node,
3866 tree_cons (NULL_TREE, integer_type_node,
3869 void_ftype_ptr_luns_luns_cptr_luns_luns_luns
3870 = build_function_type (void_type_node,
3871 tree_cons (NULL_TREE, ptr_type_node,
3872 tree_cons (NULL_TREE, long_unsigned_type_node,
3873 tree_cons (NULL_TREE, long_unsigned_type_node,
3874 tree_cons (NULL_TREE, const_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, long_unsigned_type_node,
3880 ptr_ftype_luns_ptr_int
3881 = build_function_type (ptr_type_node,
3882 tree_cons (NULL_TREE, long_unsigned_type_node,
3883 tree_cons (NULL_TREE, ptr_type_node,
3884 tree_cons (NULL_TREE, integer_type_node,
3888 = build_function_type (double_type_node,
3889 tree_cons (NULL_TREE, double_type_node,
3892 /* These are compiler-internal function calls, not intended
3893 to be directly called by user code */
3894 builtin_function ("__allocate", ptr_ftype_luns_ptr_int,
3895 0, NOT_BUILT_IN, NULL_PTR);
3896 builtin_function ("_allocate_global_memory", void_ftype_refptr_int_ptr_int,
3897 0, NOT_BUILT_IN, NULL_PTR);
3898 builtin_function ("_allocate_memory", void_ftype_refptr_int_ptr_int,
3899 0, NOT_BUILT_IN, NULL_PTR);
3900 builtin_function ("__andpowerset", bool_ftype_ptr_ptr_ptr_luns,
3901 0, NOT_BUILT_IN, NULL_PTR);
3902 builtin_function ("__bitsetpowerset", void_ftype_ptr_int_int_int_int,
3903 0, NOT_BUILT_IN, NULL_PTR);
3904 builtin_function ("__cardpowerset", long_ftype_ptr_luns,
3905 0, NOT_BUILT_IN, NULL_PTR);
3906 builtin_function ("__cause_ex1", void_ftype_cptr_cptr_int,
3907 0, NOT_BUILT_IN, NULL_PTR);
3908 builtin_function ("__concatstring", ptr_ftype_ptr_ptr_int_ptr_int,
3909 0, NOT_BUILT_IN, NULL_PTR);
3910 builtin_function ("__continue", void_ftype_ptr_ptr_int,
3911 0, NOT_BUILT_IN, NULL_PTR);
3912 builtin_function ("__diffpowerset", void_ftype_ptr_ptr_ptr_luns,
3913 0, NOT_BUILT_IN, NULL_PTR);
3914 builtin_function ("__eqpowerset", bool_ftype_ptr_ptr_luns,
3915 0, NOT_BUILT_IN, NULL_PTR);
3916 builtin_function ("__ffsetclrpowerset", find_bit_ftype,
3917 0, NOT_BUILT_IN, NULL_PTR);
3918 builtin_function ("__flsetclrpowerset", find_bit_ftype,
3919 0, NOT_BUILT_IN, NULL_PTR);
3920 builtin_function ("__flsetpowerset", int_ftype_ptr_luns_long_ptr_int,
3921 0, NOT_BUILT_IN, NULL_PTR);
3922 builtin_function ("__ffsetpowerset", int_ftype_ptr_luns_long_ptr_int,
3923 0, NOT_BUILT_IN, NULL_PTR);
3924 builtin_function ("__inbitstring", bool_ftype_luns_ptr_luns_long_ptr_int,
3925 0, NOT_BUILT_IN, NULL_PTR);
3926 builtin_function ("__inpowerset", bool_ftype_luns_ptr_luns_long,
3927 0, NOT_BUILT_IN, NULL_PTR);
3928 builtin_function ("__lepowerset", bool_ftype_ptr_ptr_luns,
3929 0, NOT_BUILT_IN, NULL_PTR);
3930 builtin_function ("__ltpowerset", bool_ftype_ptr_ptr_luns,
3931 0, NOT_BUILT_IN, NULL_PTR);
3932 /* Currently under experimentation. */
3933 builtin_function ("memmove", memcpy_ftype,
3934 0, NOT_BUILT_IN, NULL_PTR);
3935 builtin_function ("memcmp", memcmp_ftype,
3936 0, NOT_BUILT_IN, NULL_PTR);
3938 /* this comes from c-decl.c (init_decl_processing) */
3939 builtin_function ("__builtin_alloca",
3940 build_function_type (ptr_type_node,
3941 tree_cons (NULL_TREE,
3944 BUILT_IN_ALLOCA, BUILT_IN_NORMAL, "alloca");
3946 builtin_function ("memset", ptr_ftype_ptr_int_int,
3947 0, NOT_BUILT_IN, NULL_PTR);
3948 builtin_function ("__notpowerset", bool_ftype_ptr_ptr_luns,
3949 0, NOT_BUILT_IN, NULL_PTR);
3950 builtin_function ("__orpowerset", bool_ftype_ptr_ptr_ptr_luns,
3951 0, NOT_BUILT_IN, NULL_PTR);
3952 builtin_function ("__psslice", void_ftype_ptr_int_ptr_int_int_int,
3953 0, NOT_BUILT_IN, NULL_PTR);
3954 builtin_function ("__pscpy", void_ftype_ptr_luns_luns_cptr_luns_luns_luns,
3955 0, NOT_BUILT_IN, NULL_PTR);
3956 builtin_function ("_return_memory", void_ftype_ptr_ptr_int,
3957 0, NOT_BUILT_IN, NULL_PTR);
3958 builtin_function ("__setbitpowerset", void_ftype_ptr_luns_long_long_bool_ptr_int,
3959 0, NOT_BUILT_IN, NULL_PTR);
3960 builtin_function ("__terminate", void_ftype_ptr_ptr_int,
3961 0, NOT_BUILT_IN, NULL_PTR);
3962 builtin_function ("__unhandled_ex", void_ftype_cptr_cptr_int,
3963 0, NOT_BUILT_IN, NULL_PTR);
3964 builtin_function ("__xorpowerset", bool_ftype_ptr_ptr_ptr_luns,
3965 0, NOT_BUILT_IN, NULL_PTR);
3967 /* declare floating point functions */
3968 builtin_function ("__sin", double_ftype_double, 0, NOT_BUILT_IN, "sin");
3969 builtin_function ("__cos", double_ftype_double, 0, NOT_BUILT_IN, "cos");
3970 builtin_function ("__tan", double_ftype_double, 0, NOT_BUILT_IN, "tan");
3971 builtin_function ("__asin", double_ftype_double, 0, NOT_BUILT_IN, "asin");
3972 builtin_function ("__acos", double_ftype_double, 0, NOT_BUILT_IN, "acos");
3973 builtin_function ("__atan", double_ftype_double, 0, NOT_BUILT_IN, "atan");
3974 builtin_function ("__exp", double_ftype_double, 0, NOT_BUILT_IN, "exp");
3975 builtin_function ("__log", double_ftype_double, 0, NOT_BUILT_IN, "log");
3976 builtin_function ("__log10", double_ftype_double, 0, NOT_BUILT_IN, "log10");
3977 builtin_function ("__sqrt", double_ftype_double, 0, NOT_BUILT_IN, "sqrt");
3983 /* These are predefined value builtin routine calls, built
3984 by the compiler, but over-ridable by user procedures of
3985 the same names. Note the lack of a leading underscore. */
3986 builtin_function ((ignore_case || ! special_UC) ? "abs" : "ABS",
3987 chill_predefined_function_type,
3988 BUILT_IN_CH_ABS, BUILT_IN_NORMAL, NULL_PTR);
3989 builtin_function ((ignore_case || ! special_UC) ? "abstime" : "ABSTIME",
3990 chill_predefined_function_type,
3991 BUILT_IN_ABSTIME, BUILT_IN_NORMAL, NULL_PTR);
3992 builtin_function ((ignore_case || ! special_UC) ? "allocate" : "ALLOCATE",
3993 chill_predefined_function_type,
3994 BUILT_IN_ALLOCATE, BUILT_IN_NORMAL, NULL_PTR);
3995 builtin_function ((ignore_case || ! special_UC) ? "allocate_memory" : "ALLOCATE_MEMORY",
3996 chill_predefined_function_type,
3997 BUILT_IN_ALLOCATE_MEMORY, BUILT_IN_NORMAL, NULL_PTR);
3998 builtin_function ((ignore_case || ! special_UC) ? "addr" : "ADDR",
3999 chill_predefined_function_type,
4000 BUILT_IN_ADDR, BUILT_IN_NORMAL, NULL_PTR);
4001 builtin_function ((ignore_case || ! special_UC) ? "allocate_global_memory" : "ALLOCATE_GLOBAL_MEMORY",
4002 chill_predefined_function_type,
4003 BUILT_IN_ALLOCATE_GLOBAL_MEMORY, BUILT_IN_NORMAL, NULL_PTR);
4004 builtin_function ((ignore_case || ! special_UC) ? "arccos" : "ARCCOS",
4005 chill_predefined_function_type,
4006 BUILT_IN_ARCCOS, BUILT_IN_NORMAL, NULL_PTR);
4007 builtin_function ((ignore_case || ! special_UC) ? "arcsin" : "ARCSIN",
4008 chill_predefined_function_type,
4009 BUILT_IN_ARCSIN, BUILT_IN_NORMAL, NULL_PTR);
4010 builtin_function ((ignore_case || ! special_UC) ? "arctan" : "ARCTAN",
4011 chill_predefined_function_type,
4012 BUILT_IN_ARCTAN, BUILT_IN_NORMAL, NULL_PTR);
4013 builtin_function ((ignore_case || ! special_UC) ? "card" : "CARD",
4014 chill_predefined_function_type,
4015 BUILT_IN_CARD, BUILT_IN_NORMAL, NULL_PTR);
4016 builtin_function ((ignore_case || ! special_UC) ? "cos" : "COS",
4017 chill_predefined_function_type,
4018 BUILT_IN_CH_COS, BUILT_IN_NORMAL, NULL_PTR);
4019 builtin_function ((ignore_case || ! special_UC) ? "days" : "DAYS",
4020 chill_predefined_function_type,
4021 BUILT_IN_DAYS, BUILT_IN_NORMAL, NULL_PTR);
4022 builtin_function ((ignore_case || ! special_UC) ? "descr" : "DESCR",
4023 chill_predefined_function_type,
4024 BUILT_IN_DESCR, BUILT_IN_NORMAL, NULL_PTR);
4025 builtin_function ((ignore_case || ! special_UC) ? "getstack" : "GETSTACK",
4026 chill_predefined_function_type,
4027 BUILT_IN_GETSTACK, BUILT_IN_NORMAL, NULL_PTR);
4028 builtin_function ((ignore_case || ! special_UC) ? "exp" : "EXP",
4029 chill_predefined_function_type,
4030 BUILT_IN_EXP, BUILT_IN_NORMAL, NULL_PTR);
4031 builtin_function ((ignore_case || ! special_UC) ? "hours" : "HOURS",
4032 chill_predefined_function_type,
4033 BUILT_IN_HOURS, BUILT_IN_NORMAL, NULL_PTR);
4034 builtin_function ((ignore_case || ! special_UC) ? "inttime" : "INTTIME",
4035 chill_predefined_function_type,
4036 BUILT_IN_INTTIME, BUILT_IN_NORMAL, NULL_PTR);
4037 builtin_function ((ignore_case || ! special_UC) ? "length" : "LENGTH",
4038 chill_predefined_function_type,
4039 BUILT_IN_LENGTH, BUILT_IN_NORMAL, NULL_PTR);
4040 builtin_function ((ignore_case || ! special_UC) ? "log" : "LOG",
4041 chill_predefined_function_type,
4042 BUILT_IN_LOG, BUILT_IN_NORMAL, NULL_PTR);
4043 builtin_function ((ignore_case || ! special_UC) ? "lower" : "LOWER",
4044 chill_predefined_function_type,
4045 BUILT_IN_LOWER, BUILT_IN_NORMAL, NULL_PTR);
4046 builtin_function ((ignore_case || ! special_UC) ? "ln" : "LN",
4047 chill_predefined_function_type,
4048 BUILT_IN_LN, BUILT_IN_NORMAL, NULL_PTR);
4049 /* Note: these are *not* the C integer MAX and MIN. They're
4050 for powerset arguments. */
4051 builtin_function ((ignore_case || ! special_UC) ? "max" : "MAX",
4052 chill_predefined_function_type,
4053 BUILT_IN_MAX, BUILT_IN_NORMAL, NULL_PTR);
4054 builtin_function ((ignore_case || ! special_UC) ? "millisecs" : "MILLISECS",
4055 chill_predefined_function_type,
4056 BUILT_IN_MILLISECS, BUILT_IN_NORMAL, NULL_PTR);
4057 builtin_function ((ignore_case || ! special_UC) ? "min" : "MIN",
4058 chill_predefined_function_type,
4059 BUILT_IN_MIN, BUILT_IN_NORMAL, NULL_PTR);
4060 builtin_function ((ignore_case || ! special_UC) ? "minutes" : "MINUTES",
4061 chill_predefined_function_type,
4062 BUILT_IN_MINUTES, BUILT_IN_NORMAL, NULL_PTR);
4063 builtin_function ((ignore_case || ! special_UC) ? "num" : "NUM",
4064 chill_predefined_function_type,
4065 BUILT_IN_NUM, BUILT_IN_NORMAL, NULL_PTR);
4066 builtin_function ((ignore_case || ! special_UC) ? "pred" : "PRED",
4067 chill_predefined_function_type,
4068 BUILT_IN_PRED, BUILT_IN_NORMAL, NULL_PTR);
4069 builtin_function ((ignore_case || ! special_UC) ? "return_memory" : "RETURN_MEMORY",
4070 chill_predefined_function_type,
4071 BUILT_IN_RETURN_MEMORY, BUILT_IN_NORMAL, NULL_PTR);
4072 builtin_function ((ignore_case || ! special_UC) ? "secs" : "SECS",
4073 chill_predefined_function_type,
4074 BUILT_IN_SECS, BUILT_IN_NORMAL, NULL_PTR);
4075 builtin_function ((ignore_case || ! special_UC) ? "sin" : "SIN",
4076 chill_predefined_function_type,
4077 BUILT_IN_CH_SIN, BUILT_IN_NORMAL, NULL_PTR);
4078 builtin_function ((ignore_case || ! special_UC) ? "size" : "SIZE",
4079 chill_predefined_function_type,
4080 BUILT_IN_SIZE, BUILT_IN_NORMAL, NULL_PTR);
4081 builtin_function ((ignore_case || ! special_UC) ? "sqrt" : "SQRT",
4082 chill_predefined_function_type,
4083 BUILT_IN_SQRT, BUILT_IN_NORMAL, NULL_PTR);
4084 builtin_function ((ignore_case || ! special_UC) ? "succ" : "SUCC",
4085 chill_predefined_function_type,
4086 BUILT_IN_SUCC, BUILT_IN_NORMAL, NULL_PTR);
4087 builtin_function ((ignore_case || ! special_UC) ? "tan" : "TAN",
4088 chill_predefined_function_type,
4089 BUILT_IN_TAN, BUILT_IN_NORMAL, NULL_PTR);
4090 builtin_function ((ignore_case || ! special_UC) ? "terminate" : "TERMINATE",
4091 chill_predefined_function_type,
4092 BUILT_IN_TERMINATE, BUILT_IN_NORMAL, NULL_PTR);
4093 builtin_function ((ignore_case || ! special_UC) ? "upper" : "UPPER",
4094 chill_predefined_function_type,
4095 BUILT_IN_UPPER, BUILT_IN_NORMAL, NULL_PTR);
4097 build_chill_descr_type ();
4098 build_chill_inttime_type ();
4100 endlink = tree_cons (NULL_TREE, void_type_node, NULL_TREE);
4102 start_identifier_warnings ();
4107 /* Return a definition for a builtin function named NAME and whose data type
4108 is TYPE. TYPE should be a function type with argument types.
4109 FUNCTION_CODE tells later passes how to compile calls to this function.
4110 See tree.h for its possible values.
4112 If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME,
4113 the name to be called if we can't opencode the function. */
4116 builtin_function (name, type, function_code, class, library_name)
4120 enum built_in_class class;
4121 const char *library_name;
4123 tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type);
4124 DECL_EXTERNAL (decl) = 1;
4125 TREE_PUBLIC (decl) = 1;
4126 /* If -traditional, permit redefining a builtin function any way you like.
4127 (Though really, if the program redefines these functions,
4128 it probably won't work right unless compiled with -fno-builtin.) */
4129 if (flag_traditional && name[0] != '_')
4130 DECL_BUILT_IN_NONANSI (decl) = 1;
4132 DECL_ASSEMBLER_NAME (decl) = get_identifier (library_name);
4133 make_decl_rtl (decl, NULL_PTR, 1);
4135 DECL_BUILT_IN_CLASS (decl) = class;
4136 DECL_FUNCTION_CODE (decl) = function_code;
4141 /* Print a warning if a constant expression had overflow in folding.
4142 Invoke this function on every expression that the language
4143 requires to be a constant expression. */
4146 constant_expression_warning (value)
4149 if ((TREE_CODE (value) == INTEGER_CST || TREE_CODE (value) == REAL_CST
4150 || TREE_CODE (value) == COMPLEX_CST)
4151 && TREE_CONSTANT_OVERFLOW (value) && pedantic)
4152 pedwarn ("overflow in constant expression");
4156 /* Finish processing of a declaration;
4157 If the length of an array type is not known before,
4158 it must be determined now, from the initial value, or it is an error. */
4164 int was_incomplete = (DECL_SIZE (decl) == 0);
4165 int temporary = allocation_temporary_p ();
4167 /* Pop back to the obstack that is current for this binding level.
4168 This is because MAXINDEX, rtl, etc. to be made below
4169 must go in the permanent obstack. But don't discard the
4170 temporary data yet. */
4172 #if 0 /* pop_obstacks was near the end; this is what was here. */
4173 if (current_scope == global_scope && temporary)
4174 end_temporary_allocation ();
4177 if (TREE_CODE (decl) == VAR_DECL)
4179 if (DECL_SIZE (decl) == 0
4180 && TYPE_SIZE (TREE_TYPE (decl)) != 0)
4181 layout_decl (decl, 0);
4183 if (DECL_SIZE (decl) == 0 && TREE_CODE (TREE_TYPE (decl)) != ERROR_MARK)
4185 error_with_decl (decl, "storage size of `%s' isn't known");
4186 TREE_TYPE (decl) = error_mark_node;
4189 if ((DECL_EXTERNAL (decl) || TREE_STATIC (decl))
4190 && DECL_SIZE (decl) != 0)
4192 if (TREE_CODE (DECL_SIZE (decl)) == INTEGER_CST)
4193 constant_expression_warning (DECL_SIZE (decl));
4197 /* Output the assembler code and/or RTL code for variables and functions,
4198 unless the type is an undefined structure or union.
4199 If not, it will get done when the type is completed. */
4201 if (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == FUNCTION_DECL)
4203 /* The last argument (at_end) is set to 1 as a kludge to force
4204 assemble_variable to be called. */
4205 if (TREE_CODE (TREE_TYPE (decl)) != ERROR_MARK)
4206 rest_of_decl_compilation (decl, (char*) 0, global_bindings_p (), 1);
4208 /* Compute the RTL of a decl if not yet set.
4209 (For normal user variables, satisfy_decl sets it.) */
4210 if (! TREE_STATIC (decl) && ! DECL_EXTERNAL (decl))
4214 /* If we used it already as memory, it must stay in memory. */
4215 TREE_ADDRESSABLE (decl) = TREE_USED (decl);
4216 /* If it's still incomplete now, no init will save it. */
4217 if (DECL_SIZE (decl) == 0)
4218 DECL_INITIAL (decl) = 0;
4224 if (TREE_CODE (decl) == TYPE_DECL)
4226 rest_of_decl_compilation (decl, NULL_PTR,
4227 global_bindings_p (), 0);
4230 /* ??? After 2.3, test (init != 0) instead of TREE_CODE. */
4231 if (!(TREE_CODE (decl) == FUNCTION_DECL && DECL_INLINE (decl))
4232 && temporary && TREE_PERMANENT (decl))
4234 /* We need to remember that this array HAD an initialization,
4235 but discard the actual temporary nodes,
4236 since we can't have a permanent node keep pointing to them. */
4237 /* We make an exception for inline functions, since it's
4238 normal for a local extern redeclaration of an inline function
4239 to have a copy of the top-level decl's DECL_INLINE. */
4240 if (DECL_INITIAL (decl) != 0)
4241 DECL_INITIAL (decl) = error_mark_node;
4245 /* Resume permanent allocation, if not within a function. */
4246 /* The corresponding push_obstacks_nochange is in start_decl,
4247 and in push_parm_decl and in grokfield. */
4251 /* If we have gone back from temporary to permanent allocation,
4252 actually free the temporary space that we no longer need. */
4253 if (temporary && !allocation_temporary_p ())
4254 permanent_allocation (0);
4256 /* At the end of a declaration, throw away any variable type sizes
4257 of types defined inside that declaration. There is no use
4258 computing them in the following function definition. */
4259 if (current_scope == global_scope)
4260 get_pending_sizes ();
4263 /* If DECL has a cleanup, build and return that cleanup here.
4264 This is a callback called by expand_expr. */
4267 maybe_build_cleanup (decl)
4268 tree decl ATTRIBUTE_UNUSED;
4270 /* There are no cleanups in C. */
4274 /* Make TYPE a complete type based on INITIAL_VALUE.
4275 Return 0 if successful, 1 if INITIAL_VALUE can't be deciphered,
4276 2 if there was no information (in which case assume 1 if DO_DEFAULT). */
4279 complete_array_type (type, initial_value, do_default)
4280 tree type ATTRIBUTE_UNUSED, initial_value ATTRIBUTE_UNUSED;
4281 int do_default ATTRIBUTE_UNUSED;
4283 /* Only needed so we can link with ../c-typeck.c. */
4287 /* Make sure that the tag NAME is defined *in the current binding level*
4288 at least as a forward reference.
4289 CODE says which kind of tag NAME ought to be.
4291 We also do a push_obstacks_nochange
4292 whose matching pop is in finish_struct. */
4295 start_struct (code, name)
4296 enum chill_tree_code code;
4297 tree name ATTRIBUTE_UNUSED;
4299 /* If there is already a tag defined at this binding level
4300 (as a forward reference), just return it. */
4302 register tree ref = 0;
4304 push_obstacks_nochange ();
4305 if (current_scope == global_scope)
4306 end_temporary_allocation ();
4308 /* Otherwise create a forward-reference just so the tag is in scope. */
4310 ref = make_node (code);
4311 /* pushtag (name, ref); */
4316 /* Function to help qsort sort FIELD_DECLs by name order. */
4319 field_decl_cmp (x, y)
4322 return (long)DECL_NAME (*x) - (long)DECL_NAME (*y);
4325 /* Fill in the fields of a RECORD_TYPE or UNION_TYPE node, T.
4326 FIELDLIST is a chain of FIELD_DECL nodes for the fields.
4328 We also do a pop_obstacks to match the push in start_struct. */
4331 finish_struct (t, fieldlist)
4332 register tree t, fieldlist;
4336 /* Install struct as DECL_CONTEXT of each field decl. */
4337 for (x = fieldlist; x; x = TREE_CHAIN (x))
4338 DECL_CONTEXT (x) = t;
4340 TYPE_FIELDS (t) = fieldlist;
4343 t = layout_chill_struct_type (t);
4345 /* The matching push is in start_struct. */
4351 /* Lay out the type T, and its element type, and so on. */
4354 layout_array_type (t)
4357 if (TYPE_SIZE (t) != 0)
4359 if (TREE_CODE (TREE_TYPE (t)) == ARRAY_TYPE)
4360 layout_array_type (TREE_TYPE (t));
4364 /* Begin compiling the definition of an enumeration type.
4365 NAME is its name (or null if anonymous).
4366 Returns the type object, as yet incomplete.
4367 Also records info about it so that build_enumerator
4368 may be used to declare the individual values as they are read. */
4372 tree name ATTRIBUTE_UNUSED;
4374 register tree enumtype;
4376 /* If this is the real definition for a previous forward reference,
4377 fill in the contents in the same object that used to be the
4378 forward reference. */
4381 /* The corresponding pop_obstacks is in finish_enum. */
4382 push_obstacks_nochange ();
4383 /* If these symbols and types are global, make them permanent. */
4384 if (current_scope == global_scope)
4385 end_temporary_allocation ();
4388 enumtype = make_node (ENUMERAL_TYPE);
4389 /* pushtag (name, enumtype); */
4393 /* Determine the precision this type needs. */
4395 get_type_precision (minnode, maxnode)
4396 tree minnode, maxnode;
4398 unsigned precision = 0;
4400 if (TREE_INT_CST_HIGH (minnode) >= 0
4401 ? tree_int_cst_lt (TYPE_MAX_VALUE (unsigned_type_node), maxnode)
4402 : (tree_int_cst_lt (minnode, TYPE_MIN_VALUE (integer_type_node))
4403 || tree_int_cst_lt (TYPE_MAX_VALUE (integer_type_node), maxnode)))
4404 precision = TYPE_PRECISION (long_long_integer_type_node);
4407 HOST_WIDE_INT maxvalue = TREE_INT_CST_LOW (maxnode);
4408 HOST_WIDE_INT minvalue = TREE_INT_CST_LOW (minnode);
4411 precision = floor_log2 (maxvalue) + 1;
4414 /* Compute number of bits to represent magnitude of a negative value.
4415 Add one to MINVALUE since range of negative numbers
4416 includes the power of two. */
4417 unsigned negprecision = floor_log2 (-minvalue - 1) + 1;
4418 if (negprecision > precision)
4419 precision = negprecision;
4420 precision += 1; /* room for sign bit */
4430 layout_enum (enumtype)
4433 register tree pair, tem;
4434 tree minnode = 0, maxnode = 0;
4435 unsigned precision = 0;
4437 /* Do arithmetic using double integers, but don't use fold/build. */
4438 union tree_node enum_next_node;
4439 /* This is 1 plus the last enumerator constant value. */
4440 tree enum_next_value = &enum_next_node;
4442 /* Nonzero means that there was overflow computing enum_next_value. */
4443 int enum_overflow = 0;
4445 tree values = TYPE_VALUES (enumtype);
4447 if (TYPE_SIZE (enumtype) != NULL_TREE)
4450 /* Initialize enum_next_value to zero. */
4451 TREE_TYPE (enum_next_value) = integer_type_node;
4452 TREE_INT_CST_LOW (enum_next_value) = TREE_INT_CST_LOW (integer_zero_node);
4453 TREE_INT_CST_HIGH (enum_next_value) = TREE_INT_CST_HIGH (integer_zero_node);
4455 /* After processing and defining all the values of an enumeration type,
4456 install their decls in the enumeration type and finish it off.
4458 TYPE_VALUES currently contains a list of (purpose: NAME, value: DECL).
4459 This gets converted to a list of (purpose: NAME, value: VALUE). */
4462 /* For each enumerator, calculate values, if defaulted.
4463 Convert to correct type (the enumtype).
4464 Also, calculate the minimum and maximum values. */
4466 for (pair = values; pair; pair = TREE_CHAIN (pair))
4468 tree decl = TREE_VALUE (pair);
4469 tree value = DECL_INITIAL (decl);
4471 /* Remove no-op casts from the value. */
4472 if (value != NULL_TREE)
4473 STRIP_TYPE_NOPS (value);
4475 if (value != NULL_TREE)
4477 if (TREE_CODE (value) == INTEGER_CST)
4479 constant_expression_warning (value);
4480 if (tree_int_cst_lt (value, integer_zero_node))
4482 error ("enumerator value for `%s' is less then 0",
4483 IDENTIFIER_POINTER (DECL_NAME (decl)));
4484 value = error_mark_node;
4489 error ("enumerator value for `%s' not integer constant",
4490 IDENTIFIER_POINTER (DECL_NAME (decl)));
4491 value = error_mark_node;
4495 if (value != error_mark_node)
4497 if (value == NULL_TREE) /* Default based on previous value. */
4499 value = enum_next_value;
4501 error ("overflow in enumeration values");
4503 value = build_int_2 (TREE_INT_CST_LOW (value),
4504 TREE_INT_CST_HIGH (value));
4505 TREE_TYPE (value) = enumtype;
4506 DECL_INITIAL (decl) = value;
4507 CH_DERIVED_FLAG (value) = 1;
4510 minnode = maxnode = value;
4513 if (tree_int_cst_lt (maxnode, value))
4515 if (tree_int_cst_lt (value, minnode))
4519 /* Set basis for default for next value. */
4520 add_double (TREE_INT_CST_LOW (value), TREE_INT_CST_HIGH (value), 1, 0,
4521 &TREE_INT_CST_LOW (enum_next_value),
4522 &TREE_INT_CST_HIGH (enum_next_value));
4523 enum_overflow = tree_int_cst_lt (enum_next_value, value);
4526 DECL_INITIAL (decl) = value; /* error_mark_node */
4529 /* Fix all error_mark_nodes in enum. Increment maxnode and assign value.
4530 This is neccessary to make a duplicate value check in the enum */
4531 for (pair = values; pair; pair = TREE_CHAIN (pair))
4533 tree decl = TREE_VALUE (pair);
4534 if (DECL_INITIAL (decl) == error_mark_node)
4537 add_double (TREE_INT_CST_LOW (maxnode), TREE_INT_CST_HIGH (maxnode), 1, 0,
4538 &TREE_INT_CST_LOW (enum_next_value),
4539 &TREE_INT_CST_HIGH (enum_next_value));
4540 value = build_int_2 (TREE_INT_CST_LOW (enum_next_value),
4541 TREE_INT_CST_HIGH (enum_next_value));
4542 TREE_TYPE (value) = enumtype;
4543 CH_DERIVED_FLAG (value) = 1;
4544 DECL_INITIAL (decl) = value;
4550 /* Now check if we have duplicate values within the enum */
4551 for (pair = values; pair; pair = TREE_CHAIN (pair))
4554 tree decl1 = TREE_VALUE (pair);
4555 tree val1 = DECL_INITIAL (decl1);
4557 for (succ = TREE_CHAIN (pair); succ; succ = TREE_CHAIN (succ))
4561 tree decl2 = TREE_VALUE (succ);
4562 tree val2 = DECL_INITIAL (decl2);
4563 if (tree_int_cst_equal (val1, val2))
4564 error ("enumerators `%s' and `%s' have equal values",
4565 IDENTIFIER_POINTER (DECL_NAME (decl1)),
4566 IDENTIFIER_POINTER (DECL_NAME (decl2)));
4571 TYPE_MIN_VALUE (enumtype) = minnode;
4572 TYPE_MAX_VALUE (enumtype) = maxnode;
4574 precision = get_type_precision (minnode, maxnode);
4576 if (flag_short_enums || precision > TYPE_PRECISION (integer_type_node))
4577 /* Use the width of the narrowest normal C type which is wide enough. */
4578 TYPE_PRECISION (enumtype) = TYPE_PRECISION (type_for_size (precision, 1));
4580 TYPE_PRECISION (enumtype) = TYPE_PRECISION (integer_type_node);
4582 layout_type (enumtype);
4585 /* An enum can have some negative values; then it is signed. */
4586 TREE_UNSIGNED (enumtype) = ! tree_int_cst_lt (minnode, integer_zero_node);
4588 /* Z200/1988 page 19 says:
4589 For each pair of integer literal expression e1, e2 in the set list NUM (e1)
4590 and NUM (e2) must deliver different non-negative results */
4591 TREE_UNSIGNED (enumtype) = 1;
4594 for (pair = values; pair; pair = TREE_CHAIN (pair))
4596 tree decl = TREE_VALUE (pair);
4598 DECL_SIZE (decl) = TYPE_SIZE (enumtype);
4599 DECL_SIZE_UNIT (decl) = TYPE_SIZE_UNIT (enumtype);
4600 DECL_ALIGN (decl) = TYPE_ALIGN (enumtype);
4602 /* Set the TREE_VALUE to the name, rather than the decl,
4603 since that is what the rest of the compiler expects. */
4604 TREE_VALUE (pair) = DECL_INITIAL (decl);
4607 /* Fix up all variant types of this enum type. */
4608 for (tem = TYPE_MAIN_VARIANT (enumtype); tem; tem = TYPE_NEXT_VARIANT (tem))
4610 TYPE_VALUES (tem) = TYPE_VALUES (enumtype);
4611 TYPE_MIN_VALUE (tem) = TYPE_MIN_VALUE (enumtype);
4612 TYPE_MAX_VALUE (tem) = TYPE_MAX_VALUE (enumtype);
4613 TYPE_SIZE (tem) = TYPE_SIZE (enumtype);
4614 TYPE_MODE (tem) = TYPE_MODE (enumtype);
4615 TYPE_PRECISION (tem) = TYPE_PRECISION (enumtype);
4616 TYPE_ALIGN (tem) = TYPE_ALIGN (enumtype);
4617 TREE_UNSIGNED (tem) = TREE_UNSIGNED (enumtype);
4621 /* This matches a push in start_enum. */
4627 finish_enum (enumtype, values)
4628 register tree enumtype, values;
4630 TYPE_VALUES (enumtype) = values = nreverse (values);
4632 /* If satisfy_decl is called on one of the enum CONST_DECLs,
4633 this will make sure that the enumtype gets laid out then. */
4634 for ( ; values; values = TREE_CHAIN (values))
4635 TREE_TYPE (TREE_VALUE (values)) = enumtype;
4641 /* Build and install a CONST_DECL for one value of the
4642 current enumeration type (one that was begun with start_enum).
4643 Return a tree-list containing the CONST_DECL and its value.
4644 Assignment of sequential values by default is handled here. */
4647 build_enumerator (name, value)
4651 int named = name != NULL_TREE;
4656 (void) get_next_decl ();
4660 if (name == NULL_TREE)
4662 static int unnamed_value_warned = 0;
4663 static int next_dummy_enum_value = 0;
4665 if (!unnamed_value_warned)
4667 unnamed_value_warned = 1;
4668 warning ("undefined value in SET mode is obsolete and deprecated.");
4670 sprintf (buf, "__star_%d", next_dummy_enum_value++);
4671 name = get_identifier (buf);
4674 decl = build_decl (CONST_DECL, name, integer_type_node);
4675 CH_DECL_ENUM (decl) = 1;
4676 DECL_INITIAL (decl) = value;
4681 push_obstacks_nochange ();
4688 return build_tree_list (name, decl);
4691 tree old_value = lookup_name_current_level (name);
4693 if (old_value != NULL_TREE
4694 && TREE_CODE (old_value)=!= CONST_DECL
4695 && (value == NULL_TREE || operand_equal_p (value, old_value, 1)))
4697 if (value == NULL_TREE)
4699 if (TREE_CODE (old_value) == CONST_DECL)
4700 value = DECL_INITIAL (old_value);
4704 return saveable_tree_cons (old_value, value, NULL_TREE);
4709 /* Record that this function is going to be a varargs function.
4710 This is called before store_parm_decls, which is too early
4711 to call mark_varargs directly. */
4716 c_function_varargs = 1;
4719 /* Function needed for CHILL interface. */
4723 return current_function_parms;
4726 /* Save and restore the variables in this file and elsewhere
4727 that keep track of the progress of compilation of the current function.
4728 Used for nested functions. */
4732 struct c_function *next;
4733 struct scope *scope;
4734 tree chill_result_decl;
4735 int result_never_set;
4738 struct c_function *c_function_chain;
4740 /* Save and reinitialize the variables
4741 used during compilation of a C function. */
4744 push_chill_function_context ()
4746 struct c_function *p
4747 = (struct c_function *) xmalloc (sizeof (struct c_function));
4749 push_function_context ();
4751 p->next = c_function_chain;
4752 c_function_chain = p;
4754 p->scope = current_scope;
4755 p->chill_result_decl = chill_result_decl;
4756 p->result_never_set = result_never_set;
4759 /* Restore the variables used during compilation of a C function. */
4762 pop_chill_function_context ()
4764 struct c_function *p = c_function_chain;
4767 /* Bring back all the labels that were shadowed. */
4768 for (link = shadowed_labels; link; link = TREE_CHAIN (link))
4769 if (DECL_NAME (TREE_VALUE (link)) != 0)
4770 IDENTIFIER_LABEL_VALUE (DECL_NAME (TREE_VALUE (link)))
4771 = TREE_VALUE (link);
4774 pop_function_context ();
4776 c_function_chain = p->next;
4778 current_scope = p->scope;
4779 chill_result_decl = p->chill_result_decl;
4780 result_never_set = p->result_never_set;
4785 /* Following from Jukka Virtanen's GNU Pascal */
4786 /* To implement WITH statement:
4788 1) Call shadow_record_fields for each record_type element in the WITH
4789 element list. Each call creates a new binding level.
4791 2) construct a component_ref for EACH field in the record,
4792 and store it to the IDENTIFIER_LOCAL_VALUE after adding
4793 the old value to the shadow list
4795 3) let lookup_name do the rest
4797 4) pop all of the binding levels after the WITH statement ends.
4798 (restoring old local values) You have to keep track of the number
4799 of times you called it.
4803 * Save an arbitrary tree-expression as the IDENTIFIER_LOCAL_VALUE
4804 * of a name. Save the name's previous value. Check for name
4805 * collisions with another value under the same name at the same
4806 * nesting level. This is used to implement the DO WITH construct
4807 * and the temporary for the location iteration loop.
4810 save_expr_under_name (name, expr)
4813 tree alias = build_alias_decl (NULL_TREE, NULL_TREE, name);
4815 DECL_ABSTRACT_ORIGIN (alias) = expr;
4816 TREE_CHAIN (alias) = NULL_TREE;
4817 pushdecllist (alias, 0);
4821 do_based_decl (name, mode, base_var)
4822 tree name, mode, base_var;
4827 push_obstacks (&permanent_obstack, &permanent_obstack);
4828 decl = make_node (BASED_DECL);
4829 DECL_NAME (decl) = name;
4830 TREE_TYPE (decl) = mode;
4831 DECL_ABSTRACT_ORIGIN (decl) = base_var;
4838 decl = get_next_decl ();
4839 if (name != DECL_NAME (decl))
4841 /* FIXME: This isn't a complete test */
4842 base_decl = lookup_name (base_var);
4843 if (base_decl == NULL_TREE)
4844 error ("BASE variable never declared");
4845 else if (TREE_CODE (base_decl) == FUNCTION_DECL)
4846 error ("cannot BASE a variable on a PROC/PROCESS name");
4851 do_based_decls (names, mode, base_var)
4852 tree names, mode, base_var;
4854 if (names == NULL_TREE || TREE_CODE (names) == TREE_LIST)
4856 for (; names != NULL_TREE; names = TREE_CHAIN (names))
4857 do_based_decl (names, mode, base_var);
4859 else if (TREE_CODE (names) != ERROR_MARK)
4860 do_based_decl (names, mode, base_var);
4864 * Declare the fields so that lookup_name() will find them as
4865 * component refs for Pascal WITH or CHILL DO WITH.
4867 * Proceeds to the inner layers of Pascal/CHILL variant record
4869 * Internal routine of shadow_record_fields ()
4872 handle_one_level (parent, fields)
4873 tree parent, fields;
4877 switch (TREE_CODE (TREE_TYPE (parent)))
4881 for (field = fields; field; field = TREE_CHAIN (field)) {
4882 name = DECL_NAME (field);
4883 if (name == NULL_TREE || name == ELSE_VARIANT_NAME)
4884 /* proceed through variant part */
4885 handle_one_level (parent, TYPE_FIELDS (TREE_TYPE (field)));
4888 tree field_alias = make_node (WITH_DECL);
4889 DECL_NAME (field_alias) = name;
4890 TREE_TYPE (field_alias) = TREE_TYPE (field);
4891 DECL_ABSTRACT_ORIGIN (field_alias) = parent;
4892 TREE_CHAIN (field_alias) = NULL_TREE;
4893 pushdecllist (field_alias, 0);
4898 error ("INTERNAL ERROR: handle_one_level is broken");
4903 * For each FIELD_DECL node in a RECORD_TYPE, we have to declare
4904 * a name so that lookup_name will find a COMPONENT_REF node
4905 * when the name is referenced. This happens in Pascal WITH statement.
4908 shadow_record_fields (struct_val)
4911 if (pass == 1 || struct_val == NULL_TREE)
4914 handle_one_level (struct_val, TYPE_FIELDS (TREE_TYPE (struct_val)));
4917 static char exception_prefix [] = "__Ex_";
4920 build_chill_exception_decl (name)
4923 tree decl, ex_name, ex_init, ex_type;
4924 int name_len = strlen (name);
4925 char *ex_string = (char *)
4926 alloca (strlen (exception_prefix) + name_len + 1);
4928 sprintf(ex_string, "%s%s", exception_prefix, name);
4929 ex_name = get_identifier (ex_string);
4930 decl = IDENTIFIER_LOCAL_VALUE (ex_name);
4934 /* finish_decl is too eager about switching back to the
4935 ambient context. This decl's rtl must live in the permanent_obstack. */
4936 push_obstacks (&permanent_obstack, &permanent_obstack);
4937 push_obstacks_nochange ();
4938 ex_type = build_array_type (char_type_node,
4939 build_index_2_type (integer_zero_node,
4940 build_int_2 (name_len, 0)));
4941 decl = build_lang_decl (VAR_DECL, ex_name, ex_type);
4942 ex_init = build_string (name_len, name);
4943 TREE_TYPE (ex_init) = ex_type;
4944 DECL_INITIAL (decl) = ex_init;
4945 TREE_READONLY (decl) = 1;
4946 TREE_STATIC (decl) = 1;
4947 pushdecl_top_level (decl);
4949 pop_obstacks (); /* Return to the ambient context. */
4953 extern tree module_init_list;
4956 * This function is called from the parser to preface the entire
4957 * compilation. It contains module-level actions and reach-bound
4961 start_outer_function ()
4963 start_chill_function (pass < 2 ? get_identifier ("_GLOBAL_")
4964 : DECL_NAME (global_function_decl),
4965 void_type_node, NULL_TREE, NULL_TREE, NULL_TREE);
4966 global_function_decl = current_function_decl;
4967 global_scope = current_scope;
4968 chill_at_module_level = 1;
4971 /* This function finishes the global_function_decl, and if it is non-empty
4972 * (as indiacted by seen_action), adds it to module_init_list.
4975 finish_outer_function ()
4977 /* If there was module-level code in this module (not just function
4978 declarations), we allocate space for this module's init list entry,
4979 and fill in the module's function's address. */
4981 extern tree initializer_type;
4982 const char *fname_str = IDENTIFIER_POINTER (DECL_NAME (current_function_decl));
4983 char *init_entry_name = (char *)xmalloc ((unsigned)(strlen (fname_str) + 20));
4985 tree init_entry_decl;
4988 finish_chill_function ();
4990 chill_at_module_level = 0;
4996 sprintf (init_entry_name, "__tmp_%s_init_entry", fname_str);
4997 init_entry_id = get_identifier (init_entry_name);
4999 init_entry_decl = build1 (ADDR_EXPR,
5000 TREE_TYPE (TYPE_FIELDS (initializer_type)),
5001 global_function_decl);
5002 TREE_CONSTANT (init_entry_decl) = 1;
5003 initializer = build (CONSTRUCTOR, initializer_type, NULL_TREE,
5004 tree_cons (NULL_TREE, init_entry_decl,
5005 build_tree_list (NULL_TREE,
5006 null_pointer_node)));
5007 TREE_CONSTANT (initializer) = 1;
5009 = do_decl (init_entry_id, initializer_type, 1, 1, initializer, 0);
5010 DECL_SOURCE_LINE (init_entry_decl) = 0;
5012 /* tell chill_finish_compile that there's
5013 module-level code to be processed. */
5014 module_init_list = integer_one_node;
5015 else if (build_constructor)
5016 module_init_list = tree_cons (global_function_decl,
5020 make_decl_rtl (global_function_decl, NULL, 0);