OSDN Git Service

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