Major cutover to using system.h:
[gcc.git] / gcc / tree.c
1 /* Language-independent node constructors for parse phase of GNU compiler.
2 Copyright (C) 1987, 88, 92-97, 1998 Free Software Foundation, Inc.
3
4 This file is part of GNU CC.
5
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)
9 any later version.
10
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.
15
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. */
20
21
22 /* This file contains the low level primitives for operating on tree nodes,
23 including allocation, list operations, interning of identifiers,
24 construction of data type nodes and statement nodes,
25 and construction of type conversion nodes. It also contains
26 tables index by tree code that describe how to take apart
27 nodes of that code.
28
29 It is intended to be language-independent, but occasionally
30 calls language-dependent routines defined (for C) in typecheck.c.
31
32 The low-level allocation routines oballoc and permalloc
33 are used also for allocating many other kinds of objects
34 by all passes of the compiler. */
35
36 #include "config.h"
37 #ifdef __STDC__
38 #include <stdarg.h>
39 #else
40 #include <varargs.h>
41 #endif
42 #include "system.h"
43 #include <setjmp.h>
44 #include "flags.h"
45 #include "tree.h"
46 #include "except.h"
47 #include "function.h"
48 #include "obstack.h"
49
50 #define obstack_chunk_alloc xmalloc
51 #define obstack_chunk_free free
52
53 /* Tree nodes of permanent duration are allocated in this obstack.
54 They are the identifier nodes, and everything outside of
55 the bodies and parameters of function definitions. */
56
57 struct obstack permanent_obstack;
58
59 /* The initial RTL, and all ..._TYPE nodes, in a function
60 are allocated in this obstack. Usually they are freed at the
61 end of the function, but if the function is inline they are saved.
62 For top-level functions, this is maybepermanent_obstack.
63 Separate obstacks are made for nested functions. */
64
65 struct obstack *function_maybepermanent_obstack;
66
67 /* This is the function_maybepermanent_obstack for top-level functions. */
68
69 struct obstack maybepermanent_obstack;
70
71 /* This is a list of function_maybepermanent_obstacks for top-level inline
72 functions that are compiled in the middle of compiling other functions. */
73
74 struct simple_obstack_stack *toplev_inline_obstacks;
75
76 /* Former elements of toplev_inline_obstacks that have been recycled. */
77
78 struct simple_obstack_stack *extra_inline_obstacks;
79
80 /* This is a list of function_maybepermanent_obstacks for inline functions
81 nested in the current function that were compiled in the middle of
82 compiling other functions. */
83
84 struct simple_obstack_stack *inline_obstacks;
85
86 /* The contents of the current function definition are allocated
87 in this obstack, and all are freed at the end of the function.
88 For top-level functions, this is temporary_obstack.
89 Separate obstacks are made for nested functions. */
90
91 struct obstack *function_obstack;
92
93 /* This is used for reading initializers of global variables. */
94
95 struct obstack temporary_obstack;
96
97 /* The tree nodes of an expression are allocated
98 in this obstack, and all are freed at the end of the expression. */
99
100 struct obstack momentary_obstack;
101
102 /* The tree nodes of a declarator are allocated
103 in this obstack, and all are freed when the declarator
104 has been parsed. */
105
106 static struct obstack temp_decl_obstack;
107
108 /* This points at either permanent_obstack
109 or the current function_maybepermanent_obstack. */
110
111 struct obstack *saveable_obstack;
112
113 /* This is same as saveable_obstack during parse and expansion phase;
114 it points to the current function's obstack during optimization.
115 This is the obstack to be used for creating rtl objects. */
116
117 struct obstack *rtl_obstack;
118
119 /* This points at either permanent_obstack or the current function_obstack. */
120
121 struct obstack *current_obstack;
122
123 /* This points at either permanent_obstack or the current function_obstack
124 or momentary_obstack. */
125
126 struct obstack *expression_obstack;
127
128 /* Stack of obstack selections for push_obstacks and pop_obstacks. */
129
130 struct obstack_stack
131 {
132 struct obstack_stack *next;
133 struct obstack *current;
134 struct obstack *saveable;
135 struct obstack *expression;
136 struct obstack *rtl;
137 };
138
139 struct obstack_stack *obstack_stack;
140
141 /* Obstack for allocating struct obstack_stack entries. */
142
143 static struct obstack obstack_stack_obstack;
144
145 /* Addresses of first objects in some obstacks.
146 This is for freeing their entire contents. */
147 char *maybepermanent_firstobj;
148 char *temporary_firstobj;
149 char *momentary_firstobj;
150 char *temp_decl_firstobj;
151
152 /* This is used to preserve objects (mainly array initializers) that need to
153 live until the end of the current function, but no further. */
154 char *momentary_function_firstobj;
155
156 /* Nonzero means all ..._TYPE nodes should be allocated permanently. */
157
158 int all_types_permanent;
159
160 /* Stack of places to restore the momentary obstack back to. */
161
162 struct momentary_level
163 {
164 /* Pointer back to previous such level. */
165 struct momentary_level *prev;
166 /* First object allocated within this level. */
167 char *base;
168 /* Value of expression_obstack saved at entry to this level. */
169 struct obstack *obstack;
170 };
171
172 struct momentary_level *momentary_stack;
173
174 /* Table indexed by tree code giving a string containing a character
175 classifying the tree code. Possibilities are
176 t, d, s, c, r, <, 1, 2 and e. See tree.def for details. */
177
178 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
179
180 char tree_code_type[MAX_TREE_CODES] = {
181 #include "tree.def"
182 };
183 #undef DEFTREECODE
184
185 /* Table indexed by tree code giving number of expression
186 operands beyond the fixed part of the node structure.
187 Not used for types or decls. */
188
189 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
190
191 int tree_code_length[MAX_TREE_CODES] = {
192 #include "tree.def"
193 };
194 #undef DEFTREECODE
195
196 /* Names of tree components.
197 Used for printing out the tree and error messages. */
198 #define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
199
200 char *tree_code_name[MAX_TREE_CODES] = {
201 #include "tree.def"
202 };
203 #undef DEFTREECODE
204
205 /* Statistics-gathering stuff. */
206 typedef enum
207 {
208 d_kind,
209 t_kind,
210 b_kind,
211 s_kind,
212 r_kind,
213 e_kind,
214 c_kind,
215 id_kind,
216 op_id_kind,
217 perm_list_kind,
218 temp_list_kind,
219 vec_kind,
220 x_kind,
221 lang_decl,
222 lang_type,
223 all_kinds
224 } tree_node_kind;
225
226 int tree_node_counts[(int)all_kinds];
227 int tree_node_sizes[(int)all_kinds];
228 int id_string_size = 0;
229
230 char *tree_node_kind_names[] = {
231 "decls",
232 "types",
233 "blocks",
234 "stmts",
235 "refs",
236 "exprs",
237 "constants",
238 "identifiers",
239 "op_identifiers",
240 "perm_tree_lists",
241 "temp_tree_lists",
242 "vecs",
243 "random kinds",
244 "lang_decl kinds",
245 "lang_type kinds"
246 };
247
248 /* Hash table for uniquizing IDENTIFIER_NODEs by name. */
249
250 #define MAX_HASH_TABLE 1009
251 static tree hash_table[MAX_HASH_TABLE]; /* id hash buckets */
252
253 /* 0 while creating built-in identifiers. */
254 static int do_identifier_warnings;
255
256 /* Unique id for next decl created. */
257 static int next_decl_uid;
258 /* Unique id for next type created. */
259 static int next_type_uid = 1;
260
261 /* Here is how primitive or already-canonicalized types' hash
262 codes are made. */
263 #define TYPE_HASH(TYPE) ((unsigned long) (TYPE) & 0777777)
264
265 extern char *mode_name[];
266
267 void gcc_obstack_init ();
268 \f
269 /* Init the principal obstacks. */
270
271 void
272 init_obstacks ()
273 {
274 gcc_obstack_init (&obstack_stack_obstack);
275 gcc_obstack_init (&permanent_obstack);
276
277 gcc_obstack_init (&temporary_obstack);
278 temporary_firstobj = (char *) obstack_alloc (&temporary_obstack, 0);
279 gcc_obstack_init (&momentary_obstack);
280 momentary_firstobj = (char *) obstack_alloc (&momentary_obstack, 0);
281 momentary_function_firstobj = momentary_firstobj;
282 gcc_obstack_init (&maybepermanent_obstack);
283 maybepermanent_firstobj
284 = (char *) obstack_alloc (&maybepermanent_obstack, 0);
285 gcc_obstack_init (&temp_decl_obstack);
286 temp_decl_firstobj = (char *) obstack_alloc (&temp_decl_obstack, 0);
287
288 function_obstack = &temporary_obstack;
289 function_maybepermanent_obstack = &maybepermanent_obstack;
290 current_obstack = &permanent_obstack;
291 expression_obstack = &permanent_obstack;
292 rtl_obstack = saveable_obstack = &permanent_obstack;
293
294 /* Init the hash table of identifiers. */
295 bzero ((char *) hash_table, sizeof hash_table);
296 }
297
298 void
299 gcc_obstack_init (obstack)
300 struct obstack *obstack;
301 {
302 /* Let particular systems override the size of a chunk. */
303 #ifndef OBSTACK_CHUNK_SIZE
304 #define OBSTACK_CHUNK_SIZE 0
305 #endif
306 /* Let them override the alloc and free routines too. */
307 #ifndef OBSTACK_CHUNK_ALLOC
308 #define OBSTACK_CHUNK_ALLOC xmalloc
309 #endif
310 #ifndef OBSTACK_CHUNK_FREE
311 #define OBSTACK_CHUNK_FREE free
312 #endif
313 _obstack_begin (obstack, OBSTACK_CHUNK_SIZE, 0,
314 (void *(*) ()) OBSTACK_CHUNK_ALLOC,
315 (void (*) ()) OBSTACK_CHUNK_FREE);
316 }
317
318 /* Save all variables describing the current status into the structure *P.
319 This is used before starting a nested function.
320
321 CONTEXT is the decl_function_context for the function we're about to
322 compile; if it isn't current_function_decl, we have to play some games. */
323
324 void
325 save_tree_status (p, context)
326 struct function *p;
327 tree context;
328 {
329 p->all_types_permanent = all_types_permanent;
330 p->momentary_stack = momentary_stack;
331 p->maybepermanent_firstobj = maybepermanent_firstobj;
332 p->temporary_firstobj = temporary_firstobj;
333 p->momentary_firstobj = momentary_firstobj;
334 p->momentary_function_firstobj = momentary_function_firstobj;
335 p->function_obstack = function_obstack;
336 p->function_maybepermanent_obstack = function_maybepermanent_obstack;
337 p->current_obstack = current_obstack;
338 p->expression_obstack = expression_obstack;
339 p->saveable_obstack = saveable_obstack;
340 p->rtl_obstack = rtl_obstack;
341 p->inline_obstacks = inline_obstacks;
342
343 if (context == current_function_decl)
344 /* Objects that need to be saved in this function can be in the nonsaved
345 obstack of the enclosing function since they can't possibly be needed
346 once it has returned. */
347 function_maybepermanent_obstack = function_obstack;
348 else
349 {
350 /* We're compiling a function which isn't nested in the current
351 function. We need to create a new maybepermanent_obstack for this
352 function, since it can't go onto any of the existing obstacks. */
353 struct simple_obstack_stack **head;
354 struct simple_obstack_stack *current;
355
356 if (context == NULL_TREE)
357 head = &toplev_inline_obstacks;
358 else
359 {
360 struct function *f = find_function_data (context);
361 head = &f->inline_obstacks;
362 }
363
364 if (context == NULL_TREE && extra_inline_obstacks)
365 {
366 current = extra_inline_obstacks;
367 extra_inline_obstacks = current->next;
368 }
369 else
370 {
371 current = ((struct simple_obstack_stack *)
372 xmalloc (sizeof (struct simple_obstack_stack)));
373
374 current->obstack
375 = (struct obstack *) xmalloc (sizeof (struct obstack));
376 gcc_obstack_init (current->obstack);
377 }
378
379 function_maybepermanent_obstack = current->obstack;
380
381 current->next = *head;
382 *head = current;
383 }
384
385 maybepermanent_firstobj
386 = (char *) obstack_finish (function_maybepermanent_obstack);
387
388 function_obstack = (struct obstack *) xmalloc (sizeof (struct obstack));
389 gcc_obstack_init (function_obstack);
390
391 current_obstack = &permanent_obstack;
392 expression_obstack = &permanent_obstack;
393 rtl_obstack = saveable_obstack = &permanent_obstack;
394
395 temporary_firstobj = (char *) obstack_alloc (&temporary_obstack, 0);
396 momentary_firstobj = (char *) obstack_finish (&momentary_obstack);
397 momentary_function_firstobj = momentary_firstobj;
398 }
399
400 /* Restore all variables describing the current status from the structure *P.
401 This is used after a nested function. */
402
403 void
404 restore_tree_status (p, context)
405 struct function *p;
406 tree context;
407 {
408 all_types_permanent = p->all_types_permanent;
409 momentary_stack = p->momentary_stack;
410
411 obstack_free (&momentary_obstack, momentary_function_firstobj);
412
413 /* Free saveable storage used by the function just compiled and not
414 saved.
415
416 CAUTION: This is in function_obstack of the containing function.
417 So we must be sure that we never allocate from that obstack during
418 the compilation of a nested function if we expect it to survive
419 past the nested function's end. */
420 obstack_free (function_maybepermanent_obstack, maybepermanent_firstobj);
421
422 /* If we were compiling a toplevel function, we can free this space now. */
423 if (context == NULL_TREE)
424 {
425 obstack_free (&temporary_obstack, temporary_firstobj);
426 obstack_free (&momentary_obstack, momentary_function_firstobj);
427 }
428
429 /* If we were compiling a toplevel function that we don't actually want
430 to save anything from, return the obstack to the pool. */
431 if (context == NULL_TREE
432 && obstack_empty_p (function_maybepermanent_obstack))
433 {
434 struct simple_obstack_stack *current, **p = &toplev_inline_obstacks;
435
436 if ((*p) != NULL)
437 {
438 while ((*p)->obstack != function_maybepermanent_obstack)
439 p = &((*p)->next);
440 current = *p;
441 *p = current->next;
442
443 current->next = extra_inline_obstacks;
444 extra_inline_obstacks = current;
445 }
446 }
447
448 obstack_free (function_obstack, 0);
449 free (function_obstack);
450
451 temporary_firstobj = p->temporary_firstobj;
452 momentary_firstobj = p->momentary_firstobj;
453 momentary_function_firstobj = p->momentary_function_firstobj;
454 maybepermanent_firstobj = p->maybepermanent_firstobj;
455 function_obstack = p->function_obstack;
456 function_maybepermanent_obstack = p->function_maybepermanent_obstack;
457 current_obstack = p->current_obstack;
458 expression_obstack = p->expression_obstack;
459 saveable_obstack = p->saveable_obstack;
460 rtl_obstack = p->rtl_obstack;
461 inline_obstacks = p->inline_obstacks;
462 }
463 \f
464 /* Start allocating on the temporary (per function) obstack.
465 This is done in start_function before parsing the function body,
466 and before each initialization at top level, and to go back
467 to temporary allocation after doing permanent_allocation. */
468
469 void
470 temporary_allocation ()
471 {
472 /* Note that function_obstack at top level points to temporary_obstack.
473 But within a nested function context, it is a separate obstack. */
474 current_obstack = function_obstack;
475 expression_obstack = function_obstack;
476 rtl_obstack = saveable_obstack = function_maybepermanent_obstack;
477 momentary_stack = 0;
478 inline_obstacks = 0;
479 }
480
481 /* Start allocating on the permanent obstack but don't
482 free the temporary data. After calling this, call
483 `permanent_allocation' to fully resume permanent allocation status. */
484
485 void
486 end_temporary_allocation ()
487 {
488 current_obstack = &permanent_obstack;
489 expression_obstack = &permanent_obstack;
490 rtl_obstack = saveable_obstack = &permanent_obstack;
491 }
492
493 /* Resume allocating on the temporary obstack, undoing
494 effects of `end_temporary_allocation'. */
495
496 void
497 resume_temporary_allocation ()
498 {
499 current_obstack = function_obstack;
500 expression_obstack = function_obstack;
501 rtl_obstack = saveable_obstack = function_maybepermanent_obstack;
502 }
503
504 /* While doing temporary allocation, switch to allocating in such a
505 way as to save all nodes if the function is inlined. Call
506 resume_temporary_allocation to go back to ordinary temporary
507 allocation. */
508
509 void
510 saveable_allocation ()
511 {
512 /* Note that function_obstack at top level points to temporary_obstack.
513 But within a nested function context, it is a separate obstack. */
514 expression_obstack = current_obstack = saveable_obstack;
515 }
516
517 /* Switch to current obstack CURRENT and maybepermanent obstack SAVEABLE,
518 recording the previously current obstacks on a stack.
519 This does not free any storage in any obstack. */
520
521 void
522 push_obstacks (current, saveable)
523 struct obstack *current, *saveable;
524 {
525 struct obstack_stack *p
526 = (struct obstack_stack *) obstack_alloc (&obstack_stack_obstack,
527 (sizeof (struct obstack_stack)));
528
529 p->current = current_obstack;
530 p->saveable = saveable_obstack;
531 p->expression = expression_obstack;
532 p->rtl = rtl_obstack;
533 p->next = obstack_stack;
534 obstack_stack = p;
535
536 current_obstack = current;
537 expression_obstack = current;
538 rtl_obstack = saveable_obstack = saveable;
539 }
540
541 /* Save the current set of obstacks, but don't change them. */
542
543 void
544 push_obstacks_nochange ()
545 {
546 struct obstack_stack *p
547 = (struct obstack_stack *) obstack_alloc (&obstack_stack_obstack,
548 (sizeof (struct obstack_stack)));
549
550 p->current = current_obstack;
551 p->saveable = saveable_obstack;
552 p->expression = expression_obstack;
553 p->rtl = rtl_obstack;
554 p->next = obstack_stack;
555 obstack_stack = p;
556 }
557
558 /* Pop the obstack selection stack. */
559
560 void
561 pop_obstacks ()
562 {
563 struct obstack_stack *p = obstack_stack;
564 obstack_stack = p->next;
565
566 current_obstack = p->current;
567 saveable_obstack = p->saveable;
568 expression_obstack = p->expression;
569 rtl_obstack = p->rtl;
570
571 obstack_free (&obstack_stack_obstack, p);
572 }
573
574 /* Nonzero if temporary allocation is currently in effect.
575 Zero if currently doing permanent allocation. */
576
577 int
578 allocation_temporary_p ()
579 {
580 return current_obstack != &permanent_obstack;
581 }
582
583 /* Go back to allocating on the permanent obstack
584 and free everything in the temporary obstack.
585
586 FUNCTION_END is true only if we have just finished compiling a function.
587 In that case, we also free preserved initial values on the momentary
588 obstack. */
589
590 void
591 permanent_allocation (function_end)
592 int function_end;
593 {
594 /* Free up previous temporary obstack data */
595 obstack_free (&temporary_obstack, temporary_firstobj);
596 if (function_end)
597 {
598 obstack_free (&momentary_obstack, momentary_function_firstobj);
599 momentary_firstobj = momentary_function_firstobj;
600 }
601 else
602 obstack_free (&momentary_obstack, momentary_firstobj);
603 obstack_free (function_maybepermanent_obstack, maybepermanent_firstobj);
604 obstack_free (&temp_decl_obstack, temp_decl_firstobj);
605
606 /* Free up the maybepermanent_obstacks for any of our nested functions
607 which were compiled at a lower level. */
608 while (inline_obstacks)
609 {
610 struct simple_obstack_stack *current = inline_obstacks;
611 inline_obstacks = current->next;
612 obstack_free (current->obstack, 0);
613 free (current->obstack);
614 free (current);
615 }
616
617 current_obstack = &permanent_obstack;
618 expression_obstack = &permanent_obstack;
619 rtl_obstack = saveable_obstack = &permanent_obstack;
620 }
621
622 /* Save permanently everything on the maybepermanent_obstack. */
623
624 void
625 preserve_data ()
626 {
627 maybepermanent_firstobj
628 = (char *) obstack_alloc (function_maybepermanent_obstack, 0);
629 }
630
631 void
632 preserve_initializer ()
633 {
634 struct momentary_level *tem;
635 char *old_momentary;
636
637 temporary_firstobj
638 = (char *) obstack_alloc (&temporary_obstack, 0);
639 maybepermanent_firstobj
640 = (char *) obstack_alloc (function_maybepermanent_obstack, 0);
641
642 old_momentary = momentary_firstobj;
643 momentary_firstobj
644 = (char *) obstack_alloc (&momentary_obstack, 0);
645 if (momentary_firstobj != old_momentary)
646 for (tem = momentary_stack; tem; tem = tem->prev)
647 tem->base = momentary_firstobj;
648 }
649
650 /* Start allocating new rtl in current_obstack.
651 Use resume_temporary_allocation
652 to go back to allocating rtl in saveable_obstack. */
653
654 void
655 rtl_in_current_obstack ()
656 {
657 rtl_obstack = current_obstack;
658 }
659
660 /* Start allocating rtl from saveable_obstack. Intended to be used after
661 a call to push_obstacks_nochange. */
662
663 void
664 rtl_in_saveable_obstack ()
665 {
666 rtl_obstack = saveable_obstack;
667 }
668 \f
669 /* Allocate SIZE bytes in the current obstack
670 and return a pointer to them.
671 In practice the current obstack is always the temporary one. */
672
673 char *
674 oballoc (size)
675 int size;
676 {
677 return (char *) obstack_alloc (current_obstack, size);
678 }
679
680 /* Free the object PTR in the current obstack
681 as well as everything allocated since PTR.
682 In practice the current obstack is always the temporary one. */
683
684 void
685 obfree (ptr)
686 char *ptr;
687 {
688 obstack_free (current_obstack, ptr);
689 }
690
691 /* Allocate SIZE bytes in the permanent obstack
692 and return a pointer to them. */
693
694 char *
695 permalloc (size)
696 int size;
697 {
698 return (char *) obstack_alloc (&permanent_obstack, size);
699 }
700
701 /* Allocate NELEM items of SIZE bytes in the permanent obstack
702 and return a pointer to them. The storage is cleared before
703 returning the value. */
704
705 char *
706 perm_calloc (nelem, size)
707 int nelem;
708 long size;
709 {
710 char *rval = (char *) obstack_alloc (&permanent_obstack, nelem * size);
711 bzero (rval, nelem * size);
712 return rval;
713 }
714
715 /* Allocate SIZE bytes in the saveable obstack
716 and return a pointer to them. */
717
718 char *
719 savealloc (size)
720 int size;
721 {
722 return (char *) obstack_alloc (saveable_obstack, size);
723 }
724
725 /* Allocate SIZE bytes in the expression obstack
726 and return a pointer to them. */
727
728 char *
729 expralloc (size)
730 int size;
731 {
732 return (char *) obstack_alloc (expression_obstack, size);
733 }
734 \f
735 /* Print out which obstack an object is in. */
736
737 void
738 print_obstack_name (object, file, prefix)
739 char *object;
740 FILE *file;
741 char *prefix;
742 {
743 struct obstack *obstack = NULL;
744 char *obstack_name = NULL;
745 struct function *p;
746
747 for (p = outer_function_chain; p; p = p->next)
748 {
749 if (_obstack_allocated_p (p->function_obstack, object))
750 {
751 obstack = p->function_obstack;
752 obstack_name = "containing function obstack";
753 }
754 if (_obstack_allocated_p (p->function_maybepermanent_obstack, object))
755 {
756 obstack = p->function_maybepermanent_obstack;
757 obstack_name = "containing function maybepermanent obstack";
758 }
759 }
760
761 if (_obstack_allocated_p (&obstack_stack_obstack, object))
762 {
763 obstack = &obstack_stack_obstack;
764 obstack_name = "obstack_stack_obstack";
765 }
766 else if (_obstack_allocated_p (function_obstack, object))
767 {
768 obstack = function_obstack;
769 obstack_name = "function obstack";
770 }
771 else if (_obstack_allocated_p (&permanent_obstack, object))
772 {
773 obstack = &permanent_obstack;
774 obstack_name = "permanent_obstack";
775 }
776 else if (_obstack_allocated_p (&momentary_obstack, object))
777 {
778 obstack = &momentary_obstack;
779 obstack_name = "momentary_obstack";
780 }
781 else if (_obstack_allocated_p (function_maybepermanent_obstack, object))
782 {
783 obstack = function_maybepermanent_obstack;
784 obstack_name = "function maybepermanent obstack";
785 }
786 else if (_obstack_allocated_p (&temp_decl_obstack, object))
787 {
788 obstack = &temp_decl_obstack;
789 obstack_name = "temp_decl_obstack";
790 }
791
792 /* Check to see if the object is in the free area of the obstack. */
793 if (obstack != NULL)
794 {
795 if (object >= obstack->next_free
796 && object < obstack->chunk_limit)
797 fprintf (file, "%s in free portion of obstack %s",
798 prefix, obstack_name);
799 else
800 fprintf (file, "%s allocated from %s", prefix, obstack_name);
801 }
802 else
803 fprintf (file, "%s not allocated from any obstack", prefix);
804 }
805
806 void
807 debug_obstack (object)
808 char *object;
809 {
810 print_obstack_name (object, stderr, "object");
811 fprintf (stderr, ".\n");
812 }
813
814 /* Return 1 if OBJ is in the permanent obstack.
815 This is slow, and should be used only for debugging.
816 Use TREE_PERMANENT for other purposes. */
817
818 int
819 object_permanent_p (obj)
820 tree obj;
821 {
822 return _obstack_allocated_p (&permanent_obstack, obj);
823 }
824 \f
825 /* Start a level of momentary allocation.
826 In C, each compound statement has its own level
827 and that level is freed at the end of each statement.
828 All expression nodes are allocated in the momentary allocation level. */
829
830 void
831 push_momentary ()
832 {
833 struct momentary_level *tem
834 = (struct momentary_level *) obstack_alloc (&momentary_obstack,
835 sizeof (struct momentary_level));
836 tem->prev = momentary_stack;
837 tem->base = (char *) obstack_base (&momentary_obstack);
838 tem->obstack = expression_obstack;
839 momentary_stack = tem;
840 expression_obstack = &momentary_obstack;
841 }
842
843 /* Set things up so the next clear_momentary will only clear memory
844 past our present position in momentary_obstack. */
845
846 void
847 preserve_momentary ()
848 {
849 momentary_stack->base = (char *) obstack_base (&momentary_obstack);
850 }
851
852 /* Free all the storage in the current momentary-allocation level.
853 In C, this happens at the end of each statement. */
854
855 void
856 clear_momentary ()
857 {
858 obstack_free (&momentary_obstack, momentary_stack->base);
859 }
860
861 /* Discard a level of momentary allocation.
862 In C, this happens at the end of each compound statement.
863 Restore the status of expression node allocation
864 that was in effect before this level was created. */
865
866 void
867 pop_momentary ()
868 {
869 struct momentary_level *tem = momentary_stack;
870 momentary_stack = tem->prev;
871 expression_obstack = tem->obstack;
872 /* We can't free TEM from the momentary_obstack, because there might
873 be objects above it which have been saved. We can free back to the
874 stack of the level we are popping off though. */
875 obstack_free (&momentary_obstack, tem->base);
876 }
877
878 /* Pop back to the previous level of momentary allocation,
879 but don't free any momentary data just yet. */
880
881 void
882 pop_momentary_nofree ()
883 {
884 struct momentary_level *tem = momentary_stack;
885 momentary_stack = tem->prev;
886 expression_obstack = tem->obstack;
887 }
888
889 /* Call when starting to parse a declaration:
890 make expressions in the declaration last the length of the function.
891 Returns an argument that should be passed to resume_momentary later. */
892
893 int
894 suspend_momentary ()
895 {
896 register int tem = expression_obstack == &momentary_obstack;
897 expression_obstack = saveable_obstack;
898 return tem;
899 }
900
901 /* Call when finished parsing a declaration:
902 restore the treatment of node-allocation that was
903 in effect before the suspension.
904 YES should be the value previously returned by suspend_momentary. */
905
906 void
907 resume_momentary (yes)
908 int yes;
909 {
910 if (yes)
911 expression_obstack = &momentary_obstack;
912 }
913 \f
914 /* Init the tables indexed by tree code.
915 Note that languages can add to these tables to define their own codes. */
916
917 void
918 init_tree_codes ()
919 {
920
921 }
922
923 /* Return a newly allocated node of code CODE.
924 Initialize the node's unique id and its TREE_PERMANENT flag.
925 For decl and type nodes, some other fields are initialized.
926 The rest of the node is initialized to zero.
927
928 Achoo! I got a code in the node. */
929
930 tree
931 make_node (code)
932 enum tree_code code;
933 {
934 register tree t;
935 register int type = TREE_CODE_CLASS (code);
936 register int length;
937 register struct obstack *obstack = current_obstack;
938 register int i;
939 #ifdef GATHER_STATISTICS
940 register tree_node_kind kind;
941 #endif
942
943 switch (type)
944 {
945 case 'd': /* A decl node */
946 #ifdef GATHER_STATISTICS
947 kind = d_kind;
948 #endif
949 length = sizeof (struct tree_decl);
950 /* All decls in an inline function need to be saved. */
951 if (obstack != &permanent_obstack)
952 obstack = saveable_obstack;
953
954 /* PARM_DECLs go on the context of the parent. If this is a nested
955 function, then we must allocate the PARM_DECL on the parent's
956 obstack, so that they will live to the end of the parent's
957 closing brace. This is necessary in case we try to inline the
958 function into its parent.
959
960 PARM_DECLs of top-level functions do not have this problem. However,
961 we allocate them where we put the FUNCTION_DECL for languages such as
962 Ada that need to consult some flags in the PARM_DECLs of the function
963 when calling it.
964
965 See comment in restore_tree_status for why we can't put this
966 in function_obstack. */
967 if (code == PARM_DECL && obstack != &permanent_obstack)
968 {
969 tree context = 0;
970 if (current_function_decl)
971 context = decl_function_context (current_function_decl);
972
973 if (context)
974 obstack
975 = find_function_data (context)->function_maybepermanent_obstack;
976 }
977 break;
978
979 case 't': /* a type node */
980 #ifdef GATHER_STATISTICS
981 kind = t_kind;
982 #endif
983 length = sizeof (struct tree_type);
984 /* All data types are put where we can preserve them if nec. */
985 if (obstack != &permanent_obstack)
986 obstack = all_types_permanent ? &permanent_obstack : saveable_obstack;
987 break;
988
989 case 'b': /* a lexical block */
990 #ifdef GATHER_STATISTICS
991 kind = b_kind;
992 #endif
993 length = sizeof (struct tree_block);
994 /* All BLOCK nodes are put where we can preserve them if nec. */
995 if (obstack != &permanent_obstack)
996 obstack = saveable_obstack;
997 break;
998
999 case 's': /* an expression with side effects */
1000 #ifdef GATHER_STATISTICS
1001 kind = s_kind;
1002 goto usual_kind;
1003 #endif
1004 case 'r': /* a reference */
1005 #ifdef GATHER_STATISTICS
1006 kind = r_kind;
1007 goto usual_kind;
1008 #endif
1009 case 'e': /* an expression */
1010 case '<': /* a comparison expression */
1011 case '1': /* a unary arithmetic expression */
1012 case '2': /* a binary arithmetic expression */
1013 #ifdef GATHER_STATISTICS
1014 kind = e_kind;
1015 usual_kind:
1016 #endif
1017 obstack = expression_obstack;
1018 /* All BIND_EXPR nodes are put where we can preserve them if nec. */
1019 if (code == BIND_EXPR && obstack != &permanent_obstack)
1020 obstack = saveable_obstack;
1021 length = sizeof (struct tree_exp)
1022 + (tree_code_length[(int) code] - 1) * sizeof (char *);
1023 break;
1024
1025 case 'c': /* a constant */
1026 #ifdef GATHER_STATISTICS
1027 kind = c_kind;
1028 #endif
1029 obstack = expression_obstack;
1030
1031 /* We can't use tree_code_length for INTEGER_CST, since the number of
1032 words is machine-dependent due to varying length of HOST_WIDE_INT,
1033 which might be wider than a pointer (e.g., long long). Similarly
1034 for REAL_CST, since the number of words is machine-dependent due
1035 to varying size and alignment of `double'. */
1036
1037 if (code == INTEGER_CST)
1038 length = sizeof (struct tree_int_cst);
1039 else if (code == REAL_CST)
1040 length = sizeof (struct tree_real_cst);
1041 else
1042 length = sizeof (struct tree_common)
1043 + tree_code_length[(int) code] * sizeof (char *);
1044 break;
1045
1046 case 'x': /* something random, like an identifier. */
1047 #ifdef GATHER_STATISTICS
1048 if (code == IDENTIFIER_NODE)
1049 kind = id_kind;
1050 else if (code == OP_IDENTIFIER)
1051 kind = op_id_kind;
1052 else if (code == TREE_VEC)
1053 kind = vec_kind;
1054 else
1055 kind = x_kind;
1056 #endif
1057 length = sizeof (struct tree_common)
1058 + tree_code_length[(int) code] * sizeof (char *);
1059 /* Identifier nodes are always permanent since they are
1060 unique in a compiler run. */
1061 if (code == IDENTIFIER_NODE) obstack = &permanent_obstack;
1062 break;
1063
1064 default:
1065 abort ();
1066 }
1067
1068 t = (tree) obstack_alloc (obstack, length);
1069
1070 #ifdef GATHER_STATISTICS
1071 tree_node_counts[(int)kind]++;
1072 tree_node_sizes[(int)kind] += length;
1073 #endif
1074
1075 /* Clear a word at a time. */
1076 for (i = (length / sizeof (int)) - 1; i >= 0; i--)
1077 ((int *) t)[i] = 0;
1078 /* Clear any extra bytes. */
1079 for (i = length / sizeof (int) * sizeof (int); i < length; i++)
1080 ((char *) t)[i] = 0;
1081
1082 TREE_SET_CODE (t, code);
1083 if (obstack == &permanent_obstack)
1084 TREE_PERMANENT (t) = 1;
1085
1086 switch (type)
1087 {
1088 case 's':
1089 TREE_SIDE_EFFECTS (t) = 1;
1090 TREE_TYPE (t) = void_type_node;
1091 break;
1092
1093 case 'd':
1094 if (code != FUNCTION_DECL)
1095 DECL_ALIGN (t) = 1;
1096 DECL_IN_SYSTEM_HEADER (t)
1097 = in_system_header && (obstack == &permanent_obstack);
1098 DECL_SOURCE_LINE (t) = lineno;
1099 DECL_SOURCE_FILE (t) = (input_filename) ? input_filename : "<built-in>";
1100 DECL_UID (t) = next_decl_uid++;
1101 break;
1102
1103 case 't':
1104 TYPE_UID (t) = next_type_uid++;
1105 TYPE_ALIGN (t) = 1;
1106 TYPE_MAIN_VARIANT (t) = t;
1107 TYPE_OBSTACK (t) = obstack;
1108 TYPE_ATTRIBUTES (t) = NULL_TREE;
1109 #ifdef SET_DEFAULT_TYPE_ATTRIBUTES
1110 SET_DEFAULT_TYPE_ATTRIBUTES (t);
1111 #endif
1112 break;
1113
1114 case 'c':
1115 TREE_CONSTANT (t) = 1;
1116 break;
1117 }
1118
1119 return t;
1120 }
1121 \f
1122 /* Return a new node with the same contents as NODE
1123 except that its TREE_CHAIN is zero and it has a fresh uid. */
1124
1125 tree
1126 copy_node (node)
1127 tree node;
1128 {
1129 register tree t;
1130 register enum tree_code code = TREE_CODE (node);
1131 register int length;
1132 register int i;
1133
1134 switch (TREE_CODE_CLASS (code))
1135 {
1136 case 'd': /* A decl node */
1137 length = sizeof (struct tree_decl);
1138 break;
1139
1140 case 't': /* a type node */
1141 length = sizeof (struct tree_type);
1142 break;
1143
1144 case 'b': /* a lexical block node */
1145 length = sizeof (struct tree_block);
1146 break;
1147
1148 case 'r': /* a reference */
1149 case 'e': /* an expression */
1150 case 's': /* an expression with side effects */
1151 case '<': /* a comparison expression */
1152 case '1': /* a unary arithmetic expression */
1153 case '2': /* a binary arithmetic expression */
1154 length = sizeof (struct tree_exp)
1155 + (tree_code_length[(int) code] - 1) * sizeof (char *);
1156 break;
1157
1158 case 'c': /* a constant */
1159 /* We can't use tree_code_length for INTEGER_CST, since the number of
1160 words is machine-dependent due to varying length of HOST_WIDE_INT,
1161 which might be wider than a pointer (e.g., long long). Similarly
1162 for REAL_CST, since the number of words is machine-dependent due
1163 to varying size and alignment of `double'. */
1164 if (code == INTEGER_CST)
1165 length = sizeof (struct tree_int_cst);
1166 else if (code == REAL_CST)
1167 length = sizeof (struct tree_real_cst);
1168 else
1169 length = (sizeof (struct tree_common)
1170 + tree_code_length[(int) code] * sizeof (char *));
1171 break;
1172
1173 case 'x': /* something random, like an identifier. */
1174 length = sizeof (struct tree_common)
1175 + tree_code_length[(int) code] * sizeof (char *);
1176 if (code == TREE_VEC)
1177 length += (TREE_VEC_LENGTH (node) - 1) * sizeof (char *);
1178 }
1179
1180 t = (tree) obstack_alloc (current_obstack, length);
1181
1182 for (i = (length / sizeof (int)) - 1; i >= 0; i--)
1183 ((int *) t)[i] = ((int *) node)[i];
1184 /* Clear any extra bytes. */
1185 for (i = length / sizeof (int) * sizeof (int); i < length; i++)
1186 ((char *) t)[i] = ((char *) node)[i];
1187
1188 TREE_CHAIN (t) = 0;
1189 TREE_ASM_WRITTEN (t) = 0;
1190
1191 if (TREE_CODE_CLASS (code) == 'd')
1192 DECL_UID (t) = next_decl_uid++;
1193 else if (TREE_CODE_CLASS (code) == 't')
1194 {
1195 TYPE_UID (t) = next_type_uid++;
1196 TYPE_OBSTACK (t) = current_obstack;
1197
1198 /* The following is so that the debug code for
1199 the copy is different from the original type.
1200 The two statements usually duplicate each other
1201 (because they clear fields of the same union),
1202 but the optimizer should catch that. */
1203 TYPE_SYMTAB_POINTER (t) = 0;
1204 TYPE_SYMTAB_ADDRESS (t) = 0;
1205 }
1206
1207 TREE_PERMANENT (t) = (current_obstack == &permanent_obstack);
1208
1209 return t;
1210 }
1211
1212 /* Return a copy of a chain of nodes, chained through the TREE_CHAIN field.
1213 For example, this can copy a list made of TREE_LIST nodes. */
1214
1215 tree
1216 copy_list (list)
1217 tree list;
1218 {
1219 tree head;
1220 register tree prev, next;
1221
1222 if (list == 0)
1223 return 0;
1224
1225 head = prev = copy_node (list);
1226 next = TREE_CHAIN (list);
1227 while (next)
1228 {
1229 TREE_CHAIN (prev) = copy_node (next);
1230 prev = TREE_CHAIN (prev);
1231 next = TREE_CHAIN (next);
1232 }
1233 return head;
1234 }
1235 \f
1236 #define HASHBITS 30
1237
1238 /* Return an IDENTIFIER_NODE whose name is TEXT (a null-terminated string).
1239 If an identifier with that name has previously been referred to,
1240 the same node is returned this time. */
1241
1242 tree
1243 get_identifier (text)
1244 register char *text;
1245 {
1246 register int hi;
1247 register int i;
1248 register tree idp;
1249 register int len, hash_len;
1250
1251 /* Compute length of text in len. */
1252 for (len = 0; text[len]; len++);
1253
1254 /* Decide how much of that length to hash on */
1255 hash_len = len;
1256 if (warn_id_clash && len > id_clash_len)
1257 hash_len = id_clash_len;
1258
1259 /* Compute hash code */
1260 hi = hash_len * 613 + (unsigned) text[0];
1261 for (i = 1; i < hash_len; i += 2)
1262 hi = ((hi * 613) + (unsigned) (text[i]));
1263
1264 hi &= (1 << HASHBITS) - 1;
1265 hi %= MAX_HASH_TABLE;
1266
1267 /* Search table for identifier */
1268 for (idp = hash_table[hi]; idp; idp = TREE_CHAIN (idp))
1269 if (IDENTIFIER_LENGTH (idp) == len
1270 && IDENTIFIER_POINTER (idp)[0] == text[0]
1271 && !bcmp (IDENTIFIER_POINTER (idp), text, len))
1272 return idp; /* <-- return if found */
1273
1274 /* Not found; optionally warn about a similar identifier */
1275 if (warn_id_clash && do_identifier_warnings && len >= id_clash_len)
1276 for (idp = hash_table[hi]; idp; idp = TREE_CHAIN (idp))
1277 if (!strncmp (IDENTIFIER_POINTER (idp), text, id_clash_len))
1278 {
1279 warning ("`%s' and `%s' identical in first %d characters",
1280 IDENTIFIER_POINTER (idp), text, id_clash_len);
1281 break;
1282 }
1283
1284 if (tree_code_length[(int) IDENTIFIER_NODE] < 0)
1285 abort (); /* set_identifier_size hasn't been called. */
1286
1287 /* Not found, create one, add to chain */
1288 idp = make_node (IDENTIFIER_NODE);
1289 IDENTIFIER_LENGTH (idp) = len;
1290 #ifdef GATHER_STATISTICS
1291 id_string_size += len;
1292 #endif
1293
1294 IDENTIFIER_POINTER (idp) = obstack_copy0 (&permanent_obstack, text, len);
1295
1296 TREE_CHAIN (idp) = hash_table[hi];
1297 hash_table[hi] = idp;
1298 return idp; /* <-- return if created */
1299 }
1300
1301 /* If an identifier with the name TEXT (a null-terminated string) has
1302 previously been referred to, return that node; otherwise return
1303 NULL_TREE. */
1304
1305 tree
1306 maybe_get_identifier (text)
1307 register char *text;
1308 {
1309 register int hi;
1310 register int i;
1311 register tree idp;
1312 register int len, hash_len;
1313
1314 /* Compute length of text in len. */
1315 for (len = 0; text[len]; len++);
1316
1317 /* Decide how much of that length to hash on */
1318 hash_len = len;
1319 if (warn_id_clash && len > id_clash_len)
1320 hash_len = id_clash_len;
1321
1322 /* Compute hash code */
1323 hi = hash_len * 613 + (unsigned) text[0];
1324 for (i = 1; i < hash_len; i += 2)
1325 hi = ((hi * 613) + (unsigned) (text[i]));
1326
1327 hi &= (1 << HASHBITS) - 1;
1328 hi %= MAX_HASH_TABLE;
1329
1330 /* Search table for identifier */
1331 for (idp = hash_table[hi]; idp; idp = TREE_CHAIN (idp))
1332 if (IDENTIFIER_LENGTH (idp) == len
1333 && IDENTIFIER_POINTER (idp)[0] == text[0]
1334 && !bcmp (IDENTIFIER_POINTER (idp), text, len))
1335 return idp; /* <-- return if found */
1336
1337 return NULL_TREE;
1338 }
1339
1340 /* Enable warnings on similar identifiers (if requested).
1341 Done after the built-in identifiers are created. */
1342
1343 void
1344 start_identifier_warnings ()
1345 {
1346 do_identifier_warnings = 1;
1347 }
1348
1349 /* Record the size of an identifier node for the language in use.
1350 SIZE is the total size in bytes.
1351 This is called by the language-specific files. This must be
1352 called before allocating any identifiers. */
1353
1354 void
1355 set_identifier_size (size)
1356 int size;
1357 {
1358 tree_code_length[(int) IDENTIFIER_NODE]
1359 = (size - sizeof (struct tree_common)) / sizeof (tree);
1360 }
1361 \f
1362 /* Return a newly constructed INTEGER_CST node whose constant value
1363 is specified by the two ints LOW and HI.
1364 The TREE_TYPE is set to `int'.
1365
1366 This function should be used via the `build_int_2' macro. */
1367
1368 tree
1369 build_int_2_wide (low, hi)
1370 HOST_WIDE_INT low, hi;
1371 {
1372 register tree t = make_node (INTEGER_CST);
1373 TREE_INT_CST_LOW (t) = low;
1374 TREE_INT_CST_HIGH (t) = hi;
1375 TREE_TYPE (t) = integer_type_node;
1376 return t;
1377 }
1378
1379 /* Return a new REAL_CST node whose type is TYPE and value is D. */
1380
1381 tree
1382 build_real (type, d)
1383 tree type;
1384 REAL_VALUE_TYPE d;
1385 {
1386 tree v;
1387 int overflow = 0;
1388
1389 /* Check for valid float value for this type on this target machine;
1390 if not, can print error message and store a valid value in D. */
1391 #ifdef CHECK_FLOAT_VALUE
1392 CHECK_FLOAT_VALUE (TYPE_MODE (type), d, overflow);
1393 #endif
1394
1395 v = make_node (REAL_CST);
1396 TREE_TYPE (v) = type;
1397 TREE_REAL_CST (v) = d;
1398 TREE_OVERFLOW (v) = TREE_CONSTANT_OVERFLOW (v) = overflow;
1399 return v;
1400 }
1401
1402 /* Return a new REAL_CST node whose type is TYPE
1403 and whose value is the integer value of the INTEGER_CST node I. */
1404
1405 #if !defined (REAL_IS_NOT_DOUBLE) || defined (REAL_ARITHMETIC)
1406
1407 REAL_VALUE_TYPE
1408 real_value_from_int_cst (type, i)
1409 tree type, i;
1410 {
1411 REAL_VALUE_TYPE d;
1412
1413 #ifdef REAL_ARITHMETIC
1414 if (! TREE_UNSIGNED (TREE_TYPE (i)))
1415 REAL_VALUE_FROM_INT (d, TREE_INT_CST_LOW (i), TREE_INT_CST_HIGH (i),
1416 TYPE_MODE (type));
1417 else
1418 REAL_VALUE_FROM_UNSIGNED_INT (d, TREE_INT_CST_LOW (i),
1419 TREE_INT_CST_HIGH (i), TYPE_MODE (type));
1420 #else /* not REAL_ARITHMETIC */
1421 /* Some 386 compilers mishandle unsigned int to float conversions,
1422 so introduce a temporary variable E to avoid those bugs. */
1423 if (TREE_INT_CST_HIGH (i) < 0 && ! TREE_UNSIGNED (TREE_TYPE (i)))
1424 {
1425 REAL_VALUE_TYPE e;
1426
1427 d = (double) (~ TREE_INT_CST_HIGH (i));
1428 e = ((double) ((HOST_WIDE_INT) 1 << (HOST_BITS_PER_WIDE_INT / 2))
1429 * (double) ((HOST_WIDE_INT) 1 << (HOST_BITS_PER_WIDE_INT / 2)));
1430 d *= e;
1431 e = (double) (unsigned HOST_WIDE_INT) (~ TREE_INT_CST_LOW (i));
1432 d += e;
1433 d = (- d - 1.0);
1434 }
1435 else
1436 {
1437 REAL_VALUE_TYPE e;
1438
1439 d = (double) (unsigned HOST_WIDE_INT) TREE_INT_CST_HIGH (i);
1440 e = ((double) ((HOST_WIDE_INT) 1 << (HOST_BITS_PER_WIDE_INT / 2))
1441 * (double) ((HOST_WIDE_INT) 1 << (HOST_BITS_PER_WIDE_INT / 2)));
1442 d *= e;
1443 e = (double) (unsigned HOST_WIDE_INT) TREE_INT_CST_LOW (i);
1444 d += e;
1445 }
1446 #endif /* not REAL_ARITHMETIC */
1447 return d;
1448 }
1449
1450 /* This function can't be implemented if we can't do arithmetic
1451 on the float representation. */
1452
1453 tree
1454 build_real_from_int_cst (type, i)
1455 tree type;
1456 tree i;
1457 {
1458 tree v;
1459 int overflow = TREE_OVERFLOW (i);
1460 REAL_VALUE_TYPE d;
1461 jmp_buf float_error;
1462
1463 v = make_node (REAL_CST);
1464 TREE_TYPE (v) = type;
1465
1466 if (setjmp (float_error))
1467 {
1468 d = dconst0;
1469 overflow = 1;
1470 goto got_it;
1471 }
1472
1473 set_float_handler (float_error);
1474
1475 #ifdef REAL_ARITHMETIC
1476 d = real_value_from_int_cst (type, i);
1477 #else
1478 d = REAL_VALUE_TRUNCATE (TYPE_MODE (type),
1479 real_value_from_int_cst (type, i));
1480 #endif
1481
1482 /* Check for valid float value for this type on this target machine. */
1483
1484 got_it:
1485 set_float_handler (NULL_PTR);
1486
1487 #ifdef CHECK_FLOAT_VALUE
1488 CHECK_FLOAT_VALUE (TYPE_MODE (type), d, overflow);
1489 #endif
1490
1491 TREE_REAL_CST (v) = d;
1492 TREE_OVERFLOW (v) = TREE_CONSTANT_OVERFLOW (v) = overflow;
1493 return v;
1494 }
1495
1496 #endif /* not REAL_IS_NOT_DOUBLE, or REAL_ARITHMETIC */
1497
1498 /* Return a newly constructed STRING_CST node whose value is
1499 the LEN characters at STR.
1500 The TREE_TYPE is not initialized. */
1501
1502 tree
1503 build_string (len, str)
1504 int len;
1505 char *str;
1506 {
1507 /* Put the string in saveable_obstack since it will be placed in the RTL
1508 for an "asm" statement and will also be kept around a while if
1509 deferring constant output in varasm.c. */
1510
1511 register tree s = make_node (STRING_CST);
1512 TREE_STRING_LENGTH (s) = len;
1513 TREE_STRING_POINTER (s) = obstack_copy0 (saveable_obstack, str, len);
1514 return s;
1515 }
1516
1517 /* Return a newly constructed COMPLEX_CST node whose value is
1518 specified by the real and imaginary parts REAL and IMAG.
1519 Both REAL and IMAG should be constant nodes. TYPE, if specified,
1520 will be the type of the COMPLEX_CST; otherwise a new type will be made. */
1521
1522 tree
1523 build_complex (type, real, imag)
1524 tree type;
1525 tree real, imag;
1526 {
1527 register tree t = make_node (COMPLEX_CST);
1528
1529 TREE_REALPART (t) = real;
1530 TREE_IMAGPART (t) = imag;
1531 TREE_TYPE (t) = type ? type : build_complex_type (TREE_TYPE (real));
1532 TREE_OVERFLOW (t) = TREE_OVERFLOW (real) | TREE_OVERFLOW (imag);
1533 TREE_CONSTANT_OVERFLOW (t)
1534 = TREE_CONSTANT_OVERFLOW (real) | TREE_CONSTANT_OVERFLOW (imag);
1535 return t;
1536 }
1537
1538 /* Build a newly constructed TREE_VEC node of length LEN. */
1539
1540 tree
1541 make_tree_vec (len)
1542 int len;
1543 {
1544 register tree t;
1545 register int length = (len-1) * sizeof (tree) + sizeof (struct tree_vec);
1546 register struct obstack *obstack = current_obstack;
1547 register int i;
1548
1549 #ifdef GATHER_STATISTICS
1550 tree_node_counts[(int)vec_kind]++;
1551 tree_node_sizes[(int)vec_kind] += length;
1552 #endif
1553
1554 t = (tree) obstack_alloc (obstack, length);
1555
1556 for (i = (length / sizeof (int)) - 1; i >= 0; i--)
1557 ((int *) t)[i] = 0;
1558
1559 TREE_SET_CODE (t, TREE_VEC);
1560 TREE_VEC_LENGTH (t) = len;
1561 if (obstack == &permanent_obstack)
1562 TREE_PERMANENT (t) = 1;
1563
1564 return t;
1565 }
1566 \f
1567 /* Return 1 if EXPR is the integer constant zero or a complex constant
1568 of zero. */
1569
1570 int
1571 integer_zerop (expr)
1572 tree expr;
1573 {
1574 STRIP_NOPS (expr);
1575
1576 return ((TREE_CODE (expr) == INTEGER_CST
1577 && ! TREE_CONSTANT_OVERFLOW (expr)
1578 && TREE_INT_CST_LOW (expr) == 0
1579 && TREE_INT_CST_HIGH (expr) == 0)
1580 || (TREE_CODE (expr) == COMPLEX_CST
1581 && integer_zerop (TREE_REALPART (expr))
1582 && integer_zerop (TREE_IMAGPART (expr))));
1583 }
1584
1585 /* Return 1 if EXPR is the integer constant one or the corresponding
1586 complex constant. */
1587
1588 int
1589 integer_onep (expr)
1590 tree expr;
1591 {
1592 STRIP_NOPS (expr);
1593
1594 return ((TREE_CODE (expr) == INTEGER_CST
1595 && ! TREE_CONSTANT_OVERFLOW (expr)
1596 && TREE_INT_CST_LOW (expr) == 1
1597 && TREE_INT_CST_HIGH (expr) == 0)
1598 || (TREE_CODE (expr) == COMPLEX_CST
1599 && integer_onep (TREE_REALPART (expr))
1600 && integer_zerop (TREE_IMAGPART (expr))));
1601 }
1602
1603 /* Return 1 if EXPR is an integer containing all 1's in as much precision as
1604 it contains. Likewise for the corresponding complex constant. */
1605
1606 int
1607 integer_all_onesp (expr)
1608 tree expr;
1609 {
1610 register int prec;
1611 register int uns;
1612
1613 STRIP_NOPS (expr);
1614
1615 if (TREE_CODE (expr) == COMPLEX_CST
1616 && integer_all_onesp (TREE_REALPART (expr))
1617 && integer_zerop (TREE_IMAGPART (expr)))
1618 return 1;
1619
1620 else if (TREE_CODE (expr) != INTEGER_CST
1621 || TREE_CONSTANT_OVERFLOW (expr))
1622 return 0;
1623
1624 uns = TREE_UNSIGNED (TREE_TYPE (expr));
1625 if (!uns)
1626 return TREE_INT_CST_LOW (expr) == -1 && TREE_INT_CST_HIGH (expr) == -1;
1627
1628 /* Note that using TYPE_PRECISION here is wrong. We care about the
1629 actual bits, not the (arbitrary) range of the type. */
1630 prec = GET_MODE_BITSIZE (TYPE_MODE (TREE_TYPE (expr)));
1631 if (prec >= HOST_BITS_PER_WIDE_INT)
1632 {
1633 int high_value, shift_amount;
1634
1635 shift_amount = prec - HOST_BITS_PER_WIDE_INT;
1636
1637 if (shift_amount > HOST_BITS_PER_WIDE_INT)
1638 /* Can not handle precisions greater than twice the host int size. */
1639 abort ();
1640 else if (shift_amount == HOST_BITS_PER_WIDE_INT)
1641 /* Shifting by the host word size is undefined according to the ANSI
1642 standard, so we must handle this as a special case. */
1643 high_value = -1;
1644 else
1645 high_value = ((HOST_WIDE_INT) 1 << shift_amount) - 1;
1646
1647 return TREE_INT_CST_LOW (expr) == -1
1648 && TREE_INT_CST_HIGH (expr) == high_value;
1649 }
1650 else
1651 return TREE_INT_CST_LOW (expr) == ((HOST_WIDE_INT) 1 << prec) - 1;
1652 }
1653
1654 /* Return 1 if EXPR is an integer constant that is a power of 2 (i.e., has only
1655 one bit on). */
1656
1657 int
1658 integer_pow2p (expr)
1659 tree expr;
1660 {
1661 int prec;
1662 HOST_WIDE_INT high, low;
1663
1664 STRIP_NOPS (expr);
1665
1666 if (TREE_CODE (expr) == COMPLEX_CST
1667 && integer_pow2p (TREE_REALPART (expr))
1668 && integer_zerop (TREE_IMAGPART (expr)))
1669 return 1;
1670
1671 if (TREE_CODE (expr) != INTEGER_CST || TREE_CONSTANT_OVERFLOW (expr))
1672 return 0;
1673
1674 prec = (TREE_CODE (TREE_TYPE (expr)) == POINTER_TYPE
1675 ? POINTER_SIZE : TYPE_PRECISION (TREE_TYPE (expr)));
1676 high = TREE_INT_CST_HIGH (expr);
1677 low = TREE_INT_CST_LOW (expr);
1678
1679 /* First clear all bits that are beyond the type's precision in case
1680 we've been sign extended. */
1681
1682 if (prec == 2 * HOST_BITS_PER_WIDE_INT)
1683 ;
1684 else if (prec > HOST_BITS_PER_WIDE_INT)
1685 high &= ~((HOST_WIDE_INT) (-1) << (prec - HOST_BITS_PER_WIDE_INT));
1686 else
1687 {
1688 high = 0;
1689 if (prec < HOST_BITS_PER_WIDE_INT)
1690 low &= ~((HOST_WIDE_INT) (-1) << prec);
1691 }
1692
1693 if (high == 0 && low == 0)
1694 return 0;
1695
1696 return ((high == 0 && (low & (low - 1)) == 0)
1697 || (low == 0 && (high & (high - 1)) == 0));
1698 }
1699
1700 /* Return the power of two represented by a tree node known to be a
1701 power of two. */
1702
1703 int
1704 tree_log2 (expr)
1705 tree expr;
1706 {
1707 int prec;
1708 HOST_WIDE_INT high, low;
1709
1710 STRIP_NOPS (expr);
1711
1712 if (TREE_CODE (expr) == COMPLEX_CST)
1713 return tree_log2 (TREE_REALPART (expr));
1714
1715 prec = (TREE_CODE (TREE_TYPE (expr)) == POINTER_TYPE
1716 ? POINTER_SIZE : TYPE_PRECISION (TREE_TYPE (expr)));
1717
1718 high = TREE_INT_CST_HIGH (expr);
1719 low = TREE_INT_CST_LOW (expr);
1720
1721 /* First clear all bits that are beyond the type's precision in case
1722 we've been sign extended. */
1723
1724 if (prec == 2 * HOST_BITS_PER_WIDE_INT)
1725 ;
1726 else if (prec > HOST_BITS_PER_WIDE_INT)
1727 high &= ~((HOST_WIDE_INT) (-1) << (prec - HOST_BITS_PER_WIDE_INT));
1728 else
1729 {
1730 high = 0;
1731 if (prec < HOST_BITS_PER_WIDE_INT)
1732 low &= ~((HOST_WIDE_INT) (-1) << prec);
1733 }
1734
1735 return (high != 0 ? HOST_BITS_PER_WIDE_INT + exact_log2 (high)
1736 : exact_log2 (low));
1737 }
1738
1739 /* Return 1 if EXPR is the real constant zero. */
1740
1741 int
1742 real_zerop (expr)
1743 tree expr;
1744 {
1745 STRIP_NOPS (expr);
1746
1747 return ((TREE_CODE (expr) == REAL_CST
1748 && ! TREE_CONSTANT_OVERFLOW (expr)
1749 && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst0))
1750 || (TREE_CODE (expr) == COMPLEX_CST
1751 && real_zerop (TREE_REALPART (expr))
1752 && real_zerop (TREE_IMAGPART (expr))));
1753 }
1754
1755 /* Return 1 if EXPR is the real constant one in real or complex form. */
1756
1757 int
1758 real_onep (expr)
1759 tree expr;
1760 {
1761 STRIP_NOPS (expr);
1762
1763 return ((TREE_CODE (expr) == REAL_CST
1764 && ! TREE_CONSTANT_OVERFLOW (expr)
1765 && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst1))
1766 || (TREE_CODE (expr) == COMPLEX_CST
1767 && real_onep (TREE_REALPART (expr))
1768 && real_zerop (TREE_IMAGPART (expr))));
1769 }
1770
1771 /* Return 1 if EXPR is the real constant two. */
1772
1773 int
1774 real_twop (expr)
1775 tree expr;
1776 {
1777 STRIP_NOPS (expr);
1778
1779 return ((TREE_CODE (expr) == REAL_CST
1780 && ! TREE_CONSTANT_OVERFLOW (expr)
1781 && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst2))
1782 || (TREE_CODE (expr) == COMPLEX_CST
1783 && real_twop (TREE_REALPART (expr))
1784 && real_zerop (TREE_IMAGPART (expr))));
1785 }
1786
1787 /* Nonzero if EXP is a constant or a cast of a constant. */
1788
1789 int
1790 really_constant_p (exp)
1791 tree exp;
1792 {
1793 /* This is not quite the same as STRIP_NOPS. It does more. */
1794 while (TREE_CODE (exp) == NOP_EXPR
1795 || TREE_CODE (exp) == CONVERT_EXPR
1796 || TREE_CODE (exp) == NON_LVALUE_EXPR)
1797 exp = TREE_OPERAND (exp, 0);
1798 return TREE_CONSTANT (exp);
1799 }
1800 \f
1801 /* Return first list element whose TREE_VALUE is ELEM.
1802 Return 0 if ELEM is not in LIST. */
1803
1804 tree
1805 value_member (elem, list)
1806 tree elem, list;
1807 {
1808 while (list)
1809 {
1810 if (elem == TREE_VALUE (list))
1811 return list;
1812 list = TREE_CHAIN (list);
1813 }
1814 return NULL_TREE;
1815 }
1816
1817 /* Return first list element whose TREE_PURPOSE is ELEM.
1818 Return 0 if ELEM is not in LIST. */
1819
1820 tree
1821 purpose_member (elem, list)
1822 tree elem, list;
1823 {
1824 while (list)
1825 {
1826 if (elem == TREE_PURPOSE (list))
1827 return list;
1828 list = TREE_CHAIN (list);
1829 }
1830 return NULL_TREE;
1831 }
1832
1833 /* Return first list element whose BINFO_TYPE is ELEM.
1834 Return 0 if ELEM is not in LIST. */
1835
1836 tree
1837 binfo_member (elem, list)
1838 tree elem, list;
1839 {
1840 while (list)
1841 {
1842 if (elem == BINFO_TYPE (list))
1843 return list;
1844 list = TREE_CHAIN (list);
1845 }
1846 return NULL_TREE;
1847 }
1848
1849 /* Return nonzero if ELEM is part of the chain CHAIN. */
1850
1851 int
1852 chain_member (elem, chain)
1853 tree elem, chain;
1854 {
1855 while (chain)
1856 {
1857 if (elem == chain)
1858 return 1;
1859 chain = TREE_CHAIN (chain);
1860 }
1861
1862 return 0;
1863 }
1864
1865 /* Return nonzero if ELEM is equal to TREE_VALUE (CHAIN) for any piece of
1866 chain CHAIN. */
1867 /* ??? This function was added for machine specific attributes but is no
1868 longer used. It could be deleted if we could confirm all front ends
1869 don't use it. */
1870
1871 int
1872 chain_member_value (elem, chain)
1873 tree elem, chain;
1874 {
1875 while (chain)
1876 {
1877 if (elem == TREE_VALUE (chain))
1878 return 1;
1879 chain = TREE_CHAIN (chain);
1880 }
1881
1882 return 0;
1883 }
1884
1885 /* Return nonzero if ELEM is equal to TREE_PURPOSE (CHAIN)
1886 for any piece of chain CHAIN. */
1887 /* ??? This function was added for machine specific attributes but is no
1888 longer used. It could be deleted if we could confirm all front ends
1889 don't use it. */
1890
1891 int
1892 chain_member_purpose (elem, chain)
1893 tree elem, chain;
1894 {
1895 while (chain)
1896 {
1897 if (elem == TREE_PURPOSE (chain))
1898 return 1;
1899 chain = TREE_CHAIN (chain);
1900 }
1901
1902 return 0;
1903 }
1904
1905 /* Return the length of a chain of nodes chained through TREE_CHAIN.
1906 We expect a null pointer to mark the end of the chain.
1907 This is the Lisp primitive `length'. */
1908
1909 int
1910 list_length (t)
1911 tree t;
1912 {
1913 register tree tail;
1914 register int len = 0;
1915
1916 for (tail = t; tail; tail = TREE_CHAIN (tail))
1917 len++;
1918
1919 return len;
1920 }
1921
1922 /* Concatenate two chains of nodes (chained through TREE_CHAIN)
1923 by modifying the last node in chain 1 to point to chain 2.
1924 This is the Lisp primitive `nconc'. */
1925
1926 tree
1927 chainon (op1, op2)
1928 tree op1, op2;
1929 {
1930
1931 if (op1)
1932 {
1933 register tree t1;
1934 register tree t2;
1935
1936 for (t1 = op1; TREE_CHAIN (t1); t1 = TREE_CHAIN (t1))
1937 ;
1938 TREE_CHAIN (t1) = op2;
1939 for (t2 = op2; t2; t2 = TREE_CHAIN (t2))
1940 if (t2 == t1)
1941 abort (); /* Circularity created. */
1942 return op1;
1943 }
1944 else return op2;
1945 }
1946
1947 /* Return the last node in a chain of nodes (chained through TREE_CHAIN). */
1948
1949 tree
1950 tree_last (chain)
1951 register tree chain;
1952 {
1953 register tree next;
1954 if (chain)
1955 while ((next = TREE_CHAIN (chain)))
1956 chain = next;
1957 return chain;
1958 }
1959
1960 /* Reverse the order of elements in the chain T,
1961 and return the new head of the chain (old last element). */
1962
1963 tree
1964 nreverse (t)
1965 tree t;
1966 {
1967 register tree prev = 0, decl, next;
1968 for (decl = t; decl; decl = next)
1969 {
1970 next = TREE_CHAIN (decl);
1971 TREE_CHAIN (decl) = prev;
1972 prev = decl;
1973 }
1974 return prev;
1975 }
1976
1977 /* Given a chain CHAIN of tree nodes,
1978 construct and return a list of those nodes. */
1979
1980 tree
1981 listify (chain)
1982 tree chain;
1983 {
1984 tree result = NULL_TREE;
1985 tree in_tail = chain;
1986 tree out_tail = NULL_TREE;
1987
1988 while (in_tail)
1989 {
1990 tree next = tree_cons (NULL_TREE, in_tail, NULL_TREE);
1991 if (out_tail)
1992 TREE_CHAIN (out_tail) = next;
1993 else
1994 result = next;
1995 out_tail = next;
1996 in_tail = TREE_CHAIN (in_tail);
1997 }
1998
1999 return result;
2000 }
2001 \f
2002 /* Return a newly created TREE_LIST node whose
2003 purpose and value fields are PARM and VALUE. */
2004
2005 tree
2006 build_tree_list (parm, value)
2007 tree parm, value;
2008 {
2009 register tree t = make_node (TREE_LIST);
2010 TREE_PURPOSE (t) = parm;
2011 TREE_VALUE (t) = value;
2012 return t;
2013 }
2014
2015 /* Similar, but build on the temp_decl_obstack. */
2016
2017 tree
2018 build_decl_list (parm, value)
2019 tree parm, value;
2020 {
2021 register tree node;
2022 register struct obstack *ambient_obstack = current_obstack;
2023 current_obstack = &temp_decl_obstack;
2024 node = build_tree_list (parm, value);
2025 current_obstack = ambient_obstack;
2026 return node;
2027 }
2028
2029 /* Similar, but build on the expression_obstack. */
2030
2031 tree
2032 build_expr_list (parm, value)
2033 tree parm, value;
2034 {
2035 register tree node;
2036 register struct obstack *ambient_obstack = current_obstack;
2037 current_obstack = expression_obstack;
2038 node = build_tree_list (parm, value);
2039 current_obstack = ambient_obstack;
2040 return node;
2041 }
2042
2043 /* Return a newly created TREE_LIST node whose
2044 purpose and value fields are PARM and VALUE
2045 and whose TREE_CHAIN is CHAIN. */
2046
2047 tree
2048 tree_cons (purpose, value, chain)
2049 tree purpose, value, chain;
2050 {
2051 #if 0
2052 register tree node = make_node (TREE_LIST);
2053 #else
2054 register int i;
2055 register tree node = (tree) obstack_alloc (current_obstack, sizeof (struct tree_list));
2056 #ifdef GATHER_STATISTICS
2057 tree_node_counts[(int)x_kind]++;
2058 tree_node_sizes[(int)x_kind] += sizeof (struct tree_list);
2059 #endif
2060
2061 for (i = (sizeof (struct tree_common) / sizeof (int)) - 1; i >= 0; i--)
2062 ((int *) node)[i] = 0;
2063
2064 TREE_SET_CODE (node, TREE_LIST);
2065 if (current_obstack == &permanent_obstack)
2066 TREE_PERMANENT (node) = 1;
2067 #endif
2068
2069 TREE_CHAIN (node) = chain;
2070 TREE_PURPOSE (node) = purpose;
2071 TREE_VALUE (node) = value;
2072 return node;
2073 }
2074
2075 /* Similar, but build on the temp_decl_obstack. */
2076
2077 tree
2078 decl_tree_cons (purpose, value, chain)
2079 tree purpose, value, chain;
2080 {
2081 register tree node;
2082 register struct obstack *ambient_obstack = current_obstack;
2083 current_obstack = &temp_decl_obstack;
2084 node = tree_cons (purpose, value, chain);
2085 current_obstack = ambient_obstack;
2086 return node;
2087 }
2088
2089 /* Similar, but build on the expression_obstack. */
2090
2091 tree
2092 expr_tree_cons (purpose, value, chain)
2093 tree purpose, value, chain;
2094 {
2095 register tree node;
2096 register struct obstack *ambient_obstack = current_obstack;
2097 current_obstack = expression_obstack;
2098 node = tree_cons (purpose, value, chain);
2099 current_obstack = ambient_obstack;
2100 return node;
2101 }
2102
2103 /* Same as `tree_cons' but make a permanent object. */
2104
2105 tree
2106 perm_tree_cons (purpose, value, chain)
2107 tree purpose, value, chain;
2108 {
2109 register tree node;
2110 register struct obstack *ambient_obstack = current_obstack;
2111 current_obstack = &permanent_obstack;
2112
2113 node = tree_cons (purpose, value, chain);
2114 current_obstack = ambient_obstack;
2115 return node;
2116 }
2117
2118 /* Same as `tree_cons', but make this node temporary, regardless. */
2119
2120 tree
2121 temp_tree_cons (purpose, value, chain)
2122 tree purpose, value, chain;
2123 {
2124 register tree node;
2125 register struct obstack *ambient_obstack = current_obstack;
2126 current_obstack = &temporary_obstack;
2127
2128 node = tree_cons (purpose, value, chain);
2129 current_obstack = ambient_obstack;
2130 return node;
2131 }
2132
2133 /* Same as `tree_cons', but save this node if the function's RTL is saved. */
2134
2135 tree
2136 saveable_tree_cons (purpose, value, chain)
2137 tree purpose, value, chain;
2138 {
2139 register tree node;
2140 register struct obstack *ambient_obstack = current_obstack;
2141 current_obstack = saveable_obstack;
2142
2143 node = tree_cons (purpose, value, chain);
2144 current_obstack = ambient_obstack;
2145 return node;
2146 }
2147 \f
2148 /* Return the size nominally occupied by an object of type TYPE
2149 when it resides in memory. The value is measured in units of bytes,
2150 and its data type is that normally used for type sizes
2151 (which is the first type created by make_signed_type or
2152 make_unsigned_type). */
2153
2154 tree
2155 size_in_bytes (type)
2156 tree type;
2157 {
2158 tree t;
2159
2160 if (type == error_mark_node)
2161 return integer_zero_node;
2162 type = TYPE_MAIN_VARIANT (type);
2163 if (TYPE_SIZE (type) == 0)
2164 {
2165 incomplete_type_error (NULL_TREE, type);
2166 return integer_zero_node;
2167 }
2168 t = size_binop (CEIL_DIV_EXPR, TYPE_SIZE (type),
2169 size_int (BITS_PER_UNIT));
2170 if (TREE_CODE (t) == INTEGER_CST)
2171 force_fit_type (t, 0);
2172 return t;
2173 }
2174
2175 /* Return the size of TYPE (in bytes) as an integer,
2176 or return -1 if the size can vary. */
2177
2178 int
2179 int_size_in_bytes (type)
2180 tree type;
2181 {
2182 unsigned int size;
2183 if (type == error_mark_node)
2184 return 0;
2185 type = TYPE_MAIN_VARIANT (type);
2186 if (TYPE_SIZE (type) == 0)
2187 return -1;
2188 if (TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST)
2189 return -1;
2190 if (TREE_INT_CST_HIGH (TYPE_SIZE (type)) != 0)
2191 {
2192 tree t = size_binop (CEIL_DIV_EXPR, TYPE_SIZE (type),
2193 size_int (BITS_PER_UNIT));
2194 return TREE_INT_CST_LOW (t);
2195 }
2196 size = TREE_INT_CST_LOW (TYPE_SIZE (type));
2197 return (size + BITS_PER_UNIT - 1) / BITS_PER_UNIT;
2198 }
2199 \f
2200 /* Return, as a tree node, the number of elements for TYPE (which is an
2201 ARRAY_TYPE) minus one. This counts only elements of the top array.
2202
2203 Don't let any SAVE_EXPRs escape; if we are called as part of a cleanup
2204 action, they would get unsaved. */
2205
2206 tree
2207 array_type_nelts (type)
2208 tree type;
2209 {
2210 tree index_type, min, max;
2211
2212 /* If they did it with unspecified bounds, then we should have already
2213 given an error about it before we got here. */
2214 if (! TYPE_DOMAIN (type))
2215 return error_mark_node;
2216
2217 index_type = TYPE_DOMAIN (type);
2218 min = TYPE_MIN_VALUE (index_type);
2219 max = TYPE_MAX_VALUE (index_type);
2220
2221 if (! TREE_CONSTANT (min))
2222 {
2223 STRIP_NOPS (min);
2224 if (TREE_CODE (min) == SAVE_EXPR)
2225 min = build (RTL_EXPR, TREE_TYPE (TYPE_MIN_VALUE (index_type)), 0,
2226 SAVE_EXPR_RTL (min));
2227 else
2228 min = TYPE_MIN_VALUE (index_type);
2229 }
2230
2231 if (! TREE_CONSTANT (max))
2232 {
2233 STRIP_NOPS (max);
2234 if (TREE_CODE (max) == SAVE_EXPR)
2235 max = build (RTL_EXPR, TREE_TYPE (TYPE_MAX_VALUE (index_type)), 0,
2236 SAVE_EXPR_RTL (max));
2237 else
2238 max = TYPE_MAX_VALUE (index_type);
2239 }
2240
2241 return (integer_zerop (min)
2242 ? max
2243 : fold (build (MINUS_EXPR, TREE_TYPE (max), max, min)));
2244 }
2245 \f
2246 /* Return nonzero if arg is static -- a reference to an object in
2247 static storage. This is not the same as the C meaning of `static'. */
2248
2249 int
2250 staticp (arg)
2251 tree arg;
2252 {
2253 switch (TREE_CODE (arg))
2254 {
2255 case FUNCTION_DECL:
2256 /* Nested functions aren't static, since taking their address
2257 involves a trampoline. */
2258 return decl_function_context (arg) == 0 || DECL_NO_STATIC_CHAIN (arg);
2259 case VAR_DECL:
2260 return TREE_STATIC (arg) || DECL_EXTERNAL (arg);
2261
2262 case CONSTRUCTOR:
2263 return TREE_STATIC (arg);
2264
2265 case STRING_CST:
2266 return 1;
2267
2268 /* If we are referencing a bitfield, we can't evaluate an
2269 ADDR_EXPR at compile time and so it isn't a constant. */
2270 case COMPONENT_REF:
2271 return (! DECL_BIT_FIELD (TREE_OPERAND (arg, 1))
2272 && staticp (TREE_OPERAND (arg, 0)));
2273
2274 case BIT_FIELD_REF:
2275 return 0;
2276
2277 #if 0
2278 /* This case is technically correct, but results in setting
2279 TREE_CONSTANT on ADDR_EXPRs that cannot be evaluated at
2280 compile time. */
2281 case INDIRECT_REF:
2282 return TREE_CONSTANT (TREE_OPERAND (arg, 0));
2283 #endif
2284
2285 case ARRAY_REF:
2286 if (TREE_CODE (TYPE_SIZE (TREE_TYPE (arg))) == INTEGER_CST
2287 && TREE_CODE (TREE_OPERAND (arg, 1)) == INTEGER_CST)
2288 return staticp (TREE_OPERAND (arg, 0));
2289
2290 default:
2291 return 0;
2292 }
2293 }
2294 \f
2295 /* Wrap a SAVE_EXPR around EXPR, if appropriate.
2296 Do this to any expression which may be used in more than one place,
2297 but must be evaluated only once.
2298
2299 Normally, expand_expr would reevaluate the expression each time.
2300 Calling save_expr produces something that is evaluated and recorded
2301 the first time expand_expr is called on it. Subsequent calls to
2302 expand_expr just reuse the recorded value.
2303
2304 The call to expand_expr that generates code that actually computes
2305 the value is the first call *at compile time*. Subsequent calls
2306 *at compile time* generate code to use the saved value.
2307 This produces correct result provided that *at run time* control
2308 always flows through the insns made by the first expand_expr
2309 before reaching the other places where the save_expr was evaluated.
2310 You, the caller of save_expr, must make sure this is so.
2311
2312 Constants, and certain read-only nodes, are returned with no
2313 SAVE_EXPR because that is safe. Expressions containing placeholders
2314 are not touched; see tree.def for an explanation of what these
2315 are used for. */
2316
2317 tree
2318 save_expr (expr)
2319 tree expr;
2320 {
2321 register tree t = fold (expr);
2322
2323 /* We don't care about whether this can be used as an lvalue in this
2324 context. */
2325 while (TREE_CODE (t) == NON_LVALUE_EXPR)
2326 t = TREE_OPERAND (t, 0);
2327
2328 /* If the tree evaluates to a constant, then we don't want to hide that
2329 fact (i.e. this allows further folding, and direct checks for constants).
2330 However, a read-only object that has side effects cannot be bypassed.
2331 Since it is no problem to reevaluate literals, we just return the
2332 literal node. */
2333
2334 if (TREE_CONSTANT (t) || (TREE_READONLY (t) && ! TREE_SIDE_EFFECTS (t))
2335 || TREE_CODE (t) == SAVE_EXPR || TREE_CODE (t) == ERROR_MARK)
2336 return t;
2337
2338 /* If T contains a PLACEHOLDER_EXPR, we must evaluate it each time, since
2339 it means that the size or offset of some field of an object depends on
2340 the value within another field.
2341
2342 Note that it must not be the case that T contains both a PLACEHOLDER_EXPR
2343 and some variable since it would then need to be both evaluated once and
2344 evaluated more than once. Front-ends must assure this case cannot
2345 happen by surrounding any such subexpressions in their own SAVE_EXPR
2346 and forcing evaluation at the proper time. */
2347 if (contains_placeholder_p (t))
2348 return t;
2349
2350 t = build (SAVE_EXPR, TREE_TYPE (expr), t, current_function_decl, NULL_TREE);
2351
2352 /* This expression might be placed ahead of a jump to ensure that the
2353 value was computed on both sides of the jump. So make sure it isn't
2354 eliminated as dead. */
2355 TREE_SIDE_EFFECTS (t) = 1;
2356 return t;
2357 }
2358
2359 /* Arrange for an expression to be expanded multiple independent
2360 times. This is useful for cleanup actions, as the backend can
2361 expand them multiple times in different places. */
2362
2363 tree
2364 unsave_expr (expr)
2365 tree expr;
2366 {
2367 tree t;
2368
2369 /* If this is already protected, no sense in protecting it again. */
2370 if (TREE_CODE (expr) == UNSAVE_EXPR)
2371 return expr;
2372
2373 t = build1 (UNSAVE_EXPR, TREE_TYPE (expr), expr);
2374 TREE_SIDE_EFFECTS (t) = TREE_SIDE_EFFECTS (expr);
2375 return t;
2376 }
2377
2378 /* Returns the index of the first non-tree operand for CODE, or the number
2379 of operands if all are trees. */
2380
2381 int
2382 first_rtl_op (code)
2383 enum tree_code code;
2384 {
2385 switch (code)
2386 {
2387 case SAVE_EXPR:
2388 return 2;
2389 case RTL_EXPR:
2390 return 0;
2391 case CALL_EXPR:
2392 return 2;
2393 case WITH_CLEANUP_EXPR:
2394 /* Should be defined to be 2. */
2395 return 1;
2396 case METHOD_CALL_EXPR:
2397 return 3;
2398 default:
2399 return tree_code_length [(int) code];
2400 }
2401 }
2402
2403 /* Modify a tree in place so that all the evaluate only once things
2404 are cleared out. Return the EXPR given. */
2405
2406 tree
2407 unsave_expr_now (expr)
2408 tree expr;
2409 {
2410 enum tree_code code;
2411 register int i;
2412 int first_rtl;
2413
2414 if (expr == NULL_TREE)
2415 return expr;
2416
2417 code = TREE_CODE (expr);
2418 first_rtl = first_rtl_op (code);
2419 switch (code)
2420 {
2421 case SAVE_EXPR:
2422 SAVE_EXPR_RTL (expr) = 0;
2423 break;
2424
2425 case TARGET_EXPR:
2426 TREE_OPERAND (expr, 1) = TREE_OPERAND (expr, 3);
2427 TREE_OPERAND (expr, 3) = NULL_TREE;
2428 break;
2429
2430 case RTL_EXPR:
2431 /* I don't yet know how to emit a sequence multiple times. */
2432 if (RTL_EXPR_SEQUENCE (expr) != 0)
2433 abort ();
2434 break;
2435
2436 case CALL_EXPR:
2437 CALL_EXPR_RTL (expr) = 0;
2438 if (TREE_OPERAND (expr, 1)
2439 && TREE_CODE (TREE_OPERAND (expr, 1)) == TREE_LIST)
2440 {
2441 tree exp = TREE_OPERAND (expr, 1);
2442 while (exp)
2443 {
2444 unsave_expr_now (TREE_VALUE (exp));
2445 exp = TREE_CHAIN (exp);
2446 }
2447 }
2448 break;
2449
2450 default:
2451 break;
2452 }
2453
2454 switch (TREE_CODE_CLASS (code))
2455 {
2456 case 'c': /* a constant */
2457 case 't': /* a type node */
2458 case 'x': /* something random, like an identifier or an ERROR_MARK. */
2459 case 'd': /* A decl node */
2460 case 'b': /* A block node */
2461 return expr;
2462
2463 case 'e': /* an expression */
2464 case 'r': /* a reference */
2465 case 's': /* an expression with side effects */
2466 case '<': /* a comparison expression */
2467 case '2': /* a binary arithmetic expression */
2468 case '1': /* a unary arithmetic expression */
2469 for (i = first_rtl - 1; i >= 0; i--)
2470 unsave_expr_now (TREE_OPERAND (expr, i));
2471 return expr;
2472
2473 default:
2474 abort ();
2475 }
2476 }
2477 \f
2478 /* Return 1 if EXP contains a PLACEHOLDER_EXPR; i.e., if it represents a size
2479 or offset that depends on a field within a record. */
2480
2481 int
2482 contains_placeholder_p (exp)
2483 tree exp;
2484 {
2485 register enum tree_code code = TREE_CODE (exp);
2486 int result;
2487
2488 /* If we have a WITH_RECORD_EXPR, it "cancels" any PLACEHOLDER_EXPR
2489 in it since it is supplying a value for it. */
2490 if (code == WITH_RECORD_EXPR)
2491 return 0;
2492 else if (code == PLACEHOLDER_EXPR)
2493 return 1;
2494
2495 switch (TREE_CODE_CLASS (code))
2496 {
2497 case 'r':
2498 /* Don't look at any PLACEHOLDER_EXPRs that might be in index or bit
2499 position computations since they will be converted into a
2500 WITH_RECORD_EXPR involving the reference, which will assume
2501 here will be valid. */
2502 return contains_placeholder_p (TREE_OPERAND (exp, 0));
2503
2504 case 'x':
2505 if (code == TREE_LIST)
2506 return (contains_placeholder_p (TREE_VALUE (exp))
2507 || (TREE_CHAIN (exp) != 0
2508 && contains_placeholder_p (TREE_CHAIN (exp))));
2509 break;
2510
2511 case '1':
2512 case '2': case '<':
2513 case 'e':
2514 switch (code)
2515 {
2516 case COMPOUND_EXPR:
2517 /* Ignoring the first operand isn't quite right, but works best. */
2518 return contains_placeholder_p (TREE_OPERAND (exp, 1));
2519
2520 case RTL_EXPR:
2521 case CONSTRUCTOR:
2522 return 0;
2523
2524 case COND_EXPR:
2525 return (contains_placeholder_p (TREE_OPERAND (exp, 0))
2526 || contains_placeholder_p (TREE_OPERAND (exp, 1))
2527 || contains_placeholder_p (TREE_OPERAND (exp, 2)));
2528
2529 case SAVE_EXPR:
2530 /* If we already know this doesn't have a placeholder, don't
2531 check again. */
2532 if (SAVE_EXPR_NOPLACEHOLDER (exp) || SAVE_EXPR_RTL (exp) != 0)
2533 return 0;
2534
2535 SAVE_EXPR_NOPLACEHOLDER (exp) = 1;
2536 result = contains_placeholder_p (TREE_OPERAND (exp, 0));
2537 if (result)
2538 SAVE_EXPR_NOPLACEHOLDER (exp) = 0;
2539
2540 return result;
2541
2542 case CALL_EXPR:
2543 return (TREE_OPERAND (exp, 1) != 0
2544 && contains_placeholder_p (TREE_OPERAND (exp, 1)));
2545
2546 default:
2547 break;
2548 }
2549
2550 switch (tree_code_length[(int) code])
2551 {
2552 case 1:
2553 return contains_placeholder_p (TREE_OPERAND (exp, 0));
2554 case 2:
2555 return (contains_placeholder_p (TREE_OPERAND (exp, 0))
2556 || contains_placeholder_p (TREE_OPERAND (exp, 1)));
2557 default:
2558 return 0;
2559 }
2560
2561 default:
2562 return 0;
2563 }
2564 return 0;
2565 }
2566
2567 /* Return 1 if EXP contains any expressions that produce cleanups for an
2568 outer scope to deal with. Used by fold. */
2569
2570 int
2571 has_cleanups (exp)
2572 tree exp;
2573 {
2574 int i, nops, cmp;
2575
2576 if (! TREE_SIDE_EFFECTS (exp))
2577 return 0;
2578
2579 switch (TREE_CODE (exp))
2580 {
2581 case TARGET_EXPR:
2582 case WITH_CLEANUP_EXPR:
2583 return 1;
2584
2585 case CLEANUP_POINT_EXPR:
2586 return 0;
2587
2588 case CALL_EXPR:
2589 for (exp = TREE_OPERAND (exp, 1); exp; exp = TREE_CHAIN (exp))
2590 {
2591 cmp = has_cleanups (TREE_VALUE (exp));
2592 if (cmp)
2593 return cmp;
2594 }
2595 return 0;
2596
2597 default:
2598 break;
2599 }
2600
2601 /* This general rule works for most tree codes. All exceptions should be
2602 handled above. If this is a language-specific tree code, we can't
2603 trust what might be in the operand, so say we don't know
2604 the situation. */
2605 if ((int) TREE_CODE (exp) >= (int) LAST_AND_UNUSED_TREE_CODE)
2606 return -1;
2607
2608 nops = first_rtl_op (TREE_CODE (exp));
2609 for (i = 0; i < nops; i++)
2610 if (TREE_OPERAND (exp, i) != 0)
2611 {
2612 int type = TREE_CODE_CLASS (TREE_CODE (TREE_OPERAND (exp, i)));
2613 if (type == 'e' || type == '<' || type == '1' || type == '2'
2614 || type == 'r' || type == 's')
2615 {
2616 cmp = has_cleanups (TREE_OPERAND (exp, i));
2617 if (cmp)
2618 return cmp;
2619 }
2620 }
2621
2622 return 0;
2623 }
2624 \f
2625 /* Given a tree EXP, a FIELD_DECL F, and a replacement value R,
2626 return a tree with all occurrences of references to F in a
2627 PLACEHOLDER_EXPR replaced by R. Note that we assume here that EXP
2628 contains only arithmetic expressions or a CALL_EXPR with a
2629 PLACEHOLDER_EXPR occurring only in its arglist. */
2630
2631 tree
2632 substitute_in_expr (exp, f, r)
2633 tree exp;
2634 tree f;
2635 tree r;
2636 {
2637 enum tree_code code = TREE_CODE (exp);
2638 tree op0, op1, op2;
2639 tree new;
2640 tree inner;
2641
2642 switch (TREE_CODE_CLASS (code))
2643 {
2644 case 'c':
2645 case 'd':
2646 return exp;
2647
2648 case 'x':
2649 if (code == PLACEHOLDER_EXPR)
2650 return exp;
2651 else if (code == TREE_LIST)
2652 {
2653 op0 = (TREE_CHAIN (exp) == 0
2654 ? 0 : substitute_in_expr (TREE_CHAIN (exp), f, r));
2655 op1 = substitute_in_expr (TREE_VALUE (exp), f, r);
2656 if (op0 == TREE_CHAIN (exp) && op1 == TREE_VALUE (exp))
2657 return exp;
2658
2659 return tree_cons (TREE_PURPOSE (exp), op1, op0);
2660 }
2661
2662 abort ();
2663
2664 case '1':
2665 case '2':
2666 case '<':
2667 case 'e':
2668 switch (tree_code_length[(int) code])
2669 {
2670 case 1:
2671 op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2672 if (op0 == TREE_OPERAND (exp, 0))
2673 return exp;
2674
2675 new = fold (build1 (code, TREE_TYPE (exp), op0));
2676 break;
2677
2678 case 2:
2679 /* An RTL_EXPR cannot contain a PLACEHOLDER_EXPR; a CONSTRUCTOR
2680 could, but we don't support it. */
2681 if (code == RTL_EXPR)
2682 return exp;
2683 else if (code == CONSTRUCTOR)
2684 abort ();
2685
2686 op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2687 op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
2688 if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1))
2689 return exp;
2690
2691 new = fold (build (code, TREE_TYPE (exp), op0, op1));
2692 break;
2693
2694 case 3:
2695 /* It cannot be that anything inside a SAVE_EXPR contains a
2696 PLACEHOLDER_EXPR. */
2697 if (code == SAVE_EXPR)
2698 return exp;
2699
2700 else if (code == CALL_EXPR)
2701 {
2702 op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
2703 if (op1 == TREE_OPERAND (exp, 1))
2704 return exp;
2705
2706 return build (code, TREE_TYPE (exp),
2707 TREE_OPERAND (exp, 0), op1, NULL_TREE);
2708 }
2709
2710 else if (code != COND_EXPR)
2711 abort ();
2712
2713 op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2714 op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
2715 op2 = substitute_in_expr (TREE_OPERAND (exp, 2), f, r);
2716 if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1)
2717 && op2 == TREE_OPERAND (exp, 2))
2718 return exp;
2719
2720 new = fold (build (code, TREE_TYPE (exp), op0, op1, op2));
2721 break;
2722
2723 default:
2724 abort ();
2725 }
2726
2727 break;
2728
2729 case 'r':
2730 switch (code)
2731 {
2732 case COMPONENT_REF:
2733 /* If this expression is getting a value from a PLACEHOLDER_EXPR
2734 and it is the right field, replace it with R. */
2735 for (inner = TREE_OPERAND (exp, 0);
2736 TREE_CODE_CLASS (TREE_CODE (inner)) == 'r';
2737 inner = TREE_OPERAND (inner, 0))
2738 ;
2739 if (TREE_CODE (inner) == PLACEHOLDER_EXPR
2740 && TREE_OPERAND (exp, 1) == f)
2741 return r;
2742
2743 /* If this expression hasn't been completed let, leave it
2744 alone. */
2745 if (TREE_CODE (inner) == PLACEHOLDER_EXPR
2746 && TREE_TYPE (inner) == 0)
2747 return exp;
2748
2749 op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2750 if (op0 == TREE_OPERAND (exp, 0))
2751 return exp;
2752
2753 new = fold (build (code, TREE_TYPE (exp), op0,
2754 TREE_OPERAND (exp, 1)));
2755 break;
2756
2757 case BIT_FIELD_REF:
2758 op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2759 op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
2760 op2 = substitute_in_expr (TREE_OPERAND (exp, 2), f, r);
2761 if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1)
2762 && op2 == TREE_OPERAND (exp, 2))
2763 return exp;
2764
2765 new = fold (build (code, TREE_TYPE (exp), op0, op1, op2));
2766 break;
2767
2768 case INDIRECT_REF:
2769 case BUFFER_REF:
2770 op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2771 if (op0 == TREE_OPERAND (exp, 0))
2772 return exp;
2773
2774 new = fold (build1 (code, TREE_TYPE (exp), op0));
2775 break;
2776
2777 default:
2778 abort ();
2779 }
2780 break;
2781
2782 default:
2783 abort ();
2784 }
2785
2786 TREE_READONLY (new) = TREE_READONLY (exp);
2787 return new;
2788 }
2789 \f
2790 /* Stabilize a reference so that we can use it any number of times
2791 without causing its operands to be evaluated more than once.
2792 Returns the stabilized reference. This works by means of save_expr,
2793 so see the caveats in the comments about save_expr.
2794
2795 Also allows conversion expressions whose operands are references.
2796 Any other kind of expression is returned unchanged. */
2797
2798 tree
2799 stabilize_reference (ref)
2800 tree ref;
2801 {
2802 register tree result;
2803 register enum tree_code code = TREE_CODE (ref);
2804
2805 switch (code)
2806 {
2807 case VAR_DECL:
2808 case PARM_DECL:
2809 case RESULT_DECL:
2810 /* No action is needed in this case. */
2811 return ref;
2812
2813 case NOP_EXPR:
2814 case CONVERT_EXPR:
2815 case FLOAT_EXPR:
2816 case FIX_TRUNC_EXPR:
2817 case FIX_FLOOR_EXPR:
2818 case FIX_ROUND_EXPR:
2819 case FIX_CEIL_EXPR:
2820 result = build_nt (code, stabilize_reference (TREE_OPERAND (ref, 0)));
2821 break;
2822
2823 case INDIRECT_REF:
2824 result = build_nt (INDIRECT_REF,
2825 stabilize_reference_1 (TREE_OPERAND (ref, 0)));
2826 break;
2827
2828 case COMPONENT_REF:
2829 result = build_nt (COMPONENT_REF,
2830 stabilize_reference (TREE_OPERAND (ref, 0)),
2831 TREE_OPERAND (ref, 1));
2832 break;
2833
2834 case BIT_FIELD_REF:
2835 result = build_nt (BIT_FIELD_REF,
2836 stabilize_reference (TREE_OPERAND (ref, 0)),
2837 stabilize_reference_1 (TREE_OPERAND (ref, 1)),
2838 stabilize_reference_1 (TREE_OPERAND (ref, 2)));
2839 break;
2840
2841 case ARRAY_REF:
2842 result = build_nt (ARRAY_REF,
2843 stabilize_reference (TREE_OPERAND (ref, 0)),
2844 stabilize_reference_1 (TREE_OPERAND (ref, 1)));
2845 break;
2846
2847 case COMPOUND_EXPR:
2848 /* We cannot wrap the first expression in a SAVE_EXPR, as then
2849 it wouldn't be ignored. This matters when dealing with
2850 volatiles. */
2851 return stabilize_reference_1 (ref);
2852
2853 case RTL_EXPR:
2854 result = build1 (INDIRECT_REF, TREE_TYPE (ref),
2855 save_expr (build1 (ADDR_EXPR,
2856 build_pointer_type (TREE_TYPE (ref)),
2857 ref)));
2858 break;
2859
2860
2861 /* If arg isn't a kind of lvalue we recognize, make no change.
2862 Caller should recognize the error for an invalid lvalue. */
2863 default:
2864 return ref;
2865
2866 case ERROR_MARK:
2867 return error_mark_node;
2868 }
2869
2870 TREE_TYPE (result) = TREE_TYPE (ref);
2871 TREE_READONLY (result) = TREE_READONLY (ref);
2872 TREE_SIDE_EFFECTS (result) = TREE_SIDE_EFFECTS (ref);
2873 TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
2874 TREE_RAISES (result) = TREE_RAISES (ref);
2875
2876 return result;
2877 }
2878
2879 /* Subroutine of stabilize_reference; this is called for subtrees of
2880 references. Any expression with side-effects must be put in a SAVE_EXPR
2881 to ensure that it is only evaluated once.
2882
2883 We don't put SAVE_EXPR nodes around everything, because assigning very
2884 simple expressions to temporaries causes us to miss good opportunities
2885 for optimizations. Among other things, the opportunity to fold in the
2886 addition of a constant into an addressing mode often gets lost, e.g.
2887 "y[i+1] += x;". In general, we take the approach that we should not make
2888 an assignment unless we are forced into it - i.e., that any non-side effect
2889 operator should be allowed, and that cse should take care of coalescing
2890 multiple utterances of the same expression should that prove fruitful. */
2891
2892 tree
2893 stabilize_reference_1 (e)
2894 tree e;
2895 {
2896 register tree result;
2897 register enum tree_code code = TREE_CODE (e);
2898
2899 /* We cannot ignore const expressions because it might be a reference
2900 to a const array but whose index contains side-effects. But we can
2901 ignore things that are actual constant or that already have been
2902 handled by this function. */
2903
2904 if (TREE_CONSTANT (e) || code == SAVE_EXPR)
2905 return e;
2906
2907 switch (TREE_CODE_CLASS (code))
2908 {
2909 case 'x':
2910 case 't':
2911 case 'd':
2912 case 'b':
2913 case '<':
2914 case 's':
2915 case 'e':
2916 case 'r':
2917 /* If the expression has side-effects, then encase it in a SAVE_EXPR
2918 so that it will only be evaluated once. */
2919 /* The reference (r) and comparison (<) classes could be handled as
2920 below, but it is generally faster to only evaluate them once. */
2921 if (TREE_SIDE_EFFECTS (e))
2922 return save_expr (e);
2923 return e;
2924
2925 case 'c':
2926 /* Constants need no processing. In fact, we should never reach
2927 here. */
2928 return e;
2929
2930 case '2':
2931 /* Division is slow and tends to be compiled with jumps,
2932 especially the division by powers of 2 that is often
2933 found inside of an array reference. So do it just once. */
2934 if (code == TRUNC_DIV_EXPR || code == TRUNC_MOD_EXPR
2935 || code == FLOOR_DIV_EXPR || code == FLOOR_MOD_EXPR
2936 || code == CEIL_DIV_EXPR || code == CEIL_MOD_EXPR
2937 || code == ROUND_DIV_EXPR || code == ROUND_MOD_EXPR)
2938 return save_expr (e);
2939 /* Recursively stabilize each operand. */
2940 result = build_nt (code, stabilize_reference_1 (TREE_OPERAND (e, 0)),
2941 stabilize_reference_1 (TREE_OPERAND (e, 1)));
2942 break;
2943
2944 case '1':
2945 /* Recursively stabilize each operand. */
2946 result = build_nt (code, stabilize_reference_1 (TREE_OPERAND (e, 0)));
2947 break;
2948
2949 default:
2950 abort ();
2951 }
2952
2953 TREE_TYPE (result) = TREE_TYPE (e);
2954 TREE_READONLY (result) = TREE_READONLY (e);
2955 TREE_SIDE_EFFECTS (result) = TREE_SIDE_EFFECTS (e);
2956 TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
2957 TREE_RAISES (result) = TREE_RAISES (e);
2958
2959 return result;
2960 }
2961 \f
2962 /* Low-level constructors for expressions. */
2963
2964 /* Build an expression of code CODE, data type TYPE,
2965 and operands as specified by the arguments ARG1 and following arguments.
2966 Expressions and reference nodes can be created this way.
2967 Constants, decls, types and misc nodes cannot be. */
2968
2969 tree
2970 build VPROTO((enum tree_code code, tree tt, ...))
2971 {
2972 #ifndef __STDC__
2973 enum tree_code code;
2974 tree tt;
2975 #endif
2976 va_list p;
2977 register tree t;
2978 register int length;
2979 register int i;
2980
2981 VA_START (p, tt);
2982
2983 #ifndef __STDC__
2984 code = va_arg (p, enum tree_code);
2985 tt = va_arg (p, tree);
2986 #endif
2987
2988 t = make_node (code);
2989 length = tree_code_length[(int) code];
2990 TREE_TYPE (t) = tt;
2991
2992 if (length == 2)
2993 {
2994 /* This is equivalent to the loop below, but faster. */
2995 register tree arg0 = va_arg (p, tree);
2996 register tree arg1 = va_arg (p, tree);
2997 TREE_OPERAND (t, 0) = arg0;
2998 TREE_OPERAND (t, 1) = arg1;
2999 if ((arg0 && TREE_SIDE_EFFECTS (arg0))
3000 || (arg1 && TREE_SIDE_EFFECTS (arg1)))
3001 TREE_SIDE_EFFECTS (t) = 1;
3002 TREE_RAISES (t)
3003 = (arg0 && TREE_RAISES (arg0)) || (arg1 && TREE_RAISES (arg1));
3004 }
3005 else if (length == 1)
3006 {
3007 register tree arg0 = va_arg (p, tree);
3008
3009 /* Call build1 for this! */
3010 if (TREE_CODE_CLASS (code) != 's')
3011 abort ();
3012 TREE_OPERAND (t, 0) = arg0;
3013 if (arg0 && TREE_SIDE_EFFECTS (arg0))
3014 TREE_SIDE_EFFECTS (t) = 1;
3015 TREE_RAISES (t) = (arg0 && TREE_RAISES (arg0));
3016 }
3017 else
3018 {
3019 for (i = 0; i < length; i++)
3020 {
3021 register tree operand = va_arg (p, tree);
3022 TREE_OPERAND (t, i) = operand;
3023 if (operand)
3024 {
3025 if (TREE_SIDE_EFFECTS (operand))
3026 TREE_SIDE_EFFECTS (t) = 1;
3027 if (TREE_RAISES (operand))
3028 TREE_RAISES (t) = 1;
3029 }
3030 }
3031 }
3032 va_end (p);
3033 return t;
3034 }
3035
3036 /* Same as above, but only builds for unary operators.
3037 Saves lions share of calls to `build'; cuts down use
3038 of varargs, which is expensive for RISC machines. */
3039
3040 tree
3041 build1 (code, type, node)
3042 enum tree_code code;
3043 tree type;
3044 tree node;
3045 {
3046 register struct obstack *obstack = expression_obstack;
3047 register int i, length;
3048 #ifdef GATHER_STATISTICS
3049 register tree_node_kind kind;
3050 #endif
3051 register tree t;
3052
3053 #ifdef GATHER_STATISTICS
3054 if (TREE_CODE_CLASS (code) == 'r')
3055 kind = r_kind;
3056 else
3057 kind = e_kind;
3058 #endif
3059
3060 length = sizeof (struct tree_exp);
3061
3062 t = (tree) obstack_alloc (obstack, length);
3063
3064 #ifdef GATHER_STATISTICS
3065 tree_node_counts[(int)kind]++;
3066 tree_node_sizes[(int)kind] += length;
3067 #endif
3068
3069 for (i = (length / sizeof (int)) - 1; i >= 0; i--)
3070 ((int *) t)[i] = 0;
3071
3072 TREE_TYPE (t) = type;
3073 TREE_SET_CODE (t, code);
3074
3075 if (obstack == &permanent_obstack)
3076 TREE_PERMANENT (t) = 1;
3077
3078 TREE_OPERAND (t, 0) = node;
3079 if (node)
3080 {
3081 if (TREE_SIDE_EFFECTS (node))
3082 TREE_SIDE_EFFECTS (t) = 1;
3083 if (TREE_RAISES (node))
3084 TREE_RAISES (t) = 1;
3085 }
3086
3087 return t;
3088 }
3089
3090 /* Similar except don't specify the TREE_TYPE
3091 and leave the TREE_SIDE_EFFECTS as 0.
3092 It is permissible for arguments to be null,
3093 or even garbage if their values do not matter. */
3094
3095 tree
3096 build_nt VPROTO((enum tree_code code, ...))
3097 {
3098 #ifndef __STDC__
3099 enum tree_code code;
3100 #endif
3101 va_list p;
3102 register tree t;
3103 register int length;
3104 register int i;
3105
3106 VA_START (p, code);
3107
3108 #ifndef __STDC__
3109 code = va_arg (p, enum tree_code);
3110 #endif
3111
3112 t = make_node (code);
3113 length = tree_code_length[(int) code];
3114
3115 for (i = 0; i < length; i++)
3116 TREE_OPERAND (t, i) = va_arg (p, tree);
3117
3118 va_end (p);
3119 return t;
3120 }
3121
3122 /* Similar to `build_nt', except we build
3123 on the temp_decl_obstack, regardless. */
3124
3125 tree
3126 build_parse_node VPROTO((enum tree_code code, ...))
3127 {
3128 #ifndef __STDC__
3129 enum tree_code code;
3130 #endif
3131 register struct obstack *ambient_obstack = expression_obstack;
3132 va_list p;
3133 register tree t;
3134 register int length;
3135 register int i;
3136
3137 VA_START (p, code);
3138
3139 #ifndef __STDC__
3140 code = va_arg (p, enum tree_code);
3141 #endif
3142
3143 expression_obstack = &temp_decl_obstack;
3144
3145 t = make_node (code);
3146 length = tree_code_length[(int) code];
3147
3148 for (i = 0; i < length; i++)
3149 TREE_OPERAND (t, i) = va_arg (p, tree);
3150
3151 va_end (p);
3152 expression_obstack = ambient_obstack;
3153 return t;
3154 }
3155
3156 #if 0
3157 /* Commented out because this wants to be done very
3158 differently. See cp-lex.c. */
3159 tree
3160 build_op_identifier (op1, op2)
3161 tree op1, op2;
3162 {
3163 register tree t = make_node (OP_IDENTIFIER);
3164 TREE_PURPOSE (t) = op1;
3165 TREE_VALUE (t) = op2;
3166 return t;
3167 }
3168 #endif
3169 \f
3170 /* Create a DECL_... node of code CODE, name NAME and data type TYPE.
3171 We do NOT enter this node in any sort of symbol table.
3172
3173 layout_decl is used to set up the decl's storage layout.
3174 Other slots are initialized to 0 or null pointers. */
3175
3176 tree
3177 build_decl (code, name, type)
3178 enum tree_code code;
3179 tree name, type;
3180 {
3181 register tree t;
3182
3183 t = make_node (code);
3184
3185 /* if (type == error_mark_node)
3186 type = integer_type_node; */
3187 /* That is not done, deliberately, so that having error_mark_node
3188 as the type can suppress useless errors in the use of this variable. */
3189
3190 DECL_NAME (t) = name;
3191 DECL_ASSEMBLER_NAME (t) = name;
3192 TREE_TYPE (t) = type;
3193
3194 if (code == VAR_DECL || code == PARM_DECL || code == RESULT_DECL)
3195 layout_decl (t, 0);
3196 else if (code == FUNCTION_DECL)
3197 DECL_MODE (t) = FUNCTION_MODE;
3198
3199 return t;
3200 }
3201 \f
3202 /* BLOCK nodes are used to represent the structure of binding contours
3203 and declarations, once those contours have been exited and their contents
3204 compiled. This information is used for outputting debugging info. */
3205
3206 tree
3207 build_block (vars, tags, subblocks, supercontext, chain)
3208 tree vars, tags, subblocks, supercontext, chain;
3209 {
3210 register tree block = make_node (BLOCK);
3211 BLOCK_VARS (block) = vars;
3212 BLOCK_TYPE_TAGS (block) = tags;
3213 BLOCK_SUBBLOCKS (block) = subblocks;
3214 BLOCK_SUPERCONTEXT (block) = supercontext;
3215 BLOCK_CHAIN (block) = chain;
3216 return block;
3217 }
3218 \f
3219 /* Return a declaration like DDECL except that its DECL_MACHINE_ATTRIBUTE
3220 is ATTRIBUTE. */
3221
3222 tree
3223 build_decl_attribute_variant (ddecl, attribute)
3224 tree ddecl, attribute;
3225 {
3226 DECL_MACHINE_ATTRIBUTES (ddecl) = attribute;
3227 return ddecl;
3228 }
3229
3230 /* Return a type like TTYPE except that its TYPE_ATTRIBUTE
3231 is ATTRIBUTE.
3232
3233 Record such modified types already made so we don't make duplicates. */
3234
3235 tree
3236 build_type_attribute_variant (ttype, attribute)
3237 tree ttype, attribute;
3238 {
3239 if ( ! attribute_list_equal (TYPE_ATTRIBUTES (ttype), attribute))
3240 {
3241 register int hashcode;
3242 register struct obstack *ambient_obstack = current_obstack;
3243 tree ntype;
3244
3245 if (ambient_obstack != &permanent_obstack)
3246 current_obstack = TYPE_OBSTACK (ttype);
3247
3248 ntype = copy_node (ttype);
3249 current_obstack = ambient_obstack;
3250
3251 TYPE_POINTER_TO (ntype) = 0;
3252 TYPE_REFERENCE_TO (ntype) = 0;
3253 TYPE_ATTRIBUTES (ntype) = attribute;
3254
3255 /* Create a new main variant of TYPE. */
3256 TYPE_MAIN_VARIANT (ntype) = ntype;
3257 TYPE_NEXT_VARIANT (ntype) = 0;
3258 TYPE_READONLY (ntype) = TYPE_VOLATILE (ntype) = 0;
3259
3260 hashcode = TYPE_HASH (TREE_CODE (ntype))
3261 + TYPE_HASH (TREE_TYPE (ntype))
3262 + attribute_hash_list (attribute);
3263
3264 switch (TREE_CODE (ntype))
3265 {
3266 case FUNCTION_TYPE:
3267 hashcode += TYPE_HASH (TYPE_ARG_TYPES (ntype));
3268 break;
3269 case ARRAY_TYPE:
3270 hashcode += TYPE_HASH (TYPE_DOMAIN (ntype));
3271 break;
3272 case INTEGER_TYPE:
3273 hashcode += TYPE_HASH (TYPE_MAX_VALUE (ntype));
3274 break;
3275 case REAL_TYPE:
3276 hashcode += TYPE_HASH (TYPE_PRECISION (ntype));
3277 break;
3278 default:
3279 break;
3280 }
3281
3282 ntype = type_hash_canon (hashcode, ntype);
3283 ttype = build_type_variant (ntype, TYPE_READONLY (ttype),
3284 TYPE_VOLATILE (ttype));
3285 }
3286
3287 return ttype;
3288 }
3289
3290 /* Return a 1 if ATTR_NAME and ATTR_ARGS is valid for either declaration DECL
3291 or type TYPE and 0 otherwise. Validity is determined the configuration
3292 macros VALID_MACHINE_DECL_ATTRIBUTE and VALID_MACHINE_TYPE_ATTRIBUTE. */
3293
3294 int
3295 valid_machine_attribute (attr_name, attr_args, decl, type)
3296 tree attr_name, attr_args;
3297 tree decl;
3298 tree type;
3299 {
3300 int valid = 0;
3301 #ifdef VALID_MACHINE_DECL_ATTRIBUTE
3302 tree decl_attr_list = decl != 0 ? DECL_MACHINE_ATTRIBUTES (decl) : 0;
3303 #endif
3304 #ifdef VALID_MACHINE_TYPE_ATTRIBUTE
3305 tree type_attr_list = TYPE_ATTRIBUTES (type);
3306 #endif
3307
3308 if (TREE_CODE (attr_name) != IDENTIFIER_NODE)
3309 abort ();
3310
3311 #ifdef VALID_MACHINE_DECL_ATTRIBUTE
3312 if (decl != 0
3313 && VALID_MACHINE_DECL_ATTRIBUTE (decl, decl_attr_list, attr_name, attr_args))
3314 {
3315 tree attr = lookup_attribute (IDENTIFIER_POINTER (attr_name),
3316 decl_attr_list);
3317
3318 if (attr != NULL_TREE)
3319 {
3320 /* Override existing arguments. Declarations are unique so we can
3321 modify this in place. */
3322 TREE_VALUE (attr) = attr_args;
3323 }
3324 else
3325 {
3326 decl_attr_list = tree_cons (attr_name, attr_args, decl_attr_list);
3327 decl = build_decl_attribute_variant (decl, decl_attr_list);
3328 }
3329
3330 valid = 1;
3331 }
3332 #endif
3333
3334 #ifdef VALID_MACHINE_TYPE_ATTRIBUTE
3335 if (VALID_MACHINE_TYPE_ATTRIBUTE (type, type_attr_list, attr_name, attr_args))
3336 {
3337 tree attr = lookup_attribute (IDENTIFIER_POINTER (attr_name),
3338 type_attr_list);
3339
3340 if (attr != NULL_TREE)
3341 {
3342 /* Override existing arguments.
3343 ??? This currently works since attribute arguments are not
3344 included in `attribute_hash_list'. Something more complicated
3345 may be needed in the future. */
3346 TREE_VALUE (attr) = attr_args;
3347 }
3348 else
3349 {
3350 type_attr_list = tree_cons (attr_name, attr_args, type_attr_list);
3351 type = build_type_attribute_variant (type, type_attr_list);
3352 }
3353 if (decl != 0)
3354 TREE_TYPE (decl) = type;
3355 valid = 1;
3356 }
3357
3358 /* Handle putting a type attribute on pointer-to-function-type by putting
3359 the attribute on the function type. */
3360 else if (TREE_CODE (type) == POINTER_TYPE
3361 && TREE_CODE (TREE_TYPE (type)) == FUNCTION_TYPE
3362 && VALID_MACHINE_TYPE_ATTRIBUTE (TREE_TYPE (type), type_attr_list,
3363 attr_name, attr_args))
3364 {
3365 tree inner_type = TREE_TYPE (type);
3366 tree inner_attr_list = TYPE_ATTRIBUTES (inner_type);
3367 tree attr = lookup_attribute (IDENTIFIER_POINTER (attr_name),
3368 type_attr_list);
3369
3370 if (attr != NULL_TREE)
3371 TREE_VALUE (attr) = attr_args;
3372 else
3373 {
3374 inner_attr_list = tree_cons (attr_name, attr_args, inner_attr_list);
3375 inner_type = build_type_attribute_variant (inner_type,
3376 inner_attr_list);
3377 }
3378
3379 if (decl != 0)
3380 TREE_TYPE (decl) = build_pointer_type (inner_type);
3381
3382 valid = 1;
3383 }
3384 #endif
3385
3386 return valid;
3387 }
3388
3389 /* Return non-zero if IDENT is a valid name for attribute ATTR,
3390 or zero if not.
3391
3392 We try both `text' and `__text__', ATTR may be either one. */
3393 /* ??? It might be a reasonable simplification to require ATTR to be only
3394 `text'. One might then also require attribute lists to be stored in
3395 their canonicalized form. */
3396
3397 int
3398 is_attribute_p (attr, ident)
3399 char *attr;
3400 tree ident;
3401 {
3402 int ident_len, attr_len;
3403 char *p;
3404
3405 if (TREE_CODE (ident) != IDENTIFIER_NODE)
3406 return 0;
3407
3408 if (strcmp (attr, IDENTIFIER_POINTER (ident)) == 0)
3409 return 1;
3410
3411 p = IDENTIFIER_POINTER (ident);
3412 ident_len = strlen (p);
3413 attr_len = strlen (attr);
3414
3415 /* If ATTR is `__text__', IDENT must be `text'; and vice versa. */
3416 if (attr[0] == '_')
3417 {
3418 if (attr[1] != '_'
3419 || attr[attr_len - 2] != '_'
3420 || attr[attr_len - 1] != '_')
3421 abort ();
3422 if (ident_len == attr_len - 4
3423 && strncmp (attr + 2, p, attr_len - 4) == 0)
3424 return 1;
3425 }
3426 else
3427 {
3428 if (ident_len == attr_len + 4
3429 && p[0] == '_' && p[1] == '_'
3430 && p[ident_len - 2] == '_' && p[ident_len - 1] == '_'
3431 && strncmp (attr, p + 2, attr_len) == 0)
3432 return 1;
3433 }
3434
3435 return 0;
3436 }
3437
3438 /* Given an attribute name and a list of attributes, return a pointer to the
3439 attribute's list element if the attribute is part of the list, or NULL_TREE
3440 if not found. */
3441
3442 tree
3443 lookup_attribute (attr_name, list)
3444 char *attr_name;
3445 tree list;
3446 {
3447 tree l;
3448
3449 for (l = list; l; l = TREE_CHAIN (l))
3450 {
3451 if (TREE_CODE (TREE_PURPOSE (l)) != IDENTIFIER_NODE)
3452 abort ();
3453 if (is_attribute_p (attr_name, TREE_PURPOSE (l)))
3454 return l;
3455 }
3456
3457 return NULL_TREE;
3458 }
3459
3460 /* Return an attribute list that is the union of a1 and a2. */
3461
3462 tree
3463 merge_attributes (a1, a2)
3464 register tree a1, a2;
3465 {
3466 tree attributes;
3467
3468 /* Either one unset? Take the set one. */
3469
3470 if (! (attributes = a1))
3471 attributes = a2;
3472
3473 /* One that completely contains the other? Take it. */
3474
3475 else if (a2 && ! attribute_list_contained (a1, a2))
3476 {
3477 if (attribute_list_contained (a2, a1))
3478 attributes = a2;
3479 else
3480 {
3481 /* Pick the longest list, and hang on the other list. */
3482 /* ??? For the moment we punt on the issue of attrs with args. */
3483
3484 if (list_length (a1) < list_length (a2))
3485 attributes = a2, a2 = a1;
3486
3487 for (; a2; a2 = TREE_CHAIN (a2))
3488 if (lookup_attribute (IDENTIFIER_POINTER (TREE_PURPOSE (a2)),
3489 attributes) == NULL_TREE)
3490 {
3491 a1 = copy_node (a2);
3492 TREE_CHAIN (a1) = attributes;
3493 attributes = a1;
3494 }
3495 }
3496 }
3497 return attributes;
3498 }
3499
3500 /* Given types T1 and T2, merge their attributes and return
3501 the result. */
3502
3503 tree
3504 merge_machine_type_attributes (t1, t2)
3505 tree t1, t2;
3506 {
3507 #ifdef MERGE_MACHINE_TYPE_ATTRIBUTES
3508 return MERGE_MACHINE_TYPE_ATTRIBUTES (t1, t2);
3509 #else
3510 return merge_attributes (TYPE_ATTRIBUTES (t1),
3511 TYPE_ATTRIBUTES (t2));
3512 #endif
3513 }
3514
3515 /* Given decls OLDDECL and NEWDECL, merge their attributes and return
3516 the result. */
3517
3518 tree
3519 merge_machine_decl_attributes (olddecl, newdecl)
3520 tree olddecl, newdecl;
3521 {
3522 #ifdef MERGE_MACHINE_DECL_ATTRIBUTES
3523 return MERGE_MACHINE_DECL_ATTRIBUTES (olddecl, newdecl);
3524 #else
3525 return merge_attributes (DECL_MACHINE_ATTRIBUTES (olddecl),
3526 DECL_MACHINE_ATTRIBUTES (newdecl));
3527 #endif
3528 }
3529 \f
3530 /* Return a type like TYPE except that its TYPE_READONLY is CONSTP
3531 and its TYPE_VOLATILE is VOLATILEP.
3532
3533 Such variant types already made are recorded so that duplicates
3534 are not made.
3535
3536 A variant types should never be used as the type of an expression.
3537 Always copy the variant information into the TREE_READONLY
3538 and TREE_THIS_VOLATILE of the expression, and then give the expression
3539 as its type the "main variant", the variant whose TYPE_READONLY
3540 and TYPE_VOLATILE are zero. Use TYPE_MAIN_VARIANT to find the
3541 main variant. */
3542
3543 tree
3544 build_type_variant (type, constp, volatilep)
3545 tree type;
3546 int constp, volatilep;
3547 {
3548 register tree t;
3549
3550 /* Treat any nonzero argument as 1. */
3551 constp = !!constp;
3552 volatilep = !!volatilep;
3553
3554 /* Search the chain of variants to see if there is already one there just
3555 like the one we need to have. If so, use that existing one. We must
3556 preserve the TYPE_NAME, since there is code that depends on this. */
3557
3558 for (t = TYPE_MAIN_VARIANT (type); t; t = TYPE_NEXT_VARIANT (t))
3559 if (constp == TYPE_READONLY (t) && volatilep == TYPE_VOLATILE (t)
3560 && TYPE_NAME (t) == TYPE_NAME (type))
3561 return t;
3562
3563 /* We need a new one. */
3564
3565 t = build_type_copy (type);
3566 TYPE_READONLY (t) = constp;
3567 TYPE_VOLATILE (t) = volatilep;
3568
3569 return t;
3570 }
3571
3572 /* Create a new variant of TYPE, equivalent but distinct.
3573 This is so the caller can modify it. */
3574
3575 tree
3576 build_type_copy (type)
3577 tree type;
3578 {
3579 register tree t, m = TYPE_MAIN_VARIANT (type);
3580 register struct obstack *ambient_obstack = current_obstack;
3581
3582 current_obstack = TYPE_OBSTACK (type);
3583 t = copy_node (type);
3584 current_obstack = ambient_obstack;
3585
3586 TYPE_POINTER_TO (t) = 0;
3587 TYPE_REFERENCE_TO (t) = 0;
3588
3589 /* Add this type to the chain of variants of TYPE. */
3590 TYPE_NEXT_VARIANT (t) = TYPE_NEXT_VARIANT (m);
3591 TYPE_NEXT_VARIANT (m) = t;
3592
3593 return t;
3594 }
3595 \f
3596 /* Hashing of types so that we don't make duplicates.
3597 The entry point is `type_hash_canon'. */
3598
3599 /* Each hash table slot is a bucket containing a chain
3600 of these structures. */
3601
3602 struct type_hash
3603 {
3604 struct type_hash *next; /* Next structure in the bucket. */
3605 int hashcode; /* Hash code of this type. */
3606 tree type; /* The type recorded here. */
3607 };
3608
3609 /* Now here is the hash table. When recording a type, it is added
3610 to the slot whose index is the hash code mod the table size.
3611 Note that the hash table is used for several kinds of types
3612 (function types, array types and array index range types, for now).
3613 While all these live in the same table, they are completely independent,
3614 and the hash code is computed differently for each of these. */
3615
3616 #define TYPE_HASH_SIZE 59
3617 struct type_hash *type_hash_table[TYPE_HASH_SIZE];
3618
3619 /* Compute a hash code for a list of types (chain of TREE_LIST nodes
3620 with types in the TREE_VALUE slots), by adding the hash codes
3621 of the individual types. */
3622
3623 int
3624 type_hash_list (list)
3625 tree list;
3626 {
3627 register int hashcode;
3628 register tree tail;
3629 for (hashcode = 0, tail = list; tail; tail = TREE_CHAIN (tail))
3630 hashcode += TYPE_HASH (TREE_VALUE (tail));
3631 return hashcode;
3632 }
3633
3634 /* Look in the type hash table for a type isomorphic to TYPE.
3635 If one is found, return it. Otherwise return 0. */
3636
3637 tree
3638 type_hash_lookup (hashcode, type)
3639 int hashcode;
3640 tree type;
3641 {
3642 register struct type_hash *h;
3643 for (h = type_hash_table[hashcode % TYPE_HASH_SIZE]; h; h = h->next)
3644 if (h->hashcode == hashcode
3645 && TREE_CODE (h->type) == TREE_CODE (type)
3646 && TREE_TYPE (h->type) == TREE_TYPE (type)
3647 && attribute_list_equal (TYPE_ATTRIBUTES (h->type),
3648 TYPE_ATTRIBUTES (type))
3649 && (TYPE_MAX_VALUE (h->type) == TYPE_MAX_VALUE (type)
3650 || tree_int_cst_equal (TYPE_MAX_VALUE (h->type),
3651 TYPE_MAX_VALUE (type)))
3652 && (TYPE_MIN_VALUE (h->type) == TYPE_MIN_VALUE (type)
3653 || tree_int_cst_equal (TYPE_MIN_VALUE (h->type),
3654 TYPE_MIN_VALUE (type)))
3655 /* Note that TYPE_DOMAIN is TYPE_ARG_TYPES for FUNCTION_TYPE. */
3656 && (TYPE_DOMAIN (h->type) == TYPE_DOMAIN (type)
3657 || (TYPE_DOMAIN (h->type)
3658 && TREE_CODE (TYPE_DOMAIN (h->type)) == TREE_LIST
3659 && TYPE_DOMAIN (type)
3660 && TREE_CODE (TYPE_DOMAIN (type)) == TREE_LIST
3661 && type_list_equal (TYPE_DOMAIN (h->type),
3662 TYPE_DOMAIN (type)))))
3663 return h->type;
3664 return 0;
3665 }
3666
3667 /* Add an entry to the type-hash-table
3668 for a type TYPE whose hash code is HASHCODE. */
3669
3670 void
3671 type_hash_add (hashcode, type)
3672 int hashcode;
3673 tree type;
3674 {
3675 register struct type_hash *h;
3676
3677 h = (struct type_hash *) oballoc (sizeof (struct type_hash));
3678 h->hashcode = hashcode;
3679 h->type = type;
3680 h->next = type_hash_table[hashcode % TYPE_HASH_SIZE];
3681 type_hash_table[hashcode % TYPE_HASH_SIZE] = h;
3682 }
3683
3684 /* Given TYPE, and HASHCODE its hash code, return the canonical
3685 object for an identical type if one already exists.
3686 Otherwise, return TYPE, and record it as the canonical object
3687 if it is a permanent object.
3688
3689 To use this function, first create a type of the sort you want.
3690 Then compute its hash code from the fields of the type that
3691 make it different from other similar types.
3692 Then call this function and use the value.
3693 This function frees the type you pass in if it is a duplicate. */
3694
3695 /* Set to 1 to debug without canonicalization. Never set by program. */
3696 int debug_no_type_hash = 0;
3697
3698 tree
3699 type_hash_canon (hashcode, type)
3700 int hashcode;
3701 tree type;
3702 {
3703 tree t1;
3704
3705 if (debug_no_type_hash)
3706 return type;
3707
3708 t1 = type_hash_lookup (hashcode, type);
3709 if (t1 != 0)
3710 {
3711 obstack_free (TYPE_OBSTACK (type), type);
3712 #ifdef GATHER_STATISTICS
3713 tree_node_counts[(int)t_kind]--;
3714 tree_node_sizes[(int)t_kind] -= sizeof (struct tree_type);
3715 #endif
3716 return t1;
3717 }
3718
3719 /* If this is a permanent type, record it for later reuse. */
3720 if (TREE_PERMANENT (type))
3721 type_hash_add (hashcode, type);
3722
3723 return type;
3724 }
3725
3726 /* Compute a hash code for a list of attributes (chain of TREE_LIST nodes
3727 with names in the TREE_PURPOSE slots and args in the TREE_VALUE slots),
3728 by adding the hash codes of the individual attributes. */
3729
3730 int
3731 attribute_hash_list (list)
3732 tree list;
3733 {
3734 register int hashcode;
3735 register tree tail;
3736 for (hashcode = 0, tail = list; tail; tail = TREE_CHAIN (tail))
3737 /* ??? Do we want to add in TREE_VALUE too? */
3738 hashcode += TYPE_HASH (TREE_PURPOSE (tail));
3739 return hashcode;
3740 }
3741
3742 /* Given two lists of attributes, return true if list l2 is
3743 equivalent to l1. */
3744
3745 int
3746 attribute_list_equal (l1, l2)
3747 tree l1, l2;
3748 {
3749 return attribute_list_contained (l1, l2)
3750 && attribute_list_contained (l2, l1);
3751 }
3752
3753 /* Given two lists of attributes, return true if list L2 is
3754 completely contained within L1. */
3755 /* ??? This would be faster if attribute names were stored in a canonicalized
3756 form. Otherwise, if L1 uses `foo' and L2 uses `__foo__', the long method
3757 must be used to show these elements are equivalent (which they are). */
3758 /* ??? It's not clear that attributes with arguments will always be handled
3759 correctly. */
3760
3761 int
3762 attribute_list_contained (l1, l2)
3763 tree l1, l2;
3764 {
3765 register tree t1, t2;
3766
3767 /* First check the obvious, maybe the lists are identical. */
3768 if (l1 == l2)
3769 return 1;
3770
3771 /* Maybe the lists are similar. */
3772 for (t1 = l1, t2 = l2;
3773 t1 && t2
3774 && TREE_PURPOSE (t1) == TREE_PURPOSE (t2)
3775 && TREE_VALUE (t1) == TREE_VALUE (t2);
3776 t1 = TREE_CHAIN (t1), t2 = TREE_CHAIN (t2));
3777
3778 /* Maybe the lists are equal. */
3779 if (t1 == 0 && t2 == 0)
3780 return 1;
3781
3782 for (; t2; t2 = TREE_CHAIN (t2))
3783 {
3784 tree attr
3785 = lookup_attribute (IDENTIFIER_POINTER (TREE_PURPOSE (t2)), l1);
3786
3787 if (attr == NULL_TREE)
3788 return 0;
3789 if (simple_cst_equal (TREE_VALUE (t2), TREE_VALUE (attr)) != 1)
3790 return 0;
3791 }
3792
3793 return 1;
3794 }
3795
3796 /* Given two lists of types
3797 (chains of TREE_LIST nodes with types in the TREE_VALUE slots)
3798 return 1 if the lists contain the same types in the same order.
3799 Also, the TREE_PURPOSEs must match. */
3800
3801 int
3802 type_list_equal (l1, l2)
3803 tree l1, l2;
3804 {
3805 register tree t1, t2;
3806
3807 for (t1 = l1, t2 = l2; t1 && t2; t1 = TREE_CHAIN (t1), t2 = TREE_CHAIN (t2))
3808 if (TREE_VALUE (t1) != TREE_VALUE (t2)
3809 || (TREE_PURPOSE (t1) != TREE_PURPOSE (t2)
3810 && ! (1 == simple_cst_equal (TREE_PURPOSE (t1), TREE_PURPOSE (t2))
3811 && (TREE_TYPE (TREE_PURPOSE (t1))
3812 == TREE_TYPE (TREE_PURPOSE (t2))))))
3813 return 0;
3814
3815 return t1 == t2;
3816 }
3817
3818 /* Nonzero if integer constants T1 and T2
3819 represent the same constant value. */
3820
3821 int
3822 tree_int_cst_equal (t1, t2)
3823 tree t1, t2;
3824 {
3825 if (t1 == t2)
3826 return 1;
3827 if (t1 == 0 || t2 == 0)
3828 return 0;
3829 if (TREE_CODE (t1) == INTEGER_CST
3830 && TREE_CODE (t2) == INTEGER_CST
3831 && TREE_INT_CST_LOW (t1) == TREE_INT_CST_LOW (t2)
3832 && TREE_INT_CST_HIGH (t1) == TREE_INT_CST_HIGH (t2))
3833 return 1;
3834 return 0;
3835 }
3836
3837 /* Nonzero if integer constants T1 and T2 represent values that satisfy <.
3838 The precise way of comparison depends on their data type. */
3839
3840 int
3841 tree_int_cst_lt (t1, t2)
3842 tree t1, t2;
3843 {
3844 if (t1 == t2)
3845 return 0;
3846
3847 if (!TREE_UNSIGNED (TREE_TYPE (t1)))
3848 return INT_CST_LT (t1, t2);
3849 return INT_CST_LT_UNSIGNED (t1, t2);
3850 }
3851
3852 /* Return an indication of the sign of the integer constant T.
3853 The return value is -1 if T < 0, 0 if T == 0, and 1 if T > 0.
3854 Note that -1 will never be returned it T's type is unsigned. */
3855
3856 int
3857 tree_int_cst_sgn (t)
3858 tree t;
3859 {
3860 if (TREE_INT_CST_LOW (t) == 0 && TREE_INT_CST_HIGH (t) == 0)
3861 return 0;
3862 else if (TREE_UNSIGNED (TREE_TYPE (t)))
3863 return 1;
3864 else if (TREE_INT_CST_HIGH (t) < 0)
3865 return -1;
3866 else
3867 return 1;
3868 }
3869
3870 /* Compare two constructor-element-type constants. Return 1 if the lists
3871 are known to be equal; otherwise return 0. */
3872
3873 int
3874 simple_cst_list_equal (l1, l2)
3875 tree l1, l2;
3876 {
3877 while (l1 != NULL_TREE && l2 != NULL_TREE)
3878 {
3879 if (simple_cst_equal (TREE_VALUE (l1), TREE_VALUE (l2)) != 1)
3880 return 0;
3881
3882 l1 = TREE_CHAIN (l1);
3883 l2 = TREE_CHAIN (l2);
3884 }
3885
3886 return (l1 == l2);
3887 }
3888
3889 /* Return truthvalue of whether T1 is the same tree structure as T2.
3890 Return 1 if they are the same.
3891 Return 0 if they are understandably different.
3892 Return -1 if either contains tree structure not understood by
3893 this function. */
3894
3895 int
3896 simple_cst_equal (t1, t2)
3897 tree t1, t2;
3898 {
3899 register enum tree_code code1, code2;
3900 int cmp;
3901
3902 if (t1 == t2)
3903 return 1;
3904 if (t1 == 0 || t2 == 0)
3905 return 0;
3906
3907 code1 = TREE_CODE (t1);
3908 code2 = TREE_CODE (t2);
3909
3910 if (code1 == NOP_EXPR || code1 == CONVERT_EXPR || code1 == NON_LVALUE_EXPR)
3911 if (code2 == NOP_EXPR || code2 == CONVERT_EXPR || code2 == NON_LVALUE_EXPR)
3912 return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3913 else
3914 return simple_cst_equal (TREE_OPERAND (t1, 0), t2);
3915 else if (code2 == NOP_EXPR || code2 == CONVERT_EXPR
3916 || code2 == NON_LVALUE_EXPR)
3917 return simple_cst_equal (t1, TREE_OPERAND (t2, 0));
3918
3919 if (code1 != code2)
3920 return 0;
3921
3922 switch (code1)
3923 {
3924 case INTEGER_CST:
3925 return TREE_INT_CST_LOW (t1) == TREE_INT_CST_LOW (t2)
3926 && TREE_INT_CST_HIGH (t1) == TREE_INT_CST_HIGH (t2);
3927
3928 case REAL_CST:
3929 return REAL_VALUES_IDENTICAL (TREE_REAL_CST (t1), TREE_REAL_CST (t2));
3930
3931 case STRING_CST:
3932 return TREE_STRING_LENGTH (t1) == TREE_STRING_LENGTH (t2)
3933 && !bcmp (TREE_STRING_POINTER (t1), TREE_STRING_POINTER (t2),
3934 TREE_STRING_LENGTH (t1));
3935
3936 case CONSTRUCTOR:
3937 abort ();
3938
3939 case SAVE_EXPR:
3940 return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3941
3942 case CALL_EXPR:
3943 cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3944 if (cmp <= 0)
3945 return cmp;
3946 return simple_cst_list_equal (TREE_OPERAND (t1, 1), TREE_OPERAND (t2, 1));
3947
3948 case TARGET_EXPR:
3949 /* Special case: if either target is an unallocated VAR_DECL,
3950 it means that it's going to be unified with whatever the
3951 TARGET_EXPR is really supposed to initialize, so treat it
3952 as being equivalent to anything. */
3953 if ((TREE_CODE (TREE_OPERAND (t1, 0)) == VAR_DECL
3954 && DECL_NAME (TREE_OPERAND (t1, 0)) == NULL_TREE
3955 && DECL_RTL (TREE_OPERAND (t1, 0)) == 0)
3956 || (TREE_CODE (TREE_OPERAND (t2, 0)) == VAR_DECL
3957 && DECL_NAME (TREE_OPERAND (t2, 0)) == NULL_TREE
3958 && DECL_RTL (TREE_OPERAND (t2, 0)) == 0))
3959 cmp = 1;
3960 else
3961 cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3962 if (cmp <= 0)
3963 return cmp;
3964 return simple_cst_equal (TREE_OPERAND (t1, 1), TREE_OPERAND (t2, 1));
3965
3966 case WITH_CLEANUP_EXPR:
3967 cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3968 if (cmp <= 0)
3969 return cmp;
3970 return simple_cst_equal (TREE_OPERAND (t1, 2), TREE_OPERAND (t1, 2));
3971
3972 case COMPONENT_REF:
3973 if (TREE_OPERAND (t1, 1) == TREE_OPERAND (t2, 1))
3974 return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3975 return 0;
3976
3977 case VAR_DECL:
3978 case PARM_DECL:
3979 case CONST_DECL:
3980 case FUNCTION_DECL:
3981 return 0;
3982
3983 default:
3984 break;
3985 }
3986
3987 /* This general rule works for most tree codes. All exceptions should be
3988 handled above. If this is a language-specific tree code, we can't
3989 trust what might be in the operand, so say we don't know
3990 the situation. */
3991 if ((int) code1 >= (int) LAST_AND_UNUSED_TREE_CODE)
3992 return -1;
3993
3994 switch (TREE_CODE_CLASS (code1))
3995 {
3996 int i;
3997 case '1':
3998 case '2':
3999 case '<':
4000 case 'e':
4001 case 'r':
4002 case 's':
4003 cmp = 1;
4004 for (i=0; i<tree_code_length[(int) code1]; ++i)
4005 {
4006 cmp = simple_cst_equal (TREE_OPERAND (t1, i), TREE_OPERAND (t2, i));
4007 if (cmp <= 0)
4008 return cmp;
4009 }
4010 return cmp;
4011
4012 default:
4013 return -1;
4014 }
4015 }
4016 \f
4017 /* Constructors for pointer, array and function types.
4018 (RECORD_TYPE, UNION_TYPE and ENUMERAL_TYPE nodes are
4019 constructed by language-dependent code, not here.) */
4020
4021 /* Construct, lay out and return the type of pointers to TO_TYPE.
4022 If such a type has already been constructed, reuse it. */
4023
4024 tree
4025 build_pointer_type (to_type)
4026 tree to_type;
4027 {
4028 register tree t = TYPE_POINTER_TO (to_type);
4029
4030 /* First, if we already have a type for pointers to TO_TYPE, use it. */
4031
4032 if (t)
4033 return t;
4034
4035 /* We need a new one. Put this in the same obstack as TO_TYPE. */
4036 push_obstacks (TYPE_OBSTACK (to_type), TYPE_OBSTACK (to_type));
4037 t = make_node (POINTER_TYPE);
4038 pop_obstacks ();
4039
4040 TREE_TYPE (t) = to_type;
4041
4042 /* Record this type as the pointer to TO_TYPE. */
4043 TYPE_POINTER_TO (to_type) = t;
4044
4045 /* Lay out the type. This function has many callers that are concerned
4046 with expression-construction, and this simplifies them all.
4047 Also, it guarantees the TYPE_SIZE is in the same obstack as the type. */
4048 layout_type (t);
4049
4050 return t;
4051 }
4052
4053 /* Create a type of integers to be the TYPE_DOMAIN of an ARRAY_TYPE.
4054 MAXVAL should be the maximum value in the domain
4055 (one less than the length of the array).
4056
4057 The maximum value that MAXVAL can have is INT_MAX for a HOST_WIDE_INT.
4058 We don't enforce this limit, that is up to caller (e.g. language front end).
4059 The limit exists because the result is a signed type and we don't handle
4060 sizes that use more than one HOST_WIDE_INT. */
4061
4062 tree
4063 build_index_type (maxval)
4064 tree maxval;
4065 {
4066 register tree itype = make_node (INTEGER_TYPE);
4067
4068 TYPE_PRECISION (itype) = TYPE_PRECISION (sizetype);
4069 TYPE_MIN_VALUE (itype) = size_zero_node;
4070
4071 push_obstacks (TYPE_OBSTACK (itype), TYPE_OBSTACK (itype));
4072 TYPE_MAX_VALUE (itype) = convert (sizetype, maxval);
4073 pop_obstacks ();
4074
4075 TYPE_MODE (itype) = TYPE_MODE (sizetype);
4076 TYPE_SIZE (itype) = TYPE_SIZE (sizetype);
4077 TYPE_ALIGN (itype) = TYPE_ALIGN (sizetype);
4078 if (TREE_CODE (maxval) == INTEGER_CST)
4079 {
4080 int maxint = (int) TREE_INT_CST_LOW (maxval);
4081 /* If the domain should be empty, make sure the maxval
4082 remains -1 and is not spoiled by truncation. */
4083 if (INT_CST_LT (maxval, integer_zero_node))
4084 {
4085 TYPE_MAX_VALUE (itype) = build_int_2 (-1, -1);
4086 TREE_TYPE (TYPE_MAX_VALUE (itype)) = sizetype;
4087 }
4088 return type_hash_canon (maxint < 0 ? ~maxint : maxint, itype);
4089 }
4090 else
4091 return itype;
4092 }
4093
4094 /* Create a range of some discrete type TYPE (an INTEGER_TYPE,
4095 ENUMERAL_TYPE, BOOLEAN_TYPE, or CHAR_TYPE), with
4096 low bound LOWVAL and high bound HIGHVAL.
4097 if TYPE==NULL_TREE, sizetype is used. */
4098
4099 tree
4100 build_range_type (type, lowval, highval)
4101 tree type, lowval, highval;
4102 {
4103 register tree itype = make_node (INTEGER_TYPE);
4104
4105 TREE_TYPE (itype) = type;
4106 if (type == NULL_TREE)
4107 type = sizetype;
4108
4109 push_obstacks (TYPE_OBSTACK (itype), TYPE_OBSTACK (itype));
4110 TYPE_MIN_VALUE (itype) = convert (type, lowval);
4111 TYPE_MAX_VALUE (itype) = highval ? convert (type, highval) : NULL;
4112 pop_obstacks ();
4113
4114 TYPE_PRECISION (itype) = TYPE_PRECISION (type);
4115 TYPE_MODE (itype) = TYPE_MODE (type);
4116 TYPE_SIZE (itype) = TYPE_SIZE (type);
4117 TYPE_ALIGN (itype) = TYPE_ALIGN (type);
4118 if (TREE_CODE (lowval) == INTEGER_CST)
4119 {
4120 HOST_WIDE_INT lowint, highint;
4121 int maxint;
4122
4123 lowint = TREE_INT_CST_LOW (lowval);
4124 if (highval && TREE_CODE (highval) == INTEGER_CST)
4125 highint = TREE_INT_CST_LOW (highval);
4126 else
4127 highint = (~(unsigned HOST_WIDE_INT)0) >> 1;
4128
4129 maxint = (int) (highint - lowint);
4130 return type_hash_canon (maxint < 0 ? ~maxint : maxint, itype);
4131 }
4132 else
4133 return itype;
4134 }
4135
4136 /* Just like build_index_type, but takes lowval and highval instead
4137 of just highval (maxval). */
4138
4139 tree
4140 build_index_2_type (lowval,highval)
4141 tree lowval, highval;
4142 {
4143 return build_range_type (NULL_TREE, lowval, highval);
4144 }
4145
4146 /* Return nonzero iff ITYPE1 and ITYPE2 are equal (in the LISP sense).
4147 Needed because when index types are not hashed, equal index types
4148 built at different times appear distinct, even though structurally,
4149 they are not. */
4150
4151 int
4152 index_type_equal (itype1, itype2)
4153 tree itype1, itype2;
4154 {
4155 if (TREE_CODE (itype1) != TREE_CODE (itype2))
4156 return 0;
4157 if (TREE_CODE (itype1) == INTEGER_TYPE)
4158 {
4159 if (TYPE_PRECISION (itype1) != TYPE_PRECISION (itype2)
4160 || TYPE_MODE (itype1) != TYPE_MODE (itype2)
4161 || simple_cst_equal (TYPE_SIZE (itype1), TYPE_SIZE (itype2)) != 1
4162 || TYPE_ALIGN (itype1) != TYPE_ALIGN (itype2))
4163 return 0;
4164 if (1 == simple_cst_equal (TYPE_MIN_VALUE (itype1),
4165 TYPE_MIN_VALUE (itype2))
4166 && 1 == simple_cst_equal (TYPE_MAX_VALUE (itype1),
4167 TYPE_MAX_VALUE (itype2)))
4168 return 1;
4169 }
4170
4171 return 0;
4172 }
4173
4174 /* Construct, lay out and return the type of arrays of elements with ELT_TYPE
4175 and number of elements specified by the range of values of INDEX_TYPE.
4176 If such a type has already been constructed, reuse it. */
4177
4178 tree
4179 build_array_type (elt_type, index_type)
4180 tree elt_type, index_type;
4181 {
4182 register tree t;
4183 int hashcode;
4184
4185 if (TREE_CODE (elt_type) == FUNCTION_TYPE)
4186 {
4187 error ("arrays of functions are not meaningful");
4188 elt_type = integer_type_node;
4189 }
4190
4191 /* Make sure TYPE_POINTER_TO (elt_type) is filled in. */
4192 build_pointer_type (elt_type);
4193
4194 /* Allocate the array after the pointer type,
4195 in case we free it in type_hash_canon. */
4196 t = make_node (ARRAY_TYPE);
4197 TREE_TYPE (t) = elt_type;
4198 TYPE_DOMAIN (t) = index_type;
4199
4200 if (index_type == 0)
4201 {
4202 return t;
4203 }
4204
4205 hashcode = TYPE_HASH (elt_type) + TYPE_HASH (index_type);
4206 t = type_hash_canon (hashcode, t);
4207
4208 if (TYPE_SIZE (t) == 0)
4209 layout_type (t);
4210 return t;
4211 }
4212
4213 /* Construct, lay out and return
4214 the type of functions returning type VALUE_TYPE
4215 given arguments of types ARG_TYPES.
4216 ARG_TYPES is a chain of TREE_LIST nodes whose TREE_VALUEs
4217 are data type nodes for the arguments of the function.
4218 If such a type has already been constructed, reuse it. */
4219
4220 tree
4221 build_function_type (value_type, arg_types)
4222 tree value_type, arg_types;
4223 {
4224 register tree t;
4225 int hashcode;
4226
4227 if (TREE_CODE (value_type) == FUNCTION_TYPE)
4228 {
4229 error ("function return type cannot be function");
4230 value_type = integer_type_node;
4231 }
4232
4233 /* Make a node of the sort we want. */
4234 t = make_node (FUNCTION_TYPE);
4235 TREE_TYPE (t) = value_type;
4236 TYPE_ARG_TYPES (t) = arg_types;
4237
4238 /* If we already have such a type, use the old one and free this one. */
4239 hashcode = TYPE_HASH (value_type) + type_hash_list (arg_types);
4240 t = type_hash_canon (hashcode, t);
4241
4242 if (TYPE_SIZE (t) == 0)
4243 layout_type (t);
4244 return t;
4245 }
4246
4247 /* Build the node for the type of references-to-TO_TYPE. */
4248
4249 tree
4250 build_reference_type (to_type)
4251 tree to_type;
4252 {
4253 register tree t = TYPE_REFERENCE_TO (to_type);
4254 register struct obstack *ambient_obstack = current_obstack;
4255 register struct obstack *ambient_saveable_obstack = saveable_obstack;
4256
4257 /* First, if we already have a type for pointers to TO_TYPE, use it. */
4258
4259 if (t)
4260 return t;
4261
4262 /* We need a new one. If TO_TYPE is permanent, make this permanent too. */
4263 if (TREE_PERMANENT (to_type))
4264 {
4265 current_obstack = &permanent_obstack;
4266 saveable_obstack = &permanent_obstack;
4267 }
4268
4269 t = make_node (REFERENCE_TYPE);
4270 TREE_TYPE (t) = to_type;
4271
4272 /* Record this type as the pointer to TO_TYPE. */
4273 TYPE_REFERENCE_TO (to_type) = t;
4274
4275 layout_type (t);
4276
4277 current_obstack = ambient_obstack;
4278 saveable_obstack = ambient_saveable_obstack;
4279 return t;
4280 }
4281
4282 /* Construct, lay out and return the type of methods belonging to class
4283 BASETYPE and whose arguments and values are described by TYPE.
4284 If that type exists already, reuse it.
4285 TYPE must be a FUNCTION_TYPE node. */
4286
4287 tree
4288 build_method_type (basetype, type)
4289 tree basetype, type;
4290 {
4291 register tree t;
4292 int hashcode;
4293
4294 /* Make a node of the sort we want. */
4295 t = make_node (METHOD_TYPE);
4296
4297 if (TREE_CODE (type) != FUNCTION_TYPE)
4298 abort ();
4299
4300 TYPE_METHOD_BASETYPE (t) = TYPE_MAIN_VARIANT (basetype);
4301 TREE_TYPE (t) = TREE_TYPE (type);
4302
4303 /* The actual arglist for this function includes a "hidden" argument
4304 which is "this". Put it into the list of argument types. */
4305
4306 TYPE_ARG_TYPES (t)
4307 = tree_cons (NULL_TREE,
4308 build_pointer_type (basetype), TYPE_ARG_TYPES (type));
4309
4310 /* If we already have such a type, use the old one and free this one. */
4311 hashcode = TYPE_HASH (basetype) + TYPE_HASH (type);
4312 t = type_hash_canon (hashcode, t);
4313
4314 if (TYPE_SIZE (t) == 0)
4315 layout_type (t);
4316
4317 return t;
4318 }
4319
4320 /* Construct, lay out and return the type of offsets to a value
4321 of type TYPE, within an object of type BASETYPE.
4322 If a suitable offset type exists already, reuse it. */
4323
4324 tree
4325 build_offset_type (basetype, type)
4326 tree basetype, type;
4327 {
4328 register tree t;
4329 int hashcode;
4330
4331 /* Make a node of the sort we want. */
4332 t = make_node (OFFSET_TYPE);
4333
4334 TYPE_OFFSET_BASETYPE (t) = TYPE_MAIN_VARIANT (basetype);
4335 TREE_TYPE (t) = type;
4336
4337 /* If we already have such a type, use the old one and free this one. */
4338 hashcode = TYPE_HASH (basetype) + TYPE_HASH (type);
4339 t = type_hash_canon (hashcode, t);
4340
4341 if (TYPE_SIZE (t) == 0)
4342 layout_type (t);
4343
4344 return t;
4345 }
4346
4347 /* Create a complex type whose components are COMPONENT_TYPE. */
4348
4349 tree
4350 build_complex_type (component_type)
4351 tree component_type;
4352 {
4353 register tree t;
4354 int hashcode;
4355
4356 /* Make a node of the sort we want. */
4357 t = make_node (COMPLEX_TYPE);
4358
4359 TREE_TYPE (t) = TYPE_MAIN_VARIANT (component_type);
4360 TYPE_VOLATILE (t) = TYPE_VOLATILE (component_type);
4361 TYPE_READONLY (t) = TYPE_READONLY (component_type);
4362
4363 /* If we already have such a type, use the old one and free this one. */
4364 hashcode = TYPE_HASH (component_type);
4365 t = type_hash_canon (hashcode, t);
4366
4367 if (TYPE_SIZE (t) == 0)
4368 layout_type (t);
4369
4370 return t;
4371 }
4372 \f
4373 /* Return OP, stripped of any conversions to wider types as much as is safe.
4374 Converting the value back to OP's type makes a value equivalent to OP.
4375
4376 If FOR_TYPE is nonzero, we return a value which, if converted to
4377 type FOR_TYPE, would be equivalent to converting OP to type FOR_TYPE.
4378
4379 If FOR_TYPE is nonzero, unaligned bit-field references may be changed to the
4380 narrowest type that can hold the value, even if they don't exactly fit.
4381 Otherwise, bit-field references are changed to a narrower type
4382 only if they can be fetched directly from memory in that type.
4383
4384 OP must have integer, real or enumeral type. Pointers are not allowed!
4385
4386 There are some cases where the obvious value we could return
4387 would regenerate to OP if converted to OP's type,
4388 but would not extend like OP to wider types.
4389 If FOR_TYPE indicates such extension is contemplated, we eschew such values.
4390 For example, if OP is (unsigned short)(signed char)-1,
4391 we avoid returning (signed char)-1 if FOR_TYPE is int,
4392 even though extending that to an unsigned short would regenerate OP,
4393 since the result of extending (signed char)-1 to (int)
4394 is different from (int) OP. */
4395
4396 tree
4397 get_unwidened (op, for_type)
4398 register tree op;
4399 tree for_type;
4400 {
4401 /* Set UNS initially if converting OP to FOR_TYPE is a zero-extension. */
4402 /* TYPE_PRECISION is safe in place of type_precision since
4403 pointer types are not allowed. */
4404 register tree type = TREE_TYPE (op);
4405 register unsigned final_prec
4406 = TYPE_PRECISION (for_type != 0 ? for_type : type);
4407 register int uns
4408 = (for_type != 0 && for_type != type
4409 && final_prec > TYPE_PRECISION (type)
4410 && TREE_UNSIGNED (type));
4411 register tree win = op;
4412
4413 while (TREE_CODE (op) == NOP_EXPR)
4414 {
4415 register int bitschange
4416 = TYPE_PRECISION (TREE_TYPE (op))
4417 - TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (op, 0)));
4418
4419 /* Truncations are many-one so cannot be removed.
4420 Unless we are later going to truncate down even farther. */
4421 if (bitschange < 0
4422 && final_prec > TYPE_PRECISION (TREE_TYPE (op)))
4423 break;
4424
4425 /* See what's inside this conversion. If we decide to strip it,
4426 we will set WIN. */
4427 op = TREE_OPERAND (op, 0);
4428
4429 /* If we have not stripped any zero-extensions (uns is 0),
4430 we can strip any kind of extension.
4431 If we have previously stripped a zero-extension,
4432 only zero-extensions can safely be stripped.
4433 Any extension can be stripped if the bits it would produce
4434 are all going to be discarded later by truncating to FOR_TYPE. */
4435
4436 if (bitschange > 0)
4437 {
4438 if (! uns || final_prec <= TYPE_PRECISION (TREE_TYPE (op)))
4439 win = op;
4440 /* TREE_UNSIGNED says whether this is a zero-extension.
4441 Let's avoid computing it if it does not affect WIN
4442 and if UNS will not be needed again. */
4443 if ((uns || TREE_CODE (op) == NOP_EXPR)
4444 && TREE_UNSIGNED (TREE_TYPE (op)))
4445 {
4446 uns = 1;
4447 win = op;
4448 }
4449 }
4450 }
4451
4452 if (TREE_CODE (op) == COMPONENT_REF
4453 /* Since type_for_size always gives an integer type. */
4454 && TREE_CODE (type) != REAL_TYPE
4455 /* Don't crash if field not laid out yet. */
4456 && DECL_SIZE (TREE_OPERAND (op, 1)) != 0)
4457 {
4458 unsigned innerprec = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1)));
4459 type = type_for_size (innerprec, TREE_UNSIGNED (TREE_OPERAND (op, 1)));
4460
4461 /* We can get this structure field in the narrowest type it fits in.
4462 If FOR_TYPE is 0, do this only for a field that matches the
4463 narrower type exactly and is aligned for it
4464 The resulting extension to its nominal type (a fullword type)
4465 must fit the same conditions as for other extensions. */
4466
4467 if (innerprec < TYPE_PRECISION (TREE_TYPE (op))
4468 && (for_type || ! DECL_BIT_FIELD (TREE_OPERAND (op, 1)))
4469 && (! uns || final_prec <= innerprec
4470 || TREE_UNSIGNED (TREE_OPERAND (op, 1)))
4471 && type != 0)
4472 {
4473 win = build (COMPONENT_REF, type, TREE_OPERAND (op, 0),
4474 TREE_OPERAND (op, 1));
4475 TREE_SIDE_EFFECTS (win) = TREE_SIDE_EFFECTS (op);
4476 TREE_THIS_VOLATILE (win) = TREE_THIS_VOLATILE (op);
4477 TREE_RAISES (win) = TREE_RAISES (op);
4478 }
4479 }
4480 return win;
4481 }
4482 \f
4483 /* Return OP or a simpler expression for a narrower value
4484 which can be sign-extended or zero-extended to give back OP.
4485 Store in *UNSIGNEDP_PTR either 1 if the value should be zero-extended
4486 or 0 if the value should be sign-extended. */
4487
4488 tree
4489 get_narrower (op, unsignedp_ptr)
4490 register tree op;
4491 int *unsignedp_ptr;
4492 {
4493 register int uns = 0;
4494 int first = 1;
4495 register tree win = op;
4496
4497 while (TREE_CODE (op) == NOP_EXPR)
4498 {
4499 register int bitschange
4500 = TYPE_PRECISION (TREE_TYPE (op))
4501 - TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (op, 0)));
4502
4503 /* Truncations are many-one so cannot be removed. */
4504 if (bitschange < 0)
4505 break;
4506
4507 /* See what's inside this conversion. If we decide to strip it,
4508 we will set WIN. */
4509 op = TREE_OPERAND (op, 0);
4510
4511 if (bitschange > 0)
4512 {
4513 /* An extension: the outermost one can be stripped,
4514 but remember whether it is zero or sign extension. */
4515 if (first)
4516 uns = TREE_UNSIGNED (TREE_TYPE (op));
4517 /* Otherwise, if a sign extension has been stripped,
4518 only sign extensions can now be stripped;
4519 if a zero extension has been stripped, only zero-extensions. */
4520 else if (uns != TREE_UNSIGNED (TREE_TYPE (op)))
4521 break;
4522 first = 0;
4523 }
4524 else /* bitschange == 0 */
4525 {
4526 /* A change in nominal type can always be stripped, but we must
4527 preserve the unsignedness. */
4528 if (first)
4529 uns = TREE_UNSIGNED (TREE_TYPE (op));
4530 first = 0;
4531 }
4532
4533 win = op;
4534 }
4535
4536 if (TREE_CODE (op) == COMPONENT_REF
4537 /* Since type_for_size always gives an integer type. */
4538 && TREE_CODE (TREE_TYPE (op)) != REAL_TYPE)
4539 {
4540 unsigned innerprec = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1)));
4541 tree type = type_for_size (innerprec, TREE_UNSIGNED (op));
4542
4543 /* We can get this structure field in a narrower type that fits it,
4544 but the resulting extension to its nominal type (a fullword type)
4545 must satisfy the same conditions as for other extensions.
4546
4547 Do this only for fields that are aligned (not bit-fields),
4548 because when bit-field insns will be used there is no
4549 advantage in doing this. */
4550
4551 if (innerprec < TYPE_PRECISION (TREE_TYPE (op))
4552 && ! DECL_BIT_FIELD (TREE_OPERAND (op, 1))
4553 && (first || uns == TREE_UNSIGNED (TREE_OPERAND (op, 1)))
4554 && type != 0)
4555 {
4556 if (first)
4557 uns = TREE_UNSIGNED (TREE_OPERAND (op, 1));
4558 win = build (COMPONENT_REF, type, TREE_OPERAND (op, 0),
4559 TREE_OPERAND (op, 1));
4560 TREE_SIDE_EFFECTS (win) = TREE_SIDE_EFFECTS (op);
4561 TREE_THIS_VOLATILE (win) = TREE_THIS_VOLATILE (op);
4562 TREE_RAISES (win) = TREE_RAISES (op);
4563 }
4564 }
4565 *unsignedp_ptr = uns;
4566 return win;
4567 }
4568 \f
4569 /* Return the precision of a type, for arithmetic purposes.
4570 Supports all types on which arithmetic is possible
4571 (including pointer types).
4572 It's not clear yet what will be right for complex types. */
4573
4574 int
4575 type_precision (type)
4576 register tree type;
4577 {
4578 return ((TREE_CODE (type) == INTEGER_TYPE
4579 || TREE_CODE (type) == ENUMERAL_TYPE
4580 || TREE_CODE (type) == REAL_TYPE)
4581 ? TYPE_PRECISION (type) : POINTER_SIZE);
4582 }
4583
4584 /* Nonzero if integer constant C has a value that is permissible
4585 for type TYPE (an INTEGER_TYPE). */
4586
4587 int
4588 int_fits_type_p (c, type)
4589 tree c, type;
4590 {
4591 if (TREE_UNSIGNED (type))
4592 return (! (TREE_CODE (TYPE_MAX_VALUE (type)) == INTEGER_CST
4593 && INT_CST_LT_UNSIGNED (TYPE_MAX_VALUE (type), c))
4594 && ! (TREE_CODE (TYPE_MIN_VALUE (type)) == INTEGER_CST
4595 && INT_CST_LT_UNSIGNED (c, TYPE_MIN_VALUE (type)))
4596 /* Negative ints never fit unsigned types. */
4597 && ! (TREE_INT_CST_HIGH (c) < 0
4598 && ! TREE_UNSIGNED (TREE_TYPE (c))));
4599 else
4600 return (! (TREE_CODE (TYPE_MAX_VALUE (type)) == INTEGER_CST
4601 && INT_CST_LT (TYPE_MAX_VALUE (type), c))
4602 && ! (TREE_CODE (TYPE_MIN_VALUE (type)) == INTEGER_CST
4603 && INT_CST_LT (c, TYPE_MIN_VALUE (type)))
4604 /* Unsigned ints with top bit set never fit signed types. */
4605 && ! (TREE_INT_CST_HIGH (c) < 0
4606 && TREE_UNSIGNED (TREE_TYPE (c))));
4607 }
4608
4609 /* Return the innermost context enclosing DECL that is
4610 a FUNCTION_DECL, or zero if none. */
4611
4612 tree
4613 decl_function_context (decl)
4614 tree decl;
4615 {
4616 tree context;
4617
4618 if (TREE_CODE (decl) == ERROR_MARK)
4619 return 0;
4620
4621 if (TREE_CODE (decl) == SAVE_EXPR)
4622 context = SAVE_EXPR_CONTEXT (decl);
4623 else
4624 context = DECL_CONTEXT (decl);
4625
4626 while (context && TREE_CODE (context) != FUNCTION_DECL)
4627 {
4628 if (TREE_CODE (context) == RECORD_TYPE
4629 || TREE_CODE (context) == UNION_TYPE
4630 || TREE_CODE (context) == QUAL_UNION_TYPE)
4631 context = TYPE_CONTEXT (context);
4632 else if (TREE_CODE (context) == TYPE_DECL)
4633 context = DECL_CONTEXT (context);
4634 else if (TREE_CODE (context) == BLOCK)
4635 context = BLOCK_SUPERCONTEXT (context);
4636 else
4637 /* Unhandled CONTEXT !? */
4638 abort ();
4639 }
4640
4641 return context;
4642 }
4643
4644 /* Return the innermost context enclosing DECL that is
4645 a RECORD_TYPE, UNION_TYPE or QUAL_UNION_TYPE, or zero if none.
4646 TYPE_DECLs and FUNCTION_DECLs are transparent to this function. */
4647
4648 tree
4649 decl_type_context (decl)
4650 tree decl;
4651 {
4652 tree context = DECL_CONTEXT (decl);
4653
4654 while (context)
4655 {
4656 if (TREE_CODE (context) == RECORD_TYPE
4657 || TREE_CODE (context) == UNION_TYPE
4658 || TREE_CODE (context) == QUAL_UNION_TYPE)
4659 return context;
4660 if (TREE_CODE (context) == TYPE_DECL
4661 || TREE_CODE (context) == FUNCTION_DECL)
4662 context = DECL_CONTEXT (context);
4663 else if (TREE_CODE (context) == BLOCK)
4664 context = BLOCK_SUPERCONTEXT (context);
4665 else
4666 /* Unhandled CONTEXT!? */
4667 abort ();
4668 }
4669 return NULL_TREE;
4670 }
4671
4672 /* Print debugging information about the size of the
4673 toplev_inline_obstacks. */
4674
4675 void
4676 print_inline_obstack_statistics ()
4677 {
4678 struct simple_obstack_stack *current = toplev_inline_obstacks;
4679 int n_obstacks = 0;
4680 int n_alloc = 0;
4681 int n_chunks = 0;
4682
4683 for (; current; current = current->next, ++n_obstacks)
4684 {
4685 struct obstack *o = current->obstack;
4686 struct _obstack_chunk *chunk = o->chunk;
4687
4688 n_alloc += o->next_free - chunk->contents;
4689 chunk = chunk->prev;
4690 ++n_chunks;
4691 for (; chunk; chunk = chunk->prev, ++n_chunks)
4692 n_alloc += chunk->limit - &chunk->contents[0];
4693 }
4694 fprintf (stderr, "inline obstacks: %d obstacks, %d bytes, %d chunks\n",
4695 n_obstacks, n_alloc, n_chunks);
4696 }
4697
4698 /* Print debugging information about the obstack O, named STR. */
4699
4700 void
4701 print_obstack_statistics (str, o)
4702 char *str;
4703 struct obstack *o;
4704 {
4705 struct _obstack_chunk *chunk = o->chunk;
4706 int n_chunks = 1;
4707 int n_alloc = 0;
4708
4709 n_alloc += o->next_free - chunk->contents;
4710 chunk = chunk->prev;
4711 while (chunk)
4712 {
4713 n_chunks += 1;
4714 n_alloc += chunk->limit - &chunk->contents[0];
4715 chunk = chunk->prev;
4716 }
4717 fprintf (stderr, "obstack %s: %u bytes, %d chunks\n",
4718 str, n_alloc, n_chunks);
4719 }
4720
4721 /* Print debugging information about tree nodes generated during the compile,
4722 and any language-specific information. */
4723
4724 void
4725 dump_tree_statistics ()
4726 {
4727 #ifdef GATHER_STATISTICS
4728 int i;
4729 int total_nodes, total_bytes;
4730 #endif
4731
4732 fprintf (stderr, "\n??? tree nodes created\n\n");
4733 #ifdef GATHER_STATISTICS
4734 fprintf (stderr, "Kind Nodes Bytes\n");
4735 fprintf (stderr, "-------------------------------------\n");
4736 total_nodes = total_bytes = 0;
4737 for (i = 0; i < (int) all_kinds; i++)
4738 {
4739 fprintf (stderr, "%-20s %6d %9d\n", tree_node_kind_names[i],
4740 tree_node_counts[i], tree_node_sizes[i]);
4741 total_nodes += tree_node_counts[i];
4742 total_bytes += tree_node_sizes[i];
4743 }
4744 fprintf (stderr, "%-20s %9d\n", "identifier names", id_string_size);
4745 fprintf (stderr, "-------------------------------------\n");
4746 fprintf (stderr, "%-20s %6d %9d\n", "Total", total_nodes, total_bytes);
4747 fprintf (stderr, "-------------------------------------\n");
4748 #else
4749 fprintf (stderr, "(No per-node statistics)\n");
4750 #endif
4751 print_obstack_statistics ("permanent_obstack", &permanent_obstack);
4752 print_obstack_statistics ("maybepermanent_obstack", &maybepermanent_obstack);
4753 print_obstack_statistics ("temporary_obstack", &temporary_obstack);
4754 print_obstack_statistics ("momentary_obstack", &momentary_obstack);
4755 print_obstack_statistics ("temp_decl_obstack", &temp_decl_obstack);
4756 print_inline_obstack_statistics ();
4757 print_lang_statistics ();
4758 }
4759 \f
4760 #define FILE_FUNCTION_PREFIX_LEN 9
4761
4762 #ifndef NO_DOLLAR_IN_LABEL
4763 #define FILE_FUNCTION_FORMAT "_GLOBAL_$D$%s"
4764 #else /* NO_DOLLAR_IN_LABEL */
4765 #ifndef NO_DOT_IN_LABEL
4766 #define FILE_FUNCTION_FORMAT "_GLOBAL_.D.%s"
4767 #else /* NO_DOT_IN_LABEL */
4768 #define FILE_FUNCTION_FORMAT "_GLOBAL__D_%s"
4769 #endif /* NO_DOT_IN_LABEL */
4770 #endif /* NO_DOLLAR_IN_LABEL */
4771
4772 extern char * first_global_object_name;
4773
4774 /* If KIND=='I', return a suitable global initializer (constructor) name.
4775 If KIND=='D', return a suitable global clean-up (destructor) name. */
4776
4777 tree
4778 get_file_function_name (kind)
4779 int kind;
4780 {
4781 char *buf;
4782 register char *p;
4783
4784 if (first_global_object_name)
4785 p = first_global_object_name;
4786 else if (main_input_filename)
4787 p = main_input_filename;
4788 else
4789 p = input_filename;
4790
4791 buf = (char *) alloca (sizeof (FILE_FUNCTION_FORMAT) + strlen (p));
4792
4793 /* Set up the name of the file-level functions we may need. */
4794 /* Use a global object (which is already required to be unique over
4795 the program) rather than the file name (which imposes extra
4796 constraints). -- Raeburn@MIT.EDU, 10 Jan 1990. */
4797 sprintf (buf, FILE_FUNCTION_FORMAT, p);
4798
4799 /* Don't need to pull weird characters out of global names. */
4800 if (p != first_global_object_name)
4801 {
4802 for (p = buf+11; *p; p++)
4803 if (! ((*p >= '0' && *p <= '9')
4804 #if 0 /* we always want labels, which are valid C++ identifiers (+ `$') */
4805 #ifndef ASM_IDENTIFY_GCC /* this is required if `.' is invalid -- k. raeburn */
4806 || *p == '.'
4807 #endif
4808 #endif
4809 #ifndef NO_DOLLAR_IN_LABEL /* this for `$'; unlikely, but... -- kr */
4810 || *p == '$'
4811 #endif
4812 #ifndef NO_DOT_IN_LABEL /* this for `.'; unlikely, but... */
4813 || *p == '.'
4814 #endif
4815 || (*p >= 'A' && *p <= 'Z')
4816 || (*p >= 'a' && *p <= 'z')))
4817 *p = '_';
4818 }
4819
4820 buf[FILE_FUNCTION_PREFIX_LEN] = kind;
4821
4822 return get_identifier (buf);
4823 }
4824 \f
4825 /* Expand (the constant part of) a SET_TYPE CONSTRUCTOR node.
4826 The result is placed in BUFFER (which has length BIT_SIZE),
4827 with one bit in each char ('\000' or '\001').
4828
4829 If the constructor is constant, NULL_TREE is returned.
4830 Otherwise, a TREE_LIST of the non-constant elements is emitted. */
4831
4832 tree
4833 get_set_constructor_bits (init, buffer, bit_size)
4834 tree init;
4835 char *buffer;
4836 int bit_size;
4837 {
4838 int i;
4839 tree vals;
4840 HOST_WIDE_INT domain_min
4841 = TREE_INT_CST_LOW (TYPE_MIN_VALUE (TYPE_DOMAIN (TREE_TYPE (init))));
4842 tree non_const_bits = NULL_TREE;
4843 for (i = 0; i < bit_size; i++)
4844 buffer[i] = 0;
4845
4846 for (vals = TREE_OPERAND (init, 1);
4847 vals != NULL_TREE; vals = TREE_CHAIN (vals))
4848 {
4849 if (TREE_CODE (TREE_VALUE (vals)) != INTEGER_CST
4850 || (TREE_PURPOSE (vals) != NULL_TREE
4851 && TREE_CODE (TREE_PURPOSE (vals)) != INTEGER_CST))
4852 non_const_bits
4853 = tree_cons (TREE_PURPOSE (vals), TREE_VALUE (vals), non_const_bits);
4854 else if (TREE_PURPOSE (vals) != NULL_TREE)
4855 {
4856 /* Set a range of bits to ones. */
4857 HOST_WIDE_INT lo_index
4858 = TREE_INT_CST_LOW (TREE_PURPOSE (vals)) - domain_min;
4859 HOST_WIDE_INT hi_index
4860 = TREE_INT_CST_LOW (TREE_VALUE (vals)) - domain_min;
4861 if (lo_index < 0 || lo_index >= bit_size
4862 || hi_index < 0 || hi_index >= bit_size)
4863 abort ();
4864 for ( ; lo_index <= hi_index; lo_index++)
4865 buffer[lo_index] = 1;
4866 }
4867 else
4868 {
4869 /* Set a single bit to one. */
4870 HOST_WIDE_INT index
4871 = TREE_INT_CST_LOW (TREE_VALUE (vals)) - domain_min;
4872 if (index < 0 || index >= bit_size)
4873 {
4874 error ("invalid initializer for bit string");
4875 return NULL_TREE;
4876 }
4877 buffer[index] = 1;
4878 }
4879 }
4880 return non_const_bits;
4881 }
4882
4883 /* Expand (the constant part of) a SET_TYPE CONSTRUCTOR node.
4884 The result is placed in BUFFER (which is an array of bytes).
4885 If the constructor is constant, NULL_TREE is returned.
4886 Otherwise, a TREE_LIST of the non-constant elements is emitted. */
4887
4888 tree
4889 get_set_constructor_bytes (init, buffer, wd_size)
4890 tree init;
4891 unsigned char *buffer;
4892 int wd_size;
4893 {
4894 int i;
4895 int set_word_size = BITS_PER_UNIT;
4896 int bit_size = wd_size * set_word_size;
4897 int bit_pos = 0;
4898 unsigned char *bytep = buffer;
4899 char *bit_buffer = (char *) alloca(bit_size);
4900 tree non_const_bits = get_set_constructor_bits (init, bit_buffer, bit_size);
4901
4902 for (i = 0; i < wd_size; i++)
4903 buffer[i] = 0;
4904
4905 for (i = 0; i < bit_size; i++)
4906 {
4907 if (bit_buffer[i])
4908 {
4909 if (BYTES_BIG_ENDIAN)
4910 *bytep |= (1 << (set_word_size - 1 - bit_pos));
4911 else
4912 *bytep |= 1 << bit_pos;
4913 }
4914 bit_pos++;
4915 if (bit_pos >= set_word_size)
4916 bit_pos = 0, bytep++;
4917 }
4918 return non_const_bits;
4919 }