OSDN Git Service

* jump.c (jump_optimize, follow_jumps, mark_jump_label): Disable some
[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 tree
2144 array_type_nelts (type)
2145      tree type;
2146 {
2147   tree index_type = TYPE_DOMAIN (type);
2148
2149   return (integer_zerop (TYPE_MIN_VALUE (index_type))
2150           ? TYPE_MAX_VALUE (index_type)
2151           : fold (build (MINUS_EXPR, TREE_TYPE (TYPE_MAX_VALUE (index_type)),
2152                          TYPE_MAX_VALUE (index_type),
2153                          TYPE_MIN_VALUE (index_type))));
2154 }
2155 \f
2156 /* Return nonzero if arg is static -- a reference to an object in
2157    static storage.  This is not the same as the C meaning of `static'.  */
2158
2159 int
2160 staticp (arg)
2161      tree arg;
2162 {
2163   switch (TREE_CODE (arg))
2164     {
2165     case FUNCTION_DECL:
2166       /* Nested functions aren't static, since taking their address
2167          involves a trampoline.  */
2168        return decl_function_context (arg) == 0 || DECL_NO_STATIC_CHAIN (arg);
2169     case VAR_DECL:
2170       return TREE_STATIC (arg) || DECL_EXTERNAL (arg);
2171
2172     case CONSTRUCTOR:
2173       return TREE_STATIC (arg);
2174
2175     case STRING_CST:
2176       return 1;
2177
2178       /* If we are referencing a bitfield, we can't evaluate an
2179          ADDR_EXPR at compile time and so it isn't a constant.  */
2180     case COMPONENT_REF:
2181       return (! DECL_BIT_FIELD (TREE_OPERAND (arg, 1))
2182               && staticp (TREE_OPERAND (arg, 0)));
2183
2184     case BIT_FIELD_REF:
2185       return 0;
2186
2187 #if 0
2188        /* This case is technically correct, but results in setting
2189           TREE_CONSTANT on ADDR_EXPRs that cannot be evaluated at
2190           compile time.  */
2191     case INDIRECT_REF:
2192       return TREE_CONSTANT (TREE_OPERAND (arg, 0));
2193 #endif
2194
2195     case ARRAY_REF:
2196       if (TREE_CODE (TYPE_SIZE (TREE_TYPE (arg))) == INTEGER_CST
2197           && TREE_CODE (TREE_OPERAND (arg, 1)) == INTEGER_CST)
2198         return staticp (TREE_OPERAND (arg, 0));
2199     }
2200
2201   return 0;
2202 }
2203 \f
2204 /* Wrap a SAVE_EXPR around EXPR, if appropriate.
2205    Do this to any expression which may be used in more than one place,
2206    but must be evaluated only once.
2207
2208    Normally, expand_expr would reevaluate the expression each time.
2209    Calling save_expr produces something that is evaluated and recorded
2210    the first time expand_expr is called on it.  Subsequent calls to
2211    expand_expr just reuse the recorded value.
2212
2213    The call to expand_expr that generates code that actually computes
2214    the value is the first call *at compile time*.  Subsequent calls
2215    *at compile time* generate code to use the saved value.
2216    This produces correct result provided that *at run time* control
2217    always flows through the insns made by the first expand_expr
2218    before reaching the other places where the save_expr was evaluated.
2219    You, the caller of save_expr, must make sure this is so.
2220
2221    Constants, and certain read-only nodes, are returned with no
2222    SAVE_EXPR because that is safe.  Expressions containing placeholders
2223    are not touched; see tree.def for an explanation of what these
2224    are used for.  */
2225
2226 tree
2227 save_expr (expr)
2228      tree expr;
2229 {
2230   register tree t = fold (expr);
2231
2232   /* We don't care about whether this can be used as an lvalue in this
2233      context.  */
2234   while (TREE_CODE (t) == NON_LVALUE_EXPR)
2235     t = TREE_OPERAND (t, 0);
2236
2237   /* If the tree evaluates to a constant, then we don't want to hide that
2238      fact (i.e. this allows further folding, and direct checks for constants).
2239      However, a read-only object that has side effects cannot be bypassed.
2240      Since it is no problem to reevaluate literals, we just return the 
2241      literal node.  */
2242
2243   if (TREE_CONSTANT (t) || (TREE_READONLY (t) && ! TREE_SIDE_EFFECTS (t))
2244       || TREE_CODE (t) == SAVE_EXPR || TREE_CODE (t) == ERROR_MARK)
2245     return t;
2246
2247   /* If T contains a PLACEHOLDER_EXPR, we must evaluate it each time, since
2248      it means that the size or offset of some field of an object depends on
2249      the value within another field.
2250
2251      Note that it must not be the case that T contains both a PLACEHOLDER_EXPR
2252      and some variable since it would then need to be both evaluated once and
2253      evaluated more than once.  Front-ends must assure this case cannot
2254      happen by surrounding any such subexpressions in their own SAVE_EXPR
2255      and forcing evaluation at the proper time.  */
2256   if (contains_placeholder_p (t))
2257     return t;
2258
2259   t = build (SAVE_EXPR, TREE_TYPE (expr), t, current_function_decl, NULL_TREE);
2260
2261   /* This expression might be placed ahead of a jump to ensure that the
2262      value was computed on both sides of the jump.  So make sure it isn't
2263      eliminated as dead.  */
2264   TREE_SIDE_EFFECTS (t) = 1;
2265   return t;
2266 }
2267
2268 /* Arrange for an expression to be expanded multiple independent
2269    times.  This is useful for cleanup actions, as the backend can
2270    expand them multiple times in different places.  */
2271
2272 tree
2273 unsave_expr (expr)
2274      tree expr;
2275 {
2276   tree t;
2277
2278   /* If this is already protected, no sense in protecting it again.  */
2279   if (TREE_CODE (expr) == UNSAVE_EXPR)
2280     return expr;
2281
2282   t = build1 (UNSAVE_EXPR, TREE_TYPE (expr), expr);
2283   TREE_SIDE_EFFECTS (t) = TREE_SIDE_EFFECTS (expr);
2284   return t;
2285 }
2286
2287 /* Modify a tree in place so that all the evaluate only once things
2288    are cleared out.  Return the EXPR given.  */
2289
2290 tree
2291 unsave_expr_now (expr)
2292      tree expr;
2293 {
2294   enum tree_code code;
2295   register int i;
2296
2297   if (expr == NULL_TREE)
2298     return expr;
2299
2300   code = TREE_CODE (expr);
2301   switch (code)
2302     {
2303     case SAVE_EXPR:
2304       SAVE_EXPR_RTL (expr) = 0;
2305       break;
2306
2307     case TARGET_EXPR:
2308       TREE_OPERAND (expr, 1) = TREE_OPERAND (expr, 3);
2309       TREE_OPERAND (expr, 3) = NULL_TREE;
2310       break;
2311       
2312     case RTL_EXPR:
2313       /* I don't yet know how to emit a sequence multiple times.  */
2314       if (RTL_EXPR_SEQUENCE (expr) != 0)
2315         abort ();
2316       break;
2317
2318     case CALL_EXPR:
2319       CALL_EXPR_RTL (expr) = 0;
2320       if (TREE_OPERAND (expr, 1)
2321           && TREE_CODE (TREE_OPERAND (expr, 1)) == TREE_LIST)
2322         {
2323           tree exp = TREE_OPERAND (expr, 1);
2324           while (exp)
2325             {
2326               unsave_expr_now (TREE_VALUE (exp));
2327               exp = TREE_CHAIN (exp);
2328             }
2329         }
2330       break;
2331     }
2332
2333   switch (TREE_CODE_CLASS (code))
2334     {
2335     case 'c':  /* a constant */
2336     case 't':  /* a type node */
2337     case 'x':  /* something random, like an identifier or an ERROR_MARK.  */
2338     case 'd':  /* A decl node */
2339     case 'b':  /* A block node */
2340       return expr;
2341
2342     case 'e':  /* an expression */
2343     case 'r':  /* a reference */
2344     case 's':  /* an expression with side effects */
2345     case '<':  /* a comparison expression */
2346     case '2':  /* a binary arithmetic expression */
2347     case '1':  /* a unary arithmetic expression */
2348       for (i = tree_code_length[(int) code] - 1; i >= 0; i--)
2349         unsave_expr_now (TREE_OPERAND (expr, i));
2350       return expr;
2351
2352     default:
2353       abort ();
2354     }
2355 }
2356 \f
2357 /* Return 1 if EXP contains a PLACEHOLDER_EXPR; i.e., if it represents a size
2358    or offset that depends on a field within a record.
2359
2360    Note that we only allow such expressions within simple arithmetic
2361    or a COND_EXPR.  */
2362
2363 int
2364 contains_placeholder_p (exp)
2365      tree exp;
2366 {
2367   register enum tree_code code = TREE_CODE (exp);
2368   tree inner;
2369
2370   /* If we have a WITH_RECORD_EXPR, it "cancels" any PLACEHOLDER_EXPR
2371      in it since it is supplying a value for it.  */
2372   if (code == WITH_RECORD_EXPR)
2373     return 0;
2374   else if (code == PLACEHOLDER_EXPR)
2375     return 1;
2376
2377   switch (TREE_CODE_CLASS (code))
2378     {
2379     case 'r':
2380       for (inner = TREE_OPERAND (exp, 0);
2381            TREE_CODE_CLASS (TREE_CODE (inner)) == 'r';
2382            inner = TREE_OPERAND (inner, 0))
2383         ;
2384       return TREE_CODE (inner) == PLACEHOLDER_EXPR;
2385
2386     case '1':
2387     case '2':  case '<':
2388     case 'e':
2389       switch (tree_code_length[(int) code])
2390         {
2391         case 1:
2392           return contains_placeholder_p (TREE_OPERAND (exp, 0));
2393         case 2:
2394           return (code != RTL_EXPR
2395                   && code != CONSTRUCTOR
2396                   && ! (code == SAVE_EXPR && SAVE_EXPR_RTL (exp) != 0)
2397                   && code != WITH_RECORD_EXPR
2398                   && (contains_placeholder_p (TREE_OPERAND (exp, 0))
2399                       || contains_placeholder_p (TREE_OPERAND (exp, 1))));
2400         case 3:
2401           return (code == COND_EXPR
2402                   && (contains_placeholder_p (TREE_OPERAND (exp, 0))
2403                       || contains_placeholder_p (TREE_OPERAND (exp, 1))
2404                       || contains_placeholder_p (TREE_OPERAND (exp, 2))));
2405         }
2406     }
2407
2408   return 0;
2409 }
2410 \f
2411 /* Given a tree EXP, a FIELD_DECL F, and a replacement value R,
2412    return a tree with all occurrences of references to F in a
2413    PLACEHOLDER_EXPR replaced by R.   Note that we assume here that EXP
2414    contains only arithmetic expressions.  */
2415
2416 tree
2417 substitute_in_expr (exp, f, r)
2418      tree exp;
2419      tree f;
2420      tree r;
2421 {
2422   enum tree_code code = TREE_CODE (exp);
2423   tree op0, op1, op2;
2424   tree new = 0;
2425   tree inner;
2426
2427   switch (TREE_CODE_CLASS (code))
2428     {
2429     case 'c':
2430     case 'd':
2431       return exp;
2432
2433     case 'x':
2434       if (code == PLACEHOLDER_EXPR)
2435         return exp;
2436       break;
2437
2438     case '1':
2439     case '2':
2440     case '<':
2441     case 'e':
2442       switch (tree_code_length[(int) code])
2443         {
2444         case 1:
2445           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2446           if (op0 == TREE_OPERAND (exp, 0))
2447             return exp;
2448           
2449           new = fold (build1 (code, TREE_TYPE (exp), op0));
2450           break;
2451
2452         case 2:
2453           /* An RTL_EXPR cannot contain a PLACEHOLDER_EXPR; a CONSTRUCTOR
2454              could, but we don't support it.  */
2455           if (code == RTL_EXPR)
2456             return exp;
2457           else if (code == CONSTRUCTOR)
2458             abort ();
2459
2460           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2461           op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
2462           if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1))
2463             return exp;
2464
2465           new = fold (build (code, TREE_TYPE (exp), op0, op1));
2466           break;
2467
2468         case 3:
2469           /* It cannot be that anything inside a SAVE_EXPR contains a
2470              PLACEHOLDER_EXPR.  */
2471           if (code == SAVE_EXPR)
2472             return exp;
2473
2474           if (code != COND_EXPR)
2475             abort ();
2476
2477           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2478           op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
2479           op2 = substitute_in_expr (TREE_OPERAND (exp, 2), f, r);
2480           if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1)
2481               && op2 == TREE_OPERAND (exp, 2))
2482             return exp;
2483
2484           new = fold (build (code, TREE_TYPE (exp), op0, op1, op2));
2485         }
2486
2487       break;
2488
2489     case 'r':
2490       switch (code)
2491         {
2492         case COMPONENT_REF:
2493           /* If this expression is getting a value from a PLACEHOLDER_EXPR
2494              and it is the right field, replace it with R.  */
2495           for (inner = TREE_OPERAND (exp, 0);
2496                TREE_CODE_CLASS (TREE_CODE (inner)) == 'r';
2497                inner = TREE_OPERAND (inner, 0))
2498             ;
2499           if (TREE_CODE (inner) == PLACEHOLDER_EXPR
2500               && TREE_OPERAND (exp, 1) == f)
2501             return r;
2502
2503           /* If this expression hasn't been completed let, leave it 
2504              alone.  */
2505           if (TREE_CODE (inner) == PLACEHOLDER_EXPR
2506               && TREE_TYPE (inner) == 0)
2507             return exp;
2508
2509           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2510           if (op0 == TREE_OPERAND (exp, 0))
2511             return exp;
2512
2513           new = fold (build (code, TREE_TYPE (exp), op0,
2514                              TREE_OPERAND (exp, 1)));
2515           break;
2516
2517         case BIT_FIELD_REF:
2518           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2519           op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
2520           op2 = substitute_in_expr (TREE_OPERAND (exp, 2), f, r);
2521           if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1)
2522               && op2 == TREE_OPERAND (exp, 2))
2523             return exp;
2524
2525           new = fold (build (code, TREE_TYPE (exp), op0, op1, op2));
2526           break;
2527
2528         case INDIRECT_REF:
2529         case BUFFER_REF:
2530           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2531           if (op0 == TREE_OPERAND (exp, 0))
2532             return exp;
2533
2534           new = fold (build1 (code, TREE_TYPE (exp), op0));
2535           break;
2536         }
2537     }
2538
2539   /* If it wasn't one of the cases we handle, give up.  */
2540   if (new == 0)
2541     abort ();
2542
2543   TREE_READONLY (new) = TREE_READONLY (exp);
2544   return new;
2545 }
2546 \f
2547 /* Stabilize a reference so that we can use it any number of times
2548    without causing its operands to be evaluated more than once.
2549    Returns the stabilized reference.  This works by means of save_expr,
2550    so see the caveats in the comments about save_expr.
2551
2552    Also allows conversion expressions whose operands are references.
2553    Any other kind of expression is returned unchanged.  */
2554
2555 tree
2556 stabilize_reference (ref)
2557      tree ref;
2558 {
2559   register tree result;
2560   register enum tree_code code = TREE_CODE (ref);
2561
2562   switch (code)
2563     {
2564     case VAR_DECL:
2565     case PARM_DECL:
2566     case RESULT_DECL:
2567       /* No action is needed in this case.  */
2568       return ref;
2569
2570     case NOP_EXPR:
2571     case CONVERT_EXPR:
2572     case FLOAT_EXPR:
2573     case FIX_TRUNC_EXPR:
2574     case FIX_FLOOR_EXPR:
2575     case FIX_ROUND_EXPR:
2576     case FIX_CEIL_EXPR:
2577       result = build_nt (code, stabilize_reference (TREE_OPERAND (ref, 0)));
2578       break;
2579
2580     case INDIRECT_REF:
2581       result = build_nt (INDIRECT_REF,
2582                          stabilize_reference_1 (TREE_OPERAND (ref, 0)));
2583       break;
2584
2585     case COMPONENT_REF:
2586       result = build_nt (COMPONENT_REF,
2587                          stabilize_reference (TREE_OPERAND (ref, 0)),
2588                          TREE_OPERAND (ref, 1));
2589       break;
2590
2591     case BIT_FIELD_REF:
2592       result = build_nt (BIT_FIELD_REF,
2593                          stabilize_reference (TREE_OPERAND (ref, 0)),
2594                          stabilize_reference_1 (TREE_OPERAND (ref, 1)),
2595                          stabilize_reference_1 (TREE_OPERAND (ref, 2)));
2596       break;
2597
2598     case ARRAY_REF:
2599       result = build_nt (ARRAY_REF,
2600                          stabilize_reference (TREE_OPERAND (ref, 0)),
2601                          stabilize_reference_1 (TREE_OPERAND (ref, 1)));
2602       break;
2603
2604     case COMPOUND_EXPR:
2605       /* We cannot wrap the first expression in a SAVE_EXPR, as then
2606          it wouldn't be ignored.  This matters when dealing with
2607          volatiles.  */
2608       return stabilize_reference_1 (ref);
2609
2610     case RTL_EXPR:
2611       result = build1 (INDIRECT_REF, TREE_TYPE (ref),
2612                        save_expr (build1 (ADDR_EXPR,
2613                                           build_pointer_type (TREE_TYPE (ref)),
2614                                           ref)));
2615       break;
2616
2617
2618       /* If arg isn't a kind of lvalue we recognize, make no change.
2619          Caller should recognize the error for an invalid lvalue.  */
2620     default:
2621       return ref;
2622
2623     case ERROR_MARK:
2624       return error_mark_node;
2625     }
2626
2627   TREE_TYPE (result) = TREE_TYPE (ref);
2628   TREE_READONLY (result) = TREE_READONLY (ref);
2629   TREE_SIDE_EFFECTS (result) = TREE_SIDE_EFFECTS (ref);
2630   TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
2631   TREE_RAISES (result) = TREE_RAISES (ref);
2632
2633   return result;
2634 }
2635
2636 /* Subroutine of stabilize_reference; this is called for subtrees of
2637    references.  Any expression with side-effects must be put in a SAVE_EXPR
2638    to ensure that it is only evaluated once.
2639
2640    We don't put SAVE_EXPR nodes around everything, because assigning very
2641    simple expressions to temporaries causes us to miss good opportunities
2642    for optimizations.  Among other things, the opportunity to fold in the
2643    addition of a constant into an addressing mode often gets lost, e.g.
2644    "y[i+1] += x;".  In general, we take the approach that we should not make
2645    an assignment unless we are forced into it - i.e., that any non-side effect
2646    operator should be allowed, and that cse should take care of coalescing
2647    multiple utterances of the same expression should that prove fruitful.  */
2648
2649 tree
2650 stabilize_reference_1 (e)
2651      tree e;
2652 {
2653   register tree result;
2654   register enum tree_code code = TREE_CODE (e);
2655
2656   /* We cannot ignore const expressions because it might be a reference
2657      to a const array but whose index contains side-effects.  But we can
2658      ignore things that are actual constant or that already have been
2659      handled by this function.  */
2660
2661   if (TREE_CONSTANT (e) || code == SAVE_EXPR)
2662     return e;
2663
2664   switch (TREE_CODE_CLASS (code))
2665     {
2666     case 'x':
2667     case 't':
2668     case 'd':
2669     case 'b':
2670     case '<':
2671     case 's':
2672     case 'e':
2673     case 'r':
2674       /* If the expression has side-effects, then encase it in a SAVE_EXPR
2675          so that it will only be evaluated once.  */
2676       /* The reference (r) and comparison (<) classes could be handled as
2677          below, but it is generally faster to only evaluate them once.  */
2678       if (TREE_SIDE_EFFECTS (e))
2679         return save_expr (e);
2680       return e;
2681
2682     case 'c':
2683       /* Constants need no processing.  In fact, we should never reach
2684          here.  */
2685       return e;
2686       
2687     case '2':
2688       /* Division is slow and tends to be compiled with jumps,
2689          especially the division by powers of 2 that is often
2690          found inside of an array reference.  So do it just once.  */
2691       if (code == TRUNC_DIV_EXPR || code == TRUNC_MOD_EXPR
2692           || code == FLOOR_DIV_EXPR || code == FLOOR_MOD_EXPR
2693           || code == CEIL_DIV_EXPR || code == CEIL_MOD_EXPR
2694           || code == ROUND_DIV_EXPR || code == ROUND_MOD_EXPR)
2695         return save_expr (e);
2696       /* Recursively stabilize each operand.  */
2697       result = build_nt (code, stabilize_reference_1 (TREE_OPERAND (e, 0)),
2698                          stabilize_reference_1 (TREE_OPERAND (e, 1)));
2699       break;
2700
2701     case '1':
2702       /* Recursively stabilize each operand.  */
2703       result = build_nt (code, stabilize_reference_1 (TREE_OPERAND (e, 0)));
2704       break;
2705
2706     default:
2707       abort ();
2708     }
2709   
2710   TREE_TYPE (result) = TREE_TYPE (e);
2711   TREE_READONLY (result) = TREE_READONLY (e);
2712   TREE_SIDE_EFFECTS (result) = TREE_SIDE_EFFECTS (e);
2713   TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
2714   TREE_RAISES (result) = TREE_RAISES (e);
2715
2716   return result;
2717 }
2718 \f
2719 /* Low-level constructors for expressions.  */
2720
2721 /* Build an expression of code CODE, data type TYPE,
2722    and operands as specified by the arguments ARG1 and following arguments.
2723    Expressions and reference nodes can be created this way.
2724    Constants, decls, types and misc nodes cannot be.  */
2725
2726 tree
2727 build VPROTO((enum tree_code code, tree tt, ...))
2728 {
2729 #ifndef __STDC__
2730   enum tree_code code;
2731   tree tt;
2732 #endif
2733   va_list p;
2734   register tree t;
2735   register int length;
2736   register int i;
2737
2738   VA_START (p, tt);
2739
2740 #ifndef __STDC__
2741   code = va_arg (p, enum tree_code);
2742   tt = va_arg (p, tree);
2743 #endif
2744
2745   t = make_node (code);
2746   length = tree_code_length[(int) code];
2747   TREE_TYPE (t) = tt;
2748
2749   if (length == 2)
2750     {
2751       /* This is equivalent to the loop below, but faster.  */
2752       register tree arg0 = va_arg (p, tree);
2753       register tree arg1 = va_arg (p, tree);
2754       TREE_OPERAND (t, 0) = arg0;
2755       TREE_OPERAND (t, 1) = arg1;
2756       if ((arg0 && TREE_SIDE_EFFECTS (arg0))
2757           || (arg1 && TREE_SIDE_EFFECTS (arg1)))
2758         TREE_SIDE_EFFECTS (t) = 1;
2759       TREE_RAISES (t)
2760         = (arg0 && TREE_RAISES (arg0)) || (arg1 && TREE_RAISES (arg1));
2761     }
2762   else if (length == 1)
2763     {
2764       register tree arg0 = va_arg (p, tree);
2765
2766       /* Call build1 for this!  */
2767       if (TREE_CODE_CLASS (code) != 's')
2768         abort ();
2769       TREE_OPERAND (t, 0) = arg0;
2770       if (arg0 && TREE_SIDE_EFFECTS (arg0))
2771         TREE_SIDE_EFFECTS (t) = 1;
2772       TREE_RAISES (t) = (arg0 && TREE_RAISES (arg0));
2773     }
2774   else
2775     {
2776       for (i = 0; i < length; i++)
2777         {
2778           register tree operand = va_arg (p, tree);
2779           TREE_OPERAND (t, i) = operand;
2780           if (operand)
2781             {
2782               if (TREE_SIDE_EFFECTS (operand))
2783                 TREE_SIDE_EFFECTS (t) = 1;
2784               if (TREE_RAISES (operand))
2785                 TREE_RAISES (t) = 1;
2786             }
2787         }
2788     }
2789   va_end (p);
2790   return t;
2791 }
2792
2793 /* Same as above, but only builds for unary operators.
2794    Saves lions share of calls to `build'; cuts down use
2795    of varargs, which is expensive for RISC machines.  */
2796
2797 tree
2798 build1 (code, type, node)
2799      enum tree_code code;
2800      tree type;
2801      tree node;
2802 {
2803   register struct obstack *obstack = expression_obstack;
2804   register int i, length;
2805   register tree_node_kind kind;
2806   register tree t;
2807
2808 #ifdef GATHER_STATISTICS
2809   if (TREE_CODE_CLASS (code) == 'r')
2810     kind = r_kind;
2811   else
2812     kind = e_kind;
2813 #endif
2814
2815   length = sizeof (struct tree_exp);
2816
2817   t = (tree) obstack_alloc (obstack, length);
2818
2819 #ifdef GATHER_STATISTICS
2820   tree_node_counts[(int)kind]++;
2821   tree_node_sizes[(int)kind] += length;
2822 #endif
2823
2824   for (i = (length / sizeof (int)) - 1; i >= 0; i--)
2825     ((int *) t)[i] = 0;
2826
2827   TREE_TYPE (t) = type;
2828   TREE_SET_CODE (t, code);
2829
2830   if (obstack == &permanent_obstack)
2831     TREE_PERMANENT (t) = 1;
2832
2833   TREE_OPERAND (t, 0) = node;
2834   if (node)
2835     {
2836       if (TREE_SIDE_EFFECTS (node))
2837         TREE_SIDE_EFFECTS (t) = 1;
2838       if (TREE_RAISES (node))
2839         TREE_RAISES (t) = 1;
2840     }
2841
2842   return t;
2843 }
2844
2845 /* Similar except don't specify the TREE_TYPE
2846    and leave the TREE_SIDE_EFFECTS as 0.
2847    It is permissible for arguments to be null,
2848    or even garbage if their values do not matter.  */
2849
2850 tree
2851 build_nt VPROTO((enum tree_code code, ...))
2852 {
2853 #ifndef __STDC__
2854   enum tree_code code;
2855 #endif
2856   va_list p;
2857   register tree t;
2858   register int length;
2859   register int i;
2860
2861   VA_START (p, code);
2862
2863 #ifndef __STDC__
2864   code = va_arg (p, enum tree_code);
2865 #endif
2866
2867   t = make_node (code);
2868   length = tree_code_length[(int) code];
2869
2870   for (i = 0; i < length; i++)
2871     TREE_OPERAND (t, i) = va_arg (p, tree);
2872
2873   va_end (p);
2874   return t;
2875 }
2876
2877 /* Similar to `build_nt', except we build
2878    on the temp_decl_obstack, regardless.  */
2879
2880 tree
2881 build_parse_node VPROTO((enum tree_code code, ...))
2882 {
2883 #ifndef __STDC__
2884   enum tree_code code;
2885 #endif
2886   register struct obstack *ambient_obstack = expression_obstack;
2887   va_list p;
2888   register tree t;
2889   register int length;
2890   register int i;
2891
2892   VA_START (p, code);
2893
2894 #ifndef __STDC__
2895   code = va_arg (p, enum tree_code);
2896 #endif
2897
2898   expression_obstack = &temp_decl_obstack;
2899
2900   t = make_node (code);
2901   length = tree_code_length[(int) code];
2902
2903   for (i = 0; i < length; i++)
2904     TREE_OPERAND (t, i) = va_arg (p, tree);
2905
2906   va_end (p);
2907   expression_obstack = ambient_obstack;
2908   return t;
2909 }
2910
2911 #if 0
2912 /* Commented out because this wants to be done very
2913    differently.  See cp-lex.c.  */
2914 tree
2915 build_op_identifier (op1, op2)
2916      tree op1, op2;
2917 {
2918   register tree t = make_node (OP_IDENTIFIER);
2919   TREE_PURPOSE (t) = op1;
2920   TREE_VALUE (t) = op2;
2921   return t;
2922 }
2923 #endif
2924 \f
2925 /* Create a DECL_... node of code CODE, name NAME and data type TYPE.
2926    We do NOT enter this node in any sort of symbol table.
2927
2928    layout_decl is used to set up the decl's storage layout.
2929    Other slots are initialized to 0 or null pointers.  */
2930
2931 tree
2932 build_decl (code, name, type)
2933      enum tree_code code;
2934      tree name, type;
2935 {
2936   register tree t;
2937
2938   t = make_node (code);
2939
2940 /*  if (type == error_mark_node)
2941     type = integer_type_node; */
2942 /* That is not done, deliberately, so that having error_mark_node
2943    as the type can suppress useless errors in the use of this variable.  */
2944
2945   DECL_NAME (t) = name;
2946   DECL_ASSEMBLER_NAME (t) = name;
2947   TREE_TYPE (t) = type;
2948
2949   if (code == VAR_DECL || code == PARM_DECL || code == RESULT_DECL)
2950     layout_decl (t, 0);
2951   else if (code == FUNCTION_DECL)
2952     DECL_MODE (t) = FUNCTION_MODE;
2953
2954   return t;
2955 }
2956 \f
2957 /* BLOCK nodes are used to represent the structure of binding contours
2958    and declarations, once those contours have been exited and their contents
2959    compiled.  This information is used for outputting debugging info.  */
2960
2961 tree
2962 build_block (vars, tags, subblocks, supercontext, chain)
2963      tree vars, tags, subblocks, supercontext, chain;
2964 {
2965   register tree block = make_node (BLOCK);
2966   BLOCK_VARS (block) = vars;
2967   BLOCK_TYPE_TAGS (block) = tags;
2968   BLOCK_SUBBLOCKS (block) = subblocks;
2969   BLOCK_SUPERCONTEXT (block) = supercontext;
2970   BLOCK_CHAIN (block) = chain;
2971   return block;
2972 }
2973 \f
2974 /* Return a declaration like DDECL except that its DECL_MACHINE_ATTRIBUTE
2975    is ATTRIBUTE.  */
2976
2977 tree
2978 build_decl_attribute_variant (ddecl, attribute)
2979      tree ddecl, attribute;
2980 {
2981   DECL_MACHINE_ATTRIBUTES (ddecl) = attribute;
2982   return ddecl;
2983 }
2984
2985 /* Return a type like TTYPE except that its TYPE_ATTRIBUTE
2986    is ATTRIBUTE.
2987
2988    Record such modified types already made so we don't make duplicates.  */
2989
2990 tree
2991 build_type_attribute_variant (ttype, attribute)
2992      tree ttype, attribute;
2993 {
2994   if ( ! attribute_list_equal (TYPE_ATTRIBUTES (ttype), attribute))
2995     {
2996       register int hashcode;
2997       register struct obstack *ambient_obstack = current_obstack;
2998       tree ntype;
2999
3000       if (ambient_obstack != &permanent_obstack)
3001         current_obstack = TYPE_OBSTACK (ttype);
3002
3003       ntype = copy_node (ttype);
3004       current_obstack = ambient_obstack;
3005
3006       TYPE_POINTER_TO (ntype) = 0;
3007       TYPE_REFERENCE_TO (ntype) = 0;
3008       TYPE_ATTRIBUTES (ntype) = attribute;
3009
3010       /* Create a new main variant of TYPE.  */
3011       TYPE_MAIN_VARIANT (ntype) = ntype;
3012       TYPE_NEXT_VARIANT (ntype) = 0;
3013       TYPE_READONLY (ntype) = TYPE_VOLATILE (ntype) = 0;
3014
3015       hashcode = TYPE_HASH (TREE_CODE (ntype))
3016                  + TYPE_HASH (TREE_TYPE (ntype))
3017                  + attribute_hash_list (attribute);
3018
3019       switch (TREE_CODE (ntype))
3020         {
3021           case FUNCTION_TYPE:
3022             hashcode += TYPE_HASH (TYPE_ARG_TYPES (ntype));
3023             break;
3024           case ARRAY_TYPE:
3025             hashcode += TYPE_HASH (TYPE_DOMAIN (ntype));
3026             break;
3027           case INTEGER_TYPE:
3028             hashcode += TYPE_HASH (TYPE_MAX_VALUE (ntype));
3029             break;
3030           case REAL_TYPE:
3031             hashcode += TYPE_HASH (TYPE_PRECISION (ntype));
3032             break;
3033         }
3034
3035       ntype = type_hash_canon (hashcode, ntype);
3036       ttype = build_type_variant (ntype, TYPE_READONLY (ttype),
3037                                   TYPE_VOLATILE (ttype));
3038     }
3039
3040   return ttype;
3041 }
3042
3043 /* Return a 1 if ATTR_NAME and ATTR_ARGS is valid for either declaration DECL
3044    or type TYPE and 0 otherwise.  Validity is determined the configuration
3045    macros VALID_MACHINE_DECL_ATTRIBUTE and VALID_MACHINE_TYPE_ATTRIBUTE.  */
3046
3047 int
3048 valid_machine_attribute (attr_name, attr_args, decl, type)
3049      tree attr_name, attr_args;
3050      tree decl;
3051      tree type;
3052 {
3053   int valid = 0;
3054   tree decl_attr_list = decl != 0 ? DECL_MACHINE_ATTRIBUTES (decl) : 0;
3055   tree type_attr_list = TYPE_ATTRIBUTES (type);
3056
3057   if (TREE_CODE (attr_name) != IDENTIFIER_NODE)
3058     abort ();
3059
3060 #ifdef VALID_MACHINE_DECL_ATTRIBUTE
3061   if (decl != 0
3062       && VALID_MACHINE_DECL_ATTRIBUTE (decl, decl_attr_list, attr_name, attr_args))
3063     {
3064       tree attr = lookup_attribute (IDENTIFIER_POINTER (attr_name),
3065                                     decl_attr_list);
3066
3067       if (attr != NULL_TREE)
3068         {
3069           /* Override existing arguments.  Declarations are unique so we can
3070              modify this in place.  */
3071           TREE_VALUE (attr) = attr_args;
3072         }
3073       else
3074         {
3075           decl_attr_list = tree_cons (attr_name, attr_args, decl_attr_list);
3076           decl = build_decl_attribute_variant (decl, decl_attr_list);
3077         }
3078
3079       valid = 1;
3080     }
3081 #endif
3082
3083 #ifdef VALID_MACHINE_TYPE_ATTRIBUTE
3084   if (VALID_MACHINE_TYPE_ATTRIBUTE (type, type_attr_list, attr_name, attr_args))
3085     {
3086       tree attr = lookup_attribute (IDENTIFIER_POINTER (attr_name),
3087                                     type_attr_list);
3088
3089       if (attr != NULL_TREE)
3090         {
3091           /* Override existing arguments.
3092              ??? This currently works since attribute arguments are not
3093              included in `attribute_hash_list'.  Something more complicated
3094              may be needed in the future.  */
3095           TREE_VALUE (attr) = attr_args;
3096         }
3097       else
3098         {
3099           type_attr_list = tree_cons (attr_name, attr_args, type_attr_list);
3100           type = build_type_attribute_variant (type, type_attr_list);
3101         }
3102       if (decl != 0)
3103         TREE_TYPE (decl) = type;
3104       valid = 1;
3105     }
3106
3107   /* Handle putting a type attribute on pointer-to-function-type by putting
3108      the attribute on the function type.  */
3109   else if (TREE_CODE (type) == POINTER_TYPE
3110            && TREE_CODE (TREE_TYPE (type)) == FUNCTION_TYPE
3111            && VALID_MACHINE_TYPE_ATTRIBUTE (TREE_TYPE (type), type_attr_list,
3112                                             attr_name, attr_args))
3113     {
3114       tree inner_type = TREE_TYPE (type);
3115       tree inner_attr_list = TYPE_ATTRIBUTES (inner_type);
3116       tree attr = lookup_attribute (IDENTIFIER_POINTER (attr_name),
3117                                     type_attr_list);
3118
3119       if (attr != NULL_TREE)
3120         TREE_VALUE (attr) = attr_args;
3121       else
3122         {
3123           inner_attr_list = tree_cons (attr_name, attr_args, inner_attr_list);
3124           inner_type = build_type_attribute_variant (inner_type,
3125                                                      inner_attr_list);
3126         }
3127
3128       if (decl != 0)
3129         TREE_TYPE (decl) = build_pointer_type (inner_type);
3130
3131       valid = 1;
3132     }
3133 #endif
3134
3135   return valid;
3136 }
3137
3138 /* Return non-zero if IDENT is a valid name for attribute ATTR,
3139    or zero if not.
3140
3141    We try both `text' and `__text__', ATTR may be either one.  */
3142 /* ??? It might be a reasonable simplification to require ATTR to be only
3143    `text'.  One might then also require attribute lists to be stored in
3144    their canonicalized form.  */
3145
3146 int
3147 is_attribute_p (attr, ident)
3148      char *attr;
3149      tree ident;
3150 {
3151   int ident_len, attr_len;
3152   char *p;
3153
3154   if (TREE_CODE (ident) != IDENTIFIER_NODE)
3155     return 0;
3156
3157   if (strcmp (attr, IDENTIFIER_POINTER (ident)) == 0)
3158     return 1;
3159
3160   p = IDENTIFIER_POINTER (ident);
3161   ident_len = strlen (p);
3162   attr_len = strlen (attr);
3163
3164   /* If ATTR is `__text__', IDENT must be `text'; and vice versa.  */
3165   if (attr[0] == '_')
3166     {
3167       if (attr[1] != '_'
3168           || attr[attr_len - 2] != '_'
3169           || attr[attr_len - 1] != '_')
3170         abort ();
3171       if (ident_len == attr_len - 4
3172           && strncmp (attr + 2, p, attr_len - 4) == 0)
3173         return 1;
3174     }
3175   else
3176     {
3177       if (ident_len == attr_len + 4
3178           && p[0] == '_' && p[1] == '_'
3179           && p[ident_len - 2] == '_' && p[ident_len - 1] == '_'
3180           && strncmp (attr, p + 2, attr_len) == 0)
3181         return 1;
3182     }
3183
3184   return 0;
3185 }
3186
3187 /* Given an attribute name and a list of attributes, return a pointer to the
3188    attribute's list element if the attribute is part of the list, or NULL_TREE
3189    if not found.  */
3190
3191 tree
3192 lookup_attribute (attr_name, list)
3193      char *attr_name;
3194      tree list;
3195 {
3196   tree l;
3197
3198   for (l = list; l; l = TREE_CHAIN (l))
3199     {
3200       if (TREE_CODE (TREE_PURPOSE (l)) != IDENTIFIER_NODE)
3201         abort ();
3202       if (is_attribute_p (attr_name, TREE_PURPOSE (l)))
3203         return l;
3204     }
3205
3206   return NULL_TREE;
3207 }
3208
3209 /* Return an attribute list that is the union of a1 and a2.  */
3210
3211 tree
3212 merge_attributes (a1, a2)
3213      register tree a1, a2;
3214 {
3215   tree attributes;
3216
3217   /* Either one unset?  Take the set one.  */
3218
3219   if (! (attributes = a1))
3220     attributes = a2;
3221
3222   /* One that completely contains the other?  Take it.  */
3223
3224   else if (a2 && ! attribute_list_contained (a1, a2))
3225     if (attribute_list_contained (a2, a1))
3226       attributes = a2;
3227     else
3228       {
3229         /* Pick the longest list, and hang on the other list.  */
3230         /* ??? For the moment we punt on the issue of attrs with args.  */
3231
3232         if (list_length (a1) < list_length (a2))
3233           attributes = a2, a2 = a1;
3234
3235         for (; a2; a2 = TREE_CHAIN (a2))
3236           if (lookup_attribute (IDENTIFIER_POINTER (TREE_PURPOSE (a2)),
3237                                 attributes) == NULL_TREE)
3238             {
3239               a1 = copy_node (a2);
3240               TREE_CHAIN (a1) = attributes;
3241               attributes = a1;
3242             }
3243       }
3244   return attributes;
3245 }
3246 \f
3247 /* Return a type like TYPE except that its TYPE_READONLY is CONSTP
3248    and its TYPE_VOLATILE is VOLATILEP.
3249
3250    Such variant types already made are recorded so that duplicates
3251    are not made.
3252
3253    A variant types should never be used as the type of an expression.
3254    Always copy the variant information into the TREE_READONLY
3255    and TREE_THIS_VOLATILE of the expression, and then give the expression
3256    as its type the "main variant", the variant whose TYPE_READONLY
3257    and TYPE_VOLATILE are zero.  Use TYPE_MAIN_VARIANT to find the
3258    main variant.  */
3259
3260 tree
3261 build_type_variant (type, constp, volatilep)
3262      tree type;
3263      int constp, volatilep;
3264 {
3265   register tree t;
3266
3267   /* Treat any nonzero argument as 1.  */
3268   constp = !!constp;
3269   volatilep = !!volatilep;
3270
3271   /* Search the chain of variants to see if there is already one there just
3272      like the one we need to have.  If so, use that existing one.  We must
3273      preserve the TYPE_NAME, since there is code that depends on this.  */
3274
3275   for (t = TYPE_MAIN_VARIANT (type); t; t = TYPE_NEXT_VARIANT (t))
3276     if (constp == TYPE_READONLY (t) && volatilep == TYPE_VOLATILE (t)
3277         && TYPE_NAME (t) == TYPE_NAME (type))
3278       return t;
3279
3280   /* We need a new one.  */
3281
3282   t = build_type_copy (type);
3283   TYPE_READONLY (t) = constp;
3284   TYPE_VOLATILE (t) = volatilep;
3285
3286   return t;
3287 }
3288
3289 /* Give TYPE a new main variant: NEW_MAIN.
3290    This is the right thing to do only when something else
3291    about TYPE is modified in place.  */
3292
3293 void
3294 change_main_variant (type, new_main)
3295      tree type, new_main;
3296 {
3297   tree t;
3298   tree omain = TYPE_MAIN_VARIANT (type);
3299
3300   /* Remove TYPE from the TYPE_NEXT_VARIANT chain of its main variant.  */
3301   if (TYPE_NEXT_VARIANT (omain) == type)
3302     TYPE_NEXT_VARIANT (omain) = TYPE_NEXT_VARIANT (type);
3303   else
3304     for (t = TYPE_NEXT_VARIANT (omain); t && TYPE_NEXT_VARIANT (t);
3305          t = TYPE_NEXT_VARIANT (t))
3306       if (TYPE_NEXT_VARIANT (t) == type)
3307         {
3308           TYPE_NEXT_VARIANT (t) = TYPE_NEXT_VARIANT (type);
3309           break;
3310         }
3311
3312   TYPE_MAIN_VARIANT (type) = new_main;
3313   TYPE_NEXT_VARIANT (type) = TYPE_NEXT_VARIANT (new_main);
3314   TYPE_NEXT_VARIANT (new_main) = type;
3315 }
3316
3317 /* Create a new variant of TYPE, equivalent but distinct.
3318    This is so the caller can modify it.  */
3319
3320 tree
3321 build_type_copy (type)
3322      tree type;
3323 {
3324   register tree t, m = TYPE_MAIN_VARIANT (type);
3325   register struct obstack *ambient_obstack = current_obstack;
3326
3327   current_obstack = TYPE_OBSTACK (type);
3328   t = copy_node (type);
3329   current_obstack = ambient_obstack;
3330
3331   TYPE_POINTER_TO (t) = 0;
3332   TYPE_REFERENCE_TO (t) = 0;
3333
3334   /* Add this type to the chain of variants of TYPE.  */
3335   TYPE_NEXT_VARIANT (t) = TYPE_NEXT_VARIANT (m);
3336   TYPE_NEXT_VARIANT (m) = t;
3337
3338   return t;
3339 }
3340 \f
3341 /* Hashing of types so that we don't make duplicates.
3342    The entry point is `type_hash_canon'.  */
3343
3344 /* Each hash table slot is a bucket containing a chain
3345    of these structures.  */
3346
3347 struct type_hash
3348 {
3349   struct type_hash *next;       /* Next structure in the bucket.  */
3350   int hashcode;                 /* Hash code of this type.  */
3351   tree type;                    /* The type recorded here.  */
3352 };
3353
3354 /* Now here is the hash table.  When recording a type, it is added
3355    to the slot whose index is the hash code mod the table size.
3356    Note that the hash table is used for several kinds of types
3357    (function types, array types and array index range types, for now).
3358    While all these live in the same table, they are completely independent,
3359    and the hash code is computed differently for each of these.  */
3360
3361 #define TYPE_HASH_SIZE 59
3362 struct type_hash *type_hash_table[TYPE_HASH_SIZE];
3363
3364 /* Compute a hash code for a list of types (chain of TREE_LIST nodes
3365    with types in the TREE_VALUE slots), by adding the hash codes
3366    of the individual types.  */
3367
3368 int
3369 type_hash_list (list)
3370      tree list;
3371 {
3372   register int hashcode;
3373   register tree tail;
3374   for (hashcode = 0, tail = list; tail; tail = TREE_CHAIN (tail))
3375     hashcode += TYPE_HASH (TREE_VALUE (tail));
3376   return hashcode;
3377 }
3378
3379 /* Look in the type hash table for a type isomorphic to TYPE.
3380    If one is found, return it.  Otherwise return 0.  */
3381
3382 tree
3383 type_hash_lookup (hashcode, type)
3384      int hashcode;
3385      tree type;
3386 {
3387   register struct type_hash *h;
3388   for (h = type_hash_table[hashcode % TYPE_HASH_SIZE]; h; h = h->next)
3389     if (h->hashcode == hashcode
3390         && TREE_CODE (h->type) == TREE_CODE (type)
3391         && TREE_TYPE (h->type) == TREE_TYPE (type)
3392         && attribute_list_equal (TYPE_ATTRIBUTES (h->type),
3393                                    TYPE_ATTRIBUTES (type))
3394         && (TYPE_MAX_VALUE (h->type) == TYPE_MAX_VALUE (type)
3395             || tree_int_cst_equal (TYPE_MAX_VALUE (h->type),
3396                                    TYPE_MAX_VALUE (type)))
3397         && (TYPE_MIN_VALUE (h->type) == TYPE_MIN_VALUE (type)
3398             || tree_int_cst_equal (TYPE_MIN_VALUE (h->type),
3399                                    TYPE_MIN_VALUE (type)))
3400         /* Note that TYPE_DOMAIN is TYPE_ARG_TYPES for FUNCTION_TYPE.  */
3401         && (TYPE_DOMAIN (h->type) == TYPE_DOMAIN (type)
3402             || (TYPE_DOMAIN (h->type)
3403                 && TREE_CODE (TYPE_DOMAIN (h->type)) == TREE_LIST
3404                 && TYPE_DOMAIN (type)
3405                 && TREE_CODE (TYPE_DOMAIN (type)) == TREE_LIST
3406                 && type_list_equal (TYPE_DOMAIN (h->type),
3407                                     TYPE_DOMAIN (type)))))
3408       return h->type;
3409   return 0;
3410 }
3411
3412 /* Add an entry to the type-hash-table
3413    for a type TYPE whose hash code is HASHCODE.  */
3414
3415 void
3416 type_hash_add (hashcode, type)
3417      int hashcode;
3418      tree type;
3419 {
3420   register struct type_hash *h;
3421
3422   h = (struct type_hash *) oballoc (sizeof (struct type_hash));
3423   h->hashcode = hashcode;
3424   h->type = type;
3425   h->next = type_hash_table[hashcode % TYPE_HASH_SIZE];
3426   type_hash_table[hashcode % TYPE_HASH_SIZE] = h;
3427 }
3428
3429 /* Given TYPE, and HASHCODE its hash code, return the canonical
3430    object for an identical type if one already exists.
3431    Otherwise, return TYPE, and record it as the canonical object
3432    if it is a permanent object.
3433
3434    To use this function, first create a type of the sort you want.
3435    Then compute its hash code from the fields of the type that
3436    make it different from other similar types.
3437    Then call this function and use the value.
3438    This function frees the type you pass in if it is a duplicate.  */
3439
3440 /* Set to 1 to debug without canonicalization.  Never set by program.  */
3441 int debug_no_type_hash = 0;
3442
3443 tree
3444 type_hash_canon (hashcode, type)
3445      int hashcode;
3446      tree type;
3447 {
3448   tree t1;
3449
3450   if (debug_no_type_hash)
3451     return type;
3452
3453   t1 = type_hash_lookup (hashcode, type);
3454   if (t1 != 0)
3455     {
3456       obstack_free (TYPE_OBSTACK (type), type);
3457 #ifdef GATHER_STATISTICS
3458       tree_node_counts[(int)t_kind]--;
3459       tree_node_sizes[(int)t_kind] -= sizeof (struct tree_type);
3460 #endif
3461       return t1;
3462     }
3463
3464   /* If this is a permanent type, record it for later reuse.  */
3465   if (TREE_PERMANENT (type))
3466     type_hash_add (hashcode, type);
3467
3468   return type;
3469 }
3470
3471 /* Compute a hash code for a list of attributes (chain of TREE_LIST nodes
3472    with names in the TREE_PURPOSE slots and args in the TREE_VALUE slots),
3473    by adding the hash codes of the individual attributes.  */
3474
3475 int
3476 attribute_hash_list (list)
3477      tree list;
3478 {
3479   register int hashcode;
3480   register tree tail;
3481   for (hashcode = 0, tail = list; tail; tail = TREE_CHAIN (tail))
3482     /* ??? Do we want to add in TREE_VALUE too? */
3483     hashcode += TYPE_HASH (TREE_PURPOSE (tail));
3484   return hashcode;
3485 }
3486
3487 /* Given two lists of attributes, return true if list l2 is
3488    equivalent to l1.  */
3489
3490 int
3491 attribute_list_equal (l1, l2)
3492      tree l1, l2;
3493 {
3494    return attribute_list_contained (l1, l2)
3495           && attribute_list_contained (l2, l1);
3496 }
3497
3498 /* Given two lists of attributes, return true if list L2 is
3499    completely contained within L1.  */
3500 /* ??? This would be faster if attribute names were stored in a canonicalized
3501    form.  Otherwise, if L1 uses `foo' and L2 uses `__foo__', the long method
3502    must be used to show these elements are equivalent (which they are).  */
3503 /* ??? It's not clear that attributes with arguments will always be handled
3504    correctly.  */
3505
3506 int
3507 attribute_list_contained (l1, l2)
3508      tree l1, l2;
3509 {
3510   register tree t1, t2;
3511
3512   /* First check the obvious, maybe the lists are identical.  */
3513   if (l1 == l2)
3514      return 1;
3515
3516   /* Maybe the lists are similar.  */
3517   for (t1 = l1, t2 = l2;
3518        t1 && t2
3519         && TREE_PURPOSE (t1) == TREE_PURPOSE (t2)
3520         && TREE_VALUE (t1) == TREE_VALUE (t2);
3521        t1 = TREE_CHAIN (t1), t2 = TREE_CHAIN (t2));
3522
3523   /* Maybe the lists are equal.  */
3524   if (t1 == 0 && t2 == 0)
3525      return 1;
3526
3527   for (; t2; t2 = TREE_CHAIN (t2))
3528     {
3529       tree attr
3530         = lookup_attribute (IDENTIFIER_POINTER (TREE_PURPOSE (t2)), l1);
3531
3532       if (attr == NULL_TREE)
3533         return 0;
3534       if (simple_cst_equal (TREE_VALUE (t2), TREE_VALUE (attr)) != 1)
3535         return 0;
3536     }
3537
3538   return 1;
3539 }
3540
3541 /* Given two lists of types
3542    (chains of TREE_LIST nodes with types in the TREE_VALUE slots)
3543    return 1 if the lists contain the same types in the same order.
3544    Also, the TREE_PURPOSEs must match.  */
3545
3546 int
3547 type_list_equal (l1, l2)
3548      tree l1, l2;
3549 {
3550   register tree t1, t2;
3551
3552   for (t1 = l1, t2 = l2; t1 && t2; t1 = TREE_CHAIN (t1), t2 = TREE_CHAIN (t2))
3553     if (TREE_VALUE (t1) != TREE_VALUE (t2)
3554         || (TREE_PURPOSE (t1) != TREE_PURPOSE (t2)
3555             && ! (1 == simple_cst_equal (TREE_PURPOSE (t1), TREE_PURPOSE (t2))
3556                   && (TREE_TYPE (TREE_PURPOSE (t1))
3557                       == TREE_TYPE (TREE_PURPOSE (t2))))))
3558       return 0;
3559
3560   return t1 == t2;
3561 }
3562
3563 /* Nonzero if integer constants T1 and T2
3564    represent the same constant value.  */
3565
3566 int
3567 tree_int_cst_equal (t1, t2)
3568      tree t1, t2;
3569 {
3570   if (t1 == t2)
3571     return 1;
3572   if (t1 == 0 || t2 == 0)
3573     return 0;
3574   if (TREE_CODE (t1) == INTEGER_CST
3575       && TREE_CODE (t2) == INTEGER_CST
3576       && TREE_INT_CST_LOW (t1) == TREE_INT_CST_LOW (t2)
3577       && TREE_INT_CST_HIGH (t1) == TREE_INT_CST_HIGH (t2))
3578     return 1;
3579   return 0;
3580 }
3581
3582 /* Nonzero if integer constants T1 and T2 represent values that satisfy <.
3583    The precise way of comparison depends on their data type.  */
3584
3585 int
3586 tree_int_cst_lt (t1, t2)
3587      tree t1, t2;
3588 {
3589   if (t1 == t2)
3590     return 0;
3591
3592   if (!TREE_UNSIGNED (TREE_TYPE (t1)))
3593     return INT_CST_LT (t1, t2);
3594   return INT_CST_LT_UNSIGNED (t1, t2);
3595 }
3596
3597 /* Return an indication of the sign of the integer constant T.
3598    The return value is -1 if T < 0, 0 if T == 0, and 1 if T > 0.
3599    Note that -1 will never be returned it T's type is unsigned.  */
3600
3601 int
3602 tree_int_cst_sgn (t)
3603      tree t;
3604 {
3605   if (TREE_INT_CST_LOW (t) == 0 && TREE_INT_CST_HIGH (t) == 0)
3606     return 0;
3607   else if (TREE_UNSIGNED (TREE_TYPE (t)))
3608     return 1;
3609   else if (TREE_INT_CST_HIGH (t) < 0)
3610     return -1;
3611   else
3612     return 1;
3613 }
3614
3615 /* Compare two constructor-element-type constants.  Return 1 if the lists
3616    are known to be equal; otherwise return 0.  */
3617
3618 int
3619 simple_cst_list_equal (l1, l2)
3620      tree l1, l2;
3621 {
3622   while (l1 != NULL_TREE && l2 != NULL_TREE)
3623     {
3624       if (simple_cst_equal (TREE_VALUE (l1), TREE_VALUE (l2)) != 1)
3625         return 0;
3626
3627       l1 = TREE_CHAIN (l1);
3628       l2 = TREE_CHAIN (l2);
3629     }
3630
3631   return (l1 == l2);
3632 }
3633
3634 /* Return truthvalue of whether T1 is the same tree structure as T2.
3635    Return 1 if they are the same.
3636    Return 0 if they are understandably different.
3637    Return -1 if either contains tree structure not understood by
3638    this function.  */
3639
3640 int
3641 simple_cst_equal (t1, t2)
3642      tree t1, t2;
3643 {
3644   register enum tree_code code1, code2;
3645   int cmp;
3646
3647   if (t1 == t2)
3648     return 1;
3649   if (t1 == 0 || t2 == 0)
3650     return 0;
3651
3652   code1 = TREE_CODE (t1);
3653   code2 = TREE_CODE (t2);
3654
3655   if (code1 == NOP_EXPR || code1 == CONVERT_EXPR || code1 == NON_LVALUE_EXPR)
3656     if (code2 == NOP_EXPR || code2 == CONVERT_EXPR || code2 == NON_LVALUE_EXPR)
3657       return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3658     else
3659       return simple_cst_equal (TREE_OPERAND (t1, 0), t2);
3660   else if (code2 == NOP_EXPR || code2 == CONVERT_EXPR
3661            || code2 == NON_LVALUE_EXPR)
3662     return simple_cst_equal (t1, TREE_OPERAND (t2, 0));
3663
3664   if (code1 != code2)
3665     return 0;
3666
3667   switch (code1)
3668     {
3669     case INTEGER_CST:
3670       return TREE_INT_CST_LOW (t1) == TREE_INT_CST_LOW (t2)
3671         && TREE_INT_CST_HIGH (t1) == TREE_INT_CST_HIGH (t2);
3672
3673     case REAL_CST:
3674       return REAL_VALUES_EQUAL (TREE_REAL_CST (t1), TREE_REAL_CST (t2));
3675
3676     case STRING_CST:
3677       return TREE_STRING_LENGTH (t1) == TREE_STRING_LENGTH (t2)
3678         && !bcmp (TREE_STRING_POINTER (t1), TREE_STRING_POINTER (t2),
3679                   TREE_STRING_LENGTH (t1));
3680
3681     case CONSTRUCTOR:
3682       abort ();
3683
3684     case SAVE_EXPR:
3685       return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3686
3687     case CALL_EXPR:
3688       cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3689       if (cmp <= 0)
3690         return cmp;
3691       return simple_cst_list_equal (TREE_OPERAND (t1, 1), TREE_OPERAND (t2, 1));
3692
3693     case TARGET_EXPR:
3694       /* Special case: if either target is an unallocated VAR_DECL,
3695          it means that it's going to be unified with whatever the
3696          TARGET_EXPR is really supposed to initialize, so treat it
3697          as being equivalent to anything.  */
3698       if ((TREE_CODE (TREE_OPERAND (t1, 0)) == VAR_DECL
3699            && DECL_NAME (TREE_OPERAND (t1, 0)) == NULL_TREE
3700            && DECL_RTL (TREE_OPERAND (t1, 0)) == 0)
3701           || (TREE_CODE (TREE_OPERAND (t2, 0)) == VAR_DECL
3702               && DECL_NAME (TREE_OPERAND (t2, 0)) == NULL_TREE
3703               && DECL_RTL (TREE_OPERAND (t2, 0)) == 0))
3704         cmp = 1;
3705       else
3706         cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3707       if (cmp <= 0)
3708         return cmp;
3709       return simple_cst_equal (TREE_OPERAND (t1, 1), TREE_OPERAND (t2, 1));
3710
3711     case WITH_CLEANUP_EXPR:
3712       cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3713       if (cmp <= 0)
3714         return cmp;
3715       return simple_cst_equal (TREE_OPERAND (t1, 2), TREE_OPERAND (t1, 2));
3716
3717     case COMPONENT_REF:
3718       if (TREE_OPERAND (t1, 1) == TREE_OPERAND (t2, 1))
3719         return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3720       return 0;
3721
3722     case VAR_DECL:
3723     case PARM_DECL:
3724     case CONST_DECL:
3725     case FUNCTION_DECL:
3726       return 0;
3727     }
3728
3729   /* This general rule works for most tree codes.  All exceptions should be
3730      handled above.  If this is a language-specific tree code, we can't
3731      trust what might be in the operand, so say we don't know
3732      the situation.  */
3733   if ((int) code1
3734       >= sizeof standard_tree_code_type / sizeof standard_tree_code_type[0])
3735     return -1;
3736
3737   switch (TREE_CODE_CLASS (code1))
3738     {
3739       int i;
3740     case '1':
3741     case '2':
3742     case '<':
3743     case 'e':
3744     case 'r':
3745     case 's':
3746       cmp = 1;
3747       for (i=0; i<tree_code_length[(int) code1]; ++i)
3748         {
3749           cmp = simple_cst_equal (TREE_OPERAND (t1, i), TREE_OPERAND (t2, i));
3750           if (cmp <= 0)
3751             return cmp;
3752         }
3753       return cmp;
3754     }
3755
3756   return -1;
3757 }
3758 \f
3759 /* Constructors for pointer, array and function types.
3760    (RECORD_TYPE, UNION_TYPE and ENUMERAL_TYPE nodes are
3761    constructed by language-dependent code, not here.)  */
3762
3763 /* Construct, lay out and return the type of pointers to TO_TYPE.
3764    If such a type has already been constructed, reuse it.  */
3765
3766 tree
3767 build_pointer_type (to_type)
3768      tree to_type;
3769 {
3770   register tree t = TYPE_POINTER_TO (to_type);
3771
3772   /* First, if we already have a type for pointers to TO_TYPE, use it.  */
3773
3774   if (t)
3775     return t;
3776
3777   /* We need a new one.  Put this in the same obstack as TO_TYPE.   */
3778   push_obstacks (TYPE_OBSTACK (to_type), TYPE_OBSTACK (to_type));
3779   t = make_node (POINTER_TYPE);
3780   pop_obstacks ();
3781
3782   TREE_TYPE (t) = to_type;
3783
3784   /* Record this type as the pointer to TO_TYPE.  */
3785   TYPE_POINTER_TO (to_type) = t;
3786
3787   /* Lay out the type.  This function has many callers that are concerned
3788      with expression-construction, and this simplifies them all.
3789      Also, it guarantees the TYPE_SIZE is in the same obstack as the type.  */
3790   layout_type (t);
3791
3792   return t;
3793 }
3794
3795 /* Create a type of integers to be the TYPE_DOMAIN of an ARRAY_TYPE.
3796    MAXVAL should be the maximum value in the domain
3797    (one less than the length of the array).  */
3798
3799 tree
3800 build_index_type (maxval)
3801      tree maxval;
3802 {
3803   register tree itype = make_node (INTEGER_TYPE);
3804
3805   TYPE_PRECISION (itype) = TYPE_PRECISION (sizetype);
3806   TYPE_MIN_VALUE (itype) = size_zero_node;
3807
3808   push_obstacks (TYPE_OBSTACK (itype), TYPE_OBSTACK (itype));
3809   TYPE_MAX_VALUE (itype) = convert (sizetype, maxval);
3810   pop_obstacks ();
3811
3812   TYPE_MODE (itype) = TYPE_MODE (sizetype);
3813   TYPE_SIZE (itype) = TYPE_SIZE (sizetype);
3814   TYPE_ALIGN (itype) = TYPE_ALIGN (sizetype);
3815   if (TREE_CODE (maxval) == INTEGER_CST)
3816     {
3817       int maxint = (int) TREE_INT_CST_LOW (maxval);
3818       /* If the domain should be empty, make sure the maxval
3819          remains -1 and is not spoiled by truncation.  */
3820       if (INT_CST_LT (maxval, integer_zero_node))
3821         {
3822           TYPE_MAX_VALUE (itype) = build_int_2 (-1, -1);
3823           TREE_TYPE (TYPE_MAX_VALUE (itype)) = sizetype;
3824         }
3825       return type_hash_canon (maxint < 0 ? ~maxint : maxint, itype);
3826     }
3827   else
3828     return itype;
3829 }
3830
3831 /* Create a range of some discrete type TYPE (an INTEGER_TYPE,
3832    ENUMERAL_TYPE, BOOLEAN_TYPE, or CHAR_TYPE), with
3833    low bound LOWVAL and high bound HIGHVAL.
3834    if TYPE==NULL_TREE, sizetype is used.  */
3835
3836 tree
3837 build_range_type (type, lowval, highval)
3838      tree type, lowval, highval;
3839 {
3840   register tree itype = make_node (INTEGER_TYPE);
3841
3842   TREE_TYPE (itype) = type;
3843   if (type == NULL_TREE)
3844     type = sizetype;
3845
3846   push_obstacks (TYPE_OBSTACK (itype), TYPE_OBSTACK (itype));
3847   TYPE_MIN_VALUE (itype) = convert (type, lowval);
3848   TYPE_MAX_VALUE (itype) = convert (type, highval);
3849   pop_obstacks ();
3850
3851   TYPE_PRECISION (itype) = TYPE_PRECISION (type);
3852   TYPE_MODE (itype) = TYPE_MODE (type);
3853   TYPE_SIZE (itype) = TYPE_SIZE (type);
3854   TYPE_ALIGN (itype) = TYPE_ALIGN (type);
3855   if ((TREE_CODE (lowval) == INTEGER_CST)
3856       && (TREE_CODE (highval) == INTEGER_CST))
3857     {
3858       HOST_WIDE_INT highint = TREE_INT_CST_LOW (highval);
3859       HOST_WIDE_INT lowint = TREE_INT_CST_LOW (lowval);
3860       int maxint = (int) (highint - lowint);
3861       return type_hash_canon (maxint < 0 ? ~maxint : maxint, itype);
3862     }
3863   else
3864     return itype;
3865 }
3866
3867 /* Just like build_index_type, but takes lowval and highval instead
3868    of just highval (maxval).  */
3869
3870 tree
3871 build_index_2_type (lowval,highval)
3872      tree lowval, highval;
3873 {
3874   return build_range_type (NULL_TREE, lowval, highval);
3875 }
3876
3877 /* Return nonzero iff ITYPE1 and ITYPE2 are equal (in the LISP sense).
3878    Needed because when index types are not hashed, equal index types
3879    built at different times appear distinct, even though structurally,
3880    they are not.  */
3881
3882 int
3883 index_type_equal (itype1, itype2)
3884      tree itype1, itype2;
3885 {
3886   if (TREE_CODE (itype1) != TREE_CODE (itype2))
3887     return 0;
3888   if (TREE_CODE (itype1) == INTEGER_TYPE)
3889     {
3890       if (TYPE_PRECISION (itype1) != TYPE_PRECISION (itype2)
3891           || TYPE_MODE (itype1) != TYPE_MODE (itype2)
3892           || simple_cst_equal (TYPE_SIZE (itype1), TYPE_SIZE (itype2)) != 1
3893           || TYPE_ALIGN (itype1) != TYPE_ALIGN (itype2))
3894         return 0;
3895       if (1 == simple_cst_equal (TYPE_MIN_VALUE (itype1),
3896                                  TYPE_MIN_VALUE (itype2))
3897           && 1 == simple_cst_equal (TYPE_MAX_VALUE (itype1),
3898                                     TYPE_MAX_VALUE (itype2)))
3899         return 1;
3900     }
3901
3902   return 0;
3903 }
3904
3905 /* Construct, lay out and return the type of arrays of elements with ELT_TYPE
3906    and number of elements specified by the range of values of INDEX_TYPE.
3907    If such a type has already been constructed, reuse it.  */
3908
3909 tree
3910 build_array_type (elt_type, index_type)
3911      tree elt_type, index_type;
3912 {
3913   register tree t;
3914   int hashcode;
3915
3916   if (TREE_CODE (elt_type) == FUNCTION_TYPE)
3917     {
3918       error ("arrays of functions are not meaningful");
3919       elt_type = integer_type_node;
3920     }
3921
3922   /* Make sure TYPE_POINTER_TO (elt_type) is filled in.  */
3923   build_pointer_type (elt_type);
3924
3925   /* Allocate the array after the pointer type,
3926      in case we free it in type_hash_canon.  */
3927   t = make_node (ARRAY_TYPE);
3928   TREE_TYPE (t) = elt_type;
3929   TYPE_DOMAIN (t) = index_type;
3930
3931   if (index_type == 0)
3932     {
3933       return t;
3934     }
3935
3936   hashcode = TYPE_HASH (elt_type) + TYPE_HASH (index_type);
3937   t = type_hash_canon (hashcode, t);
3938
3939 #if 0 /* This led to crashes, because it could put a temporary node
3940          on the TYPE_NEXT_VARIANT chain of a permanent one.  */
3941   /* The main variant of an array type should always
3942      be an array whose element type is the main variant.  */
3943   if (elt_type != TYPE_MAIN_VARIANT (elt_type))
3944     change_main_variant (t, build_array_type (TYPE_MAIN_VARIANT (elt_type),
3945                                               index_type));
3946 #endif
3947
3948   if (TYPE_SIZE (t) == 0)
3949     layout_type (t);
3950   return t;
3951 }
3952
3953 /* Construct, lay out and return
3954    the type of functions returning type VALUE_TYPE
3955    given arguments of types ARG_TYPES.
3956    ARG_TYPES is a chain of TREE_LIST nodes whose TREE_VALUEs
3957    are data type nodes for the arguments of the function.
3958    If such a type has already been constructed, reuse it.  */
3959
3960 tree
3961 build_function_type (value_type, arg_types)
3962      tree value_type, arg_types;
3963 {
3964   register tree t;
3965   int hashcode;
3966
3967   if (TREE_CODE (value_type) == FUNCTION_TYPE)
3968     {
3969       error ("function return type cannot be function");
3970       value_type = integer_type_node;
3971     }
3972
3973   /* Make a node of the sort we want.  */
3974   t = make_node (FUNCTION_TYPE);
3975   TREE_TYPE (t) = value_type;
3976   TYPE_ARG_TYPES (t) = arg_types;
3977
3978   /* If we already have such a type, use the old one and free this one.  */
3979   hashcode = TYPE_HASH (value_type) + type_hash_list (arg_types);
3980   t = type_hash_canon (hashcode, t);
3981
3982   if (TYPE_SIZE (t) == 0)
3983     layout_type (t);
3984   return t;
3985 }
3986
3987 /* Build the node for the type of references-to-TO_TYPE.  */
3988
3989 tree
3990 build_reference_type (to_type)
3991      tree to_type;
3992 {
3993   register tree t = TYPE_REFERENCE_TO (to_type);
3994   register struct obstack *ambient_obstack = current_obstack;
3995   register struct obstack *ambient_saveable_obstack = saveable_obstack;
3996
3997   /* First, if we already have a type for pointers to TO_TYPE, use it.  */
3998
3999   if (t)
4000     return t;
4001
4002   /* We need a new one.  If TO_TYPE is permanent, make this permanent too.  */
4003   if (TREE_PERMANENT (to_type))
4004     {
4005       current_obstack = &permanent_obstack;
4006       saveable_obstack = &permanent_obstack;
4007     }
4008
4009   t = make_node (REFERENCE_TYPE);
4010   TREE_TYPE (t) = to_type;
4011
4012   /* Record this type as the pointer to TO_TYPE.  */
4013   TYPE_REFERENCE_TO (to_type) = t;
4014
4015   layout_type (t);
4016
4017   current_obstack = ambient_obstack;
4018   saveable_obstack = ambient_saveable_obstack;
4019   return t;
4020 }
4021
4022 /* Construct, lay out and return the type of methods belonging to class
4023    BASETYPE and whose arguments and values are described by TYPE.
4024    If that type exists already, reuse it.
4025    TYPE must be a FUNCTION_TYPE node.  */
4026
4027 tree
4028 build_method_type (basetype, type)
4029      tree basetype, type;
4030 {
4031   register tree t;
4032   int hashcode;
4033
4034   /* Make a node of the sort we want.  */
4035   t = make_node (METHOD_TYPE);
4036
4037   if (TREE_CODE (type) != FUNCTION_TYPE)
4038     abort ();
4039
4040   TYPE_METHOD_BASETYPE (t) = TYPE_MAIN_VARIANT (basetype);
4041   TREE_TYPE (t) = TREE_TYPE (type);
4042
4043   /* The actual arglist for this function includes a "hidden" argument
4044      which is "this".  Put it into the list of argument types.  */
4045
4046   TYPE_ARG_TYPES (t)
4047     = tree_cons (NULL_TREE,
4048                  build_pointer_type (basetype), TYPE_ARG_TYPES (type));
4049
4050   /* If we already have such a type, use the old one and free this one.  */
4051   hashcode = TYPE_HASH (basetype) + TYPE_HASH (type);
4052   t = type_hash_canon (hashcode, t);
4053
4054   if (TYPE_SIZE (t) == 0)
4055     layout_type (t);
4056
4057   return t;
4058 }
4059
4060 /* Construct, lay out and return the type of offsets to a value
4061    of type TYPE, within an object of type BASETYPE.
4062    If a suitable offset type exists already, reuse it.  */
4063
4064 tree
4065 build_offset_type (basetype, type)
4066      tree basetype, type;
4067 {
4068   register tree t;
4069   int hashcode;
4070
4071   /* Make a node of the sort we want.  */
4072   t = make_node (OFFSET_TYPE);
4073
4074   TYPE_OFFSET_BASETYPE (t) = TYPE_MAIN_VARIANT (basetype);
4075   TREE_TYPE (t) = type;
4076
4077   /* If we already have such a type, use the old one and free this one.  */
4078   hashcode = TYPE_HASH (basetype) + TYPE_HASH (type);
4079   t = type_hash_canon (hashcode, t);
4080
4081   if (TYPE_SIZE (t) == 0)
4082     layout_type (t);
4083
4084   return t;
4085 }
4086
4087 /* Create a complex type whose components are COMPONENT_TYPE.  */
4088
4089 tree
4090 build_complex_type (component_type)
4091      tree component_type;
4092 {
4093   register tree t;
4094   int hashcode;
4095
4096   /* Make a node of the sort we want.  */
4097   t = make_node (COMPLEX_TYPE);
4098
4099   TREE_TYPE (t) = TYPE_MAIN_VARIANT (component_type);
4100   TYPE_VOLATILE (t) = TYPE_VOLATILE (component_type);
4101   TYPE_READONLY (t) = TYPE_READONLY (component_type);
4102
4103   /* If we already have such a type, use the old one and free this one.  */
4104   hashcode = TYPE_HASH (component_type);
4105   t = type_hash_canon (hashcode, t);
4106
4107   if (TYPE_SIZE (t) == 0)
4108     layout_type (t);
4109
4110   return t;
4111 }
4112 \f
4113 /* Return OP, stripped of any conversions to wider types as much as is safe.
4114    Converting the value back to OP's type makes a value equivalent to OP.
4115
4116    If FOR_TYPE is nonzero, we return a value which, if converted to
4117    type FOR_TYPE, would be equivalent to converting OP to type FOR_TYPE.
4118
4119    If FOR_TYPE is nonzero, unaligned bit-field references may be changed to the
4120    narrowest type that can hold the value, even if they don't exactly fit.
4121    Otherwise, bit-field references are changed to a narrower type
4122    only if they can be fetched directly from memory in that type.
4123
4124    OP must have integer, real or enumeral type.  Pointers are not allowed!
4125
4126    There are some cases where the obvious value we could return
4127    would regenerate to OP if converted to OP's type, 
4128    but would not extend like OP to wider types.
4129    If FOR_TYPE indicates such extension is contemplated, we eschew such values.
4130    For example, if OP is (unsigned short)(signed char)-1,
4131    we avoid returning (signed char)-1 if FOR_TYPE is int,
4132    even though extending that to an unsigned short would regenerate OP,
4133    since the result of extending (signed char)-1 to (int)
4134    is different from (int) OP.  */
4135
4136 tree
4137 get_unwidened (op, for_type)
4138      register tree op;
4139      tree for_type;
4140 {
4141   /* Set UNS initially if converting OP to FOR_TYPE is a zero-extension.  */
4142   /* TYPE_PRECISION is safe in place of type_precision since
4143      pointer types are not allowed.  */
4144   register tree type = TREE_TYPE (op);
4145   register unsigned final_prec
4146     = TYPE_PRECISION (for_type != 0 ? for_type : type);
4147   register int uns
4148     = (for_type != 0 && for_type != type
4149        && final_prec > TYPE_PRECISION (type)
4150        && TREE_UNSIGNED (type));
4151   register tree win = op;
4152
4153   while (TREE_CODE (op) == NOP_EXPR)
4154     {
4155       register int bitschange
4156         = TYPE_PRECISION (TREE_TYPE (op))
4157           - TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (op, 0)));
4158
4159       /* Truncations are many-one so cannot be removed.
4160          Unless we are later going to truncate down even farther.  */
4161       if (bitschange < 0
4162           && final_prec > TYPE_PRECISION (TREE_TYPE (op)))
4163         break;
4164
4165       /* See what's inside this conversion.  If we decide to strip it,
4166          we will set WIN.  */
4167       op = TREE_OPERAND (op, 0);
4168
4169       /* If we have not stripped any zero-extensions (uns is 0),
4170          we can strip any kind of extension.
4171          If we have previously stripped a zero-extension,
4172          only zero-extensions can safely be stripped.
4173          Any extension can be stripped if the bits it would produce
4174          are all going to be discarded later by truncating to FOR_TYPE.  */
4175
4176       if (bitschange > 0)
4177         {
4178           if (! uns || final_prec <= TYPE_PRECISION (TREE_TYPE (op)))
4179             win = op;
4180           /* TREE_UNSIGNED says whether this is a zero-extension.
4181              Let's avoid computing it if it does not affect WIN
4182              and if UNS will not be needed again.  */
4183           if ((uns || TREE_CODE (op) == NOP_EXPR)
4184               && TREE_UNSIGNED (TREE_TYPE (op)))
4185             {
4186               uns = 1;
4187               win = op;
4188             }
4189         }
4190     }
4191
4192   if (TREE_CODE (op) == COMPONENT_REF
4193       /* Since type_for_size always gives an integer type.  */
4194       && TREE_CODE (type) != REAL_TYPE
4195       /* Don't crash if field not layed out yet.  */
4196       && DECL_SIZE (TREE_OPERAND (op, 1)) != 0)
4197     {
4198       unsigned innerprec = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1)));
4199       type = type_for_size (innerprec, TREE_UNSIGNED (TREE_OPERAND (op, 1)));
4200
4201       /* We can get this structure field in the narrowest type it fits in.
4202          If FOR_TYPE is 0, do this only for a field that matches the
4203          narrower type exactly and is aligned for it
4204          The resulting extension to its nominal type (a fullword type)
4205          must fit the same conditions as for other extensions.  */
4206
4207       if (innerprec < TYPE_PRECISION (TREE_TYPE (op))
4208           && (for_type || ! DECL_BIT_FIELD (TREE_OPERAND (op, 1)))
4209           && (! uns || final_prec <= innerprec
4210               || TREE_UNSIGNED (TREE_OPERAND (op, 1)))
4211           && type != 0)
4212         {
4213           win = build (COMPONENT_REF, type, TREE_OPERAND (op, 0),
4214                        TREE_OPERAND (op, 1));
4215           TREE_SIDE_EFFECTS (win) = TREE_SIDE_EFFECTS (op);
4216           TREE_THIS_VOLATILE (win) = TREE_THIS_VOLATILE (op);
4217           TREE_RAISES (win) = TREE_RAISES (op);
4218         }
4219     }
4220   return win;
4221 }
4222 \f
4223 /* Return OP or a simpler expression for a narrower value
4224    which can be sign-extended or zero-extended to give back OP.
4225    Store in *UNSIGNEDP_PTR either 1 if the value should be zero-extended
4226    or 0 if the value should be sign-extended.  */
4227
4228 tree
4229 get_narrower (op, unsignedp_ptr)
4230      register tree op;
4231      int *unsignedp_ptr;
4232 {
4233   register int uns = 0;
4234   int first = 1;
4235   register tree win = op;
4236
4237   while (TREE_CODE (op) == NOP_EXPR)
4238     {
4239       register int bitschange
4240         = TYPE_PRECISION (TREE_TYPE (op))
4241           - TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (op, 0)));
4242
4243       /* Truncations are many-one so cannot be removed.  */
4244       if (bitschange < 0)
4245         break;
4246
4247       /* See what's inside this conversion.  If we decide to strip it,
4248          we will set WIN.  */
4249       op = TREE_OPERAND (op, 0);
4250
4251       if (bitschange > 0)
4252         {
4253           /* An extension: the outermost one can be stripped,
4254              but remember whether it is zero or sign extension.  */
4255           if (first)
4256             uns = TREE_UNSIGNED (TREE_TYPE (op));
4257           /* Otherwise, if a sign extension has been stripped,
4258              only sign extensions can now be stripped;
4259              if a zero extension has been stripped, only zero-extensions.  */
4260           else if (uns != TREE_UNSIGNED (TREE_TYPE (op)))
4261             break;
4262           first = 0;
4263         }
4264       else /* bitschange == 0 */
4265         {
4266           /* A change in nominal type can always be stripped, but we must
4267              preserve the unsignedness.  */
4268           if (first)
4269             uns = TREE_UNSIGNED (TREE_TYPE (op));
4270           first = 0;
4271         }
4272
4273       win = op;
4274     }
4275
4276   if (TREE_CODE (op) == COMPONENT_REF
4277       /* Since type_for_size always gives an integer type.  */
4278       && TREE_CODE (TREE_TYPE (op)) != REAL_TYPE)
4279     {
4280       unsigned innerprec = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1)));
4281       tree type = type_for_size (innerprec, TREE_UNSIGNED (op));
4282
4283       /* We can get this structure field in a narrower type that fits it,
4284          but the resulting extension to its nominal type (a fullword type)
4285          must satisfy the same conditions as for other extensions.
4286
4287          Do this only for fields that are aligned (not bit-fields),
4288          because when bit-field insns will be used there is no
4289          advantage in doing this.  */
4290
4291       if (innerprec < TYPE_PRECISION (TREE_TYPE (op))
4292           && ! DECL_BIT_FIELD (TREE_OPERAND (op, 1))
4293           && (first || uns == TREE_UNSIGNED (TREE_OPERAND (op, 1)))
4294           && type != 0)
4295         {
4296           if (first)
4297             uns = TREE_UNSIGNED (TREE_OPERAND (op, 1));
4298           win = build (COMPONENT_REF, type, TREE_OPERAND (op, 0),
4299                        TREE_OPERAND (op, 1));
4300           TREE_SIDE_EFFECTS (win) = TREE_SIDE_EFFECTS (op);
4301           TREE_THIS_VOLATILE (win) = TREE_THIS_VOLATILE (op);
4302           TREE_RAISES (win) = TREE_RAISES (op);
4303         }
4304     }
4305   *unsignedp_ptr = uns;
4306   return win;
4307 }
4308 \f
4309 /* Return the precision of a type, for arithmetic purposes.
4310    Supports all types on which arithmetic is possible
4311    (including pointer types).
4312    It's not clear yet what will be right for complex types.  */
4313
4314 int
4315 type_precision (type)
4316      register tree type;
4317 {
4318   return ((TREE_CODE (type) == INTEGER_TYPE
4319            || TREE_CODE (type) == ENUMERAL_TYPE
4320            || TREE_CODE (type) == REAL_TYPE)
4321           ? TYPE_PRECISION (type) : POINTER_SIZE);
4322 }
4323
4324 /* Nonzero if integer constant C has a value that is permissible
4325    for type TYPE (an INTEGER_TYPE).  */
4326
4327 int
4328 int_fits_type_p (c, type)
4329      tree c, type;
4330 {
4331   if (TREE_UNSIGNED (type))
4332     return (! (TREE_CODE (TYPE_MAX_VALUE (type)) == INTEGER_CST
4333                && INT_CST_LT_UNSIGNED (TYPE_MAX_VALUE (type), c))
4334             && ! (TREE_CODE (TYPE_MIN_VALUE (type)) == INTEGER_CST
4335                   && INT_CST_LT_UNSIGNED (c, TYPE_MIN_VALUE (type))));
4336   else
4337     return (! (TREE_CODE (TYPE_MAX_VALUE (type)) == INTEGER_CST
4338                && INT_CST_LT (TYPE_MAX_VALUE (type), c))
4339             && ! (TREE_CODE (TYPE_MIN_VALUE (type)) == INTEGER_CST
4340                   && INT_CST_LT (c, TYPE_MIN_VALUE (type))));
4341 }
4342
4343 /* Return the innermost context enclosing DECL that is
4344    a FUNCTION_DECL, or zero if none.  */
4345
4346 tree
4347 decl_function_context (decl)
4348      tree decl;
4349 {
4350   tree context;
4351
4352   if (TREE_CODE (decl) == ERROR_MARK)
4353     return 0;
4354
4355   if (TREE_CODE (decl) == SAVE_EXPR)
4356     context = SAVE_EXPR_CONTEXT (decl);
4357   else
4358     context = DECL_CONTEXT (decl);
4359
4360   while (context && TREE_CODE (context) != FUNCTION_DECL)
4361     {
4362       if (TREE_CODE (context) == RECORD_TYPE
4363           || TREE_CODE (context) == UNION_TYPE
4364           || TREE_CODE (context) == QUAL_UNION_TYPE)
4365         context = TYPE_CONTEXT (context);
4366       else if (TREE_CODE (context) == TYPE_DECL)
4367         context = DECL_CONTEXT (context);
4368       else if (TREE_CODE (context) == BLOCK)
4369         context = BLOCK_SUPERCONTEXT (context);
4370       else
4371         /* Unhandled CONTEXT !?  */
4372         abort ();
4373     }
4374
4375   return context;
4376 }
4377
4378 /* Return the innermost context enclosing DECL that is
4379    a RECORD_TYPE, UNION_TYPE or QUAL_UNION_TYPE, or zero if none.
4380    TYPE_DECLs and FUNCTION_DECLs are transparent to this function.  */
4381
4382 tree
4383 decl_type_context (decl)
4384      tree decl;
4385 {
4386   tree context = DECL_CONTEXT (decl);
4387
4388   while (context)
4389     {
4390       if (TREE_CODE (context) == RECORD_TYPE
4391           || TREE_CODE (context) == UNION_TYPE
4392           || TREE_CODE (context) == QUAL_UNION_TYPE)
4393         return context;
4394       if (TREE_CODE (context) == TYPE_DECL
4395           || TREE_CODE (context) == FUNCTION_DECL)
4396         context = DECL_CONTEXT (context);
4397       else if (TREE_CODE (context) == BLOCK)
4398         context = BLOCK_SUPERCONTEXT (context);
4399       else
4400         /* Unhandled CONTEXT!?  */
4401         abort ();
4402     }
4403   return NULL_TREE;
4404 }
4405
4406 void
4407 print_obstack_statistics (str, o)
4408      char *str;
4409      struct obstack *o;
4410 {
4411   struct _obstack_chunk *chunk = o->chunk;
4412   int n_chunks = 0;
4413   int n_alloc = 0;
4414
4415   while (chunk)
4416     {
4417       n_chunks += 1;
4418       n_alloc += chunk->limit - &chunk->contents[0];
4419       chunk = chunk->prev;
4420     }
4421   fprintf (stderr, "obstack %s: %d bytes, %d chunks\n",
4422            str, n_alloc, n_chunks);
4423 }
4424 void
4425 dump_tree_statistics ()
4426 {
4427   int i;
4428   int total_nodes, total_bytes;
4429
4430   fprintf (stderr, "\n??? tree nodes created\n\n");
4431 #ifdef GATHER_STATISTICS
4432   fprintf (stderr, "Kind                  Nodes     Bytes\n");
4433   fprintf (stderr, "-------------------------------------\n");
4434   total_nodes = total_bytes = 0;
4435   for (i = 0; i < (int) all_kinds; i++)
4436     {
4437       fprintf (stderr, "%-20s %6d %9d\n", tree_node_kind_names[i],
4438                tree_node_counts[i], tree_node_sizes[i]);
4439       total_nodes += tree_node_counts[i];
4440       total_bytes += tree_node_sizes[i];
4441     }
4442   fprintf (stderr, "%-20s        %9d\n", "identifier names", id_string_size);
4443   fprintf (stderr, "-------------------------------------\n");
4444   fprintf (stderr, "%-20s %6d %9d\n", "Total", total_nodes, total_bytes);
4445   fprintf (stderr, "-------------------------------------\n");
4446 #else
4447   fprintf (stderr, "(No per-node statistics)\n");
4448 #endif
4449   print_lang_statistics ();
4450 }
4451 \f
4452 #define FILE_FUNCTION_PREFIX_LEN 9
4453
4454 #ifndef NO_DOLLAR_IN_LABEL
4455 #define FILE_FUNCTION_FORMAT "_GLOBAL_$D$%s"
4456 #else /* NO_DOLLAR_IN_LABEL */
4457 #ifndef NO_DOT_IN_LABEL
4458 #define FILE_FUNCTION_FORMAT "_GLOBAL_.D.%s"
4459 #else /* NO_DOT_IN_LABEL */
4460 #define FILE_FUNCTION_FORMAT "_GLOBAL__D_%s"
4461 #endif  /* NO_DOT_IN_LABEL */
4462 #endif  /* NO_DOLLAR_IN_LABEL */
4463
4464 extern char * first_global_object_name;
4465
4466 /* If KIND=='I', return a suitable global initializer (constructor) name.
4467    If KIND=='D', return a suitable global clean-up (destructor) name.  */
4468
4469 tree
4470 get_file_function_name (kind)
4471      int kind;
4472 {
4473   char *buf;
4474   register char *p;
4475
4476   if (first_global_object_name)
4477     p = first_global_object_name;
4478   else if (main_input_filename)
4479     p = main_input_filename;
4480   else
4481     p = input_filename;
4482
4483   buf = (char *) alloca (sizeof (FILE_FUNCTION_FORMAT) + strlen (p));
4484
4485   /* Set up the name of the file-level functions we may need.  */
4486   /* Use a global object (which is already required to be unique over
4487      the program) rather than the file name (which imposes extra
4488      constraints).  -- Raeburn@MIT.EDU, 10 Jan 1990.  */
4489   sprintf (buf, FILE_FUNCTION_FORMAT, p);
4490
4491   /* Don't need to pull weird characters out of global names.  */
4492   if (p != first_global_object_name)
4493     {
4494       for (p = buf+11; *p; p++)
4495         if (! ((*p >= '0' && *p <= '9')
4496 #if 0 /* we always want labels, which are valid C++ identifiers (+ `$') */
4497 #ifndef ASM_IDENTIFY_GCC        /* this is required if `.' is invalid -- k. raeburn */
4498                || *p == '.'
4499 #endif
4500 #endif
4501 #ifndef NO_DOLLAR_IN_LABEL      /* this for `$'; unlikely, but... -- kr */
4502                || *p == '$'
4503 #endif
4504 #ifndef NO_DOT_IN_LABEL         /* this for `.'; unlikely, but...  */
4505                || *p == '.'
4506 #endif
4507                || (*p >= 'A' && *p <= 'Z')
4508                || (*p >= 'a' && *p <= 'z')))
4509           *p = '_';
4510     }
4511
4512   buf[FILE_FUNCTION_PREFIX_LEN] = kind;
4513
4514   return get_identifier (buf);
4515 }
4516 \f
4517 /* Expand (the constant part of) a SET_TYPE CONSTRUCTOR node.
4518    The result is placed in BUFFER (which has length BIT_SIZE),
4519    with one bit in each char ('\000' or '\001').
4520
4521    If the constructor is constant, NULL_TREE is returned.
4522    Otherwise, a TREE_LIST of the non-constant elements is emitted.  */
4523
4524 tree
4525 get_set_constructor_bits (init, buffer, bit_size)
4526      tree init;
4527      char *buffer;
4528      int bit_size;
4529 {
4530   int i;
4531   tree vals;
4532   HOST_WIDE_INT domain_min
4533     = TREE_INT_CST_LOW (TYPE_MIN_VALUE (TYPE_DOMAIN (TREE_TYPE (init))));
4534   tree non_const_bits = NULL_TREE;
4535   for (i = 0; i < bit_size; i++)
4536     buffer[i] = 0;
4537
4538   for (vals = TREE_OPERAND (init, 1); 
4539        vals != NULL_TREE; vals = TREE_CHAIN (vals))
4540     {
4541       if (TREE_CODE (TREE_VALUE (vals)) != INTEGER_CST
4542           || (TREE_PURPOSE (vals) != NULL_TREE
4543               && TREE_CODE (TREE_PURPOSE (vals)) != INTEGER_CST))
4544         non_const_bits =
4545           tree_cons (TREE_PURPOSE (vals), TREE_VALUE (vals), non_const_bits);
4546       else if (TREE_PURPOSE (vals) != NULL_TREE)
4547         {
4548           /* Set a range of bits to ones.  */
4549           HOST_WIDE_INT lo_index
4550             = TREE_INT_CST_LOW (TREE_PURPOSE (vals)) - domain_min;
4551           HOST_WIDE_INT hi_index
4552             = TREE_INT_CST_LOW (TREE_VALUE (vals)) - domain_min;
4553           if (lo_index < 0 || lo_index >= bit_size
4554             || hi_index < 0 || hi_index >= bit_size)
4555             abort ();
4556           for ( ; lo_index <= hi_index; lo_index++)
4557             buffer[lo_index] = 1;
4558         }
4559       else
4560         {
4561           /* Set a single bit to one.  */
4562           HOST_WIDE_INT index
4563             = TREE_INT_CST_LOW (TREE_VALUE (vals)) - domain_min;
4564           if (index < 0 || index >= bit_size)
4565             {
4566               error ("invalid initializer for bit string");
4567               return NULL_TREE;
4568             }
4569           buffer[index] = 1;
4570         }
4571     }
4572   return non_const_bits;
4573 }
4574
4575 /* Expand (the constant part of) a SET_TYPE CONSTRUCTOR node.
4576    The result is placed in BUFFER (which is an array of bytes).
4577    If the constructor is constant, NULL_TREE is returned.
4578    Otherwise, a TREE_LIST of the non-constant elements is emitted.  */
4579
4580 tree
4581 get_set_constructor_bytes (init, buffer, wd_size)
4582      tree init;
4583      unsigned char *buffer;
4584      int wd_size;
4585 {
4586   int i;
4587   tree vals = TREE_OPERAND (init, 1);
4588   int set_word_size = BITS_PER_UNIT;
4589   int bit_size = wd_size * set_word_size;
4590   int bit_pos = 0;
4591   unsigned char *bytep = buffer;
4592   char *bit_buffer = (char *) alloca(bit_size);
4593   tree non_const_bits = get_set_constructor_bits (init, bit_buffer, bit_size);
4594
4595   for (i = 0; i < wd_size; i++)
4596     buffer[i] = 0;
4597
4598   for (i = 0; i < bit_size; i++)
4599     {
4600       if (bit_buffer[i])
4601         {
4602           if (BYTES_BIG_ENDIAN)
4603             *bytep |= (1 << (set_word_size - 1 - bit_pos));
4604           else
4605             *bytep |= 1 << bit_pos;
4606         }
4607       bit_pos++;
4608       if (bit_pos >= set_word_size)
4609         bit_pos = 0, bytep++;
4610     }
4611   return non_const_bits;
4612 }