OSDN Git Service

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