OSDN Git Service

* config/alpha/vms.h (INCLUDE_DEFAULTS): Add /gnu/lib/gcc-lib/include.
[pf3gnuchains/gcc-fork.git] / gcc / ch / decl.c
1 /* Process declarations and variables for GNU CHILL compiler.
2    Copyright (C) 1992, 1993, 1994, 1998, 1999, 2000, 2001
3    Free Software Foundation, Inc. 
4    
5 This file is part of GNU CC.
6
7 GNU CC is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11    
12 GNU CC is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 GNU General Public License for more details.
16    
17 You should have received a copy of the GNU General Public License
18 along with GNU CC; see the file COPYING.  If not, write to
19 the Free Software Foundation, 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA.  */
21
22
23 /* Process declarations and symbol lookup for CHILL front end.
24    Also constructs types; the standard scalar types at initialization,
25    and structure, union, array and enum types when they are declared.  */
26
27 /* NOTES on Chill name resolution
28    
29    Chill allows one to refer to an identifier that is declared later in
30    the same Group.  Hence, a single pass over the code (as in C) is
31    insufficient.
32    
33    This implementation uses two complete passes over the source code,
34    plus some extra passes over internal data structures.
35    
36    Loosely, during pass 1, a 'scope' object is created for each Chill
37    reach.  Each scope object contains a list of 'decl' objects,
38    one for each 'defining occurrence' in the reach.  (This list
39    is in the 'remembered_decls' field of each scope.)
40    The scopes and their decls are replayed in pass 2:  As each reach
41    is entered, the decls saved from pass 1 are made visible.
42    
43    There are some exceptions.  Declarations that cannot be referenced
44    before their declaration (i.e. whose defining occurrence precede
45    their reach), can be deferred to pass 2.  These include formal
46    parameter declarations, and names defined in a DO action.
47    
48    During pass 2, as each scope is entered, we must make visible all
49    the declarations defined in the scope, before we generate any code.
50    We must also simplify the declarations from pass 1:  For example
51    a VAR_DECL may have a array type whose bounds are expressions;
52    these need to be folded.  But of course the expressions may contain
53    identifiers that may be defined later in the scope - or even in
54    a different module.
55    
56    The "satisfy" process has two main phases:
57    
58    1: Binding. Each identifier *referenced* in a declaration (i.e. in
59    a mode or the RHS of a synonum declaration) must be bound to its
60    defining occurrence.  This may need to be linking via
61    grants and/or seizes (which are represented by ALIAS_DECLs).
62    A further complication is handling implied name strings.
63    
64    2: Layout. Each CONST_DECL or TYPE_DECL *referenced* in a declaration
65    must than be replaced by its value (or type).  Constants must be
66    folded.  Types and declarstions must be laid out.  DECL_RTL must be set.
67    While doing this, we must watch out for circular dependencies.
68    
69    If a scope contains nested modulions, then the Binding phase must be
70    done for each nested module (recursively) before the Layout phase
71    can start for that scope.  As an example of why this is needed, consider:
72    
73    M1: MODULE
74      DCL a ARRAY [1:y] int; -- This should have 7 elements.
75      SYN x = 5;
76      SEIZE y;
77    END M1;
78    M2: MODULE
79      SYN x = 2;
80      SYN y = x + 5;
81      GRANT y;
82    END M2;
83
84    Here, the 'x' in "x + 5" must be Bound to the 'x' in module M2.
85    This must be done before we can Layout a.
86    The reason this is an issue is that we do *not* have a lookup
87    (or hash) table per scope (or module).  Instead we have a single
88    global table we keep adding and removing bindings from.
89    (This is both for speed, and because of gcc history.)
90
91    Note that a SEIZE generates a declaration in the current scope,
92    linked to something in the surrounding scope.  Determining (binding)
93    the link must be done in pass 2.  On the other hand, a GRANT
94    generates a declaration in the surrounding scope, linked to
95    something in the current scope.  This linkage is Bound in pass 1.
96
97    The sequence for the above example is:
98    - Enter the declarations of M1 (i.e. {a, x, y}) into the hash table.
99    - For each of {a, x, y}, examine dependent expression (the
100      rhs of x, the bounds of a), and Bind any identifiers to
101      the current declarations (as found in the hash table).  Specifically,
102      the 'y' in the array bounds of 'a' is bound to the 'y' declared by
103      the SEIZE declaration.  Also, 'y' is Bound to the implicit
104      declaration in the global scope (generated from the GRANT in M2).
105    - Remove the bindings for M1 (i.e. {a, x, y}) from the hash table.
106    - Enter the declarations of M2 (i.e. {x, y}) into the hash table.
107    - For each of {x, y} examine the dependent expressions (the rhs of
108      x and y), and Bind any identifiers to their current declarartions
109      (in this case the 'x' in "x + 5" is bound to the 'x' that is 2.
110    - Remove the bindings for M2 (i.e. {x, y}) from the hash table.
111    - Perform Layout for M1:  This requires the size of a, which
112      requires the value of y.  The 'y'  is Bound to the implicit
113      declaration in the global scope, which is Bound to the declaration
114      of y in M2.  We now require the value of this 'y', which is "x + 5"
115      where x is bound to the x in M2 (thanks to our previous Binding
116      phase).  So we get that the value of y is 7.
117    - Perform layout of M2.  This implies calculating (constant folding)
118    the value of y - but we already did that, so we're done.   
119
120    An example illustating the problem with implied names:
121
122    M1: MODULE
123      SEIZE y;
124      use(e);  -- e is implied by y.
125    END M1;
126    M2: MODULE
127      GRANT y;
128      SYNMODE y = x;
129      SEIZE x;
130    END M2;
131    M3: MODULE
132      GRANT x;
133      SYNMODE x = SET (e);
134    END M3;
135
136    This implies that determining the implied name e in M1
137    must be done after Binding of y to x in M2.
138
139    Yet another nasty:
140    M1: MODULE
141      SEIZE v;
142      DCL a ARRAY(v:v) int;
143    END M1;
144    M2: MODULE
145      GRANT v;
146      SEIZE x;
147      SYN v x = e;
148    END M2;
149    M3: MODULE
150      GRANT x;
151      SYNMODE x = SET(e);
152    END M3;
153
154    This one implies that determining the implied name e in M2,
155    must be done before Layout of a in M1.
156
157    These two examples togother indicate the determining implieed
158    names requries yet another phase.
159    - Bind strong names in M1.
160    - Bind strong names in M2.
161    - Bind strong names in M3.
162    - Determine weak names implied by SEIZEs in M1.
163    - Bind the weak names in M1.
164    - Determine weak names implied by SEIZEs in M2.
165    - Bind the weak names in M2.
166    - Determine weak names implied by SEIZEs in M3.
167    - Bind the weak names in M3.
168    - Layout M1.
169    - Layout M2.
170    - Layout M3.
171
172    We must bind the strong names in every module before we can determine
173    weak names in any module (because of seized/granted synmode/newmodes).
174    We must bind the weak names in every module before we can do Layout
175    in any module.
176
177    Sigh.
178
179    */
180
181 /* ??? not all decl nodes are given the most useful possible
182    line numbers.  For example, the CONST_DECLs for enum values.  */
183
184 #include "config.h"
185 #include "system.h"
186 #include "tree.h"
187 #include "flags.h"
188 #include "ch-tree.h"
189 #include "lex.h"
190 #include "obstack.h"
191 #include "input.h"
192 #include "rtl.h"
193 #include "toplev.h"
194 #include "diagnostic.h"
195
196 #define IS_UNKNOWN_TYPE(type) (TYPE_SIZE(type)==0)
197 #define BUILTIN_NESTING_LEVEL (-1)
198
199 /* For backward compatibility, we define Chill INT to be the same
200    as SHORT (i.e. 16 bits), at least if C INT is the same as LONG.
201    This is a lose. */
202 #define CHILL_INT_IS_SHORT (INT_TYPE_SIZE==LONG_TYPE_SIZE)
203
204 extern int  ignore_case;
205 extern tree process_type;
206 extern struct obstack *saveable_obstack;
207 extern tree signal_code;
208 extern int special_UC;
209
210 static tree get_next_decl             PARAMS ((void));
211 static tree lookup_name_for_seizing   PARAMS ((tree));
212 #if 0
213 static tree lookup_name_current_level PARAMS ((tree));
214 #endif
215 static void save_decl                 PARAMS ((tree));
216
217 extern struct obstack permanent_obstack;
218 extern int in_pseudo_module;
219
220 struct module *current_module = NULL;
221 struct module *first_module = NULL;
222 struct module **next_module = &first_module;
223
224 extern int  in_pseudo_module;
225
226 int module_number = 0;
227
228 /* This is only used internally (by signed_type). */
229
230 tree signed_boolean_type_node;
231
232 tree global_function_decl = NULL_TREE;
233
234 /* This is a temportary used by RESULT to store its value.
235    Note we cannot directly use DECL_RESULT for two reasons:
236    a) If DECL_RESULT is a register, it may get clobbered by a
237    subsequent function call; and
238    b) if the function returns a struct, we might (visibly) modify the
239    destination before we're supposed to. */
240 tree chill_result_decl;
241
242 int result_never_set;
243
244 /* forward declarations */
245 static void pushdecllist                     PARAMS ((tree, int));
246 static int  init_nonvalue_struct             PARAMS ((tree));
247 static int  init_nonvalue_array              PARAMS ((tree));
248 static void set_nesting_level                PARAMS ((tree, int));
249 static tree make_chill_variants              PARAMS ((tree, tree, tree));
250 static tree fix_identifier                   PARAMS ((tree));
251 static void proclaim_decl                    PARAMS ((tree, int));
252 static tree maybe_acons                      PARAMS ((tree, tree));
253 static void push_scope_decls                 PARAMS ((int));
254 static void pop_scope_decls                  PARAMS ((tree, tree));
255 static tree build_implied_names              PARAMS ((tree));
256 static void bind_sub_modules                 PARAMS ((int));
257 static void layout_array_type                PARAMS ((tree));
258 static void do_based_decl                    PARAMS ((tree, tree, tree));
259 static void handle_one_level                 PARAMS ((tree, tree));
260
261 int current_nesting_level = BUILTIN_NESTING_LEVEL;
262 int current_module_nesting_level = 0;
263 \f
264 /* Lots of declarations copied from c-decl.c. */
265 /* ??? not all decl nodes are given the most useful possible
266    line numbers.  For example, the CONST_DECLs for enum values.  */
267
268
269 /* We let tm.h override the types used here, to handle trivial differences
270    such as the choice of unsigned int or long unsigned int for size_t.
271    When machines start needing nontrivial differences in the size type,
272    it would be best to do something here to figure out automatically
273    from other information what type to use.  */
274
275 #ifndef PTRDIFF_TYPE
276 #define PTRDIFF_TYPE "long int"
277 #endif
278
279 #ifndef WCHAR_TYPE
280 #define WCHAR_TYPE "int"
281 #endif
282 \f
283 tree wchar_type_node;
284 tree signed_wchar_type_node;
285 tree unsigned_wchar_type_node;
286
287 tree void_list_node;
288
289 /* type of initializer structure, which points to
290    a module's module-level code, and to the next
291    such structure. */
292 tree initializer_type;
293
294 /* type of a CHILL predefined value builtin routine */
295 tree chill_predefined_function_type;
296
297 /* type `int ()' -- used for implicit declaration of functions.  */
298
299 tree default_function_type;
300
301 const char **boolean_code_name;
302
303 /* Nodes for boolean constants TRUE and FALSE. */
304 tree boolean_true_node, boolean_false_node;
305
306 tree string_one_type_node;  /* The type of CHARS(1). */
307 tree bitstring_one_type_node;  /* The type of BOOLS(1). */
308 tree bit_zero_node; /* B'0' */
309 tree bit_one_node; /* B'1' */
310
311 /* Nonzero if we have seen an invalid cross reference
312    to a struct, union, or enum, but not yet printed the message.  */
313
314 tree pending_invalid_xref;
315 /* File and line to appear in the eventual error message.  */
316 char *pending_invalid_xref_file;
317 int pending_invalid_xref_line;
318
319 /* After parsing the declarator that starts a function definition,
320    `start_function' puts here the list of parameter names or chain of decls.
321    `store_parm_decls' finds it here.  */
322
323 static tree current_function_parms;
324
325 /* Nonzero when store_parm_decls is called indicates a varargs function.
326    Value not meaningful after store_parm_decls.  */
327
328 static int c_function_varargs;
329
330 /* These are irrelevant for Chill, but are referenced from from c-typeck.c. */
331 int warn_format;
332 int warn_traditional;
333 int warn_bad_function_cast;
334
335 /* Identifiers that hold VAR_LENGTH and VAR_DATA.  */
336 tree var_length_id, var_data_id;
337
338 tree case_else_node;
339 \f
340 /* For each binding contour we allocate a scope structure
341  * which records the names defined in that contour.
342  * Contours include:
343  *  0) the global one
344  *  1) one for each function definition,
345  *     where internal declarations of the parameters appear.
346  *  2) one for each compound statement,
347  *     to record its declarations.
348  *
349  * The current meaning of a name can be found by searching the levels from
350  * the current one out to the global one.
351  */
352
353 /* To communicate between pass 1 and 2, we maintain a list of "scopes".
354    Each scope corrresponds to a nested source scope/block that contain 
355    that can contain declarations.  The TREE_VALUE of the scope points
356    to the list of declarations declared in that scope.
357    The TREE_PURPOSE of the scope points to the surrounding scope.
358    (We may need to handle nested modules later.  FIXME)
359    The TREE_CHAIN field contains a list of scope as they are seen
360    in chronological order.  (Reverse order during first pass,
361    but it is reverse before pass 2.) */
362
363 struct scope
364 {
365   /* The enclosing scope. */
366   struct scope *enclosing;
367   
368   /* The next scope, in chronlogical order. */
369   struct scope *next;
370   
371   /* A chain of DECLs constructed using save_decl during pass 1. */
372   tree remembered_decls;
373   
374   /* A chain of _DECL nodes for all variables, constants, functions,
375      and typedef types belong to this scope. */
376   tree decls;
377   
378   /* List of declarations that have been granted into this scope. */
379   tree granted_decls;
380
381   /* List of implied (weak) names. */
382   tree weak_decls;
383   
384   /* For each level, a list of shadowed outer-level local definitions
385      to be restored when this level is popped.
386      Each link is a TREE_LIST whose TREE_PURPOSE is an identifier and
387      whose TREE_VALUE is its old definition (a kind of ..._DECL node).  */
388   tree shadowed;
389   
390   /* For each level (except not the global one),
391      a chain of BLOCK nodes for all the levels
392      that were entered and exited one level down.  */
393   tree blocks;
394   
395   /* The BLOCK node for this level, if one has been preallocated.
396      If 0, the BLOCK is allocated (if needed) when the level is popped.  */
397   tree this_block;
398   
399   /* The binding level which this one is contained in (inherits from).  */
400   struct scope *level_chain;
401   
402   /* Nonzero for a level that corresponds to a module. */
403   char module_flag;
404   
405   /* Zero means called from backend code. */
406   char two_pass;
407   
408   /* The modules that are directly enclosed by this scope
409      are chained together. */
410   struct scope* first_child_module;
411   struct scope** tail_child_module;
412   struct scope* next_sibling_module;
413 };
414
415 /* The outermost binding level, for pre-defined (builtin) names. */
416
417 static struct scope builtin_scope = {
418   NULL, NULL, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE,
419   NULL_TREE, NULL_TREE, NULL, 0, 0, NULL, NULL, NULL};
420
421 struct scope *global_scope;
422
423 /* The binding level currently in effect.  */
424
425 static struct scope *current_scope = &builtin_scope;
426
427 /* The most recently seen scope. */
428 struct scope *last_scope = &builtin_scope;
429
430 /* Binding level structures are initialized by copying this one.  */
431
432 static struct scope clear_scope = {
433   NULL, NULL, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE,
434   NULL_TREE, NULL_TREE, NULL, 0, 0, NULL, NULL, NULL};
435
436 /* Chain of decls accessible through IDENTIFIER_OUTER_VALUE.
437    Decls with the same DECL_NAME are adjacent in the chain. */
438
439 static tree outer_decls = NULL_TREE;
440 \f
441 /* C-specific option variables.  */
442
443 /* Nonzero means allow type mismatches in conditional expressions;
444    just make their values `void'.   */
445
446 int flag_cond_mismatch;
447
448 /* Nonzero means give `double' the same size as `float'.  */
449
450 int flag_short_double;
451
452 /* Nonzero means don't recognize the keyword `asm'.  */
453
454 int flag_no_asm;
455
456 /* Nonzero means don't recognize any builtin functions.  */
457
458 int flag_no_builtin;
459
460 /* Nonzero means don't recognize the non-ANSI builtin functions.
461    -ansi sets this.  */
462
463 int flag_no_nonansi_builtin;
464
465 /* Nonzero means to treat bitfields as signed unless they say `unsigned'.  */
466
467 int flag_signed_bitfields = 1;
468 int explicit_flag_signed_bitfields = 0;
469
470 /* Nonzero means warn about implicit declarations.  */
471
472 int warn_implicit;
473
474 /* Nonzero means give string constants the type `const char *'
475    to get extra warnings from them.  These warnings will be too numerous
476    to be useful, except in thoroughly ANSIfied programs.  */
477
478 int warn_write_strings;
479
480 /* Nonzero means warn about pointer casts that can drop a type qualifier
481    from the pointer target type.  */
482
483 int warn_cast_qual;
484
485 /* Nonzero means warn about sizeof(function) or addition/subtraction
486    of function pointers.  */
487
488 int warn_pointer_arith;
489
490 /* Nonzero means warn for non-prototype function decls
491    or non-prototyped defs without previous prototype.  */
492
493 int warn_strict_prototypes;
494
495 /* Nonzero means warn for any global function def
496    without separate previous prototype decl.  */
497
498 int warn_missing_prototypes;
499
500 /* Nonzero means warn about multiple (redundant) decls for the same single
501    variable or function.  */
502
503 int warn_redundant_decls = 0;
504
505 /* Nonzero means warn about extern declarations of objects not at
506    file-scope level and about *all* declarations of functions (whether
507    extern or static) not at file-scope level.  Note that we exclude
508    implicit function declarations.  To get warnings about those, use
509    -Wimplicit.  */
510
511 int warn_nested_externs = 0;
512
513 /* Warn about a subscript that has type char.  */
514
515 int warn_char_subscripts = 0;
516
517 /* Warn if a type conversion is done that might have confusing results.  */
518
519 int warn_conversion;
520
521 /* Warn if adding () is suggested.  */
522
523 int warn_parentheses;
524
525 /* Warn if initializer is not completely bracketed.  */
526
527 int warn_missing_braces;
528
529 /* Define the special tree codes that we use.  */
530
531 /* Table indexed by tree code giving a string containing a character
532    classifying the tree code.  Possibilities are
533    t, d, s, c, r, <, 1 and 2.  See ch-tree.def for details.  */
534
535 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
536   
537 const char tree_code_type[] = {
538 #include "tree.def"
539     'x',
540 #include "ch-tree.def"
541   };
542 #undef DEFTREECODE
543
544 /* Table indexed by tree code giving number of expression
545    operands beyond the fixed part of the node structure.
546    Not used for types or decls.  */
547
548 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
549   
550 const unsigned char tree_code_length[] = {
551 #include "tree.def"
552     0,
553 #include "ch-tree.def"
554   };
555 #undef DEFTREECODE
556
557
558 /* Names of tree components.
559    Used for printing out the tree and error messages.  */
560 #define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
561   
562 const char *const tree_code_name[] = {
563 #include "tree.def"
564     "@@dummy",
565 #include "ch-tree.def"
566   };
567 #undef DEFTREECODE
568
569 /* Nonzero means `$' can be in an identifier. */
570 #ifndef DOLLARS_IN_IDENTIFIERS
571 #define DOLLARS_IN_IDENTIFIERS 0
572 #endif
573 int dollars_in_ident = DOLLARS_IN_IDENTIFIERS > 1;
574
575 /* An identifier that is used internally to indicate
576    an "ALL" prefix for granting or seizing.
577    We use "*" rather than the external name "ALL", partly for convenience,
578    and partly to avoid case senstivity problems. */
579
580 tree ALL_POSTFIX;
581 \f
582 void
583 allocate_lang_decl (t)
584      tree t ATTRIBUTE_UNUSED;
585 {
586   /* Nothing needed */
587 }
588
589 void
590 copy_lang_decl (node)
591      tree node ATTRIBUTE_UNUSED;
592 {
593   /* Nothing needed */
594 }
595
596 tree
597 build_lang_decl (code, name, type)
598      enum chill_tree_code code;
599      tree name;
600      tree type;
601 {
602   return build_decl (code, name, type);
603 }
604 \f
605 /* Decode the string P as a language-specific option for C.
606    Return the number of strings consumed for a valid option.
607    Return 0 for an invalid option.  */
608
609 int
610 c_decode_option (argc, argv)
611      int argc ATTRIBUTE_UNUSED;
612      char **argv;
613 {
614   char *p = argv[0];
615
616   if (!strcmp (p, "-fsigned-char"))
617     flag_signed_char = 1;
618   else if (!strcmp (p, "-funsigned-char"))
619     flag_signed_char = 0;
620   else if (!strcmp (p, "-fno-signed-char"))
621     flag_signed_char = 0;
622   else if (!strcmp (p, "-fno-unsigned-char"))
623     flag_signed_char = 1;
624   else if (!strcmp (p, "-fsigned-bitfields")
625            || !strcmp (p, "-fno-unsigned-bitfields"))
626     {
627       flag_signed_bitfields = 1;
628       explicit_flag_signed_bitfields = 1;
629     }
630   else if (!strcmp (p, "-funsigned-bitfields")
631            || !strcmp (p, "-fno-signed-bitfields"))
632     {
633       flag_signed_bitfields = 0;
634       explicit_flag_signed_bitfields = 1;
635     }
636   else if (!strcmp (p, "-fshort-enums"))
637     flag_short_enums = 1;
638   else if (!strcmp (p, "-fno-short-enums"))
639     flag_short_enums = 0;
640   else if (!strcmp (p, "-fcond-mismatch"))
641     flag_cond_mismatch = 1;
642   else if (!strcmp (p, "-fno-cond-mismatch"))
643     flag_cond_mismatch = 0;
644   else if (!strcmp (p, "-fshort-double"))
645     flag_short_double = 1;
646   else if (!strcmp (p, "-fno-short-double"))
647     flag_short_double = 0;
648   else if (!strcmp (p, "-fasm"))
649     flag_no_asm = 0;
650   else if (!strcmp (p, "-fno-asm"))
651     flag_no_asm = 1;
652   else if (!strcmp (p, "-fbuiltin"))
653     flag_no_builtin = 0;
654   else if (!strcmp (p, "-fno-builtin"))
655     flag_no_builtin = 1;
656   else if (!strcmp (p, "-ansi"))
657     flag_no_asm = 1, flag_no_nonansi_builtin = 1, dollars_in_ident = 0;
658   else if (!strcmp (p, "-Wimplicit"))
659     warn_implicit = 1;
660   else if (!strcmp (p, "-Wno-implicit"))
661     warn_implicit = 0;
662   else if (!strcmp (p, "-Wwrite-strings"))
663     warn_write_strings = 1;
664   else if (!strcmp (p, "-Wno-write-strings"))
665     warn_write_strings = 0;
666   else if (!strcmp (p, "-Wcast-qual"))
667     warn_cast_qual = 1;
668   else if (!strcmp (p, "-Wno-cast-qual"))
669     warn_cast_qual = 0;
670   else if (!strcmp (p, "-Wpointer-arith"))
671     warn_pointer_arith = 1;
672   else if (!strcmp (p, "-Wno-pointer-arith"))
673     warn_pointer_arith = 0;
674   else if (!strcmp (p, "-Wstrict-prototypes"))
675     warn_strict_prototypes = 1;
676   else if (!strcmp (p, "-Wno-strict-prototypes"))
677     warn_strict_prototypes = 0;
678   else if (!strcmp (p, "-Wmissing-prototypes"))
679     warn_missing_prototypes = 1;
680   else if (!strcmp (p, "-Wno-missing-prototypes"))
681     warn_missing_prototypes = 0;
682   else if (!strcmp (p, "-Wredundant-decls"))
683     warn_redundant_decls = 1;
684   else if (!strcmp (p, "-Wno-redundant-decls"))
685     warn_redundant_decls = 0;
686   else if (!strcmp (p, "-Wnested-externs"))
687     warn_nested_externs = 1;
688   else if (!strcmp (p, "-Wno-nested-externs"))
689     warn_nested_externs = 0;
690   else if (!strcmp (p, "-Wchar-subscripts"))
691     warn_char_subscripts = 1;
692   else if (!strcmp (p, "-Wno-char-subscripts"))
693     warn_char_subscripts = 0;
694   else if (!strcmp (p, "-Wconversion"))
695     warn_conversion = 1;
696   else if (!strcmp (p, "-Wno-conversion"))
697     warn_conversion = 0;
698   else if (!strcmp (p, "-Wparentheses"))
699     warn_parentheses = 1;
700   else if (!strcmp (p, "-Wno-parentheses"))
701     warn_parentheses = 0;
702   else if (!strcmp (p, "-Wreturn-type"))
703     warn_return_type = 1;
704   else if (!strcmp (p, "-Wno-return-type"))
705     warn_return_type = 0;
706   else if (!strcmp (p, "-Wcomment"))
707     ; /* cpp handles this one.  */
708   else if (!strcmp (p, "-Wno-comment"))
709     ; /* cpp handles this one.  */
710   else if (!strcmp (p, "-Wcomments"))
711     ; /* cpp handles this one.  */
712   else if (!strcmp (p, "-Wno-comments"))
713     ; /* cpp handles this one.  */
714   else if (!strcmp (p, "-Wtrigraphs"))
715     ; /* cpp handles this one.  */
716   else if (!strcmp (p, "-Wno-trigraphs"))
717     ; /* cpp handles this one.  */
718   else if (!strcmp (p, "-Wimport"))
719     ; /* cpp handles this one.  */
720   else if (!strcmp (p, "-Wno-import"))
721     ; /* cpp handles this one.  */
722   else if (!strcmp (p, "-Wmissing-braces"))
723     warn_missing_braces = 1;
724   else if (!strcmp (p, "-Wno-missing-braces"))
725     warn_missing_braces = 0;
726   else if (!strcmp (p, "-Wall"))
727     {
728       extra_warnings = 1;
729       /* We save the value of warn_uninitialized, since if they put
730          -Wuninitialized on the command line, we need to generate a
731          warning about not using it without also specifying -O.  */
732       if (warn_uninitialized != 1)
733         warn_uninitialized = 2;
734       warn_implicit = 1;
735       warn_return_type = 1;
736       set_Wunused (1);
737       warn_char_subscripts = 1;
738       warn_parentheses = 1;
739       warn_missing_braces = 1;
740     }
741   else
742     return 0;
743   
744   return 1;
745 }
746
747 /* Hooks for print_node.  */
748
749 void
750 print_lang_decl (file, node, indent)
751      FILE *file;
752      tree node;
753      int  indent;
754 {
755   indent_to (file, indent + 3);
756   fputs ("nesting_level ", file);
757   fprintf (file, HOST_WIDE_INT_PRINT_DEC, DECL_NESTING_LEVEL (node));
758   fputs (" ", file);
759   if (DECL_WEAK_NAME (node))
760     fprintf (file, "weak_name ");
761   if (CH_DECL_SIGNAL (node))
762     fprintf (file, "decl_signal ");
763   print_node (file, "tasking_code",
764               (tree)DECL_TASKING_CODE_DECL (node), indent + 4);
765 }
766
767
768 void
769 print_lang_type (file, node, indent)
770      FILE *file;
771      tree node;
772      int  indent;
773 {
774   tree temp;
775
776   indent_to (file, indent + 3);
777   if (CH_IS_BUFFER_MODE (node))
778     fprintf (file, "buffer_mode ");
779   if (CH_IS_EVENT_MODE (node))
780     fprintf (file, "event_mode ");
781
782   if (CH_IS_EVENT_MODE (node) || CH_IS_BUFFER_MODE (node))
783     {
784       temp = max_queue_size (node);
785       if (temp)
786         print_node_brief (file, "qsize", temp, indent + 4);
787     }
788 }
789
790 void
791 print_lang_identifier (file, node, indent)
792      FILE *file;
793      tree node;
794      int  indent;
795 {
796   print_node (file, "local",       IDENTIFIER_LOCAL_VALUE (node),   indent +  4);
797   print_node (file, "outer",       IDENTIFIER_OUTER_VALUE (node),   indent +  4);
798   print_node (file, "implicit",    IDENTIFIER_IMPLICIT_DECL (node), indent + 4);
799   print_node (file, "error locus", IDENTIFIER_ERROR_LOCUS (node),   indent + 4);
800   print_node (file, "signal_dest", IDENTIFIER_SIGNAL_DEST (node),   indent + 4);
801   indent_to  (file, indent + 3);
802   if (IDENTIFIER_SIGNAL_DATA(node))
803     fprintf (file, "signal_data ");
804 }
805 \f
806 /* initialise non-value struct */
807
808 static int
809 init_nonvalue_struct (expr)
810      tree expr;
811 {
812   tree type = TREE_TYPE (expr);
813   tree field;
814   int res = 0;
815
816   if (CH_IS_BUFFER_MODE (type))
817     {
818       expand_expr_stmt (
819         build_chill_modify_expr (
820           build_component_ref (expr, get_identifier ("__buffer_data")),
821             null_pointer_node));
822       return 1;
823     }
824   else if (CH_IS_EVENT_MODE (type))
825     {
826       expand_expr_stmt (
827         build_chill_modify_expr (
828           build_component_ref (expr, get_identifier ("__event_data")),
829             null_pointer_node));
830       return 1;
831     }
832   else if (CH_IS_ASSOCIATION_MODE (type))
833     {
834       expand_expr_stmt (
835         build_chill_modify_expr (expr,
836           chill_convert_for_assignment (type, association_init_value,
837                                         "association")));
838       return 1;
839     }
840   else if (CH_IS_ACCESS_MODE (type))
841     {
842       init_access_location (expr, type);
843       return 1;
844     }
845   else if (CH_IS_TEXT_MODE (type))
846     {
847       init_text_location (expr, type);
848       return 1;
849     }
850
851   for (field = TYPE_FIELDS (type); field != NULL_TREE; field = TREE_CHAIN (field))
852     {
853       type = TREE_TYPE (field);
854       if (CH_TYPE_NONVALUE_P (type))
855         {
856           tree exp = build_component_ref (expr, DECL_NAME (field));
857           if (TREE_CODE (type) == RECORD_TYPE)
858             res |= init_nonvalue_struct (exp);
859           else if (TREE_CODE (type) == ARRAY_TYPE)
860             res |= init_nonvalue_array (exp);
861         }
862     }
863   return res;
864 }
865
866 /* initialize non-value array */
867 /* do it with DO FOR unique-id IN expr; ... OD; */
868 static int
869 init_nonvalue_array (expr)
870      tree expr;
871 {
872   tree tmpvar = get_unique_identifier ("NONVALINIT");
873   tree type;
874   int res = 0;
875
876   push_loop_block ();
877   build_loop_iterator (tmpvar, expr, NULL_TREE, NULL_TREE, 0, 1, 0);
878   nonvalue_begin_loop_scope ();
879   build_loop_start (NULL_TREE);
880   tmpvar = lookup_name (tmpvar);
881   type = TREE_TYPE (tmpvar);
882   if (CH_TYPE_NONVALUE_P (type))
883     {
884       if (TREE_CODE (type) == RECORD_TYPE)
885         res |= init_nonvalue_struct (tmpvar);
886       else if (TREE_CODE (type) == ARRAY_TYPE)
887         res |= init_nonvalue_array (tmpvar);
888     }
889   build_loop_end ();
890   nonvalue_end_loop_scope ();
891   pop_loop_block ();
892   return res;
893 }
894 \f
895 /* This excessive piece of code sets DECL_NESTING_LEVEL (DECL) to LEVEL. */
896
897 static void
898 set_nesting_level (decl, level)
899      tree decl;
900      int level;
901 {
902   static tree *small_ints = NULL;
903   static int max_small_ints = 0;
904   
905   if (level < 0)
906     decl->decl.vindex = NULL_TREE;
907   else
908     {
909       if (level >= max_small_ints)
910         {
911           int new_max = level + 20;
912           if (small_ints == NULL)
913             small_ints = (tree*)xmalloc (new_max * sizeof(tree));
914           else
915             small_ints = (tree*)xrealloc (small_ints, new_max * sizeof(tree));
916           while (max_small_ints < new_max)
917             small_ints[max_small_ints++] = NULL_TREE;
918         }
919       if (small_ints[level] == NULL_TREE)
920         {
921           push_obstacks (&permanent_obstack, &permanent_obstack);
922           small_ints[level] = build_int_2 (level, 0);
923           pop_obstacks ();
924         }
925       /* set DECL_NESTING_LEVEL */
926       decl->decl.vindex = small_ints[level];
927     }
928 }
929 \f
930 /* OPT_EXTERNAL is non-zero when the declaration is at module level.
931  * OPT_EXTERNAL == 2 means implicitly grant it.
932  */
933 void
934 do_decls (names, type, opt_static, lifetime_bound, opt_init, opt_external)
935      tree names;
936      tree type;
937      int  opt_static;
938      int  lifetime_bound;
939      tree opt_init;
940      int  opt_external;
941 {
942   if (names == NULL_TREE || TREE_CODE (names) == TREE_LIST)
943     {
944       for (; names != NULL_TREE; names = TREE_CHAIN (names))
945         do_decl (TREE_VALUE (names), type, opt_static, lifetime_bound,
946                  opt_init, opt_external);
947     }
948   else if (TREE_CODE (names) != ERROR_MARK)
949     do_decl (names, type, opt_static, lifetime_bound, opt_init, opt_external);
950 }
951
952 tree
953 do_decl (name, type, is_static, lifetime_bound, opt_init, opt_external)
954      tree name, type;
955      int  is_static;
956      int  lifetime_bound;
957      tree opt_init;
958      int  opt_external;
959 {
960   tree decl;
961
962   if (current_function_decl == global_function_decl
963       && ! lifetime_bound /*&& opt_init != NULL_TREE*/)
964     seen_action = 1;
965
966   if (pass < 2)
967     {
968       push_obstacks (&permanent_obstack, &permanent_obstack);
969       decl = make_node (VAR_DECL);
970       DECL_NAME (decl) = name;
971       TREE_TYPE (decl) = type;
972       DECL_ASSEMBLER_NAME (decl) = name;
973
974       /* Try to put things in common when possible.
975          Tasking variables must go into common.  */
976       DECL_COMMON (decl) = 1;
977       DECL_EXTERNAL (decl) = opt_external > 0;
978       TREE_PUBLIC (decl)   = opt_external > 0;
979       TREE_STATIC (decl)   = is_static;
980
981       if (pass == 0)
982         {
983           /* We have to set this here, since we build the decl w/o
984              calling `build_decl'.  */
985           DECL_INITIAL (decl) = opt_init;
986           pushdecl (decl);
987           finish_decl (decl);
988         }
989       else
990         {
991           save_decl (decl);
992           pop_obstacks ();
993         }
994       DECL_INITIAL (decl) = opt_init;
995       if (opt_external > 1 || in_pseudo_module)
996         push_granted (DECL_NAME (decl), decl);
997     }
998   else /* pass == 2 */
999     {
1000       tree temp = NULL_TREE;
1001       int init_it = 0;
1002
1003       decl = get_next_decl ();
1004       
1005       if (name != DECL_NAME (decl))
1006         abort ();
1007       
1008       type = TREE_TYPE (decl);
1009       
1010       push_obstacks_nochange ();
1011       if (TYPE_READONLY_PROPERTY (type))
1012         {
1013           if (CH_TYPE_NONVALUE_P (type))
1014             {
1015               error_with_decl (decl, "`%s' must not be declared readonly");
1016               opt_init = NULL_TREE; /* prevent subsequent errors */
1017             }
1018           else if (opt_init == NULL_TREE && !opt_external)
1019             error("declaration of readonly variable without initialization");
1020         }
1021       TREE_READONLY (decl) = TYPE_READONLY (type);
1022       
1023       if (!opt_init && chill_varying_type_p (type))
1024         {
1025           tree fixed_part_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type)));
1026           if (fixed_part_type != NULL_TREE && TREE_CODE (fixed_part_type) != ERROR_MARK)
1027             {
1028               if (CH_CHARS_TYPE_P (fixed_part_type))
1029                 opt_init = build_chill_string (0, "");
1030               else
1031                 opt_init = build_nt (CONSTRUCTOR, NULL_TREE, NULL_TREE);
1032               lifetime_bound = 1;
1033             }
1034         }
1035
1036       if (opt_init)
1037         {
1038           if (CH_TYPE_NONVALUE_P (type))
1039             {
1040               error_with_decl (decl,
1041                                "no initialization allowed for `%s'");
1042               temp = NULL_TREE;
1043             }
1044           else if (TREE_CODE (type) == REFERENCE_TYPE)
1045             { /* A loc-identity declaration */
1046               if (! CH_LOCATION_P (opt_init))
1047                 {
1048                   error_with_decl (decl,
1049                         "value for loc-identity `%s' is not a location");
1050                   temp = NULL_TREE;
1051                 }
1052               else if (! CH_READ_COMPATIBLE (TREE_TYPE (type),
1053                                              TREE_TYPE (opt_init)))
1054                 {
1055                   error_with_decl (decl,
1056                                    "location for `%s' not read-compatible");
1057                   temp = NULL_TREE;
1058                 }
1059               else
1060                 temp = convert (type, opt_init);
1061             }
1062           else
1063             { /* Normal location declaration */
1064               char place[80];
1065               sprintf (place, "`%.60s' initializer",
1066                        IDENTIFIER_POINTER (DECL_NAME (decl)));
1067               temp = chill_convert_for_assignment (type, opt_init, place);
1068             }
1069         }
1070       else if (CH_TYPE_NONVALUE_P (type))
1071         {
1072           temp = NULL_TREE;
1073           init_it = 1;
1074         }
1075       DECL_INITIAL (decl) = NULL_TREE;
1076
1077       if (temp != NULL_TREE && TREE_CODE (temp) != ERROR_MARK)
1078         {
1079           /* The same for stack variables (assuming no nested modules). */
1080           if (lifetime_bound || !is_static)
1081             {
1082               if (is_static && ! TREE_CONSTANT (temp))
1083                 error_with_decl (decl, "nonconstant initializer for `%s'");
1084               else
1085                 DECL_INITIAL (decl) = temp;
1086             }
1087         }
1088       finish_decl (decl);
1089       /* Initialize the variable unless initialized statically. */
1090       if ((!is_static || ! lifetime_bound) &&
1091           temp != NULL_TREE && TREE_CODE (temp) != ERROR_MARK)
1092         {
1093           int was_used = TREE_USED (decl);
1094           emit_line_note (input_filename, lineno);
1095           expand_expr_stmt (build_chill_modify_expr (decl, temp));
1096           /* Don't let the initialization count as "using" the variable.  */
1097           TREE_USED (decl) = was_used;
1098           if (current_function_decl == global_function_decl)
1099             build_constructor = 1;
1100         }
1101       else if (init_it && TREE_CODE (type) != ERROR_MARK)
1102         {
1103           /* Initialize variables with non-value type */
1104           int was_used = TREE_USED (decl);
1105           int something_initialised = 0;
1106
1107           emit_line_note (input_filename, lineno);
1108           if (TREE_CODE (type) == RECORD_TYPE)
1109             something_initialised = init_nonvalue_struct (decl);
1110           else if (TREE_CODE (type) == ARRAY_TYPE)
1111             something_initialised = init_nonvalue_array (decl);
1112           if (! something_initialised)
1113             {
1114               error ("do_decl: internal error: don't know what to initialize");
1115               abort ();
1116             }
1117           /* Don't let the initialization count as "using" the variable.  */
1118           TREE_USED (decl) = was_used;
1119           if (current_function_decl == global_function_decl)
1120             build_constructor = 1;
1121         }
1122     }
1123   return decl;
1124 }
1125 \f
1126 /*
1127  * ARGTYPES is a tree_list of formal argument types.  TREE_VALUE
1128  * is the type tree for each argument, while the attribute is in
1129  * TREE_PURPOSE.
1130  */
1131 tree
1132 build_chill_function_type (return_type, argtypes, exceptions, recurse_p)
1133      tree return_type, argtypes, exceptions, recurse_p;
1134 {
1135   tree ftype, arg;
1136
1137   if (exceptions != NULL_TREE)
1138     {
1139       /* if we have exceptions we add 2 arguments, callers filename
1140          and linenumber. These arguments will be added automatically
1141          when calling a function which may raise exceptions. */
1142       argtypes = chainon (argtypes,
1143                           build_tree_list (NULL_TREE, ridpointers[(int) RID_PTR]));
1144       argtypes = chainon (argtypes,
1145                           build_tree_list (NULL_TREE, ridpointers[(int) RID_LONG]));
1146 }
1147
1148   /* Indicate the argument list is complete. */
1149   argtypes = chainon (argtypes,
1150                       build_tree_list (NULL_TREE, void_type_node));
1151   
1152   /* INOUT and OUT parameters must be a REFERENCE_TYPE since
1153      we'll be passing a temporary's address at call time. */
1154   for (arg = argtypes; arg; arg = TREE_CHAIN (arg))
1155     if (TREE_PURPOSE (arg) == ridpointers[(int) RID_LOC]
1156         || TREE_PURPOSE (arg) == ridpointers[(int) RID_OUT]
1157         || TREE_PURPOSE (arg) == ridpointers[(int) RID_INOUT]
1158         )
1159       TREE_VALUE (arg) = 
1160         build_chill_reference_type (TREE_VALUE (arg));
1161   
1162   /* Cannot use build_function_type, because if does hash-canonlicalization. */
1163   ftype = make_node (FUNCTION_TYPE);
1164   TREE_TYPE (ftype) = return_type ? return_type : void_type_node ;
1165   TYPE_ARG_TYPES (ftype) = argtypes;
1166   
1167   if (exceptions)
1168     ftype = build_exception_variant (ftype, exceptions);
1169   
1170   if (recurse_p)
1171     sorry ("RECURSIVE PROCs");
1172   
1173   return ftype;
1174 }
1175 \f
1176 /*
1177  * ARGTYPES is a tree_list of formal argument types.
1178  */
1179 tree
1180 push_extern_function (name, typespec, argtypes, exceptions, granting)
1181   tree name, typespec, argtypes, exceptions;
1182   int granting ATTRIBUTE_UNUSED;/*If 0 do pushdecl(); if 1 do push_granted()*/
1183 {
1184   tree ftype, fndecl;
1185   
1186   push_obstacks_nochange ();
1187   end_temporary_allocation ();
1188   
1189   if (pass < 2)
1190     {
1191       ftype = build_chill_function_type (typespec, argtypes,
1192                                          exceptions, NULL_TREE);
1193       
1194       fndecl = build_decl (FUNCTION_DECL, name, ftype);
1195       
1196       DECL_EXTERNAL(fndecl) = 1;
1197       TREE_STATIC (fndecl) = 1;
1198       TREE_PUBLIC (fndecl) = 1;
1199       if (pass == 0)
1200         {
1201           pushdecl (fndecl);
1202           finish_decl (fndecl);
1203         }
1204       else
1205         {
1206           save_decl (fndecl);
1207           pop_obstacks ();
1208         }
1209       make_function_rtl (fndecl);
1210     }
1211   else
1212     {
1213       fndecl = get_next_decl (); 
1214       finish_decl (fndecl);
1215     }
1216 #if 0
1217   
1218   if (granting)
1219     push_granted (name, decl);
1220   else
1221     pushdecl(decl);
1222 #endif
1223   return fndecl;
1224 }
1225
1226
1227 \f
1228 void
1229 push_extern_process (name, argtypes, exceptions, granting)
1230      tree name, argtypes, exceptions;
1231      int  granting;
1232 {
1233   tree decl, func, arglist;
1234   
1235   push_obstacks_nochange ();
1236   end_temporary_allocation ();
1237   
1238   if (pass < 2)
1239     {
1240       tree proc_struct = make_process_struct (name, argtypes);
1241       arglist = (argtypes == NULL_TREE) ? NULL_TREE :
1242         tree_cons (NULL_TREE,
1243                    build_chill_pointer_type (proc_struct), NULL_TREE);
1244     }
1245   else
1246     arglist = NULL_TREE;
1247
1248   func = push_extern_function (name, NULL_TREE, arglist,
1249                                exceptions, granting);
1250
1251   /* declare the code variable */
1252   decl = generate_tasking_code_variable (name, &process_type, 1);
1253   CH_DECL_PROCESS (func) = 1;
1254   /* remember the code variable in the function decl */
1255   DECL_TASKING_CODE_DECL (func) = (struct lang_decl *)decl;
1256
1257   add_taskstuff_to_list (decl, "_TT_Process", NULL_TREE, func, NULL_TREE);
1258 }
1259 \f
1260 void
1261 push_extern_signal (signame, sigmodelist, optsigdest)
1262      tree signame, sigmodelist, optsigdest;
1263 {
1264   tree decl, sigtype;
1265
1266   push_obstacks_nochange ();
1267   end_temporary_allocation ();
1268   
1269   sigtype = 
1270     build_signal_struct_type (signame, sigmodelist, optsigdest);
1271   
1272   /* declare the code variable outside the process */
1273   decl = generate_tasking_code_variable (signame, &signal_code, 1);
1274   add_taskstuff_to_list (decl, "_TT_Signal", NULL_TREE, sigtype, NULL_TREE);
1275 }
1276 \f
1277 void
1278 print_mode (mode)
1279      tree mode;
1280 {
1281   while (mode != NULL_TREE)
1282     {
1283       switch (TREE_CODE (mode))
1284         {
1285         case POINTER_TYPE:
1286           printf (" REF ");
1287           mode = TREE_TYPE (mode);
1288           break;
1289         case INTEGER_TYPE:
1290         case REAL_TYPE:
1291           printf (" %s ", IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (mode))));
1292           mode = NULL_TREE;
1293           break;
1294         case ARRAY_TYPE:
1295           {
1296             tree itype = TYPE_DOMAIN (mode);
1297             if (CH_STRING_TYPE_P (mode))
1298               {
1299                 fputs (" STRING (", stdout);
1300                 printf (HOST_WIDE_INT_PRINT_DEC,
1301                         TREE_INT_CST_LOW (TYPE_MAX_VALUE (itype)));
1302                 fputs (") OF ", stdout);
1303               }
1304             else
1305               {
1306                 fputs (" ARRAY (", stdout);
1307                 printf (HOST_WIDE_INT_PRINT_DEC,
1308                         TREE_INT_CST_LOW (TYPE_MIN_VALUE (itype)));
1309                 fputs (":", stdout);
1310                 printf (HOST_WIDE_INT_PRINT_DEC,
1311                         TREE_INT_CST_LOW (TYPE_MAX_VALUE (itype)));
1312                 fputs (") OF ", stdout);
1313               }
1314             mode = TREE_TYPE (mode);
1315             break;
1316           }
1317         case RECORD_TYPE:
1318           {
1319             tree fields = TYPE_FIELDS (mode);
1320             printf (" RECORD (");
1321             while (fields != NULL_TREE)
1322               {
1323                 printf (" %s:", IDENTIFIER_POINTER (DECL_NAME (fields)));
1324                 print_mode (TREE_TYPE (fields));
1325                 if (TREE_CHAIN (fields))
1326                   printf (",");
1327                 fields = TREE_CHAIN (fields);
1328               }
1329             printf (")");
1330             mode = NULL_TREE;
1331             break;
1332           }
1333         default:
1334           abort ();
1335         }
1336     }
1337 }
1338 \f
1339 tree
1340 chill_munge_params (nodes, type, attr)
1341      tree nodes, type, attr;
1342 {
1343   tree node;
1344   if (pass == 1)
1345     {
1346       /* Convert the list of identifiers to a list of types. */
1347       for (node = nodes; node != NULL_TREE; node = TREE_CHAIN (node))
1348         {
1349           TREE_VALUE (node) = type;  /* this was the identifier node */
1350           TREE_PURPOSE (node) = attr;
1351         }
1352     }
1353   return nodes;
1354 }
1355
1356 /* Push the declarations described by SYN_DEFS into the current scope.  */
1357 void
1358 push_syndecl (name, mode, value)
1359      tree name, mode, value;
1360 {
1361   if (pass == 1)
1362     {
1363       tree decl = make_node (CONST_DECL);
1364       DECL_NAME (decl) = name;
1365       DECL_ASSEMBLER_NAME (decl) = name;
1366       TREE_TYPE (decl) = mode;
1367       DECL_INITIAL (decl) = value;
1368       TREE_READONLY (decl) = 1;
1369       save_decl (decl);
1370       if (in_pseudo_module)
1371         push_granted (DECL_NAME (decl), decl);
1372     }
1373   else /* pass == 2 */
1374     get_next_decl ();
1375 }
1376
1377
1378 \f
1379 /* Push the declarations described by (MODENAME,MODE) into the current scope.
1380    MAKE_NEWMODE is 1 for NEWMODE, 0 for SYNMODE, and
1381    -1 for internal use (in which case the mode does not need to be copied). */
1382
1383 tree
1384 push_modedef (modename, mode, make_newmode)
1385      tree modename;
1386      tree mode;  /* ignored if pass==2. */
1387      int make_newmode;
1388 {
1389   tree newdecl, newmode;
1390   
1391   if (pass == 1)
1392     {
1393       /* FIXME: need to check here for SYNMODE fred fred; */
1394       push_obstacks (&permanent_obstack, &permanent_obstack);
1395
1396       newdecl = build_lang_decl (TYPE_DECL, modename, mode);
1397
1398       if (make_newmode >= 0)
1399         {
1400           newmode = make_node (LANG_TYPE);
1401           TREE_TYPE (newmode) = mode;
1402           TREE_TYPE (newdecl) = newmode;
1403           TYPE_NAME (newmode) = newdecl;
1404           if (make_newmode > 0)
1405             CH_NOVELTY (newmode) = newdecl;
1406         }
1407
1408       save_decl (newdecl);
1409       pop_obstacks ();
1410           
1411     }
1412   else /* pass == 2 */
1413     {
1414       /* FIXME: need to check here for SYNMODE fred fred; */
1415       newdecl = get_next_decl ();
1416       if (DECL_NAME (newdecl) != modename)
1417         abort ();
1418       if (TREE_CODE (TREE_TYPE (newdecl)) != ERROR_MARK)
1419         {
1420           /* ASSOCIATION, ACCESS, TEXT, BUFFER, and EVENT must not be READOnly */
1421           if (TREE_READONLY (TREE_TYPE (newdecl)) &&
1422               (CH_IS_ASSOCIATION_MODE (TREE_TYPE (newdecl)) ||
1423                CH_IS_ACCESS_MODE (TREE_TYPE (newdecl)) ||
1424                CH_IS_TEXT_MODE (TREE_TYPE (newdecl)) ||
1425                CH_IS_BUFFER_MODE (TREE_TYPE (newdecl)) ||
1426                CH_IS_EVENT_MODE (TREE_TYPE (newdecl))))
1427             error_with_decl (newdecl, "`%s' must not be READonly");
1428           rest_of_decl_compilation (newdecl, NULL_PTR,
1429                                     global_bindings_p (), 0);
1430         }
1431     }
1432   return newdecl;
1433 }
1434 \f
1435 /* Return a chain of FIELD_DECLs for the names in NAMELIST.  All of
1436    of type TYPE.  When NAMELIST is passed in from the parser, it is
1437    in reverse order.
1438    LAYOUT is (NULL_TREE, integer_one_node, integer_zero_node, tree_list),
1439    meaning (default, pack, nopack, POS (...) ).  */
1440
1441 tree
1442 grok_chill_fixedfields (namelist, type, layout)
1443      tree namelist, type;
1444      tree layout;
1445 {
1446   tree decls = NULL_TREE;
1447   
1448   if (layout != NULL_TREE && TREE_CHAIN (namelist) != NULL_TREE)
1449     {
1450       if (layout != integer_one_node && layout != integer_zero_node)
1451         {
1452           layout = NULL_TREE;
1453           error ("POS may not be specified for a list of field declarations");
1454         }
1455     }
1456
1457   /* we build the chain of FIELD_DECLs backwards, effectively
1458      unreversing the reversed names in NAMELIST.  */
1459   for (; namelist; namelist = TREE_CHAIN (namelist))
1460     {
1461       tree decl = build_decl (FIELD_DECL, 
1462                               TREE_VALUE (namelist), type);
1463       DECL_INITIAL (decl) = layout;
1464       TREE_CHAIN (decl) = decls;
1465       decls = decl;
1466     }
1467   
1468   return decls;
1469 }
1470 \f
1471 struct tree_pair
1472 {
1473   tree value;
1474   tree decl;
1475 };
1476
1477 static int  label_value_cmp                  PARAMS ((struct tree_pair *,
1478                                                     struct tree_pair *));
1479
1480 /* Function to help qsort sort variant labels by value order.  */
1481 static int
1482 label_value_cmp (x, y)
1483      struct tree_pair *x, *y;
1484 {
1485   return TREE_INT_CST_LOW (x->value) - TREE_INT_CST_LOW (y->value);
1486 }
1487 \f
1488 static tree
1489 make_chill_variants (tagfields, body, variantelse)
1490      tree tagfields;
1491      tree body;
1492      tree variantelse;
1493 {
1494   tree utype;
1495   tree first = NULL_TREE;
1496   for (; body; body = TREE_CHAIN (body))
1497     {
1498       tree decls = TREE_VALUE (body);
1499       tree labellist = TREE_PURPOSE (body);
1500
1501       if (labellist != NULL_TREE
1502           && TREE_CODE (TREE_VALUE (labellist)) == TREE_LIST
1503           && TREE_VALUE (TREE_VALUE (labellist)) == case_else_node
1504           && TREE_CHAIN (labellist) == NULL_TREE)
1505         {
1506           if (variantelse)
1507             error ("(ELSE) case label as well as ELSE variant");
1508           variantelse = decls;
1509         }
1510       else
1511         {
1512           tree rtype = start_struct (RECORD_TYPE, NULL_TREE);
1513           rtype = finish_struct (rtype, decls);
1514
1515           first = chainon (first, build_decl (FIELD_DECL, NULL_TREE, rtype));
1516       
1517           TYPE_TAG_VALUES (rtype) = labellist;
1518         }
1519     }
1520   
1521   if (variantelse != NULL_TREE)
1522     {
1523       tree rtype = start_struct (RECORD_TYPE, NULL_TREE);
1524       rtype = finish_struct (rtype, variantelse);
1525       first = chainon (first,
1526                        build_decl (FIELD_DECL,
1527                                    ELSE_VARIANT_NAME, rtype));
1528     }
1529   
1530   utype = start_struct (UNION_TYPE, NULL_TREE);
1531   utype = finish_struct (utype, first);
1532   TYPE_TAGFIELDS (utype) = tagfields;
1533   return utype;
1534 }
1535 \f
1536 tree
1537 layout_chill_variants (utype)
1538      tree utype;
1539 {
1540   tree first = TYPE_FIELDS (utype);
1541   int nlabels, label_index = 0;
1542   struct tree_pair *label_value_array;
1543   tree decl;
1544   extern int errorcount;
1545   
1546   if (TYPE_SIZE (utype))
1547     return utype;
1548   
1549   for (decl = first; decl; decl = TREE_CHAIN (decl))
1550     {
1551       tree tagfields = TYPE_TAGFIELDS (utype);
1552       tree t = TREE_TYPE (decl);
1553       tree taglist = TYPE_TAG_VALUES (t);
1554       if (DECL_NAME (decl) == ELSE_VARIANT_NAME)
1555         continue;
1556       if (tagfields == NULL_TREE)
1557         continue;
1558       for ( ; tagfields != NULL_TREE && taglist != NULL_TREE;
1559            tagfields = TREE_CHAIN (tagfields), taglist = TREE_CHAIN (taglist))
1560         {
1561           tree labellist = TREE_VALUE (taglist);
1562           for (; labellist; labellist = TREE_CHAIN (labellist))
1563             {
1564               int compat_error = 0;
1565               tree label_value = TREE_VALUE (labellist);
1566               if (TREE_CODE (label_value) == RANGE_EXPR)
1567                 {
1568                   if (TREE_OPERAND (label_value, 0) != NULL_TREE)
1569                     {
1570                       if (!CH_COMPATIBLE (TREE_OPERAND (label_value, 0),
1571                                           TREE_TYPE (TREE_VALUE (tagfields)))
1572                           || !CH_COMPATIBLE (TREE_OPERAND (label_value, 1),
1573                                              TREE_TYPE (TREE_VALUE (tagfields))))
1574                         compat_error = 1;
1575                     }
1576                 }
1577               else if (TREE_CODE (label_value) == TYPE_DECL)
1578                 {
1579                   if (!CH_COMPATIBLE (label_value,
1580                                       TREE_TYPE (TREE_VALUE (tagfields))))
1581                     compat_error = 1;
1582                 }
1583               else if (TREE_CODE (label_value) == INTEGER_CST)
1584                 {
1585                   if (!CH_COMPATIBLE (label_value,
1586                                       TREE_TYPE (TREE_VALUE (tagfields))))
1587                     compat_error = 1;
1588                 }
1589               if (compat_error)
1590                 {
1591                   if (TYPE_FIELDS (t) == NULL_TREE)
1592                     error ("inconsistent modes between labels and tag field");
1593                   else 
1594                     error_with_decl (TYPE_FIELDS (t),
1595                                      "inconsistent modes between labels and tag field");
1596                 }
1597             }
1598         }
1599       if (tagfields != NULL_TREE)
1600         error ("too few tag labels");
1601       if (taglist != NULL_TREE)
1602         error ("too many tag labels");
1603     }
1604
1605   /* Compute the number of labels to be checked for duplicates.  */
1606   nlabels = 0;
1607   for (decl = first; decl; decl = TREE_CHAIN (decl))
1608     {
1609       tree t = TREE_TYPE (decl);
1610        /* Only one tag (first case_label_list) supported, for now. */
1611       tree labellist = TYPE_TAG_VALUES (t);
1612       if (labellist)
1613         labellist = TREE_VALUE (labellist);
1614       
1615       for (; labellist != NULL_TREE; labellist = TREE_CHAIN (labellist))
1616         if (TREE_CODE (TREE_VALUE (labellist)) == INTEGER_CST)
1617           nlabels++;
1618     }
1619
1620   /* Check for duplicate label values.  */
1621   label_value_array = (struct tree_pair *)alloca (nlabels * sizeof (struct tree_pair));
1622   for (decl = first; decl; decl = TREE_CHAIN (decl))
1623     {
1624       tree t = TREE_TYPE (decl);
1625        /* Only one tag (first case_label_list) supported, for now. */
1626       tree labellist = TYPE_TAG_VALUES (t);
1627       if (labellist)
1628         labellist = TREE_VALUE (labellist);
1629       
1630       for (; labellist != NULL_TREE; labellist = TREE_CHAIN (labellist))
1631         {
1632           struct tree_pair p;
1633           
1634           tree x = TREE_VALUE (labellist);
1635           if (TREE_CODE (x) == RANGE_EXPR)
1636             {
1637               if (TREE_OPERAND (x, 0) != NULL_TREE)
1638                 {
1639                   if (TREE_CODE (TREE_OPERAND (x, 0)) != INTEGER_CST)
1640                     error ("case label lower limit is not a discrete constant expression");
1641                   if (TREE_CODE (TREE_OPERAND (x, 1)) != INTEGER_CST)
1642                     error ("case label upper limit is not a discrete constant expression");
1643                 }
1644               continue;
1645             }
1646           else if (TREE_CODE (x) == TYPE_DECL)
1647             continue;
1648           else if (TREE_CODE (x) == ERROR_MARK)
1649             continue;
1650           else if (TREE_CODE (x) != INTEGER_CST) /* <-- FIXME: what about CONST_DECLs? */
1651             {
1652               error ("case label must be a discrete constant expression");
1653               continue;
1654             }
1655           
1656           if (TREE_CODE (x) == CONST_DECL)
1657             x = DECL_INITIAL (x);
1658           if (TREE_CODE (x) != INTEGER_CST) abort ();
1659           p.value = x;
1660           p.decl = decl;
1661           if (p.decl == NULL_TREE)
1662             p.decl = TREE_VALUE (labellist);
1663           label_value_array[label_index++] = p;
1664         }
1665     }
1666   if (errorcount == 0)
1667     {
1668       int limit;
1669       qsort (label_value_array,
1670              label_index, sizeof (struct tree_pair),
1671              (int (*) PARAMS ((const void *, const void *))) label_value_cmp);
1672       limit = label_index - 1;
1673       for (label_index = 0; label_index < limit; label_index++)
1674         {
1675           if (tree_int_cst_equal (label_value_array[label_index].value, 
1676                                   label_value_array[label_index+1].value))
1677             {
1678               error_with_decl (label_value_array[label_index].decl,
1679                                "variant label declared here...");
1680               error_with_decl (label_value_array[label_index+1].decl,
1681                                "...is duplicated here");
1682             }
1683         }
1684     }
1685   layout_type (utype);
1686   return utype;
1687 }
1688 \f
1689 /* Convert a TREE_LIST of tag field names into a list of
1690    field decls, found from FIXED_FIELDS, re-using the input list. */
1691
1692 tree
1693 lookup_tag_fields (tag_field_names, fixed_fields)
1694      tree tag_field_names;
1695      tree fixed_fields;
1696 {
1697   tree list;
1698   for (list = tag_field_names; list != NULL_TREE; list = TREE_CHAIN (list))
1699     {
1700       tree decl = fixed_fields;
1701       for ( ; decl != NULL_TREE; decl = TREE_CHAIN (decl))
1702         {
1703           if (DECL_NAME (decl) == TREE_VALUE (list))
1704             {
1705               TREE_VALUE (list) = decl;
1706               break;
1707             }
1708         }
1709       if (decl == NULL_TREE)
1710         {
1711           error ("no field (yet) for tag %s",
1712                  IDENTIFIER_POINTER (TREE_VALUE (list)));
1713           TREE_VALUE (list) = error_mark_node;
1714         }
1715     }
1716   return tag_field_names;
1717 }
1718
1719 /* If non-NULL, TAGFIELDS is the tag fields for this variant record.
1720    BODY is a TREE_LIST of (optlabels, fixed fields).
1721    If non-null, VARIANTELSE is a fixed field for the else part of the
1722    variant record.  */
1723
1724 tree
1725 grok_chill_variantdefs (tagfields, body, variantelse)
1726      tree tagfields, body, variantelse;
1727 {
1728   tree t;
1729   
1730   t = make_chill_variants (tagfields, body, variantelse);
1731   if (pass != 1)
1732     t = layout_chill_variants (t);
1733   return build_decl (FIELD_DECL, NULL_TREE, t);
1734 }
1735 \f
1736 /*
1737   In pass 1, PARMS is a list of types (with attributes).
1738   In pass 2, PARMS is a chain of PARM_DECLs.
1739   */
1740
1741 int
1742 start_chill_function (label, rtype, parms, exceptlist, attrs)
1743      tree label, rtype, parms, exceptlist, attrs;
1744 {
1745   tree decl, fndecl, type, result_type, func_type;
1746   int nested = current_function_decl != 0;
1747   if (pass == 1)
1748     {
1749       func_type
1750         = build_chill_function_type (rtype, parms, exceptlist, 0);
1751       fndecl = build_decl (FUNCTION_DECL, label, func_type);
1752
1753       save_decl (fndecl);
1754       
1755       /* Make the init_value nonzero so pushdecl knows this is not tentative.
1756          error_mark_node is replaced below (in poplevel) with the BLOCK.  */
1757       DECL_INITIAL (fndecl) = error_mark_node;
1758       
1759       DECL_EXTERNAL (fndecl) = 0;
1760       
1761       /* This function exists in static storage.
1762          (This does not mean `static' in the C sense!)  */
1763       TREE_STATIC (fndecl) = 1;
1764
1765       for (; attrs != NULL_TREE; attrs = TREE_CHAIN (attrs))
1766         {
1767           if (TREE_VALUE (attrs) == ridpointers[RID_GENERAL])
1768             CH_DECL_GENERAL (fndecl) = 1;
1769           else if (TREE_VALUE (attrs) == ridpointers[RID_SIMPLE])
1770             CH_DECL_SIMPLE (fndecl) = 1;
1771           else if (TREE_VALUE (attrs) == ridpointers[RID_RECURSIVE])
1772             CH_DECL_RECURSIVE (fndecl) = 1;
1773           else if (TREE_VALUE (attrs) == ridpointers[RID_INLINE])
1774             DECL_INLINE (fndecl) = 1;
1775           else
1776             abort ();
1777         }
1778     }
1779   else /* pass == 2 */
1780     {
1781       fndecl = get_next_decl (); 
1782       if (DECL_NAME (fndecl) != label)
1783         abort ();           /* outta sync - got wrong decl */
1784       func_type = TREE_TYPE (fndecl);
1785       if (TYPE_RAISES_EXCEPTIONS (func_type) != NULL_TREE)
1786         {
1787           /* In this case we have to add 2 parameters. 
1788              See build_chill_function_type (pass == 1). */
1789           tree arg;
1790         
1791           arg = make_node (PARM_DECL);
1792           DECL_ASSEMBLER_NAME (arg) = DECL_NAME (arg) = get_identifier (CALLER_FILE);
1793           DECL_IGNORED_P (arg) = 1;
1794           parms = chainon (parms, arg);
1795         
1796           arg = make_node (PARM_DECL);
1797           DECL_ASSEMBLER_NAME (arg) = DECL_NAME (arg) = get_identifier (CALLER_LINE);
1798           DECL_IGNORED_P (arg) = 1;
1799           parms = chainon (parms, arg);
1800         }
1801     }
1802
1803   current_function_decl = fndecl;
1804   result_type = TREE_TYPE (func_type);
1805   if (CH_TYPE_NONVALUE_P (result_type))
1806     error ("non-value mode may only returned by LOC");
1807
1808   pushlevel (1); /* Push parameters. */
1809
1810   if (pass == 2)
1811     {
1812       DECL_ARGUMENTS (fndecl) = parms;
1813       for (decl = DECL_ARGUMENTS (fndecl), type = TYPE_ARG_TYPES (func_type);
1814            decl != NULL_TREE;
1815            decl = TREE_CHAIN (decl), type = TREE_CHAIN (type))
1816         {
1817           /* check here that modes with the non-value property (like
1818              BUFFER's, EVENT's, ASSOCIATION's, ACCESS's, or TEXT's) only
1819              gets passed by LOC */
1820           tree argtype = TREE_VALUE (type);
1821           tree argattr = TREE_PURPOSE (type);
1822
1823           if (TREE_CODE (argtype) == REFERENCE_TYPE)
1824             argtype = TREE_TYPE (argtype);
1825
1826           if (TREE_CODE (argtype) != ERROR_MARK &&
1827               TREE_CODE_CLASS (TREE_CODE (argtype)) != 't')
1828             {
1829               error_with_decl (decl, "mode of `%s' is not a mode");
1830               TREE_VALUE (type) = error_mark_node;
1831             }
1832
1833           if (CH_TYPE_NONVALUE_P (argtype) &&
1834               argattr != ridpointers[(int) RID_LOC])
1835             error_with_decl (decl, "`%s' may only be passed by LOC");
1836           TREE_TYPE (decl) = TREE_VALUE (type);
1837           DECL_ARG_TYPE (decl) = TREE_TYPE (decl);
1838           DECL_CONTEXT (decl) = fndecl;
1839           TREE_READONLY (decl) = TYPE_READONLY (argtype);
1840           layout_decl (decl, 0);
1841         }
1842
1843       pushdecllist (DECL_ARGUMENTS (fndecl), 0);
1844
1845       DECL_RESULT (current_function_decl)
1846         = build_decl (RESULT_DECL, NULL_TREE, result_type);
1847
1848 #if 0
1849       /* Write a record describing this function definition to the prototypes
1850          file (if requested).  */
1851       gen_aux_info_record (fndecl, 1, 0, prototype);
1852 #endif
1853
1854       if (fndecl != global_function_decl || seen_action)
1855         {
1856           /* Initialize the RTL code for the function.  */
1857           init_function_start (fndecl, input_filename, lineno);
1858
1859           /* Set up parameters and prepare for return, for the function.  */
1860           expand_function_start (fndecl, 0);
1861         }
1862
1863       if (!nested)
1864         /* Allocate further tree nodes temporarily during compilation
1865            of this function only.  */
1866         temporary_allocation ();
1867
1868       /* If this fcn was already referenced via a block-scope `extern' decl (or
1869          an implicit decl), propagate certain information about the usage. */
1870       if (TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (current_function_decl)))
1871         TREE_ADDRESSABLE (current_function_decl) = 1;
1872     }
1873       
1874   /* Z.200 requires that formal parameter names be defined in
1875      the same block as the procedure body.
1876      We could do this by keeping boths sets of DECLs in the same
1877      scope, but we would have to be careful to not merge the
1878      two chains (e.g. DECL_ARGUEMENTS musr not contains locals).
1879      Instead, we just make sure they have the same nesting_level. */
1880   current_nesting_level--;
1881   pushlevel (1); /* Push local variables. */
1882
1883   if (pass == 2 && (fndecl != global_function_decl || seen_action))
1884     {
1885       /* generate label for possible 'exit' */
1886       expand_start_bindings (1);
1887
1888       result_never_set = 1;
1889     }
1890
1891   if (TREE_CODE (result_type) == VOID_TYPE)
1892     chill_result_decl = NULL_TREE;
1893   else
1894     {
1895       /* We use the same name as the keyword.
1896          This makes it easy to print and change the RESULT from gdb. */
1897       const char *result_str =
1898         (ignore_case || ! special_UC) ? "result" : "RESULT";
1899       if (pass == 2 && TREE_CODE (result_type) == ERROR_MARK)
1900         TREE_TYPE (current_scope->remembered_decls) = result_type;
1901       chill_result_decl = do_decl (get_identifier (result_str),
1902                                    result_type, 0, 0, 0, 0);
1903       DECL_CONTEXT (chill_result_decl) = fndecl;
1904     }
1905
1906   return 1;
1907 }
1908 \f
1909 /* For checking purpose added pname as new argument
1910    MW Wed Oct 14 14:22:10 1992 */
1911 void
1912 finish_chill_function ()
1913 {
1914   register tree fndecl = current_function_decl;
1915   tree outer_function = decl_function_context (fndecl);
1916   int nested;
1917   if (outer_function == NULL_TREE && fndecl != global_function_decl)
1918     outer_function = global_function_decl;
1919   nested = current_function_decl != global_function_decl;
1920   if (pass == 2 && (fndecl != global_function_decl || seen_action))
1921     expand_end_bindings (getdecls (), 1, 0);
1922     
1923   /* pop out of function */
1924   poplevel (1, 1, 0);
1925   current_nesting_level++;
1926   /* pop out of its parameters */
1927   poplevel (1, 0, 1);
1928
1929   if (pass == 2)
1930     {
1931       /*  TREE_READONLY (fndecl) = 1;
1932           This caused &foo to be of type ptr-to-const-function which
1933           then got a warning when stored in a ptr-to-function variable. */
1934
1935       BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
1936
1937       /* Must mark the RESULT_DECL as being in this function.  */
1938
1939       DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
1940
1941       if (fndecl != global_function_decl || seen_action)
1942         {
1943           /* Generate rtl for function exit.  */
1944           expand_function_end (input_filename, lineno, 0);
1945
1946           /* Run the optimizers and output assembler code for this function. */
1947           rest_of_compilation (fndecl);
1948         }
1949
1950       if (DECL_SAVED_INSNS (fndecl) == 0 && ! nested)
1951         {
1952           /* Stop pointing to the local nodes about to be freed.  */
1953           /* But DECL_INITIAL must remain nonzero so we know this
1954              was an actual function definition.  */
1955           /* For a nested function, this is done in pop_chill_function_context.  */
1956           DECL_INITIAL (fndecl) = error_mark_node;
1957           DECL_ARGUMENTS (fndecl) = 0;
1958         }
1959     }
1960   current_function_decl = outer_function;
1961 }
1962 \f
1963 /* process SEIZE */
1964
1965 /* Points to the head of the _DECLs read from seize files.  */
1966 #if 0
1967 static tree seized_decls;
1968
1969 static tree processed_seize_files = 0;
1970 #endif
1971
1972 void
1973 chill_seize (old_prefix, new_prefix, postfix)
1974      tree old_prefix, new_prefix, postfix;
1975 {
1976   if (pass == 1)
1977     {
1978       tree decl = build_alias_decl (old_prefix, new_prefix, postfix);
1979       DECL_SEIZEFILE(decl) = use_seizefile_name;
1980       save_decl (decl);
1981     }
1982   else /* pass == 2 */
1983     {
1984       /* Do nothing - get_next_decl automatically ignores ALIAS_DECLs */
1985     }
1986 }
1987 #if 0
1988 \f
1989 /*
1990  * output a debug dump of a scope structure
1991  */
1992 void
1993 debug_scope (sp)
1994      struct scope *sp;
1995 {
1996   if (sp == (struct scope *)NULL)
1997     {
1998       fprintf (stderr, "null scope ptr\n");
1999       return;
2000     }
2001   fprintf (stderr, "enclosing 0x%x ",           sp->enclosing);
2002   fprintf (stderr, "next 0x%x ",                sp->next); 
2003   fprintf (stderr, "remembered_decls 0x%x ",    sp->remembered_decls);
2004   fprintf (stderr, "decls 0x%x\n",              sp->decls); 
2005   fprintf (stderr, "shadowed 0x%x ",            sp->shadowed); 
2006   fprintf (stderr, "blocks 0x%x ",              sp->blocks); 
2007   fprintf (stderr, "this_block 0x%x ",          sp->this_block); 
2008   fprintf (stderr, "level_chain 0x%x\n",        sp->level_chain);
2009   fprintf (stderr, "module_flag %c ",           sp->module_flag ? 'T' : 'F');
2010   fprintf (stderr, "first_child_module 0x%x ",  sp->first_child_module);
2011   fprintf (stderr, "next_sibling_module 0x%x\n", sp->next_sibling_module);
2012   if (sp->remembered_decls != NULL_TREE)
2013     {
2014       tree temp;
2015       fprintf (stderr, "remembered_decl chain:\n");
2016       for (temp = sp->remembered_decls; temp; temp = TREE_CHAIN (temp))
2017         debug_tree (temp);
2018     }
2019 }
2020 #endif
2021 \f
2022 static void
2023 save_decl (decl)
2024      tree decl;
2025 {
2026   if (current_function_decl != global_function_decl)
2027     DECL_CONTEXT (decl) = current_function_decl;
2028
2029   TREE_CHAIN (decl) = current_scope->remembered_decls;
2030   current_scope->remembered_decls = decl;
2031 #if 0
2032   fprintf (stderr, "\n\nsave_decl 0x%x\n", decl);
2033   debug_scope (current_scope);  /* ************* */
2034 #endif
2035   set_nesting_level (decl, current_nesting_level);
2036 }
2037
2038 static tree
2039 get_next_decl ()
2040 {
2041   tree decl;
2042   do
2043     {
2044       decl = current_scope->remembered_decls;
2045       current_scope->remembered_decls = TREE_CHAIN (decl);
2046       /* We ignore ALIAS_DECLs, because push_scope_decls
2047          can convert a single ALIAS_DECL representing 'SEIZE ALL'
2048          into one ALIAS_DECL for each seizeable name.
2049          This means we lose the nice one-to-one mapping
2050          between pass 1 decls and pass 2 decls.
2051          (Perhaps ALIAS_DECLs should not be on the remembered_decls list.) */
2052     } while (decl && TREE_CODE (decl) == ALIAS_DECL);
2053   return decl;
2054 }
2055
2056 /* At the end of pass 1, we reverse the chronological chain of scopes. */
2057
2058 void
2059 switch_to_pass_2 ()
2060 {
2061 #if 0
2062   extern int errorcount, sorrycount;
2063 #endif
2064   if (current_scope != &builtin_scope)
2065     abort ();
2066   last_scope = &builtin_scope;
2067   builtin_scope.remembered_decls = nreverse (builtin_scope.remembered_decls);
2068   write_grant_file ();
2069
2070 #if 0
2071   if (errorcount || sorrycount)
2072     exit (FATAL_EXIT_CODE);
2073   else
2074 #endif
2075   if (grant_only_flag)
2076     exit (SUCCESS_EXIT_CODE);
2077
2078   pass = 2;
2079   module_number = 0;
2080   next_module = &first_module;
2081 }
2082 \f
2083 /*
2084  * Called during pass 2, when we're processing actions, to
2085  * generate a temporary variable.  These don't need satisfying
2086  * because they're compiler-generated and always declared
2087  * before they're used.
2088  */
2089 tree
2090 decl_temp1 (name, type, opt_static, opt_init, 
2091             opt_external, opt_public)
2092      tree name, type;
2093      int  opt_static;
2094      tree opt_init;
2095      int  opt_external, opt_public;
2096 {
2097   int orig_pass = pass;           /* be cautious */
2098   tree mydecl;
2099
2100   pass = 1;
2101   mydecl = do_decl (name, type, opt_static, opt_static,
2102                     opt_init, opt_external);
2103
2104   if (opt_public)
2105     TREE_PUBLIC (mydecl) = 1;
2106   pass = 2;
2107   do_decl (name, type, opt_static, opt_static, opt_init, opt_external);
2108
2109   pass = orig_pass;
2110   return mydecl;
2111 }
2112 \f
2113 /* True if we're reading a seizefile, but we haven't seen a SPEC MODULE yet.
2114    For backwards compatibility, we treat declarations in such a context
2115    as implicity granted. */
2116
2117 tree
2118 set_module_name (name)
2119      tree name;
2120 {
2121   module_number++;
2122   if (name == NULL_TREE)
2123     {
2124       /* NOTE: build_prefix_clause assumes a generated
2125          module starts with a '_'. */
2126       char buf[20];
2127       sprintf (buf, "_MODULE_%d", module_number);
2128       name = get_identifier (buf);
2129     }
2130   return name;
2131 }
2132
2133 tree
2134 push_module (name, is_spec_module)
2135      tree name;
2136      int is_spec_module;
2137
2138   struct module *new_module;
2139   if (pass == 1)
2140     {
2141       new_module = (struct module*) permalloc (sizeof (struct module));
2142       new_module->prev_module = current_module;
2143
2144       *next_module = new_module;
2145     }
2146   else
2147     {
2148       new_module = *next_module;
2149     }
2150   next_module = &new_module->next_module;
2151
2152   new_module->procedure_seen = 0;
2153   new_module->is_spec_module = is_spec_module;
2154   new_module->name = name;
2155   if (current_module)
2156     new_module->prefix_name
2157       = get_identifier3 (IDENTIFIER_POINTER (current_module->prefix_name),
2158                          "__", IDENTIFIER_POINTER (name));
2159   else
2160     new_module->prefix_name = name;
2161
2162   new_module->granted_decls = NULL_TREE;
2163   new_module->nesting_level = current_nesting_level + 1;
2164
2165   current_module = new_module;
2166   current_module_nesting_level = new_module->nesting_level;
2167   in_pseudo_module = name ? 0 : 1;
2168
2169   pushlevel (1);
2170
2171   current_scope->module_flag = 1;
2172
2173   *current_scope->enclosing->tail_child_module = current_scope;
2174   current_scope->enclosing->tail_child_module
2175     = &current_scope->next_sibling_module;
2176
2177   /* Rename the global function to have the same name as
2178      the first named non-spec module. */
2179   if (!is_spec_module
2180       && IDENTIFIER_POINTER (name)[0] != '_'
2181       && IDENTIFIER_POINTER (DECL_NAME (global_function_decl))[0] == '_')
2182     {
2183       tree fname = get_identifier3 ("", IDENTIFIER_POINTER (name), "_");
2184       DECL_NAME (global_function_decl) = fname;
2185       DECL_ASSEMBLER_NAME (global_function_decl) = fname;
2186     }
2187
2188   return name;   /* may have generated a name */
2189 }
2190 /* Make a copy of the identifier NAME, replacing each '!' by '__'. */
2191 static tree
2192 fix_identifier (name)
2193      tree name;
2194 {
2195   char *buf = (char*)alloca (2 * IDENTIFIER_LENGTH (name) + 1);
2196   int fixed = 0;
2197   register char *dptr = buf;
2198   register const char *sptr = IDENTIFIER_POINTER (name);
2199   for (; *sptr; sptr++)
2200     {
2201       if (*sptr == '!')
2202         {
2203           *dptr++ = '_';
2204           *dptr++ = '_';
2205           fixed++;
2206         }
2207       else
2208         *dptr++ = *sptr;
2209     }
2210   *dptr = '\0';
2211   return fixed ? get_identifier (buf) : name;
2212 }
2213 \f
2214 void
2215 find_granted_decls ()
2216 {
2217   if (pass == 1)
2218     {
2219       /* Match each granted name to a granted decl. */
2220
2221       tree alias = current_module->granted_decls;
2222       tree next_alias, decl;
2223       /* This is an O(M*N) algorithm.  FIXME! */
2224       for (; alias; alias = next_alias)
2225         {
2226           int found = 0;
2227           next_alias = TREE_CHAIN (alias);
2228           for (decl = current_scope->remembered_decls;
2229                decl; decl = TREE_CHAIN (decl))
2230             {
2231               tree new_name = (! DECL_NAME (decl)) ? NULL_TREE :
2232                               decl_check_rename (alias, 
2233                                                  DECL_NAME (decl));
2234
2235               if (!new_name)
2236                 continue;
2237               /* A Seized declaration is not grantable. */
2238               if (TREE_CODE (decl) == ALIAS_DECL && !CH_DECL_GRANTED (decl))
2239                 continue;
2240               found = 1;
2241               if (global_bindings_p ())
2242                 TREE_PUBLIC (decl) = 1;
2243               if (DECL_ASSEMBLER_NAME (decl) == NULL_TREE)
2244                 DECL_ASSEMBLER_NAME (decl) = fix_identifier (new_name);
2245               if (DECL_POSTFIX_ALL (alias))
2246                 {
2247                   tree new_alias
2248                     = build_alias_decl (NULL_TREE, NULL_TREE, new_name);
2249                   TREE_CHAIN (new_alias) = TREE_CHAIN (alias);
2250                   TREE_CHAIN (alias) = new_alias;
2251                   DECL_ABSTRACT_ORIGIN (new_alias) = decl;
2252                   DECL_SOURCE_LINE (new_alias) = 0;
2253                   DECL_SEIZEFILE (new_alias) = DECL_SEIZEFILE (alias);
2254                 }
2255               else
2256                 {
2257                   DECL_ABSTRACT_ORIGIN (alias) = decl;
2258                   break;
2259                 }
2260             }
2261           if (!found)
2262             {
2263               error_with_decl (alias, "nothing named `%s' to grant");
2264               DECL_ABSTRACT_ORIGIN (alias) = error_mark_node;
2265             }
2266         }
2267     }
2268 }
2269
2270 void
2271 pop_module ()
2272 {
2273   tree decl;
2274   struct scope *module_scope = current_scope;
2275
2276   poplevel (0, 0, 0);
2277
2278   if (pass == 1)
2279     {
2280       /* Write out the grant file. */
2281       if (!current_module->is_spec_module)
2282         {
2283           /* After reversal, TREE_CHAIN (last_old_decl) is the oldest
2284              decl of the current module. */
2285           write_spec_module (module_scope->remembered_decls,
2286                              current_module->granted_decls);
2287         }
2288
2289       /* Move the granted decls into the enclosing scope. */
2290       if (current_scope == global_scope)
2291         {
2292           tree next_decl;
2293           for (decl = current_module->granted_decls; decl; decl = next_decl)
2294             {
2295               tree name = DECL_NAME (decl);
2296               next_decl = TREE_CHAIN (decl);
2297               if (name != NULL_TREE)
2298                 {
2299                   tree old_decl = IDENTIFIER_OUTER_VALUE (name);
2300                   set_nesting_level (decl, current_nesting_level);
2301                   if (old_decl != NULL_TREE)
2302                     {
2303                       pedwarn_with_decl (decl, "duplicate grant for `%s'");
2304                       pedwarn_with_decl (old_decl, "previous grant for `%s'");
2305                       TREE_CHAIN (decl) = TREE_CHAIN (old_decl);
2306                       TREE_CHAIN (old_decl) = decl;
2307                     }
2308                   else
2309                     {
2310                       TREE_CHAIN (decl) = outer_decls;
2311                       outer_decls = decl;
2312                       IDENTIFIER_OUTER_VALUE (name) = decl;
2313                     }
2314                 }
2315             }
2316         }
2317       else
2318         current_scope->granted_decls = chainon (current_module->granted_decls,
2319                                                 current_scope->granted_decls);
2320     }
2321
2322   chill_check_no_handlers (); /* Sanity test */
2323   current_module = current_module->prev_module;
2324   current_module_nesting_level = current_module ?
2325     current_module->nesting_level : 0;
2326   in_pseudo_module = 0;
2327 }
2328 \f
2329 /* Nonzero if we are currently in the global binding level.  */
2330
2331 int
2332 global_bindings_p ()
2333 {
2334   /* We return -1 here for the sake of variable_size() in ../stor-layout.c. */
2335   return (current_function_decl == NULL_TREE 
2336           || current_function_decl == global_function_decl) ? -1 : 0;
2337 }
2338
2339 /* Nonzero if the current level needs to have a BLOCK made.  */
2340
2341 int
2342 kept_level_p ()
2343 {
2344   return current_scope->decls != 0;
2345 }
2346
2347 /* Make DECL visible.
2348    Save any existing definition.
2349    Check redefinitions at the same level.
2350    Suppress error messages if QUIET is true. */
2351
2352 static void
2353 proclaim_decl (decl, quiet)
2354      tree decl;
2355      int quiet;
2356 {
2357   tree name = DECL_NAME (decl);
2358   if (name)
2359     {
2360       tree old_decl = IDENTIFIER_LOCAL_VALUE (name);
2361       if (old_decl == NULL) ; /* No duplication */
2362       else if (DECL_NESTING_LEVEL (old_decl) != current_nesting_level)
2363         {
2364           /* Record for restoration when this binding level ends.  */
2365           current_scope->shadowed
2366             = tree_cons (name, old_decl, current_scope->shadowed);
2367         }
2368       else if (DECL_WEAK_NAME (decl))
2369         return;
2370       else if (!DECL_WEAK_NAME (old_decl))
2371         {
2372           tree base_decl = decl, base_old_decl = old_decl;
2373           while (TREE_CODE (base_decl) == ALIAS_DECL)
2374             base_decl = DECL_ABSTRACT_ORIGIN (base_decl);
2375           while (TREE_CODE (base_old_decl) == ALIAS_DECL)
2376             base_old_decl = DECL_ABSTRACT_ORIGIN (base_old_decl);
2377           /* Note that duplicate definitions are allowed for set elements
2378              of similar set modes.  See Z200 (1988) 12.2.2.
2379              However, if the types are identical, we are defining the
2380              same name multiple times in the same SET, which is naughty. */
2381           if (!quiet && base_decl != base_old_decl)
2382             {
2383               if (TREE_CODE (base_decl) != CONST_DECL
2384                   || TREE_CODE (base_old_decl) != CONST_DECL
2385                   || !CH_DECL_ENUM (base_decl)
2386                   || !CH_DECL_ENUM (base_old_decl)
2387                   || TREE_TYPE (base_decl) == TREE_TYPE (base_old_decl)
2388                   || !CH_SIMILAR (TREE_TYPE (base_decl),
2389                                   TREE_TYPE(base_old_decl)))
2390                 {
2391                   error_with_decl (decl, "duplicate definition `%s'");
2392                   error_with_decl (old_decl, "previous definition of `%s'");
2393                 }
2394             }
2395         }
2396       IDENTIFIER_LOCAL_VALUE (name) = decl;
2397     }
2398   /* Should be redundant most of the time ... */
2399   set_nesting_level (decl, current_nesting_level);
2400 }
2401
2402 /* Return tree_cons (NULL_TREE, ELEMENT, LIST) unless ELEMENT
2403    is already in LIST, in which case return LIST. */
2404
2405 static tree
2406 maybe_acons (element, list)
2407      tree element, list;
2408 {
2409   tree pair;
2410   for (pair = list; pair; pair = TREE_CHAIN (pair))
2411     if (element == TREE_VALUE (pair))
2412       return list;
2413   return tree_cons (NULL_TREE, element, list);
2414 }
2415
2416 struct path
2417 {
2418   struct path *prev;
2419   tree node;
2420 };
2421
2422 static tree find_implied_types            PARAMS ((tree, struct path *, tree));
2423 \f
2424 /* Look for implied types (enumeral types) implied by TYPE (a decl or type).
2425    Add these to list.
2426    Use old_path to guard against cycles. */
2427
2428 static tree
2429 find_implied_types (type, old_path, list)
2430      tree type;
2431      struct path *old_path;
2432      tree list;
2433 {
2434   struct path path[1], *link;
2435   if (type == NULL_TREE)
2436     return list;
2437   path[0].prev = old_path;
2438   path[0].node = type;
2439
2440   /* Check for a cycle.  Something more clever might be appropriate.  FIXME? */
2441   for (link = old_path; link; link = link->prev)
2442     if (link->node == type)
2443       return list;
2444
2445   switch (TREE_CODE (type))
2446     {
2447     case ENUMERAL_TYPE:
2448       return maybe_acons (type, list);
2449     case LANG_TYPE:
2450     case POINTER_TYPE:
2451     case REFERENCE_TYPE:
2452     case INTEGER_TYPE:
2453       return find_implied_types (TREE_TYPE (type), path, list);
2454     case SET_TYPE:
2455       return find_implied_types (TYPE_DOMAIN (type), path, list);
2456     case FUNCTION_TYPE:
2457 #if 0
2458     case PROCESS_TYPE:
2459 #endif
2460       { tree t;
2461         list = find_implied_types (TREE_TYPE (type), path, list);
2462         for (t = TYPE_ARG_TYPES (type); t != NULL_TREE; t = TREE_CHAIN (t))
2463           list = find_implied_types (TREE_VALUE (t), path, list);
2464         return list;
2465       }
2466     case ARRAY_TYPE:
2467       list = find_implied_types (TYPE_DOMAIN (type), path, list);
2468       return find_implied_types (TREE_TYPE (type), path, list);
2469     case RECORD_TYPE:
2470     case UNION_TYPE:
2471       { tree fields;
2472         for (fields = TYPE_FIELDS (type); fields != NULL_TREE;
2473              fields = TREE_CHAIN (fields))
2474           list = find_implied_types (TREE_TYPE (fields), path, list);
2475         return list;
2476       }
2477
2478     case IDENTIFIER_NODE:
2479       return find_implied_types (lookup_name (type), path, list);
2480       break;
2481     case ALIAS_DECL:
2482       return find_implied_types (DECL_ABSTRACT_ORIGIN (type), path, list);
2483     case VAR_DECL:
2484     case FUNCTION_DECL:
2485     case TYPE_DECL:
2486       return find_implied_types (TREE_TYPE (type), path, list);
2487     default:
2488       return list;
2489     }
2490 }
2491 \f
2492 /* Make declarations in current scope visible.
2493    Also, expand SEIZEs, and make correspondong ALIAS_DECLs visible. */
2494
2495 static void
2496 push_scope_decls (quiet)
2497      int quiet;  /* If 1, we're pre-scanning, so suppress errors. */
2498 {
2499   tree decl;
2500
2501   /* First make everything except 'SEIZE ALL' names visible, before
2502      handling 'SEIZE ALL'.  (This makes it easier to check 'seizable'). */
2503   for (decl = current_scope->remembered_decls; decl; decl = TREE_CHAIN (decl))
2504     {
2505       if (TREE_CODE (decl) == ALIAS_DECL)
2506         {
2507           if (DECL_POSTFIX_ALL (decl))
2508             continue;
2509           if (DECL_ABSTRACT_ORIGIN (decl) == NULL_TREE)
2510             {
2511               tree val = lookup_name_for_seizing (decl);
2512               if (val == NULL_TREE)
2513                 {
2514                   error_with_file_and_line
2515                     (DECL_SOURCE_FILE (decl), DECL_SOURCE_LINE (decl),
2516                      "cannot SEIZE `%s'",
2517                      IDENTIFIER_POINTER (DECL_OLD_NAME (decl)));
2518                   val = error_mark_node;
2519                 }
2520               DECL_ABSTRACT_ORIGIN (decl) = val;
2521             }
2522         }
2523       proclaim_decl (decl, quiet);
2524     }
2525
2526   pushdecllist (current_scope->granted_decls, quiet);
2527
2528   /* Now handle SEIZE ALLs. */
2529   for (decl = current_scope->remembered_decls; decl; )
2530     {
2531       tree next_decl = TREE_CHAIN (decl);
2532       if (TREE_CODE (decl) == ALIAS_DECL
2533           && DECL_ABSTRACT_ORIGIN (decl) == NULL_TREE
2534           && DECL_POSTFIX_ALL (decl))
2535         {
2536           /* We saw a "SEIZE ALL".  Replace it be a SEIZE for each
2537              declaration visible in the surrounding scope.
2538              Note that this complicates get_next_decl(). */
2539           tree candidate;
2540           tree last_new_alias = decl;
2541           DECL_ABSTRACT_ORIGIN (decl) = error_mark_node;
2542           if (current_scope->enclosing == global_scope)
2543             candidate = outer_decls;
2544           else
2545             candidate = current_scope->enclosing->decls;
2546           for ( ; candidate; candidate = TREE_CHAIN (candidate))
2547             {
2548               tree seizename = DECL_NAME (candidate);
2549               tree new_name;
2550               tree new_alias;
2551               if (!seizename)
2552                 continue;
2553               new_name = decl_check_rename (decl, seizename);
2554               if (!new_name)
2555                 continue;
2556
2557               /* Check if candidate is seizable. */
2558               if (lookup_name (new_name) != NULL_TREE)
2559                 continue;
2560
2561               new_alias = build_alias_decl (NULL_TREE,NULL_TREE, new_name);
2562               TREE_CHAIN (new_alias) = TREE_CHAIN (last_new_alias);
2563               TREE_CHAIN (last_new_alias) = new_alias;
2564               last_new_alias = new_alias;
2565               DECL_ABSTRACT_ORIGIN (new_alias) = candidate;
2566               DECL_SOURCE_LINE (new_alias) = 0;
2567
2568               proclaim_decl (new_alias, quiet);
2569             }
2570         }
2571       decl = next_decl;
2572     }
2573
2574   /* Link current_scope->remembered_decls at the head of the
2575      current_scope->decls list (just like pushdecllist, but
2576      without calling proclaim_decl, since we've already done that). */
2577   if ((decl = current_scope->remembered_decls) != NULL_TREE)
2578     {
2579       while (TREE_CHAIN (decl) != NULL_TREE)
2580         decl = TREE_CHAIN (decl);
2581       TREE_CHAIN (decl) = current_scope->decls;
2582       current_scope->decls = current_scope->remembered_decls;
2583     }
2584 }
2585
2586 static void
2587 pop_scope_decls (decls_limit, shadowed_limit)
2588      tree decls_limit, shadowed_limit;
2589 {
2590   /* Remove the temporary bindings we made. */
2591   tree link = current_scope->shadowed;
2592   tree decl = current_scope->decls;
2593   if (decl != decls_limit)
2594     {
2595       while (decl != decls_limit)
2596         {
2597           tree next = TREE_CHAIN (decl);
2598           if (DECL_NAME (decl))
2599             {
2600               /* If the ident. was used or addressed via a local extern decl,
2601                  don't forget that fact.  */
2602               if (DECL_EXTERNAL (decl))
2603                 {
2604                   if (TREE_USED (decl))
2605                     TREE_USED (DECL_NAME (decl)) = 1;
2606                   if (TREE_ADDRESSABLE (decl))
2607                     TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (decl)) = 1;
2608                 }
2609               IDENTIFIER_LOCAL_VALUE (DECL_NAME (decl)) = 0;
2610             }
2611           if (next == decls_limit)
2612             {
2613               TREE_CHAIN (decl) = NULL_TREE;
2614               break;
2615             }
2616           decl = next;
2617         }
2618       current_scope->decls = decls_limit;
2619     }
2620   
2621   /* Restore all name-meanings of the outer levels
2622      that were shadowed by this level.  */
2623   for ( ; link != shadowed_limit; link = TREE_CHAIN (link))
2624     IDENTIFIER_LOCAL_VALUE (TREE_PURPOSE (link)) = TREE_VALUE (link);
2625   current_scope->shadowed = shadowed_limit;
2626 }
2627
2628 /* Return list of weak names (as ALIAS_DECLs) implied by IMPLIED_TYPES. */
2629
2630 static tree
2631 build_implied_names (implied_types)
2632      tree implied_types;
2633 {
2634   tree aliases = NULL_TREE;
2635
2636   for ( ; implied_types; implied_types = TREE_CHAIN (implied_types))
2637     {
2638       tree enum_type = TREE_VALUE (implied_types);
2639       tree link = TYPE_VALUES (enum_type);
2640       if (TREE_CODE (enum_type) != ENUMERAL_TYPE)
2641         abort ();
2642       
2643       for ( ; link; link = TREE_CHAIN (link))
2644         {
2645           /* We don't handle renaming/prefixes (Blue Book p 163) FIXME */
2646           /* Note that before enum_type is laid out, TREE_VALUE (link)
2647              is a CONST_DECL, while after it is laid out,
2648              TREE_VALUE (link) is an INTEGER_CST.  Either works. */
2649           tree alias
2650             = build_alias_decl (NULL_TREE, NULL_TREE, TREE_PURPOSE (link));
2651           DECL_ABSTRACT_ORIGIN (alias) = TREE_VALUE (link);
2652           DECL_WEAK_NAME (alias) = 1;
2653           TREE_CHAIN (alias) = aliases;
2654           aliases = alias;
2655           /* Strictlt speaking, we should have a pointer from the alias
2656              to the decl, so we can make sure that the alias is only
2657              visible when the decl is.  FIXME */
2658         }
2659     }
2660   return aliases;
2661 }
2662
2663 static void
2664 bind_sub_modules (do_weak)
2665      int do_weak;
2666 {
2667   tree decl;
2668   int save_module_nesting_level = current_module_nesting_level;
2669   struct scope *saved_scope = current_scope;
2670   struct scope *nested_module = current_scope->first_child_module;
2671
2672   while (nested_module != NULL)
2673     {
2674       tree saved_shadowed = nested_module->shadowed;
2675       tree saved_decls = nested_module->decls;
2676       current_nesting_level++;
2677       current_scope = nested_module;
2678       current_module_nesting_level = current_nesting_level;
2679       if (do_weak == 0)
2680         push_scope_decls (1);
2681       else
2682         {
2683           tree implied_types = NULL_TREE;
2684           /* Push weak names implied by decls in current_scope. */
2685           for (decl = current_scope->remembered_decls;
2686                decl; decl = TREE_CHAIN (decl))
2687             if (TREE_CODE (decl) == ALIAS_DECL)
2688               implied_types = find_implied_types (decl, NULL, implied_types);
2689           for (decl = current_scope->granted_decls;
2690                decl; decl = TREE_CHAIN (decl))
2691             implied_types = find_implied_types (decl, NULL, implied_types);
2692           current_scope->weak_decls = build_implied_names (implied_types);
2693           pushdecllist (current_scope->weak_decls, 1);
2694         }
2695
2696       bind_sub_modules (do_weak);
2697       for (decl = current_scope->remembered_decls;
2698            decl; decl = TREE_CHAIN (decl))
2699         satisfy_decl (decl, 1);
2700       pop_scope_decls (saved_decls, saved_shadowed);
2701       current_nesting_level--;
2702       nested_module = nested_module->next_sibling_module;
2703     }
2704
2705   current_scope = saved_scope;
2706   current_module_nesting_level = save_module_nesting_level;
2707 }
2708 \f
2709 /* Enter a new binding level.
2710    If two_pass==0, assume we are called from non-Chill-specific parts
2711    of the compiler.  These parts assume a single pass.
2712    If two_pass==1,  we're called from Chill parts of the compiler.
2713 */
2714
2715 void
2716 pushlevel (two_pass)
2717      int two_pass;
2718 {
2719   register struct scope *newlevel;
2720
2721   current_nesting_level++;
2722   if (!two_pass)
2723     {
2724       newlevel = (struct scope *)xmalloc (sizeof(struct scope));
2725       *newlevel = clear_scope;
2726       newlevel->enclosing = current_scope;
2727       current_scope = newlevel;
2728     }
2729   else if (pass < 2)
2730     {
2731       newlevel = (struct scope *)permalloc (sizeof(struct scope));
2732       *newlevel = clear_scope;
2733       newlevel->tail_child_module = &newlevel->first_child_module;
2734       newlevel->enclosing = current_scope;
2735       current_scope = newlevel;
2736       last_scope->next = newlevel;
2737       last_scope = newlevel;
2738     }
2739   else /* pass == 2 */
2740     {
2741       tree decl;
2742       newlevel = current_scope = last_scope = last_scope->next;
2743
2744       push_scope_decls (0);
2745       pushdecllist (current_scope->weak_decls, 0);
2746
2747       /* If this is not a module scope, scan ahead for locally nested
2748          modules.  (If this is a module, that's already done.) */
2749       if (!current_scope->module_flag)
2750         {
2751           bind_sub_modules (0);
2752           bind_sub_modules (1);
2753         }
2754
2755       for (decl = current_scope->remembered_decls;
2756            decl; decl = TREE_CHAIN (decl))
2757         satisfy_decl (decl, 0);
2758     }
2759
2760   /* Add this level to the front of the chain (stack) of levels that
2761      are active.  */
2762
2763   newlevel->level_chain = current_scope;
2764   current_scope = newlevel;
2765
2766   newlevel->two_pass = two_pass;
2767 }
2768 \f
2769 /* Exit a binding level.
2770    Pop the level off, and restore the state of the identifier-decl mappings
2771    that were in effect when this level was entered.
2772
2773    If KEEP is nonzero, this level had explicit declarations, so
2774    and create a "block" (a BLOCK node) for the level
2775    to record its declarations and subblocks for symbol table output.
2776
2777    If FUNCTIONBODY is nonzero, this level is the body of a function,
2778    so create a block as if KEEP were set and also clear out all
2779    label names.
2780
2781    If REVERSE is nonzero, reverse the order of decls before putting
2782    them into the BLOCK.  */
2783
2784 tree
2785 poplevel (keep, reverse, functionbody)
2786      int keep;
2787      int reverse;
2788      int functionbody;
2789 {
2790   register tree link;
2791   /* The chain of decls was accumulated in reverse order.
2792      Put it into forward order, just for cleanliness.  */
2793   tree decls;
2794   tree subblocks;
2795   tree block = 0;
2796   tree decl;
2797   int block_previously_created = 0;
2798
2799   if (current_scope == NULL)
2800     return error_mark_node;
2801
2802   subblocks = current_scope->blocks;
2803
2804   /* Get the decls in the order they were written.
2805      Usually current_scope->decls is in reverse order.
2806      But parameter decls were previously put in forward order.  */
2807
2808   if (reverse)
2809     current_scope->decls
2810       = decls = nreverse (current_scope->decls);
2811   else
2812     decls = current_scope->decls;
2813
2814   if (pass == 2)
2815     {
2816       /* Output any nested inline functions within this block
2817          if they weren't already output.  */
2818
2819       for (decl = decls; decl; decl = TREE_CHAIN (decl))
2820         if (TREE_CODE (decl) == FUNCTION_DECL
2821             && ! TREE_ASM_WRITTEN (decl)
2822             && DECL_INITIAL (decl) != 0
2823             && TREE_ADDRESSABLE (decl))
2824           {
2825             /* If this decl was copied from a file-scope decl
2826                on account of a block-scope extern decl,
2827                propagate TREE_ADDRESSABLE to the file-scope decl.  */
2828             if (DECL_ABSTRACT_ORIGIN (decl) != 0)
2829               TREE_ADDRESSABLE (DECL_ABSTRACT_ORIGIN (decl)) = 1;
2830             else
2831               {
2832                 push_function_context ();
2833                 output_inline_function (decl);
2834                 pop_function_context ();
2835               }
2836           }
2837
2838       /* Clear out the meanings of the local variables of this level.  */
2839       pop_scope_decls (NULL_TREE, NULL_TREE);
2840
2841       /* If there were any declarations or structure tags in that level,
2842          or if this level is a function body,
2843          create a BLOCK to record them for the life of this function.  */
2844
2845       block = 0;
2846       block_previously_created = (current_scope->this_block != 0);
2847       if (block_previously_created)
2848         block = current_scope->this_block;
2849       else if (keep || functionbody)
2850         block = make_node (BLOCK);
2851       if (block != 0)
2852         {
2853           tree *ptr;
2854           BLOCK_VARS (block) = decls;
2855
2856           /* Splice out ALIAS_DECL and LABEL_DECLs,
2857              since instantiate_decls can't handle them. */
2858           for (ptr = &BLOCK_VARS (block); *ptr; )
2859             {
2860               decl = *ptr;
2861               if (TREE_CODE (decl) == ALIAS_DECL
2862                   || TREE_CODE (decl) == LABEL_DECL)
2863                 *ptr = TREE_CHAIN (decl);
2864               else
2865                 ptr = &TREE_CHAIN(*ptr);
2866             }
2867
2868           BLOCK_SUBBLOCKS (block) = subblocks;
2869         }
2870
2871       /* In each subblock, record that this is its superior.  */
2872
2873       for (link = subblocks; link; link = TREE_CHAIN (link))
2874         BLOCK_SUPERCONTEXT (link) = block;
2875
2876     }
2877
2878   /* If the level being exited is the top level of a function,
2879      check over all the labels, and clear out the current
2880      (function local) meanings of their names.  */
2881
2882   if (pass == 2 && functionbody)
2883     {
2884       /* If this is the top level block of a function,
2885          the vars are the function's parameters.
2886          Don't leave them in the BLOCK because they are
2887          found in the FUNCTION_DECL instead.  */
2888
2889       BLOCK_VARS (block) = 0;
2890
2891 #if 0
2892       /* Clear out the definitions of all label names,
2893          since their scopes end here,
2894          and add them to BLOCK_VARS.  */
2895
2896       for (link = named_labels; link; link = TREE_CHAIN (link))
2897         {
2898           register tree label = TREE_VALUE (link);
2899
2900           if (DECL_INITIAL (label) == 0)
2901             {
2902               error_with_decl (label, "label `%s' used but not defined");
2903               /* Avoid crashing later.  */
2904               define_label (input_filename, lineno,
2905                             DECL_NAME (label));
2906             }
2907           else if (warn_unused_label && !TREE_USED (label))
2908             warning_with_decl (label, "label `%s' defined but not used");
2909           IDENTIFIER_LABEL_VALUE (DECL_NAME (label)) = 0;
2910
2911           /* Put the labels into the "variables" of the
2912              top-level block, so debugger can see them.  */
2913           TREE_CHAIN (label) = BLOCK_VARS (block);
2914           BLOCK_VARS (block) = label;
2915         }
2916 #endif
2917     }
2918
2919   if (pass < 2)
2920     {
2921       current_scope->remembered_decls
2922         = nreverse (current_scope->remembered_decls);
2923       current_scope->granted_decls = nreverse (current_scope->granted_decls);
2924     }
2925
2926   current_scope = current_scope->enclosing;
2927   current_nesting_level--;
2928
2929   if (pass < 2)
2930     {
2931       return NULL_TREE;
2932     }
2933
2934   /* Dispose of the block that we just made inside some higher level.  */
2935   if (functionbody)
2936     DECL_INITIAL (current_function_decl) = block;
2937   else if (block)
2938     {
2939       if (!block_previously_created)
2940         current_scope->blocks
2941           = chainon (current_scope->blocks, block);
2942     }
2943   /* If we did not make a block for the level just exited,
2944      any blocks made for inner levels
2945      (since they cannot be recorded as subblocks in that level)
2946      must be carried forward so they will later become subblocks
2947      of something else.  */
2948   else if (subblocks)
2949     current_scope->blocks
2950       = chainon (current_scope->blocks, subblocks);
2951
2952   if (block)
2953     TREE_USED (block) = 1;
2954   return block;
2955 }
2956 \f
2957 /* Delete the node BLOCK from the current binding level.
2958    This is used for the block inside a stmt expr ({...})
2959    so that the block can be reinserted where appropriate.  */
2960
2961 void
2962 delete_block (block)
2963      tree block;
2964 {
2965   tree t;
2966   if (current_scope->blocks == block)
2967     current_scope->blocks = TREE_CHAIN (block);
2968   for (t = current_scope->blocks; t;)
2969     {
2970       if (TREE_CHAIN (t) == block)
2971         TREE_CHAIN (t) = TREE_CHAIN (block);
2972       else
2973         t = TREE_CHAIN (t);
2974     }
2975   TREE_CHAIN (block) = NULL;
2976   /* Clear TREE_USED which is always set by poplevel.
2977      The flag is set again if insert_block is called.  */
2978   TREE_USED (block) = 0;
2979 }
2980
2981 /* Insert BLOCK at the end of the list of subblocks of the
2982    current binding level.  This is used when a BIND_EXPR is expanded,
2983    to handle the BLOCK node inside teh BIND_EXPR.  */
2984
2985 void
2986 insert_block (block)
2987      tree block;
2988 {
2989   TREE_USED (block) = 1;
2990   current_scope->blocks
2991     = chainon (current_scope->blocks, block);
2992 }
2993
2994 /* Set the BLOCK node for the innermost scope
2995    (the one we are currently in).  */
2996
2997 void
2998 set_block (block)
2999      register tree block;
3000 {
3001   current_scope->this_block = block;
3002   current_scope->decls = chainon (current_scope->decls, BLOCK_VARS (block));
3003   current_scope->blocks = chainon (current_scope->blocks,
3004                                    BLOCK_SUBBLOCKS (block));
3005 }
3006 \f
3007 /* Record a decl-node X as belonging to the current lexical scope.
3008    Check for errors (such as an incompatible declaration for the same
3009    name already seen in the same scope).
3010
3011    Returns either X or an old decl for the same name.
3012    If an old decl is returned, it may have been smashed
3013    to agree with what X says. */
3014
3015 tree
3016 pushdecl (x)
3017      tree x;
3018 {
3019   register tree name = DECL_NAME (x);
3020   register struct scope *b = current_scope;
3021
3022   DECL_CONTEXT (x) = current_function_decl;
3023   /* A local extern declaration for a function doesn't constitute nesting.
3024      A local auto declaration does, since it's a forward decl
3025      for a nested function coming later.  */
3026   if (TREE_CODE (x) == FUNCTION_DECL && DECL_INITIAL (x) == 0
3027       && DECL_EXTERNAL (x))
3028     DECL_CONTEXT (x) = 0;
3029
3030   if (name)
3031     proclaim_decl (x, 0);
3032
3033   if (TREE_CODE (x) == TYPE_DECL && DECL_SOURCE_LINE (x) == 0
3034       && TYPE_NAME (TREE_TYPE (x)) == 0)
3035     TYPE_NAME (TREE_TYPE (x)) = x;
3036
3037   /* Put decls on list in reverse order.
3038      We will reverse them later if necessary.  */
3039   TREE_CHAIN (x) = b->decls;
3040   b->decls = x;
3041
3042   return x;
3043 }
3044 \f
3045 /* Make DECLS (a chain of decls) visible in the current_scope. */
3046
3047 static void
3048 pushdecllist (decls, quiet)
3049      tree decls;
3050      int quiet;
3051 {
3052   tree last = NULL_TREE, decl;
3053
3054   for (decl = decls; decl != NULL_TREE; 
3055        last = decl, decl = TREE_CHAIN (decl))
3056     {
3057       proclaim_decl (decl, quiet);
3058     }
3059
3060   if (last)
3061     {
3062       TREE_CHAIN (last) = current_scope->decls;
3063       current_scope->decls = decls;
3064     }
3065 }
3066
3067 /* Like pushdecl, only it places X in GLOBAL_SCOPE, if appropriate.  */
3068
3069 tree
3070 pushdecl_top_level (x)
3071      tree x;
3072 {
3073   register tree t;
3074   register struct scope *b = current_scope;
3075
3076   current_scope = global_scope;
3077   t = pushdecl (x);
3078   current_scope = b;
3079   return t;
3080 }
3081 \f
3082 /* Define a label, specifying the location in the source file.
3083    Return the LABEL_DECL node for the label, if the definition is valid.
3084    Otherwise return 0.  */
3085
3086 tree
3087 define_label (filename, line, name)
3088      const char *filename;
3089      int line;
3090      tree name;
3091 {
3092   tree decl;
3093
3094   if (pass == 1)
3095     {
3096       decl = build_decl (LABEL_DECL, name, void_type_node);
3097
3098       /* A label not explicitly declared must be local to where it's ref'd.  */
3099       DECL_CONTEXT (decl) = current_function_decl;
3100
3101       DECL_MODE (decl) = VOIDmode;
3102
3103       /* Say where one reference is to the label,
3104          for the sake of the error if it is not defined.  */
3105       DECL_SOURCE_LINE (decl) = line;
3106       DECL_SOURCE_FILE (decl) = filename;
3107
3108       /* Mark label as having been defined.  */
3109       DECL_INITIAL (decl) = error_mark_node;
3110
3111       DECL_ACTION_NESTING_LEVEL (decl) = action_nesting_level;
3112
3113       save_decl (decl);
3114     }
3115   else
3116     {
3117       decl = get_next_decl ();
3118       /* Make sure every label has an rtx.  */
3119
3120       label_rtx (decl);
3121       expand_label (decl);
3122     }
3123   return decl;
3124 }
3125 \f
3126 /* Return the list of declarations of the current level.
3127    Note that this list is in reverse order unless/until
3128    you nreverse it; and when you do nreverse it, you must
3129    store the result back using `storedecls' or you will lose.  */
3130
3131 tree
3132 getdecls ()
3133 {
3134   /* This is a kludge, so that dbxout_init can get the predefined types,
3135      which are in the builtin_scope, though when it is called,
3136      the current_scope is the global_scope.. */
3137   if (current_scope == global_scope)
3138     return builtin_scope.decls;
3139   return current_scope->decls;
3140 }
3141
3142 #if 0
3143 /* Store the list of declarations of the current level.
3144    This is done for the parameter declarations of a function being defined,
3145    after they are modified in the light of any missing parameters.  */
3146
3147 static void
3148 storedecls (decls)
3149      tree decls;
3150 {
3151   current_scope->decls = decls;
3152 }
3153 #endif
3154 \f
3155 /* Look up NAME in the current binding level and its superiors
3156    in the namespace of variables, functions and typedefs.
3157    Return a ..._DECL node of some kind representing its definition,
3158    or return 0 if it is undefined.  */
3159
3160 tree
3161 lookup_name (name)
3162      tree name;
3163 {
3164   register tree val = IDENTIFIER_LOCAL_VALUE (name);
3165
3166   if (val == NULL_TREE)
3167     return NULL_TREE;
3168   if (TREE_CODE_CLASS (TREE_CODE (val)) == 'c')
3169     return val;
3170   if (DECL_NESTING_LEVEL (val) > BUILTIN_NESTING_LEVEL
3171       && DECL_NESTING_LEVEL (val) < current_module_nesting_level)
3172     {
3173       return NULL_TREE;
3174     }
3175   while (TREE_CODE (val) == ALIAS_DECL)
3176     {
3177       val = DECL_ABSTRACT_ORIGIN (val);
3178       if (TREE_CODE (val) == ERROR_MARK)
3179         return NULL_TREE;
3180     }
3181   if (TREE_CODE (val) == BASED_DECL)
3182     {
3183       return build_chill_indirect_ref (DECL_ABSTRACT_ORIGIN (val),
3184                                        TREE_TYPE (val), 1);
3185     }
3186   if (TREE_CODE (val) == WITH_DECL)
3187     return build_component_ref (DECL_ABSTRACT_ORIGIN (val), DECL_NAME (val));
3188   return val;
3189 }
3190
3191 #if 0
3192 /* Similar to `lookup_name' but look only at current binding level.  */
3193
3194 static tree
3195 lookup_name_current_level (name)
3196      tree name;
3197 {
3198   register tree val = IDENTIFIER_LOCAL_VALUE (name);
3199   if (val && DECL_NESTING_LEVEL (val) == current_nesting_level)
3200     return val;
3201   return NULL_TREE;
3202 }
3203 #endif
3204
3205 static tree
3206 lookup_name_for_seizing (seize_decl)
3207      tree seize_decl;
3208 {
3209   tree name = DECL_OLD_NAME (seize_decl);
3210   register tree val;
3211   val = IDENTIFIER_LOCAL_VALUE (name);
3212   if (val == NULL_TREE || DECL_NESTING_LEVEL (val) == BUILTIN_NESTING_LEVEL)
3213     {
3214       val = IDENTIFIER_OUTER_VALUE (name);
3215       if (val == NULL_TREE)
3216         return NULL_TREE;
3217       if (TREE_CHAIN (val) && DECL_NAME (TREE_CHAIN (val)) == name)
3218         { /* More than one decl with the same name has been granted
3219              into the same global scope.  Pick the one (we hope) that
3220              came from a seizefile the matches the most recent
3221              seizefile (as given by DECL_SEIZEFILE (seize_decl).) */
3222           tree d, best = NULL_TREE;
3223           for (d = val; d != NULL_TREE && DECL_NAME (d) == name;
3224                d = TREE_CHAIN (d))
3225             if (DECL_SEIZEFILE (d) == DECL_SEIZEFILE (seize_decl))
3226               {
3227                 if (best)
3228                   {
3229                     error_with_decl (seize_decl,
3230                                      "ambiguous choice for seize `%s' -");
3231                     error_with_decl (best, " - can seize this `%s' -");
3232                     error_with_decl (d, " - or this granted decl `%s'");
3233                     return NULL_TREE;
3234                   }
3235                 best = d;
3236               }
3237           if (best == NULL_TREE)
3238             {
3239               error_with_decl (seize_decl,
3240                                "ambiguous choice for seize `%s' -");
3241               error_with_decl (val, " - can seize this `%s' -");
3242               error_with_decl (TREE_CHAIN (val),
3243                                " - or this granted decl `%s'");
3244               return NULL_TREE;
3245             }
3246           val = best;
3247         }
3248     }
3249 #if 0
3250   /* We don't need to handle this, as long as we
3251      resolve the seize targets before pushing them. */
3252   if (DECL_NESTING_LEVEL (val) >= current_module_nesting_level)
3253     {
3254       /* VAL was declared inside current module.  We need something
3255          from the scope *enclosing* the current module, so search
3256          through the shadowed declarations. */
3257       /* TODO - FIXME */
3258     }
3259 #endif
3260   if (current_module && current_module->prev_module
3261       && DECL_NESTING_LEVEL (val)
3262       < current_module->prev_module->nesting_level)
3263     {
3264
3265       /* It's declared in a scope enclosing the module enclosing
3266          the current module.  Hence it's not visible. */
3267       return NULL_TREE;
3268     }
3269   while (TREE_CODE (val) == ALIAS_DECL)
3270     {
3271       val = DECL_ABSTRACT_ORIGIN (val);
3272       if (TREE_CODE (val) == ERROR_MARK)
3273         return NULL_TREE;
3274     }
3275   return val;
3276 }
3277 \f
3278 /* Create the predefined scalar types of C,
3279    and some nodes representing standard constants (0, 1, (void *)0).
3280    Initialize the global binding level.
3281    Make definitions for built-in primitive functions.  */
3282
3283 void
3284 init_decl_processing ()
3285 {
3286   int  wchar_type_size;
3287   tree bool_ftype_int_ptr_int;
3288   tree bool_ftype_int_ptr_int_int;
3289   tree bool_ftype_luns_ptr_luns_long;
3290   tree bool_ftype_luns_ptr_luns_long_ptr_int;
3291   tree bool_ftype_ptr_int_ptr_int;
3292   tree bool_ftype_ptr_int_ptr_int_int;
3293   tree find_bit_ftype;
3294   tree bool_ftype_ptr_ptr_int;
3295   tree bool_ftype_ptr_ptr_luns;
3296   tree bool_ftype_ptr_ptr_ptr_luns;
3297   tree endlink;
3298   tree int_ftype_int;
3299   tree int_ftype_int_int;
3300   tree int_ftype_int_ptr_int;
3301   tree int_ftype_ptr;
3302   tree int_ftype_ptr_int;
3303   tree int_ftype_ptr_int_int_ptr_int;
3304   tree int_ftype_ptr_luns_long_ptr_int;
3305   tree int_ftype_ptr_ptr_int;
3306   tree int_ftype_ptr_ptr_luns;
3307   tree long_ftype_ptr_luns;
3308   tree memcpy_ftype;
3309   tree memcmp_ftype;
3310   tree ptr_ftype_ptr_int_int;
3311   tree ptr_ftype_ptr_ptr_int;
3312   tree ptr_ftype_ptr_ptr_int_ptr_int;
3313   tree real_ftype_real;
3314   tree temp;
3315   tree void_ftype_cptr_cptr_int;
3316   tree void_ftype_long_int_ptr_int_ptr_int;
3317   tree void_ftype_ptr;
3318   tree void_ftype_ptr_int_int_int_int;
3319   tree void_ftype_ptr_int_ptr_int_int_int;
3320   tree void_ftype_ptr_int_ptr_int_ptr_int;
3321   tree void_ftype_ptr_luns_long_long_bool_ptr_int;
3322   tree void_ftype_ptr_luns_ptr_luns_luns_luns;
3323   tree void_ftype_ptr_ptr_ptr_int;
3324   tree void_ftype_ptr_ptr_ptr_luns;
3325   tree void_ftype_refptr_int_ptr_int;
3326   tree void_ftype_void;
3327   tree void_ftype_ptr_ptr_int;
3328   tree void_ftype_ptr_luns_luns_cptr_luns_luns_luns;
3329   tree ptr_ftype_luns_ptr_int;
3330   tree double_ftype_double;
3331
3332   /* allow 0-255 enums to occupy only a byte */
3333   flag_short_enums = 1;
3334
3335   current_function_decl = NULL;
3336
3337   set_alignment = BITS_PER_UNIT;
3338
3339   ALL_POSTFIX = get_identifier ("*");
3340   string_index_type_dummy = get_identifier("%string-index%");
3341
3342   var_length_id = get_identifier (VAR_LENGTH);
3343   var_data_id = get_identifier (VAR_DATA);
3344
3345   build_common_tree_nodes (1);
3346
3347   if (CHILL_INT_IS_SHORT)
3348     long_integer_type_node = integer_type_node;
3349   else
3350     long_integer_type_node = make_signed_type (LONG_TYPE_SIZE);
3351
3352   /* `unsigned long' is the standard type for sizeof.
3353      Note that stddef.h uses `unsigned long',
3354      and this must agree, even of long and int are the same size.  */
3355 #ifndef SIZE_TYPE
3356   set_sizetype (long_unsigned_type_node);
3357 #else
3358   {
3359     const char *size_type_c_name = SIZE_TYPE;
3360     if (strncmp (size_type_c_name, "long long ", 10) == 0)
3361       set_sizetype (long_long_unsigned_type_node);
3362     else if (strncmp (size_type_c_name, "long ", 5) == 0)
3363       set_sizetype (long_unsigned_type_node);
3364     else
3365       set_sizetype (unsigned_type_node);
3366   }
3367 #endif
3368
3369   pushdecl (build_decl (TYPE_DECL, ridpointers[(int) RID_FLOAT],
3370                         float_type_node));
3371   pushdecl (build_decl (TYPE_DECL, ridpointers[(int) RID_DOUBLE],
3372                         double_type_node));
3373
3374   build_common_tree_nodes_2 (flag_short_double);
3375
3376   pushdecl (build_decl (TYPE_DECL,
3377                         ridpointers[(int) RID_VOID], void_type_node));
3378   /* We are not going to have real types in C with less than byte alignment,
3379      so we might as well not have any types that claim to have it.  */
3380   TYPE_ALIGN (void_type_node) = BITS_PER_UNIT;
3381   TYPE_USER_ALIGN (void_type_node) = 0;
3382
3383   /* This is for wide string constants.  */
3384   wchar_type_node = short_unsigned_type_node;
3385   wchar_type_size = TYPE_PRECISION (wchar_type_node);
3386   signed_wchar_type_node = type_for_size (wchar_type_size, 0);
3387   unsigned_wchar_type_node = type_for_size (wchar_type_size, 1);
3388
3389   default_function_type
3390     = build_function_type (integer_type_node, NULL_TREE);
3391
3392   ptr_type_node = build_pointer_type (void_type_node);
3393   const_ptr_type_node
3394     = build_pointer_type (build_type_variant (void_type_node, 1, 0));
3395
3396   void_list_node = build_tree_list (NULL_TREE, void_type_node);
3397
3398   boolean_type_node = make_node (BOOLEAN_TYPE);
3399   TYPE_PRECISION (boolean_type_node) = 1;
3400   fixup_unsigned_type (boolean_type_node);
3401   boolean_false_node = TYPE_MIN_VALUE (boolean_type_node);
3402   boolean_true_node = TYPE_MAX_VALUE (boolean_type_node);
3403   pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_BOOL],
3404                         boolean_type_node));
3405
3406   /* TRUE and FALSE have the BOOL derived class */
3407   CH_DERIVED_FLAG (boolean_true_node) = 1;
3408   CH_DERIVED_FLAG (boolean_false_node) = 1;
3409
3410   signed_boolean_type_node = make_node (BOOLEAN_TYPE);
3411   temp = build_int_2 (-1, -1);
3412   TREE_TYPE (temp) = signed_boolean_type_node;
3413   TYPE_MIN_VALUE (signed_boolean_type_node) = temp;
3414   temp = build_int_2 (0, 0);
3415   TREE_TYPE (temp) = signed_boolean_type_node;
3416   TYPE_MAX_VALUE (signed_boolean_type_node) = temp;
3417   layout_type (signed_boolean_type_node);
3418
3419  
3420   bitstring_one_type_node = build_bitstring_type (integer_one_node);
3421   bit_zero_node = build (CONSTRUCTOR, bitstring_one_type_node, NULL_TREE,
3422                          NULL_TREE);
3423   bit_one_node = build (CONSTRUCTOR, bitstring_one_type_node, NULL_TREE,
3424                         build_tree_list (NULL_TREE, integer_zero_node));
3425
3426   pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_CHAR],
3427                         char_type_node));
3428
3429   if (CHILL_INT_IS_SHORT)
3430     {
3431       chill_integer_type_node = short_integer_type_node;
3432       chill_unsigned_type_node = short_unsigned_type_node;
3433     }
3434   else
3435     {
3436       chill_integer_type_node = integer_type_node;
3437       chill_unsigned_type_node = unsigned_type_node;
3438     }
3439
3440   string_one_type_node = build_string_type (char_type_node, integer_one_node);
3441
3442   pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_BYTE],
3443                         signed_char_type_node));
3444   pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_UBYTE],
3445                         unsigned_char_type_node));
3446
3447   pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_INT],
3448                         chill_integer_type_node));
3449
3450   pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_UINT],
3451                         chill_unsigned_type_node));
3452
3453   pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_LONG],
3454                         long_integer_type_node));
3455
3456   set_sizetype (long_integer_type_node);
3457 #if 0
3458   ptrdiff_type_node
3459     = TREE_TYPE (IDENTIFIER_LOCAL_VALUE (get_identifier (PTRDIFF_TYPE)));
3460 #endif
3461   pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_ULONG],
3462                         long_unsigned_type_node));
3463   pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_REAL],
3464                         float_type_node));
3465   pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_LONG_REAL],
3466                         double_type_node));
3467   pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_PTR],
3468                         ptr_type_node));
3469
3470   IDENTIFIER_LOCAL_VALUE (ridpointers[(int)RID_TRUE]) =
3471     boolean_true_node;    
3472   IDENTIFIER_LOCAL_VALUE (ridpointers[(int)RID_FALSE]) =
3473     boolean_false_node;    
3474   IDENTIFIER_LOCAL_VALUE (ridpointers[(int)RID_NULL]) =
3475     null_pointer_node;    
3476
3477   /* The second operand is set to non-NULL to distinguish
3478      (ELSE) from (*).  Used when writing grant files.  */
3479   case_else_node = build (RANGE_EXPR,
3480                           NULL_TREE, NULL_TREE, boolean_false_node);
3481
3482   pushdecl (temp = build_decl (TYPE_DECL,
3483                      get_identifier ("__tmp_initializer"),
3484                        build_init_struct ()));
3485   DECL_SOURCE_LINE (temp) = 0;
3486   initializer_type = TREE_TYPE (temp);
3487
3488   boolean_code_name = (const char **) xcalloc (sizeof (char *),
3489                                                (int) LAST_CHILL_TREE_CODE);
3490
3491   boolean_code_name[EQ_EXPR] = "=";
3492   boolean_code_name[NE_EXPR] = "/=";
3493   boolean_code_name[LT_EXPR] = "<";
3494   boolean_code_name[GT_EXPR] = ">";
3495   boolean_code_name[LE_EXPR] = "<=";
3496   boolean_code_name[GE_EXPR] = ">=";
3497   boolean_code_name[SET_IN_EXPR] = "in";
3498   boolean_code_name[TRUTH_ANDIF_EXPR] = "andif";
3499   boolean_code_name[TRUTH_ORIF_EXPR] = "orif";
3500   boolean_code_name[TRUTH_AND_EXPR] = "and";
3501   boolean_code_name[TRUTH_OR_EXPR] = "or";
3502   boolean_code_name[BIT_AND_EXPR] = "and";
3503   boolean_code_name[BIT_IOR_EXPR] = "or";
3504   boolean_code_name[BIT_XOR_EXPR] = "xor";
3505
3506   endlink = void_list_node;
3507
3508   chill_predefined_function_type
3509     = build_function_type (integer_type_node,
3510        tree_cons (NULL_TREE, integer_type_node,
3511          endlink));
3512
3513   bool_ftype_int_ptr_int
3514     = build_function_type (boolean_type_node,
3515           tree_cons (NULL_TREE, integer_type_node,
3516               tree_cons (NULL_TREE, ptr_type_node,
3517                   tree_cons (NULL_TREE, integer_type_node,
3518                       endlink))));
3519   bool_ftype_int_ptr_int
3520     = build_function_type (boolean_type_node,
3521           tree_cons (NULL_TREE, integer_type_node,
3522               tree_cons (NULL_TREE, ptr_type_node,
3523                   tree_cons (NULL_TREE, integer_type_node,
3524                       tree_cons (NULL_TREE, integer_type_node,
3525                           endlink)))));
3526   bool_ftype_int_ptr_int_int
3527     = build_function_type (boolean_type_node,
3528           tree_cons (NULL_TREE, integer_type_node,
3529               tree_cons (NULL_TREE, ptr_type_node,
3530                       tree_cons (NULL_TREE, integer_type_node,
3531                           tree_cons (NULL_TREE, integer_type_node,
3532                               endlink)))));
3533   bool_ftype_luns_ptr_luns_long
3534     = build_function_type (boolean_type_node,
3535           tree_cons (NULL_TREE, long_unsigned_type_node,
3536               tree_cons (NULL_TREE, ptr_type_node,
3537                       tree_cons (NULL_TREE, long_unsigned_type_node,
3538                           tree_cons (NULL_TREE, long_integer_type_node,
3539                               endlink)))));
3540   bool_ftype_luns_ptr_luns_long_ptr_int
3541     = build_function_type (boolean_type_node,
3542           tree_cons (NULL_TREE, long_unsigned_type_node,
3543               tree_cons (NULL_TREE, ptr_type_node,
3544                       tree_cons (NULL_TREE, long_unsigned_type_node,
3545                           tree_cons (NULL_TREE, long_integer_type_node,
3546                               tree_cons (NULL_TREE, ptr_type_node,
3547                                   tree_cons (NULL_TREE, integer_type_node,
3548                                       endlink)))))));
3549   bool_ftype_ptr_ptr_int
3550     = build_function_type (boolean_type_node,
3551           tree_cons (NULL_TREE, ptr_type_node,
3552               tree_cons (NULL_TREE, ptr_type_node,
3553                   tree_cons (NULL_TREE, integer_type_node, 
3554                       endlink))));
3555   bool_ftype_ptr_ptr_luns
3556     = build_function_type (boolean_type_node,
3557           tree_cons (NULL_TREE, ptr_type_node,
3558               tree_cons (NULL_TREE, ptr_type_node,
3559                   tree_cons (NULL_TREE, long_unsigned_type_node, 
3560                       endlink))));
3561   bool_ftype_ptr_ptr_ptr_luns
3562     = build_function_type (boolean_type_node,
3563           tree_cons (NULL_TREE, ptr_type_node,
3564               tree_cons (NULL_TREE, ptr_type_node,
3565                   tree_cons (NULL_TREE, ptr_type_node,
3566                       tree_cons (NULL_TREE, long_unsigned_type_node, 
3567                           endlink)))));
3568   bool_ftype_ptr_int_ptr_int
3569     = build_function_type (boolean_type_node,
3570           tree_cons (NULL_TREE, ptr_type_node,
3571               tree_cons (NULL_TREE, integer_type_node,
3572                   tree_cons (NULL_TREE, ptr_type_node, 
3573                       tree_cons (NULL_TREE, integer_type_node, 
3574                           endlink)))));
3575   bool_ftype_ptr_int_ptr_int_int
3576     = build_function_type (boolean_type_node,
3577           tree_cons (NULL_TREE, ptr_type_node,
3578               tree_cons (NULL_TREE, integer_type_node,
3579                   tree_cons (NULL_TREE, ptr_type_node, 
3580                       tree_cons (NULL_TREE, integer_type_node, 
3581                           tree_cons (NULL_TREE, integer_type_node, 
3582                                      endlink))))));
3583   find_bit_ftype
3584     = build_function_type (integer_type_node,
3585           tree_cons (NULL_TREE, ptr_type_node,
3586               tree_cons (NULL_TREE, lo