OSDN Git Service

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