OSDN Git Service

* reorg.c (fill_simple_delay_slots): Don't use a JUMP_INSN
[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   prec = TYPE_PRECISION (TREE_TYPE (expr));
1534   if (prec >= HOST_BITS_PER_WIDE_INT)
1535     {
1536       int high_value, shift_amount;
1537
1538       shift_amount = prec - HOST_BITS_PER_WIDE_INT;
1539
1540       if (shift_amount > HOST_BITS_PER_WIDE_INT)
1541         /* Can not handle precisions greater than twice the host int size.  */
1542         abort ();
1543       else if (shift_amount == HOST_BITS_PER_WIDE_INT)
1544         /* Shifting by the host word size is undefined according to the ANSI
1545            standard, so we must handle this as a special case.  */
1546         high_value = -1;
1547       else
1548         high_value = ((HOST_WIDE_INT) 1 << shift_amount) - 1;
1549
1550       return TREE_INT_CST_LOW (expr) == -1
1551         && TREE_INT_CST_HIGH (expr) == high_value;
1552     }
1553   else
1554     return TREE_INT_CST_LOW (expr) == ((HOST_WIDE_INT) 1 << prec) - 1;
1555 }
1556
1557 /* Return 1 if EXPR is an integer constant that is a power of 2 (i.e., has only
1558    one bit on).  */
1559
1560 int
1561 integer_pow2p (expr)
1562      tree expr;
1563 {
1564   HOST_WIDE_INT high, low;
1565
1566   STRIP_NOPS (expr);
1567
1568   if (TREE_CODE (expr) == COMPLEX_CST
1569       && integer_pow2p (TREE_REALPART (expr))
1570       && integer_zerop (TREE_IMAGPART (expr)))
1571     return 1;
1572
1573   if (TREE_CODE (expr) != INTEGER_CST)
1574     return 0;
1575
1576   high = TREE_INT_CST_HIGH (expr);
1577   low = TREE_INT_CST_LOW (expr);
1578
1579   if (high == 0 && low == 0)
1580     return 0;
1581
1582   return ((high == 0 && (low & (low - 1)) == 0)
1583           || (low == 0 && (high & (high - 1)) == 0));
1584 }
1585
1586 /* Return 1 if EXPR is the real constant zero.  */
1587
1588 int
1589 real_zerop (expr)
1590      tree expr;
1591 {
1592   STRIP_NOPS (expr);
1593
1594   return ((TREE_CODE (expr) == REAL_CST
1595            && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst0))
1596           || (TREE_CODE (expr) == COMPLEX_CST
1597               && real_zerop (TREE_REALPART (expr))
1598               && real_zerop (TREE_IMAGPART (expr))));
1599 }
1600
1601 /* Return 1 if EXPR is the real constant one in real or complex form.  */
1602
1603 int
1604 real_onep (expr)
1605      tree expr;
1606 {
1607   STRIP_NOPS (expr);
1608
1609   return ((TREE_CODE (expr) == REAL_CST
1610            && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst1))
1611           || (TREE_CODE (expr) == COMPLEX_CST
1612               && real_onep (TREE_REALPART (expr))
1613               && real_zerop (TREE_IMAGPART (expr))));
1614 }
1615
1616 /* Return 1 if EXPR is the real constant two.  */
1617
1618 int
1619 real_twop (expr)
1620      tree expr;
1621 {
1622   STRIP_NOPS (expr);
1623
1624   return ((TREE_CODE (expr) == REAL_CST
1625            && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst2))
1626           || (TREE_CODE (expr) == COMPLEX_CST
1627               && real_twop (TREE_REALPART (expr))
1628               && real_zerop (TREE_IMAGPART (expr))));
1629 }
1630
1631 /* Nonzero if EXP is a constant or a cast of a constant.  */
1632  
1633 int
1634 really_constant_p (exp)
1635      tree exp;
1636 {
1637   /* This is not quite the same as STRIP_NOPS.  It does more.  */
1638   while (TREE_CODE (exp) == NOP_EXPR
1639          || TREE_CODE (exp) == CONVERT_EXPR
1640          || TREE_CODE (exp) == NON_LVALUE_EXPR)
1641     exp = TREE_OPERAND (exp, 0);
1642   return TREE_CONSTANT (exp);
1643 }
1644 \f
1645 /* Return first list element whose TREE_VALUE is ELEM.
1646    Return 0 if ELEM is not it LIST.  */
1647
1648 tree
1649 value_member (elem, list)
1650      tree elem, list;
1651 {
1652   while (list)
1653     {
1654       if (elem == TREE_VALUE (list))
1655         return list;
1656       list = TREE_CHAIN (list);
1657     }
1658   return NULL_TREE;
1659 }
1660
1661 /* Return first list element whose TREE_PURPOSE is ELEM.
1662    Return 0 if ELEM is not it LIST.  */
1663
1664 tree
1665 purpose_member (elem, list)
1666      tree elem, list;
1667 {
1668   while (list)
1669     {
1670       if (elem == TREE_PURPOSE (list))
1671         return list;
1672       list = TREE_CHAIN (list);
1673     }
1674   return NULL_TREE;
1675 }
1676
1677 /* Return first list element whose BINFO_TYPE is ELEM.
1678    Return 0 if ELEM is not it LIST.  */
1679
1680 tree
1681 binfo_member (elem, list)
1682      tree elem, list;
1683 {
1684   while (list)
1685     {
1686       if (elem == BINFO_TYPE (list))
1687         return list;
1688       list = TREE_CHAIN (list);
1689     }
1690   return NULL_TREE;
1691 }
1692
1693 /* Return nonzero if ELEM is part of the chain CHAIN. */
1694
1695 int
1696 chain_member (elem, chain)
1697      tree elem, chain;
1698 {
1699   while (chain)
1700     {
1701       if (elem == chain)
1702         return 1;
1703       chain = TREE_CHAIN (chain);
1704     }
1705
1706   return 0;
1707 }
1708
1709 /* Return nonzero if ELEM is equal to TREE_VALUE (CHAIN) for any piece of
1710    chain CHAIN. */
1711
1712 int
1713 chain_member_value (elem, chain)
1714      tree elem, chain;
1715 {
1716   while (chain)
1717     {
1718       if (elem == TREE_VALUE (chain))
1719         return 1;
1720       chain = TREE_CHAIN (chain);
1721     }
1722
1723   return 0;
1724 }
1725
1726 /* Return nonzero if ELEM is equal to TREE_PURPOSE (TREE_VALUE (CHAIN)) 
1727    for any piece of chain CHAIN. */
1728
1729 int
1730 chain_member_purpose (elem, chain)
1731      tree elem, chain;
1732 {
1733
1734   while (chain)
1735     {
1736       if (elem == TREE_PURPOSE (TREE_VALUE (chain)))
1737         return 1;
1738       chain = TREE_CHAIN (chain);
1739     }
1740
1741   return 0;
1742 }
1743
1744 /* Return the length of a chain of nodes chained through TREE_CHAIN.
1745    We expect a null pointer to mark the end of the chain.
1746    This is the Lisp primitive `length'.  */
1747
1748 int
1749 list_length (t)
1750      tree t;
1751 {
1752   register tree tail;
1753   register int len = 0;
1754
1755   for (tail = t; tail; tail = TREE_CHAIN (tail))
1756     len++;
1757
1758   return len;
1759 }
1760
1761 /* Concatenate two chains of nodes (chained through TREE_CHAIN)
1762    by modifying the last node in chain 1 to point to chain 2.
1763    This is the Lisp primitive `nconc'.  */
1764
1765 tree
1766 chainon (op1, op2)
1767      tree op1, op2;
1768 {
1769
1770   if (op1)
1771     {
1772       register tree t1;
1773       register tree t2;
1774
1775       for (t1 = op1; TREE_CHAIN (t1); t1 = TREE_CHAIN (t1))
1776         ;
1777       TREE_CHAIN (t1) = op2;
1778       for (t2 = op2; t2; t2 = TREE_CHAIN (t2))
1779         if (t2 == t1)
1780           abort ();  /* Circularity created.  */
1781       return op1;
1782     }
1783   else return op2;
1784 }
1785
1786 /* Return the last node in a chain of nodes (chained through TREE_CHAIN).  */
1787
1788 tree
1789 tree_last (chain)
1790      register tree chain;
1791 {
1792   register tree next;
1793   if (chain)
1794     while (next = TREE_CHAIN (chain))
1795       chain = next;
1796   return chain;
1797 }
1798
1799 /* Reverse the order of elements in the chain T,
1800    and return the new head of the chain (old last element).  */
1801
1802 tree
1803 nreverse (t)
1804      tree t;
1805 {
1806   register tree prev = 0, decl, next;
1807   for (decl = t; decl; decl = next)
1808     {
1809       next = TREE_CHAIN (decl);
1810       TREE_CHAIN (decl) = prev;
1811       prev = decl;
1812     }
1813   return prev;
1814 }
1815
1816 /* Given a chain CHAIN of tree nodes,
1817    construct and return a list of those nodes.  */
1818
1819 tree
1820 listify (chain)
1821      tree chain;
1822 {
1823   tree result = NULL_TREE;
1824   tree in_tail = chain;
1825   tree out_tail = NULL_TREE;
1826
1827   while (in_tail)
1828     {
1829       tree next = tree_cons (NULL_TREE, in_tail, NULL_TREE);
1830       if (out_tail)
1831         TREE_CHAIN (out_tail) = next;
1832       else
1833         result = next;
1834       out_tail = next;
1835       in_tail = TREE_CHAIN (in_tail);
1836     }
1837
1838   return result;
1839 }
1840 \f
1841 /* Return a newly created TREE_LIST node whose
1842    purpose and value fields are PARM and VALUE.  */
1843
1844 tree
1845 build_tree_list (parm, value)
1846      tree parm, value;
1847 {
1848   register tree t = make_node (TREE_LIST);
1849   TREE_PURPOSE (t) = parm;
1850   TREE_VALUE (t) = value;
1851   return t;
1852 }
1853
1854 /* Similar, but build on the temp_decl_obstack.  */
1855
1856 tree
1857 build_decl_list (parm, value)
1858      tree parm, value;
1859 {
1860   register tree node;
1861   register struct obstack *ambient_obstack = current_obstack;
1862   current_obstack = &temp_decl_obstack;
1863   node = build_tree_list (parm, value);
1864   current_obstack = ambient_obstack;
1865   return node;
1866 }
1867
1868 /* Return a newly created TREE_LIST node whose
1869    purpose and value fields are PARM and VALUE
1870    and whose TREE_CHAIN is CHAIN.  */
1871
1872 tree
1873 tree_cons (purpose, value, chain)
1874      tree purpose, value, chain;
1875 {
1876 #if 0
1877   register tree node = make_node (TREE_LIST);
1878 #else
1879   register int i;
1880   register tree node = (tree) obstack_alloc (current_obstack, sizeof (struct tree_list));
1881 #ifdef GATHER_STATISTICS
1882   tree_node_counts[(int)x_kind]++;
1883   tree_node_sizes[(int)x_kind] += sizeof (struct tree_list);
1884 #endif
1885
1886   for (i = (sizeof (struct tree_common) / sizeof (int)) - 1; i >= 0; i--)
1887     ((int *) node)[i] = 0;
1888
1889   TREE_SET_CODE (node, TREE_LIST);
1890   if (current_obstack == &permanent_obstack)
1891     TREE_PERMANENT (node) = 1;
1892 #endif
1893
1894   TREE_CHAIN (node) = chain;
1895   TREE_PURPOSE (node) = purpose;
1896   TREE_VALUE (node) = value;
1897   return node;
1898 }
1899
1900 /* Similar, but build on the temp_decl_obstack.  */
1901
1902 tree
1903 decl_tree_cons (purpose, value, chain)
1904      tree purpose, value, chain;
1905 {
1906   register tree node;
1907   register struct obstack *ambient_obstack = current_obstack;
1908   current_obstack = &temp_decl_obstack;
1909   node = tree_cons (purpose, value, chain);
1910   current_obstack = ambient_obstack;
1911   return node;
1912 }
1913
1914 /* Same as `tree_cons' but make a permanent object.  */
1915
1916 tree
1917 perm_tree_cons (purpose, value, chain)
1918      tree purpose, value, chain;
1919 {
1920   register tree node;
1921   register struct obstack *ambient_obstack = current_obstack;
1922   current_obstack = &permanent_obstack;
1923
1924   node = tree_cons (purpose, value, chain);
1925   current_obstack = ambient_obstack;
1926   return node;
1927 }
1928
1929 /* Same as `tree_cons', but make this node temporary, regardless.  */
1930
1931 tree
1932 temp_tree_cons (purpose, value, chain)
1933      tree purpose, value, chain;
1934 {
1935   register tree node;
1936   register struct obstack *ambient_obstack = current_obstack;
1937   current_obstack = &temporary_obstack;
1938
1939   node = tree_cons (purpose, value, chain);
1940   current_obstack = ambient_obstack;
1941   return node;
1942 }
1943
1944 /* Same as `tree_cons', but save this node if the function's RTL is saved.  */
1945
1946 tree
1947 saveable_tree_cons (purpose, value, chain)
1948      tree purpose, value, chain;
1949 {
1950   register tree node;
1951   register struct obstack *ambient_obstack = current_obstack;
1952   current_obstack = saveable_obstack;
1953
1954   node = tree_cons (purpose, value, chain);
1955   current_obstack = ambient_obstack;
1956   return node;
1957 }
1958 \f
1959 /* Return the size nominally occupied by an object of type TYPE
1960    when it resides in memory.  The value is measured in units of bytes,
1961    and its data type is that normally used for type sizes
1962    (which is the first type created by make_signed_type or
1963    make_unsigned_type).  */
1964
1965 tree
1966 size_in_bytes (type)
1967      tree type;
1968 {
1969   tree t;
1970
1971   if (type == error_mark_node)
1972     return integer_zero_node;
1973   type = TYPE_MAIN_VARIANT (type);
1974   if (TYPE_SIZE (type) == 0)
1975     {
1976       incomplete_type_error (NULL_TREE, type);
1977       return integer_zero_node;
1978     }
1979   t = size_binop (CEIL_DIV_EXPR, TYPE_SIZE (type),
1980                   size_int (BITS_PER_UNIT));
1981   if (TREE_CODE (t) == INTEGER_CST)
1982     force_fit_type (t, 0);
1983   return t;
1984 }
1985
1986 /* Return the size of TYPE (in bytes) as an integer,
1987    or return -1 if the size can vary.  */
1988
1989 int
1990 int_size_in_bytes (type)
1991      tree type;
1992 {
1993   unsigned int size;
1994   if (type == error_mark_node)
1995     return 0;
1996   type = TYPE_MAIN_VARIANT (type);
1997   if (TYPE_SIZE (type) == 0)
1998     return -1;
1999   if (TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST)
2000     return -1;
2001   if (TREE_INT_CST_HIGH (TYPE_SIZE (type)) != 0)
2002     {
2003       tree t = size_binop (CEIL_DIV_EXPR, TYPE_SIZE (type),
2004                            size_int (BITS_PER_UNIT));
2005       return TREE_INT_CST_LOW (t);
2006     }
2007   size = TREE_INT_CST_LOW (TYPE_SIZE (type));
2008   return (size + BITS_PER_UNIT - 1) / BITS_PER_UNIT;
2009 }
2010 \f
2011 /* Return, as a tree node, the number of elements for TYPE (which is an
2012    ARRAY_TYPE) minus one. This counts only elements of the top array.  */
2013
2014 tree
2015 array_type_nelts (type)
2016      tree type;
2017 {
2018   tree index_type = TYPE_DOMAIN (type);
2019
2020   return (integer_zerop (TYPE_MIN_VALUE (index_type))
2021           ? TYPE_MAX_VALUE (index_type)
2022           : fold (build (MINUS_EXPR, TREE_TYPE (TYPE_MAX_VALUE (index_type)),
2023                          TYPE_MAX_VALUE (index_type),
2024                          TYPE_MIN_VALUE (index_type))));
2025 }
2026 \f
2027 /* Return nonzero if arg is static -- a reference to an object in
2028    static storage.  This is not the same as the C meaning of `static'.  */
2029
2030 int
2031 staticp (arg)
2032      tree arg;
2033 {
2034   switch (TREE_CODE (arg))
2035     {
2036     case FUNCTION_DECL:
2037       /* Nested functions aren't static, since taking their address
2038          involves a trampoline.  */
2039        return decl_function_context (arg) == 0;
2040     case VAR_DECL:
2041       return TREE_STATIC (arg) || DECL_EXTERNAL (arg);
2042
2043     case CONSTRUCTOR:
2044       return TREE_STATIC (arg);
2045
2046     case STRING_CST:
2047       return 1;
2048
2049     case COMPONENT_REF:
2050     case BIT_FIELD_REF:
2051       return staticp (TREE_OPERAND (arg, 0));
2052
2053     case INDIRECT_REF:
2054       return TREE_CONSTANT (TREE_OPERAND (arg, 0));
2055
2056     case ARRAY_REF:
2057       if (TREE_CODE (TYPE_SIZE (TREE_TYPE (arg))) == INTEGER_CST
2058           && TREE_CODE (TREE_OPERAND (arg, 1)) == INTEGER_CST)
2059         return staticp (TREE_OPERAND (arg, 0));
2060     }
2061
2062   return 0;
2063 }
2064 \f
2065 /* Wrap a SAVE_EXPR around EXPR, if appropriate.
2066    Do this to any expression which may be used in more than one place,
2067    but must be evaluated only once.
2068
2069    Normally, expand_expr would reevaluate the expression each time.
2070    Calling save_expr produces something that is evaluated and recorded
2071    the first time expand_expr is called on it.  Subsequent calls to
2072    expand_expr just reuse the recorded value.
2073
2074    The call to expand_expr that generates code that actually computes
2075    the value is the first call *at compile time*.  Subsequent calls
2076    *at compile time* generate code to use the saved value.
2077    This produces correct result provided that *at run time* control
2078    always flows through the insns made by the first expand_expr
2079    before reaching the other places where the save_expr was evaluated.
2080    You, the caller of save_expr, must make sure this is so.
2081
2082    Constants, and certain read-only nodes, are returned with no
2083    SAVE_EXPR because that is safe.  Expressions containing placeholders
2084    are not touched; see tree.def for an explanation of what these
2085    are used for.  */
2086
2087 tree
2088 save_expr (expr)
2089      tree expr;
2090 {
2091   register tree t = fold (expr);
2092
2093   /* We don't care about whether this can be used as an lvalue in this
2094      context.  */
2095   while (TREE_CODE (t) == NON_LVALUE_EXPR)
2096     t = TREE_OPERAND (t, 0);
2097
2098   /* If the tree evaluates to a constant, then we don't want to hide that
2099      fact (i.e. this allows further folding, and direct checks for constants).
2100      However, a read-only object that has side effects cannot be bypassed.
2101      Since it is no problem to reevaluate literals, we just return the 
2102      literal node. */
2103
2104   if (TREE_CONSTANT (t) || (TREE_READONLY (t) && ! TREE_SIDE_EFFECTS (t))
2105       || TREE_CODE (t) == SAVE_EXPR)
2106     return t;
2107
2108   /* If T contains a PLACEHOLDER_EXPR, we must evaluate it each time, since
2109      it means that the size or offset of some field of an object depends on
2110      the value within another field.
2111
2112      Note that it must not be the case that T contains both a PLACEHOLDER_EXPR
2113      and some variable since it would then need to be both evaluated once and
2114      evaluated more than once.  Front-ends must assure this case cannot
2115      happen by surrounding any such subexpressions in their own SAVE_EXPR
2116      and forcing evaluation at the proper time.  */
2117   if (contains_placeholder_p (t))
2118     return t;
2119
2120   t = build (SAVE_EXPR, TREE_TYPE (expr), t, current_function_decl, NULL_TREE);
2121
2122   /* This expression might be placed ahead of a jump to ensure that the
2123      value was computed on both sides of the jump.  So make sure it isn't
2124      eliminated as dead.  */
2125   TREE_SIDE_EFFECTS (t) = 1;
2126   return t;
2127 }
2128 \f
2129 /* Return 1 if EXP contains a PLACEHOLDER_EXPR; i.e., if it represents a size
2130    or offset that depends on a field within a record.
2131
2132    Note that we only allow such expressions within simple arithmetic
2133    or a COND_EXPR.  */
2134
2135 int
2136 contains_placeholder_p (exp)
2137      tree exp;
2138 {
2139   register enum tree_code code = TREE_CODE (exp);
2140   tree inner;
2141
2142   /* If we have a WITH_RECORD_EXPR, it "cancels" any PLACEHOLDER_EXPR
2143      in it since it is supplying a value for it.  */
2144   if (code == WITH_RECORD_EXPR)
2145     return 0;
2146
2147   switch (TREE_CODE_CLASS (code))
2148     {
2149     case 'r':
2150       for (inner = TREE_OPERAND (exp, 0);
2151            TREE_CODE_CLASS (TREE_CODE (inner)) == 'r';
2152            inner = TREE_OPERAND (inner, 0))
2153         ;
2154       return TREE_CODE (inner) == PLACEHOLDER_EXPR;
2155
2156     case '1':
2157     case '2':  case '<':
2158     case 'e':
2159       switch (tree_code_length[(int) code])
2160         {
2161         case 1:
2162           return contains_placeholder_p (TREE_OPERAND (exp, 0));
2163         case 2:
2164           return (code != RTL_EXPR
2165                   && code != CONSTRUCTOR
2166                   && ! (code == SAVE_EXPR && SAVE_EXPR_RTL (exp) != 0)
2167                   && code != WITH_RECORD_EXPR
2168                   && (contains_placeholder_p (TREE_OPERAND (exp, 0))
2169                       || contains_placeholder_p (TREE_OPERAND (exp, 1))));
2170         case 3:
2171           return (code == COND_EXPR
2172                   && (contains_placeholder_p (TREE_OPERAND (exp, 0))
2173                       || contains_placeholder_p (TREE_OPERAND (exp, 1))
2174                       || contains_placeholder_p (TREE_OPERAND (exp, 2))));
2175         }
2176     }
2177
2178   return 0;
2179 }
2180 \f
2181 /* Given a tree EXP, a FIELD_DECL F, and a replacement value R,
2182    return a tree with all occurrences of references to F in a
2183    PLACEHOLDER_EXPR replaced by R.   Note that we assume here that EXP
2184    contains only arithmetic expressions.  */
2185
2186 tree
2187 substitute_in_expr (exp, f, r)
2188      tree exp;
2189      tree f;
2190      tree r;
2191 {
2192   enum tree_code code = TREE_CODE (exp);
2193   tree inner;
2194
2195   switch (TREE_CODE_CLASS (code))
2196     {
2197     case 'c':
2198     case 'd':
2199       return exp;
2200
2201     case 'x':
2202       if (code == PLACEHOLDER_EXPR)
2203         return exp;
2204       break;
2205
2206     case '1':
2207     case '2':
2208     case '<':
2209     case 'e':
2210       switch (tree_code_length[(int) code])
2211         {
2212         case 1:
2213           return fold (build1 (code, TREE_TYPE (exp),
2214                                substitute_in_expr (TREE_OPERAND (exp, 0),
2215                                                    f, r)));
2216
2217         case 2:
2218           /* An RTL_EXPR cannot contain a PLACEHOLDER_EXPR; a CONSTRUCTOR
2219              could, but we don't support it.  */
2220           if (code == RTL_EXPR)
2221             return exp;
2222           else if (code == CONSTRUCTOR)
2223             abort ();
2224
2225           return fold (build (code, TREE_TYPE (exp),
2226                               substitute_in_expr (TREE_OPERAND (exp, 0), f, r),
2227                               substitute_in_expr (TREE_OPERAND (exp, 1),
2228                                                   f, r)));
2229
2230         case 3:
2231           /* It cannot be that anything inside a SAVE_EXPR contains a
2232              PLACEHOLDER_EXPR.  */
2233           if (code == SAVE_EXPR)
2234             return exp;
2235
2236           if (code != COND_EXPR)
2237             abort ();
2238
2239           return fold (build (code, TREE_TYPE (exp),
2240                               substitute_in_expr (TREE_OPERAND (exp, 0), f, r),
2241                               substitute_in_expr (TREE_OPERAND (exp, 1), f, r),
2242                               substitute_in_expr (TREE_OPERAND (exp, 2),
2243                                                   f, r)));
2244         }
2245
2246       break;
2247
2248     case 'r':
2249       switch (code)
2250         {
2251         case COMPONENT_REF:
2252           /* If this expression is getting a value from a PLACEHOLDER_EXPR
2253              and it is the right field, replace it with R.  */
2254           for (inner = TREE_OPERAND (exp, 0);
2255                TREE_CODE_CLASS (TREE_CODE (inner)) == 'r';
2256                inner = TREE_OPERAND (inner, 0))
2257             ;
2258           if (TREE_CODE (inner) == PLACEHOLDER_EXPR
2259               && TREE_OPERAND (exp, 1) == f)
2260             return r;
2261
2262           return fold (build (code, TREE_TYPE (exp),
2263                               substitute_in_expr (TREE_OPERAND (exp, 0), f, r),
2264                               TREE_OPERAND (exp, 1)));
2265         case BIT_FIELD_REF:
2266           return fold (build (code, TREE_TYPE (exp),
2267                               substitute_in_expr (TREE_OPERAND (exp, 0), f, r),
2268                               substitute_in_expr (TREE_OPERAND (exp, 1), f, r),
2269                               substitute_in_expr (TREE_OPERAND (exp, 2), f, r)));
2270         case INDIRECT_REF:
2271         case BUFFER_REF:
2272           return fold (build1 (code, TREE_TYPE (exp),
2273                                substitute_in_expr (TREE_OPERAND (exp, 0),
2274                                                  f, r)));
2275         case OFFSET_REF:
2276           return fold (build (code, TREE_TYPE (exp),
2277                               substitute_in_expr (TREE_OPERAND (exp, 0), f, r),
2278                               substitute_in_expr (TREE_OPERAND (exp, 1), f, r)));
2279         }
2280     }
2281
2282   /* If it wasn't one of the cases we handle, give up.  */
2283
2284   abort ();
2285 }
2286 \f
2287 /* Given a type T, a FIELD_DECL F, and a replacement value R,
2288    return a new type with all size expressions that contain F
2289    updated by replacing F with R.  */
2290
2291 tree
2292 substitute_in_type (t, f, r)
2293      tree t, f, r;
2294 {
2295   switch (TREE_CODE (t))
2296     {
2297     case POINTER_TYPE:
2298     case VOID_TYPE:
2299       return t;
2300     case INTEGER_TYPE:
2301     case ENUMERAL_TYPE:
2302     case BOOLEAN_TYPE:
2303     case CHAR_TYPE:
2304       if ((TREE_CODE (TYPE_MIN_VALUE (t)) != INTEGER_CST
2305            && contains_placeholder_p (TYPE_MIN_VALUE (t)))
2306           || (TREE_CODE (TYPE_MAX_VALUE (t)) != INTEGER_CST
2307               && contains_placeholder_p (TYPE_MAX_VALUE (t))))
2308         return build_range_type (t,
2309                                  substitute_in_expr (TYPE_MIN_VALUE (t), f, r),
2310                                  substitute_in_expr (TYPE_MAX_VALUE (t), f, r));
2311       return t;
2312
2313     case REAL_TYPE:
2314       if ((TYPE_MIN_VALUE (t) != 0
2315            && TREE_CODE (TYPE_MIN_VALUE (t)) != REAL_CST
2316            && contains_placeholder_p (TYPE_MIN_VALUE (t)))
2317           || (TYPE_MAX_VALUE (t) != 0
2318               && TREE_CODE (TYPE_MAX_VALUE (t)) != REAL_CST
2319               && contains_placeholder_p (TYPE_MAX_VALUE (t))))
2320         {
2321           t = build_type_copy (t);
2322
2323           if (TYPE_MIN_VALUE (t))
2324             TYPE_MIN_VALUE (t) = substitute_in_expr (TYPE_MIN_VALUE (t), f, r);
2325           if (TYPE_MAX_VALUE (t))
2326             TYPE_MAX_VALUE (t) = substitute_in_expr (TYPE_MAX_VALUE (t), f, r);
2327         }
2328       return t;
2329
2330     case COMPLEX_TYPE:
2331       return build_complex_type (substitute_in_type (TREE_TYPE (t), f, r));
2332
2333     case OFFSET_TYPE:
2334     case METHOD_TYPE:
2335     case REFERENCE_TYPE:
2336     case FILE_TYPE:
2337     case SET_TYPE:
2338     case FUNCTION_TYPE:
2339     case LANG_TYPE:
2340       /* Don't know how to do these yet.  */
2341       abort ();
2342
2343     case ARRAY_TYPE:
2344       t = build_array_type (substitute_in_type (TREE_TYPE (t), f, r),
2345                             substitute_in_type (TYPE_DOMAIN (t), f, r));
2346       TYPE_SIZE (t) = 0;
2347       layout_type (t);
2348       return t;
2349
2350     case RECORD_TYPE:
2351     case UNION_TYPE:
2352     case QUAL_UNION_TYPE:
2353       {
2354         tree new = copy_node (t);
2355         tree field;
2356         tree last_field = 0;
2357
2358         /* Start out with no fields, make new fields, and chain them
2359            in.  */
2360
2361         TYPE_FIELDS (new) = 0;
2362         TYPE_SIZE (new) = 0;
2363
2364         for (field = TYPE_FIELDS (t); field;
2365              field = TREE_CHAIN (field))
2366           {
2367             tree new_field = copy_node (field);
2368
2369             TREE_TYPE (new_field)
2370               = substitute_in_type (TREE_TYPE (new_field), f, r);
2371
2372             /* If this is an anonymous field and the type of this field is
2373                a UNION_TYPE or RECORD_TYPE with no elements, ignore it.  If
2374                the type just has one element, treat that as the field. 
2375                But don't do this if we are processing a QUAL_UNION_TYPE.  */
2376             if (TREE_CODE (t) != QUAL_UNION_TYPE && DECL_NAME (new_field) == 0
2377                 && (TREE_CODE (TREE_TYPE (new_field)) == UNION_TYPE
2378                     || TREE_CODE (TREE_TYPE (new_field)) == RECORD_TYPE))
2379               {
2380                 if (TYPE_FIELDS (TREE_TYPE (new_field)) == 0)
2381                   continue;
2382
2383                 if (TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (new_field))) == 0)
2384                   new_field = TYPE_FIELDS (TREE_TYPE (new_field));
2385               }
2386
2387             DECL_CONTEXT (new_field) = new;
2388             DECL_SIZE (new_field) = 0;
2389
2390             if (TREE_CODE (t) == QUAL_UNION_TYPE)
2391               {
2392                 /* Do the substitution inside the qualifier and if we find
2393                    that this field will not be present, omit it.  */
2394                 DECL_QUALIFIER (new_field)
2395                   = substitute_in_expr (DECL_QUALIFIER (field), f, r);
2396                 if (integer_zerop (DECL_QUALIFIER (new_field)))
2397                   continue;
2398               }
2399
2400             if (last_field == 0)
2401               TYPE_FIELDS (new) = new_field;
2402             else
2403               TREE_CHAIN (last_field) = new_field;
2404
2405             last_field = new_field;
2406
2407             /* If this is a qualified type and this field will always be
2408                present, we are done.  */
2409             if (TREE_CODE (t) == QUAL_UNION_TYPE
2410                 && integer_onep (DECL_QUALIFIER (new_field)))
2411               break;
2412           }
2413
2414         /* If this used to be a qualified union type, but we now know what
2415            field will be present, make this a normal union.  */
2416         if (TREE_CODE (new) == QUAL_UNION_TYPE
2417             && (TYPE_FIELDS (new) == 0
2418                 || integer_onep (DECL_QUALIFIER (TYPE_FIELDS (new)))))
2419           TREE_SET_CODE (new, UNION_TYPE);
2420
2421         layout_type (new);
2422         return new;
2423       }
2424     }
2425 }
2426 \f
2427 /* Stabilize a reference so that we can use it any number of times
2428    without causing its operands to be evaluated more than once.
2429    Returns the stabilized reference.  This works by means of save_expr,
2430    so see the caveats in the comments about save_expr.
2431
2432    Also allows conversion expressions whose operands are references.
2433    Any other kind of expression is returned unchanged.  */
2434
2435 tree
2436 stabilize_reference (ref)
2437      tree ref;
2438 {
2439   register tree result;
2440   register enum tree_code code = TREE_CODE (ref);
2441
2442   switch (code)
2443     {
2444     case VAR_DECL:
2445     case PARM_DECL:
2446     case RESULT_DECL:
2447       /* No action is needed in this case.  */
2448       return ref;
2449
2450     case NOP_EXPR:
2451     case CONVERT_EXPR:
2452     case FLOAT_EXPR:
2453     case FIX_TRUNC_EXPR:
2454     case FIX_FLOOR_EXPR:
2455     case FIX_ROUND_EXPR:
2456     case FIX_CEIL_EXPR:
2457       result = build_nt (code, stabilize_reference (TREE_OPERAND (ref, 0)));
2458       break;
2459
2460     case INDIRECT_REF:
2461       result = build_nt (INDIRECT_REF,
2462                          stabilize_reference_1 (TREE_OPERAND (ref, 0)));
2463       break;
2464
2465     case COMPONENT_REF:
2466       result = build_nt (COMPONENT_REF,
2467                          stabilize_reference (TREE_OPERAND (ref, 0)),
2468                          TREE_OPERAND (ref, 1));
2469       break;
2470
2471     case BIT_FIELD_REF:
2472       result = build_nt (BIT_FIELD_REF,
2473                          stabilize_reference (TREE_OPERAND (ref, 0)),
2474                          stabilize_reference_1 (TREE_OPERAND (ref, 1)),
2475                          stabilize_reference_1 (TREE_OPERAND (ref, 2)));
2476       break;
2477
2478     case ARRAY_REF:
2479       result = build_nt (ARRAY_REF,
2480                          stabilize_reference (TREE_OPERAND (ref, 0)),
2481                          stabilize_reference_1 (TREE_OPERAND (ref, 1)));
2482       break;
2483
2484     case COMPOUND_EXPR:
2485       result = build_nt (COMPOUND_EXPR,
2486                          stabilize_reference_1 (TREE_OPERAND (ref, 0)),
2487                          stabilize_reference (TREE_OPERAND (ref, 1)));
2488       break;
2489
2490     case RTL_EXPR:
2491       result = build1 (INDIRECT_REF, TREE_TYPE (ref),
2492                        save_expr (build1 (ADDR_EXPR,
2493                                           build_pointer_type (TREE_TYPE (ref)),
2494                                           ref)));
2495       break;
2496
2497
2498       /* If arg isn't a kind of lvalue we recognize, make no change.
2499          Caller should recognize the error for an invalid lvalue.  */
2500     default:
2501       return ref;
2502
2503     case ERROR_MARK:
2504       return error_mark_node;
2505     }
2506
2507   TREE_TYPE (result) = TREE_TYPE (ref);
2508   TREE_READONLY (result) = TREE_READONLY (ref);
2509   TREE_SIDE_EFFECTS (result) = TREE_SIDE_EFFECTS (ref);
2510   TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
2511   TREE_RAISES (result) = TREE_RAISES (ref);
2512
2513   return result;
2514 }
2515
2516 /* Subroutine of stabilize_reference; this is called for subtrees of
2517    references.  Any expression with side-effects must be put in a SAVE_EXPR
2518    to ensure that it is only evaluated once.
2519
2520    We don't put SAVE_EXPR nodes around everything, because assigning very
2521    simple expressions to temporaries causes us to miss good opportunities
2522    for optimizations.  Among other things, the opportunity to fold in the
2523    addition of a constant into an addressing mode often gets lost, e.g.
2524    "y[i+1] += x;".  In general, we take the approach that we should not make
2525    an assignment unless we are forced into it - i.e., that any non-side effect
2526    operator should be allowed, and that cse should take care of coalescing
2527    multiple utterances of the same expression should that prove fruitful.  */
2528
2529 tree
2530 stabilize_reference_1 (e)
2531      tree e;
2532 {
2533   register tree result;
2534   register enum tree_code code = TREE_CODE (e);
2535
2536   /* We cannot ignore const expressions because it might be a reference
2537      to a const array but whose index contains side-effects.  But we can
2538      ignore things that are actual constant or that already have been
2539      handled by this function.  */
2540
2541   if (TREE_CONSTANT (e) || code == SAVE_EXPR)
2542     return e;
2543
2544   switch (TREE_CODE_CLASS (code))
2545     {
2546     case 'x':
2547     case 't':
2548     case 'd':
2549     case 'b':
2550     case '<':
2551     case 's':
2552     case 'e':
2553     case 'r':
2554       /* If the expression has side-effects, then encase it in a SAVE_EXPR
2555          so that it will only be evaluated once.  */
2556       /* The reference (r) and comparison (<) classes could be handled as
2557          below, but it is generally faster to only evaluate them once.  */
2558       if (TREE_SIDE_EFFECTS (e))
2559         return save_expr (e);
2560       return e;
2561
2562     case 'c':
2563       /* Constants need no processing.  In fact, we should never reach
2564          here.  */
2565       return e;
2566       
2567     case '2':
2568       /* Division is slow and tends to be compiled with jumps,
2569          especially the division by powers of 2 that is often
2570          found inside of an array reference.  So do it just once.  */
2571       if (code == TRUNC_DIV_EXPR || code == TRUNC_MOD_EXPR
2572           || code == FLOOR_DIV_EXPR || code == FLOOR_MOD_EXPR
2573           || code == CEIL_DIV_EXPR || code == CEIL_MOD_EXPR
2574           || code == ROUND_DIV_EXPR || code == ROUND_MOD_EXPR)
2575         return save_expr (e);
2576       /* Recursively stabilize each operand.  */
2577       result = build_nt (code, stabilize_reference_1 (TREE_OPERAND (e, 0)),
2578                          stabilize_reference_1 (TREE_OPERAND (e, 1)));
2579       break;
2580
2581     case '1':
2582       /* Recursively stabilize each operand.  */
2583       result = build_nt (code, stabilize_reference_1 (TREE_OPERAND (e, 0)));
2584       break;
2585
2586     default:
2587       abort ();
2588     }
2589   
2590   TREE_TYPE (result) = TREE_TYPE (e);
2591   TREE_READONLY (result) = TREE_READONLY (e);
2592   TREE_SIDE_EFFECTS (result) = TREE_SIDE_EFFECTS (e);
2593   TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
2594   TREE_RAISES (result) = TREE_RAISES (e);
2595
2596   return result;
2597 }
2598 \f
2599 /* Low-level constructors for expressions.  */
2600
2601 /* Build an expression of code CODE, data type TYPE,
2602    and operands as specified by the arguments ARG1 and following arguments.
2603    Expressions and reference nodes can be created this way.
2604    Constants, decls, types and misc nodes cannot be.  */
2605
2606 tree
2607 build VPROTO((enum tree_code code, tree tt, ...))
2608 {
2609 #ifndef __STDC__
2610   enum tree_code code;
2611   tree tt;
2612 #endif
2613   va_list p;
2614   register tree t;
2615   register int length;
2616   register int i;
2617
2618   VA_START (p, tt);
2619
2620 #ifndef __STDC__
2621   code = va_arg (p, enum tree_code);
2622   tt = va_arg (p, tree);
2623 #endif
2624
2625   t = make_node (code);
2626   length = tree_code_length[(int) code];
2627   TREE_TYPE (t) = tt;
2628
2629   if (length == 2)
2630     {
2631       /* This is equivalent to the loop below, but faster.  */
2632       register tree arg0 = va_arg (p, tree);
2633       register tree arg1 = va_arg (p, tree);
2634       TREE_OPERAND (t, 0) = arg0;
2635       TREE_OPERAND (t, 1) = arg1;
2636       if ((arg0 && TREE_SIDE_EFFECTS (arg0))
2637           || (arg1 && TREE_SIDE_EFFECTS (arg1)))
2638         TREE_SIDE_EFFECTS (t) = 1;
2639       TREE_RAISES (t)
2640         = (arg0 && TREE_RAISES (arg0)) || (arg1 && TREE_RAISES (arg1));
2641     }
2642   else if (length == 1)
2643     {
2644       register tree arg0 = va_arg (p, tree);
2645
2646       /* Call build1 for this!  */
2647       if (TREE_CODE_CLASS (code) != 's')
2648         abort ();
2649       TREE_OPERAND (t, 0) = arg0;
2650       if (arg0 && TREE_SIDE_EFFECTS (arg0))
2651         TREE_SIDE_EFFECTS (t) = 1;
2652       TREE_RAISES (t) = (arg0 && TREE_RAISES (arg0));
2653     }
2654   else
2655     {
2656       for (i = 0; i < length; i++)
2657         {
2658           register tree operand = va_arg (p, tree);
2659           TREE_OPERAND (t, i) = operand;
2660           if (operand)
2661             {
2662               if (TREE_SIDE_EFFECTS (operand))
2663                 TREE_SIDE_EFFECTS (t) = 1;
2664               if (TREE_RAISES (operand))
2665                 TREE_RAISES (t) = 1;
2666             }
2667         }
2668     }
2669   va_end (p);
2670   return t;
2671 }
2672
2673 /* Same as above, but only builds for unary operators.
2674    Saves lions share of calls to `build'; cuts down use
2675    of varargs, which is expensive for RISC machines.  */
2676 tree
2677 build1 (code, type, node)
2678      enum tree_code code;
2679      tree type;
2680      tree node;
2681 {
2682   register struct obstack *obstack = current_obstack;
2683   register int i, length;
2684   register tree_node_kind kind;
2685   register tree t;
2686
2687 #ifdef GATHER_STATISTICS
2688   if (TREE_CODE_CLASS (code) == 'r')
2689     kind = r_kind;
2690   else
2691     kind = e_kind;
2692 #endif
2693
2694   obstack = expression_obstack;
2695   length = sizeof (struct tree_exp);
2696
2697   t = (tree) obstack_alloc (obstack, length);
2698
2699 #ifdef GATHER_STATISTICS
2700   tree_node_counts[(int)kind]++;
2701   tree_node_sizes[(int)kind] += length;
2702 #endif
2703
2704   for (i = (length / sizeof (int)) - 1; i >= 0; i--)
2705     ((int *) t)[i] = 0;
2706
2707   TREE_TYPE (t) = type;
2708   TREE_SET_CODE (t, code);
2709
2710   if (obstack == &permanent_obstack)
2711     TREE_PERMANENT (t) = 1;
2712
2713   TREE_OPERAND (t, 0) = node;
2714   if (node)
2715     {
2716       if (TREE_SIDE_EFFECTS (node))
2717         TREE_SIDE_EFFECTS (t) = 1;
2718       if (TREE_RAISES (node))
2719         TREE_RAISES (t) = 1;
2720     }
2721
2722   return t;
2723 }
2724
2725 /* Similar except don't specify the TREE_TYPE
2726    and leave the TREE_SIDE_EFFECTS as 0.
2727    It is permissible for arguments to be null,
2728    or even garbage if their values do not matter.  */
2729
2730 tree
2731 build_nt VPROTO((enum tree_code code, ...))
2732 {
2733 #ifndef __STDC__
2734   enum tree_code code;
2735 #endif
2736   va_list p;
2737   register tree t;
2738   register int length;
2739   register int i;
2740
2741   VA_START (p, code);
2742
2743 #ifndef __STDC__
2744   code = va_arg (p, enum tree_code);
2745 #endif
2746
2747   t = make_node (code);
2748   length = tree_code_length[(int) code];
2749
2750   for (i = 0; i < length; i++)
2751     TREE_OPERAND (t, i) = va_arg (p, tree);
2752
2753   va_end (p);
2754   return t;
2755 }
2756
2757 /* Similar to `build_nt', except we build
2758    on the temp_decl_obstack, regardless.  */
2759
2760 tree
2761 build_parse_node VPROTO((enum tree_code code, ...))
2762 {
2763 #ifndef __STDC__
2764   enum tree_code code;
2765 #endif
2766   register struct obstack *ambient_obstack = expression_obstack;
2767   va_list p;
2768   register tree t;
2769   register int length;
2770   register int i;
2771
2772   VA_START (p, code);
2773
2774 #ifndef __STDC__
2775   code = va_arg (p, enum tree_code);
2776 #endif
2777
2778   expression_obstack = &temp_decl_obstack;
2779
2780   t = make_node (code);
2781   length = tree_code_length[(int) code];
2782
2783   for (i = 0; i < length; i++)
2784     TREE_OPERAND (t, i) = va_arg (p, tree);
2785
2786   va_end (p);
2787   expression_obstack = ambient_obstack;
2788   return t;
2789 }
2790
2791 #if 0
2792 /* Commented out because this wants to be done very
2793    differently.  See cp-lex.c.  */
2794 tree
2795 build_op_identifier (op1, op2)
2796      tree op1, op2;
2797 {
2798   register tree t = make_node (OP_IDENTIFIER);
2799   TREE_PURPOSE (t) = op1;
2800   TREE_VALUE (t) = op2;
2801   return t;
2802 }
2803 #endif
2804 \f
2805 /* Create a DECL_... node of code CODE, name NAME and data type TYPE.
2806    We do NOT enter this node in any sort of symbol table.
2807
2808    layout_decl is used to set up the decl's storage layout.
2809    Other slots are initialized to 0 or null pointers.  */
2810
2811 tree
2812 build_decl (code, name, type)
2813      enum tree_code code;
2814      tree name, type;
2815 {
2816   register tree t;
2817
2818   t = make_node (code);
2819
2820 /*  if (type == error_mark_node)
2821     type = integer_type_node; */
2822 /* That is not done, deliberately, so that having error_mark_node
2823    as the type can suppress useless errors in the use of this variable.  */
2824
2825   DECL_NAME (t) = name;
2826   DECL_ASSEMBLER_NAME (t) = name;
2827   TREE_TYPE (t) = type;
2828
2829   if (code == VAR_DECL || code == PARM_DECL || code == RESULT_DECL)
2830     layout_decl (t, 0);
2831   else if (code == FUNCTION_DECL)
2832     DECL_MODE (t) = FUNCTION_MODE;
2833
2834   return t;
2835 }
2836 \f
2837 /* BLOCK nodes are used to represent the structure of binding contours
2838    and declarations, once those contours have been exited and their contents
2839    compiled.  This information is used for outputting debugging info.  */
2840
2841 tree
2842 build_block (vars, tags, subblocks, supercontext, chain)
2843      tree vars, tags, subblocks, supercontext, chain;
2844 {
2845   register tree block = make_node (BLOCK);
2846   BLOCK_VARS (block) = vars;
2847   BLOCK_TYPE_TAGS (block) = tags;
2848   BLOCK_SUBBLOCKS (block) = subblocks;
2849   BLOCK_SUPERCONTEXT (block) = supercontext;
2850   BLOCK_CHAIN (block) = chain;
2851   return block;
2852 }
2853 \f
2854 /* Return a declaration like DDECL except that its DECL_MACHINE_ATTRIBUTE
2855    is ATTRIBUTE. */
2856
2857 tree
2858 build_decl_attribute_variant (ddecl, attribute)
2859      tree ddecl, attribute;
2860 {
2861   DECL_MACHINE_ATTRIBUTES (ddecl) = attribute;
2862   return ddecl;
2863 }
2864
2865 /* Return a type like TTYPE except that its TYPE_ATTRIBUTE
2866    is ATTRIBUTE.
2867
2868    Record such modified types already made so we don't make duplicates.  */
2869
2870 tree
2871 build_type_attribute_variant (ttype, attribute)
2872      tree ttype, attribute;
2873 {
2874   if ( ! attribute_list_equal (TYPE_ATTRIBUTES (ttype), attribute))
2875     {
2876       register int hashcode;
2877       register struct obstack *ambient_obstack = current_obstack;
2878       tree ntype;
2879
2880       if (ambient_obstack != &permanent_obstack)
2881         current_obstack = TYPE_OBSTACK (ttype);
2882
2883       ntype = copy_node (ttype);
2884       current_obstack = ambient_obstack;
2885
2886       TYPE_POINTER_TO (ntype) = 0;
2887       TYPE_REFERENCE_TO (ntype) = 0;
2888       TYPE_ATTRIBUTES (ntype) = attribute;
2889
2890       /* Create a new main variant of TYPE.  */
2891       TYPE_MAIN_VARIANT (ntype) = ntype;
2892       TYPE_NEXT_VARIANT (ntype) = 0;
2893       TYPE_READONLY (ntype) = TYPE_VOLATILE (ntype) = 0;
2894
2895       hashcode = TYPE_HASH (TREE_CODE (ntype))
2896                  + TYPE_HASH (TREE_TYPE (ntype))
2897                  + type_hash_list (attribute);
2898
2899       switch (TREE_CODE (ntype))
2900         {
2901           case FUNCTION_TYPE:
2902             hashcode += TYPE_HASH (TYPE_ARG_TYPES (ntype));
2903             break;
2904           case ARRAY_TYPE:
2905             hashcode += TYPE_HASH (TYPE_DOMAIN (ntype));
2906             break;
2907           case INTEGER_TYPE:
2908             hashcode += TYPE_HASH (TYPE_MAX_VALUE (ntype));
2909             break;
2910           case REAL_TYPE:
2911             hashcode += TYPE_HASH (TYPE_PRECISION (ntype));
2912             break;
2913         }
2914
2915       ntype = type_hash_canon (hashcode, ntype);
2916       ttype = build_type_variant (ntype, TYPE_READONLY (ttype),
2917                                   TYPE_VOLATILE (ttype));
2918     }
2919
2920   return ttype;
2921 }
2922
2923 /* Return a 1 if ATTR_NAME and ATTR_ARGS is valid for either declaration DECL
2924    or type TYPE and 0 otherwise.  Validity is determined the configuration
2925    macros VALID_MACHINE_DECL_ATTRIBUTE and VALID_MACHINE_TYPE_ATTRIBUTE. */
2926
2927 int
2928 valid_machine_attribute (attr_name, attr_args, decl, type)
2929      tree attr_name, attr_args;
2930      tree decl;
2931      tree type;
2932 {
2933   int valid = 0;
2934   tree decl_attr_list = decl != 0 ? DECL_MACHINE_ATTRIBUTES (decl) : 0;
2935   tree type_attr_list = TYPE_ATTRIBUTES (type);
2936
2937   /* For now, we don't support args.  */
2938   if (attr_args != 0)
2939     return 0;
2940
2941 #ifdef VALID_MACHINE_DECL_ATTRIBUTE
2942   if (decl != 0
2943       && VALID_MACHINE_DECL_ATTRIBUTE (decl, decl_attr_list, attr_name))
2944     {
2945       tree attr_list;
2946       int in_list = 0;
2947
2948       for (attr_list = decl_attr_list; 
2949            attr_list;
2950            attr_list = TREE_CHAIN (attr_list))
2951         if (TREE_VALUE (attr_list) == attr_name)
2952           in_list = 1;
2953
2954       if (! in_list)
2955         decl_attr_list = tree_cons (NULL_TREE, attr_name, decl_attr_list);
2956
2957       decl = build_decl_attribute_variant (decl, decl_attr_list);
2958       valid = 1;
2959     }
2960 #endif
2961
2962 #ifdef VALID_MACHINE_TYPE_ATTRIBUTE
2963   if (VALID_MACHINE_TYPE_ATTRIBUTE (type, type_attr_list, attr_name))
2964     {
2965       tree attr_list;
2966       int in_list = 0;
2967
2968       for (attr_list = type_attr_list;
2969            attr_list;
2970            attr_list = TREE_CHAIN (attr_list))
2971         if (TREE_VALUE (attr_list) == attr_name)
2972           in_list = 1;
2973
2974       if (! in_list)
2975         type_attr_list = tree_cons (NULL_TREE, attr_name, type_attr_list);
2976
2977       type = build_type_attribute_variant (type, type_attr_list);
2978       if (decl != 0)
2979         TREE_TYPE (decl) = type;
2980       valid = 1;
2981     }
2982 #endif
2983
2984   return valid;
2985 }
2986 \f
2987 /* Return a type like TYPE except that its TYPE_READONLY is CONSTP
2988    and its TYPE_VOLATILE is VOLATILEP.
2989
2990    Such variant types already made are recorded so that duplicates
2991    are not made.
2992
2993    A variant types should never be used as the type of an expression.
2994    Always copy the variant information into the TREE_READONLY
2995    and TREE_THIS_VOLATILE of the expression, and then give the expression
2996    as its type the "main variant", the variant whose TYPE_READONLY
2997    and TYPE_VOLATILE are zero.  Use TYPE_MAIN_VARIANT to find the
2998    main variant.  */
2999
3000 tree
3001 build_type_variant (type, constp, volatilep)
3002      tree type;
3003      int constp, volatilep;
3004 {
3005   register tree t;
3006
3007   /* Treat any nonzero argument as 1.  */
3008   constp = !!constp;
3009   volatilep = !!volatilep;
3010
3011   /* Search the chain of variants to see if there is already one there just
3012      like the one we need to have.  If so, use that existing one.  We must
3013      preserve the TYPE_NAME, since there is code that depends on this.  */
3014
3015   for (t = TYPE_MAIN_VARIANT(type); t; t = TYPE_NEXT_VARIANT (t))
3016     if (constp == TYPE_READONLY (t) && volatilep == TYPE_VOLATILE (t)
3017         && TYPE_NAME (t) == TYPE_NAME (type))
3018       return t;
3019
3020   /* We need a new one.  */
3021
3022   t = build_type_copy (type);
3023   TYPE_READONLY (t) = constp;
3024   TYPE_VOLATILE (t) = volatilep;
3025
3026   return t;
3027 }
3028
3029 /* Give TYPE a new main variant: NEW_MAIN.
3030    This is the right thing to do only when something else
3031    about TYPE is modified in place.  */
3032
3033 void
3034 change_main_variant (type, new_main)
3035      tree type, new_main;
3036 {
3037   tree t;
3038   tree omain = TYPE_MAIN_VARIANT (type);
3039
3040   /* Remove TYPE from the TYPE_NEXT_VARIANT chain of its main variant.  */
3041   if (TYPE_NEXT_VARIANT (omain) == type)
3042     TYPE_NEXT_VARIANT (omain) = TYPE_NEXT_VARIANT (type);
3043   else
3044     for (t = TYPE_NEXT_VARIANT (omain); t && TYPE_NEXT_VARIANT (t);
3045          t = TYPE_NEXT_VARIANT (t))
3046       if (TYPE_NEXT_VARIANT (t) == type)
3047         {
3048           TYPE_NEXT_VARIANT (t) = TYPE_NEXT_VARIANT (type);
3049           break;
3050         }
3051
3052   TYPE_MAIN_VARIANT (type) = new_main;
3053   TYPE_NEXT_VARIANT (type) = TYPE_NEXT_VARIANT (new_main);
3054   TYPE_NEXT_VARIANT (new_main) = type;
3055 }
3056
3057 /* Create a new variant of TYPE, equivalent but distinct.
3058    This is so the caller can modify it.  */
3059
3060 tree
3061 build_type_copy (type)
3062      tree type;
3063 {
3064   register tree t, m = TYPE_MAIN_VARIANT (type);
3065   register struct obstack *ambient_obstack = current_obstack;
3066
3067   current_obstack = TYPE_OBSTACK (type);
3068   t = copy_node (type);
3069   current_obstack = ambient_obstack;
3070
3071   TYPE_POINTER_TO (t) = 0;
3072   TYPE_REFERENCE_TO (t) = 0;
3073
3074   /* Add this type to the chain of variants of TYPE.  */
3075   TYPE_NEXT_VARIANT (t) = TYPE_NEXT_VARIANT (m);
3076   TYPE_NEXT_VARIANT (m) = t;
3077
3078   return t;
3079 }
3080 \f
3081 /* Hashing of types so that we don't make duplicates.
3082    The entry point is `type_hash_canon'.  */
3083
3084 /* Each hash table slot is a bucket containing a chain
3085    of these structures.  */
3086
3087 struct type_hash
3088 {
3089   struct type_hash *next;       /* Next structure in the bucket.  */
3090   int hashcode;                 /* Hash code of this type.  */
3091   tree type;                    /* The type recorded here.  */
3092 };
3093
3094 /* Now here is the hash table.  When recording a type, it is added
3095    to the slot whose index is the hash code mod the table size.
3096    Note that the hash table is used for several kinds of types
3097    (function types, array types and array index range types, for now).
3098    While all these live in the same table, they are completely independent,
3099    and the hash code is computed differently for each of these.  */
3100
3101 #define TYPE_HASH_SIZE 59
3102 struct type_hash *type_hash_table[TYPE_HASH_SIZE];
3103
3104 /* Compute a hash code for a list of types (chain of TREE_LIST nodes
3105    with types in the TREE_VALUE slots), by adding the hash codes
3106    of the individual types.  */
3107
3108 int
3109 type_hash_list (list)
3110      tree list;
3111 {
3112   register int hashcode;
3113   register tree tail;
3114   for (hashcode = 0, tail = list; tail; tail = TREE_CHAIN (tail))
3115     hashcode += TYPE_HASH (TREE_VALUE (tail));
3116   return hashcode;
3117 }
3118
3119 /* Look in the type hash table for a type isomorphic to TYPE.
3120    If one is found, return it.  Otherwise return 0.  */
3121
3122 tree
3123 type_hash_lookup (hashcode, type)
3124      int hashcode;
3125      tree type;
3126 {
3127   register struct type_hash *h;
3128   for (h = type_hash_table[hashcode % TYPE_HASH_SIZE]; h; h = h->next)
3129     if (h->hashcode == hashcode
3130         && TREE_CODE (h->type) == TREE_CODE (type)
3131         && TREE_TYPE (h->type) == TREE_TYPE (type)
3132         && attribute_list_equal (TYPE_ATTRIBUTES (h->type),
3133                                    TYPE_ATTRIBUTES (type))
3134         && (TYPE_MAX_VALUE (h->type) == TYPE_MAX_VALUE (type)
3135             || tree_int_cst_equal (TYPE_MAX_VALUE (h->type),
3136                                    TYPE_MAX_VALUE (type)))
3137         && (TYPE_MIN_VALUE (h->type) == TYPE_MIN_VALUE (type)
3138             || tree_int_cst_equal (TYPE_MIN_VALUE (h->type),
3139                                    TYPE_MIN_VALUE (type)))
3140         && (TYPE_DOMAIN (h->type) == TYPE_DOMAIN (type)
3141             || (TYPE_DOMAIN (h->type)
3142                 && TREE_CODE (TYPE_DOMAIN (h->type)) == TREE_LIST
3143                 && TYPE_DOMAIN (type)
3144                 && TREE_CODE (TYPE_DOMAIN (type)) == TREE_LIST
3145                 && type_list_equal (TYPE_DOMAIN (h->type), TYPE_DOMAIN (type)))))
3146       return h->type;
3147   return 0;
3148 }
3149
3150 /* Add an entry to the type-hash-table
3151    for a type TYPE whose hash code is HASHCODE.  */
3152
3153 void
3154 type_hash_add (hashcode, type)
3155      int hashcode;
3156      tree type;
3157 {
3158   register struct type_hash *h;
3159
3160   h = (struct type_hash *) oballoc (sizeof (struct type_hash));
3161   h->hashcode = hashcode;
3162   h->type = type;
3163   h->next = type_hash_table[hashcode % TYPE_HASH_SIZE];
3164   type_hash_table[hashcode % TYPE_HASH_SIZE] = h;
3165 }
3166
3167 /* Given TYPE, and HASHCODE its hash code, return the canonical
3168    object for an identical type if one already exists.
3169    Otherwise, return TYPE, and record it as the canonical object
3170    if it is a permanent object.
3171
3172    To use this function, first create a type of the sort you want.
3173    Then compute its hash code from the fields of the type that
3174    make it different from other similar types.
3175    Then call this function and use the value.
3176    This function frees the type you pass in if it is a duplicate.  */
3177
3178 /* Set to 1 to debug without canonicalization.  Never set by program.  */
3179 int debug_no_type_hash = 0;
3180
3181 tree
3182 type_hash_canon (hashcode, type)
3183      int hashcode;
3184      tree type;
3185 {
3186   tree t1;
3187
3188   if (debug_no_type_hash)
3189     return type;
3190
3191   t1 = type_hash_lookup (hashcode, type);
3192   if (t1 != 0)
3193     {
3194       obstack_free (TYPE_OBSTACK (type), type);
3195 #ifdef GATHER_STATISTICS
3196       tree_node_counts[(int)t_kind]--;
3197       tree_node_sizes[(int)t_kind] -= sizeof (struct tree_type);
3198 #endif
3199       return t1;
3200     }
3201
3202   /* If this is a permanent type, record it for later reuse.  */
3203   if (TREE_PERMANENT (type))
3204     type_hash_add (hashcode, type);
3205
3206   return type;
3207 }
3208
3209 /* Given two lists of attributes, return true if list l2 is
3210    equivalent to l1.  */
3211
3212 int
3213 attribute_list_equal (l1, l2)
3214      tree l1, l2;
3215 {
3216    return attribute_list_contained (l1, l2)
3217           && attribute_list_contained (l2, l1);
3218 }
3219
3220 /* Given two lists of attributes, return true if list l2 is
3221    completely contained within l1.  */
3222
3223 int
3224 attribute_list_contained (l1, l2)
3225      tree l1, l2;
3226 {
3227   register tree t1, t2;
3228
3229   /* First check the obvious, maybe the lists are identical.  */
3230   if (l1 == l2)
3231      return 1;
3232
3233   /* Then check the obvious, maybe the lists are similar.  */
3234   for (t1 = l1, t2 = l2;
3235        t1 && t2
3236         && TREE_VALUE (t1) == TREE_VALUE (t2);
3237        t1 = TREE_CHAIN (t1), t2 = TREE_CHAIN (t2));
3238
3239   /* Maybe the lists are equal.  */
3240   if (t1 == 0 && t2 == 0)
3241      return 1;
3242
3243   for (; t2; t2 = TREE_CHAIN (t2))
3244      if (!value_member (l1, t2))
3245         return 0;
3246   return 1;
3247 }
3248
3249 /* Given two lists of types
3250    (chains of TREE_LIST nodes with types in the TREE_VALUE slots)
3251    return 1 if the lists contain the same types in the same order.
3252    Also, the TREE_PURPOSEs must match.  */
3253
3254 int
3255 type_list_equal (l1, l2)
3256      tree l1, l2;
3257 {
3258   register tree t1, t2;
3259   for (t1 = l1, t2 = l2; t1 && t2; t1 = TREE_CHAIN (t1), t2 = TREE_CHAIN (t2))
3260     {
3261       if (TREE_VALUE (t1) != TREE_VALUE (t2))
3262         return 0;
3263       if (TREE_PURPOSE (t1) != TREE_PURPOSE (t2))
3264         {
3265           int cmp = simple_cst_equal (TREE_PURPOSE (t1), TREE_PURPOSE (t2));
3266           if (cmp < 0)
3267             abort ();
3268           if (cmp == 0
3269               || TREE_TYPE (TREE_PURPOSE (t1))
3270                  != TREE_TYPE (TREE_PURPOSE (t2)))
3271             return 0;
3272         }
3273     }
3274
3275   return t1 == t2;
3276 }
3277
3278 /* Nonzero if integer constants T1 and T2
3279    represent the same constant value.  */
3280
3281 int
3282 tree_int_cst_equal (t1, t2)
3283      tree t1, t2;
3284 {
3285   if (t1 == t2)
3286     return 1;
3287   if (t1 == 0 || t2 == 0)
3288     return 0;
3289   if (TREE_CODE (t1) == INTEGER_CST
3290       && TREE_CODE (t2) == INTEGER_CST
3291       && TREE_INT_CST_LOW (t1) == TREE_INT_CST_LOW (t2)
3292       && TREE_INT_CST_HIGH (t1) == TREE_INT_CST_HIGH (t2))
3293     return 1;
3294   return 0;
3295 }
3296
3297 /* Nonzero if integer constants T1 and T2 represent values that satisfy <.
3298    The precise way of comparison depends on their data type.  */
3299
3300 int
3301 tree_int_cst_lt (t1, t2)
3302      tree t1, t2;
3303 {
3304   if (t1 == t2)
3305     return 0;
3306
3307   if (!TREE_UNSIGNED (TREE_TYPE (t1)))
3308     return INT_CST_LT (t1, t2);
3309   return INT_CST_LT_UNSIGNED (t1, t2);
3310 }
3311
3312 /* Return an indication of the sign of the integer constant T.
3313    The return value is -1 if T < 0, 0 if T == 0, and 1 if T > 0.
3314    Note that -1 will never be returned it T's type is unsigned.  */
3315
3316 int
3317 tree_int_cst_sgn (t)
3318      tree t;
3319 {
3320   if (TREE_INT_CST_LOW (t) == 0 && TREE_INT_CST_HIGH (t) == 0)
3321     return 0;
3322   else if (TREE_UNSIGNED (TREE_TYPE (t)))
3323     return 1;
3324   else if (TREE_INT_CST_HIGH (t) < 0)
3325     return -1;
3326   else
3327     return 1;
3328 }
3329
3330 /* Compare two constructor-element-type constants.  */
3331 int
3332 simple_cst_list_equal (l1, l2)
3333      tree l1, l2;
3334 {
3335   while (l1 != NULL_TREE && l2 != NULL_TREE)
3336     {
3337       int cmp = simple_cst_equal (TREE_VALUE (l1), TREE_VALUE (l2));
3338       if (cmp < 0)
3339         abort ();
3340       if (cmp == 0)
3341         return 0;
3342       l1 = TREE_CHAIN (l1);
3343       l2 = TREE_CHAIN (l2);
3344     }
3345   return (l1 == l2);
3346 }
3347
3348 /* Return truthvalue of whether T1 is the same tree structure as T2.
3349    Return 1 if they are the same.
3350    Return 0 if they are understandably different.
3351    Return -1 if either contains tree structure not understood by
3352    this function.  */
3353
3354 int
3355 simple_cst_equal (t1, t2)
3356      tree t1, t2;
3357 {
3358   register enum tree_code code1, code2;
3359   int cmp;
3360
3361   if (t1 == t2)
3362     return 1;
3363   if (t1 == 0 || t2 == 0)
3364     return 0;
3365
3366   code1 = TREE_CODE (t1);
3367   code2 = TREE_CODE (t2);
3368
3369   if (code1 == NOP_EXPR || code1 == CONVERT_EXPR || code1 == NON_LVALUE_EXPR)
3370     if (code2 == NOP_EXPR || code2 == CONVERT_EXPR || code2 == NON_LVALUE_EXPR)
3371       return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3372     else
3373       return simple_cst_equal (TREE_OPERAND (t1, 0), t2);
3374   else if (code2 == NOP_EXPR || code2 == CONVERT_EXPR
3375            || code2 == NON_LVALUE_EXPR)
3376     return simple_cst_equal (t1, TREE_OPERAND (t2, 0));
3377
3378   if (code1 != code2)
3379     return 0;
3380
3381   switch (code1)
3382     {
3383     case INTEGER_CST:
3384       return TREE_INT_CST_LOW (t1) == TREE_INT_CST_LOW (t2)
3385         && TREE_INT_CST_HIGH (t1) == TREE_INT_CST_HIGH (t2);
3386
3387     case REAL_CST:
3388       return REAL_VALUES_EQUAL (TREE_REAL_CST (t1), TREE_REAL_CST (t2));
3389
3390     case STRING_CST:
3391       return TREE_STRING_LENGTH (t1) == TREE_STRING_LENGTH (t2)
3392         && !bcmp (TREE_STRING_POINTER (t1), TREE_STRING_POINTER (t2),
3393                   TREE_STRING_LENGTH (t1));
3394
3395     case CONSTRUCTOR:
3396       abort ();
3397
3398     case SAVE_EXPR:
3399       return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3400
3401     case CALL_EXPR:
3402       cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3403       if (cmp <= 0)
3404         return cmp;
3405       return simple_cst_list_equal (TREE_OPERAND (t1, 1), TREE_OPERAND (t2, 1));
3406
3407     case TARGET_EXPR:
3408       /* Special case: if either target is an unallocated VAR_DECL,
3409          it means that it's going to be unified with whatever the
3410          TARGET_EXPR is really supposed to initialize, so treat it
3411          as being equivalent to anything.  */
3412       if ((TREE_CODE (TREE_OPERAND (t1, 0)) == VAR_DECL
3413            && DECL_NAME (TREE_OPERAND (t1, 0)) == NULL_TREE
3414            && DECL_RTL (TREE_OPERAND (t1, 0)) == 0)
3415           || (TREE_CODE (TREE_OPERAND (t2, 0)) == VAR_DECL
3416               && DECL_NAME (TREE_OPERAND (t2, 0)) == NULL_TREE
3417               && DECL_RTL (TREE_OPERAND (t2, 0)) == 0))
3418         cmp = 1;
3419       else
3420         cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3421       if (cmp <= 0)
3422         return cmp;
3423       return simple_cst_equal (TREE_OPERAND (t1, 1), TREE_OPERAND (t2, 1));
3424
3425     case WITH_CLEANUP_EXPR:
3426       cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3427       if (cmp <= 0)
3428         return cmp;
3429       return simple_cst_equal (TREE_OPERAND (t1, 2), TREE_OPERAND (t1, 2));
3430
3431     case COMPONENT_REF:
3432       if (TREE_OPERAND (t1, 1) == TREE_OPERAND (t2, 1))
3433         return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3434       return 0;
3435
3436     case VAR_DECL:
3437     case PARM_DECL:
3438     case CONST_DECL:
3439     case FUNCTION_DECL:
3440       return 0;
3441     }
3442
3443   /* This general rule works for most tree codes.
3444      All exceptions should be handled above.  */
3445
3446   switch (TREE_CODE_CLASS (code1))
3447     {
3448       int i;
3449     case '1':
3450     case '2':
3451     case '<':
3452     case 'e':
3453     case 'r':
3454     case 's':
3455       cmp = 1;
3456       for (i=0; i<tree_code_length[(int) code1]; ++i)
3457         {
3458           cmp = simple_cst_equal (TREE_OPERAND (t1, i), TREE_OPERAND (t2, i));
3459           if (cmp <= 0)
3460             return cmp;
3461         }
3462       return cmp;
3463     }
3464
3465   return -1;
3466 }
3467 \f
3468 /* Constructors for pointer, array and function types.
3469    (RECORD_TYPE, UNION_TYPE and ENUMERAL_TYPE nodes are
3470    constructed by language-dependent code, not here.)  */
3471
3472 /* Construct, lay out and return the type of pointers to TO_TYPE.
3473    If such a type has already been constructed, reuse it.  */
3474
3475 tree
3476 build_pointer_type (to_type)
3477      tree to_type;
3478 {
3479   register tree t = TYPE_POINTER_TO (to_type);
3480
3481   /* First, if we already have a type for pointers to TO_TYPE, use it.  */
3482
3483   if (t)
3484     return t;
3485
3486   /* We need a new one.  Put this in the same obstack as TO_TYPE.   */
3487   push_obstacks (TYPE_OBSTACK (to_type), TYPE_OBSTACK (to_type));
3488   t = make_node (POINTER_TYPE);
3489   pop_obstacks ();
3490
3491   TREE_TYPE (t) = to_type;
3492
3493   /* Record this type as the pointer to TO_TYPE.  */
3494   TYPE_POINTER_TO (to_type) = t;
3495
3496   /* Lay out the type.  This function has many callers that are concerned
3497      with expression-construction, and this simplifies them all.
3498      Also, it guarantees the TYPE_SIZE is in the same obstack as the type.  */
3499   layout_type (t);
3500
3501   return t;
3502 }
3503
3504 /* Create a type of integers to be the TYPE_DOMAIN of an ARRAY_TYPE.
3505    MAXVAL should be the maximum value in the domain
3506    (one less than the length of the array).  */
3507
3508 tree
3509 build_index_type (maxval)
3510      tree maxval;
3511 {
3512   register tree itype = make_node (INTEGER_TYPE);
3513   TYPE_PRECISION (itype) = TYPE_PRECISION (sizetype);
3514   TYPE_MIN_VALUE (itype) = build_int_2 (0, 0);
3515   TREE_TYPE (TYPE_MIN_VALUE (itype)) = sizetype;
3516   TYPE_MAX_VALUE (itype) = convert (sizetype, maxval);
3517   TYPE_MODE (itype) = TYPE_MODE (sizetype);
3518   TYPE_SIZE (itype) = TYPE_SIZE (sizetype);
3519   TYPE_ALIGN (itype) = TYPE_ALIGN (sizetype);
3520   if (TREE_CODE (maxval) == INTEGER_CST)
3521     {
3522       int maxint = (int) TREE_INT_CST_LOW (maxval);
3523       /* If the domain should be empty, make sure the maxval
3524          remains -1 and is not spoiled by truncation.  */
3525       if (INT_CST_LT (maxval, integer_zero_node))
3526         {
3527           TYPE_MAX_VALUE (itype) = build_int_2 (-1, -1);
3528           TREE_TYPE (TYPE_MAX_VALUE (itype)) = sizetype;
3529         }
3530       return type_hash_canon (maxint < 0 ? ~maxint : maxint, itype);
3531     }
3532   else
3533     return itype;
3534 }
3535
3536 /* Create a range of some discrete type TYPE (an INTEGER_TYPE,
3537    ENUMERAL_TYPE, BOOLEAN_TYPE, or CHAR_TYPE), with
3538    low bound LOWVAL and high bound HIGHVAL.
3539    if TYPE==NULL_TREE, sizetype is used. */
3540
3541 tree
3542 build_range_type (type, lowval, highval)
3543      tree type, lowval, highval;
3544 {
3545   register tree itype = make_node (INTEGER_TYPE);
3546   TREE_TYPE (itype) = type;
3547   if (type == NULL_TREE)
3548     type = sizetype;
3549   TYPE_PRECISION (itype) = TYPE_PRECISION (type);
3550   TYPE_MIN_VALUE (itype) = convert (type, lowval);
3551   TYPE_MAX_VALUE (itype) = convert (type, highval);
3552   TYPE_MODE (itype) = TYPE_MODE (type);
3553   TYPE_SIZE (itype) = TYPE_SIZE (type);
3554   TYPE_ALIGN (itype) = TYPE_ALIGN (type);
3555   if ((TREE_CODE (lowval) == INTEGER_CST)
3556       && (TREE_CODE (highval) == INTEGER_CST))
3557     {
3558       HOST_WIDE_INT highint = TREE_INT_CST_LOW (highval);
3559       HOST_WIDE_INT lowint = TREE_INT_CST_LOW (lowval);
3560       int maxint = (int) (highint - lowint);
3561       return type_hash_canon (maxint < 0 ? ~maxint : maxint, itype);
3562     }
3563   else
3564     return itype;
3565 }
3566
3567 /* Just like build_index_type, but takes lowval and highval instead
3568    of just highval (maxval). */
3569
3570 tree
3571 build_index_2_type (lowval,highval)
3572      tree lowval, highval;
3573 {
3574   return build_range_type (NULL_TREE, lowval, highval);
3575 }
3576
3577 /* Return nonzero iff ITYPE1 and ITYPE2 are equal (in the LISP sense).
3578    Needed because when index types are not hashed, equal index types
3579    built at different times appear distinct, even though structurally,
3580    they are not.  */
3581
3582 int
3583 index_type_equal (itype1, itype2)
3584      tree itype1, itype2;
3585 {
3586   if (TREE_CODE (itype1) != TREE_CODE (itype2))
3587     return 0;
3588   if (TREE_CODE (itype1) == INTEGER_TYPE)
3589     {
3590       if (TYPE_PRECISION (itype1) != TYPE_PRECISION (itype2)
3591           || TYPE_MODE (itype1) != TYPE_MODE (itype2)
3592           || ! simple_cst_equal (TYPE_SIZE (itype1), TYPE_SIZE (itype2))
3593           || TYPE_ALIGN (itype1) != TYPE_ALIGN (itype2))
3594         return 0;
3595       if (simple_cst_equal (TYPE_MIN_VALUE (itype1), TYPE_MIN_VALUE (itype2))
3596           && simple_cst_equal (TYPE_MAX_VALUE (itype1), TYPE_MAX_VALUE (itype2)))
3597         return 1;
3598     }
3599   return 0;
3600 }
3601
3602 /* Construct, lay out and return the type of arrays of elements with ELT_TYPE
3603    and number of elements specified by the range of values of INDEX_TYPE.
3604    If such a type has already been constructed, reuse it.  */
3605
3606 tree
3607 build_array_type (elt_type, index_type)
3608      tree elt_type, index_type;
3609 {
3610   register tree t;
3611   int hashcode;
3612
3613   if (TREE_CODE (elt_type) == FUNCTION_TYPE)
3614     {
3615       error ("arrays of functions are not meaningful");
3616       elt_type = integer_type_node;
3617     }
3618
3619   /* Make sure TYPE_POINTER_TO (elt_type) is filled in.  */
3620   build_pointer_type (elt_type);
3621
3622   /* Allocate the array after the pointer type,
3623      in case we free it in type_hash_canon.  */
3624   t = make_node (ARRAY_TYPE);
3625   TREE_TYPE (t) = elt_type;
3626   TYPE_DOMAIN (t) = index_type;
3627
3628   if (index_type == 0)
3629     {
3630       return t;
3631     }
3632
3633   hashcode = TYPE_HASH (elt_type) + TYPE_HASH (index_type);
3634   t = type_hash_canon (hashcode, t);
3635
3636 #if 0 /* This led to crashes, because it could put a temporary node
3637          on the TYPE_NEXT_VARIANT chain of a permanent one.  */
3638   /* The main variant of an array type should always
3639      be an array whose element type is the main variant.  */
3640   if (elt_type != TYPE_MAIN_VARIANT (elt_type))
3641     change_main_variant (t, build_array_type (TYPE_MAIN_VARIANT (elt_type),
3642                                               index_type));
3643 #endif
3644
3645   if (TYPE_SIZE (t) == 0)
3646     layout_type (t);
3647   return t;
3648 }
3649
3650 /* Construct, lay out and return
3651    the type of functions returning type VALUE_TYPE
3652    given arguments of types ARG_TYPES.
3653    ARG_TYPES is a chain of TREE_LIST nodes whose TREE_VALUEs
3654    are data type nodes for the arguments of the function.
3655    If such a type has already been constructed, reuse it.  */
3656
3657 tree
3658 build_function_type (value_type, arg_types)
3659      tree value_type, arg_types;
3660 {
3661   register tree t;
3662   int hashcode;
3663
3664   if (TREE_CODE (value_type) == FUNCTION_TYPE)
3665     {
3666       error ("function return type cannot be function");
3667       value_type = integer_type_node;
3668     }
3669
3670   /* Make a node of the sort we want.  */
3671   t = make_node (FUNCTION_TYPE);
3672   TREE_TYPE (t) = value_type;
3673   TYPE_ARG_TYPES (t) = arg_types;
3674
3675   /* If we already have such a type, use the old one and free this one.  */
3676   hashcode = TYPE_HASH (value_type) + type_hash_list (arg_types);
3677   t = type_hash_canon (hashcode, t);
3678
3679   if (TYPE_SIZE (t) == 0)
3680     layout_type (t);
3681   return t;
3682 }
3683
3684 /* Build the node for the type of references-to-TO_TYPE.  */
3685
3686 tree
3687 build_reference_type (to_type)
3688      tree to_type;
3689 {
3690   register tree t = TYPE_REFERENCE_TO (to_type);
3691   register struct obstack *ambient_obstack = current_obstack;
3692   register struct obstack *ambient_saveable_obstack = saveable_obstack;
3693
3694   /* First, if we already have a type for pointers to TO_TYPE, use it.  */
3695
3696   if (t)
3697     return t;
3698
3699   /* We need a new one.  If TO_TYPE is permanent, make this permanent too.  */
3700   if (TREE_PERMANENT (to_type))
3701     {
3702       current_obstack = &permanent_obstack;
3703       saveable_obstack = &permanent_obstack;
3704     }
3705
3706   t = make_node (REFERENCE_TYPE);
3707   TREE_TYPE (t) = to_type;
3708
3709   /* Record this type as the pointer to TO_TYPE.  */
3710   TYPE_REFERENCE_TO (to_type) = t;
3711
3712   layout_type (t);
3713
3714   current_obstack = ambient_obstack;
3715   saveable_obstack = ambient_saveable_obstack;
3716   return t;
3717 }
3718
3719 /* Construct, lay out and return the type of methods belonging to class
3720    BASETYPE and whose arguments and values are described by TYPE.
3721    If that type exists already, reuse it.
3722    TYPE must be a FUNCTION_TYPE node.  */
3723
3724 tree
3725 build_method_type (basetype, type)
3726      tree basetype, type;
3727 {
3728   register tree t;
3729   int hashcode;
3730
3731   /* Make a node of the sort we want.  */
3732   t = make_node (METHOD_TYPE);
3733
3734   if (TREE_CODE (type) != FUNCTION_TYPE)
3735     abort ();
3736
3737   TYPE_METHOD_BASETYPE (t) = TYPE_MAIN_VARIANT (basetype);
3738   TREE_TYPE (t) = TREE_TYPE (type);
3739
3740   /* The actual arglist for this function includes a "hidden" argument
3741      which is "this".  Put it into the list of argument types.  */
3742
3743   TYPE_ARG_TYPES (t)
3744     = tree_cons (NULL_TREE,
3745                  build_pointer_type (basetype), TYPE_ARG_TYPES (type));
3746
3747   /* If we already have such a type, use the old one and free this one.  */
3748   hashcode = TYPE_HASH (basetype) + TYPE_HASH (type);
3749   t = type_hash_canon (hashcode, t);
3750
3751   if (TYPE_SIZE (t) == 0)
3752     layout_type (t);
3753
3754   return t;
3755 }
3756
3757 /* Construct, lay out and return the type of offsets to a value
3758    of type TYPE, within an object of type BASETYPE.
3759    If a suitable offset type exists already, reuse it.  */
3760
3761 tree
3762 build_offset_type (basetype, type)
3763      tree basetype, type;
3764 {
3765   register tree t;
3766   int hashcode;
3767
3768   /* Make a node of the sort we want.  */
3769   t = make_node (OFFSET_TYPE);
3770
3771   TYPE_OFFSET_BASETYPE (t) = TYPE_MAIN_VARIANT (basetype);
3772   TREE_TYPE (t) = type;
3773
3774   /* If we already have such a type, use the old one and free this one.  */
3775   hashcode = TYPE_HASH (basetype) + TYPE_HASH (type);
3776   t = type_hash_canon (hashcode, t);
3777
3778   if (TYPE_SIZE (t) == 0)
3779     layout_type (t);
3780
3781   return t;
3782 }
3783
3784 /* Create a complex type whose components are COMPONENT_TYPE.  */
3785
3786 tree
3787 build_complex_type (component_type)
3788      tree component_type;
3789 {
3790   register tree t;
3791   int hashcode;
3792
3793   /* Make a node of the sort we want.  */
3794   t = make_node (COMPLEX_TYPE);
3795
3796   TREE_TYPE (t) = TYPE_MAIN_VARIANT (component_type);
3797   TYPE_VOLATILE (t) = TYPE_VOLATILE (component_type);
3798   TYPE_READONLY (t) = TYPE_READONLY (component_type);
3799
3800   /* If we already have such a type, use the old one and free this one.  */
3801   hashcode = TYPE_HASH (component_type);
3802   t = type_hash_canon (hashcode, t);
3803
3804   if (TYPE_SIZE (t) == 0)
3805     layout_type (t);
3806
3807   return t;
3808 }
3809 \f
3810 /* Return OP, stripped of any conversions to wider types as much as is safe.
3811    Converting the value back to OP's type makes a value equivalent to OP.
3812
3813    If FOR_TYPE is nonzero, we return a value which, if converted to
3814    type FOR_TYPE, would be equivalent to converting OP to type FOR_TYPE.
3815
3816    If FOR_TYPE is nonzero, unaligned bit-field references may be changed to the
3817    narrowest type that can hold the value, even if they don't exactly fit.
3818    Otherwise, bit-field references are changed to a narrower type
3819    only if they can be fetched directly from memory in that type.
3820
3821    OP must have integer, real or enumeral type.  Pointers are not allowed!
3822
3823    There are some cases where the obvious value we could return
3824    would regenerate to OP if converted to OP's type, 
3825    but would not extend like OP to wider types.
3826    If FOR_TYPE indicates such extension is contemplated, we eschew such values.
3827    For example, if OP is (unsigned short)(signed char)-1,
3828    we avoid returning (signed char)-1 if FOR_TYPE is int,
3829    even though extending that to an unsigned short would regenerate OP,
3830    since the result of extending (signed char)-1 to (int)
3831    is different from (int) OP.  */
3832
3833 tree
3834 get_unwidened (op, for_type)
3835      register tree op;
3836      tree for_type;
3837 {
3838   /* Set UNS initially if converting OP to FOR_TYPE is a zero-extension.  */
3839   /* TYPE_PRECISION is safe in place of type_precision since
3840      pointer types are not allowed.  */
3841   register tree type = TREE_TYPE (op);
3842   register unsigned final_prec
3843     = TYPE_PRECISION (for_type != 0 ? for_type : type);
3844   register int uns
3845     = (for_type != 0 && for_type != type
3846        && final_prec > TYPE_PRECISION (type)
3847        && TREE_UNSIGNED (type));
3848   register tree win = op;
3849
3850   while (TREE_CODE (op) == NOP_EXPR)
3851     {
3852       register int bitschange
3853         = TYPE_PRECISION (TREE_TYPE (op))
3854           - TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (op, 0)));
3855
3856       /* Truncations are many-one so cannot be removed.
3857          Unless we are later going to truncate down even farther.  */
3858       if (bitschange < 0
3859           && final_prec > TYPE_PRECISION (TREE_TYPE (op)))
3860         break;
3861
3862       /* See what's inside this conversion.  If we decide to strip it,
3863          we will set WIN.  */
3864       op = TREE_OPERAND (op, 0);
3865
3866       /* If we have not stripped any zero-extensions (uns is 0),
3867          we can strip any kind of extension.
3868          If we have previously stripped a zero-extension,
3869          only zero-extensions can safely be stripped.
3870          Any extension can be stripped if the bits it would produce
3871          are all going to be discarded later by truncating to FOR_TYPE.  */
3872
3873       if (bitschange > 0)
3874         {
3875           if (! uns || final_prec <= TYPE_PRECISION (TREE_TYPE (op)))
3876             win = op;
3877           /* TREE_UNSIGNED says whether this is a zero-extension.
3878              Let's avoid computing it if it does not affect WIN
3879              and if UNS will not be needed again.  */
3880           if ((uns || TREE_CODE (op) == NOP_EXPR)
3881               && TREE_UNSIGNED (TREE_TYPE (op)))
3882             {
3883               uns = 1;
3884               win = op;
3885             }
3886         }
3887     }
3888
3889   if (TREE_CODE (op) == COMPONENT_REF
3890       /* Since type_for_size always gives an integer type.  */
3891       && TREE_CODE (type) != REAL_TYPE)
3892     {
3893       unsigned innerprec = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1)));
3894       type = type_for_size (innerprec, TREE_UNSIGNED (TREE_OPERAND (op, 1)));
3895
3896       /* We can get this structure field in the narrowest type it fits in.
3897          If FOR_TYPE is 0, do this only for a field that matches the
3898          narrower type exactly and is aligned for it
3899          The resulting extension to its nominal type (a fullword type)
3900          must fit the same conditions as for other extensions.  */
3901
3902       if (innerprec < TYPE_PRECISION (TREE_TYPE (op))
3903           && (for_type || ! DECL_BIT_FIELD (TREE_OPERAND (op, 1)))
3904           && (! uns || final_prec <= innerprec
3905               || TREE_UNSIGNED (TREE_OPERAND (op, 1)))
3906           && type != 0)
3907         {
3908           win = build (COMPONENT_REF, type, TREE_OPERAND (op, 0),
3909                        TREE_OPERAND (op, 1));
3910           TREE_SIDE_EFFECTS (win) = TREE_SIDE_EFFECTS (op);
3911           TREE_THIS_VOLATILE (win) = TREE_THIS_VOLATILE (op);
3912           TREE_RAISES (win) = TREE_RAISES (op);
3913         }
3914     }
3915   return win;
3916 }
3917 \f
3918 /* Return OP or a simpler expression for a narrower value
3919    which can be sign-extended or zero-extended to give back OP.
3920    Store in *UNSIGNEDP_PTR either 1 if the value should be zero-extended
3921    or 0 if the value should be sign-extended.  */
3922
3923 tree
3924 get_narrower (op, unsignedp_ptr)
3925      register tree op;
3926      int *unsignedp_ptr;
3927 {
3928   register int uns = 0;
3929   int first = 1;
3930   register tree win = op;
3931
3932   while (TREE_CODE (op) == NOP_EXPR)
3933     {
3934       register int bitschange
3935         = TYPE_PRECISION (TREE_TYPE (op))
3936           - TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (op, 0)));
3937
3938       /* Truncations are many-one so cannot be removed.  */
3939       if (bitschange < 0)
3940         break;
3941
3942       /* See what's inside this conversion.  If we decide to strip it,
3943          we will set WIN.  */
3944       op = TREE_OPERAND (op, 0);
3945
3946       if (bitschange > 0)
3947         {
3948           /* An extension: the outermost one can be stripped,
3949              but remember whether it is zero or sign extension.  */
3950           if (first)
3951             uns = TREE_UNSIGNED (TREE_TYPE (op));
3952           /* Otherwise, if a sign extension has been stripped,
3953              only sign extensions can now be stripped;
3954              if a zero extension has been stripped, only zero-extensions.  */
3955           else if (uns != TREE_UNSIGNED (TREE_TYPE (op)))
3956             break;
3957           first = 0;
3958         }
3959       else /* bitschange == 0 */
3960         {
3961           /* A change in nominal type can always be stripped, but we must
3962              preserve the unsignedness.  */
3963           if (first)
3964             uns = TREE_UNSIGNED (TREE_TYPE (op));
3965           first = 0;
3966         }
3967
3968       win = op;
3969     }
3970
3971   if (TREE_CODE (op) == COMPONENT_REF
3972       /* Since type_for_size always gives an integer type.  */
3973       && TREE_CODE (TREE_TYPE (op)) != REAL_TYPE)
3974     {
3975       unsigned innerprec = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1)));
3976       tree type = type_for_size (innerprec, TREE_UNSIGNED (op));
3977
3978       /* We can get this structure field in a narrower type that fits it,
3979          but the resulting extension to its nominal type (a fullword type)
3980          must satisfy the same conditions as for other extensions.
3981
3982          Do this only for fields that are aligned (not bit-fields),
3983          because when bit-field insns will be used there is no
3984          advantage in doing this.  */
3985
3986       if (innerprec < TYPE_PRECISION (TREE_TYPE (op))
3987           && ! DECL_BIT_FIELD (TREE_OPERAND (op, 1))
3988           && (first || uns == TREE_UNSIGNED (TREE_OPERAND (op, 1)))
3989           && type != 0)
3990         {
3991           if (first)
3992             uns = TREE_UNSIGNED (TREE_OPERAND (op, 1));
3993           win = build (COMPONENT_REF, type, TREE_OPERAND (op, 0),
3994                        TREE_OPERAND (op, 1));
3995           TREE_SIDE_EFFECTS (win) = TREE_SIDE_EFFECTS (op);
3996           TREE_THIS_VOLATILE (win) = TREE_THIS_VOLATILE (op);
3997           TREE_RAISES (win) = TREE_RAISES (op);
3998         }
3999     }
4000   *unsignedp_ptr = uns;
4001   return win;
4002 }
4003 \f
4004 /* Return the precision of a type, for arithmetic purposes.
4005    Supports all types on which arithmetic is possible
4006    (including pointer types).
4007    It's not clear yet what will be right for complex types.  */
4008
4009 int
4010 type_precision (type)
4011      register tree type;
4012 {
4013   return ((TREE_CODE (type) == INTEGER_TYPE
4014            || TREE_CODE (type) == ENUMERAL_TYPE
4015            || TREE_CODE (type) == REAL_TYPE)
4016           ? TYPE_PRECISION (type) : POINTER_SIZE);
4017 }
4018
4019 /* Nonzero if integer constant C has a value that is permissible
4020    for type TYPE (an INTEGER_TYPE).  */
4021
4022 int
4023 int_fits_type_p (c, type)
4024      tree c, type;
4025 {
4026   if (TREE_UNSIGNED (type))
4027     return (! (TREE_CODE (TYPE_MAX_VALUE (type)) == INTEGER_CST
4028                && INT_CST_LT_UNSIGNED (TYPE_MAX_VALUE (type), c))
4029             && ! (TREE_CODE (TYPE_MIN_VALUE (type)) == INTEGER_CST
4030                   && INT_CST_LT_UNSIGNED (c, TYPE_MIN_VALUE (type))));
4031   else
4032     return (! (TREE_CODE (TYPE_MAX_VALUE (type)) == INTEGER_CST
4033                && INT_CST_LT (TYPE_MAX_VALUE (type), c))
4034             && ! (TREE_CODE (TYPE_MIN_VALUE (type)) == INTEGER_CST
4035                   && INT_CST_LT (c, TYPE_MIN_VALUE (type))));
4036 }
4037
4038 /* Return the innermost context enclosing DECL that is
4039    a FUNCTION_DECL, or zero if none.  */
4040
4041 tree
4042 decl_function_context (decl)
4043      tree decl;
4044 {
4045   tree context;
4046
4047   if (TREE_CODE (decl) == ERROR_MARK)
4048     return 0;
4049
4050   if (TREE_CODE (decl) == SAVE_EXPR)
4051     context = SAVE_EXPR_CONTEXT (decl);
4052   else
4053     context = DECL_CONTEXT (decl);
4054
4055   while (context && TREE_CODE (context) != FUNCTION_DECL)
4056     {
4057       if (TREE_CODE (context) == RECORD_TYPE
4058           || TREE_CODE (context) == UNION_TYPE)
4059         context = NULL_TREE;
4060       else if (TREE_CODE (context) == TYPE_DECL)
4061         context = DECL_CONTEXT (context);
4062       else if (TREE_CODE (context) == BLOCK)
4063         context = BLOCK_SUPERCONTEXT (context);
4064       else
4065         /* Unhandled CONTEXT !?  */
4066         abort ();
4067     }
4068
4069   return context;
4070 }
4071
4072 /* Return the innermost context enclosing DECL that is
4073    a RECORD_TYPE, UNION_TYPE or QUAL_UNION_TYPE, or zero if none.
4074    TYPE_DECLs and FUNCTION_DECLs are transparent to this function.  */
4075
4076 tree
4077 decl_type_context (decl)
4078      tree decl;
4079 {
4080   tree context = DECL_CONTEXT (decl);
4081
4082   while (context)
4083     {
4084       if (TREE_CODE (context) == RECORD_TYPE
4085           || TREE_CODE (context) == UNION_TYPE
4086           || TREE_CODE (context) == QUAL_UNION_TYPE)
4087         return context;
4088       if (TREE_CODE (context) == TYPE_DECL
4089           || TREE_CODE (context) == FUNCTION_DECL)
4090         context = DECL_CONTEXT (context);
4091       else if (TREE_CODE (context) == BLOCK)
4092         context = BLOCK_SUPERCONTEXT (context);
4093       else
4094         /* Unhandled CONTEXT!?  */
4095         abort ();
4096     }
4097   return NULL_TREE;
4098 }
4099
4100 void
4101 print_obstack_statistics (str, o)
4102      char *str;
4103      struct obstack *o;
4104 {
4105   struct _obstack_chunk *chunk = o->chunk;
4106   int n_chunks = 0;
4107   int n_alloc = 0;
4108
4109   while (chunk)
4110     {
4111       n_chunks += 1;
4112       n_alloc += chunk->limit - &chunk->contents[0];
4113       chunk = chunk->prev;
4114     }
4115   fprintf (stderr, "obstack %s: %d bytes, %d chunks\n",
4116            str, n_alloc, n_chunks);
4117 }
4118 void
4119 dump_tree_statistics ()
4120 {
4121   int i;
4122   int total_nodes, total_bytes;
4123
4124   fprintf (stderr, "\n??? tree nodes created\n\n");
4125 #ifdef GATHER_STATISTICS
4126   fprintf (stderr, "Kind                  Nodes     Bytes\n");
4127   fprintf (stderr, "-------------------------------------\n");
4128   total_nodes = total_bytes = 0;
4129   for (i = 0; i < (int) all_kinds; i++)
4130     {
4131       fprintf (stderr, "%-20s %6d %9d\n", tree_node_kind_names[i],
4132                tree_node_counts[i], tree_node_sizes[i]);
4133       total_nodes += tree_node_counts[i];
4134       total_bytes += tree_node_sizes[i];
4135     }
4136   fprintf (stderr, "%-20s        %9d\n", "identifier names", id_string_size);
4137   fprintf (stderr, "-------------------------------------\n");
4138   fprintf (stderr, "%-20s %6d %9d\n", "Total", total_nodes, total_bytes);
4139   fprintf (stderr, "-------------------------------------\n");
4140 #else
4141   fprintf (stderr, "(No per-node statistics)\n");
4142 #endif
4143   print_lang_statistics ();
4144 }
4145 \f
4146 #define FILE_FUNCTION_PREFIX_LEN 9
4147
4148 #ifndef NO_DOLLAR_IN_LABEL
4149 #define FILE_FUNCTION_FORMAT "_GLOBAL_$D$%s"
4150 #else /* NO_DOLLAR_IN_LABEL */
4151 #ifndef NO_DOT_IN_LABEL
4152 #define FILE_FUNCTION_FORMAT "_GLOBAL_.D.%s"
4153 #else /* NO_DOT_IN_LABEL */
4154 #define FILE_FUNCTION_FORMAT "_GLOBAL__D_%s"
4155 #endif  /* NO_DOT_IN_LABEL */
4156 #endif  /* NO_DOLLAR_IN_LABEL */
4157
4158 extern char * first_global_object_name;
4159
4160 /* If KIND=='I', return a suitable global initializer (constructor) name.
4161    If KIND=='D', return a suitable global clean-up (destructor) name. */
4162
4163 tree
4164 get_file_function_name (kind)
4165      int kind;
4166 {
4167   char *buf;
4168   register char *p;
4169
4170   if (first_global_object_name)
4171     p = first_global_object_name;
4172   else if (main_input_filename)
4173     p = main_input_filename;
4174   else
4175     p = input_filename;
4176
4177   buf = (char *) alloca (sizeof (FILE_FUNCTION_FORMAT) + strlen (p));
4178
4179   /* Set up the name of the file-level functions we may need.  */
4180   /* Use a global object (which is already required to be unique over
4181      the program) rather than the file name (which imposes extra
4182      constraints).  -- Raeburn@MIT.EDU, 10 Jan 1990.  */
4183   sprintf (buf, FILE_FUNCTION_FORMAT, p);
4184
4185   /* Don't need to pull wierd characters out of global names.  */
4186   if (p != first_global_object_name)
4187     {
4188       for (p = buf+11; *p; p++)
4189         if (! ((*p >= '0' && *p <= '9')
4190 #if 0 /* we always want labels, which are valid C++ identifiers (+ `$') */
4191 #ifndef ASM_IDENTIFY_GCC        /* this is required if `.' is invalid -- k. raeburn */
4192                || *p == '.'
4193 #endif
4194 #endif
4195 #ifndef NO_DOLLAR_IN_LABEL      /* this for `$'; unlikely, but... -- kr */
4196                || *p == '$'
4197 #endif
4198 #ifndef NO_DOT_IN_LABEL         /* this for `.'; unlikely, but... */
4199                || *p == '.'
4200 #endif
4201                || (*p >= 'A' && *p <= 'Z')
4202                || (*p >= 'a' && *p <= 'z')))
4203           *p = '_';
4204     }
4205
4206   buf[FILE_FUNCTION_PREFIX_LEN] = kind;
4207
4208   return get_identifier (buf);
4209 }
4210 \f
4211 /* Expand (the constant part of) a SET_TYPE CONTRUCTOR node.
4212    The result is placed in BUFFER (which has length BIT_SIZE),
4213    with one bit in each char ('\000' or '\001').
4214
4215    If the constructor is constant, NULL_TREE is returned.
4216    Otherwise, a TREE_LIST of the non-constant elements is emitted. */
4217
4218 tree
4219 get_set_constructor_bits (init, buffer, bit_size)
4220      tree init;
4221      char *buffer;
4222      int bit_size;
4223 {
4224   int i;
4225   tree vals;
4226   HOST_WIDE_INT domain_min
4227     = TREE_INT_CST_LOW (TYPE_MIN_VALUE (TYPE_DOMAIN (TREE_TYPE (init))));
4228   tree non_const_bits = NULL_TREE;
4229   for (i = 0; i < bit_size; i++)
4230     buffer[i] = 0;
4231
4232   for (vals = TREE_OPERAND (init, 1); 
4233        vals != NULL_TREE; vals = TREE_CHAIN (vals))
4234     {
4235       if (TREE_CODE (TREE_VALUE (vals)) != INTEGER_CST
4236           || (TREE_PURPOSE (vals) != NULL_TREE
4237               && TREE_CODE (TREE_PURPOSE (vals)) != INTEGER_CST))
4238         non_const_bits =
4239           tree_cons (TREE_PURPOSE (vals), TREE_VALUE (vals), non_const_bits);
4240       else if (TREE_PURPOSE (vals) != NULL_TREE)
4241         {
4242           /* Set a range of bits to ones. */
4243           HOST_WIDE_INT lo_index
4244             = TREE_INT_CST_LOW (TREE_PURPOSE (vals)) - domain_min;
4245           HOST_WIDE_INT hi_index
4246             = TREE_INT_CST_LOW (TREE_VALUE (vals)) - domain_min;
4247           if (lo_index < 0 || lo_index >= bit_size
4248             || hi_index < 0 || hi_index >= bit_size)
4249             abort ();
4250           for ( ; lo_index <= hi_index; lo_index++)
4251             buffer[lo_index] = 1;
4252         }
4253       else
4254         {
4255           /* Set a single bit to one. */
4256           HOST_WIDE_INT index
4257             = TREE_INT_CST_LOW (TREE_VALUE (vals)) - domain_min;
4258           if (index < 0 || index >= bit_size)
4259             {
4260               error ("invalid initializer for bit string");
4261               return NULL_TREE;
4262             }
4263           buffer[index] = 1;
4264         }
4265     }
4266   return non_const_bits;
4267 }
4268
4269 /* Expand (the constant part of) a SET_TYPE CONTRUCTOR node.
4270    The result is placed in BUFFER (which is an array of bytes).
4271    If the constructor is constant, NULL_TREE is returned.
4272    Otherwise, a TREE_LIST of the non-constant elements is emitted. */
4273
4274 tree
4275 get_set_constructor_bytes (init, buffer, wd_size)
4276      tree init;
4277      unsigned char *buffer;
4278      int wd_size;
4279 {
4280   int i;
4281   tree vals = TREE_OPERAND (init, 1);
4282   int set_word_size = BITS_PER_UNIT;
4283   int bit_size = wd_size * set_word_size;
4284   int bit_pos = 0;
4285   unsigned char *bytep = buffer;
4286   char *bit_buffer = (char*)alloca(bit_size);
4287   tree non_const_bits = get_set_constructor_bits (init, bit_buffer, bit_size);
4288
4289   for (i = 0; i < wd_size; i++)
4290     buffer[i] = 0;
4291
4292   for (i = 0; i < bit_size; i++)
4293     {
4294       if (bit_buffer[i])
4295         {
4296           if (BITS_BIG_ENDIAN)
4297             *bytep |= (1 << (set_word_size - 1 - bit_pos));
4298           else
4299             *bytep |= 1 << bit_pos;
4300         }
4301       bit_pos++;
4302       if (bit_pos >= set_word_size)
4303         bit_pos = 0, bytep++;
4304     }
4305   return non_const_bits;
4306 }