OSDN Git Service

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