1 /* Name-satisfaction for GNU Chill compiler.
2 Copyright (C) 1993, 1998, 1999, 2000 Free Software Foundation, Inc.
4 This file is part of GNU CC.
6 GNU CC is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU CC is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU CC; see the file COPYING. If not, write to
18 the Free Software Foundation, 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
29 #define SATISFY(ARG) ((ARG) = satisfy(ARG, chain))
33 struct decl_chain
*prev
;
34 /* DECL can be a decl, or a POINTER_TYPE or a REFERENCE_TYPE. */
38 /* forward declarations */
39 static tree satisfy
PARAMS ((tree
, struct decl_chain
*));
40 static void cycle_error_print
PARAMS ((struct decl_chain
*, tree
));
41 static tree safe_satisfy_decl
PARAMS ((tree
, struct decl_chain
*));
42 static void satisfy_list
PARAMS ((tree
, struct decl_chain
*));
43 static void satisfy_list_values
PARAMS ((tree
, struct decl_chain
*));
45 static struct decl_chain dummy_chain
;
46 #define LOOKUP_ONLY (chain==&dummy_chain)
48 /* Recursive helper routine to logically reverse the chain. */
50 cycle_error_print (chain
, decl
)
51 struct decl_chain
*chain
;
54 if (chain
->decl
!= decl
)
56 cycle_error_print (chain
->prev
, decl
);
57 if (TREE_CODE_CLASS (TREE_CODE (chain
->decl
)) == 'd')
58 error_with_decl (chain
->decl
, " `%s', which depends on ...");
63 safe_satisfy_decl (decl
, prev_chain
)
65 struct decl_chain
*prev_chain
;
67 struct decl_chain new_link
;
68 struct decl_chain
*link
;
69 struct decl_chain
*chain
= prev_chain
;
70 const char *save_filename
= input_filename
;
71 int save_lineno
= lineno
;
74 if (decl
== NULL_TREE
)
79 int pointer_type_breaks_cycle
= 0;
81 We could do this test more efficiently by setting a flag. FIXME */
82 for (link
= prev_chain
; link
!= NULL
; link
= link
->prev
)
84 if (TREE_CODE_CLASS (TREE_CODE (link
->decl
)) != 'd')
85 pointer_type_breaks_cycle
= 1;
86 if (link
->decl
== decl
)
88 if (!pointer_type_breaks_cycle
)
90 error_with_decl (decl
, "Cycle: `%s' depends on ...");
91 cycle_error_print (prev_chain
, decl
);
92 error_with_decl (decl
, " `%s'");
93 return error_mark_node
;
95 /* There is a cycle, but it includes a pointer type,
96 so we're OK. However, we still have to continue
97 the satisfy (for example in case this is a TYPE_DECL
98 that points to a LANG_DECL). The cycle-check for
99 POINTER_TYPE/REFERENCE_TYPE should stop the recursion. */
104 new_link
.decl
= decl
;
105 new_link
.prev
= prev_chain
;
109 input_filename
= DECL_SOURCE_FILE (decl
);
110 lineno
= DECL_SOURCE_LINE (decl
);
112 switch ((enum chill_tree_code
)TREE_CODE (decl
))
115 if (!LOOKUP_ONLY
&& !DECL_POSTFIX_ALL(decl
))
116 result
= safe_satisfy_decl (DECL_ABSTRACT_ORIGIN (decl
), chain
);
119 SATISFY (TREE_TYPE (decl
));
120 SATISFY (DECL_ABSTRACT_ORIGIN (decl
));
123 SATISFY (TREE_TYPE (decl
));
124 SATISFY (DECL_INITIAL (decl
));
127 if (DECL_SIZE (decl
) == 0)
129 tree init_expr
= DECL_INITIAL (decl
);
131 tree specified_mode
= TREE_TYPE (decl
);
133 if (init_expr
== NULL_TREE
134 || TREE_CODE (init_expr
) == ERROR_MARK
)
136 init_type
= TREE_TYPE (init_expr
);
137 if (specified_mode
== NULL_TREE
)
139 if (init_type
== NULL_TREE
)
141 check_have_mode (init_expr
, "SYN without mode");
144 TREE_TYPE (decl
) = init_type
;
145 CH_DERIVED_FLAG (decl
) = CH_DERIVED_FLAG (init_expr
);
147 else if (CH_IS_ASSOCIATION_MODE (specified_mode
) ||
148 CH_IS_ACCESS_MODE (specified_mode
) || CH_IS_TEXT_MODE (specified_mode
) ||
149 CH_IS_BUFFER_MODE (specified_mode
) || CH_IS_EVENT_MODE (specified_mode
))
151 error ("SYN of this mode not allowed");
154 else if (!CH_COMPATIBLE (init_expr
, specified_mode
))
156 error ("mode of SYN incompatible with value");
159 else if (discrete_type_p (specified_mode
)
160 && TREE_CODE (init_expr
) == INTEGER_CST
161 && (compare_int_csts (LT_EXPR
, init_expr
,
162 TYPE_MIN_VALUE (specified_mode
))
163 || compare_int_csts (GT_EXPR
, init_expr
,
164 TYPE_MAX_VALUE(specified_mode
))
167 error ("SYN value outside range of its mode");
168 /* set an always-valid initial value to prevent
170 DECL_INITIAL (decl
) = TYPE_MIN_VALUE (specified_mode
);
172 else if (CH_STRING_TYPE_P (specified_mode
)
173 && (init_type
&& CH_STRING_TYPE_P (init_type
))
174 && integer_zerop (string_assignment_condition (specified_mode
, init_expr
)))
176 error ("INIT string too large for mode");
177 DECL_INITIAL (decl
) = error_mark_node
;
181 struct ch_class
class;
182 class.mode
= TREE_TYPE (decl
);
183 class.kind
= CH_VALUE_CLASS
;
185 = convert_to_class (class, DECL_INITIAL (decl
));
187 /* DECL_SIZE is set to prevent re-doing this stuff. */
188 DECL_SIZE (decl
) = TYPE_SIZE (TREE_TYPE (decl
));
189 DECL_SIZE_UNIT (decl
) = TYPE_SIZE_UNIT (TREE_TYPE (decl
));
191 if (! TREE_CONSTANT (DECL_INITIAL (decl
))
192 && TREE_CODE (DECL_INITIAL (decl
)) != ERROR_MARK
)
194 error_with_decl (decl
,
195 "value of %s is not a valid constant");
196 DECL_INITIAL (decl
) = error_mark_node
;
199 result
= DECL_INITIAL (decl
);
203 DECL_INITIAL (decl
) = error_mark_node
;
204 TREE_TYPE (decl
) = error_mark_node
;
205 return error_mark_node
;
207 SATISFY (TREE_TYPE (decl
));
208 if (CH_DECL_PROCESS (decl
))
209 safe_satisfy_decl ((tree
) DECL_TASKING_CODE_DECL (decl
), prev_chain
);
212 SATISFY (TREE_TYPE (decl
));
214 /* RESULT_DECL doesn't need to be satisfied;
215 it's only built internally in pass 2 */
217 SATISFY (TREE_TYPE (decl
));
218 if (CH_DECL_SIGNAL (decl
))
219 safe_satisfy_decl ((tree
) DECL_TASKING_CODE_DECL (decl
), prev_chain
);
222 if (TYPE_NAME (TREE_TYPE (decl
)) == NULL_TREE
)
223 TYPE_NAME (TREE_TYPE (decl
)) = decl
;
224 layout_decl (decl
, 0);
225 if (CH_DECL_SIGNAL (decl
) && CH_TYPE_NONVALUE_P (TREE_TYPE (decl
)))
226 error ("mode with non-value property in signal definition");
227 result
= TREE_TYPE (decl
);
231 SATISFY (TREE_TYPE (decl
));
234 layout_decl (decl
, 0);
235 if (TREE_READONLY (TREE_TYPE (decl
)))
236 TREE_READONLY (decl
) = 1;
243 /* Now set the DECL_RTL, if needed. */
244 if (!LOOKUP_ONLY
&& DECL_RTL (decl
) == 0
245 && (TREE_CODE (decl
) == VAR_DECL
|| TREE_CODE (decl
) == FUNCTION_DECL
246 || TREE_CODE (decl
) == CONST_DECL
))
248 if (TREE_CODE (decl
) == FUNCTION_DECL
&& decl_function_context (decl
))
249 make_function_rtl (decl
);
250 else if (!TREE_STATIC (decl
) && !DECL_EXTERNAL (decl
))
254 if (current_module
== 0 || TREE_PUBLIC (decl
)
255 || current_function_decl
)
260 alloca (IDENTIFIER_LENGTH (current_module
->prefix_name
)
261 + IDENTIFIER_LENGTH (DECL_NAME (decl
)) + 3);
262 sprintf (asm_name
, "%s__%s",
263 IDENTIFIER_POINTER (current_module
->prefix_name
),
264 IDENTIFIER_POINTER (DECL_NAME (decl
)));
266 make_decl_rtl (decl
, asm_name
, TREE_PUBLIC (decl
));
270 input_filename
= save_filename
;
271 lineno
= save_lineno
;
277 satisfy_decl (decl
, lookup_only
)
281 return safe_satisfy_decl (decl
, lookup_only
? &dummy_chain
: NULL
);
285 satisfy_list (exp
, chain
)
287 struct decl_chain
*chain
;
289 for (; exp
!= NULL_TREE
; exp
= TREE_CHAIN (exp
))
291 SATISFY (TREE_VALUE (exp
));
292 SATISFY (TREE_PURPOSE (exp
));
297 satisfy_list_values (exp
, chain
)
299 struct decl_chain
*chain
;
301 for (; exp
!= NULL_TREE
; exp
= TREE_CHAIN (exp
))
303 SATISFY (TREE_VALUE (exp
));
310 struct decl_chain
*chain
;
316 if (exp
== NULL_TREE
)
320 if (!UNSATISFIED (exp
))
324 switch (TREE_CODE_CLASS (TREE_CODE (exp
)))
328 return safe_satisfy_decl (exp
, chain
);
334 switch ((enum chill_tree_code
)TREE_CODE (exp
))
341 SATISFY (TREE_OPERAND (exp
, 0));
342 if (!LOOKUP_ONLY
&& TREE_TYPE (exp
) == NULL_TREE
)
343 return resolve_component_ref (exp
);
346 SATISFY (TREE_OPERAND (exp
, 0));
347 SATISFY (TREE_OPERAND (exp
, 1));
348 if (!LOOKUP_ONLY
&& TREE_TYPE (exp
) == NULL_TREE
)
349 return build_generalized_call (TREE_OPERAND (exp
, 0),
350 TREE_OPERAND (exp
, 1));
353 { tree link
= TREE_OPERAND (exp
, 1);
354 int expand_needed
= TREE_TYPE (exp
)
355 && TREE_CODE_CLASS (TREE_CODE (TREE_TYPE (exp
))) != 't';
356 for (; link
!= NULL_TREE
; link
= TREE_CHAIN (link
))
358 SATISFY (TREE_VALUE (link
));
359 if (!TUPLE_NAMED_FIELD (link
))
360 SATISFY (TREE_PURPOSE (link
));
362 SATISFY (TREE_TYPE (exp
));
363 if (expand_needed
&& !LOOKUP_ONLY
)
365 tree type
= TREE_TYPE (exp
);
366 TREE_TYPE (exp
) = NULL_TREE
; /* To force expansion. */
367 return chill_expand_tuple (type
, exp
);
375 arg_length
= TREE_CODE_LENGTH (TREE_CODE (exp
));
376 for (i
= 0; i
< arg_length
; i
++)
377 SATISFY (TREE_OPERAND (exp
, i
));
381 SATISFY (TREE_OPERAND (exp
, 0));
382 if ((enum chill_tree_code
)TREE_CODE (exp
) == PAREN_EXPR
)
383 return TREE_OPERAND (exp
, 0);
385 return finish_chill_unary_op (exp
);
389 SATISFY (TREE_OPERAND (exp
, 0));
390 SATISFY (TREE_OPERAND (exp
, 1));
391 if (!LOOKUP_ONLY
&& TREE_CODE (exp
) != RANGE_EXPR
)
392 return finish_chill_binary_op (exp
);
395 switch ((enum chill_tree_code
)TREE_CODE (exp
))
397 case IDENTIFIER_NODE
:
398 decl
= lookup_name (exp
);
403 error ("undeclared identifier `%s'", IDENTIFIER_POINTER (exp
));
404 return error_mark_node
;
408 return safe_satisfy_decl (decl
, chain
);
410 satisfy_list (exp
, chain
);
417 /* If TYPE_SIZE is non-NULL, exp and its subfields has already been
418 satified and laid out. The exception is pointer and reference types,
419 which we layout before we lay out their TREE_TYPE. */
420 if (TYPE_SIZE (exp
) && TREE_CODE (exp
) != POINTER_TYPE
421 && TREE_CODE (exp
) != REFERENCE_TYPE
)
423 if (TYPE_MAIN_VARIANT (exp
) != exp
)
424 SATISFY (TYPE_MAIN_VARIANT (exp
));
425 switch ((enum chill_tree_code
)TREE_CODE (exp
))
429 tree d
= TYPE_DOMAIN (exp
);
430 tree t
= satisfy (TREE_TYPE (exp
), chain
);
432 /* It is possible that one of the above satisfy calls recursively
433 caused exp to be satisfied, in which case we're done. */
434 if (TREE_CODE (exp
) != LANG_TYPE
)
437 TYPE_DOMAIN (exp
) = d
;
439 exp
= smash_dummy_type (exp
);
443 SATISFY (TREE_TYPE (exp
));
444 SATISFY (TYPE_DOMAIN (exp
));
445 SATISFY (TYPE_ATTRIBUTES (exp
));
447 CH_TYPE_NONVALUE_P (exp
) = CH_TYPE_NONVALUE_P (TREE_TYPE (exp
));
448 if (!TYPE_SIZE (exp
) && !LOOKUP_ONLY
)
449 exp
= layout_chill_array_type (exp
);
452 SATISFY (TREE_TYPE (exp
));
453 if (TREE_CODE_CLASS (TREE_CODE (TREE_TYPE (exp
))) != 't'
454 && !LOOKUP_ONLY
&& TREE_CODE (TREE_TYPE (exp
)) != ERROR_MARK
)
456 error ("RETURNS spec with invalid mode");
457 TREE_TYPE (exp
) = error_mark_node
;
459 satisfy_list_values (TYPE_ARG_TYPES (exp
), chain
);
460 if (!TYPE_SIZE (exp
) && !LOOKUP_ONLY
)
464 if (TYPE_SIZE (exp
) == NULL_TREE
&& !LOOKUP_ONLY
)
466 /* FIXME: Should this use satisfy_decl? */
467 for (pair
= TYPE_VALUES (exp
); pair
; pair
= TREE_CHAIN (pair
))
468 SATISFY (DECL_INITIAL (TREE_VALUE (pair
)));
473 SATISFY (TYPE_MIN_VALUE (exp
));
474 SATISFY (TYPE_MAX_VALUE (exp
));
475 if (TREE_TYPE (exp
) != NULL_TREE
)
477 if (TREE_TYPE (exp
) != ridpointers
[(int) RID_RANGE
]
478 && TREE_TYPE (exp
) != ridpointers
[(int) RID_BIN
]
479 && TREE_TYPE (exp
) != string_index_type_dummy
)
480 SATISFY (TREE_TYPE (exp
));
481 if (!TYPE_SIZE (exp
) && !LOOKUP_ONLY
)
482 exp
= layout_chill_range_type (exp
, 1);
488 SATISFY (TREE_TYPE (exp
));
491 struct decl_chain
*link
;
492 int already_seen
= 0;
493 for (link
= chain
; ; link
= link
->prev
)
497 struct decl_chain new_link
;
499 new_link
.prev
= chain
;
500 TREE_TYPE (exp
) = satisfy (TREE_TYPE (exp
), &new_link
);
503 else if (link
->decl
== exp
)
509 if (!TYPE_SIZE (exp
))
512 if (TREE_CODE (exp
) == REFERENCE_TYPE
)
513 CH_NOVELTY (exp
) = CH_NOVELTY (TREE_TYPE (exp
));
516 tree valtype
= TREE_TYPE (exp
);
517 if (TREE_CODE_CLASS (TREE_CODE (valtype
)) != 't')
519 if (TREE_CODE (valtype
) != ERROR_MARK
)
520 error ("operand to REF is not a mode");
521 TREE_TYPE (exp
) = error_mark_node
;
522 return error_mark_node
;
524 else if (TREE_CODE (exp
) == POINTER_TYPE
525 && TYPE_POINTER_TO (valtype
) == NULL
)
526 TYPE_POINTER_TO (valtype
) = exp
;
533 /* FIXME: detected errors in here will be printed as
534 often as this sequence runs. Find another way or
535 place to print the errors. */
536 /* if we have an ACCESS or TEXT mode we have to set
537 maximum_field_alignment to 0 to fit with runtime
538 system, even when we compile with -fpack. */
539 unsigned int save_maximum_field_alignment
= maximum_field_alignment
;
541 if (CH_IS_ACCESS_MODE (exp
) || CH_IS_TEXT_MODE (exp
))
542 maximum_field_alignment
= 0;
544 for (decl
= TYPE_FIELDS (exp
); decl
; decl
= TREE_CHAIN (decl
))
546 SATISFY (TREE_TYPE (decl
));
549 /* if we have a UNION_TYPE here (variant structure), check for
550 non-value mode in it. This is not allowed (Z.200/pg. 33) */
551 if (TREE_CODE (TREE_TYPE (decl
)) == UNION_TYPE
&&
552 CH_TYPE_NONVALUE_P (TREE_TYPE (decl
)))
554 error ("field with non-value mode in variant structure not allowed");
555 TREE_TYPE (decl
) = error_mark_node
;
557 /* RECORD_TYPE gets the non-value property if one of the
558 fields has the non-value property */
559 CH_TYPE_NONVALUE_P (exp
) |= CH_TYPE_NONVALUE_P (TREE_TYPE (decl
));
561 if (TREE_CODE (decl
) == CONST_DECL
)
563 SATISFY (DECL_INITIAL (decl
));
566 if (CH_IS_BUFFER_MODE (exp
) || CH_IS_EVENT_MODE (exp
))
568 = check_queue_size (DECL_INITIAL (decl
));
569 else if (CH_IS_TEXT_MODE (exp
) &&
570 DECL_NAME (decl
) == get_identifier ("__textlength"))
572 = check_text_length (DECL_INITIAL (decl
));
575 else if (TREE_CODE (decl
) == FIELD_DECL
)
577 SATISFY (DECL_INITIAL (decl
));
580 satisfy_list (TYPE_TAG_VALUES (exp
), chain
);
581 if (!TYPE_SIZE (exp
) && !LOOKUP_ONLY
)
582 exp
= layout_chill_struct_type (exp
);
583 maximum_field_alignment
= save_maximum_field_alignment
;
585 /* perform some checks on nonvalue modes, they are record_mode's */
588 if (CH_IS_BUFFER_MODE (exp
))
590 tree elemmode
= buffer_element_mode (exp
);
591 if (elemmode
!= NULL_TREE
&& CH_TYPE_NONVALUE_P (elemmode
))
593 error ("buffer element mode must not have non-value property");
594 invalidate_buffer_element_mode (exp
);
597 else if (CH_IS_ACCESS_MODE (exp
))
599 tree recordmode
= access_recordmode (exp
);
600 if (recordmode
!= NULL_TREE
&& CH_TYPE_NONVALUE_P (recordmode
))
602 error ("recordmode must not have the non-value property");
603 invalidate_access_recordmode (exp
);
610 SATISFY (TYPE_DOMAIN (exp
));
611 if (!TYPE_SIZE (exp
) && !LOOKUP_ONLY
)
612 exp
= layout_powerset_type (exp
);
615 for (decl
= TYPE_FIELDS (exp
); decl
; decl
= TREE_CHAIN (decl
))
617 SATISFY (TREE_TYPE (decl
));
619 CH_TYPE_NONVALUE_P (exp
) |= CH_TYPE_NONVALUE_P (TREE_TYPE (decl
));
621 if (!TYPE_SIZE (exp
) && !LOOKUP_ONLY
)
622 exp
= layout_chill_variants (exp
);