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