]>
Commit | Line | Data |
---|---|---|
3c79b2da | 1 | /* Process declarations and variables for GNU CHILL compiler. |
c913b6f1 | 2 | Copyright (C) 1992, 1993, 1994, 1998, 1999, 2000, 2001 |
06ceef4e | 3 | Free Software Foundation, Inc. |
3c79b2da | 4 | |
06ceef4e RK |
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. | |
3c79b2da | 11 | |
06ceef4e RK |
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. | |
3c79b2da | 16 | |
06ceef4e RK |
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, | |
6f48294d | 20 | Boston, MA 02111-1307, USA. */ |
3c79b2da PB |
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 | |
26f1aa5f | 88 | global table we keep adding and removing bindings from. |
3c79b2da PB |
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 | ||
3c79b2da | 184 | #include "config.h" |
75111422 | 185 | #include "system.h" |
3c79b2da PB |
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" | |
75111422 | 193 | #include "toplev.h" |
2a2b2d43 | 194 | #include "diagnostic.h" |
3c79b2da PB |
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 | ||
3b0d91ff KG |
210 | static tree get_next_decl PARAMS ((void)); |
211 | static tree lookup_name_for_seizing PARAMS ((tree)); | |
75111422 | 212 | #if 0 |
3b0d91ff | 213 | static tree lookup_name_current_level PARAMS ((tree)); |
3c79b2da | 214 | #endif |
3b0d91ff | 215 | static void save_decl PARAMS ((tree)); |
3c79b2da PB |
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 */ | |
3b0d91ff KG |
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)); | |
3c79b2da PB |
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 | ||
3c79b2da PB |
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 | |
3c79b2da PB |
283 | tree wchar_type_node; |
284 | tree signed_wchar_type_node; | |
285 | tree unsigned_wchar_type_node; | |
286 | ||
3c79b2da PB |
287 | tree void_list_node; |
288 | ||
3c79b2da PB |
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 | ||
31029ad7 | 301 | const char **boolean_code_name; |
3c79b2da | 302 | |
3c79b2da PB |
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 | ||
3c79b2da PB |
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 | ||
75111422 KG |
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}; | |
3c79b2da PB |
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 | ||
75111422 KG |
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}; | |
3c79b2da PB |
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; | |
3c79b2da PB |
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 do some things the same way PCC does. */ | |
466 | ||
467 | int flag_traditional; | |
468 | ||
469 | /* Nonzero means to allow single precision math even if we're generally | |
470 | being traditional. */ | |
471 | int flag_allow_single_precision = 0; | |
472 | ||
473 | /* Nonzero means to treat bitfields as signed unless they say `unsigned'. */ | |
474 | ||
475 | int flag_signed_bitfields = 1; | |
476 | int explicit_flag_signed_bitfields = 0; | |
477 | ||
3c79b2da PB |
478 | /* Nonzero means warn about implicit declarations. */ |
479 | ||
480 | int warn_implicit; | |
481 | ||
482 | /* Nonzero means give string constants the type `const char *' | |
483 | to get extra warnings from them. These warnings will be too numerous | |
484 | to be useful, except in thoroughly ANSIfied programs. */ | |
485 | ||
486 | int warn_write_strings; | |
487 | ||
488 | /* Nonzero means warn about pointer casts that can drop a type qualifier | |
489 | from the pointer target type. */ | |
490 | ||
491 | int warn_cast_qual; | |
492 | ||
493 | /* Nonzero means warn about sizeof(function) or addition/subtraction | |
494 | of function pointers. */ | |
495 | ||
496 | int warn_pointer_arith; | |
497 | ||
498 | /* Nonzero means warn for non-prototype function decls | |
499 | or non-prototyped defs without previous prototype. */ | |
500 | ||
501 | int warn_strict_prototypes; | |
502 | ||
503 | /* Nonzero means warn for any global function def | |
504 | without separate previous prototype decl. */ | |
505 | ||
506 | int warn_missing_prototypes; | |
507 | ||
508 | /* Nonzero means warn about multiple (redundant) decls for the same single | |
509 | variable or function. */ | |
510 | ||
511 | int warn_redundant_decls = 0; | |
512 | ||
513 | /* Nonzero means warn about extern declarations of objects not at | |
514 | file-scope level and about *all* declarations of functions (whether | |
515 | extern or static) not at file-scope level. Note that we exclude | |
516 | implicit function declarations. To get warnings about those, use | |
517 | -Wimplicit. */ | |
518 | ||
519 | int warn_nested_externs = 0; | |
520 | ||
521 | /* Warn about a subscript that has type char. */ | |
522 | ||
523 | int warn_char_subscripts = 0; | |
524 | ||
525 | /* Warn if a type conversion is done that might have confusing results. */ | |
526 | ||
527 | int warn_conversion; | |
528 | ||
529 | /* Warn if adding () is suggested. */ | |
530 | ||
531 | int warn_parentheses; | |
532 | ||
533 | /* Warn if initializer is not completely bracketed. */ | |
534 | ||
535 | int warn_missing_braces; | |
536 | ||
537 | /* Define the special tree codes that we use. */ | |
538 | ||
539 | /* Table indexed by tree code giving a string containing a character | |
540 | classifying the tree code. Possibilities are | |
541 | t, d, s, c, r, <, 1 and 2. See ch-tree.def for details. */ | |
542 | ||
543 | #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE, | |
544 | ||
31029ad7 | 545 | const char chill_tree_code_type[] = { |
3c79b2da PB |
546 | 'x', |
547 | #include "ch-tree.def" | |
548 | }; | |
549 | #undef DEFTREECODE | |
550 | ||
551 | /* Table indexed by tree code giving number of expression | |
552 | operands beyond the fixed part of the node structure. | |
553 | Not used for types or decls. */ | |
554 | ||
555 | #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH, | |
556 | ||
557 | int chill_tree_code_length[] = { | |
558 | 0, | |
559 | #include "ch-tree.def" | |
560 | }; | |
561 | #undef DEFTREECODE | |
562 | ||
563 | ||
564 | /* Names of tree components. | |
565 | Used for printing out the tree and error messages. */ | |
566 | #define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME, | |
567 | ||
31029ad7 | 568 | const char *chill_tree_code_name[] = { |
3c79b2da PB |
569 | "@@dummy", |
570 | #include "ch-tree.def" | |
571 | }; | |
572 | #undef DEFTREECODE | |
573 | ||
86702e31 | 574 | /* Nonzero means `$' can be in an identifier. */ |
3c79b2da PB |
575 | #ifndef DOLLARS_IN_IDENTIFIERS |
576 | #define DOLLARS_IN_IDENTIFIERS 0 | |
577 | #endif | |
578 | int dollars_in_ident = DOLLARS_IN_IDENTIFIERS > 1; | |
579 | ||
580 | /* An identifier that is used internally to indicate | |
581 | an "ALL" prefix for granting or seizing. | |
582 | We use "*" rather than the external name "ALL", partly for convenience, | |
583 | and partly to avoid case senstivity problems. */ | |
584 | ||
585 | tree ALL_POSTFIX; | |
586 | \f | |
587 | void | |
588 | allocate_lang_decl (t) | |
75111422 | 589 | tree t ATTRIBUTE_UNUSED; |
3c79b2da PB |
590 | { |
591 | /* Nothing needed */ | |
592 | } | |
593 | ||
594 | void | |
595 | copy_lang_decl (node) | |
75111422 | 596 | tree node ATTRIBUTE_UNUSED; |
3c79b2da PB |
597 | { |
598 | /* Nothing needed */ | |
599 | } | |
600 | ||
601 | tree | |
602 | build_lang_decl (code, name, type) | |
603 | enum chill_tree_code code; | |
604 | tree name; | |
605 | tree type; | |
606 | { | |
607 | return build_decl (code, name, type); | |
608 | } | |
609 | \f | |
610 | /* Decode the string P as a language-specific option for C. | |
611 | Return the number of strings consumed for a valid option. | |
612 | Return 0 for an invalid option. */ | |
613 | ||
614 | int | |
615 | c_decode_option (argc, argv) | |
75111422 | 616 | int argc ATTRIBUTE_UNUSED; |
3c79b2da PB |
617 | char **argv; |
618 | { | |
619 | char *p = argv[0]; | |
620 | if (!strcmp (p, "-ftraditional") || !strcmp (p, "-traditional")) | |
621 | { | |
622 | flag_traditional = 1; | |
623 | flag_writable_strings = 1; | |
624 | #if DOLLARS_IN_IDENTIFIERS > 0 | |
625 | dollars_in_ident = 1; | |
626 | #endif | |
627 | } | |
628 | else if (!strcmp (p, "-fnotraditional") || !strcmp (p, "-fno-traditional")) | |
629 | { | |
630 | flag_traditional = 0; | |
631 | flag_writable_strings = 0; | |
632 | dollars_in_ident = DOLLARS_IN_IDENTIFIERS > 1; | |
633 | } | |
634 | else if (!strcmp (p, "-fsigned-char")) | |
635 | flag_signed_char = 1; | |
636 | else if (!strcmp (p, "-funsigned-char")) | |
637 | flag_signed_char = 0; | |
638 | else if (!strcmp (p, "-fno-signed-char")) | |
639 | flag_signed_char = 0; | |
640 | else if (!strcmp (p, "-fno-unsigned-char")) | |
641 | flag_signed_char = 1; | |
642 | else if (!strcmp (p, "-fsigned-bitfields") | |
643 | || !strcmp (p, "-fno-unsigned-bitfields")) | |
644 | { | |
645 | flag_signed_bitfields = 1; | |
646 | explicit_flag_signed_bitfields = 1; | |
647 | } | |
648 | else if (!strcmp (p, "-funsigned-bitfields") | |
649 | || !strcmp (p, "-fno-signed-bitfields")) | |
650 | { | |
651 | flag_signed_bitfields = 0; | |
652 | explicit_flag_signed_bitfields = 1; | |
653 | } | |
654 | else if (!strcmp (p, "-fshort-enums")) | |
655 | flag_short_enums = 1; | |
656 | else if (!strcmp (p, "-fno-short-enums")) | |
657 | flag_short_enums = 0; | |
658 | else if (!strcmp (p, "-fcond-mismatch")) | |
659 | flag_cond_mismatch = 1; | |
660 | else if (!strcmp (p, "-fno-cond-mismatch")) | |
661 | flag_cond_mismatch = 0; | |
662 | else if (!strcmp (p, "-fshort-double")) | |
663 | flag_short_double = 1; | |
664 | else if (!strcmp (p, "-fno-short-double")) | |
665 | flag_short_double = 0; | |
666 | else if (!strcmp (p, "-fasm")) | |
667 | flag_no_asm = 0; | |
668 | else if (!strcmp (p, "-fno-asm")) | |
669 | flag_no_asm = 1; | |
670 | else if (!strcmp (p, "-fbuiltin")) | |
671 | flag_no_builtin = 0; | |
672 | else if (!strcmp (p, "-fno-builtin")) | |
673 | flag_no_builtin = 1; | |
3c79b2da PB |
674 | else if (!strcmp (p, "-ansi")) |
675 | flag_no_asm = 1, flag_no_nonansi_builtin = 1, dollars_in_ident = 0; | |
676 | else if (!strcmp (p, "-Wimplicit")) | |
677 | warn_implicit = 1; | |
678 | else if (!strcmp (p, "-Wno-implicit")) | |
679 | warn_implicit = 0; | |
680 | else if (!strcmp (p, "-Wwrite-strings")) | |
681 | warn_write_strings = 1; | |
682 | else if (!strcmp (p, "-Wno-write-strings")) | |
683 | warn_write_strings = 0; | |
684 | else if (!strcmp (p, "-Wcast-qual")) | |
685 | warn_cast_qual = 1; | |
686 | else if (!strcmp (p, "-Wno-cast-qual")) | |
687 | warn_cast_qual = 0; | |
688 | else if (!strcmp (p, "-Wpointer-arith")) | |
689 | warn_pointer_arith = 1; | |
690 | else if (!strcmp (p, "-Wno-pointer-arith")) | |
691 | warn_pointer_arith = 0; | |
692 | else if (!strcmp (p, "-Wstrict-prototypes")) | |
693 | warn_strict_prototypes = 1; | |
694 | else if (!strcmp (p, "-Wno-strict-prototypes")) | |
695 | warn_strict_prototypes = 0; | |
696 | else if (!strcmp (p, "-Wmissing-prototypes")) | |
697 | warn_missing_prototypes = 1; | |
698 | else if (!strcmp (p, "-Wno-missing-prototypes")) | |
699 | warn_missing_prototypes = 0; | |
700 | else if (!strcmp (p, "-Wredundant-decls")) | |
701 | warn_redundant_decls = 1; | |
702 | else if (!strcmp (p, "-Wno-redundant-decls")) | |
703 | warn_redundant_decls = 0; | |
704 | else if (!strcmp (p, "-Wnested-externs")) | |
705 | warn_nested_externs = 1; | |
706 | else if (!strcmp (p, "-Wno-nested-externs")) | |
707 | warn_nested_externs = 0; | |
708 | else if (!strcmp (p, "-Wchar-subscripts")) | |
709 | warn_char_subscripts = 1; | |
710 | else if (!strcmp (p, "-Wno-char-subscripts")) | |
711 | warn_char_subscripts = 0; | |
712 | else if (!strcmp (p, "-Wconversion")) | |
713 | warn_conversion = 1; | |
714 | else if (!strcmp (p, "-Wno-conversion")) | |
715 | warn_conversion = 0; | |
716 | else if (!strcmp (p, "-Wparentheses")) | |
717 | warn_parentheses = 1; | |
718 | else if (!strcmp (p, "-Wno-parentheses")) | |
719 | warn_parentheses = 0; | |
720 | else if (!strcmp (p, "-Wreturn-type")) | |
721 | warn_return_type = 1; | |
722 | else if (!strcmp (p, "-Wno-return-type")) | |
723 | warn_return_type = 0; | |
724 | else if (!strcmp (p, "-Wcomment")) | |
725 | ; /* cpp handles this one. */ | |
726 | else if (!strcmp (p, "-Wno-comment")) | |
727 | ; /* cpp handles this one. */ | |
728 | else if (!strcmp (p, "-Wcomments")) | |
729 | ; /* cpp handles this one. */ | |
730 | else if (!strcmp (p, "-Wno-comments")) | |
731 | ; /* cpp handles this one. */ | |
732 | else if (!strcmp (p, "-Wtrigraphs")) | |
733 | ; /* cpp handles this one. */ | |
734 | else if (!strcmp (p, "-Wno-trigraphs")) | |
735 | ; /* cpp handles this one. */ | |
736 | else if (!strcmp (p, "-Wimport")) | |
737 | ; /* cpp handles this one. */ | |
738 | else if (!strcmp (p, "-Wno-import")) | |
739 | ; /* cpp handles this one. */ | |
740 | else if (!strcmp (p, "-Wmissing-braces")) | |
741 | warn_missing_braces = 1; | |
742 | else if (!strcmp (p, "-Wno-missing-braces")) | |
743 | warn_missing_braces = 0; | |
744 | else if (!strcmp (p, "-Wall")) | |
745 | { | |
746 | extra_warnings = 1; | |
747 | /* We save the value of warn_uninitialized, since if they put | |
748 | -Wuninitialized on the command line, we need to generate a | |
749 | warning about not using it without also specifying -O. */ | |
750 | if (warn_uninitialized != 1) | |
751 | warn_uninitialized = 2; | |
752 | warn_implicit = 1; | |
753 | warn_return_type = 1; | |
078721e1 | 754 | set_Wunused (1); |
3c79b2da PB |
755 | warn_char_subscripts = 1; |
756 | warn_parentheses = 1; | |
757 | warn_missing_braces = 1; | |
758 | } | |
759 | else | |
760 | return 0; | |
761 | ||
762 | return 1; | |
763 | } | |
764 | ||
765 | /* Hooks for print_node. */ | |
766 | ||
767 | void | |
768 | print_lang_decl (file, node, indent) | |
769 | FILE *file; | |
770 | tree node; | |
771 | int indent; | |
772 | { | |
773 | indent_to (file, indent + 3); | |
5efaf7b0 KG |
774 | fputs ("nesting_level ", file); |
775 | fprintf (file, HOST_WIDE_INT_PRINT_DEC, DECL_NESTING_LEVEL (node)); | |
776 | fputs (" ", file); | |
3c79b2da PB |
777 | if (DECL_WEAK_NAME (node)) |
778 | fprintf (file, "weak_name "); | |
779 | if (CH_DECL_SIGNAL (node)) | |
780 | fprintf (file, "decl_signal "); | |
781 | print_node (file, "tasking_code", | |
782 | (tree)DECL_TASKING_CODE_DECL (node), indent + 4); | |
783 | } | |
784 | ||
785 | ||
786 | void | |
787 | print_lang_type (file, node, indent) | |
788 | FILE *file; | |
789 | tree node; | |
790 | int indent; | |
791 | { | |
792 | tree temp; | |
793 | ||
794 | indent_to (file, indent + 3); | |
795 | if (CH_IS_BUFFER_MODE (node)) | |
796 | fprintf (file, "buffer_mode "); | |
797 | if (CH_IS_EVENT_MODE (node)) | |
798 | fprintf (file, "event_mode "); | |
799 | ||
800 | if (CH_IS_EVENT_MODE (node) || CH_IS_BUFFER_MODE (node)) | |
801 | { | |
802 | temp = max_queue_size (node); | |
803 | if (temp) | |
804 | print_node_brief (file, "qsize", temp, indent + 4); | |
805 | } | |
806 | } | |
807 | ||
808 | void | |
809 | print_lang_identifier (file, node, indent) | |
810 | FILE *file; | |
811 | tree node; | |
812 | int indent; | |
813 | { | |
814 | print_node (file, "local", IDENTIFIER_LOCAL_VALUE (node), indent + 4); | |
815 | print_node (file, "outer", IDENTIFIER_OUTER_VALUE (node), indent + 4); | |
816 | print_node (file, "implicit", IDENTIFIER_IMPLICIT_DECL (node), indent + 4); | |
817 | print_node (file, "error locus", IDENTIFIER_ERROR_LOCUS (node), indent + 4); | |
818 | print_node (file, "signal_dest", IDENTIFIER_SIGNAL_DEST (node), indent + 4); | |
819 | indent_to (file, indent + 3); | |
820 | if (IDENTIFIER_SIGNAL_DATA(node)) | |
821 | fprintf (file, "signal_data "); | |
822 | } | |
823 | \f | |
824 | /* initialise non-value struct */ | |
825 | ||
826 | static int | |
827 | init_nonvalue_struct (expr) | |
828 | tree expr; | |
829 | { | |
830 | tree type = TREE_TYPE (expr); | |
831 | tree field; | |
832 | int res = 0; | |
833 | ||
834 | if (CH_IS_BUFFER_MODE (type)) | |
835 | { | |
836 | expand_expr_stmt ( | |
837 | build_chill_modify_expr ( | |
838 | build_component_ref (expr, get_identifier ("__buffer_data")), | |
839 | null_pointer_node)); | |
840 | return 1; | |
841 | } | |
842 | else if (CH_IS_EVENT_MODE (type)) | |
843 | { | |
844 | expand_expr_stmt ( | |
845 | build_chill_modify_expr ( | |
846 | build_component_ref (expr, get_identifier ("__event_data")), | |
847 | null_pointer_node)); | |
848 | return 1; | |
849 | } | |
850 | else if (CH_IS_ASSOCIATION_MODE (type)) | |
851 | { | |
852 | expand_expr_stmt ( | |
853 | build_chill_modify_expr (expr, | |
854 | chill_convert_for_assignment (type, association_init_value, | |
855 | "association"))); | |
856 | return 1; | |
857 | } | |
858 | else if (CH_IS_ACCESS_MODE (type)) | |
859 | { | |
860 | init_access_location (expr, type); | |
861 | return 1; | |
862 | } | |
863 | else if (CH_IS_TEXT_MODE (type)) | |
864 | { | |
865 | init_text_location (expr, type); | |
866 | return 1; | |
867 | } | |
868 | ||
869 | for (field = TYPE_FIELDS (type); field != NULL_TREE; field = TREE_CHAIN (field)) | |
870 | { | |
871 | type = TREE_TYPE (field); | |
872 | if (CH_TYPE_NONVALUE_P (type)) | |
873 | { | |
874 | tree exp = build_component_ref (expr, DECL_NAME (field)); | |
875 | if (TREE_CODE (type) == RECORD_TYPE) | |
876 | res |= init_nonvalue_struct (exp); | |
877 | else if (TREE_CODE (type) == ARRAY_TYPE) | |
878 | res |= init_nonvalue_array (exp); | |
879 | } | |
880 | } | |
881 | return res; | |
882 | } | |
883 | ||
884 | /* initialize non-value array */ | |
885 | /* do it with DO FOR unique-id IN expr; ... OD; */ | |
886 | static int | |
887 | init_nonvalue_array (expr) | |
888 | tree expr; | |
889 | { | |
890 | tree tmpvar = get_unique_identifier ("NONVALINIT"); | |
891 | tree type; | |
892 | int res = 0; | |
893 | ||
894 | push_loop_block (); | |
895 | build_loop_iterator (tmpvar, expr, NULL_TREE, NULL_TREE, 0, 1, 0); | |
896 | nonvalue_begin_loop_scope (); | |
897 | build_loop_start (NULL_TREE); | |
898 | tmpvar = lookup_name (tmpvar); | |
899 | type = TREE_TYPE (tmpvar); | |
900 | if (CH_TYPE_NONVALUE_P (type)) | |
901 | { | |
902 | if (TREE_CODE (type) == RECORD_TYPE) | |
903 | res |= init_nonvalue_struct (tmpvar); | |
904 | else if (TREE_CODE (type) == ARRAY_TYPE) | |
905 | res |= init_nonvalue_array (tmpvar); | |
906 | } | |
907 | build_loop_end (); | |
908 | nonvalue_end_loop_scope (); | |
909 | pop_loop_block (); | |
910 | return res; | |
911 | } | |
912 | \f | |
913 | /* This excessive piece of code sets DECL_NESTING_LEVEL (DECL) to LEVEL. */ | |
914 | ||
31029ad7 | 915 | static void |
3c79b2da PB |
916 | set_nesting_level (decl, level) |
917 | tree decl; | |
918 | int level; | |
919 | { | |
920 | static tree *small_ints = NULL; | |
921 | static int max_small_ints = 0; | |
922 | ||
923 | if (level < 0) | |
924 | decl->decl.vindex = NULL_TREE; | |
925 | else | |
926 | { | |
927 | if (level >= max_small_ints) | |
928 | { | |
929 | int new_max = level + 20; | |
930 | if (small_ints == NULL) | |
931 | small_ints = (tree*)xmalloc (new_max * sizeof(tree)); | |
932 | else | |
933 | small_ints = (tree*)xrealloc (small_ints, new_max * sizeof(tree)); | |
934 | while (max_small_ints < new_max) | |
935 | small_ints[max_small_ints++] = NULL_TREE; | |
936 | } | |
937 | if (small_ints[level] == NULL_TREE) | |
938 | { | |
939 | push_obstacks (&permanent_obstack, &permanent_obstack); | |
940 | small_ints[level] = build_int_2 (level, 0); | |
941 | pop_obstacks (); | |
942 | } | |
943 | /* set DECL_NESTING_LEVEL */ | |
944 | decl->decl.vindex = small_ints[level]; | |
945 | } | |
946 | } | |
947 | \f | |
948 | /* OPT_EXTERNAL is non-zero when the declaration is at module level. | |
949 | * OPT_EXTERNAL == 2 means implicitly grant it. | |
950 | */ | |
951 | void | |
952 | do_decls (names, type, opt_static, lifetime_bound, opt_init, opt_external) | |
953 | tree names; | |
954 | tree type; | |
955 | int opt_static; | |
956 | int lifetime_bound; | |
957 | tree opt_init; | |
958 | int opt_external; | |
959 | { | |
960 | if (names == NULL_TREE || TREE_CODE (names) == TREE_LIST) | |
961 | { | |
962 | for (; names != NULL_TREE; names = TREE_CHAIN (names)) | |
963 | do_decl (TREE_VALUE (names), type, opt_static, lifetime_bound, | |
964 | opt_init, opt_external); | |
965 | } | |
966 | else if (TREE_CODE (names) != ERROR_MARK) | |
967 | do_decl (names, type, opt_static, lifetime_bound, opt_init, opt_external); | |
968 | } | |
969 | ||
970 | tree | |
971 | do_decl (name, type, is_static, lifetime_bound, opt_init, opt_external) | |
972 | tree name, type; | |
973 | int is_static; | |
974 | int lifetime_bound; | |
975 | tree opt_init; | |
976 | int opt_external; | |
977 | { | |
978 | tree decl; | |
979 | ||
980 | if (current_function_decl == global_function_decl | |
981 | && ! lifetime_bound /*&& opt_init != NULL_TREE*/) | |
982 | seen_action = 1; | |
983 | ||
984 | if (pass < 2) | |
985 | { | |
986 | push_obstacks (&permanent_obstack, &permanent_obstack); | |
987 | decl = make_node (VAR_DECL); | |
988 | DECL_NAME (decl) = name; | |
989 | TREE_TYPE (decl) = type; | |
990 | DECL_ASSEMBLER_NAME (decl) = name; | |
991 | ||
992 | /* Try to put things in common when possible. | |
993 | Tasking variables must go into common. */ | |
994 | DECL_COMMON (decl) = 1; | |
995 | DECL_EXTERNAL (decl) = opt_external > 0; | |
996 | TREE_PUBLIC (decl) = opt_external > 0; | |
997 | TREE_STATIC (decl) = is_static; | |
998 | ||
999 | if (pass == 0) | |
1000 | { | |
1001 | /* We have to set this here, since we build the decl w/o | |
1002 | calling `build_decl'. */ | |
1003 | DECL_INITIAL (decl) = opt_init; | |
1004 | pushdecl (decl); | |
1005 | finish_decl (decl); | |
1006 | } | |
1007 | else | |
1008 | { | |
1009 | save_decl (decl); | |
1010 | pop_obstacks (); | |
1011 | } | |
1012 | DECL_INITIAL (decl) = opt_init; | |
1013 | if (opt_external > 1 || in_pseudo_module) | |
1014 | push_granted (DECL_NAME (decl), decl); | |
1015 | } | |
1016 | else /* pass == 2 */ | |
1017 | { | |
1018 | tree temp = NULL_TREE; | |
1019 | int init_it = 0; | |
1020 | ||
1021 | decl = get_next_decl (); | |
1022 | ||
1023 | if (name != DECL_NAME (decl)) | |
1024 | abort (); | |
1025 | ||
1026 | type = TREE_TYPE (decl); | |
1027 | ||
1028 | push_obstacks_nochange (); | |
1029 | if (TYPE_READONLY_PROPERTY (type)) | |
1030 | { | |
1031 | if (CH_TYPE_NONVALUE_P (type)) | |
1032 | { | |
1033 | error_with_decl (decl, "`%s' must not be declared readonly"); | |
1034 | opt_init = NULL_TREE; /* prevent subsequent errors */ | |
1035 | } | |
1036 | else if (opt_init == NULL_TREE && !opt_external) | |
1037 | error("declaration of readonly variable without initialization"); | |
1038 | } | |
1039 | TREE_READONLY (decl) = TYPE_READONLY (type); | |
1040 | ||
1041 | if (!opt_init && chill_varying_type_p (type)) | |
1042 | { | |
1043 | tree fixed_part_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type))); | |
1044 | if (fixed_part_type != NULL_TREE && TREE_CODE (fixed_part_type) != ERROR_MARK) | |
1045 | { | |
1046 | if (CH_CHARS_TYPE_P (fixed_part_type)) | |
1047 | opt_init = build_chill_string (0, ""); | |
1048 | else | |
1049 | opt_init = build_nt (CONSTRUCTOR, NULL_TREE, NULL_TREE); | |
1050 | lifetime_bound = 1; | |
1051 | } | |
1052 | } | |
1053 | ||
1054 | if (opt_init) | |
1055 | { | |
1056 | if (CH_TYPE_NONVALUE_P (type)) | |
1057 | { | |
1058 | error_with_decl (decl, | |
1737c953 | 1059 | "no initialization allowed for `%s'"); |
3c79b2da PB |
1060 | temp = NULL_TREE; |
1061 | } | |
1062 | else if (TREE_CODE (type) == REFERENCE_TYPE) | |
1063 | { /* A loc-identity declaration */ | |
1064 | if (! CH_LOCATION_P (opt_init)) | |
1065 | { | |
1066 | error_with_decl (decl, | |
1067 | "value for loc-identity `%s' is not a location"); | |
1068 | temp = NULL_TREE; | |
1069 | } | |
1070 | else if (! CH_READ_COMPATIBLE (TREE_TYPE (type), | |
1071 | TREE_TYPE (opt_init))) | |
1072 | { | |
1073 | error_with_decl (decl, | |
1074 | "location for `%s' not read-compatible"); | |
1075 | temp = NULL_TREE; | |
1076 | } | |
1077 | else | |
1078 | temp = convert (type, opt_init); | |
1079 | } | |
1080 | else | |
1081 | { /* Normal location declaration */ | |
1082 | char place[80]; | |
1083 | sprintf (place, "`%.60s' initializer", | |
1084 | IDENTIFIER_POINTER (DECL_NAME (decl))); | |
1085 | temp = chill_convert_for_assignment (type, opt_init, place); | |
1086 | } | |
1087 | } | |
1088 | else if (CH_TYPE_NONVALUE_P (type)) | |
1089 | { | |
1090 | temp = NULL_TREE; | |
1091 | init_it = 1; | |
1092 | } | |
1093 | DECL_INITIAL (decl) = NULL_TREE; | |
1094 | ||
1095 | if (temp != NULL_TREE && TREE_CODE (temp) != ERROR_MARK) | |
1096 | { | |
1097 | /* The same for stack variables (assuming no nested modules). */ | |
1098 | if (lifetime_bound || !is_static) | |
1099 | { | |
1100 | if (is_static && ! TREE_CONSTANT (temp)) | |
1101 | error_with_decl (decl, "nonconstant initializer for `%s'"); | |
1102 | else | |
1103 | DECL_INITIAL (decl) = temp; | |
1104 | } | |
1105 | } | |
1106 | finish_decl (decl); | |
1107 | /* Initialize the variable unless initialized statically. */ | |
1108 | if ((!is_static || ! lifetime_bound) && | |
1109 | temp != NULL_TREE && TREE_CODE (temp) != ERROR_MARK) | |
1110 | { | |
1111 | int was_used = TREE_USED (decl); | |
1112 | emit_line_note (input_filename, lineno); | |
1113 | expand_expr_stmt (build_chill_modify_expr (decl, temp)); | |
1114 | /* Don't let the initialization count as "using" the variable. */ | |
1115 | TREE_USED (decl) = was_used; | |
1116 | if (current_function_decl == global_function_decl) | |
1117 | build_constructor = 1; | |
1118 | } | |
1119 | else if (init_it && TREE_CODE (type) != ERROR_MARK) | |
1120 | { | |
1121 | /* Initialize variables with non-value type */ | |
1122 | int was_used = TREE_USED (decl); | |
1123 | int something_initialised = 0; | |
1124 | ||
1125 | emit_line_note (input_filename, lineno); | |
1126 | if (TREE_CODE (type) == RECORD_TYPE) | |
1127 | something_initialised = init_nonvalue_struct (decl); | |
1128 | else if (TREE_CODE (type) == ARRAY_TYPE) | |
1129 | something_initialised = init_nonvalue_array (decl); | |
1130 | if (! something_initialised) | |
1131 | { | |
1132 | error ("do_decl: internal error: don't know what to initialize"); | |
1133 | abort (); | |
1134 | } | |
1135 | /* Don't let the initialization count as "using" the variable. */ | |
1136 | TREE_USED (decl) = was_used; | |
1137 | if (current_function_decl == global_function_decl) | |
1138 | build_constructor = 1; | |
1139 | } | |
1140 | } | |
1141 | return decl; | |
1142 | } | |
1143 | \f | |
1144 | /* | |
1145 | * ARGTYPES is a tree_list of formal argument types. TREE_VALUE | |
1146 | * is the type tree for each argument, while the attribute is in | |
1147 | * TREE_PURPOSE. | |
1148 | */ | |
1149 | tree | |
1150 | build_chill_function_type (return_type, argtypes, exceptions, recurse_p) | |
1151 | tree return_type, argtypes, exceptions, recurse_p; | |
1152 | { | |
1153 | tree ftype, arg; | |
1154 | ||
1155 | if (exceptions != NULL_TREE) | |
1156 | { | |
1157 | /* if we have exceptions we add 2 arguments, callers filename | |
1158 | and linenumber. These arguments will be added automatically | |
1159 | when calling a function which may raise exceptions. */ | |
1160 | argtypes = chainon (argtypes, | |
1161 | build_tree_list (NULL_TREE, ridpointers[(int) RID_PTR])); | |
1162 | argtypes = chainon (argtypes, | |
1163 | build_tree_list (NULL_TREE, ridpointers[(int) RID_LONG])); | |
1164 | } | |
1165 | ||
1166 | /* Indicate the argument list is complete. */ | |
1167 | argtypes = chainon (argtypes, | |
1168 | build_tree_list (NULL_TREE, void_type_node)); | |
1169 | ||
1170 | /* INOUT and OUT parameters must be a REFERENCE_TYPE since | |
1171 | we'll be passing a temporary's address at call time. */ | |
1172 | for (arg = argtypes; arg; arg = TREE_CHAIN (arg)) | |
1173 | if (TREE_PURPOSE (arg) == ridpointers[(int) RID_LOC] | |
1174 | || TREE_PURPOSE (arg) == ridpointers[(int) RID_OUT] | |
1175 | || TREE_PURPOSE (arg) == ridpointers[(int) RID_INOUT] | |
1176 | ) | |
1177 | TREE_VALUE (arg) = | |
1178 | build_chill_reference_type (TREE_VALUE (arg)); | |
1179 | ||
1180 | /* Cannot use build_function_type, because if does hash-canonlicalization. */ | |
1181 | ftype = make_node (FUNCTION_TYPE); | |
1182 | TREE_TYPE (ftype) = return_type ? return_type : void_type_node ; | |
1183 | TYPE_ARG_TYPES (ftype) = argtypes; | |
1184 | ||
1185 | if (exceptions) | |
1186 | ftype = build_exception_variant (ftype, exceptions); | |
1187 | ||
1188 | if (recurse_p) | |
1189 | sorry ("RECURSIVE PROCs"); | |
1190 | ||
1191 | return ftype; | |
1192 | } | |
1193 | \f | |
1194 | /* | |
1195 | * ARGTYPES is a tree_list of formal argument types. | |
1196 | */ | |
1197 | tree | |
1198 | push_extern_function (name, typespec, argtypes, exceptions, granting) | |
75111422 KG |
1199 | tree name, typespec, argtypes, exceptions; |
1200 | int granting ATTRIBUTE_UNUSED;/*If 0 do pushdecl(); if 1 do push_granted()*/ | |
3c79b2da PB |
1201 | { |
1202 | tree ftype, fndecl; | |
1203 | ||
1204 | push_obstacks_nochange (); | |
1205 | end_temporary_allocation (); | |
1206 | ||
1207 | if (pass < 2) | |
1208 | { | |
1209 | ftype = build_chill_function_type (typespec, argtypes, | |
1210 | exceptions, NULL_TREE); | |
1211 | ||
1212 | fndecl = build_decl (FUNCTION_DECL, name, ftype); | |
1213 | ||
1214 | DECL_EXTERNAL(fndecl) = 1; | |
1215 | TREE_STATIC (fndecl) = 1; | |
1216 | TREE_PUBLIC (fndecl) = 1; | |
1217 | if (pass == 0) | |
1218 | { | |
1219 | pushdecl (fndecl); | |
1220 | finish_decl (fndecl); | |
1221 | } | |
1222 | else | |
1223 | { | |
1224 | save_decl (fndecl); | |
1225 | pop_obstacks (); | |
1226 | } | |
1227 | make_function_rtl (fndecl); | |
1228 | } | |
1229 | else | |
1230 | { | |
1231 | fndecl = get_next_decl (); | |
1232 | finish_decl (fndecl); | |
1233 | } | |
1234 | #if 0 | |
1235 | ||
1236 | if (granting) | |
1237 | push_granted (name, decl); | |
1238 | else | |
1239 | pushdecl(decl); | |
1240 | #endif | |
1241 | return fndecl; | |
1242 | } | |
1243 | ||
1244 | ||
1245 | \f | |
1246 | void | |
1247 | push_extern_process (name, argtypes, exceptions, granting) | |
1248 | tree name, argtypes, exceptions; | |
1249 | int granting; | |
1250 | { | |
1251 | tree decl, func, arglist; | |
1252 | ||
1253 | push_obstacks_nochange (); | |
1254 | end_temporary_allocation (); | |
1255 | ||
1256 | if (pass < 2) | |
1257 | { | |
1258 | tree proc_struct = make_process_struct (name, argtypes); | |
1259 | arglist = (argtypes == NULL_TREE) ? NULL_TREE : | |
1260 | tree_cons (NULL_TREE, | |
1261 | build_chill_pointer_type (proc_struct), NULL_TREE); | |
1262 | } | |
1263 | else | |
1264 | arglist = NULL_TREE; | |
1265 | ||
1266 | func = push_extern_function (name, NULL_TREE, arglist, | |
1267 | exceptions, granting); | |
1268 | ||
1269 | /* declare the code variable */ | |
1270 | decl = generate_tasking_code_variable (name, &process_type, 1); | |
1271 | CH_DECL_PROCESS (func) = 1; | |
1272 | /* remember the code variable in the function decl */ | |
1273 | DECL_TASKING_CODE_DECL (func) = (struct lang_decl *)decl; | |
1274 | ||
1275 | add_taskstuff_to_list (decl, "_TT_Process", NULL_TREE, func, NULL_TREE); | |
1276 | } | |
1277 | \f | |
1278 | void | |
1279 | push_extern_signal (signame, sigmodelist, optsigdest) | |
1280 | tree signame, sigmodelist, optsigdest; | |
1281 | { | |
1282 | tree decl, sigtype; | |
1283 | ||
1284 | push_obstacks_nochange (); | |
1285 | end_temporary_allocation (); | |
1286 | ||
1287 | sigtype = | |
1288 | build_signal_struct_type (signame, sigmodelist, optsigdest); | |
1289 | ||
1290 | /* declare the code variable outside the process */ | |
1291 | decl = generate_tasking_code_variable (signame, &signal_code, 1); | |
1292 | add_taskstuff_to_list (decl, "_TT_Signal", NULL_TREE, sigtype, NULL_TREE); | |
1293 | } | |
1294 | \f | |
1295 | void | |
1296 | print_mode (mode) | |
1297 | tree mode; | |
1298 | { | |
1299 | while (mode != NULL_TREE) | |
1300 | { | |
1301 | switch (TREE_CODE (mode)) | |
1302 | { | |
1303 | case POINTER_TYPE: | |
1304 | printf (" REF "); | |
1305 | mode = TREE_TYPE (mode); | |
1306 | break; | |
1307 | case INTEGER_TYPE: | |
1308 | case REAL_TYPE: | |
1309 | printf (" %s ", IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (mode)))); | |
1310 | mode = NULL_TREE; | |
1311 | break; | |
1312 | case ARRAY_TYPE: | |
1313 | { | |
1314 | tree itype = TYPE_DOMAIN (mode); | |
1315 | if (CH_STRING_TYPE_P (mode)) | |
5efaf7b0 KG |
1316 | { |
1317 | fputs (" STRING (", stdout); | |
1318 | printf (HOST_WIDE_INT_PRINT_DEC, | |
1319 | TREE_INT_CST_LOW (TYPE_MAX_VALUE (itype))); | |
1320 | fputs (") OF ", stdout); | |
1321 | } | |
3c79b2da | 1322 | else |
5efaf7b0 KG |
1323 | { |
1324 | fputs (" ARRAY (", stdout); | |
1325 | printf (HOST_WIDE_INT_PRINT_DEC, | |
1326 | TREE_INT_CST_LOW (TYPE_MIN_VALUE (itype))); | |
1327 | fputs (":", stdout); | |
1328 | printf (HOST_WIDE_INT_PRINT_DEC, | |
1329 | TREE_INT_CST_LOW (TYPE_MAX_VALUE (itype))); | |
1330 | fputs (") OF ", stdout); | |
1331 | } | |
3c79b2da PB |
1332 | mode = TREE_TYPE (mode); |
1333 | break; | |
1334 | } | |
1335 | case RECORD_TYPE: | |
1336 | { | |
1337 | tree fields = TYPE_FIELDS (mode); | |
1338 | printf (" RECORD ("); | |
1339 | while (fields != NULL_TREE) | |
1340 | { | |
1341 | printf (" %s:", IDENTIFIER_POINTER (DECL_NAME (fields))); | |
1342 | print_mode (TREE_TYPE (fields)); | |
1343 | if (TREE_CHAIN (fields)) | |
1344 | printf (","); | |
1345 | fields = TREE_CHAIN (fields); | |
1346 | } | |
1347 | printf (")"); | |
1348 | mode = NULL_TREE; | |
1349 | break; | |
1350 | } | |
1351 | default: | |
1352 | abort (); | |
1353 | } | |
1354 | } | |
1355 | } | |
1356 | \f | |
1357 | tree | |
1358 | chill_munge_params (nodes, type, attr) | |
1359 | tree nodes, type, attr; | |
1360 | { | |
1361 | tree node; | |
1362 | if (pass == 1) | |
1363 | { | |
1364 | /* Convert the list of identifiers to a list of types. */ | |
1365 | for (node = nodes; node != NULL_TREE; node = TREE_CHAIN (node)) | |
1366 | { | |
1367 | TREE_VALUE (node) = type; /* this was the identifier node */ | |
1368 | TREE_PURPOSE (node) = attr; | |
1369 | } | |
1370 | } | |
1371 | return nodes; | |
1372 | } | |
1373 | ||
1374 | /* Push the declarations described by SYN_DEFS into the current scope. */ | |
1375 | void | |
1376 | push_syndecl (name, mode, value) | |
1377 | tree name, mode, value; | |
1378 | { | |
1379 | if (pass == 1) | |
1380 | { | |
1381 | tree decl = make_node (CONST_DECL); | |
1382 | DECL_NAME (decl) = name; | |
1383 | DECL_ASSEMBLER_NAME (decl) = name; | |
1384 | TREE_TYPE (decl) = mode; | |
1385 | DECL_INITIAL (decl) = value; | |
1386 | TREE_READONLY (decl) = 1; | |
1387 | save_decl (decl); | |
1388 | if (in_pseudo_module) | |
1389 | push_granted (DECL_NAME (decl), decl); | |
1390 | } | |
1391 | else /* pass == 2 */ | |
1392 | get_next_decl (); | |
1393 | } | |
1394 | ||
1395 | ||
1396 | \f | |
1397 | /* Push the declarations described by (MODENAME,MODE) into the current scope. | |
1398 | MAKE_NEWMODE is 1 for NEWMODE, 0 for SYNMODE, and | |
1399 | -1 for internal use (in which case the mode does not need to be copied). */ | |
1400 | ||
1401 | tree | |
1402 | push_modedef (modename, mode, make_newmode) | |
1403 | tree modename; | |
1404 | tree mode; /* ignored if pass==2. */ | |
1405 | int make_newmode; | |
1406 | { | |
1407 | tree newdecl, newmode; | |
1408 | ||
1409 | if (pass == 1) | |
1410 | { | |
1411 | /* FIXME: need to check here for SYNMODE fred fred; */ | |
1412 | push_obstacks (&permanent_obstack, &permanent_obstack); | |
1413 | ||
1414 | newdecl = build_lang_decl (TYPE_DECL, modename, mode); | |
1415 | ||
1416 | if (make_newmode >= 0) | |
1417 | { | |
1418 | newmode = make_node (LANG_TYPE); | |
1419 | TREE_TYPE (newmode) = mode; | |
1420 | TREE_TYPE (newdecl) = newmode; | |
1421 | TYPE_NAME (newmode) = newdecl; | |
1422 | if (make_newmode > 0) | |
1423 | CH_NOVELTY (newmode) = newdecl; | |
1424 | } | |
1425 | ||
1426 | save_decl (newdecl); | |
1427 | pop_obstacks (); | |
1428 | ||
1429 | } | |
1430 | else /* pass == 2 */ | |
1431 | { | |
1432 | /* FIXME: need to check here for SYNMODE fred fred; */ | |
1433 | newdecl = get_next_decl (); | |
1434 | if (DECL_NAME (newdecl) != modename) | |
1435 | abort (); | |
1436 | if (TREE_CODE (TREE_TYPE (newdecl)) != ERROR_MARK) | |
1437 | { | |
1438 | /* ASSOCIATION, ACCESS, TEXT, BUFFER, and EVENT must not be READOnly */ | |
1439 | if (TREE_READONLY (TREE_TYPE (newdecl)) && | |
1440 | (CH_IS_ASSOCIATION_MODE (TREE_TYPE (newdecl)) || | |
1441 | CH_IS_ACCESS_MODE (TREE_TYPE (newdecl)) || | |
1442 | CH_IS_TEXT_MODE (TREE_TYPE (newdecl)) || | |
1443 | CH_IS_BUFFER_MODE (TREE_TYPE (newdecl)) || | |
1444 | CH_IS_EVENT_MODE (TREE_TYPE (newdecl)))) | |
1445 | error_with_decl (newdecl, "`%s' must not be READonly"); | |
1446 | rest_of_decl_compilation (newdecl, NULL_PTR, | |
1447 | global_bindings_p (), 0); | |
1448 | } | |
1449 | } | |
1450 | return newdecl; | |
1451 | } | |
1452 | \f | |
1453 | /* Return a chain of FIELD_DECLs for the names in NAMELIST. All of | |
1454 | of type TYPE. When NAMELIST is passed in from the parser, it is | |
1455 | in reverse order. | |
1456 | LAYOUT is (NULL_TREE, integer_one_node, integer_zero_node, tree_list), | |
1457 | meaning (default, pack, nopack, POS (...) ). */ | |
1458 | ||
1459 | tree | |
1460 | grok_chill_fixedfields (namelist, type, layout) | |
1461 | tree namelist, type; | |
1462 | tree layout; | |
1463 | { | |
1464 | tree decls = NULL_TREE; | |
1465 | ||
1466 | if (layout != NULL_TREE && TREE_CHAIN (namelist) != NULL_TREE) | |
1467 | { | |
1468 | if (layout != integer_one_node && layout != integer_zero_node) | |
1469 | { | |
1470 | layout = NULL_TREE; | |
1471 | error ("POS may not be specified for a list of field declarations"); | |
1472 | } | |
1473 | } | |
1474 | ||
1475 | /* we build the chain of FIELD_DECLs backwards, effectively | |
1476 | unreversing the reversed names in NAMELIST. */ | |
1477 | for (; namelist; namelist = TREE_CHAIN (namelist)) | |
1478 | { | |
1479 | tree decl = build_decl (FIELD_DECL, | |
1480 | TREE_VALUE (namelist), type); | |
1481 | DECL_INITIAL (decl) = layout; | |
1482 | TREE_CHAIN (decl) = decls; | |
1483 | decls = decl; | |
1484 | } | |
1485 | ||
1486 | return decls; | |
1487 | } | |
1488 | \f | |
1489 | struct tree_pair | |
1490 | { | |
1491 | tree value; | |
1492 | tree decl; | |
1493 | }; | |
1494 | ||
3b0d91ff | 1495 | static int label_value_cmp PARAMS ((struct tree_pair *, |
31029ad7 | 1496 | struct tree_pair *)); |
3c79b2da PB |
1497 | |
1498 | /* Function to help qsort sort variant labels by value order. */ | |
1499 | static int | |
1500 | label_value_cmp (x, y) | |
1501 | struct tree_pair *x, *y; | |
1502 | { | |
1503 | return TREE_INT_CST_LOW (x->value) - TREE_INT_CST_LOW (y->value); | |
1504 | } | |
1505 | \f | |
31029ad7 | 1506 | static tree |
3c79b2da PB |
1507 | make_chill_variants (tagfields, body, variantelse) |
1508 | tree tagfields; | |
1509 | tree body; | |
1510 | tree variantelse; | |
1511 | { | |
1512 | tree utype; | |
1513 | tree first = NULL_TREE; | |
1514 | for (; body; body = TREE_CHAIN (body)) | |
1515 | { | |
1516 | tree decls = TREE_VALUE (body); | |
1517 | tree labellist = TREE_PURPOSE (body); | |
1518 | ||
1519 | if (labellist != NULL_TREE | |
1520 | && TREE_CODE (TREE_VALUE (labellist)) == TREE_LIST | |
1521 | && TREE_VALUE (TREE_VALUE (labellist)) == case_else_node | |
1522 | && TREE_CHAIN (labellist) == NULL_TREE) | |
1523 | { | |
1524 | if (variantelse) | |
1525 | error ("(ELSE) case label as well as ELSE variant"); | |
1526 | variantelse = decls; | |
1527 | } | |
1528 | else | |
1529 | { | |
1530 | tree rtype = start_struct (RECORD_TYPE, NULL_TREE); | |
1531 | rtype = finish_struct (rtype, decls); | |
1532 | ||
1533 | first = chainon (first, build_decl (FIELD_DECL, NULL_TREE, rtype)); | |
1534 | ||
1535 | TYPE_TAG_VALUES (rtype) = labellist; | |
1536 | } | |
1537 | } | |
1538 | ||
1539 | if (variantelse != NULL_TREE) | |
1540 | { | |
1541 | tree rtype = start_struct (RECORD_TYPE, NULL_TREE); | |
1542 | rtype = finish_struct (rtype, variantelse); | |
1543 | first = chainon (first, | |
1544 | build_decl (FIELD_DECL, | |
1545 | ELSE_VARIANT_NAME, rtype)); | |
1546 | } | |
1547 | ||
1548 | utype = start_struct (UNION_TYPE, NULL_TREE); | |
1549 | utype = finish_struct (utype, first); | |
1550 | TYPE_TAGFIELDS (utype) = tagfields; | |
1551 | return utype; | |
1552 | } | |
1553 | \f | |
1554 | tree | |
1555 | layout_chill_variants (utype) | |
1556 | tree utype; | |
1557 | { | |
1558 | tree first = TYPE_FIELDS (utype); | |
058ebd7e | 1559 | int nlabels, label_index = 0; |
3c79b2da PB |
1560 | struct tree_pair *label_value_array; |
1561 | tree decl; | |
1562 | extern int errorcount; | |
1563 | ||
1564 | if (TYPE_SIZE (utype)) | |
1565 | return utype; | |
1566 | ||
1567 | for (decl = first; decl; decl = TREE_CHAIN (decl)) | |
1568 | { | |
1569 | tree tagfields = TYPE_TAGFIELDS (utype); | |
1570 | tree t = TREE_TYPE (decl); | |
1571 | tree taglist = TYPE_TAG_VALUES (t); | |
1572 | if (DECL_NAME (decl) == ELSE_VARIANT_NAME) | |
1573 | continue; | |
1574 | if (tagfields == NULL_TREE) | |
1575 | continue; | |
1576 | for ( ; tagfields != NULL_TREE && taglist != NULL_TREE; | |
1577 | tagfields = TREE_CHAIN (tagfields), taglist = TREE_CHAIN (taglist)) | |
1578 | { | |
1579 | tree labellist = TREE_VALUE (taglist); | |
1580 | for (; labellist; labellist = TREE_CHAIN (labellist)) | |
1581 | { | |
1582 | int compat_error = 0; | |
1583 | tree label_value = TREE_VALUE (labellist); | |
1584 | if (TREE_CODE (label_value) == RANGE_EXPR) | |
1585 | { | |
1586 | if (TREE_OPERAND (label_value, 0) != NULL_TREE) | |
1587 | { | |
1588 | if (!CH_COMPATIBLE (TREE_OPERAND (label_value, 0), | |
1589 | TREE_TYPE (TREE_VALUE (tagfields))) | |
1590 | || !CH_COMPATIBLE (TREE_OPERAND (label_value, 1), | |
1591 | TREE_TYPE (TREE_VALUE (tagfields)))) | |
1592 | compat_error = 1; | |
1593 | } | |
1594 | } | |
1595 | else if (TREE_CODE (label_value) == TYPE_DECL) | |
1596 | { | |
1597 | if (!CH_COMPATIBLE (label_value, | |
1598 | TREE_TYPE (TREE_VALUE (tagfields)))) | |
1599 | compat_error = 1; | |
1600 | } | |
1601 | else if (TREE_CODE (label_value) == INTEGER_CST) | |
1602 | { | |
1603 | if (!CH_COMPATIBLE (label_value, | |
1604 | TREE_TYPE (TREE_VALUE (tagfields)))) | |
1605 | compat_error = 1; | |
1606 | } | |
1607 | if (compat_error) | |
1608 | { | |
1609 | if (TYPE_FIELDS (t) == NULL_TREE) | |
1610 | error ("inconsistent modes between labels and tag field"); | |
1611 | else | |
1612 | error_with_decl (TYPE_FIELDS (t), | |
1613 | "inconsistent modes between labels and tag field"); | |
1614 | } | |
3c79b2da PB |
1615 | } |
1616 | } | |
1617 | if (tagfields != NULL_TREE) | |
1618 | error ("too few tag labels"); | |
1619 | if (taglist != NULL_TREE) | |
1620 | error ("too many tag labels"); | |
1621 | } | |
1622 | ||
058ebd7e DB |
1623 | /* Compute the number of labels to be checked for duplicates. */ |
1624 | nlabels = 0; | |
1625 | for (decl = first; decl; decl = TREE_CHAIN (decl)) | |
1626 | { | |
1627 | tree t = TREE_TYPE (decl); | |
1628 | /* Only one tag (first case_label_list) supported, for now. */ | |
1629 | tree labellist = TYPE_TAG_VALUES (t); | |
1630 | if (labellist) | |
1631 | labellist = TREE_VALUE (labellist); | |
1632 | ||
1633 | for (; labellist != NULL_TREE; labellist = TREE_CHAIN (labellist)) | |
1634 | if (TREE_CODE (TREE_VALUE (labellist)) == INTEGER_CST) | |
1635 | nlabels++; | |
1636 | } | |
1637 | ||
3c79b2da PB |
1638 | /* Check for duplicate label values. */ |
1639 | label_value_array = (struct tree_pair *)alloca (nlabels * sizeof (struct tree_pair)); | |
1640 | for (decl = first; decl; decl = TREE_CHAIN (decl)) | |
1641 | { | |
1642 | tree t = TREE_TYPE (decl); | |
1643 | /* Only one tag (first case_label_list) supported, for now. */ | |
1644 | tree labellist = TYPE_TAG_VALUES (t); | |
1645 | if (labellist) | |
1646 | labellist = TREE_VALUE (labellist); | |
1647 | ||
1648 | for (; labellist != NULL_TREE; labellist = TREE_CHAIN (labellist)) | |
1649 | { | |
1650 | struct tree_pair p; | |
1651 | ||
1652 | tree x = TREE_VALUE (labellist); | |
1653 | if (TREE_CODE (x) == RANGE_EXPR) | |
1654 | { | |
1655 | if (TREE_OPERAND (x, 0) != NULL_TREE) | |
1656 | { | |
1657 | if (TREE_CODE (TREE_OPERAND (x, 0)) != INTEGER_CST) | |
1658 | error ("case label lower limit is not a discrete constant expression"); | |
1659 | if (TREE_CODE (TREE_OPERAND (x, 1)) != INTEGER_CST) | |
1660 | error ("case label upper limit is not a discrete constant expression"); | |
1661 | } | |
1662 | continue; | |
1663 | } | |
1664 | else if (TREE_CODE (x) == TYPE_DECL) | |
1665 | continue; | |
1666 | else if (TREE_CODE (x) == ERROR_MARK) | |
1667 | continue; | |
1668 | else if (TREE_CODE (x) != INTEGER_CST) /* <-- FIXME: what about CONST_DECLs? */ | |
1669 | { | |
1670 | error ("case label must be a discrete constant expression"); | |
1671 | continue; | |
1672 | } | |
1673 | ||
1674 | if (TREE_CODE (x) == CONST_DECL) | |
1675 | x = DECL_INITIAL (x); | |
1676 | if (TREE_CODE (x) != INTEGER_CST) abort (); | |
1677 | p.value = x; | |
1678 | p.decl = decl; | |
1679 | if (p.decl == NULL_TREE) | |
1680 | p.decl = TREE_VALUE (labellist); | |
1681 | label_value_array[label_index++] = p; | |
1682 | } | |
1683 | } | |
1684 | if (errorcount == 0) | |
1685 | { | |
1686 | int limit; | |
1687 | qsort (label_value_array, | |
31029ad7 | 1688 | label_index, sizeof (struct tree_pair), |
3b0d91ff | 1689 | (int (*) PARAMS ((const void *, const void *))) label_value_cmp); |
3c79b2da PB |
1690 | limit = label_index - 1; |
1691 | for (label_index = 0; label_index < limit; label_index++) | |
1692 | { | |
1693 | if (tree_int_cst_equal (label_value_array[label_index].value, | |
1694 | label_value_array[label_index+1].value)) | |
1695 | { | |
1696 | error_with_decl (label_value_array[label_index].decl, | |
1697 | "variant label declared here..."); | |
1698 | error_with_decl (label_value_array[label_index+1].decl, | |
1699 | "...is duplicated here"); | |
1700 | } | |
1701 | } | |
1702 | } | |
1703 | layout_type (utype); | |
1704 | return utype; | |
1705 | } | |
1706 | \f | |
1707 | /* Convert a TREE_LIST of tag field names into a list of | |
1708 | field decls, found from FIXED_FIELDS, re-using the input list. */ | |
1709 | ||
1710 | tree | |
1711 | lookup_tag_fields (tag_field_names, fixed_fields) | |
1712 | tree tag_field_names; | |
1713 | tree fixed_fields; | |
1714 | { | |
1715 | tree list; | |
1716 | for (list = tag_field_names; list != NULL_TREE; list = TREE_CHAIN (list)) | |
1717 | { | |
1718 | tree decl = fixed_fields; | |
1719 | for ( ; decl != NULL_TREE; decl = TREE_CHAIN (decl)) | |
1720 | { | |
1721 | if (DECL_NAME (decl) == TREE_VALUE (list)) | |
1722 | { | |
1723 | TREE_VALUE (list) = decl; | |
1724 | break; | |
1725 | } | |
1726 | } | |
1727 | if (decl == NULL_TREE) | |
1728 | { | |
1729 | error ("no field (yet) for tag %s", | |
1730 | IDENTIFIER_POINTER (TREE_VALUE (list))); | |
1731 | TREE_VALUE (list) = error_mark_node; | |
1732 | } | |
1733 | } | |
1734 | return tag_field_names; | |
1735 | } | |
1736 | ||
1737 | /* If non-NULL, TAGFIELDS is the tag fields for this variant record. | |
1738 | BODY is a TREE_LIST of (optlabels, fixed fields). | |
1739 | If non-null, VARIANTELSE is a fixed field for the else part of the | |
1740 | variant record. */ | |
1741 | ||
1742 | tree | |
1743 | grok_chill_variantdefs (tagfields, body, variantelse) | |
1744 | tree tagfields, body, variantelse; | |
1745 | { | |
1746 | tree t; | |
1747 | ||
1748 | t = make_chill_variants (tagfields, body, variantelse); | |
1749 | if (pass != 1) | |
1750 | t = layout_chill_variants (t); | |
1751 | return build_decl (FIELD_DECL, NULL_TREE, t); | |
1752 | } | |
1753 | \f | |
1754 | /* | |
1755 | In pass 1, PARMS is a list of types (with attributes). | |
1756 | In pass 2, PARMS is a chain of PARM_DECLs. | |
1757 | */ | |
1758 | ||
1759 | int | |
1760 | start_chill_function (label, rtype, parms, exceptlist, attrs) | |
1761 | tree label, rtype, parms, exceptlist, attrs; | |
1762 | { | |
1763 | tree decl, fndecl, type, result_type, func_type; | |
1764 | int nested = current_function_decl != 0; | |
1765 | if (pass == 1) | |
1766 | { | |
1767 | func_type | |
1768 | = build_chill_function_type (rtype, parms, exceptlist, 0); | |
1769 | fndecl = build_decl (FUNCTION_DECL, label, func_type); | |
1770 | ||
1771 | save_decl (fndecl); | |
1772 | ||
1773 | /* Make the init_value nonzero so pushdecl knows this is not tentative. | |
1774 | error_mark_node is replaced below (in poplevel) with the BLOCK. */ | |
1775 | DECL_INITIAL (fndecl) = error_mark_node; | |
1776 | ||
1777 | DECL_EXTERNAL (fndecl) = 0; | |
1778 | ||
1779 | /* This function exists in static storage. | |
1780 | (This does not mean `static' in the C sense!) */ | |
1781 | TREE_STATIC (fndecl) = 1; | |
1782 | ||
1783 | for (; attrs != NULL_TREE; attrs = TREE_CHAIN (attrs)) | |
1784 | { | |
1785 | if (TREE_VALUE (attrs) == ridpointers[RID_GENERAL]) | |
1786 | CH_DECL_GENERAL (fndecl) = 1; | |
1787 | else if (TREE_VALUE (attrs) == ridpointers[RID_SIMPLE]) | |
1788 | CH_DECL_SIMPLE (fndecl) = 1; | |
1789 | else if (TREE_VALUE (attrs) == ridpointers[RID_RECURSIVE]) | |
1790 | CH_DECL_RECURSIVE (fndecl) = 1; | |
1791 | else if (TREE_VALUE (attrs) == ridpointers[RID_INLINE]) | |
1792 | DECL_INLINE (fndecl) = 1; | |
1793 | else | |
1794 | abort (); | |
1795 | } | |
1796 | } | |
1797 | else /* pass == 2 */ | |
1798 | { | |
1799 | fndecl = get_next_decl (); | |
1800 | if (DECL_NAME (fndecl) != label) | |
1801 | abort (); /* outta sync - got wrong decl */ | |
1802 | func_type = TREE_TYPE (fndecl); | |
1803 | if (TYPE_RAISES_EXCEPTIONS (func_type) != NULL_TREE) | |
1804 | { | |
1805 | /* In this case we have to add 2 parameters. | |
1806 | See build_chill_function_type (pass == 1). */ | |
1807 | tree arg; | |
1808 | ||
1809 | arg = make_node (PARM_DECL); | |
1810 | DECL_ASSEMBLER_NAME (arg) = DECL_NAME (arg) = get_identifier (CALLER_FILE); | |
1811 | DECL_IGNORED_P (arg) = 1; | |
1812 | parms = chainon (parms, arg); | |
1813 | ||
1814 | arg = make_node (PARM_DECL); | |
1815 | DECL_ASSEMBLER_NAME (arg) = DECL_NAME (arg) = get_identifier (CALLER_LINE); | |
1816 | DECL_IGNORED_P (arg) = 1; | |
1817 | parms = chainon (parms, arg); | |
1818 | } | |
1819 | } | |
1820 | ||
1821 | current_function_decl = fndecl; | |
1822 | result_type = TREE_TYPE (func_type); | |
1823 | if (CH_TYPE_NONVALUE_P (result_type)) | |
1824 | error ("non-value mode may only returned by LOC"); | |
1825 | ||
1826 | pushlevel (1); /* Push parameters. */ | |
1827 | ||
1828 | if (pass == 2) | |
1829 | { | |
1830 | DECL_ARGUMENTS (fndecl) = parms; | |
1831 | for (decl = DECL_ARGUMENTS (fndecl), type = TYPE_ARG_TYPES (func_type); | |
1832 | decl != NULL_TREE; | |
1833 | decl = TREE_CHAIN (decl), type = TREE_CHAIN (type)) | |
1834 | { | |
1835 | /* check here that modes with the non-value property (like | |
1836 | BUFFER's, EVENT's, ASSOCIATION's, ACCESS's, or TEXT's) only | |
1837 | gets passed by LOC */ | |
1838 | tree argtype = TREE_VALUE (type); | |
1839 | tree argattr = TREE_PURPOSE (type); | |
1840 | ||
1841 | if (TREE_CODE (argtype) == REFERENCE_TYPE) | |
1842 | argtype = TREE_TYPE (argtype); | |
1843 | ||
1844 | if (TREE_CODE (argtype) != ERROR_MARK && | |
1845 | TREE_CODE_CLASS (TREE_CODE (argtype)) != 't') | |
1846 | { | |
1847 | error_with_decl (decl, "mode of `%s' is not a mode"); | |
1848 | TREE_VALUE (type) = error_mark_node; | |
1849 | } | |
1850 | ||
1851 | if (CH_TYPE_NONVALUE_P (argtype) && | |
1852 | argattr != ridpointers[(int) RID_LOC]) | |
1853 | error_with_decl (decl, "`%s' may only be passed by LOC"); | |
1854 | TREE_TYPE (decl) = TREE_VALUE (type); | |
1855 | DECL_ARG_TYPE (decl) = TREE_TYPE (decl); | |
1856 | DECL_CONTEXT (decl) = fndecl; | |
1857 | TREE_READONLY (decl) = TYPE_READONLY (argtype); | |
1858 | layout_decl (decl, 0); | |
1859 | } | |
1860 | ||
1861 | pushdecllist (DECL_ARGUMENTS (fndecl), 0); | |
1862 | ||
1863 | DECL_RESULT (current_function_decl) | |
1864 | = build_decl (RESULT_DECL, NULL_TREE, result_type); | |
1865 | ||
1866 | #if 0 | |
1867 | /* Write a record describing this function definition to the prototypes | |
1868 | file (if requested). */ | |
1869 | gen_aux_info_record (fndecl, 1, 0, prototype); | |
1870 | #endif | |
1871 | ||
1872 | if (fndecl != global_function_decl || seen_action) | |
1873 | { | |
1874 | /* Initialize the RTL code for the function. */ | |
1875 | init_function_start (fndecl, input_filename, lineno); | |
1876 | ||
1877 | /* Set up parameters and prepare for return, for the function. */ | |
1878 | expand_function_start (fndecl, 0); | |
1879 | } | |
1880 | ||
1881 | if (!nested) | |
1882 | /* Allocate further tree nodes temporarily during compilation | |
1883 | of this function only. */ | |
1884 | temporary_allocation (); | |
1885 | ||
1886 | /* If this fcn was already referenced via a block-scope `extern' decl (or | |
1887 | an implicit decl), propagate certain information about the usage. */ | |
1888 | if (TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (current_function_decl))) | |
1889 | TREE_ADDRESSABLE (current_function_decl) = 1; | |
1890 | } | |
1891 | ||
1892 | /* Z.200 requires that formal parameter names be defined in | |
1893 | the same block as the procedure body. | |
1894 | We could do this by keeping boths sets of DECLs in the same | |
1895 | scope, but we would have to be careful to not merge the | |
1896 | two chains (e.g. DECL_ARGUEMENTS musr not contains locals). | |
1897 | Instead, we just make sure they have the same nesting_level. */ | |
1898 | current_nesting_level--; | |
1899 | pushlevel (1); /* Push local variables. */ | |
1900 | ||
1901 | if (pass == 2 && (fndecl != global_function_decl || seen_action)) | |
1902 | { | |
1903 | /* generate label for possible 'exit' */ | |
1904 | expand_start_bindings (1); | |
1905 | ||
1906 | result_never_set = 1; | |
1907 | } | |
1908 | ||
1909 | if (TREE_CODE (result_type) == VOID_TYPE) | |
1910 | chill_result_decl = NULL_TREE; | |
1911 | else | |
1912 | { | |
1913 | /* We use the same name as the keyword. | |
1914 | This makes it easy to print and change the RESULT from gdb. */ | |
31029ad7 KG |
1915 | const char *result_str = |
1916 | (ignore_case || ! special_UC) ? "result" : "RESULT"; | |
3c79b2da PB |
1917 | if (pass == 2 && TREE_CODE (result_type) == ERROR_MARK) |
1918 | TREE_TYPE (current_scope->remembered_decls) = result_type; | |
1919 | chill_result_decl = do_decl (get_identifier (result_str), | |
1920 | result_type, 0, 0, 0, 0); | |
1921 | DECL_CONTEXT (chill_result_decl) = fndecl; | |
1922 | } | |
1923 | ||
1924 | return 1; | |
1925 | } | |
1926 | \f | |
1927 | /* For checking purpose added pname as new argument | |
1928 | MW Wed Oct 14 14:22:10 1992 */ | |
1929 | void | |
1930 | finish_chill_function () | |
1931 | { | |
1932 | register tree fndecl = current_function_decl; | |
1933 | tree outer_function = decl_function_context (fndecl); | |
1934 | int nested; | |
1935 | if (outer_function == NULL_TREE && fndecl != global_function_decl) | |
1936 | outer_function = global_function_decl; | |
1937 | nested = current_function_decl != global_function_decl; | |
1938 | if (pass == 2 && (fndecl != global_function_decl || seen_action)) | |
1939 | expand_end_bindings (getdecls (), 1, 0); | |
1940 | ||
1941 | /* pop out of function */ | |
1942 | poplevel (1, 1, 0); | |
1943 | current_nesting_level++; | |
1944 | /* pop out of its parameters */ | |
1945 | poplevel (1, 0, 1); | |
1946 | ||
1947 | if (pass == 2) | |
1948 | { | |
1949 | /* TREE_READONLY (fndecl) = 1; | |
1950 | This caused &foo to be of type ptr-to-const-function which | |
1951 | then got a warning when stored in a ptr-to-function variable. */ | |
1952 | ||
1953 | BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl; | |
1954 | ||
1955 | /* Must mark the RESULT_DECL as being in this function. */ | |
1956 | ||
1957 | DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl; | |
1958 | ||
1959 | if (fndecl != global_function_decl || seen_action) | |
1960 | { | |
1961 | /* Generate rtl for function exit. */ | |
1962 | expand_function_end (input_filename, lineno, 0); | |
1963 | ||
3c79b2da PB |
1964 | /* Run the optimizers and output assembler code for this function. */ |
1965 | rest_of_compilation (fndecl); | |
1966 | } | |
1967 | ||
1968 | if (DECL_SAVED_INSNS (fndecl) == 0 && ! nested) | |
1969 | { | |
1970 | /* Stop pointing to the local nodes about to be freed. */ | |
1971 | /* But DECL_INITIAL must remain nonzero so we know this | |
1972 | was an actual function definition. */ | |
1973 | /* For a nested function, this is done in pop_chill_function_context. */ | |
1974 | DECL_INITIAL (fndecl) = error_mark_node; | |
1975 | DECL_ARGUMENTS (fndecl) = 0; | |
1976 | } | |
1977 | } | |
1978 | current_function_decl = outer_function; | |
1979 | } | |
1980 | \f | |
1981 | /* process SEIZE */ | |
1982 | ||
1983 | /* Points to the head of the _DECLs read from seize files. */ | |
1984 | #if 0 | |
1985 | static tree seized_decls; | |
1986 | ||
1987 | static tree processed_seize_files = 0; | |
1988 | #endif | |
1989 | ||
1990 | void | |
1991 | chill_seize (old_prefix, new_prefix, postfix) | |
1992 | tree old_prefix, new_prefix, postfix; | |
1993 | { | |
1994 | if (pass == 1) | |
1995 | { | |
1996 | tree decl = build_alias_decl (old_prefix, new_prefix, postfix); | |
1997 | DECL_SEIZEFILE(decl) = use_seizefile_name; | |
1998 | save_decl (decl); | |
1999 | } | |
2000 | else /* pass == 2 */ | |
2001 | { | |
2002 | /* Do nothing - get_next_decl automatically ignores ALIAS_DECLs */ | |
2003 | } | |
2004 | } | |
2005 | #if 0 | |
2006 | \f | |
2007 | /* | |
2008 | * output a debug dump of a scope structure | |
2009 | */ | |
2010 | void | |
2011 | debug_scope (sp) | |
2012 | struct scope *sp; | |
2013 | { | |
2014 | if (sp == (struct scope *)NULL) | |
2015 | { | |
2016 | fprintf (stderr, "null scope ptr\n"); | |
2017 | return; | |
2018 | } | |
2019 | fprintf (stderr, "enclosing 0x%x ", sp->enclosing); | |
2020 | fprintf (stderr, "next 0x%x ", sp->next); | |
2021 | fprintf (stderr, "remembered_decls 0x%x ", sp->remembered_decls); | |
2022 | fprintf (stderr, "decls 0x%x\n", sp->decls); | |
2023 | fprintf (stderr, "shadowed 0x%x ", sp->shadowed); | |
2024 | fprintf (stderr, "blocks 0x%x ", sp->blocks); | |
2025 | fprintf (stderr, "this_block 0x%x ", sp->this_block); | |
2026 | fprintf (stderr, "level_chain 0x%x\n", sp->level_chain); | |
2027 | fprintf (stderr, "module_flag %c ", sp->module_flag ? 'T' : 'F'); | |
2028 | fprintf (stderr, "first_child_module 0x%x ", sp->first_child_module); | |
2029 | fprintf (stderr, "next_sibling_module 0x%x\n", sp->next_sibling_module); | |
2030 | if (sp->remembered_decls != NULL_TREE) | |
2031 | { | |
2032 | tree temp; | |
2033 | fprintf (stderr, "remembered_decl chain:\n"); | |
2034 | for (temp = sp->remembered_decls; temp; temp = TREE_CHAIN (temp)) | |
2035 | debug_tree (temp); | |
2036 | } | |
2037 | } | |
2038 | #endif | |
2039 | \f | |
2040 | static void | |
2041 | save_decl (decl) | |
2042 | tree decl; | |
2043 | { | |
2044 | if (current_function_decl != global_function_decl) | |
2045 | DECL_CONTEXT (decl) = current_function_decl; | |
2046 | ||
2047 | TREE_CHAIN (decl) = current_scope->remembered_decls; | |
2048 | current_scope->remembered_decls = decl; | |
2049 | #if 0 | |
2050 | fprintf (stderr, "\n\nsave_decl 0x%x\n", decl); | |
2051 | debug_scope (current_scope); /* ************* */ | |
2052 | #endif | |
2053 | set_nesting_level (decl, current_nesting_level); | |
2054 | } | |
2055 | ||
2056 | static tree | |
2057 | get_next_decl () | |
2058 | { | |
2059 | tree decl; | |
2060 | do | |
2061 | { | |
2062 | decl = current_scope->remembered_decls; | |
2063 | current_scope->remembered_decls = TREE_CHAIN (decl); | |
2064 | /* We ignore ALIAS_DECLs, because push_scope_decls | |
2065 | can convert a single ALIAS_DECL representing 'SEIZE ALL' | |
2066 | into one ALIAS_DECL for each seizeable name. | |
2067 | This means we lose the nice one-to-one mapping | |
2068 | between pass 1 decls and pass 2 decls. | |
2069 | (Perhaps ALIAS_DECLs should not be on the remembered_decls list.) */ | |
2070 | } while (decl && TREE_CODE (decl) == ALIAS_DECL); | |
2071 | return decl; | |
2072 | } | |
2073 | ||
2074 | /* At the end of pass 1, we reverse the chronological chain of scopes. */ | |
2075 | ||
2076 | void | |
2077 | switch_to_pass_2 () | |
2078 | { | |
75111422 | 2079 | #if 0 |
3c79b2da | 2080 | extern int errorcount, sorrycount; |
75111422 | 2081 | #endif |
3c79b2da PB |
2082 | if (current_scope != &builtin_scope) |
2083 | abort (); | |
2084 | last_scope = &builtin_scope; | |
2085 | builtin_scope.remembered_decls = nreverse (builtin_scope.remembered_decls); | |
2086 | write_grant_file (); | |
2087 | ||
2088 | #if 0 | |
2089 | if (errorcount || sorrycount) | |
2090 | exit (FATAL_EXIT_CODE); | |
2091 | else | |
2092 | #endif | |
2093 | if (grant_only_flag) | |
2094 | exit (SUCCESS_EXIT_CODE); | |
2095 | ||
2096 | pass = 2; | |
2097 | module_number = 0; | |
2098 | next_module = &first_module; | |
2099 | } | |
2100 | \f | |
2101 | /* | |
2102 | * Called during pass 2, when we're processing actions, to | |
2103 | * generate a temporary variable. These don't need satisfying | |
2104 | * because they're compiler-generated and always declared | |
2105 | * before they're used. | |
2106 | */ | |
2107 | tree | |
2108 | decl_temp1 (name, type, opt_static, opt_init, | |
2109 | opt_external, opt_public) | |
2110 | tree name, type; | |
2111 | int opt_static; | |
2112 | tree opt_init; | |
2113 | int opt_external, opt_public; | |
2114 | { | |
2115 | int orig_pass = pass; /* be cautious */ | |
2116 | tree mydecl; | |
2117 | ||
2118 | pass = 1; | |
2119 | mydecl = do_decl (name, type, opt_static, opt_static, | |
2120 | opt_init, opt_external); | |
2121 | ||
2122 | if (opt_public) | |
2123 | TREE_PUBLIC (mydecl) = 1; | |
2124 | pass = 2; | |
2125 | do_decl (name, type, opt_static, opt_static, opt_init, opt_external); | |
2126 | ||
2127 | pass = orig_pass; | |
2128 | return mydecl; | |
2129 | } | |
2130 | \f | |
2131 | /* True if we're reading a seizefile, but we haven't seen a SPEC MODULE yet. | |
2132 | For backwards compatibility, we treat declarations in such a context | |
2133 | as implicity granted. */ | |
2134 | ||
2135 | tree | |
2136 | set_module_name (name) | |
2137 | tree name; | |
2138 | { | |
2139 | module_number++; | |
2140 | if (name == NULL_TREE) | |
2141 | { | |
2142 | /* NOTE: build_prefix_clause assumes a generated | |
2143 | module starts with a '_'. */ | |
2144 | char buf[20]; | |
2145 | sprintf (buf, "_MODULE_%d", module_number); | |
2146 | name = get_identifier (buf); | |
2147 | } | |
2148 | return name; | |
2149 | } | |
2150 | ||
2151 | tree | |
2152 | push_module (name, is_spec_module) | |
2153 | tree name; | |
2154 | int is_spec_module; | |
2155 | { | |
2156 | struct module *new_module; | |
2157 | if (pass == 1) | |
2158 | { | |
2159 | new_module = (struct module*) permalloc (sizeof (struct module)); | |
2160 | new_module->prev_module = current_module; | |
2161 | ||
2162 | *next_module = new_module; | |
2163 | } | |
2164 | else | |
2165 | { | |
2166 | new_module = *next_module; | |
2167 | } | |
2168 | next_module = &new_module->next_module; | |
2169 | ||
2170 | new_module->procedure_seen = 0; | |
2171 | new_module->is_spec_module = is_spec_module; | |
2172 | new_module->name = name; | |
2173 | if (current_module) | |
2174 | new_module->prefix_name | |
2175 | = get_identifier3 (IDENTIFIER_POINTER (current_module->prefix_name), | |
2176 | "__", IDENTIFIER_POINTER (name)); | |
2177 | else | |
2178 | new_module->prefix_name = name; | |
2179 | ||
2180 | new_module->granted_decls = NULL_TREE; | |
2181 | new_module->nesting_level = current_nesting_level + 1; | |
2182 | ||
2183 | current_module = new_module; | |
2184 | current_module_nesting_level = new_module->nesting_level; | |
2185 | in_pseudo_module = name ? 0 : 1; | |
2186 | ||
2187 | pushlevel (1); | |
2188 | ||
2189 | current_scope->module_flag = 1; | |
2190 | ||
2191 | *current_scope->enclosing->tail_child_module = current_scope; | |
2192 | current_scope->enclosing->tail_child_module | |
2193 | = ¤t_scope->next_sibling_module; | |
2194 | ||
2195 | /* Rename the global function to have the same name as | |
2196 | the first named non-spec module. */ | |
2197 | if (!is_spec_module | |
2198 | && IDENTIFIER_POINTER (name)[0] != '_' | |
2199 | && IDENTIFIER_POINTER (DECL_NAME (global_function_decl))[0] == '_') | |
2200 | { | |
2201 | tree fname = get_identifier3 ("", IDENTIFIER_POINTER (name), "_"); | |
2202 | DECL_NAME (global_function_decl) = fname; | |
2203 | DECL_ASSEMBLER_NAME (global_function_decl) = fname; | |
2204 | } | |
2205 | ||
2206 | return name; /* may have generated a name */ | |
2207 | } | |
2208 | /* Make a copy of the identifier NAME, replacing each '!' by '__'. */ | |
31029ad7 | 2209 | static tree |
3c79b2da PB |
2210 | fix_identifier (name) |
2211 | tree name; | |
2212 | { | |
2213 | char *buf = (char*)alloca (2 * IDENTIFIER_LENGTH (name) + 1); | |
2214 | int fixed = 0; | |
2215 | register char *dptr = buf; | |
31029ad7 | 2216 | register const char *sptr = IDENTIFIER_POINTER (name); |
3c79b2da PB |
2217 | for (; *sptr; sptr++) |
2218 | { | |
2219 | if (*sptr == '!') | |
2220 | { | |
2221 | *dptr++ = '_'; | |
2222 | *dptr++ = '_'; | |
2223 | fixed++; | |
2224 | } | |
2225 | else | |
2226 | *dptr++ = *sptr; | |
2227 | } | |
2228 | *dptr = '\0'; | |
2229 | return fixed ? get_identifier (buf) : name; | |
2230 | } | |
2231 | \f | |
2232 | void | |
2233 | find_granted_decls () | |
2234 | { | |
2235 | if (pass == 1) | |
2236 | { | |
2237 | /* Match each granted name to a granted decl. */ | |
2238 | ||
2239 | tree alias = current_module->granted_decls; | |
2240 | tree next_alias, decl; | |
2241 | /* This is an O(M*N) algorithm. FIXME! */ | |
2242 | for (; alias; alias = next_alias) | |
2243 | { | |
2244 | int found = 0; | |
2245 | next_alias = TREE_CHAIN (alias); | |
2246 | for (decl = current_scope->remembered_decls; | |
2247 | decl; decl = TREE_CHAIN (decl)) | |
2248 | { | |
2249 | tree new_name = (! DECL_NAME (decl)) ? NULL_TREE : | |
2250 | decl_check_rename (alias, | |
2251 | DECL_NAME (decl)); | |
2252 | ||
2253 | if (!new_name) | |
2254 | continue; | |
2255 | /* A Seized declaration is not grantable. */ | |
2256 | if (TREE_CODE (decl) == ALIAS_DECL && !CH_DECL_GRANTED (decl)) | |
2257 | continue; | |
2258 | found = 1; | |
2259 | if (global_bindings_p ()) | |
2260 | TREE_PUBLIC (decl) = 1; | |
2261 | if (DECL_ASSEMBLER_NAME (decl) == NULL_TREE) | |
2262 | DECL_ASSEMBLER_NAME (decl) = fix_identifier (new_name); | |
2263 | if (DECL_POSTFIX_ALL (alias)) | |
2264 | { | |
2265 | tree new_alias | |
2266 | = build_alias_decl (NULL_TREE, NULL_TREE, new_name); | |
2267 | TREE_CHAIN (new_alias) = TREE_CHAIN (alias); | |
2268 | TREE_CHAIN (alias) = new_alias; | |
2269 | DECL_ABSTRACT_ORIGIN (new_alias) = decl; | |
2270 | DECL_SOURCE_LINE (new_alias) = 0; | |
2271 | DECL_SEIZEFILE (new_alias) = DECL_SEIZEFILE (alias); | |
2272 | } | |
2273 | else | |
2274 | { | |
2275 | DECL_ABSTRACT_ORIGIN (alias) = decl; | |
2276 | break; | |
2277 | } | |
2278 | } | |
2279 | if (!found) | |
2280 | { | |
c725bd79 | 2281 | error_with_decl (alias, "nothing named `%s' to grant"); |
3c79b2da PB |
2282 | DECL_ABSTRACT_ORIGIN (alias) = error_mark_node; |
2283 | } | |
2284 | } | |
2285 | } | |
2286 | } | |
2287 | ||
2288 | void | |
2289 | pop_module () | |
2290 | { | |
2291 | tree decl; | |
2292 | struct scope *module_scope = current_scope; | |
2293 | ||
2294 | poplevel (0, 0, 0); | |
2295 | ||
2296 | if (pass == 1) | |
2297 | { | |
2298 | /* Write out the grant file. */ | |
2299 | if (!current_module->is_spec_module) | |
2300 | { | |
2301 | /* After reversal, TREE_CHAIN (last_old_decl) is the oldest | |
2302 | decl of the current module. */ | |
2303 | write_spec_module (module_scope->remembered_decls, | |
2304 | current_module->granted_decls); | |
2305 | } | |
2306 | ||
2307 | /* Move the granted decls into the enclosing scope. */ | |
2308 | if (current_scope == global_scope) | |
2309 | { | |
2310 | tree next_decl; | |
2311 | for (decl = current_module->granted_decls; decl; decl = next_decl) | |
2312 | { | |
2313 | tree name = DECL_NAME (decl); | |
2314 | next_decl = TREE_CHAIN (decl); | |
2315 | if (name != NULL_TREE) | |
2316 | { | |
2317 | tree old_decl = IDENTIFIER_OUTER_VALUE (name); | |
2318 | set_nesting_level (decl, current_nesting_level); | |
2319 | if (old_decl != NULL_TREE) | |
2320 | { | |
2321 | pedwarn_with_decl (decl, "duplicate grant for `%s'"); | |
2322 | pedwarn_with_decl (old_decl, "previous grant for `%s'"); | |
2323 | TREE_CHAIN (decl) = TREE_CHAIN (old_decl); | |
2324 | TREE_CHAIN (old_decl) = decl; | |
2325 | } | |
2326 | else | |
2327 | { | |
2328 | TREE_CHAIN (decl) = outer_decls; | |
2329 | outer_decls = decl; | |
2330 | IDENTIFIER_OUTER_VALUE (name) = decl; | |
2331 | } | |
2332 | } | |
2333 | } | |
2334 | } | |
2335 | else | |
2336 | current_scope->granted_decls = chainon (current_module->granted_decls, | |
2337 | current_scope->granted_decls); | |
2338 | } | |
2339 | ||
2340 | chill_check_no_handlers (); /* Sanity test */ | |
2341 | current_module = current_module->prev_module; | |
2342 | current_module_nesting_level = current_module ? | |
2343 | current_module->nesting_level : 0; | |
2344 | in_pseudo_module = 0; | |
2345 | } | |
2346 | \f | |
2347 | /* Nonzero if we are currently in the global binding level. */ | |
2348 | ||
2349 | int | |
2350 | global_bindings_p () | |
2351 | { | |
2352 | /* We return -1 here for the sake of variable_size() in ../stor-layout.c. */ | |
2353 | return (current_function_decl == NULL_TREE | |
2354 | || current_function_decl == global_function_decl) ? -1 : 0; | |
2355 | } | |
2356 | ||
2357 | /* Nonzero if the current level needs to have a BLOCK made. */ | |
2358 | ||
2359 | int | |
2360 | kept_level_p () | |
2361 | { | |
2362 | return current_scope->decls != 0; | |
2363 | } | |
2364 | ||
2365 | /* Make DECL visible. | |
2366 | Save any existing definition. | |
2367 | Check redefinitions at the same level. | |
2368 | Suppress error messages if QUIET is true. */ | |
2369 | ||
31029ad7 | 2370 | static void |
3c79b2da PB |
2371 | proclaim_decl (decl, quiet) |
2372 | tree decl; | |
2373 | int quiet; | |
2374 | { | |
2375 | tree name = DECL_NAME (decl); | |
2376 | if (name) | |
2377 | { | |
2378 | tree old_decl = IDENTIFIER_LOCAL_VALUE (name); | |
2379 | if (old_decl == NULL) ; /* No duplication */ | |
2380 | else if (DECL_NESTING_LEVEL (old_decl) != current_nesting_level) | |
2381 | { | |
2382 | /* Record for restoration when this binding level ends. */ | |
2383 | current_scope->shadowed | |
2384 | = tree_cons (name, old_decl, current_scope->shadowed); | |
2385 | } | |
2386 | else if (DECL_WEAK_NAME (decl)) | |
2387 | return; | |
2388 | else if (!DECL_WEAK_NAME (old_decl)) | |
2389 | { | |
2390 | tree base_decl = decl, base_old_decl = old_decl; | |
2391 | while (TREE_CODE (base_decl) == ALIAS_DECL) | |
2392 | base_decl = DECL_ABSTRACT_ORIGIN (base_decl); | |
2393 | while (TREE_CODE (base_old_decl) == ALIAS_DECL) | |
2394 | base_old_decl = DECL_ABSTRACT_ORIGIN (base_old_decl); | |
2395 | /* Note that duplicate definitions are allowed for set elements | |
2396 | of similar set modes. See Z200 (1988) 12.2.2. | |
2397 | However, if the types are identical, we are defining the | |
2398 | same name multiple times in the same SET, which is naughty. */ | |
2399 | if (!quiet && base_decl != base_old_decl) | |
2400 | { | |
2401 | if (TREE_CODE (base_decl) != CONST_DECL | |
2402 | || TREE_CODE (base_old_decl) != CONST_DECL | |
2403 | || !CH_DECL_ENUM (base_decl) | |
2404 | || !CH_DECL_ENUM (base_old_decl) | |
2405 | || TREE_TYPE (base_decl) == TREE_TYPE (base_old_decl) | |
2406 | || !CH_SIMILAR (TREE_TYPE (base_decl), | |
2407 | TREE_TYPE(base_old_decl))) | |
2408 | { | |
2409 | error_with_decl (decl, "duplicate definition `%s'"); | |
2410 | error_with_decl (old_decl, "previous definition of `%s'"); | |
2411 | } | |
2412 | } | |
2413 | } | |
2414 | IDENTIFIER_LOCAL_VALUE (name) = decl; | |
2415 | } | |
2416 | /* Should be redundant most of the time ... */ | |
2417 | set_nesting_level (decl, current_nesting_level); | |
2418 | } | |
2419 | ||
2420 | /* Return tree_cons (NULL_TREE, ELEMENT, LIST) unless ELEMENT | |
2421 | is already in LIST, in which case return LIST. */ | |
2422 | ||
2423 | static tree | |
2424 | maybe_acons (element, list) | |
2425 | tree element, list; | |
2426 | { | |
2427 | tree pair; | |
2428 | for (pair = list; pair; pair = TREE_CHAIN (pair)) | |
2429 | if (element == TREE_VALUE (pair)) | |
2430 | return list; | |
2431 | return tree_cons (NULL_TREE, element, list); | |
2432 | } | |
2433 | ||
2434 | struct path | |
2435 | { | |
2436 | struct path *prev; | |
2437 | tree node; | |
2438 | }; | |
31029ad7 | 2439 | |
3b0d91ff | 2440 | static tree find_implied_types PARAMS ((tree, struct path *, tree)); |
3c79b2da PB |
2441 | \f |
2442 | /* Look for implied types (enumeral types) implied by TYPE (a decl or type). | |
2443 | Add these to list. | |
2444 | Use old_path to guard against cycles. */ | |
2445 | ||
31029ad7 | 2446 | static tree |
3c79b2da PB |
2447 | find_implied_types (type, old_path, list) |
2448 | tree type; | |
2449 | struct path *old_path; | |
2450 | tree list; | |
2451 | { | |
2452 | struct path path[1], *link; | |
2453 | if (type == NULL_TREE) | |
2454 | return list; | |
2455 | path[0].prev = old_path; | |
2456 | path[0].node = type; | |
2457 | ||
2458 | /* Check for a cycle. Something more clever might be appropriate. FIXME? */ | |
2459 | for (link = old_path; link; link = link->prev) | |
2460 | if (link->node == type) | |
2461 | return list; | |
2462 | ||
2463 | switch (TREE_CODE (type)) | |
2464 | { | |
2465 | case ENUMERAL_TYPE: | |
2466 | return maybe_acons (type, list); | |
2467 | case LANG_TYPE: | |
2468 | case POINTER_TYPE: | |
2469 | case REFERENCE_TYPE: | |
2470 | case INTEGER_TYPE: | |
2471 | return find_implied_types (TREE_TYPE (type), path, list); | |
2472 | case SET_TYPE: | |
2473 | return find_implied_types (TYPE_DOMAIN (type), path, list); | |
2474 | case FUNCTION_TYPE: | |
2475 | #if 0 | |
2476 | case PROCESS_TYPE: | |
2477 | #endif | |
2478 | { tree t; | |
2479 | list = find_implied_types (TREE_TYPE (type), path, list); | |
2480 | for (t = TYPE_ARG_TYPES (type); t != NULL_TREE; t = TREE_CHAIN (t)) | |
2481 | list = find_implied_types (TREE_VALUE (t), path, list); | |
2482 | return list; | |
2483 | } | |
2484 | case ARRAY_TYPE: | |
2485 | list = find_implied_types (TYPE_DOMAIN (type), path, list); | |
2486 | return find_implied_types (TREE_TYPE (type), path, list); | |
2487 | case RECORD_TYPE: | |
2488 | case UNION_TYPE: | |
2489 | { tree fields; | |
2490 | for (fields = TYPE_FIELDS (type); fields != NULL_TREE; | |
2491 | fields = TREE_CHAIN (fields)) | |
2492 | list = find_implied_types (TREE_TYPE (fields), path, list); | |
2493 | return list; | |
2494 | } | |
2495 | ||
2496 | case IDENTIFIER_NODE: | |
2497 | return find_implied_types (lookup_name (type), path, list); | |
2498 | break; | |
2499 | case ALIAS_DECL: | |
2500 | return find_implied_types (DECL_ABSTRACT_ORIGIN (type), path, list); | |
2501 | case VAR_DECL: | |
2502 | case FUNCTION_DECL: | |
2503 | case TYPE_DECL: | |
2504 | return find_implied_types (TREE_TYPE (type), path, list); | |
2505 | default: | |
2506 | return list; | |
2507 | } | |
2508 | } | |
2509 | \f | |
2510 | /* Make declarations in current scope visible. | |
2511 | Also, expand SEIZEs, and make correspondong ALIAS_DECLs visible. */ | |
2512 | ||
2513 | static void | |
2514 | push_scope_decls (quiet) | |
2515 | int quiet; /* If 1, we're pre-scanning, so suppress errors. */ | |
2516 | { | |
2517 | tree decl; | |
2518 | ||
2519 | /* First make everything except 'SEIZE ALL' names visible, before | |
2520 | handling 'SEIZE ALL'. (This makes it easier to check 'seizable'). */ | |
2521 | for (decl = current_scope->remembered_decls; decl; decl = TREE_CHAIN (decl)) | |
2522 | { | |
2523 | if (TREE_CODE (decl) == ALIAS_DECL) | |
2524 | { | |
2525 | if (DECL_POSTFIX_ALL (decl)) | |
2526 | continue; | |
2527 | if (DECL_ABSTRACT_ORIGIN (decl) == NULL_TREE) | |
2528 | { | |
2529 | tree val = lookup_name_for_seizing (decl); | |
2530 | if (val == NULL_TREE) | |
2531 | { | |
2532 | error_with_file_and_line | |
2533 | (DECL_SOURCE_FILE (decl), DECL_SOURCE_LINE (decl), | |
2534 | "cannot SEIZE `%s'", | |
2535 | IDENTIFIER_POINTER (DECL_OLD_NAME (decl))); | |
2536 | val = error_mark_node; | |
2537 | } | |
2538 | DECL_ABSTRACT_ORIGIN (decl) = val; | |
2539 | } | |
2540 | } | |
2541 | proclaim_decl (decl, quiet); | |
2542 | } | |
2543 | ||
2544 | pushdecllist (current_scope->granted_decls, quiet); | |
2545 | ||
2546 | /* Now handle SEIZE ALLs. */ | |
2547 | for (decl = current_scope->remembered_decls; decl; ) | |
2548 | { | |
2549 | tree next_decl = TREE_CHAIN (decl); | |
2550 | if (TREE_CODE (decl) == ALIAS_DECL | |
2551 | && DECL_ABSTRACT_ORIGIN (decl) == NULL_TREE | |
2552 | && DECL_POSTFIX_ALL (decl)) | |
2553 | { | |
2554 | /* We saw a "SEIZE ALL". Replace it be a SEIZE for each | |
2555 | declaration visible in the surrounding scope. | |
2556 | Note that this complicates get_next_decl(). */ | |
2557 | tree candidate; | |
2558 | tree last_new_alias = decl; | |
2559 | DECL_ABSTRACT_ORIGIN (decl) = error_mark_node; | |
2560 | if (current_scope->enclosing == global_scope) | |
2561 | candidate = outer_decls; | |
2562 | else | |
2563 | candidate = current_scope->enclosing->decls; | |
2564 | for ( ; candidate; candidate = TREE_CHAIN (candidate)) | |
2565 | { | |
2566 | tree seizename = DECL_NAME (candidate); | |
2567 | tree new_name; | |
2568 | tree new_alias; | |
2569 | if (!seizename) | |
2570 | continue; | |
2571 | new_name = decl_check_rename (decl, seizename); | |
2572 | if (!new_name) | |
2573 | continue; | |
2574 | ||
2575 | /* Check if candidate is seizable. */ | |
2576 | if (lookup_name (new_name) != NULL_TREE) | |
2577 | continue; | |
2578 | ||
2579 | new_alias = build_alias_decl (NULL_TREE,NULL_TREE, new_name); | |
2580 | TREE_CHAIN (new_alias) = TREE_CHAIN (last_new_alias); | |
2581 | TREE_CHAIN (last_new_alias) = new_alias; | |
2582 | last_new_alias = new_alias; | |
2583 | DECL_ABSTRACT_ORIGIN (new_alias) = candidate; | |
2584 | DECL_SOURCE_LINE (new_alias) = 0; | |
2585 | ||
2586 | proclaim_decl (new_alias, quiet); | |
2587 | } | |
2588 | } | |
2589 | decl = next_decl; | |
2590 | } | |
2591 | ||
2592 | /* Link current_scope->remembered_decls at the head of the | |
2593 | current_scope->decls list (just like pushdecllist, but | |
2594 | without calling proclaim_decl, since we've already done that). */ | |
2595 | if ((decl = current_scope->remembered_decls) != NULL_TREE) | |
2596 | { | |
2597 | while (TREE_CHAIN (decl) != NULL_TREE) | |
2598 | decl = TREE_CHAIN (decl); | |
2599 | TREE_CHAIN (decl) = current_scope->decls; | |
2600 | current_scope->decls = current_scope->remembered_decls; | |
2601 | } | |
2602 | } | |
2603 | ||
2604 | static void | |
2605 | pop_scope_decls (decls_limit, shadowed_limit) | |
2606 | tree decls_limit, shadowed_limit; | |
2607 | { | |
2608 | /* Remove the temporary bindings we made. */ | |
2609 | tree link = current_scope->shadowed; | |
2610 | tree decl = current_scope->decls; | |
2611 | if (decl != decls_limit) | |
2612 | { | |
2613 | while (decl != decls_limit) | |
2614 | { | |
2615 | tree next = TREE_CHAIN (decl); | |
2616 | if (DECL_NAME (decl)) | |
2617 | { | |
2618 | /* If the ident. was used or addressed via a local extern decl, | |
2619 | don't forget that fact. */ | |
2620 | if (DECL_EXTERNAL (decl)) | |
2621 | { | |
2622 | if (TREE_USED (decl)) | |
2623 | TREE_USED (DECL_NAME (decl)) = 1; | |
2624 | if (TREE_ADDRESSABLE (decl)) | |
2625 | TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (decl)) = 1; | |
2626 | } | |
2627 | IDENTIFIER_LOCAL_VALUE (DECL_NAME (decl)) = 0; | |
2628 | } | |
2629 | if (next == decls_limit) | |
2630 | { | |
2631 | TREE_CHAIN (decl) = NULL_TREE; | |
2632 | break; | |
2633 | } | |
2634 | decl = next; | |
2635 | } | |
2636 | current_scope->decls = decls_limit; | |
2637 | } | |
2638 | ||
2639 | /* Restore all name-meanings of the outer levels | |
2640 | that were shadowed by this level. */ | |
2641 | for ( ; link != shadowed_limit; link = TREE_CHAIN (link)) | |
2642 | IDENTIFIER_LOCAL_VALUE (TREE_PURPOSE (link)) = TREE_VALUE (link); | |
2643 | current_scope->shadowed = shadowed_limit; | |
2644 | } | |
2645 | ||
2646 | /* Return list of weak names (as ALIAS_DECLs) implied by IMPLIED_TYPES. */ | |
2647 | ||
2648 | static tree | |
2649 | build_implied_names (implied_types) | |
2650 | tree implied_types; | |
2651 | { | |
2652 | tree aliases = NULL_TREE; | |
2653 | ||
2654 | for ( ; implied_types; implied_types = TREE_CHAIN (implied_types)) | |
2655 | { | |
2656 | tree enum_type = TREE_VALUE (implied_types); | |
2657 | tree link = TYPE_VALUES (enum_type); | |
2658 | if (TREE_CODE (enum_type) != ENUMERAL_TYPE) | |
2659 | abort (); | |
2660 | ||
2661 | for ( ; link; link = TREE_CHAIN (link)) | |
2662 | { | |
2663 | /* We don't handle renaming/prefixes (Blue Book p 163) FIXME */ | |
2664 | /* Note that before enum_type is laid out, TREE_VALUE (link) | |
2665 | is a CONST_DECL, while after it is laid out, | |
2666 | TREE_VALUE (link) is an INTEGER_CST. Either works. */ | |
2667 | tree alias | |
2668 | = build_alias_decl (NULL_TREE, NULL_TREE, TREE_PURPOSE (link)); | |
2669 | DECL_ABSTRACT_ORIGIN (alias) = TREE_VALUE (link); | |
2670 | DECL_WEAK_NAME (alias) = 1; | |
2671 | TREE_CHAIN (alias) = aliases; | |
2672 | aliases = alias; | |
2673 | /* Strictlt speaking, we should have a pointer from the alias | |
2674 | to the decl, so we can make sure that the alias is only | |
2675 | visible when the decl is. FIXME */ | |
2676 | } | |
2677 | } | |
2678 | return aliases; | |
2679 | } | |
2680 | ||
2681 | static void | |
2682 | bind_sub_modules (do_weak) | |
2683 | int do_weak; | |
2684 | { | |
2685 | tree decl; | |
2686 | int save_module_nesting_level = current_module_nesting_level; | |
2687 | struct scope *saved_scope = current_scope; | |
2688 | struct scope *nested_module = current_scope->first_child_module; | |
2689 | ||
2690 | while (nested_module != NULL) | |
2691 | { | |
2692 | tree saved_shadowed = nested_module->shadowed; | |
2693 | tree saved_decls = nested_module->decls; | |
2694 | current_nesting_level++; | |
2695 | current_scope = nested_module; | |
2696 | current_module_nesting_level = current_nesting_level; | |
2697 | if (do_weak == 0) | |
2698 | push_scope_decls (1); | |
2699 | else | |
2700 | { | |
2701 | tree implied_types = NULL_TREE; | |
2702 | /* Push weak names implied by decls in current_scope. */ | |
2703 | for (decl = current_scope->remembered_decls; | |
2704 | decl; decl = TREE_CHAIN (decl)) | |
2705 | if (TREE_CODE (decl) == ALIAS_DECL) | |
2706 | implied_types = find_implied_types (decl, NULL, implied_types); | |
2707 | for (decl = current_scope->granted_decls; | |
2708 | decl; decl = TREE_CHAIN (decl)) | |
2709 | implied_types = find_implied_types (decl, NULL, implied_types); | |
2710 | current_scope->weak_decls = build_implied_names (implied_types); | |
2711 | pushdecllist (current_scope->weak_decls, 1); | |
2712 | } | |
2713 | ||
2714 | bind_sub_modules (do_weak); | |
2715 | for (decl = current_scope->remembered_decls; | |
2716 | decl; decl = TREE_CHAIN (decl)) | |
2717 | satisfy_decl (decl, 1); | |
2718 | pop_scope_decls (saved_decls, saved_shadowed); | |
2719 | current_nesting_level--; | |
2720 | nested_module = nested_module->next_sibling_module; | |
2721 | } | |
2722 | ||
2723 | current_scope = saved_scope; | |
2724 | current_module_nesting_level = save_module_nesting_level; | |
2725 | } | |
2726 | \f | |
2727 | /* Enter a new binding level. | |
2728 | If two_pass==0, assume we are called from non-Chill-specific parts | |
2729 | of the compiler. These parts assume a single pass. | |
2730 | If two_pass==1, we're called from Chill parts of the compiler. | |
2731 | */ | |
2732 | ||
2733 | void | |
2734 | pushlevel (two_pass) | |
2735 | int two_pass; | |
2736 | { | |
2737 | register struct scope *newlevel; | |
2738 | ||
2739 | current_nesting_level++; | |
2740 | if (!two_pass) | |
2741 | { | |
2742 | newlevel = (struct scope *)xmalloc (sizeof(struct scope)); | |
2743 | *newlevel = clear_scope; | |
2744 | newlevel->enclosing = current_scope; | |
2745 | current_scope = newlevel; | |
2746 | } | |
2747 | else if (pass < 2) | |
2748 | { | |
2749 | newlevel = (struct scope *)permalloc (sizeof(struct scope)); | |
2750 | *newlevel = clear_scope; | |
2751 | newlevel->tail_child_module = &newlevel->first_child_module; | |
2752 | newlevel->enclosing = current_scope; | |
2753 | current_scope = newlevel; | |
2754 | last_scope->next = newlevel; | |
2755 | last_scope = newlevel; | |
2756 | } | |
2757 | else /* pass == 2 */ | |
2758 | { | |
2759 | tree decl; | |
2760 | newlevel = current_scope = last_scope = last_scope->next; | |
2761 | ||
2762 | push_scope_decls (0); | |
2763 | pushdecllist (current_scope->weak_decls, 0); | |
2764 | ||
2765 | /* If this is not a module scope, scan ahead for locally nested | |
2766 | modules. (If this is a module, that's already done.) */ | |
2767 | if (!current_scope->module_flag) | |
2768 | { | |
2769 | bind_sub_modules (0); | |
2770 | bind_sub_modules (1); | |
2771 | } | |
2772 | ||
2773 | for (decl = current_scope->remembered_decls; | |
2774 | decl; decl = TREE_CHAIN (decl)) | |
2775 | satisfy_decl (decl, 0); | |
2776 | } | |
2777 | ||
2778 | /* Add this level to the front of the chain (stack) of levels that | |
2779 | are active. */ | |
2780 | ||
2781 | newlevel->level_chain = current_scope; | |
2782 | current_scope = newlevel; | |
2783 | ||
2784 | newlevel->two_pass = two_pass; | |
2785 | } | |
2786 | \f | |
2787 | /* Exit a binding level. | |
2788 | Pop the level off, and restore the state of the identifier-decl mappings | |
2789 | that were in effect when this level was entered. | |
2790 | ||
2791 | If KEEP is nonzero, this level had explicit declarations, so | |
2792 | and create a "block" (a BLOCK node) for the level | |
2793 | to record its declarations and subblocks for symbol table output. | |
2794 | ||
2795 | If FUNCTIONBODY is nonzero, this level is the body of a function, | |
2796 | so create a block as if KEEP were set and also clear out all | |
2797 | label names. | |
2798 | ||
2799 | If REVERSE is nonzero, reverse the order of decls before putting | |
2800 | them into the BLOCK. */ | |
2801 | ||
2802 | tree | |
2803 | poplevel (keep, reverse, functionbody) | |
2804 | int keep; | |
2805 | int reverse; | |
2806 | int functionbody; | |
2807 | { | |
2808 | register tree link; | |
2809 | /* The chain of decls was accumulated in reverse order. | |
2810 | Put it into forward order, just for cleanliness. */ | |
2811 | tree decls; | |
2812 | tree subblocks; | |
2813 | tree block = 0; | |
2814 | tree decl; | |
ed730bcf | 2815 | int block_previously_created = 0; |
3c79b2da PB |
2816 | |
2817 | if (current_scope == NULL) | |
2818 | return error_mark_node; | |
2819 | ||
2820 | subblocks = current_scope->blocks; | |
2821 | ||
2822 | /* Get the decls in the order they were written. | |
2823 | Usually current_scope->decls is in reverse order. | |
2824 | But parameter decls were previously put in forward order. */ | |
2825 | ||
2826 | if (reverse) | |
2827 | current_scope->decls | |
2828 | = decls = nreverse (current_scope->decls); | |
2829 | else | |
2830 | decls = current_scope->decls; | |
2831 | ||
2832 | if (pass == 2) | |
2833 | { | |
2834 | /* Output any nested inline functions within this block | |
2835 | if they weren't already output. */ | |
2836 | ||
2837 | for (decl = decls; decl; decl = TREE_CHAIN (decl)) | |
2838 | if (TREE_CODE (decl) == FUNCTION_DECL | |
2839 | && ! TREE_ASM_WRITTEN (decl) | |
2840 | && DECL_INITIAL (decl) != 0 | |
2841 | && TREE_ADDRESSABLE (decl)) | |
2842 | { | |
2843 | /* If this decl was copied from a file-scope decl | |
2844 | on account of a block-scope extern decl, | |
2845 | propagate TREE_ADDRESSABLE to the file-scope decl. */ | |
2846 | if (DECL_ABSTRACT_ORIGIN (decl) != 0) | |
2847 | TREE_ADDRESSABLE (DECL_ABSTRACT_ORIGIN (decl)) = 1; | |
2848 | else | |
2849 | { | |
2850 | push_function_context (); | |
2851 | output_inline_function (decl); | |
2852 | pop_function_context (); | |
2853 | } | |
2854 | } | |
2855 | ||
2856 | /* Clear out the meanings of the local variables of this level. */ | |
2857 | pop_scope_decls (NULL_TREE, NULL_TREE); | |
2858 | ||
2859 | /* If there were any declarations or structure tags in that level, | |
2860 | or if this level is a function body, | |
2861 | create a BLOCK to record them for the life of this function. */ | |
2862 | ||
2863 | block = 0; | |
2864 | block_previously_created = (current_scope->this_block != 0); | |
2865 | if (block_previously_created) | |
2866 | block = current_scope->this_block; | |
2867 | else if (keep || functionbody) | |
2868 | block = make_node (BLOCK); | |
2869 | if (block != 0) | |
2870 | { | |
2871 | tree *ptr; | |
2872 | BLOCK_VARS (block) = decls; | |
2873 | ||
2874 | /* Splice out ALIAS_DECL and LABEL_DECLs, | |
2875 | since instantiate_decls can't handle them. */ | |
2876 | for (ptr = &BLOCK_VARS (block); *ptr; ) | |
2877 | { | |
2878 | decl = *ptr; | |
2879 | if (TREE_CODE (decl) == ALIAS_DECL | |
2880 | || TREE_CODE (decl) == LABEL_DECL) | |
2881 | *ptr = TREE_CHAIN (decl); | |
2882 | else | |
2883 | ptr = &TREE_CHAIN(*ptr); | |
2884 | } | |
2885 | ||
2886 | BLOCK_SUBBLOCKS (block) = subblocks; | |
3c79b2da PB |
2887 | } |
2888 | ||
2889 | /* In each subblock, record that this is its superior. */ | |
2890 | ||
2891 | for (link = subblocks; link; link = TREE_CHAIN (link)) | |
2892 | BLOCK_SUPERCONTEXT (link) = block; | |
2893 | ||
2894 | } | |
2895 | ||
2896 | /* If the level being exited is the top level of a function, | |
2897 | check over all the labels, and clear out the current | |
2898 | (function local) meanings of their names. */ | |
2899 | ||
2900 | if (pass == 2 && functionbody) | |
2901 | { | |
2902 | /* If this is the top level block of a function, | |
2903 | the vars are the function's parameters. | |
2904 | Don't leave them in the BLOCK because they are | |
2905 | found in the FUNCTION_DECL instead. */ | |
2906 | ||
2907 | BLOCK_VARS (block) = 0; | |
2908 | ||
2909 | #if 0 | |
2910 | /* Clear out the definitions of all label names, | |
2911 | since their scopes end here, | |
2912 | and add them to BLOCK_VARS. */ | |
2913 | ||
2914 | for (link = named_labels; link; link = TREE_CHAIN (link)) | |
2915 | { | |
2916 | register tree label = TREE_VALUE (link); | |
2917 | ||
2918 | if (DECL_INITIAL (label) == 0) | |
2919 | { | |
2920 | error_with_decl (label, "label `%s' used but not defined"); | |
2921 | /* Avoid crashing later. */ | |
2922 | define_label (input_filename, lineno, | |
2923 | DECL_NAME (label)); | |
2924 | } | |
078721e1 | 2925 | else if (warn_unused_label && !TREE_USED (label)) |
3c79b2da PB |
2926 | warning_with_decl (label, "label `%s' defined but not used"); |
2927 | IDENTIFIER_LABEL_VALUE (DECL_NAME (label)) = 0; | |
2928 | ||
2929 | /* Put the labels into the "variables" of the | |
2930 | top-level block, so debugger can see them. */ | |
2931 | TREE_CHAIN (label) = BLOCK_VARS (block); | |
2932 | BLOCK_VARS (block) = label; | |
2933 | } | |
2934 | #endif | |
2935 | } | |
2936 | ||
2937 | if (pass < 2) | |
2938 | { | |
2939 | current_scope->remembered_decls | |
2940 | = nreverse (current_scope->remembered_decls); | |
2941 | current_scope->granted_decls = nreverse (current_scope->granted_decls); | |
2942 | } | |
2943 | ||
2944 | current_scope = current_scope->enclosing; | |
2945 | current_nesting_level--; | |
2946 | ||
2947 | if (pass < 2) | |
2948 | { | |
2949 | return NULL_TREE; | |
2950 | } | |
2951 | ||
2952 | /* Dispose of the block that we just made inside some higher level. */ | |
2953 | if (functionbody) | |
2954 | DECL_INITIAL (current_function_decl) = block; | |
2955 | else if (block) | |
2956 | { | |
2957 | if (!block_previously_created) | |
2958 | current_scope->blocks | |
2959 | = chainon (current_scope->blocks, block); | |
2960 | } | |
2961 | /* If we did not make a block for the level just exited, | |
2962 | any blocks made for inner levels | |
2963 | (since they cannot be recorded as subblocks in that level) | |
2964 | must be carried forward so they will later become subblocks | |
2965 | of something else. */ | |
2966 | else if (subblocks) | |
2967 | current_scope->blocks | |
2968 | = chainon (current_scope->blocks, subblocks); | |
2969 | ||
2970 | if (block) | |
2971 | TREE_USED (block) = 1; | |
2972 | return block; | |
2973 | } | |
2974 | \f | |
2975 | /* Delete the node BLOCK from the current binding level. | |
2976 | This is used for the block inside a stmt expr ({...}) | |
2977 | so that the block can be reinserted where appropriate. */ | |
2978 | ||
2979 | void | |
2980 | delete_block (block) | |
2981 | tree block; | |
2982 | { | |
2983 | tree t; | |
2984 | if (current_scope->blocks == block) | |
2985 | current_scope->blocks = TREE_CHAIN (block); | |
2986 | for (t = current_scope->blocks; t;) | |
2987 | { | |
2988 | if (TREE_CHAIN (t) == block) | |
2989 | TREE_CHAIN (t) = TREE_CHAIN (block); | |
2990 | else | |
2991 | t = TREE_CHAIN (t); | |
2992 | } | |
2993 | TREE_CHAIN (block) = NULL; | |
2994 | /* Clear TREE_USED which is always set by poplevel. | |
2995 | The flag is set again if insert_block is called. */ | |
2996 | TREE_USED (block) = 0; | |
2997 | } | |
2998 | ||
2999 | /* Insert BLOCK at the end of the list of subblocks of the | |
3000 | current binding level. This is used when a BIND_EXPR is expanded, | |
3001 | to handle the BLOCK node inside teh BIND_EXPR. */ | |
3002 | ||
3003 | void | |
3004 | insert_block (block) | |
3005 | tree block; | |
3006 | { | |
3007 | TREE_USED (block) = 1; | |
3008 | current_scope->blocks | |
3009 | = chainon (current_scope->blocks, block); | |
3010 | } | |
3011 | ||
3012 | /* Set the BLOCK node for the innermost scope | |
3013 | (the one we are currently in). */ | |
3014 | ||
3015 | void | |
3016 | set_block (block) | |
3017 | register tree block; | |
3018 | { | |
3019 | current_scope->this_block = block; | |
9b58f739 RK |
3020 | current_scope->decls = chainon (current_scope->decls, BLOCK_VARS (block)); |
3021 | current_scope->blocks = chainon (current_scope->blocks, | |
3022 | BLOCK_SUBBLOCKS (block)); | |
3c79b2da PB |
3023 | } |
3024 | \f | |
3025 | /* Record a decl-node X as belonging to the current lexical scope. | |
3026 | Check for errors (such as an incompatible declaration for the same | |
3027 | name already seen in the same scope). | |
3028 | ||
3029 | Returns either X or an old decl for the same name. | |
3030 | If an old decl is returned, it may have been smashed | |
3031 | to agree with what X says. */ | |
3032 | ||
3033 | tree | |
3034 | pushdecl (x) | |
3035 | tree x; | |
3036 | { | |
3c79b2da PB |
3037 | register tree name = DECL_NAME (x); |
3038 | register struct scope *b = current_scope; | |
3039 | ||
3040 | DECL_CONTEXT (x) = current_function_decl; | |
3041 | /* A local extern declaration for a function doesn't constitute nesting. | |
3042 | A local auto declaration does, since it's a forward decl | |
3043 | for a nested function coming later. */ | |
3044 | if (TREE_CODE (x) == FUNCTION_DECL && DECL_INITIAL (x) == 0 | |
3045 | && DECL_EXTERNAL (x)) | |
3046 | DECL_CONTEXT (x) = 0; | |
3047 | ||
3048 | if (name) | |
3049 | proclaim_decl (x, 0); | |
3050 | ||
3051 | if (TREE_CODE (x) == TYPE_DECL && DECL_SOURCE_LINE (x) == 0 | |
3052 | && TYPE_NAME (TREE_TYPE (x)) == 0) | |
3053 | TYPE_NAME (TREE_TYPE (x)) = x; | |
3054 | ||
3055 | /* Put decls on list in reverse order. | |
3056 | We will reverse them later if necessary. */ | |
3057 | TREE_CHAIN (x) = b->decls; | |
3058 | b->decls = x; | |
3059 | ||
3060 | return x; | |
3061 | } | |
3062 | \f | |
3063 | /* Make DECLS (a chain of decls) visible in the current_scope. */ | |
3064 | ||
3065 | static void | |
3066 | pushdecllist (decls, quiet) | |
3067 | tree decls; | |
3068 | int quiet; | |
3069 | { | |
3070 | tree last = NULL_TREE, decl; | |
3071 | ||
3072 | for (decl = decls; decl != NULL_TREE; | |
3073 | last = decl, decl = TREE_CHAIN (decl)) | |
3074 | { | |
3075 | proclaim_decl (decl, quiet); | |
3076 | } | |
3077 | ||
3078 | if (last) | |
3079 | { | |
3080 | TREE_CHAIN (last) = current_scope->decls; | |
3081 | current_scope->decls = decls; | |
3082 | } | |
3083 | } | |
3084 | ||
3085 | /* Like pushdecl, only it places X in GLOBAL_SCOPE, if appropriate. */ | |
3086 | ||
3087 | tree | |
3088 | pushdecl_top_level (x) | |
3089 | tree x; | |
3090 | { | |
3091 | register tree t; | |
3092 | register struct scope *b = current_scope; | |
3093 | ||
3094 | current_scope = global_scope; | |
3095 | t = pushdecl (x); | |
3096 | current_scope = b; | |
3097 | return t; | |
3098 | } | |
3099 | \f | |
3100 | /* Define a label, specifying the location in the source file. | |
3101 | Return the LABEL_DECL node for the label, if the definition is valid. | |
3102 | Otherwise return 0. */ | |
3103 | ||
3104 | tree | |
3105 | define_label (filename, line, name) | |
3b304f5b | 3106 | const char *filename; |
3c79b2da PB |
3107 | int line; |
3108 | tree name; | |
3109 | { | |
3110 | tree decl; | |
3111 | ||
3112 | if (pass == 1) | |
3113 | { | |
3114 | decl = build_decl (LABEL_DECL, name, void_type_node); | |
3115 | ||
3116 | /* A label not explicitly declared must be local to where it's ref'd. */ | |
3117 | DECL_CONTEXT (decl) = current_function_decl; | |
3118 | ||
3119 | DECL_MODE (decl) = VOIDmode; | |
3120 | ||
3121 | /* Say where one reference is to the label, | |
3122 | for the sake of the error if it is not defined. */ | |
3123 | DECL_SOURCE_LINE (decl) = line; | |
3124 | DECL_SOURCE_FILE (decl) = filename; | |
3125 | ||
3126 | /* Mark label as having been defined. */ | |
3127 | DECL_INITIAL (decl) = error_mark_node; | |
3128 | ||
3129 | DECL_ACTION_NESTING_LEVEL (decl) = action_nesting_level; | |
3130 | ||
3131 | save_decl (decl); | |
3132 | } | |
3133 | else | |
3134 | { | |
3135 | decl = get_next_decl (); | |
3136 | /* Make sure every label has an rtx. */ | |
3137 | ||
3138 | label_rtx (decl); | |
3139 | expand_label (decl); | |
3140 | } | |
3141 | return decl; | |
3142 | } | |
3143 | \f | |
3144 | /* Return the list of declarations of the current level. | |
3145 | Note that this list is in reverse order unless/until | |
3146 | you nreverse it; and when you do nreverse it, you must | |
3147 | store the result back using `storedecls' or you will lose. */ | |
3148 | ||
3149 | tree | |
3150 | getdecls () | |
3151 | { | |
3152 | /* This is a kludge, so that dbxout_init can get the predefined types, | |
3153 | which are in the builtin_scope, though when it is called, | |
3154 | the current_scope is the global_scope.. */ | |
3155 | if (current_scope == global_scope) | |
3156 | return builtin_scope.decls; | |
3157 | return current_scope->decls; | |
3158 | } | |
3159 | ||
3160 | #if 0 | |
3161 | /* Store the list of declarations of the current level. | |
3162 | This is done for the parameter declarations of a function being defined, | |
3163 | after they are modified in the light of any missing parameters. */ | |
3164 | ||
3165 | static void | |
3166 | storedecls (decls) | |
3167 | tree decls; | |
3168 | { | |
3169 | current_scope->decls = decls; | |
3170 | } | |
3171 | #endif | |
3172 | \f | |
3173 | /* Look up NAME in the current binding level and its superiors | |
3174 | in the namespace of variables, functions and typedefs. | |
3175 | Return a ..._DECL node of some kind representing its definition, | |
3176 | or return 0 if it is undefined. */ | |
3177 | ||
3178 | tree | |
3179 | lookup_name (name) | |
3180 | tree name; | |
3181 | { | |
3182 | register tree val = IDENTIFIER_LOCAL_VALUE (name); | |
3183 | ||
3184 | if (val == NULL_TREE) | |
3185 | return NULL_TREE; | |
3186 | if (TREE_CODE_CLASS (TREE_CODE (val)) == 'c') | |
3187 | return val; | |
3188 | if (DECL_NESTING_LEVEL (val) > BUILTIN_NESTING_LEVEL | |
3189 | && DECL_NESTING_LEVEL (val) < current_module_nesting_level) | |
3190 | { | |
3191 | return NULL_TREE; | |
3192 | } | |
3193 | while (TREE_CODE (val) == ALIAS_DECL) | |
3194 | { | |
3195 | val = DECL_ABSTRACT_ORIGIN (val); | |
3196 | if (TREE_CODE (val) == ERROR_MARK) | |
3197 | return NULL_TREE; | |
3198 | } | |
3199 | if (TREE_CODE (val) == BASED_DECL) | |
3200 | { | |
3201 | return build_chill_indirect_ref (DECL_ABSTRACT_ORIGIN (val), | |
3202 | TREE_TYPE (val), 1); | |
3203 | } | |
3204 | if (TREE_CODE (val) == WITH_DECL) | |
3205 | return build_component_ref (DECL_ABSTRACT_ORIGIN (val), DECL_NAME (val)); | |
3206 | return val; | |
3207 | } | |
3208 | ||
75111422 | 3209 | #if 0 |
3c79b2da PB |
3210 | /* Similar to `lookup_name' but look only at current binding level. */ |
3211 | ||
75111422 | 3212 | static tree |
3c79b2da PB |
3213 | lookup_name_current_level (name) |
3214 | tree name; | |
3215 | { | |
3216 | register tree val = IDENTIFIER_LOCAL_VALUE (name); | |
3217 | if (val && DECL_NESTING_LEVEL (val) == current_nesting_level) | |
3218 | return val; | |
3219 | return NULL_TREE; | |
3220 | } | |
75111422 | 3221 | #endif |
3c79b2da | 3222 | |
75111422 | 3223 | static tree |
3c79b2da PB |
3224 | lookup_name_for_seizing (seize_decl) |
3225 | tree seize_decl; | |
3226 | { | |
3227 | tree name = DECL_OLD_NAME (seize_decl); | |
3228 | register tree val; | |
3229 | val = IDENTIFIER_LOCAL_VALUE (name); | |
3230 | if (val == NULL_TREE || DECL_NESTING_LEVEL (val) == BUILTIN_NESTING_LEVEL) | |
3231 | { | |
3232 | val = IDENTIFIER_OUTER_VALUE (name); | |
3233 | if (val == NULL_TREE) | |
3234 | return NULL_TREE; | |
3235 | if (TREE_CHAIN (val) && DECL_NAME (TREE_CHAIN (val)) == name) | |
3236 | { /* More than one decl with the same name has been granted | |
3237 | into the same global scope. Pick the one (we hope) that | |
3238 | came from a seizefile the matches the most recent | |
3239 | seizefile (as given by DECL_SEIZEFILE (seize_decl).) */ | |
3240 | tree d, best = NULL_TREE; | |
3241 | for (d = val; d != NULL_TREE && DECL_NAME (d) == name; | |
3242 | d = TREE_CHAIN (d)) | |
3243 | if (DECL_SEIZEFILE (d) == DECL_SEIZEFILE (seize_decl)) | |
3244 | { | |
3245 | if (best) | |
3246 | { | |
3247 | error_with_decl (seize_decl, | |
3248 | "ambiguous choice for seize `%s' -"); | |
3249 | error_with_decl (best, " - can seize this `%s' -"); | |
3250 | error_with_decl (d, " - or this granted decl `%s'"); | |
3251 | return NULL_TREE; | |
3252 | } | |
3253 | best = d; | |
3254 | } | |
3255 | if (best == NULL_TREE) | |
3256 | { | |
3257 | error_with_decl (seize_decl, | |
3258 | "ambiguous choice for seize `%s' -"); | |
3259 | error_with_decl (val, " - can seize this `%s' -"); | |
3260 | error_with_decl (TREE_CHAIN (val), | |
3261 | " - or this granted decl `%s'"); | |
3262 | return NULL_TREE; | |
3263 | } | |
3264 | val = best; | |
3265 | } | |
3266 | } | |
3267 | #if 0 | |
3268 | /* We don't need to handle this, as long as we | |
3269 | resolve the seize targets before pushing them. */ | |
3270 | if (DECL_NESTING_LEVEL (val) >= current_module_nesting_level) | |
3271 | { | |
3272 | /* VAL was declared inside current module. We need something | |
3273 | from the scope *enclosing* the current module, so search | |
3274 | through the shadowed declarations. */ | |
3275 | /* TODO - FIXME */ | |
3276 | } | |
3277 | #endif | |
3278 | if (current_module && current_module->prev_module | |
3279 | && DECL_NESTING_LEVEL (val) | |
3280 | < current_module->prev_module->nesting_level) | |
3281 | { | |
3282 | ||
3283 | /* It's declared in a scope enclosing the module enclosing | |
3284 | the current module. Hence it's not visible. */ | |
3285 | return NULL_TREE; | |
3286 | } | |
3287 | while (TREE_CODE (val) == ALIAS_DECL) | |
3288 | { | |
3289 | val = DECL_ABSTRACT_ORIGIN (val); | |
3290 | if (TREE_CODE (val) == ERROR_MARK) | |
3291 | return NULL_TREE; | |
3292 | } | |
3293 | return val; | |
3294 | } | |
3295 | \f | |
3296 | /* Create the predefined scalar types of C, | |
3297 | and some nodes representing standard constants (0, 1, (void *)0). | |
3298 | Initialize the global binding level. | |
3299 | Make definitions for built-in primitive functions. */ | |
3300 | ||
3301 | void | |
3302 | init_decl_processing () | |
3303 | { | |
3304 | int wchar_type_size; | |
3305 | tree bool_ftype_int_ptr_int; | |
3306 | tree bool_ftype_int_ptr_int_int; | |
3307 | tree bool_ftype_luns_ptr_luns_long; | |
3308 | tree bool_ftype_luns_ptr_luns_long_ptr_int; | |
3309 | tree bool_ftype_ptr_int_ptr_int; | |
3310 | tree bool_ftype_ptr_int_ptr_int_int; | |
3311 | tree find_bit_ftype; | |
3312 | tree bool_ftype_ptr_ptr_int; | |
3313 | tree bool_ftype_ptr_ptr_luns; | |
3314 | tree bool_ftype_ptr_ptr_ptr_luns; | |
3315 | tree endlink; | |
3316 | tree int_ftype_int; | |
3317 | tree int_ftype_int_int; | |
3318 | tree int_ftype_int_ptr_int; | |
3319 | tree int_ftype_ptr; | |
3320 | tree int_ftype_ptr_int; | |
3321 | tree int_ftype_ptr_int_int_ptr_int; | |
3322 | tree int_ftype_ptr_luns_long_ptr_int; | |
3323 | tree int_ftype_ptr_ptr_int; | |
3324 | tree int_ftype_ptr_ptr_luns; | |
3325 | tree long_ftype_ptr_luns; | |
3326 | tree memcpy_ftype; | |
3327 | tree memcmp_ftype; | |
3328 | tree ptr_ftype_ptr_int_int; | |
3329 | tree ptr_ftype_ptr_ptr_int; | |
3330 | tree ptr_ftype_ptr_ptr_int_ptr_int; | |
3331 | tree real_ftype_real; | |
3332 | tree temp; | |
3333 | tree void_ftype_cptr_cptr_int; | |
3334 | tree void_ftype_long_int_ptr_int_ptr_int; | |
3335 | tree void_ftype_ptr; | |
3336 | tree void_ftype_ptr_int_int_int_int; | |
3337 | tree void_ftype_ptr_int_ptr_int_int_int; | |
3338 | tree void_ftype_ptr_int_ptr_int_ptr_int; | |
3339 | tree void_ftype_ptr_luns_long_long_bool_ptr_int; | |
3340 | tree void_ftype_ptr_luns_ptr_luns_luns_luns; | |
3341 | tree void_ftype_ptr_ptr_ptr_int; | |
3342 | tree void_ftype_ptr_ptr_ptr_luns; | |
3343 | tree void_ftype_refptr_int_ptr_int; | |
3344 | tree void_ftype_void; | |
3345 | tree void_ftype_ptr_ptr_int; | |
3346 | tree void_ftype_ptr_luns_luns_cptr_luns_luns_luns; | |
3347 | tree ptr_ftype_luns_ptr_int; | |
3348 | tree double_ftype_double; | |
3349 | ||
3c79b2da PB |
3350 | /* allow 0-255 enums to occupy only a byte */ |
3351 | flag_short_enums = 1; | |
3352 | ||
3353 | current_function_decl = NULL; | |
3354 | ||
3355 | set_alignment = BITS_PER_UNIT; | |
3356 | ||
3357 | ALL_POSTFIX = get_identifier ("*"); | |
3358 | string_index_type_dummy = get_identifier("%string-index%"); | |
3359 | ||
3360 | var_length_id = get_identifier (VAR_LENGTH); | |
3361 | var_data_id = get_identifier (VAR_DATA); | |
3362 | ||
81b3411c | 3363 | build_common_tree_nodes (1); |
3c79b2da PB |
3364 | |
3365 | if (CHILL_INT_IS_SHORT) | |
3366 | long_integer_type_node = integer_type_node; | |
3367 | else | |
3368 | long_integer_type_node = make_signed_type (LONG_TYPE_SIZE); | |
3369 | ||
3c79b2da PB |
3370 | /* `unsigned long' is the standard type for sizeof. |
3371 | Note that stddef.h uses `unsigned long', | |
3372 | and this must agree, even of long and int are the same size. */ | |
3373 | #ifndef SIZE_TYPE | |
81b3411c | 3374 | set_sizetype (long_unsigned_type_node); |
3c79b2da PB |
3375 | #else |
3376 | { | |
31029ad7 | 3377 | const char *size_type_c_name = SIZE_TYPE; |
3c79b2da | 3378 | if (strncmp (size_type_c_name, "long long ", 10) == 0) |
81b3411c | 3379 | set_sizetype (long_long_unsigned_type_node); |
3c79b2da | 3380 | else if (strncmp (size_type_c_name, "long ", 5) == 0) |
81b3411c | 3381 | set_sizetype (long_unsigned_type_node); |
3c79b2da | 3382 | else |
81b3411c | 3383 | set_sizetype (unsigned_type_node); |
3c79b2da PB |
3384 | } |
3385 | #endif | |
3386 | ||
3c79b2da PB |
3387 | pushdecl (build_decl (TYPE_DECL, ridpointers[(int) RID_FLOAT], |
3388 | float_type_node)); | |
3c79b2da PB |
3389 | pushdecl (build_decl (TYPE_DECL, ridpointers[(int) RID_DOUBLE], |
3390 | double_type_node)); | |
3c79b2da | 3391 | |
81b3411c | 3392 | build_common_tree_nodes_2 (flag_short_double); |
3c79b2da | 3393 | |
3c79b2da PB |
3394 | pushdecl (build_decl (TYPE_DECL, |
3395 | ridpointers[(int) RID_VOID], void_type_node)); | |
3c79b2da PB |
3396 | /* We are not going to have real types in C with less than byte alignment, |
3397 | so we might as well not have any types that claim to have it. */ | |
3398 | TYPE_ALIGN (void_type_node) = BITS_PER_UNIT; | |
11cf4d18 | 3399 | TYPE_USER_ALIGN (void_type_node) = 0; |
3c79b2da | 3400 | |
3c79b2da PB |
3401 | /* This is for wide string constants. */ |
3402 | wchar_type_node = short_unsigned_type_node; | |
3403 | wchar_type_size = TYPE_PRECISION (wchar_type_node); | |
3404 | signed_wchar_type_node = type_for_size (wchar_type_size, 0); | |
3405 | unsigned_wchar_type_node = type_for_size (wchar_type_size, 1); | |
3406 | ||
3407 | default_function_type | |
3408 | = build_function_type (integer_type_node, NULL_TREE); | |
3409 | ||
3410 | ptr_type_node = build_pointer_type (void_type_node); | |
3411 | const_ptr_type_node | |
3412 | = build_pointer_type (build_type_variant (void_type_node, 1, 0)); | |
3413 | ||
3414 | void_list_node = build_tree_list (NULL_TREE, void_type_node); | |
3415 | ||
3416 | boolean_type_node = make_node (BOOLEAN_TYPE); | |
3417 | TYPE_PRECISION (boolean_type_node) = 1; | |
3418 | fixup_unsigned_type (boolean_type_node); | |
3419 | boolean_false_node = TYPE_MIN_VALUE (boolean_type_node); | |
3420 | boolean_true_node = TYPE_MAX_VALUE (boolean_type_node); | |
3421 | pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_BOOL], | |
3422 | boolean_type_node)); | |
3423 | ||
3424 | /* TRUE and FALSE have the BOOL derived class */ | |
3425 | CH_DERIVED_FLAG (boolean_true_node) = 1; | |
3426 | CH_DERIVED_FLAG (boolean_false_node) = 1; | |
3427 | ||
3428 | signed_boolean_type_node = make_node (BOOLEAN_TYPE); | |
3429 | temp = build_int_2 (-1, -1); | |
3430 | TREE_TYPE (temp) = signed_boolean_type_node; | |
3431 | TYPE_MIN_VALUE (signed_boolean_type_node) = temp; | |
3432 | temp = build_int_2 (0, 0); | |
3433 | TREE_TYPE (temp) = signed_boolean_type_node; | |
3434 | TYPE_MAX_VALUE (signed_boolean_type_node) = temp; | |
3435 | layout_type (signed_boolean_type_node); | |
3436 | ||
3437 | ||
3438 | bitstring_one_type_node = build_bitstring_type (integer_one_node); | |
3439 | bit_zero_node = build (CONSTRUCTOR, bitstring_one_type_node, NULL_TREE, | |
3440 | NULL_TREE); | |
3441 | bit_one_node = build (CONSTRUCTOR, bitstring_one_type_node, NULL_TREE, | |
3442 | build_tree_list (NULL_TREE, integer_zero_node)); | |
3443 | ||
3c79b2da PB |
3444 | pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_CHAR], |
3445 | char_type_node)); | |
3446 | ||
3447 | if (CHILL_INT_IS_SHORT) | |
3448 | { | |
3449 | chill_integer_type_node = short_integer_type_node; | |
3450 | chill_unsigned_type_node = short_unsigned_type_node; | |
3451 | } | |
3452 | else | |
3453 | { | |
3454 | chill_integer_type_node = integer_type_node; | |
3455 | chill_unsigned_type_node = unsigned_type_node; | |
3456 | } | |
3457 | ||
3458 | string_one_type_node = build_string_type (char_type_node, integer_one_node); | |
3459 | ||
3460 | pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_BYTE], | |
3461 | signed_char_type_node)); | |
3462 | pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_UBYTE], | |
3463 | unsigned_char_type_node)); | |
3464 | ||
3465 | pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_INT], | |
3466 | chill_integer_type_node)); | |
3467 | ||
3468 | pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_UINT], | |
3469 | chill_unsigned_type_node)); | |
3470 | ||
3471 | pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_LONG], | |
3472 | long_integer_type_node)); | |
3473 | ||
81b3411c | 3474 | set_sizetype (long_integer_type_node); |
3c79b2da PB |
3475 | #if 0 |
3476 | ptrdiff_type_node | |
3477 | = TREE_TYPE (IDENTIFIER_LOCAL_VALUE (get_identifier (PTRDIFF_TYPE))); | |
3478 | #endif | |
3479 | pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_ULONG], | |
3480 | long_unsigned_type_node)); | |
3481 | pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_REAL], | |
3482 | float_type_node)); | |
3483 | pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_LONG_REAL], | |
3484 | double_type_node)); | |
3485 | pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_PTR], | |
3486 | ptr_type_node)); | |
3487 | ||
3488 | IDENTIFIER_LOCAL_VALUE (ridpointers[(int)RID_TRUE]) = | |
3489 | boolean_true_node; | |
3490 | IDENTIFIER_LOCAL_VALUE (ridpointers[(int)RID_FALSE]) = | |
3491 | boolean_false_node; | |
3492 | IDENTIFIER_LOCAL_VALUE (ridpointers[(int)RID_NULL]) = | |
3493 | null_pointer_node; | |
3494 | ||
3495 | /* The second operand is set to non-NULL to distinguish | |
3496 | (ELSE) from (*). Used when writing grant files. */ | |
3497 | case_else_node = build (RANGE_EXPR, | |
3498 | NULL_TREE, NULL_TREE, boolean_false_node); | |
3499 | ||
3500 | pushdecl (temp = build_decl (TYPE_DECL, | |
3501 | get_identifier ("__tmp_initializer"), | |
3502 | build_init_struct ())); | |
3503 | DECL_SOURCE_LINE (temp) = 0; | |
3504 | initializer_type = TREE_TYPE (temp); | |
3505 | ||
31029ad7 KG |
3506 | memcpy (tree_code_type + (int) LAST_AND_UNUSED_TREE_CODE, |
3507 | chill_tree_code_type, | |
3508 | (((int) LAST_CHILL_TREE_CODE - (int) LAST_AND_UNUSED_TREE_CODE) | |
3509 | * sizeof (char))); | |
3510 | memcpy (tree_code_length + (int) LAST_AND_UNUSED_TREE_CODE, | |
3511 | chill_tree_code_length, | |
3512 | (((int) LAST_CHILL_TREE_CODE - (int) LAST_AND_UNUSED_TREE_CODE) | |
3513 | * sizeof (int))); | |
3514 | memcpy (tree_code_name + (int) LAST_AND_UNUSED_TREE_CODE, | |
3515 | chill_tree_code_name, | |
3516 | (((int) LAST_CHILL_TREE_CODE - (int) LAST_AND_UNUSED_TREE_CODE) | |
3517 | * sizeof (char *))); | |
3518 | boolean_code_name = (const char **) xcalloc (sizeof (char *), | |
3519 | (int) LAST_CHILL_TREE_CODE); | |
3c79b2da PB |
3520 | |
3521 | boolean_code_name[EQ_EXPR] = "="; | |
3522 | boolean_code_name[NE_EXPR] = "/="; | |
3523 | boolean_code_name[LT_EXPR] = "<"; | |
3524 | boolean_code_name[GT_EXPR] = ">"; | |
3525 | boolean_code_name[LE_EXPR] = "<="; | |
3526 | boolean_code_name[GE_EXPR] = ">="; | |
3527 | boolean_code_name[SET_IN_EXPR] = "in"; | |
3528 | boolean_code_name[TRUTH_ANDIF_EXPR] = "andif"; | |
3529 | boolean_code_name[TRUTH_ORIF_EXPR] = "orif"; | |
3530 | boolean_code_name[TRUTH_AND_EXPR] = "and"; | |
3531 | boolean_code_name[TRUTH_OR_EXPR] = "or"; | |
3532 | boolean_code_name[BIT_AND_EXPR] = "and"; | |
3533 | boolean_code_name[BIT_IOR_EXPR] = "or"; | |
3534 | boolean_code_name[BIT_XOR_EXPR] = "xor"; | |
3535 | ||
3536 | endlink = void_list_node; | |
3537 | ||
3538 | chill_predefined_function_type | |
3539 | = build_function_type (integer_type_node, | |
3540 | tree_cons (NULL_TREE, integer_type_node, | |
3541 | endlink)); | |
3542 | ||
3543 | bool_ftype_int_ptr_int | |
3544 | = build_function_type (boolean_type_node, | |
3545 | tree_cons (NULL_TREE, integer_type_node, | |
3546 | tree_cons (NULL_TREE, ptr_type_node, | |
3547 | tree_cons (NULL_TREE, integer_type_node, | |
3548 | endlink)))); | |
3549 | bool_ftype_int_ptr_int | |
3550 | = build_function_type (boolean_type_node, | |
3551 | tree_cons (NULL_TREE, integer_type_node, | |
3552 | tree_cons (NULL_TREE, ptr_type_node, | |
3553 | tree_cons (NULL_TREE, integer_type_node, | |
3554 | tree_cons (NULL_TREE, integer_type_node, | |
3555 | endlink))))); | |
3556 | bool_ftype_int_ptr_int_int | |
3557 | = build_function_type (boolean_type_node, | |
3558 | tree_cons (NULL_TREE, integer_type_node, | |
3559 | tree_cons (NULL_TREE, ptr_type_node, | |
3560 | tree_cons (NULL_TREE, integer_type_node, | |
3561 | tree_cons (NULL_TREE, integer_type_node, | |
3562 | endlink))))); | |
3563 | bool_ftype_luns_ptr_luns_long | |
3564 | = build_function_type (boolean_type_node, | |
3565 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3566 | tree_cons (NULL_TREE, ptr_type_node, | |
3567 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3568 | tree_cons (NULL_TREE, long_integer_type_node, | |
3569 | endlink))))); | |
3570 | bool_ftype_luns_ptr_luns_long_ptr_int | |
3571 | = build_function_type (boolean_type_node, | |
3572 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3573 | tree_cons (NULL_TREE, ptr_type_node, | |
3574 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3575 | tree_cons (NULL_TREE, long_integer_type_node, | |
3576 | tree_cons (NULL_TREE, ptr_type_node, | |
3577 | tree_cons (NULL_TREE, integer_type_node, | |
3578 | endlink))))))); | |
3579 | bool_ftype_ptr_ptr_int | |
3580 | = build_function_type (boolean_type_node, | |
3581 | tree_cons (NULL_TREE, ptr_type_node, | |
3582 | tree_cons (NULL_TREE, ptr_type_node, | |
3583 | tree_cons (NULL_TREE, integer_type_node, | |
3584 | endlink)))); | |
3585 | bool_ftype_ptr_ptr_luns | |
3586 | = build_function_type (boolean_type_node, | |
3587 | tree_cons (NULL_TREE, ptr_type_node, | |
3588 | tree_cons (NULL_TREE, ptr_type_node, | |
3589 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3590 | endlink)))); | |
3591 | bool_ftype_ptr_ptr_ptr_luns | |
3592 | = build_function_type (boolean_type_node, | |
3593 | tree_cons (NULL_TREE, ptr_type_node, | |
3594 | tree_cons (NULL_TREE, ptr_type_node, | |
3595 | tree_cons (NULL_TREE, ptr_type_node, | |
3596 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3597 | endlink))))); | |
3598 | bool_ftype_ptr_int_ptr_int | |
3599 | = build_function_type (boolean_type_node, | |
3600 | tree_cons (NULL_TREE, ptr_type_node, | |
3601 | tree_cons (NULL_TREE, integer_type_node, | |
3602 | tree_cons (NULL_TREE, ptr_type_node, | |
3603 | tree_cons (NULL_TREE, integer_type_node, | |
3604 | endlink))))); | |
3605 | bool_ftype_ptr_int_ptr_int_int | |
3606 | = build_function_type (boolean_type_node, | |
3607 | tree_cons (NULL_TREE, ptr_type_node, | |
3608 | tree_cons (NULL_TREE, integer_type_node, | |
3609 | tree_cons (NULL_TREE, ptr_type_node, | |
3610 | tree_cons (NULL_TREE, integer_type_node, | |
3611 | tree_cons (NULL_TREE, integer_type_node, | |
3612 | endlink)))))); | |
3613 | find_bit_ftype | |
3614 | = build_function_type (integer_type_node, | |
3615 | tree_cons (NULL_TREE, ptr_type_node, | |
3616 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3617 | tree_cons (NULL_TREE, integer_type_node, | |
3618 | endlink)))); | |
3619 | int_ftype_int | |
3620 | = build_function_type (integer_type_node, | |
3621 | tree_cons (NULL_TREE, integer_type_node, | |
3622 | endlink)); | |
3623 | int_ftype_int_int | |
3624 | = build_function_type (integer_type_node, | |
3625 | tree_cons (NULL_TREE, integer_type_node, | |
3626 | tree_cons (NULL_TREE, integer_type_node, | |
3627 | endlink))); | |
3628 | int_ftype_int_ptr_int | |
3629 | = build_function_type (integer_type_node, | |
3630 | tree_cons (NULL_TREE, integer_type_node, | |
3631 | tree_cons (NULL_TREE, ptr_type_node, | |
3632 | tree_cons (NULL_TREE, integer_type_node, | |
3633 | endlink)))); | |
3634 | int_ftype_ptr | |
3635 | = build_function_type (integer_type_node, | |
3636 | tree_cons (NULL_TREE, ptr_type_node, | |
3637 | endlink)); | |
3638 | int_ftype_ptr_int | |
3639 | = build_function_type (integer_type_node, | |
3640 | tree_cons (NULL_TREE, ptr_type_node, | |
3641 | tree_cons (NULL_TREE, integer_type_node, | |
3642 | endlink))); | |
3643 | ||
3644 | long_ftype_ptr_luns | |
3645 | = build_function_type (long_integer_type_node, | |
3646 | tree_cons (NULL_TREE, ptr_type_node, | |
3647 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3648 | endlink))); | |
3649 | ||
3650 | int_ftype_ptr_int_int_ptr_int | |
3651 | = build_function_type (integer_type_node, | |
3652 | tree_cons (NULL_TREE, ptr_type_node, | |
3653 | tree_cons (NULL_TREE, integer_type_node, | |
3654 | tree_cons (NULL_TREE, integer_type_node, | |
3655 | tree_cons (NULL_TREE, ptr_type_node, | |
3656 | tree_cons (NULL_TREE, integer_type_node, | |
3657 | endlink)))))); | |
3658 | ||
3659 | int_ftype_ptr_luns_long_ptr_int | |
3660 | = build_function_type (integer_type_node, | |
3661 | tree_cons (NULL_TREE, ptr_type_node, | |
3662 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3663 | tree_cons (NULL_TREE, long_integer_type_node, | |
3664 | tree_cons (NULL_TREE, ptr_type_node, | |
3665 | tree_cons (NULL_TREE, integer_type_node, | |
3666 | endlink)))))); | |
3667 | ||
3668 | int_ftype_ptr_ptr_int | |
3669 | = build_function_type (integer_type_node, | |
3670 | tree_cons (NULL_TREE, ptr_type_node, | |
3671 | tree_cons (NULL_TREE, ptr_type_node, | |
3672 | tree_cons (NULL_TREE, integer_type_node, | |
3673 | endlink)))); | |
3674 | int_ftype_ptr_ptr_luns | |
3675 | = build_function_type (integer_type_node, | |
3676 | tree_cons (NULL_TREE, ptr_type_node, | |
3677 | tree_cons (NULL_TREE, ptr_type_node, | |
3678 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3679 | endlink)))); | |
3680 | memcpy_ftype /* memcpy/memmove prototype */ | |
3681 | = build_function_type (ptr_type_node, | |
3682 | tree_cons (NULL_TREE, ptr_type_node, | |
3683 | tree_cons (NULL_TREE, const_ptr_type_node, | |
3684 | tree_cons (NULL_TREE, sizetype, | |
3685 | endlink)))); | |
3686 | memcmp_ftype /* memcmp prototype */ | |
3687 | = build_function_type (integer_type_node, | |
3688 | tree_cons (NULL_TREE, ptr_type_node, | |
3689 | tree_cons (NULL_TREE, ptr_type_node, | |
3690 | tree_cons (NULL_TREE, sizetype, | |
3691 | endlink)))); | |
3692 | ||
3693 | ptr_ftype_ptr_int_int | |
3694 | = build_function_type (ptr_type_node, | |
3695 | tree_cons (NULL_TREE, ptr_type_node, | |
3696 | tree_cons (NULL_TREE, integer_type_node, | |
3697 | tree_cons (NULL_TREE, integer_type_node, | |
3698 | endlink)))); | |
3699 | ptr_ftype_ptr_ptr_int | |
3700 | = build_function_type (ptr_type_node, | |
3701 | tree_cons (NULL_TREE, ptr_type_node, | |
3702 | tree_cons (NULL_TREE, ptr_type_node, | |
3703 | tree_cons (NULL_TREE, integer_type_node, | |
3704 | endlink)))); | |
3705 | ptr_ftype_ptr_ptr_int_ptr_int | |
3706 | = build_function_type (void_type_node, | |
3707 | tree_cons (NULL_TREE, ptr_type_node, | |
3708 | tree_cons (NULL_TREE, ptr_type_node, | |
3709 | tree_cons (NULL_TREE, integer_type_node, | |
3710 | tree_cons (NULL_TREE, ptr_type_node, | |
3711 | tree_cons (NULL_TREE, integer_type_node, | |
3712 | endlink)))))); | |
3713 | real_ftype_real | |
3714 | = build_function_type (float_type_node, | |
3715 | tree_cons (NULL_TREE, float_type_node, | |
3716 | endlink)); | |
3717 | ||
3718 | void_ftype_ptr | |
3719 | = build_function_type (void_type_node, | |
3720 | tree_cons (NULL_TREE, ptr_type_node, endlink)); | |
3721 | ||
3722 | void_ftype_cptr_cptr_int | |
3723 | = build_function_type (void_type_node, | |
3724 | tree_cons (NULL_TREE, const_ptr_type_node, | |
3725 | tree_cons (NULL_TREE, const_ptr_type_node, | |
3726 | tree_cons (NULL_TREE, integer_type_node, | |
3727 | endlink)))); | |
3728 | ||
3729 | void_ftype_refptr_int_ptr_int | |
3730 | = build_function_type (void_type_node, | |
3731 | tree_cons (NULL_TREE, build_reference_type(ptr_type_node), | |
3732 | tree_cons (NULL_TREE, integer_type_node, | |
3733 | tree_cons (NULL_TREE, ptr_type_node, | |
3734 | tree_cons (NULL_TREE, integer_type_node, | |
3735 | endlink))))); | |
3736 | ||
3737 | void_ftype_ptr_ptr_ptr_int | |
3738 | = build_function_type (void_type_node, | |
3739 | tree_cons (NULL_TREE, ptr_type_node, | |
3740 | tree_cons (NULL_TREE, ptr_type_node, | |
3741 | tree_cons (NULL_TREE, ptr_type_node, | |
3742 | tree_cons (NULL_TREE, integer_type_node, | |
3743 | endlink))))); | |
3744 | void_ftype_ptr_ptr_ptr_luns | |
3745 | = build_function_type (void_type_node, | |
3746 | tree_cons (NULL_TREE, ptr_type_node, | |
3747 | tree_cons (NULL_TREE, ptr_type_node, | |
3748 | tree_cons (NULL_TREE, ptr_type_node, | |
3749 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3750 | endlink))))); | |
3751 | void_ftype_ptr_int_int_int_int | |
3752 | = build_function_type (void_type_node, | |
3753 | tree_cons (NULL_TREE, ptr_type_node, | |
3754 | tree_cons (NULL_TREE, integer_type_node, | |
3755 | tree_cons (NULL_TREE, integer_type_node, | |
3756 | tree_cons (NULL_TREE, integer_type_node, | |
3757 | tree_cons (NULL_TREE, integer_type_node, | |
3758 | endlink)))))); | |
3759 | void_ftype_ptr_luns_long_long_bool_ptr_int | |
3760 | = build_function_type (void_type_node, | |
3761 | tree_cons (NULL_TREE, ptr_type_node, | |
3762 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3763 | tree_cons (NULL_TREE, long_integer_type_node, | |
3764 | tree_cons (NULL_TREE, long_integer_type_node, | |
3765 | tree_cons (NULL_TREE, boolean_type_node, | |
3766 | tree_cons (NULL_TREE, ptr_type_node, | |
3767 | tree_cons (NULL_TREE, integer_type_node, | |
3768 | endlink)))))))); | |
3769 | void_ftype_ptr_int_ptr_int_int_int | |
3770 | = build_function_type (void_type_node, | |
3771 | tree_cons (NULL_TREE, ptr_type_node, | |
3772 | tree_cons (NULL_TREE, integer_type_node, | |
3773 | tree_cons (NULL_TREE, ptr_type_node, | |
3774 | tree_cons (NULL_TREE, integer_type_node, | |
3775 | tree_cons (NULL_TREE, integer_type_node, | |
3776 | tree_cons (NULL_TREE, integer_type_node, | |
3777 | endlink))))))); | |
3778 | void_ftype_ptr_luns_ptr_luns_luns_luns | |
3779 | = build_function_type (void_type_node, | |
3780 | tree_cons (NULL_TREE, ptr_type_node, | |
3781 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3782 | tree_cons (NULL_TREE, ptr_type_node, | |
3783 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3784 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3785 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3786 | endlink))))))); | |
3787 | void_ftype_ptr_int_ptr_int_ptr_int | |
3788 | = build_function_type (void_type_node, | |
3789 | tree_cons (NULL_TREE, ptr_type_node, | |
3790 | tree_cons (NULL_TREE, integer_type_node, | |
3791 | tree_cons (NULL_TREE, ptr_type_node, | |
3792 | tree_cons (NULL_TREE, integer_type_node, | |
3793 | tree_cons (NULL_TREE, ptr_type_node, | |
3794 | tree_cons (NULL_TREE, integer_type_node, | |
3795 | endlink))))))); | |
3796 | void_ftype_long_int_ptr_int_ptr_int | |
3797 | = build_function_type (void_type_node, | |
3798 | tree_cons (NULL_TREE, long_integer_type_node, | |
3799 | tree_cons (NULL_TREE, integer_type_node, | |
3800 | tree_cons (NULL_TREE, ptr_type_node, | |
3801 | tree_cons (NULL_TREE, integer_type_node, | |
3802 | tree_cons (NULL_TREE, ptr_type_node, | |
3803 | tree_cons (NULL_TREE, integer_type_node, | |
3804 | endlink))))))); | |
3805 | void_ftype_void | |
3806 | = build_function_type (void_type_node, | |
3807 | tree_cons (NULL_TREE, void_type_node, | |
3808 | endlink)); | |
3809 | ||
3810 | void_ftype_ptr_ptr_int | |
3811 | = build_function_type (void_type_node, | |
3812 | tree_cons (NULL_TREE, ptr_type_node, | |
3813 | tree_cons (NULL_TREE, ptr_type_node, | |
3814 | tree_cons (NULL_TREE, integer_type_node, | |
3815 | endlink)))); | |
3816 | ||
3817 | void_ftype_ptr_luns_luns_cptr_luns_luns_luns | |
3818 | = build_function_type (void_type_node, | |
3819 | tree_cons (NULL_TREE, ptr_type_node, | |
3820 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3821 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3822 | tree_cons (NULL_TREE, const_ptr_type_node, | |
3823 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3824 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3825 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3826 | endlink)))))))); | |
3827 | ||
3828 | ptr_ftype_luns_ptr_int | |
3829 | = build_function_type (ptr_type_node, | |
3830 | tree_cons (NULL_TREE, long_unsigned_type_node, | |
3831 | tree_cons (NULL_TREE, ptr_type_node, | |
3832 | tree_cons (NULL_TREE, integer_type_node, | |
3833 | endlink)))); | |
3834 | ||
3835 | double_ftype_double | |
3836 | = build_function_type (double_type_node, | |
3837 | tree_cons (NULL_TREE, double_type_node, | |
3838 | endlink)); | |
3839 | ||
3840 | /* These are compiler-internal function calls, not intended | |
3841 | to be directly called by user code */ | |
3842 | builtin_function ("__allocate", ptr_ftype_luns_ptr_int, | |
26db82d8 | 3843 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3844 | builtin_function ("_allocate_global_memory", void_ftype_refptr_int_ptr_int, |
26db82d8 | 3845 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3846 | builtin_function ("_allocate_memory", void_ftype_refptr_int_ptr_int, |
26db82d8 | 3847 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3848 | builtin_function ("__andpowerset", bool_ftype_ptr_ptr_ptr_luns, |
26db82d8 | 3849 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3850 | builtin_function ("__bitsetpowerset", void_ftype_ptr_int_int_int_int, |
26db82d8 | 3851 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3852 | builtin_function ("__cardpowerset", long_ftype_ptr_luns, |
26db82d8 | 3853 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3854 | builtin_function ("__cause_ex1", void_ftype_cptr_cptr_int, |
26db82d8 | 3855 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3856 | builtin_function ("__concatstring", ptr_ftype_ptr_ptr_int_ptr_int, |
26db82d8 | 3857 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3858 | builtin_function ("__continue", void_ftype_ptr_ptr_int, |
26db82d8 | 3859 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3860 | builtin_function ("__diffpowerset", void_ftype_ptr_ptr_ptr_luns, |
26db82d8 | 3861 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3862 | builtin_function ("__eqpowerset", bool_ftype_ptr_ptr_luns, |
26db82d8 | 3863 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3864 | builtin_function ("__ffsetclrpowerset", find_bit_ftype, |
26db82d8 | 3865 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3866 | builtin_function ("__flsetclrpowerset", find_bit_ftype, |
26db82d8 | 3867 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3868 | builtin_function ("__flsetpowerset", int_ftype_ptr_luns_long_ptr_int, |
26db82d8 | 3869 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3870 | builtin_function ("__ffsetpowerset", int_ftype_ptr_luns_long_ptr_int, |
26db82d8 | 3871 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3872 | builtin_function ("__inbitstring", bool_ftype_luns_ptr_luns_long_ptr_int, |
26db82d8 | 3873 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3874 | builtin_function ("__inpowerset", bool_ftype_luns_ptr_luns_long, |
26db82d8 | 3875 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3876 | builtin_function ("__lepowerset", bool_ftype_ptr_ptr_luns, |
26db82d8 | 3877 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3878 | builtin_function ("__ltpowerset", bool_ftype_ptr_ptr_luns, |
26db82d8 | 3879 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da PB |
3880 | /* Currently under experimentation. */ |
3881 | builtin_function ("memmove", memcpy_ftype, | |
26db82d8 | 3882 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3883 | builtin_function ("memcmp", memcmp_ftype, |
26db82d8 | 3884 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da PB |
3885 | |
3886 | /* this comes from c-decl.c (init_decl_processing) */ | |
3887 | builtin_function ("__builtin_alloca", | |
3888 | build_function_type (ptr_type_node, | |
3889 | tree_cons (NULL_TREE, | |
3890 | sizetype, | |
3891 | endlink)), | |
26db82d8 | 3892 | BUILT_IN_ALLOCA, BUILT_IN_NORMAL, "alloca"); |
3c79b2da PB |
3893 | |
3894 | builtin_function ("memset", ptr_ftype_ptr_int_int, | |
26db82d8 | 3895 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3896 | builtin_function ("__notpowerset", bool_ftype_ptr_ptr_luns, |
26db82d8 | 3897 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3898 | builtin_function ("__orpowerset", bool_ftype_ptr_ptr_ptr_luns, |
26db82d8 | 3899 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3900 | builtin_function ("__psslice", void_ftype_ptr_int_ptr_int_int_int, |
26db82d8 | 3901 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3902 | builtin_function ("__pscpy", void_ftype_ptr_luns_luns_cptr_luns_luns_luns, |
26db82d8 | 3903 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3904 | builtin_function ("_return_memory", void_ftype_ptr_ptr_int, |
26db82d8 | 3905 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3906 | builtin_function ("__setbitpowerset", void_ftype_ptr_luns_long_long_bool_ptr_int, |
26db82d8 | 3907 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3908 | builtin_function ("__terminate", void_ftype_ptr_ptr_int, |
26db82d8 | 3909 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3910 | builtin_function ("__unhandled_ex", void_ftype_cptr_cptr_int, |
26db82d8 | 3911 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da | 3912 | builtin_function ("__xorpowerset", bool_ftype_ptr_ptr_ptr_luns, |
26db82d8 | 3913 | 0, NOT_BUILT_IN, NULL_PTR); |
3c79b2da PB |
3914 | |
3915 | /* declare floating point functions */ | |
26db82d8 BS |
3916 | builtin_function ("__sin", double_ftype_double, 0, NOT_BUILT_IN, "sin"); |
3917 | builtin_function ("__cos", double_ftype_double, 0, NOT_BUILT_IN, "cos"); | |
3918 | builtin_function ("__tan", double_ftype_double, 0, NOT_BUILT_IN, "tan"); | |
3919 | builtin_function ("__asin", double_ftype_double, 0, NOT_BUILT_IN, "asin"); | |
3920 | builtin_function ("__acos", double_ftype_double, 0, NOT_BUILT_IN, "acos"); | |
3921 | builtin_function ("__atan", double_ftype_double, 0, NOT_BUILT_IN, "atan"); | |
3922 | builtin_function ("__exp", double_ftype_double, 0, NOT_BUILT_IN, "exp"); | |
3923 | builtin_function ("__log", double_ftype_double, 0, NOT_BUILT_IN, "log"); | |
3924 | builtin_function ("__log10", double_ftype_double, 0, NOT_BUILT_IN, "log10"); | |
3925 | builtin_function ("__sqrt", double_ftype_double, 0, NOT_BUILT_IN, "sqrt"); | |
3c79b2da PB |
3926 | |
3927 | tasking_init (); | |
3928 | timing_init (); | |
3929 | inout_init (); | |
3930 | ||
3931 | /* These are predefined value builtin routine calls, built | |
3932 | by the compiler, but over-ridable by user procedures of | |
3933 | the same names. Note the lack of a leading underscore. */ | |
3934 | builtin_function ((ignore_case || ! special_UC) ? "abs" : "ABS", | |
3935 | chill_predefined_function_type, | |
26db82d8 | 3936 | BUILT_IN_CH_ABS, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3937 | builtin_function ((ignore_case || ! special_UC) ? "abstime" : "ABSTIME", |
3938 | chill_predefined_function_type, | |
26db82d8 | 3939 | BUILT_IN_ABSTIME, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3940 | builtin_function ((ignore_case || ! special_UC) ? "allocate" : "ALLOCATE", |
3941 | chill_predefined_function_type, | |
26db82d8 | 3942 | BUILT_IN_ALLOCATE, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3943 | builtin_function ((ignore_case || ! special_UC) ? "allocate_memory" : "ALLOCATE_MEMORY", |
3944 | chill_predefined_function_type, | |
26db82d8 | 3945 | BUILT_IN_ALLOCATE_MEMORY, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3946 | builtin_function ((ignore_case || ! special_UC) ? "addr" : "ADDR", |
3947 | chill_predefined_function_type, | |
26db82d8 | 3948 | BUILT_IN_ADDR, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3949 | builtin_function ((ignore_case || ! special_UC) ? "allocate_global_memory" : "ALLOCATE_GLOBAL_MEMORY", |
3950 | chill_predefined_function_type, | |
26db82d8 | 3951 | BUILT_IN_ALLOCATE_GLOBAL_MEMORY, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3952 | builtin_function ((ignore_case || ! special_UC) ? "arccos" : "ARCCOS", |
3953 | chill_predefined_function_type, | |
26db82d8 | 3954 | BUILT_IN_ARCCOS, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3955 | builtin_function ((ignore_case || ! special_UC) ? "arcsin" : "ARCSIN", |
3956 | chill_predefined_function_type, | |
26db82d8 | 3957 | BUILT_IN_ARCSIN, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3958 | builtin_function ((ignore_case || ! special_UC) ? "arctan" : "ARCTAN", |
3959 | chill_predefined_function_type, | |
26db82d8 | 3960 | BUILT_IN_ARCTAN, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3961 | builtin_function ((ignore_case || ! special_UC) ? "card" : "CARD", |
3962 | chill_predefined_function_type, | |
26db82d8 | 3963 | BUILT_IN_CARD, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3964 | builtin_function ((ignore_case || ! special_UC) ? "cos" : "COS", |
3965 | chill_predefined_function_type, | |
26db82d8 | 3966 | BUILT_IN_CH_COS, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3967 | builtin_function ((ignore_case || ! special_UC) ? "days" : "DAYS", |
3968 | chill_predefined_function_type, | |
26db82d8 | 3969 | BUILT_IN_DAYS, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3970 | builtin_function ((ignore_case || ! special_UC) ? "descr" : "DESCR", |
3971 | chill_predefined_function_type, | |
26db82d8 | 3972 | BUILT_IN_DESCR, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3973 | builtin_function ((ignore_case || ! special_UC) ? "getstack" : "GETSTACK", |
3974 | chill_predefined_function_type, | |
26db82d8 | 3975 | BUILT_IN_GETSTACK, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3976 | builtin_function ((ignore_case || ! special_UC) ? "exp" : "EXP", |
3977 | chill_predefined_function_type, | |
26db82d8 | 3978 | BUILT_IN_EXP, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3979 | builtin_function ((ignore_case || ! special_UC) ? "hours" : "HOURS", |
3980 | chill_predefined_function_type, | |
26db82d8 | 3981 | BUILT_IN_HOURS, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3982 | builtin_function ((ignore_case || ! special_UC) ? "inttime" : "INTTIME", |
3983 | chill_predefined_function_type, | |
26db82d8 | 3984 | BUILT_IN_INTTIME, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3985 | builtin_function ((ignore_case || ! special_UC) ? "length" : "LENGTH", |
3986 | chill_predefined_function_type, | |
26db82d8 | 3987 | BUILT_IN_LENGTH, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3988 | builtin_function ((ignore_case || ! special_UC) ? "log" : "LOG", |
3989 | chill_predefined_function_type, | |
26db82d8 | 3990 | BUILT_IN_LOG, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3991 | builtin_function ((ignore_case || ! special_UC) ? "lower" : "LOWER", |
3992 | chill_predefined_function_type, | |
26db82d8 | 3993 | BUILT_IN_LOWER, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3994 | builtin_function ((ignore_case || ! special_UC) ? "ln" : "LN", |
3995 | chill_predefined_function_type, | |
26db82d8 | 3996 | BUILT_IN_LN, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
3997 | /* Note: these are *not* the C integer MAX and MIN. They're |
3998 | for powerset arguments. */ | |
3999 | builtin_function ((ignore_case || ! special_UC) ? "max" : "MAX", | |
4000 | chill_predefined_function_type, | |
26db82d8 | 4001 | BUILT_IN_MAX, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
4002 | builtin_function ((ignore_case || ! special_UC) ? "millisecs" : "MILLISECS", |
4003 | chill_predefined_function_type, | |
26db82d8 | 4004 | BUILT_IN_MILLISECS, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
4005 | builtin_function ((ignore_case || ! special_UC) ? "min" : "MIN", |
4006 | chill_predefined_function_type, | |
26db82d8 | 4007 | BUILT_IN_MIN, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
4008 | builtin_function ((ignore_case || ! special_UC) ? "minutes" : "MINUTES", |
4009 | chill_predefined_function_type, | |
26db82d8 | 4010 | BUILT_IN_MINUTES, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
4011 | builtin_function ((ignore_case || ! special_UC) ? "num" : "NUM", |
4012 | chill_predefined_function_type, | |
26db82d8 | 4013 | BUILT_IN_NUM, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
4014 | builtin_function ((ignore_case || ! special_UC) ? "pred" : "PRED", |
4015 | chill_predefined_function_type, | |
26db82d8 | 4016 | BUILT_IN_PRED, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
4017 | builtin_function ((ignore_case || ! special_UC) ? "return_memory" : "RETURN_MEMORY", |
4018 | chill_predefined_function_type, | |
26db82d8 | 4019 | BUILT_IN_RETURN_MEMORY, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
4020 | builtin_function ((ignore_case || ! special_UC) ? "secs" : "SECS", |
4021 | chill_predefined_function_type, | |
26db82d8 | 4022 | BUILT_IN_SECS, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
4023 | builtin_function ((ignore_case || ! special_UC) ? "sin" : "SIN", |
4024 | chill_predefined_function_type, | |
26db82d8 | 4025 | BUILT_IN_CH_SIN, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
4026 | builtin_function ((ignore_case || ! special_UC) ? "size" : "SIZE", |
4027 | chill_predefined_function_type, | |
26db82d8 | 4028 | BUILT_IN_SIZE, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
4029 | builtin_function ((ignore_case || ! special_UC) ? "sqrt" : "SQRT", |
4030 | chill_predefined_function_type, | |
26db82d8 | 4031 | BUILT_IN_SQRT, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
4032 | builtin_function ((ignore_case || ! special_UC) ? "succ" : "SUCC", |
4033 | chill_predefined_function_type, | |
26db82d8 | 4034 | BUILT_IN_SUCC, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
4035 | builtin_function ((ignore_case || ! special_UC) ? "tan" : "TAN", |
4036 | chill_predefined_function_type, | |
26db82d8 | 4037 | BUILT_IN_TAN, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
4038 | builtin_function ((ignore_case || ! special_UC) ? "terminate" : "TERMINATE", |
4039 | chill_predefined_function_type, | |
26db82d8 | 4040 | BUILT_IN_TERMINATE, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
4041 | builtin_function ((ignore_case || ! special_UC) ? "upper" : "UPPER", |
4042 | chill_predefined_function_type, | |
26db82d8 | 4043 | BUILT_IN_UPPER, BUILT_IN_NORMAL, NULL_PTR); |
3c79b2da PB |
4044 | |
4045 | build_chill_descr_type (); | |
4046 | build_chill_inttime_type (); | |
4047 | ||
4048 | endlink = tree_cons (NULL_TREE, void_type_node, NULL_TREE); | |
4049 | ||
4050 | start_identifier_warnings (); | |
4051 | ||
4052 | pass = 1; | |
4053 | } | |
4054 | \f | |
4055 | /* Return a definition for a builtin function named NAME and whose data type | |
4056 | is TYPE. TYPE should be a function type with argument types. | |
4057 | FUNCTION_CODE tells later passes how to compile calls to this function. | |
4058 | See tree.h for its possible values. | |
4059 | ||
4060 | If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME, | |
4061 | the name to be called if we can't opencode the function. */ | |
4062 | ||
4063 | tree | |
26db82d8 | 4064 | builtin_function (name, type, function_code, class, library_name) |
31029ad7 | 4065 | const char *name; |
3c79b2da | 4066 | tree type; |
26db82d8 BS |
4067 | int function_code; |
4068 | enum built_in_class class; | |
31029ad7 | 4069 | const char *library_name; |
3c79b2da PB |
4070 | { |
4071 | tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type); | |
4072 | DECL_EXTERNAL (decl) = 1; | |
4073 | TREE_PUBLIC (decl) = 1; | |
4074 | /* If -traditional, permit redefining a builtin function any way you like. | |
4075 | (Though really, if the program redefines these functions, | |
4076 | it probably won't work right unless compiled with -fno-builtin.) */ | |
4077 | if (flag_traditional && name[0] != '_') | |
4078 | DECL_BUILT_IN_NONANSI (decl) = 1; | |
4079 | if (library_name) | |
4080 | DECL_ASSEMBLER_NAME (decl) = get_identifier (library_name); | |
4081 | make_decl_rtl (decl, NULL_PTR, 1); | |
4082 | pushdecl (decl); | |
26db82d8 BS |
4083 | DECL_BUILT_IN_CLASS (decl) = class; |
4084 | DECL_FUNCTION_CODE (decl) = function_code; | |
3c79b2da PB |
4085 | |
4086 | return decl; | |
4087 | } | |
4088 | \f | |
4089 | /* Print a warning if a constant expression had overflow in folding. | |
4090 | Invoke this function on every expression that the language | |
4091 | requires to be a constant expression. */ | |
4092 | ||
4093 | void | |
4094 | constant_expression_warning (value) | |
4095 | tree value; | |
4096 | { | |
4097 | if ((TREE_CODE (value) == INTEGER_CST || TREE_CODE (value) == REAL_CST | |
4098 | || TREE_CODE (value) == COMPLEX_CST) | |
4099 | && TREE_CONSTANT_OVERFLOW (value) && pedantic) | |
4100 | pedwarn ("overflow in constant expression"); | |
4101 | } | |
4102 | ||
4103 | \f | |
4104 | /* Finish processing of a declaration; | |
4105 | If the length of an array type is not known before, | |
4106 | it must be determined now, from the initial value, or it is an error. */ | |
4107 | ||
4108 | void | |
4109 | finish_decl (decl) | |
4110 | tree decl; | |
4111 | { | |
3c79b2da PB |
4112 | int was_incomplete = (DECL_SIZE (decl) == 0); |
4113 | int temporary = allocation_temporary_p (); | |
4114 | ||
4115 | /* Pop back to the obstack that is current for this binding level. | |
4116 | This is because MAXINDEX, rtl, etc. to be made below | |
4117 | must go in the permanent obstack. But don't discard the | |
4118 | temporary data yet. */ | |
4119 | pop_obstacks (); | |
4120 | #if 0 /* pop_obstacks was near the end; this is what was here. */ | |
4121 | if (current_scope == global_scope && temporary) | |
4122 | end_temporary_allocation (); | |
4123 | #endif | |
4124 | ||
4125 | if (TREE_CODE (decl) == VAR_DECL) | |
4126 | { | |
4127 | if (DECL_SIZE (decl) == 0 | |
4128 | && TYPE_SIZE (TREE_TYPE (decl)) != 0) | |
4129 | layout_decl (decl, 0); | |
4130 | ||
4131 | if (DECL_SIZE (decl) == 0 && TREE_CODE (TREE_TYPE (decl)) != ERROR_MARK) | |
4132 | { | |
4133 | error_with_decl (decl, "storage size of `%s' isn't known"); | |
4134 | TREE_TYPE (decl) = error_mark_node; | |
4135 | } | |
4136 | ||
4137 | if ((DECL_EXTERNAL (decl) || TREE_STATIC (decl)) | |
4138 | && DECL_SIZE (decl) != 0) | |
4139 | { | |
4140 | if (TREE_CODE (DECL_SIZE (decl)) == INTEGER_CST) | |
4141 | constant_expression_warning (DECL_SIZE (decl)); | |
4142 | } | |
4143 | } | |
4144 | ||
4145 | /* Output the assembler code and/or RTL code for variables and functions, | |
4146 | unless the type is an undefined structure or union. | |
4147 | If not, it will get done when the type is completed. */ | |
4148 | ||
4149 | if (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == FUNCTION_DECL) | |
4150 | { | |
4151 | /* The last argument (at_end) is set to 1 as a kludge to force | |
4152 | assemble_variable to be called. */ | |
4153 | if (TREE_CODE (TREE_TYPE (decl)) != ERROR_MARK) | |
4154 | rest_of_decl_compilation (decl, (char*) 0, global_bindings_p (), 1); | |
4155 | ||
4156 | /* Compute the RTL of a decl if not yet set. | |
4157 | (For normal user variables, satisfy_decl sets it.) */ | |
4158 | if (! TREE_STATIC (decl) && ! DECL_EXTERNAL (decl)) | |
4159 | { | |
4160 | if (was_incomplete) | |
4161 | { | |
4162 | /* If we used it already as memory, it must stay in memory. */ | |
4163 | TREE_ADDRESSABLE (decl) = TREE_USED (decl); | |
4164 | /* If it's still incomplete now, no init will save it. */ | |
4165 | if (DECL_SIZE (decl) == 0) | |
4166 | DECL_INITIAL (decl) = 0; | |
4167 | expand_decl (decl); | |
4168 | } | |
4169 | } | |
4170 | } | |
4171 | ||
4172 | if (TREE_CODE (decl) == TYPE_DECL) | |
4173 | { | |
4174 | rest_of_decl_compilation (decl, NULL_PTR, | |
4175 | global_bindings_p (), 0); | |
4176 | } | |
4177 | ||
4178 | /* ??? After 2.3, test (init != 0) instead of TREE_CODE. */ | |
4179 | if (!(TREE_CODE (decl) == FUNCTION_DECL && DECL_INLINE (decl)) | |
4180 | && temporary && TREE_PERMANENT (decl)) | |
4181 | { | |
4182 | /* We need to remember that this array HAD an initialization, | |
4183 | but discard the actual temporary nodes, | |
4184 | since we can't have a permanent node keep pointing to them. */ | |
4185 | /* We make an exception for inline functions, since it's | |
4186 | normal for a local extern redeclaration of an inline function | |
4187 | to have a copy of the top-level decl's DECL_INLINE. */ | |
4188 | if (DECL_INITIAL (decl) != 0) | |
4189 | DECL_INITIAL (decl) = error_mark_node; | |
4190 | } | |
4191 | ||
4192 | #if 0 | |
4193 | /* Resume permanent allocation, if not within a function. */ | |
4194 | /* The corresponding push_obstacks_nochange is in start_decl, | |
4195 | and in push_parm_decl and in grokfield. */ | |
4196 | pop_obstacks (); | |
4197 | #endif | |
4198 | ||
4199 | /* If we have gone back from temporary to permanent allocation, | |
4200 | actually free the temporary space that we no longer need. */ | |
4201 | if (temporary && !allocation_temporary_p ()) | |
4202 | permanent_allocation (0); | |
4203 | ||
4204 | /* At the end of a declaration, throw away any variable type sizes | |
4205 | of types defined inside that declaration. There is no use | |
4206 | computing them in the following function definition. */ | |
4207 | if (current_scope == global_scope) | |
4208 | get_pending_sizes (); | |
4209 | } | |
4210 | ||
4211 | /* If DECL has a cleanup, build and return that cleanup here. | |
4212 | This is a callback called by expand_expr. */ | |
4213 | ||
4214 | tree | |
4215 | maybe_build_cleanup (decl) | |
75111422 | 4216 | tree decl ATTRIBUTE_UNUSED; |
3c79b2da PB |
4217 | { |
4218 | /* There are no cleanups in C. */ | |
4219 | return NULL_TREE; | |
4220 | } | |
4221 | \f | |
4222 | /* Make TYPE a complete type based on INITIAL_VALUE. | |
4223 | Return 0 if successful, 1 if INITIAL_VALUE can't be deciphered, | |
4224 | 2 if there was no information (in which case assume 1 if DO_DEFAULT). */ | |
4225 | ||
4226 | int | |
4227 | complete_array_type (type, initial_value, do_default) | |
75111422 KG |
4228 | tree type ATTRIBUTE_UNUSED, initial_value ATTRIBUTE_UNUSED; |
4229 | int do_default ATTRIBUTE_UNUSED; | |
3c79b2da PB |
4230 | { |
4231 | /* Only needed so we can link with ../c-typeck.c. */ | |
4232 | abort (); | |
4233 | } | |
4234 | \f | |
4235 | /* Make sure that the tag NAME is defined *in the current binding level* | |
4236 | at least as a forward reference. | |
4237 | CODE says which kind of tag NAME ought to be. | |
4238 | ||
4239 | We also do a push_obstacks_nochange | |
4240 | whose matching pop is in finish_struct. */ | |
4241 | ||
4242 | tree | |
4243 | start_struct (code, name) | |
4244 | enum chill_tree_code code; | |
75111422 | 4245 | tree name ATTRIBUTE_UNUSED; |
3c79b2da PB |
4246 | { |
4247 | /* If there is already a tag defined at this binding level | |
4248 | (as a forward reference), just return it. */ | |
4249 | ||
4250 | register tree ref = 0; | |
4251 | ||
4252 | push_obstacks_nochange (); | |
4253 | if (current_scope == global_scope) | |
4254 | end_temporary_allocation (); | |
4255 | ||
4256 | /* Otherwise create a forward-reference just so the tag is in scope. */ | |
4257 | ||
4258 | ref = make_node (code); | |
4259 | /* pushtag (name, ref); */ | |
4260 | return ref; | |
4261 | } | |
4262 | \f | |
4263 | #if 0 | |
4264 | /* Function to help qsort sort FIELD_DECLs by name order. */ | |
4265 | ||
4266 | static int | |
4267 | field_decl_cmp (x, y) | |
4268 | tree *x, *y; | |
4269 | { | |
4270 | return (long)DECL_NAME (*x) - (long)DECL_NAME (*y); | |
4271 | } | |
4272 | #endif | |
4273 | /* Fill in the fields of a RECORD_TYPE or UNION_TYPE node, T. | |
4274 | FIELDLIST is a chain of FIELD_DECL nodes for the fields. | |
4275 | ||
4276 | We also do a pop_obstacks to match the push in start_struct. */ | |
4277 | ||
4278 | tree | |
4279 | finish_struct (t, fieldlist) | |
4280 | register tree t, fieldlist; | |
4281 | { | |
4282 | register tree x; | |
4283 | ||
9df2c88c | 4284 | /* Install struct as DECL_CONTEXT of each field decl. */ |
3c79b2da | 4285 | for (x = fieldlist; x; x = TREE_CHAIN (x)) |
9df2c88c | 4286 | DECL_CONTEXT (x) = t; |
3c79b2da PB |
4287 | |
4288 | TYPE_FIELDS (t) = fieldlist; | |
4289 | ||
4290 | if (pass != 1) | |
4291 | t = layout_chill_struct_type (t); | |
4292 | ||
4293 | /* The matching push is in start_struct. */ | |
4294 | pop_obstacks (); | |
4295 | ||
4296 | return t; | |
4297 | } | |
4298 | ||
4299 | /* Lay out the type T, and its element type, and so on. */ | |
4300 | ||
4301 | static void | |
4302 | layout_array_type (t) | |
4303 | tree t; | |
4304 | { | |
4305 | if (TYPE_SIZE (t) != 0) | |
4306 | return; | |
4307 | if (TREE_CODE (TREE_TYPE (t)) == ARRAY_TYPE) | |
4308 | layout_array_type (TREE_TYPE (t)); | |
4309 | layout_type (t); | |
4310 | } | |
4311 | \f | |
4312 | /* Begin compiling the definition of an enumeration type. | |
4313 | NAME is its name (or null if anonymous). | |
4314 | Returns the type object, as yet incomplete. | |
4315 | Also records info about it so that build_enumerator | |
4316 | may be used to declare the individual values as they are read. */ | |
4317 | ||
4318 | tree | |
4319 | start_enum (name) | |
75111422 | 4320 | tree name ATTRIBUTE_UNUSED; |
3c79b2da PB |
4321 | { |
4322 | register tree enumtype; | |
4323 | ||
4324 | /* If this is the real definition for a previous forward reference, | |
4325 | fill in the contents in the same object that used to be the | |
4326 | forward reference. */ | |
4327 | ||
4328 | #if 0 | |
4329 | /* The corresponding pop_obstacks is in finish_enum. */ | |
4330 | push_obstacks_nochange (); | |
4331 | /* If these symbols and types are global, make them permanent. */ | |
4332 | if (current_scope == global_scope) | |
4333 | end_temporary_allocation (); | |
4334 | #endif | |
4335 | ||
4336 | enumtype = make_node (ENUMERAL_TYPE); | |
4337 | /* pushtag (name, enumtype); */ | |
4338 | return enumtype; | |
4339 | } | |
4340 | \f | |
4341 | /* Determine the precision this type needs. */ | |
4342 | unsigned | |
4343 | get_type_precision (minnode, maxnode) | |
4344 | tree minnode, maxnode; | |
4345 | { | |
4346 | unsigned precision = 0; | |
4347 | ||
4348 | if (TREE_INT_CST_HIGH (minnode) >= 0 | |
4349 | ? tree_int_cst_lt (TYPE_MAX_VALUE (unsigned_type_node), maxnode) | |
4350 | : (tree_int_cst_lt (minnode, TYPE_MIN_VALUE (integer_type_node)) | |
4351 | || tree_int_cst_lt (TYPE_MAX_VALUE (integer_type_node), maxnode))) | |
4352 | precision = TYPE_PRECISION (long_long_integer_type_node); | |
4353 | else | |
4354 | { | |
4355 | HOST_WIDE_INT maxvalue = TREE_INT_CST_LOW (maxnode); | |
4356 | HOST_WIDE_INT minvalue = TREE_INT_CST_LOW (minnode); | |
4357 | ||
4358 | if (maxvalue > 0) | |
4359 | precision = floor_log2 (maxvalue) + 1; | |
4360 | if (minvalue < 0) | |
4361 | { | |
4362 | /* Compute number of bits to represent magnitude of a negative value. | |
4363 | Add one to MINVALUE since range of negative numbers | |
4364 | includes the power of two. */ | |
4365 | unsigned negprecision = floor_log2 (-minvalue - 1) + 1; | |
4366 | if (negprecision > precision) | |
4367 | precision = negprecision; | |
4368 | precision += 1; /* room for sign bit */ | |
4369 | } | |
4370 | ||
4371 | if (!precision) | |
4372 | precision = 1; | |
4373 | } | |
4374 | return precision; | |
4375 | } | |
4376 | \f | |
4377 | void | |
4378 | layout_enum (enumtype) | |
4379 | tree enumtype; | |
4380 | { | |
4381 | register tree pair, tem; | |
4382 | tree minnode = 0, maxnode = 0; | |
4383 | unsigned precision = 0; | |
4384 | ||
4385 | /* Do arithmetic using double integers, but don't use fold/build. */ | |
4386 | union tree_node enum_next_node; | |
4387 | /* This is 1 plus the last enumerator constant value. */ | |
4388 | tree enum_next_value = &enum_next_node; | |
4389 | ||
4390 | /* Nonzero means that there was overflow computing enum_next_value. */ | |
4391 | int enum_overflow = 0; | |
4392 | ||
4393 | tree values = TYPE_VALUES (enumtype); | |
4394 | ||
4395 | if (TYPE_SIZE (enumtype) != NULL_TREE) | |
4396 | return; | |
4397 | ||
4398 | /* Initialize enum_next_value to zero. */ | |
4399 | TREE_TYPE (enum_next_value) = integer_type_node; | |
4400 | TREE_INT_CST_LOW (enum_next_value) = TREE_INT_CST_LOW (integer_zero_node); | |
4401 | TREE_INT_CST_HIGH (enum_next_value) = TREE_INT_CST_HIGH (integer_zero_node); | |
4402 | ||
4403 | /* After processing and defining all the values of an enumeration type, | |
4404 | install their decls in the enumeration type and finish it off. | |
4405 | ||
4406 | TYPE_VALUES currently contains a list of (purpose: NAME, value: DECL). | |
4407 | This gets converted to a list of (purpose: NAME, value: VALUE). */ | |
4408 | ||
4409 | ||
4410 | /* For each enumerator, calculate values, if defaulted. | |
4411 | Convert to correct type (the enumtype). | |
4412 | Also, calculate the minimum and maximum values. */ | |
4413 | ||
4414 | for (pair = values; pair; pair = TREE_CHAIN (pair)) | |
4415 | { | |
4416 | tree decl = TREE_VALUE (pair); | |
4417 | tree value = DECL_INITIAL (decl); | |
4418 | ||
4419 | /* Remove no-op casts from the value. */ | |
4420 | if (value != NULL_TREE) | |
4421 | STRIP_TYPE_NOPS (value); | |
4422 | ||
4423 | if (value != NULL_TREE) | |
4424 | { | |
4425 | if (TREE_CODE (value) == INTEGER_CST) | |
4426 | { | |
4427 | constant_expression_warning (value); | |
4428 | if (tree_int_cst_lt (value, integer_zero_node)) | |
4429 | { | |
4430 | error ("enumerator value for `%s' is less then 0", | |
4431 | IDENTIFIER_POINTER (DECL_NAME (decl))); | |
4432 | value = error_mark_node; | |
4433 | } | |
4434 | } | |
4435 | else | |
4436 | { | |
4437 | error ("enumerator value for `%s' not integer constant", | |
4438 | IDENTIFIER_POINTER (DECL_NAME (decl))); | |
4439 | value = error_mark_node; | |
4440 | } | |
4441 | } | |
4442 | ||
4443 | if (value != error_mark_node) | |
4444 | { | |
4445 | if (value == NULL_TREE) /* Default based on previous value. */ | |
4446 | { | |
4447 | value = enum_next_value; | |
4448 | if (enum_overflow) | |
4449 | error ("overflow in enumeration values"); | |
4450 | } | |
4451 | value = build_int_2 (TREE_INT_CST_LOW (value), | |
4452 | TREE_INT_CST_HIGH (value)); | |
4453 | TREE_TYPE (value) = enumtype; | |
4454 | DECL_INITIAL (decl) = value; | |
4455 | CH_DERIVED_FLAG (value) = 1; | |
4456 | ||
4457 | if (pair == values) | |
4458 | minnode = maxnode = value; | |
4459 | else | |
4460 | { | |
4461 | if (tree_int_cst_lt (maxnode, value)) | |
4462 | maxnode = value; | |
4463 | if (tree_int_cst_lt (value, minnode)) | |
4464 | minnode = value; | |
4465 | } | |
4466 | ||
4467 | /* Set basis for default for next value. */ | |
4468 | add_double (TREE_INT_CST_LOW (value), TREE_INT_CST_HIGH (value), 1, 0, | |
4469 | &TREE_INT_CST_LOW (enum_next_value), | |
4470 | &TREE_INT_CST_HIGH (enum_next_value)); | |
4471 | enum_overflow = tree_int_cst_lt (enum_next_value, value); | |
4472 | } | |
4473 | else | |
4474 | DECL_INITIAL (decl) = value; /* error_mark_node */ | |
4475 | } | |
4476 | ||
4477 | /* Fix all error_mark_nodes in enum. Increment maxnode and assign value. | |
ec3fd6be | 4478 | This is necessary to make a duplicate value check in the enum */ |
3c79b2da PB |
4479 | for (pair = values; pair; pair = TREE_CHAIN (pair)) |
4480 | { | |
4481 | tree decl = TREE_VALUE (pair); | |
4482 | if (DECL_INITIAL (decl) == error_mark_node) | |
4483 | { | |
4484 | tree value; | |
4485 | add_double (TREE_INT_CST_LOW (maxnode), TREE_INT_CST_HIGH (maxnode), 1, 0, | |
4486 | &TREE_INT_CST_LOW (enum_next_value), | |
4487 | &TREE_INT_CST_HIGH (enum_next_value)); | |
4488 | value = build_int_2 (TREE_INT_CST_LOW (enum_next_value), | |
4489 | TREE_INT_CST_HIGH (enum_next_value)); | |
4490 | TREE_TYPE (value) = enumtype; | |
4491 | CH_DERIVED_FLAG (value) = 1; | |
4492 | DECL_INITIAL (decl) = value; | |
4493 | ||
4494 | maxnode = value; | |
4495 | } | |
4496 | } | |
4497 | ||
4498 | /* Now check if we have duplicate values within the enum */ | |
4499 | for (pair = values; pair; pair = TREE_CHAIN (pair)) | |
4500 | { | |
4501 | tree succ; | |
4502 | tree decl1 = TREE_VALUE (pair); | |
4503 | tree val1 = DECL_INITIAL (decl1); | |
4504 | ||
4505 | for (succ = TREE_CHAIN (pair); succ; succ = TREE_CHAIN (succ)) | |
4506 | { | |
4507 | if (pair != succ) | |
4508 | { | |
4509 | tree decl2 = TREE_VALUE (succ); | |
4510 | tree val2 = DECL_INITIAL (decl2); | |
4511 | if (tree_int_cst_equal (val1, val2)) | |
4512 | error ("enumerators `%s' and `%s' have equal values", | |
4513 | IDENTIFIER_POINTER (DECL_NAME (decl1)), | |
4514 | IDENTIFIER_POINTER (DECL_NAME (decl2))); | |
4515 | } | |
4516 | } | |
4517 | } | |
4518 | ||
4519 | TYPE_MIN_VALUE (enumtype) = minnode; | |
4520 | TYPE_MAX_VALUE (enumtype) = maxnode; | |
4521 | ||
4522 | precision = get_type_precision (minnode, maxnode); | |
4523 | ||
4524 | if (flag_short_enums || precision > TYPE_PRECISION (integer_type_node)) | |
4525 | /* Use the width of the narrowest normal C type which is wide enough. */ | |
4526 | TYPE_PRECISION (enumtype) = TYPE_PRECISION (type_for_size (precision, 1)); | |
4527 | else | |
4528 | TYPE_PRECISION (enumtype) = TYPE_PRECISION (integer_type_node); | |
4529 | ||
4530 | layout_type (enumtype); | |
4531 | ||
4532 | #if 0 | |
4533 | /* An enum can have some negative values; then it is signed. */ | |
4534 | TREE_UNSIGNED (enumtype) = ! tree_int_cst_lt (minnode, integer_zero_node); | |
4535 | #else | |
4536 | /* Z200/1988 page 19 says: | |
4537 | For each pair of integer literal expression e1, e2 in the set list NUM (e1) | |
4538 | and NUM (e2) must deliver different non-negative results */ | |
4539 | TREE_UNSIGNED (enumtype) = 1; | |
4540 | #endif | |
4541 | ||
4542 | for (pair = values; pair; pair = TREE_CHAIN (pair)) | |
4543 | { | |
4544 | tree decl = TREE_VALUE (pair); | |
06ceef4e | 4545 | |
3c79b2da | 4546 | DECL_SIZE (decl) = TYPE_SIZE (enumtype); |
06ceef4e | 4547 | DECL_SIZE_UNIT (decl) = TYPE_SIZE_UNIT (enumtype); |
3c79b2da | 4548 | DECL_ALIGN (decl) = TYPE_ALIGN (enumtype); |
11cf4d18 | 4549 | DECL_USER_ALIGN (decl) = TYPE_USER_ALIGN (enumtype); |
3c79b2da PB |
4550 | |
4551 | /* Set the TREE_VALUE to the name, rather than the decl, | |
4552 | since that is what the rest of the compiler expects. */ | |
4553 | TREE_VALUE (pair) = DECL_INITIAL (decl); | |
4554 | } | |
4555 | ||
4556 | /* Fix up all variant types of this enum type. */ | |
4557 | for (tem = TYPE_MAIN_VARIANT (enumtype); tem; tem = TYPE_NEXT_VARIANT (tem)) | |
4558 | { | |
4559 | TYPE_VALUES (tem) = TYPE_VALUES (enumtype); | |
4560 | TYPE_MIN_VALUE (tem) = TYPE_MIN_VALUE (enumtype); | |
4561 | TYPE_MAX_VALUE (tem) = TYPE_MAX_VALUE (enumtype); | |
4562 | TYPE_SIZE (tem) = TYPE_SIZE (enumtype); | |
4563 | TYPE_MODE (tem) = TYPE_MODE (enumtype); | |
4564 | TYPE_PRECISION (tem) = TYPE_PRECISION (enumtype); | |
4565 | TYPE_ALIGN (tem) = TYPE_ALIGN (enumtype); | |
11cf4d18 | 4566 | TYPE_USER_ALIGN (tem) = TYPE_USER_ALIGN (enumtype); |
3c79b2da PB |
4567 | TREE_UNSIGNED (tem) = TREE_UNSIGNED (enumtype); |
4568 | } | |
4569 | ||
4570 | #if 0 | |
4571 | /* This matches a push in start_enum. */ | |
4572 | pop_obstacks (); | |
4573 | #endif | |
4574 | } | |
4575 | \f | |
4576 | tree | |
4577 | finish_enum (enumtype, values) | |
4578 | register tree enumtype, values; | |
4579 | { | |
4580 | TYPE_VALUES (enumtype) = values = nreverse (values); | |
4581 | ||
4582 | /* If satisfy_decl is called on one of the enum CONST_DECLs, | |
4583 | this will make sure that the enumtype gets laid out then. */ | |
4584 | for ( ; values; values = TREE_CHAIN (values)) | |
4585 | TREE_TYPE (TREE_VALUE (values)) = enumtype; | |
4586 | ||
4587 | return enumtype; | |
4588 | } | |
4589 | ||
4590 | ||
4591 | /* Build and install a CONST_DECL for one value of the | |
4592 | current enumeration type (one that was begun with start_enum). | |
4593 | Return a tree-list containing the CONST_DECL and its value. | |
4594 | Assignment of sequential values by default is handled here. */ | |
4595 | ||
4596 | tree | |
4597 | build_enumerator (name, value) | |
4598 | tree name, value; | |
4599 | { | |
4600 | register tree decl; | |
4601 | int named = name != NULL_TREE; | |
4602 | ||
4603 | if (pass == 2) | |
4604 | { | |
4605 | if (name) | |
4606 | (void) get_next_decl (); | |
4607 | return NULL_TREE; | |
4608 | } | |
4609 | ||
4610 | if (name == NULL_TREE) | |
4611 | { | |
4612 | static int unnamed_value_warned = 0; | |
4613 | static int next_dummy_enum_value = 0; | |
4614 | char buf[20]; | |
4615 | if (!unnamed_value_warned) | |
4616 | { | |
4617 | unnamed_value_warned = 1; | |
c725bd79 | 4618 | warning ("undefined value in SET mode is obsolete and deprecated"); |
3c79b2da PB |
4619 | } |
4620 | sprintf (buf, "__star_%d", next_dummy_enum_value++); | |
4621 | name = get_identifier (buf); | |
4622 | } | |
4623 | ||
4624 | decl = build_decl (CONST_DECL, name, integer_type_node); | |
4625 | CH_DECL_ENUM (decl) = 1; | |
4626 | DECL_INITIAL (decl) = value; | |
4627 | if (named) | |
4628 | { | |
4629 | if (pass == 0) | |
4630 | { | |
4631 | push_obstacks_nochange (); | |
4632 | pushdecl (decl); | |
4633 | finish_decl (decl); | |
4634 | } | |
4635 | else | |
4636 | save_decl (decl); | |
4637 | } | |
4638 | return build_tree_list (name, decl); | |
4639 | ||
4640 | #if 0 | |
4641 | tree old_value = lookup_name_current_level (name); | |
4642 | ||
4643 | if (old_value != NULL_TREE | |
4644 | && TREE_CODE (old_value)=!= CONST_DECL | |
4645 | && (value == NULL_TREE || operand_equal_p (value, old_value, 1))) | |
4646 | { | |
4647 | if (value == NULL_TREE) | |
4648 | { | |
4649 | if (TREE_CODE (old_value) == CONST_DECL) | |
4650 | value = DECL_INITIAL (old_value); | |
4651 | else | |
4652 | abort (); | |
4653 | } | |
4654 | return saveable_tree_cons (old_value, value, NULL_TREE); | |
4655 | } | |
4656 | #endif | |
4657 | } | |
4658 | \f | |
4659 | /* Record that this function is going to be a varargs function. | |
4660 | This is called before store_parm_decls, which is too early | |
4661 | to call mark_varargs directly. */ | |
4662 | ||
4663 | void | |
4664 | c_mark_varargs () | |
4665 | { | |
4666 | c_function_varargs = 1; | |
4667 | } | |
4668 | \f | |
4669 | /* Function needed for CHILL interface. */ | |
4670 | tree | |
4671 | get_parm_decls () | |
4672 | { | |
4673 | return current_function_parms; | |
4674 | } | |
4675 | \f | |
4676 | /* Save and restore the variables in this file and elsewhere | |
4677 | that keep track of the progress of compilation of the current function. | |
4678 | Used for nested functions. */ | |
4679 | ||
4680 | struct c_function | |
4681 | { | |
4682 | struct c_function *next; | |
4683 | struct scope *scope; | |
4684 | tree chill_result_decl; | |
4685 | int result_never_set; | |
4686 | }; | |
4687 | ||
4688 | struct c_function *c_function_chain; | |
4689 | ||
4690 | /* Save and reinitialize the variables | |
4691 | used during compilation of a C function. */ | |
4692 | ||
4693 | void | |
4694 | push_chill_function_context () | |
4695 | { | |
4696 | struct c_function *p | |
4697 | = (struct c_function *) xmalloc (sizeof (struct c_function)); | |
4698 | ||
4699 | push_function_context (); | |
4700 | ||
4701 | p->next = c_function_chain; | |
4702 | c_function_chain = p; | |
4703 | ||
4704 | p->scope = current_scope; | |
4705 | p->chill_result_decl = chill_result_decl; | |
4706 | p->result_never_set = result_never_set; | |
4707 | } | |
4708 | ||
4709 | /* Restore the variables used during compilation of a C function. */ | |
4710 | ||
4711 | void | |
4712 | pop_chill_function_context () | |
4713 | { | |
4714 | struct c_function *p = c_function_chain; | |
4715 | #if 0 | |
4716 | tree link; | |
4717 | /* Bring back all the labels that were shadowed. */ | |
4718 | for (link = shadowed_labels; link; link = TREE_CHAIN (link)) | |
4719 | if (DECL_NAME (TREE_VALUE (link)) != 0) | |
4720 | IDENTIFIER_LABEL_VALUE (DECL_NAME (TREE_VALUE (link))) | |
4721 | = TREE_VALUE (link); | |
4722 | #endif | |
4723 | ||
4724 | pop_function_context (); | |
4725 | ||
4726 | c_function_chain = p->next; | |
4727 | ||
4728 | current_scope = p->scope; | |
4729 | chill_result_decl = p->chill_result_decl; | |
4730 | result_never_set = p->result_never_set; | |
4731 | ||
4732 | free (p); | |
4733 | } | |
4734 | \f | |
4735 | /* Following from Jukka Virtanen's GNU Pascal */ | |
4736 | /* To implement WITH statement: | |
4737 | ||
4738 | 1) Call shadow_record_fields for each record_type element in the WITH | |
4739 | element list. Each call creates a new binding level. | |
4740 | ||
4741 | 2) construct a component_ref for EACH field in the record, | |
4742 | and store it to the IDENTIFIER_LOCAL_VALUE after adding | |
4743 | the old value to the shadow list | |
4744 | ||
4745 | 3) let lookup_name do the rest | |
4746 | ||
4747 | 4) pop all of the binding levels after the WITH statement ends. | |
4748 | (restoring old local values) You have to keep track of the number | |
4749 | of times you called it. | |
4750 | */ | |
4751 | \f | |
4752 | /* | |
4753 | * Save an arbitrary tree-expression as the IDENTIFIER_LOCAL_VALUE | |
4754 | * of a name. Save the name's previous value. Check for name | |
4755 | * collisions with another value under the same name at the same | |
4756 | * nesting level. This is used to implement the DO WITH construct | |
4757 | * and the temporary for the location iteration loop. | |
4758 | */ | |
4759 | void | |
4760 | save_expr_under_name (name, expr) | |
4761 | tree name, expr; | |
4762 | { | |
4763 | tree alias = build_alias_decl (NULL_TREE, NULL_TREE, name); | |
4764 | ||
4765 | DECL_ABSTRACT_ORIGIN (alias) = expr; | |
4766 | TREE_CHAIN (alias) = NULL_TREE; | |
4767 | pushdecllist (alias, 0); | |
4768 | } | |
4769 | ||
31029ad7 | 4770 | static void |
3c79b2da PB |
4771 | do_based_decl (name, mode, base_var) |
4772 | tree name, mode, base_var; | |
4773 | { | |
4774 | tree decl; | |
4775 | if (pass == 1) | |
4776 | { | |
4777 | push_obstacks (&permanent_obstack, &permanent_obstack); | |
4778 | decl = make_node (BASED_DECL); | |
4779 | DECL_NAME (decl) = name; | |
4780 | TREE_TYPE (decl) = mode; | |
4781 | DECL_ABSTRACT_ORIGIN (decl) = base_var; | |
4782 | save_decl (decl); | |
4783 | pop_obstacks (); | |
4784 | } | |
4785 | else | |
4786 | { | |
4787 | tree base_decl; | |
4788 | decl = get_next_decl (); | |
4789 | if (name != DECL_NAME (decl)) | |
4790 | abort(); | |
4791 | /* FIXME: This isn't a complete test */ | |
4792 | base_decl = lookup_name (base_var); | |
4793 | if (base_decl == NULL_TREE) | |
4794 | error ("BASE variable never declared"); | |
4795 | else if (TREE_CODE (base_decl) == FUNCTION_DECL) | |
4796 | error ("cannot BASE a variable on a PROC/PROCESS name"); | |
4797 | } | |
4798 | } | |
4799 | ||
4800 | void | |
4801 | do_based_decls (names, mode, base_var) | |
4802 | tree names, mode, base_var; | |
4803 | { | |
4804 | if (names == NULL_TREE || TREE_CODE (names) == TREE_LIST) | |
4805 | { | |
4806 | for (; names != NULL_TREE; names = TREE_CHAIN (names)) | |
4807 | do_based_decl (names, mode, base_var); | |
4808 | } | |
4809 | else if (TREE_CODE (names) != ERROR_MARK) | |
4810 | do_based_decl (names, mode, base_var); | |
4811 | } | |
4812 | ||
4813 | /* | |
4814 | * Declare the fields so that lookup_name() will find them as | |
4815 | * component refs for Pascal WITH or CHILL DO WITH. | |
4816 | * | |
4817 | * Proceeds to the inner layers of Pascal/CHILL variant record | |
4818 | * | |
4819 | * Internal routine of shadow_record_fields () | |
4820 | */ | |
4821 | static void | |
4822 | handle_one_level (parent, fields) | |
4823 | tree parent, fields; | |
4824 | { | |
4825 | tree field, name; | |
4826 | ||
4827 | switch (TREE_CODE (TREE_TYPE (parent))) | |
4828 | { | |
4829 | case RECORD_TYPE: | |
4830 | case UNION_TYPE: | |
4831 | for (field = fields; field; field = TREE_CHAIN (field)) { | |
4832 | name = DECL_NAME (field); | |
4833 | if (name == NULL_TREE || name == ELSE_VARIANT_NAME) | |
4834 | /* proceed through variant part */ | |
4835 | handle_one_level (parent, TYPE_FIELDS (TREE_TYPE (field))); | |
4836 | else | |
4837 | { | |
4838 | tree field_alias = make_node (WITH_DECL); | |
4839 | DECL_NAME (field_alias) = name; | |
4840 | TREE_TYPE (field_alias) = TREE_TYPE (field); | |
4841 | DECL_ABSTRACT_ORIGIN (field_alias) = parent; | |
4842 | TREE_CHAIN (field_alias) = NULL_TREE; | |
4843 | pushdecllist (field_alias, 0); | |
4844 | } | |
4845 | } | |
4846 | break; | |
4847 | default: | |
4848 | error ("INTERNAL ERROR: handle_one_level is broken"); | |
4849 | } | |
4850 | } | |
4851 | \f | |
4852 | /* | |
4853 | * For each FIELD_DECL node in a RECORD_TYPE, we have to declare | |
4854 | * a name so that lookup_name will find a COMPONENT_REF node | |
4855 | * when the name is referenced. This happens in Pascal WITH statement. | |
4856 | */ | |
4857 | void | |
4858 | shadow_record_fields (struct_val) | |
4859 | tree struct_val; | |
4860 | { | |
3c79b2da PB |
4861 | if (pass == 1 || struct_val == NULL_TREE) |
4862 | return; | |
4863 | ||
4864 | handle_one_level (struct_val, TYPE_FIELDS (TREE_TYPE (struct_val))); | |
4865 | } | |
4866 | \f | |
4867 | static char exception_prefix [] = "__Ex_"; | |
4868 | ||
4869 | tree | |
4870 | build_chill_exception_decl (name) | |
31029ad7 | 4871 | const char *name; |
3c79b2da PB |
4872 | { |
4873 | tree decl, ex_name, ex_init, ex_type; | |
4874 | int name_len = strlen (name); | |
4875 | char *ex_string = (char *) | |
4876 | alloca (strlen (exception_prefix) + name_len + 1); | |
4877 | ||
4878 | sprintf(ex_string, "%s%s", exception_prefix, name); | |
4879 | ex_name = get_identifier (ex_string); | |
4880 | decl = IDENTIFIER_LOCAL_VALUE (ex_name); | |
4881 | if (decl) | |
4882 | return decl; | |
4883 | ||
4884 | /* finish_decl is too eager about switching back to the | |
4885 | ambient context. This decl's rtl must live in the permanent_obstack. */ | |
4886 | push_obstacks (&permanent_obstack, &permanent_obstack); | |
4887 | push_obstacks_nochange (); | |
4888 | ex_type = build_array_type (char_type_node, | |
4889 | build_index_2_type (integer_zero_node, | |
4890 | build_int_2 (name_len, 0))); | |
4891 | decl = build_lang_decl (VAR_DECL, ex_name, ex_type); | |
4892 | ex_init = build_string (name_len, name); | |
4893 | TREE_TYPE (ex_init) = ex_type; | |
4894 | DECL_INITIAL (decl) = ex_init; | |
4895 | TREE_READONLY (decl) = 1; | |
4896 | TREE_STATIC (decl) = 1; | |
4897 | pushdecl_top_level (decl); | |
4898 | finish_decl (decl); | |
4899 | pop_obstacks (); /* Return to the ambient context. */ | |
4900 | return decl; | |
4901 | } | |
4902 | ||
4903 | extern tree module_init_list; | |
4904 | ||
4905 | /* | |
4906 | * This function is called from the parser to preface the entire | |
4907 | * compilation. It contains module-level actions and reach-bound | |
4908 | * initialization. | |
4909 | */ | |
4910 | void | |
4911 | start_outer_function () | |
4912 | { | |
4913 | start_chill_function (pass < 2 ? get_identifier ("_GLOBAL_") | |
4914 | : DECL_NAME (global_function_decl), | |
4915 | void_type_node, NULL_TREE, NULL_TREE, NULL_TREE); | |
4916 | global_function_decl = current_function_decl; | |
4917 | global_scope = current_scope; | |
4918 | chill_at_module_level = 1; | |
4919 | } | |
4920 | \f | |
4921 | /* This function finishes the global_function_decl, and if it is non-empty | |
4922 | * (as indiacted by seen_action), adds it to module_init_list. | |
4923 | */ | |
4924 | void | |
4925 | finish_outer_function () | |
4926 | { | |
4927 | /* If there was module-level code in this module (not just function | |
4928 | declarations), we allocate space for this module's init list entry, | |
4929 | and fill in the module's function's address. */ | |
4930 | ||
4931 | extern tree initializer_type; | |
31029ad7 | 4932 | const char *fname_str = IDENTIFIER_POINTER (DECL_NAME (current_function_decl)); |
3c79b2da PB |
4933 | char *init_entry_name = (char *)xmalloc ((unsigned)(strlen (fname_str) + 20)); |
4934 | tree init_entry_id; | |
4935 | tree init_entry_decl; | |
4936 | tree initializer; | |
4937 | ||
4938 | finish_chill_function (); | |
4939 | ||
4940 | chill_at_module_level = 0; | |
4941 | ||
4942 | ||
4943 | if (!seen_action) | |
4944 | return; | |
4945 | ||
4946 | sprintf (init_entry_name, "__tmp_%s_init_entry", fname_str); | |
4947 | init_entry_id = get_identifier (init_entry_name); | |
4948 | ||
4949 | init_entry_decl = build1 (ADDR_EXPR, | |
4950 | TREE_TYPE (TYPE_FIELDS (initializer_type)), | |
4951 | global_function_decl); | |
4952 | TREE_CONSTANT (init_entry_decl) = 1; | |
4953 | initializer = build (CONSTRUCTOR, initializer_type, NULL_TREE, | |
4954 | tree_cons (NULL_TREE, init_entry_decl, | |
4955 | build_tree_list (NULL_TREE, | |
4956 | null_pointer_node))); | |
4957 | TREE_CONSTANT (initializer) = 1; | |
4958 | init_entry_decl | |
4959 | = do_decl (init_entry_id, initializer_type, 1, 1, initializer, 0); | |
4960 | DECL_SOURCE_LINE (init_entry_decl) = 0; | |
4961 | if (pass == 1) | |
4962 | /* tell chill_finish_compile that there's | |
4963 | module-level code to be processed. */ | |
4964 | module_init_list = integer_one_node; | |
4965 | else if (build_constructor) | |
4966 | module_init_list = tree_cons (global_function_decl, | |
4967 | init_entry_decl, | |
4968 | module_init_list); | |
4969 | ||
4970 | make_decl_rtl (global_function_decl, NULL, 0); | |
4971 | } |