exception.cc (__cp_pop_exception): If we aren't popping or rethrowing, push down...
[platform/upstream/gcc.git] / gcc / tree.c
1 /* Language-independent node constructors for parse phase of GNU compiler.
2    Copyright (C) 1987, 1988, 1992, 1993, 1994, 1995, 1996, 1997, 1998,
3    1999, 2000 Free Software Foundation, Inc.
4
5 This file is part of GNU CC.
6
7 GNU CC is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11
12 GNU CC is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU CC; see the file COPYING.  If not, write to
19 the Free Software Foundation, 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA.  */
21
22
23 /* This file contains the low level primitives for operating on tree nodes,
24    including allocation, list operations, interning of identifiers,
25    construction of data type nodes and statement nodes,
26    and construction of type conversion nodes.  It also contains
27    tables index by tree code that describe how to take apart
28    nodes of that code.
29
30    It is intended to be language-independent, but occasionally
31    calls language-dependent routines defined (for C) in typecheck.c.
32
33    The low-level allocation routines oballoc and permalloc
34    are used also for allocating many other kinds of objects
35    by all passes of the compiler.  */
36
37 #include "config.h"
38 #include "system.h"
39 #include "flags.h"
40 #include "tree.h"
41 #include "tm_p.h"
42 #include "function.h"
43 #include "obstack.h"
44 #include "toplev.h"
45 #include "ggc.h"
46 #include "hashtab.h"
47 #include "output.h"
48
49 #define obstack_chunk_alloc xmalloc
50 #define obstack_chunk_free free
51 /* obstack.[ch] explicitly declined to prototype this. */
52 extern int _obstack_allocated_p PARAMS ((struct obstack *h, PTR obj));
53
54 static void unsave_expr_now_r PARAMS ((tree));
55
56 /* Tree nodes of permanent duration are allocated in this obstack.
57    They are the identifier nodes, and everything outside of
58    the bodies and parameters of function definitions.  */
59
60 struct obstack permanent_obstack;
61
62 /* The initial RTL, and all ..._TYPE nodes, in a function
63    are allocated in this obstack.  Usually they are freed at the
64    end of the function, but if the function is inline they are saved.
65    For top-level functions, this is maybepermanent_obstack.
66    Separate obstacks are made for nested functions.  */
67
68 struct obstack *function_maybepermanent_obstack;
69
70 /* This is the function_maybepermanent_obstack for top-level functions.  */
71
72 struct obstack maybepermanent_obstack;
73
74 /* The contents of the current function definition are allocated
75    in this obstack, and all are freed at the end of the function.
76    For top-level functions, this is temporary_obstack.
77    Separate obstacks are made for nested functions.  */
78
79 struct obstack *function_obstack;
80
81 /* This is used for reading initializers of global variables.  */
82
83 struct obstack temporary_obstack;
84
85 /* The tree nodes of an expression are allocated
86    in this obstack, and all are freed at the end of the expression.  */
87
88 struct obstack momentary_obstack;
89
90 /* The tree nodes of a declarator are allocated
91    in this obstack, and all are freed when the declarator
92    has been parsed.  */
93
94 static struct obstack temp_decl_obstack;
95
96 /* This points at either permanent_obstack
97    or the current function_maybepermanent_obstack.  */
98
99 struct obstack *saveable_obstack;
100
101 /* This is same as saveable_obstack during parse and expansion phase;
102    it points to the current function's obstack during optimization.
103    This is the obstack to be used for creating rtl objects.  */
104
105 struct obstack *rtl_obstack;
106
107 /* This points at either permanent_obstack or the current function_obstack.  */
108
109 struct obstack *current_obstack;
110
111 /* This points at either permanent_obstack or the current function_obstack
112    or momentary_obstack.  */
113
114 struct obstack *expression_obstack;
115
116 /* Stack of obstack selections for push_obstacks and pop_obstacks.  */
117
118 struct obstack_stack
119 {
120   struct obstack_stack *next;
121   struct obstack *current;
122   struct obstack *saveable;
123   struct obstack *expression;
124   struct obstack *rtl;
125 };
126
127 struct obstack_stack *obstack_stack;
128
129 /* Obstack for allocating struct obstack_stack entries.  */
130
131 static struct obstack obstack_stack_obstack;
132
133 /* Addresses of first objects in some obstacks.
134    This is for freeing their entire contents.  */
135 char *maybepermanent_firstobj;
136 char *temporary_firstobj;
137 char *momentary_firstobj;
138 char *temp_decl_firstobj;
139
140 /* This is used to preserve objects (mainly array initializers) that need to
141    live until the end of the current function, but no further.  */
142 char *momentary_function_firstobj;
143
144 /* Nonzero means all ..._TYPE nodes should be allocated permanently.  */
145
146 int all_types_permanent;
147
148 /* Stack of places to restore the momentary obstack back to.  */
149    
150 struct momentary_level
151 {
152   /* Pointer back to previous such level.  */
153   struct momentary_level *prev;
154   /* First object allocated within this level.  */
155   char *base;
156   /* Value of expression_obstack saved at entry to this level.  */
157   struct obstack *obstack;
158 };
159
160 struct momentary_level *momentary_stack;
161
162 /* Table indexed by tree code giving a string containing a character
163    classifying the tree code.  Possibilities are
164    t, d, s, c, r, <, 1, 2 and e.  See tree.def for details.  */
165
166 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
167
168 char tree_code_type[MAX_TREE_CODES] = {
169 #include "tree.def"
170 };
171 #undef DEFTREECODE
172
173 /* Table indexed by tree code giving number of expression
174    operands beyond the fixed part of the node structure.
175    Not used for types or decls.  */
176
177 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
178
179 int tree_code_length[MAX_TREE_CODES] = {
180 #include "tree.def"
181 };
182 #undef DEFTREECODE
183
184 /* Names of tree components.
185    Used for printing out the tree and error messages.  */
186 #define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
187
188 const char *tree_code_name[MAX_TREE_CODES] = {
189 #include "tree.def"
190 };
191 #undef DEFTREECODE
192
193 /* Statistics-gathering stuff.  */
194 typedef enum
195 {
196   d_kind,
197   t_kind,
198   b_kind,
199   s_kind,
200   r_kind,
201   e_kind,
202   c_kind,
203   id_kind,
204   op_id_kind,
205   perm_list_kind,
206   temp_list_kind,
207   vec_kind,
208   x_kind,
209   lang_decl,
210   lang_type,
211   all_kinds
212 } tree_node_kind;
213
214 int tree_node_counts[(int)all_kinds];
215 int tree_node_sizes[(int)all_kinds];
216 int id_string_size = 0;
217
218 static const char * const tree_node_kind_names[] = {
219   "decls",
220   "types",
221   "blocks",
222   "stmts",
223   "refs",
224   "exprs",
225   "constants",
226   "identifiers",
227   "op_identifiers",
228   "perm_tree_lists",
229   "temp_tree_lists",
230   "vecs",
231   "random kinds",
232   "lang_decl kinds",
233   "lang_type kinds"
234 };
235
236 /* Hash table for uniquizing IDENTIFIER_NODEs by name.  */
237
238 #define MAX_HASH_TABLE 1009
239 static tree hash_table[MAX_HASH_TABLE]; /* id hash buckets */
240
241 /* 0 while creating built-in identifiers.  */
242 static int do_identifier_warnings;
243
244 /* Unique id for next decl created.  */
245 static int next_decl_uid;
246 /* Unique id for next type created.  */
247 static int next_type_uid = 1;
248
249 /* Here is how primitive or already-canonicalized types' hash
250    codes are made.  */
251 #define TYPE_HASH(TYPE) ((unsigned long) (TYPE) & 0777777)
252
253 /* Since we cannot rehash a type after it is in the table, we have to
254    keep the hash code.  */
255
256 struct type_hash
257 {
258   unsigned long hash;
259   tree type;
260 };
261
262 /* Initial size of the hash table (rounded to next prime). */
263 #define TYPE_HASH_INITIAL_SIZE 1000
264
265 /* Now here is the hash table.  When recording a type, it is added to
266    the slot whose index is the hash code.  Note that the hash table is
267    used for several kinds of types (function types, array types and
268    array index range types, for now).  While all these live in the
269    same table, they are completely independent, and the hash code is
270    computed differently for each of these.  */
271
272 htab_t type_hash_table;
273
274 static void build_real_from_int_cst_1 PARAMS ((PTR));
275 static void set_type_quals PARAMS ((tree, int));
276 static void append_random_chars PARAMS ((char *));
277 static void mark_type_hash PARAMS ((void *));
278 static int type_hash_eq PARAMS ((const void*, const void*));
279 static unsigned int type_hash_hash PARAMS ((const void*));
280 static void print_type_hash_statistics PARAMS((void));
281 static int mark_hash_entry PARAMS((void **, void *));
282
283 /* If non-null, these are language-specific helper functions for
284    unsave_expr_now.  If present, LANG_UNSAVE is called before its
285    argument (an UNSAVE_EXPR) is to be unsaved, and all other
286    processing in unsave_expr_now is aborted.  LANG_UNSAVE_EXPR_NOW is
287    called from unsave_expr_1 for language-specific tree codes.  */
288 void (*lang_unsave) PARAMS ((tree *));
289 void (*lang_unsave_expr_now) PARAMS ((tree));
290
291 /* The string used as a placeholder instead of a source file name for
292    built-in tree nodes.  The variable, which is dynamically allocated,
293    should be used; the macro is only used to initialize it.  */
294
295 static char *built_in_filename;
296 #define BUILT_IN_FILENAME ("<built-in>")
297 \f
298 tree global_trees[TI_MAX];
299 tree integer_types[itk_none];
300 \f
301 /* Init the principal obstacks.  */
302
303 void
304 init_obstacks ()
305 {
306   gcc_obstack_init (&obstack_stack_obstack);
307   gcc_obstack_init (&permanent_obstack);
308
309   gcc_obstack_init (&temporary_obstack);
310   temporary_firstobj = (char *) obstack_alloc (&temporary_obstack, 0);
311   gcc_obstack_init (&momentary_obstack);
312   momentary_firstobj = (char *) obstack_alloc (&momentary_obstack, 0);
313   momentary_function_firstobj = momentary_firstobj;
314   gcc_obstack_init (&maybepermanent_obstack);
315   maybepermanent_firstobj
316     = (char *) obstack_alloc (&maybepermanent_obstack, 0);
317   gcc_obstack_init (&temp_decl_obstack);
318   temp_decl_firstobj = (char *) obstack_alloc (&temp_decl_obstack, 0);
319
320   function_obstack = &temporary_obstack;
321   function_maybepermanent_obstack = &maybepermanent_obstack;
322   current_obstack = &permanent_obstack;
323   expression_obstack = &permanent_obstack;
324   rtl_obstack = saveable_obstack = &permanent_obstack;
325
326   /* Init the hash table of identifiers.  */
327   bzero ((char *) hash_table, sizeof hash_table);
328   ggc_add_tree_root (hash_table, sizeof hash_table / sizeof (tree));
329
330   /* Initialize the hash table of types.  */
331   type_hash_table = htab_create (TYPE_HASH_INITIAL_SIZE, type_hash_hash, 
332                                  type_hash_eq, 0);
333   ggc_add_root (&type_hash_table, 1, sizeof type_hash_table, mark_type_hash);
334   ggc_add_tree_root (global_trees, TI_MAX);
335   ggc_add_tree_root (integer_types, itk_none);
336 }
337
338 void
339 gcc_obstack_init (obstack)
340      struct obstack *obstack;
341 {
342   /* Let particular systems override the size of a chunk.  */
343 #ifndef OBSTACK_CHUNK_SIZE
344 #define OBSTACK_CHUNK_SIZE 0
345 #endif
346   /* Let them override the alloc and free routines too.  */
347 #ifndef OBSTACK_CHUNK_ALLOC
348 #define OBSTACK_CHUNK_ALLOC xmalloc
349 #endif
350 #ifndef OBSTACK_CHUNK_FREE
351 #define OBSTACK_CHUNK_FREE free
352 #endif
353   _obstack_begin (obstack, OBSTACK_CHUNK_SIZE, 0,
354                   (void *(*) PARAMS ((long))) OBSTACK_CHUNK_ALLOC,
355                   (void (*) PARAMS ((void *))) OBSTACK_CHUNK_FREE);
356 }
357
358 /* Save all variables describing the current status into the structure
359    *P.  This function is called whenever we start compiling one
360    function in the midst of compiling another.  For example, when
361    compiling a nested function, or, in C++, a template instantiation
362    that is required by the function we are currently compiling.
363
364    CONTEXT is the decl_function_context for the function we're about to
365    compile; if it isn't current_function_decl, we have to play some games.  */
366
367 void
368 save_tree_status (p)
369      struct function *p;
370 {
371   p->all_types_permanent = all_types_permanent;
372   p->momentary_stack = momentary_stack;
373   p->maybepermanent_firstobj = maybepermanent_firstobj;
374   p->temporary_firstobj = temporary_firstobj;
375   p->momentary_firstobj = momentary_firstobj;
376   p->momentary_function_firstobj = momentary_function_firstobj;
377   p->function_obstack = function_obstack;
378   p->function_maybepermanent_obstack = function_maybepermanent_obstack;
379   p->current_obstack = current_obstack;
380   p->expression_obstack = expression_obstack;
381   p->saveable_obstack = saveable_obstack;
382   p->rtl_obstack = rtl_obstack;
383
384   function_maybepermanent_obstack
385     = (struct obstack *) xmalloc (sizeof (struct obstack));
386   gcc_obstack_init (function_maybepermanent_obstack);
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   obstack_free (function_maybepermanent_obstack, maybepermanent_firstobj);
417   if (obstack_empty_p (function_maybepermanent_obstack))
418     {
419       obstack_free (function_maybepermanent_obstack, NULL);
420       free (function_maybepermanent_obstack);
421     }
422
423   obstack_free (&temporary_obstack, temporary_firstobj);
424   obstack_free (&momentary_obstack, momentary_function_firstobj);
425
426   obstack_free (function_obstack, NULL);
427   free (function_obstack);
428
429   temporary_firstobj = p->temporary_firstobj;
430   momentary_firstobj = p->momentary_firstobj;
431   momentary_function_firstobj = p->momentary_function_firstobj;
432   maybepermanent_firstobj = p->maybepermanent_firstobj;
433   function_obstack = p->function_obstack;
434   function_maybepermanent_obstack = p->function_maybepermanent_obstack;
435   current_obstack = p->current_obstack;
436   expression_obstack = p->expression_obstack;
437   saveable_obstack = p->saveable_obstack;
438   rtl_obstack = p->rtl_obstack;
439 }
440 \f
441 /* Start allocating on the temporary (per function) obstack.
442    This is done in start_function before parsing the function body,
443    and before each initialization at top level, and to go back
444    to temporary allocation after doing permanent_allocation.  */
445
446 void
447 temporary_allocation ()
448 {
449   /* Note that function_obstack at top level points to temporary_obstack.
450      But within a nested function context, it is a separate obstack.  */
451   current_obstack = function_obstack;
452   expression_obstack = function_obstack;
453   rtl_obstack = saveable_obstack = function_maybepermanent_obstack;
454   momentary_stack = 0;
455 }
456
457 /* Start allocating on the permanent obstack but don't
458    free the temporary data.  After calling this, call
459    `permanent_allocation' to fully resume permanent allocation status.  */
460
461 void
462 end_temporary_allocation ()
463 {
464   current_obstack = &permanent_obstack;
465   expression_obstack = &permanent_obstack;
466   rtl_obstack = saveable_obstack = &permanent_obstack;
467 }
468
469 /* Resume allocating on the temporary obstack, undoing
470    effects of `end_temporary_allocation'.  */
471
472 void
473 resume_temporary_allocation ()
474 {
475   current_obstack = function_obstack;
476   expression_obstack = function_obstack;
477   rtl_obstack = saveable_obstack = function_maybepermanent_obstack;
478 }
479
480 /* While doing temporary allocation, switch to allocating in such a
481    way as to save all nodes if the function is inlined.  Call
482    resume_temporary_allocation to go back to ordinary temporary
483    allocation.  */
484
485 void
486 saveable_allocation ()
487 {
488   /* Note that function_obstack at top level points to temporary_obstack.
489      But within a nested function context, it is a separate obstack.  */
490   expression_obstack = current_obstack = saveable_obstack;
491 }
492
493 /* Switch to current obstack CURRENT and maybepermanent obstack SAVEABLE,
494    recording the previously current obstacks on a stack.
495    This does not free any storage in any obstack.  */
496
497 void
498 push_obstacks (current, saveable)
499      struct obstack *current, *saveable;
500 {
501   struct obstack_stack *p;
502
503   p = (struct obstack_stack *) obstack_alloc (&obstack_stack_obstack,
504                                               (sizeof (struct obstack_stack)));
505
506   p->current = current_obstack;
507   p->saveable = saveable_obstack;
508   p->expression = expression_obstack;
509   p->rtl = rtl_obstack;
510   p->next = obstack_stack;
511   obstack_stack = p;
512
513   current_obstack = current;
514   expression_obstack = current;
515   rtl_obstack = saveable_obstack = saveable;
516 }
517
518 /* Save the current set of obstacks, but don't change them.  */
519
520 void
521 push_obstacks_nochange ()
522 {
523   struct obstack_stack *p;
524   
525   p = (struct obstack_stack *) obstack_alloc (&obstack_stack_obstack,
526                                               (sizeof (struct obstack_stack)));
527
528   p->current = current_obstack;
529   p->saveable = saveable_obstack;
530   p->expression = expression_obstack;
531   p->rtl = rtl_obstack;
532   p->next = obstack_stack;
533   obstack_stack = p;
534 }
535
536 /* Pop the obstack selection stack.  */
537
538 void
539 pop_obstacks ()
540 {
541   struct obstack_stack *p;
542
543   p = obstack_stack;
544   obstack_stack = p->next;
545
546   current_obstack = p->current;
547   saveable_obstack = p->saveable;
548   expression_obstack = p->expression;
549   rtl_obstack = p->rtl;
550
551   obstack_free (&obstack_stack_obstack, p);
552 }
553
554 /* Nonzero if temporary allocation is currently in effect.
555    Zero if currently doing permanent allocation.  */
556
557 int
558 allocation_temporary_p ()
559 {
560   return current_obstack != &permanent_obstack;
561 }
562
563 /* Go back to allocating on the permanent obstack
564    and free everything in the temporary obstack.
565
566    FUNCTION_END is true only if we have just finished compiling a function.
567    In that case, we also free preserved initial values on the momentary
568    obstack.  */
569
570 void
571 permanent_allocation (function_end)
572      int function_end;
573 {
574   /* Free up previous temporary obstack data */
575   obstack_free (&temporary_obstack, temporary_firstobj);
576   if (function_end)
577     {
578       obstack_free (&momentary_obstack, momentary_function_firstobj);
579       momentary_firstobj = momentary_function_firstobj;
580     }
581   else
582     obstack_free (&momentary_obstack, momentary_firstobj);
583
584   obstack_free (function_maybepermanent_obstack, maybepermanent_firstobj);
585   obstack_free (&temp_decl_obstack, temp_decl_firstobj);
586
587   current_obstack = &permanent_obstack;
588   expression_obstack = &permanent_obstack;
589   rtl_obstack = saveable_obstack = &permanent_obstack;
590 }
591
592 /* Save permanently everything on the maybepermanent_obstack.  */
593
594 void
595 preserve_data ()
596 {
597   maybepermanent_firstobj
598     = (char *) obstack_alloc (function_maybepermanent_obstack, 0);
599 }
600
601 void
602 preserve_initializer ()
603 {
604   struct momentary_level *tem;
605   char *old_momentary;
606
607   temporary_firstobj
608     = (char *) obstack_alloc (&temporary_obstack, 0);
609   maybepermanent_firstobj
610     = (char *) obstack_alloc (function_maybepermanent_obstack, 0);
611
612   old_momentary = momentary_firstobj;
613   momentary_firstobj
614     = (char *) obstack_alloc (&momentary_obstack, 0);
615   if (momentary_firstobj != old_momentary)
616     for (tem = momentary_stack; tem; tem = tem->prev)
617       tem->base = momentary_firstobj;
618 }
619
620 /* Start allocating new rtl in current_obstack.
621    Use resume_temporary_allocation
622    to go back to allocating rtl in saveable_obstack.  */
623
624 void
625 rtl_in_current_obstack ()
626 {
627   rtl_obstack = current_obstack;
628 }
629
630 /* Start allocating rtl from saveable_obstack.  Intended to be used after
631    a call to push_obstacks_nochange.  */
632
633 void
634 rtl_in_saveable_obstack ()
635 {
636   rtl_obstack = saveable_obstack;
637 }
638 \f
639 /* Allocate SIZE bytes in the current obstack
640    and return a pointer to them.
641    In practice the current obstack is always the temporary one.  */
642
643 char *
644 oballoc (size)
645      int size;
646 {
647   return (char *) obstack_alloc (current_obstack, size);
648 }
649
650 /* Free the object PTR in the current obstack
651    as well as everything allocated since PTR.
652    In practice the current obstack is always the temporary one.  */
653
654 void
655 obfree (ptr)
656      char *ptr;
657 {
658   obstack_free (current_obstack, ptr);
659 }
660
661 /* Allocate SIZE bytes in the permanent obstack
662    and return a pointer to them.  */
663
664 char *
665 permalloc (size)
666      int size;
667 {
668   return (char *) obstack_alloc (&permanent_obstack, size);
669 }
670
671 /* Allocate NELEM items of SIZE bytes in the permanent obstack
672    and return a pointer to them.  The storage is cleared before
673    returning the value.  */
674
675 char *
676 perm_calloc (nelem, size)
677      int nelem;
678      long size;
679 {
680   char *rval = (char *) obstack_alloc (&permanent_obstack, nelem * size);
681   bzero (rval, nelem * size);
682   return rval;
683 }
684
685 /* Allocate SIZE bytes in the saveable obstack
686    and return a pointer to them.  */
687
688 char *
689 savealloc (size)
690      int size;
691 {
692   return (char *) obstack_alloc (saveable_obstack, size);
693 }
694
695 /* Allocate SIZE bytes in the expression obstack
696    and return a pointer to them.  */
697
698 char *
699 expralloc (size)
700      int size;
701 {
702   return (char *) obstack_alloc (expression_obstack, size);
703 }
704 \f
705 /* Print out which obstack an object is in.  */
706
707 void
708 print_obstack_name (object, file, prefix)
709      char *object;
710      FILE *file;
711      const char *prefix;
712 {
713   struct obstack *obstack = NULL;
714   const char *obstack_name = NULL;
715   struct function *p;
716
717   for (p = outer_function_chain; p; p = p->next)
718     {
719       if (_obstack_allocated_p (p->function_obstack, object))
720         {
721           obstack = p->function_obstack;
722           obstack_name = "containing function obstack";
723         }
724       if (_obstack_allocated_p (p->function_maybepermanent_obstack, object))
725         {
726           obstack = p->function_maybepermanent_obstack;
727           obstack_name = "containing function maybepermanent obstack";
728         }
729     }
730
731   if (_obstack_allocated_p (&obstack_stack_obstack, object))
732     {
733       obstack = &obstack_stack_obstack;
734       obstack_name = "obstack_stack_obstack";
735     }
736   else if (_obstack_allocated_p (function_obstack, object))
737     {
738       obstack = function_obstack;
739       obstack_name = "function obstack";
740     }
741   else if (_obstack_allocated_p (&permanent_obstack, object))
742     {
743       obstack = &permanent_obstack;
744       obstack_name = "permanent_obstack";
745     }
746   else if (_obstack_allocated_p (&momentary_obstack, object))
747     {
748       obstack = &momentary_obstack;
749       obstack_name = "momentary_obstack";
750     }
751   else if (_obstack_allocated_p (function_maybepermanent_obstack, object))
752     {
753       obstack = function_maybepermanent_obstack;
754       obstack_name = "function maybepermanent obstack";
755     }
756   else if (_obstack_allocated_p (&temp_decl_obstack, object))
757     {
758       obstack = &temp_decl_obstack;
759       obstack_name = "temp_decl_obstack";
760     }
761
762   /* Check to see if the object is in the free area of the obstack.  */
763   if (obstack != NULL)
764     {
765       if (object >= obstack->next_free
766           && object < obstack->chunk_limit)
767         fprintf (file, "%s in free portion of obstack %s",
768                  prefix, obstack_name);
769       else
770         fprintf (file, "%s allocated from %s", prefix, obstack_name);
771     }
772   else
773     fprintf (file, "%s not allocated from any obstack", prefix);
774 }
775
776 void
777 debug_obstack (object)
778      char *object;
779 {
780   print_obstack_name (object, stderr, "object");
781   fprintf (stderr, ".\n");
782 }
783
784 /* Return 1 if OBJ is in the permanent obstack.
785    This is slow, and should be used only for debugging.
786    Use TREE_PERMANENT for other purposes.  */
787
788 int
789 object_permanent_p (obj)
790      tree obj;
791 {
792   return _obstack_allocated_p (&permanent_obstack, obj);
793 }
794 \f
795 /* Start a level of momentary allocation.
796    In C, each compound statement has its own level
797    and that level is freed at the end of each statement.
798    All expression nodes are allocated in the momentary allocation level.  */
799
800 void
801 push_momentary ()
802 {
803   struct momentary_level *tem
804     = (struct momentary_level *) obstack_alloc (&momentary_obstack,
805                                                 sizeof (struct momentary_level));
806   tem->prev = momentary_stack;
807   tem->base = (char *) obstack_base (&momentary_obstack);
808   tem->obstack = expression_obstack;
809   momentary_stack = tem;
810   expression_obstack = &momentary_obstack;
811 }
812
813 /* Set things up so the next clear_momentary will only clear memory
814    past our present position in momentary_obstack.  */
815
816 void
817 preserve_momentary ()
818 {
819   momentary_stack->base = (char *) obstack_base (&momentary_obstack);
820 }
821
822 /* Free all the storage in the current momentary-allocation level.
823    In C, this happens at the end of each statement.  */
824
825 void
826 clear_momentary ()
827 {
828   obstack_free (&momentary_obstack, momentary_stack->base);
829 }
830
831 /* Discard a level of momentary allocation.
832    In C, this happens at the end of each compound statement.
833    Restore the status of expression node allocation
834    that was in effect before this level was created.  */
835
836 void
837 pop_momentary ()
838 {
839   struct momentary_level *tem = momentary_stack;
840   momentary_stack = tem->prev;
841   expression_obstack = tem->obstack;
842   /* We can't free TEM from the momentary_obstack, because there might
843      be objects above it which have been saved.  We can free back to the
844      stack of the level we are popping off though.  */
845   obstack_free (&momentary_obstack, tem->base);
846 }
847
848 /* Pop back to the previous level of momentary allocation,
849    but don't free any momentary data just yet.  */
850
851 void
852 pop_momentary_nofree ()
853 {
854   struct momentary_level *tem = momentary_stack;
855   momentary_stack = tem->prev;
856   expression_obstack = tem->obstack;
857 }
858
859 /* Call when starting to parse a declaration:
860    make expressions in the declaration last the length of the function.
861    Returns an argument that should be passed to resume_momentary later.  */
862
863 int
864 suspend_momentary ()
865 {
866   register int tem = expression_obstack == &momentary_obstack;
867   expression_obstack = saveable_obstack;
868   return tem;
869 }
870
871 /* Call when finished parsing a declaration:
872    restore the treatment of node-allocation that was
873    in effect before the suspension.
874    YES should be the value previously returned by suspend_momentary.  */
875
876 void
877 resume_momentary (yes)
878      int yes;
879 {
880   if (yes)
881     expression_obstack = &momentary_obstack;
882 }
883 \f
884 /* Init the tables indexed by tree code.
885    Note that languages can add to these tables to define their own codes.  */
886
887 void
888 init_tree_codes ()
889 {
890   built_in_filename
891     = ggc_alloc_string (BUILT_IN_FILENAME, sizeof (BUILT_IN_FILENAME));
892   ggc_add_string_root (&built_in_filename, 1);
893 }
894
895 /* Return a newly allocated node of code CODE.
896    Initialize the node's unique id and its TREE_PERMANENT flag.
897    Note that if garbage collection is in use, TREE_PERMANENT will
898    always be zero - we want to eliminate use of TREE_PERMANENT.
899    For decl and type nodes, some other fields are initialized.
900    The rest of the node is initialized to zero.
901
902    Achoo!  I got a code in the node.  */
903
904 tree
905 make_node (code)
906      enum tree_code code;
907 {
908   register tree t;
909   register int type = TREE_CODE_CLASS (code);
910   register int length = 0;
911   register struct obstack *obstack = current_obstack;
912 #ifdef GATHER_STATISTICS
913   register tree_node_kind kind;
914 #endif
915
916   switch (type)
917     {
918     case 'd':  /* A decl node */
919 #ifdef GATHER_STATISTICS
920       kind = d_kind;
921 #endif
922       length = sizeof (struct tree_decl);
923       /* All decls in an inline function need to be saved.  */
924       if (obstack != &permanent_obstack)
925         obstack = saveable_obstack;
926
927       /* PARM_DECLs go on the context of the parent. If this is a nested
928          function, then we must allocate the PARM_DECL on the parent's
929          obstack, so that they will live to the end of the parent's
930          closing brace.  This is necessary in case we try to inline the
931          function into its parent.
932
933          PARM_DECLs of top-level functions do not have this problem.  However,
934          we allocate them where we put the FUNCTION_DECL for languages such as
935          Ada that need to consult some flags in the PARM_DECLs of the function
936          when calling it. 
937
938          See comment in restore_tree_status for why we can't put this
939          in function_obstack.  */
940       if (code == PARM_DECL && obstack != &permanent_obstack)
941         {
942           tree context = 0;
943           if (current_function_decl)
944             context = decl_function_context (current_function_decl);
945
946           if (context)
947             obstack
948               = find_function_data (context)->function_maybepermanent_obstack;
949         }
950       break;
951
952     case 't':  /* a type node */
953 #ifdef GATHER_STATISTICS
954       kind = t_kind;
955 #endif
956       length = sizeof (struct tree_type);
957       /* All data types are put where we can preserve them if nec.  */
958       if (obstack != &permanent_obstack)
959         obstack = all_types_permanent ? &permanent_obstack : saveable_obstack;
960       break;
961
962     case 'b':  /* a lexical block */
963 #ifdef GATHER_STATISTICS
964       kind = b_kind;
965 #endif
966       length = sizeof (struct tree_block);
967       /* All BLOCK nodes are put where we can preserve them if nec.  */
968       if (obstack != &permanent_obstack)
969         obstack = saveable_obstack;
970       break;
971
972     case 's':  /* an expression with side effects */
973 #ifdef GATHER_STATISTICS
974       kind = s_kind;
975       goto usual_kind;
976 #endif
977     case 'r':  /* a reference */
978 #ifdef GATHER_STATISTICS
979       kind = r_kind;
980       goto usual_kind;
981 #endif
982     case 'e':  /* an expression */
983     case '<':  /* a comparison expression */
984     case '1':  /* a unary arithmetic expression */
985     case '2':  /* a binary arithmetic expression */
986 #ifdef GATHER_STATISTICS
987       kind = e_kind;
988     usual_kind:
989 #endif
990       obstack = expression_obstack;
991       /* All BIND_EXPR nodes are put where we can preserve them if nec.  */
992       if (code == BIND_EXPR && obstack != &permanent_obstack)
993         obstack = saveable_obstack;
994       length = sizeof (struct tree_exp)
995         + (TREE_CODE_LENGTH (code) - 1) * sizeof (char *);
996       break;
997
998     case 'c':  /* a constant */
999 #ifdef GATHER_STATISTICS
1000       kind = c_kind;
1001 #endif
1002       obstack = expression_obstack;
1003
1004       /* We can't use TREE_CODE_LENGTH for INTEGER_CST, since the number of
1005          words is machine-dependent due to varying length of HOST_WIDE_INT,
1006          which might be wider than a pointer (e.g., long long).  Similarly
1007          for REAL_CST, since the number of words is machine-dependent due
1008          to varying size and alignment of `double'.  */
1009
1010       if (code == INTEGER_CST)
1011         length = sizeof (struct tree_int_cst);
1012       else if (code == REAL_CST)
1013         length = sizeof (struct tree_real_cst);
1014       else
1015         length = sizeof (struct tree_common)
1016           + TREE_CODE_LENGTH (code) * sizeof (char *);
1017       break;
1018
1019     case 'x':  /* something random, like an identifier.  */
1020 #ifdef GATHER_STATISTICS
1021       if (code == IDENTIFIER_NODE)
1022         kind = id_kind;
1023       else if (code == OP_IDENTIFIER)
1024         kind = op_id_kind;
1025       else if (code == TREE_VEC)
1026         kind = vec_kind;
1027       else
1028         kind = x_kind;
1029 #endif
1030       length = sizeof (struct tree_common)
1031         + TREE_CODE_LENGTH (code) * sizeof (char *);
1032       /* Identifier nodes are always permanent since they are
1033          unique in a compiler run.  */
1034       if (code == IDENTIFIER_NODE) obstack = &permanent_obstack;
1035       break;
1036
1037     default:
1038       abort ();
1039     }
1040
1041   if (ggc_p)
1042     t = ggc_alloc_tree (length);
1043   else
1044     {
1045       t = (tree) obstack_alloc (obstack, length);
1046       memset ((PTR) t, 0, length);
1047     }
1048
1049 #ifdef GATHER_STATISTICS
1050   tree_node_counts[(int)kind]++;
1051   tree_node_sizes[(int)kind] += length;
1052 #endif
1053
1054   TREE_SET_CODE (t, code);
1055   TREE_SET_PERMANENT (t);
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) = in_system_header;
1068       DECL_SOURCE_LINE (t) = lineno;
1069       DECL_SOURCE_FILE (t) = 
1070         (input_filename) ? input_filename : built_in_filename;
1071       DECL_UID (t) = next_decl_uid++;
1072       /* Note that we have not yet computed the alias set for this
1073          declaration.  */
1074       DECL_POINTER_ALIAS_SET (t) = -1;
1075       break;
1076
1077     case 't':
1078       TYPE_UID (t) = next_type_uid++;
1079       TYPE_ALIGN (t) = 1;
1080       TYPE_MAIN_VARIANT (t) = t;
1081       TYPE_OBSTACK (t) = obstack;
1082       TYPE_ATTRIBUTES (t) = NULL_TREE;
1083 #ifdef SET_DEFAULT_TYPE_ATTRIBUTES
1084       SET_DEFAULT_TYPE_ATTRIBUTES (t);
1085 #endif
1086       /* Note that we have not yet computed the alias set for this
1087          type.  */
1088       TYPE_ALIAS_SET (t) = -1;
1089       break;
1090
1091     case 'c':
1092       TREE_CONSTANT (t) = 1;
1093       break;
1094
1095     case 'e':
1096       switch (code)
1097         {
1098         case INIT_EXPR:
1099         case MODIFY_EXPR:
1100         case VA_ARG_EXPR:
1101         case RTL_EXPR:
1102         case PREDECREMENT_EXPR:
1103         case PREINCREMENT_EXPR:
1104         case POSTDECREMENT_EXPR:
1105         case POSTINCREMENT_EXPR:
1106           /* All of these have side-effects, no matter what their
1107              operands are.  */
1108           TREE_SIDE_EFFECTS (t) = 1;
1109           break;
1110           
1111         default:
1112           break;
1113         }
1114       break;
1115     }
1116
1117   return t;
1118 }
1119
1120 /* A front-end can reset this to an appropriate function if types need
1121    special handling.  */
1122
1123 tree (*make_lang_type_fn) PARAMS ((enum tree_code)) = make_node;
1124
1125 /* Return a new type (with the indicated CODE), doing whatever
1126    language-specific processing is required.  */
1127
1128 tree 
1129 make_lang_type (code)
1130      enum tree_code code;
1131 {
1132   return (*make_lang_type_fn) (code);
1133 }
1134 \f
1135 /* Return a new node with the same contents as NODE except that its
1136    TREE_CHAIN is zero and it has a fresh uid.  Unlike make_node, this
1137    function always performs the allocation on the CURRENT_OBSTACK;
1138    it's up to the caller to pick the right obstack before calling this
1139    function.  */
1140
1141 tree
1142 copy_node (node)
1143      tree node;
1144 {
1145   register tree t;
1146   register enum tree_code code = TREE_CODE (node);
1147   register int length = 0;
1148
1149   switch (TREE_CODE_CLASS (code))
1150     {
1151     case 'd':  /* A decl node */
1152       length = sizeof (struct tree_decl);
1153       break;
1154
1155     case 't':  /* a type node */
1156       length = sizeof (struct tree_type);
1157       break;
1158
1159     case 'b':  /* a lexical block node */
1160       length = sizeof (struct tree_block);
1161       break;
1162
1163     case 'r':  /* a reference */
1164     case 'e':  /* an expression */
1165     case 's':  /* an expression with side effects */
1166     case '<':  /* a comparison expression */
1167     case '1':  /* a unary arithmetic expression */
1168     case '2':  /* a binary arithmetic expression */
1169       length = sizeof (struct tree_exp)
1170         + (TREE_CODE_LENGTH (code) - 1) * sizeof (char *);
1171       break;
1172
1173     case 'c':  /* a constant */
1174       /* We can't use TREE_CODE_LENGTH for INTEGER_CST, since the number of
1175          words is machine-dependent due to varying length of HOST_WIDE_INT,
1176          which might be wider than a pointer (e.g., long long).  Similarly
1177          for REAL_CST, since the number of words is machine-dependent due
1178          to varying size and alignment of `double'.  */
1179       if (code == INTEGER_CST)
1180         length = sizeof (struct tree_int_cst);
1181       else if (code == REAL_CST)
1182         length = sizeof (struct tree_real_cst);
1183       else
1184         length = (sizeof (struct tree_common)
1185                   + TREE_CODE_LENGTH (code) * sizeof (char *));
1186       break;
1187
1188     case 'x':  /* something random, like an identifier.  */
1189       length = sizeof (struct tree_common)
1190         + TREE_CODE_LENGTH (code) * sizeof (char *);
1191       if (code == TREE_VEC)
1192         length += (TREE_VEC_LENGTH (node) - 1) * sizeof (char *);
1193     }
1194
1195   if (ggc_p)
1196     t = ggc_alloc_tree (length);
1197   else
1198     t = (tree) obstack_alloc (current_obstack, length);
1199   memcpy (t, node, length);
1200
1201   TREE_CHAIN (t) = 0;
1202   TREE_ASM_WRITTEN (t) = 0;
1203
1204   if (TREE_CODE_CLASS (code) == 'd')
1205     DECL_UID (t) = next_decl_uid++;
1206   else if (TREE_CODE_CLASS (code) == 't')
1207     {
1208       TYPE_UID (t) = next_type_uid++;
1209       TYPE_OBSTACK (t) = current_obstack;
1210
1211       /* The following is so that the debug code for
1212          the copy is different from the original type.
1213          The two statements usually duplicate each other
1214          (because they clear fields of the same union),
1215          but the optimizer should catch that.  */
1216       TYPE_SYMTAB_POINTER (t) = 0;
1217       TYPE_SYMTAB_ADDRESS (t) = 0;
1218     }
1219
1220   TREE_SET_PERMANENT (t);
1221
1222   return t;
1223 }
1224
1225 /* Return a copy of a chain of nodes, chained through the TREE_CHAIN field.
1226    For example, this can copy a list made of TREE_LIST nodes.  */
1227
1228 tree
1229 copy_list (list)
1230      tree list;
1231 {
1232   tree head;
1233   register tree prev, next;
1234
1235   if (list == 0)
1236     return 0;
1237
1238   head = prev = copy_node (list);
1239   next = TREE_CHAIN (list);
1240   while (next)
1241     {
1242       TREE_CHAIN (prev) = copy_node (next);
1243       prev = TREE_CHAIN (prev);
1244       next = TREE_CHAIN (next);
1245     }
1246   return head;
1247 }
1248 \f
1249 #define HASHBITS 30
1250
1251 /* Return an IDENTIFIER_NODE whose name is TEXT (a null-terminated string).
1252    If an identifier with that name has previously been referred to,
1253    the same node is returned this time.  */
1254
1255 tree
1256 get_identifier (text)
1257      register const char *text;
1258 {
1259   register int hi;
1260   register int i;
1261   register tree idp;
1262   register int len, hash_len;
1263
1264   /* Compute length of text in len.  */
1265   len = strlen (text);
1266
1267   /* Decide how much of that length to hash on */
1268   hash_len = len;
1269   if (warn_id_clash && len > id_clash_len)
1270     hash_len = id_clash_len;
1271
1272   /* Compute hash code */
1273   hi = hash_len * 613 + (unsigned) text[0];
1274   for (i = 1; i < hash_len; i += 2)
1275     hi = ((hi * 613) + (unsigned) (text[i]));
1276
1277   hi &= (1 << HASHBITS) - 1;
1278   hi %= MAX_HASH_TABLE;
1279   
1280   /* Search table for identifier */
1281   for (idp = hash_table[hi]; idp; idp = TREE_CHAIN (idp))
1282     if (IDENTIFIER_LENGTH (idp) == len
1283         && IDENTIFIER_POINTER (idp)[0] == text[0]
1284         && !bcmp (IDENTIFIER_POINTER (idp), text, len))
1285       return idp;               /* <-- return if found */
1286
1287   /* Not found; optionally warn about a similar identifier */
1288   if (warn_id_clash && do_identifier_warnings && len >= id_clash_len)
1289     for (idp = hash_table[hi]; idp; idp = TREE_CHAIN (idp))
1290       if (!strncmp (IDENTIFIER_POINTER (idp), text, id_clash_len))
1291         {
1292           warning ("`%s' and `%s' identical in first %d characters",
1293                    IDENTIFIER_POINTER (idp), text, id_clash_len);
1294           break;
1295         }
1296
1297   if (TREE_CODE_LENGTH (IDENTIFIER_NODE) < 0)
1298     abort ();                   /* set_identifier_size hasn't been called.  */
1299
1300   /* Not found, create one, add to chain */
1301   idp = make_node (IDENTIFIER_NODE);
1302   IDENTIFIER_LENGTH (idp) = len;
1303 #ifdef GATHER_STATISTICS
1304   id_string_size += len;
1305 #endif
1306
1307   if (ggc_p)
1308     IDENTIFIER_POINTER (idp) = ggc_alloc_string (text, len);
1309   else
1310     IDENTIFIER_POINTER (idp) = obstack_copy0 (&permanent_obstack, text, len);
1311
1312   TREE_CHAIN (idp) = hash_table[hi];
1313   hash_table[hi] = idp;
1314   return idp;                   /* <-- return if created */
1315 }
1316
1317 /* If an identifier with the name TEXT (a null-terminated string) has
1318    previously been referred to, return that node; otherwise return
1319    NULL_TREE.  */
1320
1321 tree
1322 maybe_get_identifier (text)
1323      register const char *text;
1324 {
1325   register int hi;
1326   register int i;
1327   register tree idp;
1328   register int len, hash_len;
1329
1330   /* Compute length of text in len.  */
1331   len = strlen (text);
1332
1333   /* Decide how much of that length to hash on */
1334   hash_len = len;
1335   if (warn_id_clash && len > id_clash_len)
1336     hash_len = id_clash_len;
1337
1338   /* Compute hash code */
1339   hi = hash_len * 613 + (unsigned) text[0];
1340   for (i = 1; i < hash_len; i += 2)
1341     hi = ((hi * 613) + (unsigned) (text[i]));
1342
1343   hi &= (1 << HASHBITS) - 1;
1344   hi %= MAX_HASH_TABLE;
1345   
1346   /* Search table for identifier */
1347   for (idp = hash_table[hi]; idp; idp = TREE_CHAIN (idp))
1348     if (IDENTIFIER_LENGTH (idp) == len
1349         && IDENTIFIER_POINTER (idp)[0] == text[0]
1350         && !bcmp (IDENTIFIER_POINTER (idp), text, len))
1351       return idp;               /* <-- return if found */
1352
1353   return NULL_TREE;
1354 }
1355
1356 /* Enable warnings on similar identifiers (if requested).
1357    Done after the built-in identifiers are created.  */
1358
1359 void
1360 start_identifier_warnings ()
1361 {
1362   do_identifier_warnings = 1;
1363 }
1364
1365 /* Record the size of an identifier node for the language in use.
1366    SIZE is the total size in bytes.
1367    This is called by the language-specific files.  This must be
1368    called before allocating any identifiers.  */
1369
1370 void
1371 set_identifier_size (size)
1372      int size;
1373 {
1374   tree_code_length[(int) IDENTIFIER_NODE]
1375     = (size - sizeof (struct tree_common)) / sizeof (tree);
1376 }
1377 \f
1378 /* Return a newly constructed INTEGER_CST node whose constant value
1379    is specified by the two ints LOW and HI.
1380    The TREE_TYPE is set to `int'. 
1381
1382    This function should be used via the `build_int_2' macro.  */
1383
1384 tree
1385 build_int_2_wide (low, hi)
1386      unsigned HOST_WIDE_INT low;
1387      HOST_WIDE_INT hi;
1388 {
1389   register tree t = make_node (INTEGER_CST);
1390
1391   TREE_INT_CST_LOW (t) = low;
1392   TREE_INT_CST_HIGH (t) = hi;
1393   TREE_TYPE (t) = integer_type_node;
1394   return t;
1395 }
1396
1397 /* Return a new REAL_CST node whose type is TYPE and value is D.  */
1398
1399 tree
1400 build_real (type, d)
1401      tree type;
1402      REAL_VALUE_TYPE d;
1403 {
1404   tree v;
1405   int overflow = 0;
1406
1407   /* Check for valid float value for this type on this target machine;
1408      if not, can print error message and store a valid value in D.  */
1409 #ifdef CHECK_FLOAT_VALUE
1410   CHECK_FLOAT_VALUE (TYPE_MODE (type), d, overflow);
1411 #endif
1412
1413   v = make_node (REAL_CST);
1414   TREE_TYPE (v) = type;
1415   TREE_REAL_CST (v) = d;
1416   TREE_OVERFLOW (v) = TREE_CONSTANT_OVERFLOW (v) = overflow;
1417   return v;
1418 }
1419
1420 /* Return a new REAL_CST node whose type is TYPE
1421    and whose value is the integer value of the INTEGER_CST node I.  */
1422
1423 #if !defined (REAL_IS_NOT_DOUBLE) || defined (REAL_ARITHMETIC)
1424
1425 REAL_VALUE_TYPE
1426 real_value_from_int_cst (type, i)
1427      tree type ATTRIBUTE_UNUSED, i;
1428 {
1429   REAL_VALUE_TYPE d;
1430
1431 #ifdef REAL_ARITHMETIC
1432   /* Clear all bits of the real value type so that we can later do
1433      bitwise comparisons to see if two values are the same.  */
1434   bzero ((char *) &d, sizeof d);
1435
1436   if (! TREE_UNSIGNED (TREE_TYPE (i)))
1437     REAL_VALUE_FROM_INT (d, TREE_INT_CST_LOW (i), TREE_INT_CST_HIGH (i),
1438                          TYPE_MODE (type));
1439   else
1440     REAL_VALUE_FROM_UNSIGNED_INT (d, TREE_INT_CST_LOW (i),
1441                                   TREE_INT_CST_HIGH (i), TYPE_MODE (type));
1442 #else /* not REAL_ARITHMETIC */
1443   /* Some 386 compilers mishandle unsigned int to float conversions,
1444      so introduce a temporary variable E to avoid those bugs.  */
1445   if (TREE_INT_CST_HIGH (i) < 0 && ! TREE_UNSIGNED (TREE_TYPE (i)))
1446     {
1447       REAL_VALUE_TYPE e;
1448
1449       d = (double) (~ TREE_INT_CST_HIGH (i));
1450       e = ((double) ((HOST_WIDE_INT) 1 << (HOST_BITS_PER_WIDE_INT / 2))
1451             * (double) ((HOST_WIDE_INT) 1 << (HOST_BITS_PER_WIDE_INT / 2)));
1452       d *= e;
1453       e = (double) (~ TREE_INT_CST_LOW (i));
1454       d += e;
1455       d = (- d - 1.0);
1456     }
1457   else
1458     {
1459       REAL_VALUE_TYPE e;
1460
1461       d = (double) (unsigned HOST_WIDE_INT) TREE_INT_CST_HIGH (i);
1462       e = ((double) ((HOST_WIDE_INT) 1 << (HOST_BITS_PER_WIDE_INT / 2))
1463             * (double) ((HOST_WIDE_INT) 1 << (HOST_BITS_PER_WIDE_INT / 2)));
1464       d *= e;
1465       e = (double) TREE_INT_CST_LOW (i);
1466       d += e;
1467     }
1468 #endif /* not REAL_ARITHMETIC */
1469   return d;
1470 }
1471
1472 /* Args to pass to and from build_real_from_int_cst_1.  */
1473
1474 struct brfic_args
1475 {
1476   tree type;                    /* Input: type to conver to. */
1477   tree i;                       /* Input: operand to convert */
1478   REAL_VALUE_TYPE d;            /* Output: floating point value. */
1479 };
1480
1481 /* Convert an integer to a floating point value while protected by a floating
1482    point exception handler.  */
1483
1484 static void
1485 build_real_from_int_cst_1 (data)
1486   PTR data;
1487 {
1488   struct brfic_args *args = (struct brfic_args *) data;
1489   
1490 #ifdef REAL_ARITHMETIC
1491   args->d = real_value_from_int_cst (args->type, args->i);
1492 #else
1493   args->d
1494     = REAL_VALUE_TRUNCATE (TYPE_MODE (args->type),
1495                            real_value_from_int_cst (args->type, args->i));
1496 #endif
1497 }
1498
1499 /* Given a tree representing an integer constant I, return a tree
1500    representing the same value as a floating-point constant of type TYPE.
1501    We cannot perform this operation if there is no way of doing arithmetic
1502    on floating-point values.  */
1503
1504 tree
1505 build_real_from_int_cst (type, i)
1506      tree type;
1507      tree i;
1508 {
1509   tree v;
1510   int overflow = TREE_OVERFLOW (i);
1511   REAL_VALUE_TYPE d;
1512   struct brfic_args args;
1513
1514   v = make_node (REAL_CST);
1515   TREE_TYPE (v) = type;
1516
1517   /* Setup input for build_real_from_int_cst_1() */
1518   args.type = type;
1519   args.i = i;
1520
1521   if (do_float_handler (build_real_from_int_cst_1, (PTR) &args))
1522     /* Receive output from build_real_from_int_cst_1() */
1523     d = args.d;
1524   else
1525     {
1526       /* We got an exception from build_real_from_int_cst_1() */
1527       d = dconst0;
1528       overflow = 1;
1529     }
1530   
1531   /* Check for valid float value for this type on this target machine.  */
1532
1533 #ifdef CHECK_FLOAT_VALUE
1534   CHECK_FLOAT_VALUE (TYPE_MODE (type), d, overflow);
1535 #endif
1536
1537   TREE_REAL_CST (v) = d;
1538   TREE_OVERFLOW (v) = TREE_CONSTANT_OVERFLOW (v) = overflow;
1539   return v;
1540 }
1541
1542 #endif /* not REAL_IS_NOT_DOUBLE, or REAL_ARITHMETIC */
1543
1544 /* Return a newly constructed STRING_CST node whose value is
1545    the LEN characters at STR.
1546    The TREE_TYPE is not initialized.  */
1547
1548 tree
1549 build_string (len, str)
1550      int len;
1551      const char *str;
1552 {
1553   /* Put the string in saveable_obstack since it will be placed in the RTL
1554      for an "asm" statement and will also be kept around a while if
1555      deferring constant output in varasm.c.  */
1556
1557   register tree s = make_node (STRING_CST);
1558
1559   TREE_STRING_LENGTH (s) = len;
1560   if (ggc_p)
1561     TREE_STRING_POINTER (s) = ggc_alloc_string (str, len);
1562   else
1563     TREE_STRING_POINTER (s) = obstack_copy0 (saveable_obstack, str, len);
1564
1565   return s;
1566 }
1567
1568 /* Return a newly constructed COMPLEX_CST node whose value is
1569    specified by the real and imaginary parts REAL and IMAG.
1570    Both REAL and IMAG should be constant nodes.  TYPE, if specified,
1571    will be the type of the COMPLEX_CST; otherwise a new type will be made.  */
1572
1573 tree
1574 build_complex (type, real, imag)
1575      tree type;
1576      tree real, imag;
1577 {
1578   register tree t = make_node (COMPLEX_CST);
1579
1580   TREE_REALPART (t) = real;
1581   TREE_IMAGPART (t) = imag;
1582   TREE_TYPE (t) = type ? type : build_complex_type (TREE_TYPE (real));
1583   TREE_OVERFLOW (t) = TREE_OVERFLOW (real) | TREE_OVERFLOW (imag);
1584   TREE_CONSTANT_OVERFLOW (t)
1585     = TREE_CONSTANT_OVERFLOW (real) | TREE_CONSTANT_OVERFLOW (imag);
1586   return t;
1587 }
1588
1589 /* Build a newly constructed TREE_VEC node of length LEN.  */
1590
1591 tree
1592 make_tree_vec (len)
1593      int len;
1594 {
1595   register tree t;
1596   register int length = (len-1) * sizeof (tree) + sizeof (struct tree_vec);
1597   register struct obstack *obstack = current_obstack;
1598
1599 #ifdef GATHER_STATISTICS
1600   tree_node_counts[(int)vec_kind]++;
1601   tree_node_sizes[(int)vec_kind] += length;
1602 #endif
1603
1604   if (ggc_p)
1605     t = ggc_alloc_tree (length);
1606   else
1607     {
1608       t = (tree) obstack_alloc (obstack, length);
1609       bzero ((PTR) t, length);
1610     }
1611
1612   TREE_SET_CODE (t, TREE_VEC);
1613   TREE_VEC_LENGTH (t) = len;
1614   TREE_SET_PERMANENT (t);
1615
1616   return t;
1617 }
1618 \f
1619 /* Return 1 if EXPR is the integer constant zero or a complex constant
1620    of zero.  */
1621
1622 int
1623 integer_zerop (expr)
1624      tree expr;
1625 {
1626   STRIP_NOPS (expr);
1627
1628   return ((TREE_CODE (expr) == INTEGER_CST
1629            && ! TREE_CONSTANT_OVERFLOW (expr)
1630            && TREE_INT_CST_LOW (expr) == 0
1631            && TREE_INT_CST_HIGH (expr) == 0)
1632           || (TREE_CODE (expr) == COMPLEX_CST
1633               && integer_zerop (TREE_REALPART (expr))
1634               && integer_zerop (TREE_IMAGPART (expr))));
1635 }
1636
1637 /* Return 1 if EXPR is the integer constant one or the corresponding
1638    complex constant.  */
1639
1640 int
1641 integer_onep (expr)
1642      tree expr;
1643 {
1644   STRIP_NOPS (expr);
1645
1646   return ((TREE_CODE (expr) == INTEGER_CST
1647            && ! TREE_CONSTANT_OVERFLOW (expr)
1648            && TREE_INT_CST_LOW (expr) == 1
1649            && TREE_INT_CST_HIGH (expr) == 0)
1650           || (TREE_CODE (expr) == COMPLEX_CST
1651               && integer_onep (TREE_REALPART (expr))
1652               && integer_zerop (TREE_IMAGPART (expr))));
1653 }
1654
1655 /* Return 1 if EXPR is an integer containing all 1's in as much precision as
1656    it contains.  Likewise for the corresponding complex constant.  */
1657
1658 int
1659 integer_all_onesp (expr)
1660      tree expr;
1661 {
1662   register int prec;
1663   register int uns;
1664
1665   STRIP_NOPS (expr);
1666
1667   if (TREE_CODE (expr) == COMPLEX_CST
1668       && integer_all_onesp (TREE_REALPART (expr))
1669       && integer_zerop (TREE_IMAGPART (expr)))
1670     return 1;
1671
1672   else if (TREE_CODE (expr) != INTEGER_CST
1673            || TREE_CONSTANT_OVERFLOW (expr))
1674     return 0;
1675
1676   uns = TREE_UNSIGNED (TREE_TYPE (expr));
1677   if (!uns)
1678     return (TREE_INT_CST_LOW (expr) == ~ (unsigned HOST_WIDE_INT) 0
1679             && TREE_INT_CST_HIGH (expr) == -1);
1680
1681   /* Note that using TYPE_PRECISION here is wrong.  We care about the
1682      actual bits, not the (arbitrary) range of the type.  */
1683   prec = GET_MODE_BITSIZE (TYPE_MODE (TREE_TYPE (expr)));
1684   if (prec >= HOST_BITS_PER_WIDE_INT)
1685     {
1686       HOST_WIDE_INT high_value;
1687       int shift_amount;
1688
1689       shift_amount = prec - HOST_BITS_PER_WIDE_INT;
1690
1691       if (shift_amount > HOST_BITS_PER_WIDE_INT)
1692         /* Can not handle precisions greater than twice the host int size.  */
1693         abort ();
1694       else if (shift_amount == HOST_BITS_PER_WIDE_INT)
1695         /* Shifting by the host word size is undefined according to the ANSI
1696            standard, so we must handle this as a special case.  */
1697         high_value = -1;
1698       else
1699         high_value = ((HOST_WIDE_INT) 1 << shift_amount) - 1;
1700
1701       return (TREE_INT_CST_LOW (expr) == ~ (unsigned HOST_WIDE_INT) 0
1702               && TREE_INT_CST_HIGH (expr) == high_value);
1703     }
1704   else
1705     return TREE_INT_CST_LOW (expr) == ((unsigned HOST_WIDE_INT) 1 << prec) - 1;
1706 }
1707
1708 /* Return 1 if EXPR is an integer constant that is a power of 2 (i.e., has only
1709    one bit on).  */
1710
1711 int
1712 integer_pow2p (expr)
1713      tree expr;
1714 {
1715   int prec;
1716   HOST_WIDE_INT high, low;
1717
1718   STRIP_NOPS (expr);
1719
1720   if (TREE_CODE (expr) == COMPLEX_CST
1721       && integer_pow2p (TREE_REALPART (expr))
1722       && integer_zerop (TREE_IMAGPART (expr)))
1723     return 1;
1724
1725   if (TREE_CODE (expr) != INTEGER_CST || TREE_CONSTANT_OVERFLOW (expr))
1726     return 0;
1727
1728   prec = (POINTER_TYPE_P (TREE_TYPE (expr))
1729           ? POINTER_SIZE : TYPE_PRECISION (TREE_TYPE (expr)));
1730   high = TREE_INT_CST_HIGH (expr);
1731   low = TREE_INT_CST_LOW (expr);
1732
1733   /* First clear all bits that are beyond the type's precision in case
1734      we've been sign extended.  */
1735
1736   if (prec == 2 * HOST_BITS_PER_WIDE_INT)
1737     ;
1738   else if (prec > HOST_BITS_PER_WIDE_INT)
1739     high &= ~((HOST_WIDE_INT) (-1) << (prec - HOST_BITS_PER_WIDE_INT));
1740   else
1741     {
1742       high = 0;
1743       if (prec < HOST_BITS_PER_WIDE_INT)
1744         low &= ~((HOST_WIDE_INT) (-1) << prec);
1745     }
1746
1747   if (high == 0 && low == 0)
1748     return 0;
1749
1750   return ((high == 0 && (low & (low - 1)) == 0)
1751           || (low == 0 && (high & (high - 1)) == 0));
1752 }
1753
1754 /* Return the power of two represented by a tree node known to be a
1755    power of two.  */
1756
1757 int
1758 tree_log2 (expr)
1759      tree expr;
1760 {
1761   int prec;
1762   HOST_WIDE_INT high, low;
1763
1764   STRIP_NOPS (expr);
1765
1766   if (TREE_CODE (expr) == COMPLEX_CST)
1767     return tree_log2 (TREE_REALPART (expr));
1768
1769   prec = (POINTER_TYPE_P (TREE_TYPE (expr))
1770           ? POINTER_SIZE : TYPE_PRECISION (TREE_TYPE (expr)));
1771
1772   high = TREE_INT_CST_HIGH (expr);
1773   low = TREE_INT_CST_LOW (expr);
1774
1775   /* First clear all bits that are beyond the type's precision in case
1776      we've been sign extended.  */
1777
1778   if (prec == 2 * HOST_BITS_PER_WIDE_INT)
1779     ;
1780   else if (prec > HOST_BITS_PER_WIDE_INT)
1781     high &= ~((HOST_WIDE_INT) (-1) << (prec - HOST_BITS_PER_WIDE_INT));
1782   else
1783     {
1784       high = 0;
1785       if (prec < HOST_BITS_PER_WIDE_INT)
1786         low &= ~((HOST_WIDE_INT) (-1) << prec);
1787     }
1788
1789   return (high != 0 ? HOST_BITS_PER_WIDE_INT + exact_log2 (high)
1790           :  exact_log2 (low));
1791 }
1792
1793 /* Similar, but return the largest integer Y such that 2 ** Y is less
1794    than or equal to EXPR.  */
1795
1796 int
1797 tree_floor_log2 (expr)
1798      tree expr;
1799 {
1800   int prec;
1801   HOST_WIDE_INT high, low;
1802
1803   STRIP_NOPS (expr);
1804
1805   if (TREE_CODE (expr) == COMPLEX_CST)
1806     return tree_log2 (TREE_REALPART (expr));
1807
1808   prec = (POINTER_TYPE_P (TREE_TYPE (expr))
1809           ? POINTER_SIZE : TYPE_PRECISION (TREE_TYPE (expr)));
1810
1811   high = TREE_INT_CST_HIGH (expr);
1812   low = TREE_INT_CST_LOW (expr);
1813
1814   /* First clear all bits that are beyond the type's precision in case
1815      we've been sign extended.  Ignore if type's precision hasn't been set
1816      since what we are doing is setting it.  */
1817
1818   if (prec == 2 * HOST_BITS_PER_WIDE_INT || prec == 0)
1819     ;
1820   else if (prec > HOST_BITS_PER_WIDE_INT)
1821     high &= ~((HOST_WIDE_INT) (-1) << (prec - HOST_BITS_PER_WIDE_INT));
1822   else
1823     {
1824       high = 0;
1825       if (prec < HOST_BITS_PER_WIDE_INT)
1826         low &= ~((HOST_WIDE_INT) (-1) << prec);
1827     }
1828
1829   return (high != 0 ? HOST_BITS_PER_WIDE_INT + floor_log2 (high)
1830           : floor_log2 (low));
1831 }
1832
1833 /* Return 1 if EXPR is the real constant zero.  */
1834
1835 int
1836 real_zerop (expr)
1837      tree expr;
1838 {
1839   STRIP_NOPS (expr);
1840
1841   return ((TREE_CODE (expr) == REAL_CST
1842            && ! TREE_CONSTANT_OVERFLOW (expr)
1843            && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst0))
1844           || (TREE_CODE (expr) == COMPLEX_CST
1845               && real_zerop (TREE_REALPART (expr))
1846               && real_zerop (TREE_IMAGPART (expr))));
1847 }
1848
1849 /* Return 1 if EXPR is the real constant one in real or complex form.  */
1850
1851 int
1852 real_onep (expr)
1853      tree expr;
1854 {
1855   STRIP_NOPS (expr);
1856
1857   return ((TREE_CODE (expr) == REAL_CST
1858            && ! TREE_CONSTANT_OVERFLOW (expr)
1859            && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst1))
1860           || (TREE_CODE (expr) == COMPLEX_CST
1861               && real_onep (TREE_REALPART (expr))
1862               && real_zerop (TREE_IMAGPART (expr))));
1863 }
1864
1865 /* Return 1 if EXPR is the real constant two.  */
1866
1867 int
1868 real_twop (expr)
1869      tree expr;
1870 {
1871   STRIP_NOPS (expr);
1872
1873   return ((TREE_CODE (expr) == REAL_CST
1874            && ! TREE_CONSTANT_OVERFLOW (expr)
1875            && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst2))
1876           || (TREE_CODE (expr) == COMPLEX_CST
1877               && real_twop (TREE_REALPART (expr))
1878               && real_zerop (TREE_IMAGPART (expr))));
1879 }
1880
1881 /* Nonzero if EXP is a constant or a cast of a constant.  */
1882  
1883 int
1884 really_constant_p (exp)
1885      tree exp;
1886 {
1887   /* This is not quite the same as STRIP_NOPS.  It does more.  */
1888   while (TREE_CODE (exp) == NOP_EXPR
1889          || TREE_CODE (exp) == CONVERT_EXPR
1890          || TREE_CODE (exp) == NON_LVALUE_EXPR)
1891     exp = TREE_OPERAND (exp, 0);
1892   return TREE_CONSTANT (exp);
1893 }
1894 \f
1895 /* Return first list element whose TREE_VALUE is ELEM.
1896    Return 0 if ELEM is not in LIST.  */
1897
1898 tree
1899 value_member (elem, list)
1900      tree elem, list;
1901 {
1902   while (list)
1903     {
1904       if (elem == TREE_VALUE (list))
1905         return list;
1906       list = TREE_CHAIN (list);
1907     }
1908   return NULL_TREE;
1909 }
1910
1911 /* Return first list element whose TREE_PURPOSE is ELEM.
1912    Return 0 if ELEM is not in LIST.  */
1913
1914 tree
1915 purpose_member (elem, list)
1916      tree elem, list;
1917 {
1918   while (list)
1919     {
1920       if (elem == TREE_PURPOSE (list))
1921         return list;
1922       list = TREE_CHAIN (list);
1923     }
1924   return NULL_TREE;
1925 }
1926
1927 /* Return first list element whose BINFO_TYPE is ELEM.
1928    Return 0 if ELEM is not in LIST.  */
1929
1930 tree
1931 binfo_member (elem, list)
1932      tree elem, list;
1933 {
1934   while (list)
1935     {
1936       if (elem == BINFO_TYPE (list))
1937         return list;
1938       list = TREE_CHAIN (list);
1939     }
1940   return NULL_TREE;
1941 }
1942
1943 /* Return nonzero if ELEM is part of the chain CHAIN.  */
1944
1945 int
1946 chain_member (elem, chain)
1947      tree elem, chain;
1948 {
1949   while (chain)
1950     {
1951       if (elem == chain)
1952         return 1;
1953       chain = TREE_CHAIN (chain);
1954     }
1955
1956   return 0;
1957 }
1958
1959 /* Return nonzero if ELEM is equal to TREE_VALUE (CHAIN) for any piece of
1960    chain CHAIN.  This and the next function are currently unused, but
1961    are retained for completeness.  */
1962
1963 int
1964 chain_member_value (elem, chain)
1965      tree elem, chain;
1966 {
1967   while (chain)
1968     {
1969       if (elem == TREE_VALUE (chain))
1970         return 1;
1971       chain = TREE_CHAIN (chain);
1972     }
1973
1974   return 0;
1975 }
1976
1977 /* Return nonzero if ELEM is equal to TREE_PURPOSE (CHAIN)
1978    for any piece of chain CHAIN.  */
1979
1980 int
1981 chain_member_purpose (elem, chain)
1982      tree elem, chain;
1983 {
1984   while (chain)
1985     {
1986       if (elem == TREE_PURPOSE (chain))
1987         return 1;
1988       chain = TREE_CHAIN (chain);
1989     }
1990
1991   return 0;
1992 }
1993
1994 /* Return the length of a chain of nodes chained through TREE_CHAIN.
1995    We expect a null pointer to mark the end of the chain.
1996    This is the Lisp primitive `length'.  */
1997
1998 int
1999 list_length (t)
2000      tree t;
2001 {
2002   register tree tail;
2003   register int len = 0;
2004
2005   for (tail = t; tail; tail = TREE_CHAIN (tail))
2006     len++;
2007
2008   return len;
2009 }
2010
2011 /* Returns the number of FIELD_DECLs in TYPE.  */
2012
2013 int
2014 fields_length (type)
2015      tree type;
2016 {
2017   tree t = TYPE_FIELDS (type);
2018   int count = 0;
2019
2020   for (; t; t = TREE_CHAIN (t))
2021     if (TREE_CODE (t) == FIELD_DECL)
2022       ++count;
2023
2024   return count;
2025 }
2026
2027 /* Concatenate two chains of nodes (chained through TREE_CHAIN)
2028    by modifying the last node in chain 1 to point to chain 2.
2029    This is the Lisp primitive `nconc'.  */
2030
2031 tree
2032 chainon (op1, op2)
2033      tree op1, op2;
2034 {
2035
2036   if (op1)
2037     {
2038       register tree t1;
2039 #ifdef ENABLE_TREE_CHECKING
2040       register tree t2;
2041 #endif
2042
2043       for (t1 = op1; TREE_CHAIN (t1); t1 = TREE_CHAIN (t1))
2044         ;
2045       TREE_CHAIN (t1) = op2;
2046 #ifdef ENABLE_TREE_CHECKING
2047       for (t2 = op2; t2; t2 = TREE_CHAIN (t2))
2048         if (t2 == t1)
2049           abort ();  /* Circularity created.  */
2050 #endif
2051       return op1;
2052     }
2053   else return op2;
2054 }
2055
2056 /* Return the last node in a chain of nodes (chained through TREE_CHAIN).  */
2057
2058 tree
2059 tree_last (chain)
2060      register tree chain;
2061 {
2062   register tree next;
2063   if (chain)
2064     while ((next = TREE_CHAIN (chain)))
2065       chain = next;
2066   return chain;
2067 }
2068
2069 /* Reverse the order of elements in the chain T,
2070    and return the new head of the chain (old last element).  */
2071
2072 tree
2073 nreverse (t)
2074      tree t;
2075 {
2076   register tree prev = 0, decl, next;
2077   for (decl = t; decl; decl = next)
2078     {
2079       next = TREE_CHAIN (decl);
2080       TREE_CHAIN (decl) = prev;
2081       prev = decl;
2082     }
2083   return prev;
2084 }
2085
2086 /* Given a chain CHAIN of tree nodes,
2087    construct and return a list of those nodes.  */
2088
2089 tree
2090 listify (chain)
2091      tree chain;
2092 {
2093   tree result = NULL_TREE;
2094   tree in_tail = chain;
2095   tree out_tail = NULL_TREE;
2096
2097   while (in_tail)
2098     {
2099       tree next = tree_cons (NULL_TREE, in_tail, NULL_TREE);
2100       if (out_tail)
2101         TREE_CHAIN (out_tail) = next;
2102       else
2103         result = next;
2104       out_tail = next;
2105       in_tail = TREE_CHAIN (in_tail);
2106     }
2107
2108   return result;
2109 }
2110 \f
2111 /* Return a newly created TREE_LIST node whose
2112    purpose and value fields are PARM and VALUE.  */
2113
2114 tree
2115 build_tree_list (parm, value)
2116      tree parm, value;
2117 {
2118   register tree t = make_node (TREE_LIST);
2119   TREE_PURPOSE (t) = parm;
2120   TREE_VALUE (t) = value;
2121   return t;
2122 }
2123
2124 /* Similar, but build on the temp_decl_obstack.  */
2125
2126 tree
2127 build_decl_list (parm, value)
2128      tree parm, value;
2129 {
2130   register tree node;
2131   register struct obstack *ambient_obstack = current_obstack;
2132
2133   current_obstack = &temp_decl_obstack;
2134   node = build_tree_list (parm, value);
2135   current_obstack = ambient_obstack;
2136   return node;
2137 }
2138
2139 /* Similar, but build on the expression_obstack.  */
2140
2141 tree
2142 build_expr_list (parm, value)
2143      tree parm, value;
2144 {
2145   register tree node;
2146   register struct obstack *ambient_obstack = current_obstack;
2147
2148   current_obstack = expression_obstack;
2149   node = build_tree_list (parm, value);
2150   current_obstack = ambient_obstack;
2151   return node;
2152 }
2153
2154 /* Return a newly created TREE_LIST node whose
2155    purpose and value fields are PARM and VALUE
2156    and whose TREE_CHAIN is CHAIN.  */
2157
2158 tree
2159 tree_cons (purpose, value, chain)
2160      tree purpose, value, chain;
2161 {
2162   register tree node;
2163
2164   if (ggc_p)
2165     node = ggc_alloc_tree (sizeof (struct tree_list));
2166   else
2167     {
2168       node = (tree) obstack_alloc (current_obstack, sizeof (struct tree_list));
2169       memset (node, 0, sizeof (struct tree_common));
2170     }
2171
2172 #ifdef GATHER_STATISTICS
2173   tree_node_counts[(int) x_kind]++;
2174   tree_node_sizes[(int) x_kind] += sizeof (struct tree_list);
2175 #endif
2176
2177   TREE_SET_CODE (node, TREE_LIST);
2178   TREE_SET_PERMANENT (node);
2179
2180   TREE_CHAIN (node) = chain;
2181   TREE_PURPOSE (node) = purpose;
2182   TREE_VALUE (node) = value;
2183   return node;
2184 }
2185
2186 /* Similar, but build on the temp_decl_obstack.  */
2187
2188 tree
2189 decl_tree_cons (purpose, value, chain)
2190      tree purpose, value, chain;
2191 {
2192   register tree node;
2193   register struct obstack *ambient_obstack = current_obstack;
2194
2195   current_obstack = &temp_decl_obstack;
2196   node = tree_cons (purpose, value, chain);
2197   current_obstack = ambient_obstack;
2198   return node;
2199 }
2200
2201 /* Similar, but build on the expression_obstack.  */
2202
2203 tree
2204 expr_tree_cons (purpose, value, chain)
2205      tree purpose, value, chain;
2206 {
2207   register tree node;
2208   register struct obstack *ambient_obstack = current_obstack;
2209
2210   current_obstack = expression_obstack;
2211   node = tree_cons (purpose, value, chain);
2212   current_obstack = ambient_obstack;
2213   return node;
2214 }
2215
2216 /* Same as `tree_cons' but make a permanent object.  */
2217
2218 tree
2219 perm_tree_cons (purpose, value, chain)
2220      tree purpose, value, chain;
2221 {
2222   register tree node;
2223   register struct obstack *ambient_obstack = current_obstack;
2224
2225   current_obstack = &permanent_obstack;
2226   node = tree_cons (purpose, value, chain);
2227   current_obstack = ambient_obstack;
2228   return node;
2229 }
2230
2231 /* Same as `tree_cons', but make this node temporary, regardless.  */
2232
2233 tree
2234 temp_tree_cons (purpose, value, chain)
2235      tree purpose, value, chain;
2236 {
2237   register tree node;
2238   register struct obstack *ambient_obstack = current_obstack;
2239
2240   current_obstack = &temporary_obstack;
2241   node = tree_cons (purpose, value, chain);
2242   current_obstack = ambient_obstack;
2243   return node;
2244 }
2245
2246 /* Same as `tree_cons', but save this node if the function's RTL is saved.  */
2247
2248 tree
2249 saveable_tree_cons (purpose, value, chain)
2250      tree purpose, value, chain;
2251 {
2252   register tree node;
2253   register struct obstack *ambient_obstack = current_obstack;
2254
2255   current_obstack = saveable_obstack;
2256   node = tree_cons (purpose, value, chain);
2257   current_obstack = ambient_obstack;
2258   return node;
2259 }
2260 \f
2261 /* Return the size nominally occupied by an object of type TYPE
2262    when it resides in memory.  The value is measured in units of bytes,
2263    and its data type is that normally used for type sizes
2264    (which is the first type created by make_signed_type or
2265    make_unsigned_type).  */
2266
2267 tree
2268 size_in_bytes (type)
2269      tree type;
2270 {
2271   tree t;
2272
2273   if (type == error_mark_node)
2274     return integer_zero_node;
2275
2276   type = TYPE_MAIN_VARIANT (type);
2277   t = TYPE_SIZE_UNIT (type);
2278
2279   if (t == 0)
2280     {
2281       incomplete_type_error (NULL_TREE, type);
2282       return size_zero_node;
2283     }
2284
2285   if (TREE_CODE (t) == INTEGER_CST)
2286     force_fit_type (t, 0);
2287
2288   return t;
2289 }
2290
2291 /* Return the size of TYPE (in bytes) as a wide integer
2292    or return -1 if the size can vary or is larger than an integer.  */
2293
2294 HOST_WIDE_INT
2295 int_size_in_bytes (type)
2296      tree type;
2297 {
2298   tree t;
2299
2300   if (type == error_mark_node)
2301     return 0;
2302
2303   type = TYPE_MAIN_VARIANT (type);
2304   t = TYPE_SIZE_UNIT (type);
2305   if (t == 0
2306       || TREE_CODE (t) != INTEGER_CST
2307       || TREE_OVERFLOW (t)
2308       || TREE_INT_CST_HIGH (t) != 0
2309       /* If the result would appear negative, it's too big to represent.  */
2310       || (HOST_WIDE_INT) TREE_INT_CST_LOW (t) < 0)
2311     return -1;
2312
2313   return TREE_INT_CST_LOW (t);
2314 }
2315 \f
2316 /* Return the bit position of FIELD, in bits from the start of the record.
2317    This is a tree of type bitsizetype.  */
2318
2319 tree
2320 bit_position (field)
2321      tree field;
2322 {
2323
2324   return bit_from_pos (DECL_FIELD_OFFSET (field),
2325                        DECL_FIELD_BIT_OFFSET (field));
2326 }
2327
2328 /* Likewise, but return as an integer.  Abort if it cannot be represented
2329    in that way (since it could be a signed value, we don't have the option
2330    of returning -1 like int_size_in_byte can.  */
2331
2332 HOST_WIDE_INT
2333 int_bit_position (field)
2334      tree field;
2335 {
2336   return tree_low_cst (bit_position (field), 0);
2337 }
2338 \f
2339 /* Return the byte position of FIELD, in bytes from the start of the record.
2340    This is a tree of type sizetype.  */
2341
2342 tree
2343 byte_position (field)
2344      tree field;
2345 {
2346   return byte_from_pos (DECL_FIELD_OFFSET (field),
2347                         DECL_FIELD_BIT_OFFSET (field));
2348 }
2349
2350 /* Likewise, but return as an integer.  Abort if it cannot be represented
2351    in that way (since it could be a signed value, we don't have the option
2352    of returning -1 like int_size_in_byte can.  */
2353
2354 HOST_WIDE_INT
2355 int_byte_position (field)
2356      tree field;
2357 {
2358   return tree_low_cst (byte_position (field), 0);
2359 }
2360 \f
2361 /* Return the strictest alignment, in bits, that T is known to have.  */
2362
2363 unsigned int
2364 expr_align (t)
2365      tree t;
2366 {
2367   unsigned int align0, align1;
2368
2369   switch (TREE_CODE (t))
2370     {
2371     case NOP_EXPR:  case CONVERT_EXPR:  case NON_LVALUE_EXPR:
2372       /* If we have conversions, we know that the alignment of the
2373          object must meet each of the alignments of the types.  */
2374       align0 = expr_align (TREE_OPERAND (t, 0));
2375       align1 = TYPE_ALIGN (TREE_TYPE (t));
2376       return MAX (align0, align1);
2377
2378     case SAVE_EXPR:         case COMPOUND_EXPR:       case MODIFY_EXPR:
2379     case INIT_EXPR:         case TARGET_EXPR:         case WITH_CLEANUP_EXPR:
2380     case WITH_RECORD_EXPR:  case CLEANUP_POINT_EXPR:  case UNSAVE_EXPR:
2381       /* These don't change the alignment of an object.  */
2382       return expr_align (TREE_OPERAND (t, 0));
2383
2384     case COND_EXPR:
2385       /* The best we can do is say that the alignment is the least aligned
2386          of the two arms.  */
2387       align0 = expr_align (TREE_OPERAND (t, 1));
2388       align1 = expr_align (TREE_OPERAND (t, 2));
2389       return MIN (align0, align1);
2390
2391     case LABEL_DECL:     case CONST_DECL:
2392     case VAR_DECL:       case PARM_DECL:   case RESULT_DECL:
2393       if (DECL_ALIGN (t) != 0)
2394         return DECL_ALIGN (t);
2395       break;
2396
2397     case FUNCTION_DECL:
2398       return FUNCTION_BOUNDARY;
2399
2400     default:
2401       break;
2402     }
2403
2404   /* Otherwise take the alignment from that of the type.  */
2405   return TYPE_ALIGN (TREE_TYPE (t));
2406 }
2407 \f
2408 /* Return, as a tree node, the number of elements for TYPE (which is an
2409    ARRAY_TYPE) minus one. This counts only elements of the top array.  */
2410
2411 tree
2412 array_type_nelts (type)
2413      tree type;
2414 {
2415   tree index_type, min, max;
2416
2417   /* If they did it with unspecified bounds, then we should have already
2418      given an error about it before we got here.  */
2419   if (! TYPE_DOMAIN (type))
2420     return error_mark_node;
2421
2422   index_type = TYPE_DOMAIN (type);
2423   min = TYPE_MIN_VALUE (index_type);
2424   max = TYPE_MAX_VALUE (index_type);
2425
2426   return (integer_zerop (min)
2427           ? max
2428           : fold (build (MINUS_EXPR, TREE_TYPE (max), max, min)));
2429 }
2430 \f
2431 /* Return nonzero if arg is static -- a reference to an object in
2432    static storage.  This is not the same as the C meaning of `static'.  */
2433
2434 int
2435 staticp (arg)
2436      tree arg;
2437 {
2438   switch (TREE_CODE (arg))
2439     {
2440     case FUNCTION_DECL:
2441       /* Nested functions aren't static, since taking their address
2442          involves a trampoline.  */
2443       return (decl_function_context (arg) == 0 || DECL_NO_STATIC_CHAIN (arg))
2444         && ! DECL_NON_ADDR_CONST_P (arg);
2445
2446     case VAR_DECL:
2447       return (TREE_STATIC (arg) || DECL_EXTERNAL (arg))
2448         && ! DECL_NON_ADDR_CONST_P (arg);
2449
2450     case CONSTRUCTOR:
2451       return TREE_STATIC (arg);
2452
2453     case LABEL_DECL:
2454     case STRING_CST:
2455       return 1;
2456
2457       /* If we are referencing a bitfield, we can't evaluate an
2458          ADDR_EXPR at compile time and so it isn't a constant.  */
2459     case COMPONENT_REF:
2460       return (! DECL_BIT_FIELD (TREE_OPERAND (arg, 1))
2461               && staticp (TREE_OPERAND (arg, 0)));
2462
2463     case BIT_FIELD_REF:
2464       return 0;
2465
2466 #if 0
2467        /* This case is technically correct, but results in setting
2468           TREE_CONSTANT on ADDR_EXPRs that cannot be evaluated at
2469           compile time.  */
2470     case INDIRECT_REF:
2471       return TREE_CONSTANT (TREE_OPERAND (arg, 0));
2472 #endif
2473
2474     case ARRAY_REF:
2475       if (TREE_CODE (TYPE_SIZE (TREE_TYPE (arg))) == INTEGER_CST
2476           && TREE_CODE (TREE_OPERAND (arg, 1)) == INTEGER_CST)
2477         return staticp (TREE_OPERAND (arg, 0));
2478
2479     default:
2480       return 0;
2481     }
2482 }
2483 \f
2484 /* Wrap a SAVE_EXPR around EXPR, if appropriate.
2485    Do this to any expression which may be used in more than one place,
2486    but must be evaluated only once.
2487
2488    Normally, expand_expr would reevaluate the expression each time.
2489    Calling save_expr produces something that is evaluated and recorded
2490    the first time expand_expr is called on it.  Subsequent calls to
2491    expand_expr just reuse the recorded value.
2492
2493    The call to expand_expr that generates code that actually computes
2494    the value is the first call *at compile time*.  Subsequent calls
2495    *at compile time* generate code to use the saved value.
2496    This produces correct result provided that *at run time* control
2497    always flows through the insns made by the first expand_expr
2498    before reaching the other places where the save_expr was evaluated.
2499    You, the caller of save_expr, must make sure this is so.
2500
2501    Constants, and certain read-only nodes, are returned with no
2502    SAVE_EXPR because that is safe.  Expressions containing placeholders
2503    are not touched; see tree.def for an explanation of what these
2504    are used for.  */
2505
2506 tree
2507 save_expr (expr)
2508      tree expr;
2509 {
2510   register tree t = fold (expr);
2511
2512   /* We don't care about whether this can be used as an lvalue in this
2513      context.  */
2514   while (TREE_CODE (t) == NON_LVALUE_EXPR)
2515     t = TREE_OPERAND (t, 0);
2516
2517   /* If the tree evaluates to a constant, then we don't want to hide that
2518      fact (i.e. this allows further folding, and direct checks for constants).
2519      However, a read-only object that has side effects cannot be bypassed.
2520      Since it is no problem to reevaluate literals, we just return the 
2521      literal node.  */
2522
2523   if (TREE_CONSTANT (t) || (TREE_READONLY (t) && ! TREE_SIDE_EFFECTS (t))
2524       || TREE_CODE (t) == SAVE_EXPR || TREE_CODE (t) == ERROR_MARK)
2525     return t;
2526
2527   /* If T contains a PLACEHOLDER_EXPR, we must evaluate it each time, since
2528      it means that the size or offset of some field of an object depends on
2529      the value within another field.
2530
2531      Note that it must not be the case that T contains both a PLACEHOLDER_EXPR
2532      and some variable since it would then need to be both evaluated once and
2533      evaluated more than once.  Front-ends must assure this case cannot
2534      happen by surrounding any such subexpressions in their own SAVE_EXPR
2535      and forcing evaluation at the proper time.  */
2536   if (contains_placeholder_p (t))
2537     return t;
2538
2539   t = build (SAVE_EXPR, TREE_TYPE (expr), t, current_function_decl, NULL_TREE);
2540
2541   /* This expression might be placed ahead of a jump to ensure that the
2542      value was computed on both sides of the jump.  So make sure it isn't
2543      eliminated as dead.  */
2544   TREE_SIDE_EFFECTS (t) = 1;
2545   return t;
2546 }
2547
2548 /* Arrange for an expression to be expanded multiple independent
2549    times.  This is useful for cleanup actions, as the backend can
2550    expand them multiple times in different places.  */
2551
2552 tree
2553 unsave_expr (expr)
2554      tree expr;
2555 {
2556   tree t;
2557
2558   /* If this is already protected, no sense in protecting it again.  */
2559   if (TREE_CODE (expr) == UNSAVE_EXPR)
2560     return expr;
2561
2562   t = build1 (UNSAVE_EXPR, TREE_TYPE (expr), expr);
2563   TREE_SIDE_EFFECTS (t) = TREE_SIDE_EFFECTS (expr);
2564   return t;
2565 }
2566
2567 /* Returns the index of the first non-tree operand for CODE, or the number
2568    of operands if all are trees.  */
2569
2570 int
2571 first_rtl_op (code)
2572      enum tree_code code;
2573 {
2574   switch (code)
2575     {
2576     case SAVE_EXPR:
2577       return 2;
2578     case GOTO_SUBROUTINE_EXPR:
2579     case RTL_EXPR:
2580       return 0;
2581     case CALL_EXPR:
2582       return 2;
2583     case WITH_CLEANUP_EXPR:
2584       /* Should be defined to be 2.  */
2585       return 1;
2586     case METHOD_CALL_EXPR:
2587       return 3;
2588     default:
2589       return TREE_CODE_LENGTH (code);
2590     }
2591 }
2592
2593 /* Perform any modifications to EXPR required when it is unsaved.  Does
2594    not recurse into EXPR's subtrees.  */
2595
2596 void
2597 unsave_expr_1 (expr)
2598      tree expr;
2599 {
2600   switch (TREE_CODE (expr))
2601     {
2602     case SAVE_EXPR:
2603       if (! SAVE_EXPR_PERSISTENT_P (expr))
2604         SAVE_EXPR_RTL (expr) = 0;
2605       break;
2606
2607     case TARGET_EXPR:
2608       /* Don't mess with a TARGET_EXPR that hasn't been expanded.
2609          It's OK for this to happen if it was part of a subtree that
2610          isn't immediately expanded, such as operand 2 of another
2611          TARGET_EXPR.  */
2612       if (TREE_OPERAND (expr, 1))
2613         break;
2614
2615       TREE_OPERAND (expr, 1) = TREE_OPERAND (expr, 3);
2616       TREE_OPERAND (expr, 3) = NULL_TREE;
2617       break;
2618       
2619     case RTL_EXPR:
2620       /* I don't yet know how to emit a sequence multiple times.  */
2621       if (RTL_EXPR_SEQUENCE (expr) != 0)
2622         abort ();
2623       break;
2624
2625     case CALL_EXPR:
2626       CALL_EXPR_RTL (expr) = 0;
2627       break;
2628
2629     default:
2630       if (lang_unsave_expr_now != 0)
2631         (*lang_unsave_expr_now) (expr);
2632       break;
2633     }
2634 }
2635
2636 /* Helper function for unsave_expr_now.  */
2637
2638 static void
2639 unsave_expr_now_r (expr)
2640      tree expr;
2641 {
2642   enum tree_code code;
2643
2644   /* There's nothing to do for NULL_TREE.  */
2645   if (expr == 0)
2646     return;
2647
2648   unsave_expr_1 (expr);
2649
2650   code = TREE_CODE (expr);
2651   switch (TREE_CODE_CLASS (code))
2652     {
2653     case 'c':  /* a constant */
2654     case 't':  /* a type node */
2655     case 'd':  /* A decl node */
2656     case 'b':  /* A block node */
2657       break;
2658
2659     case 'x':  /* miscellaneous: e.g., identifier, TREE_LIST or ERROR_MARK.  */
2660       if (code == TREE_LIST)
2661         {
2662           unsave_expr_now_r (TREE_VALUE (expr));
2663           unsave_expr_now_r (TREE_CHAIN (expr));
2664         }
2665       break;
2666
2667     case 'e':  /* an expression */
2668     case 'r':  /* a reference */
2669     case 's':  /* an expression with side effects */
2670     case '<':  /* a comparison expression */
2671     case '2':  /* a binary arithmetic expression */
2672     case '1':  /* a unary arithmetic expression */
2673       {
2674         int i;
2675         
2676         for (i = first_rtl_op (code) - 1; i >= 0; i--)
2677           unsave_expr_now_r (TREE_OPERAND (expr, i));
2678       }
2679       break;
2680
2681     default:
2682       abort ();
2683     }
2684 }
2685
2686 /* Modify a tree in place so that all the evaluate only once things
2687    are cleared out.  Return the EXPR given.  */
2688
2689 tree
2690 unsave_expr_now (expr)
2691      tree expr;
2692 {
2693   if (lang_unsave!= 0)
2694     (*lang_unsave) (&expr);
2695   else
2696     unsave_expr_now_r (expr);
2697
2698   return expr;
2699 }
2700
2701 /* Return 0 if it is safe to evaluate EXPR multiple times,
2702    return 1 if it is safe if EXPR is unsaved afterward, or
2703    return 2 if it is completely unsafe. 
2704
2705    This assumes that CALL_EXPRs and TARGET_EXPRs are never replicated in
2706    an expression tree, so that it safe to unsave them and the surrounding
2707    context will be correct.
2708
2709    SAVE_EXPRs basically *only* appear replicated in an expression tree,
2710    occasionally across the whole of a function.  It is therefore only
2711    safe to unsave a SAVE_EXPR if you know that all occurrences appear
2712    below the UNSAVE_EXPR.
2713
2714    RTL_EXPRs consume their rtl during evaluation.  It is therefore 
2715    never possible to unsave them.  */
2716
2717 int
2718 unsafe_for_reeval (expr)
2719      tree expr;
2720 {
2721   int unsafeness = 0;
2722   enum tree_code code;
2723   int i, tmp;
2724   tree exp;
2725   int first_rtl;
2726
2727   if (expr == NULL_TREE)
2728     return 1;
2729
2730   code = TREE_CODE (expr);
2731   first_rtl = first_rtl_op (code);
2732
2733   switch (code)
2734     {
2735     case SAVE_EXPR:
2736     case RTL_EXPR:
2737       return 2;
2738
2739     case TREE_LIST:
2740       for (exp = expr; exp != 0; exp = TREE_CHAIN (exp))
2741         {
2742           tmp = unsafe_for_reeval (TREE_VALUE (exp));
2743           unsafeness = MAX (tmp, unsafeness);
2744         }
2745
2746       return unsafeness;
2747
2748     case CALL_EXPR:
2749       tmp = unsafe_for_reeval (TREE_OPERAND (expr, 1));
2750       return MAX (tmp, 1);
2751
2752     case TARGET_EXPR:
2753       unsafeness = 1;
2754       break;
2755
2756     default:
2757       /* ??? Add a lang hook if it becomes necessary.  */
2758       break;
2759     }
2760
2761   switch (TREE_CODE_CLASS (code))
2762     {
2763     case 'c':  /* a constant */
2764     case 't':  /* a type node */
2765     case 'x':  /* something random, like an identifier or an ERROR_MARK.  */
2766     case 'd':  /* A decl node */
2767     case 'b':  /* A block node */
2768       return 0;
2769
2770     case 'e':  /* an expression */
2771     case 'r':  /* a reference */
2772     case 's':  /* an expression with side effects */
2773     case '<':  /* a comparison expression */
2774     case '2':  /* a binary arithmetic expression */
2775     case '1':  /* a unary arithmetic expression */
2776       for (i = first_rtl - 1; i >= 0; i--)
2777         {
2778           tmp = unsafe_for_reeval (TREE_OPERAND (expr, i));
2779           unsafeness = MAX (tmp, unsafeness);
2780         }
2781
2782       return unsafeness;
2783
2784     default:
2785       return 2;
2786     }
2787 }
2788 \f
2789 /* Return 1 if EXP contains a PLACEHOLDER_EXPR; i.e., if it represents a size
2790    or offset that depends on a field within a record.  */
2791
2792 int
2793 contains_placeholder_p (exp)
2794      tree exp;
2795 {
2796   register enum tree_code code = TREE_CODE (exp);
2797   int result;
2798
2799   /* If we have a WITH_RECORD_EXPR, it "cancels" any PLACEHOLDER_EXPR
2800      in it since it is supplying a value for it.  */
2801   if (code == WITH_RECORD_EXPR)
2802     return 0;
2803   else if (code == PLACEHOLDER_EXPR)
2804     return 1;
2805
2806   switch (TREE_CODE_CLASS (code))
2807     {
2808     case 'r':
2809       /* Don't look at any PLACEHOLDER_EXPRs that might be in index or bit
2810          position computations since they will be converted into a
2811          WITH_RECORD_EXPR involving the reference, which will assume
2812          here will be valid.  */
2813       return contains_placeholder_p (TREE_OPERAND (exp, 0));
2814
2815     case 'x':
2816       if (code == TREE_LIST)
2817         return (contains_placeholder_p (TREE_VALUE (exp))
2818                 || (TREE_CHAIN (exp) != 0
2819                     && contains_placeholder_p (TREE_CHAIN (exp))));
2820       break;
2821                                         
2822     case '1':
2823     case '2':  case '<':
2824     case 'e':
2825       switch (code)
2826         {
2827         case COMPOUND_EXPR:
2828           /* Ignoring the first operand isn't quite right, but works best. */
2829           return contains_placeholder_p (TREE_OPERAND (exp, 1));
2830
2831         case RTL_EXPR:
2832         case CONSTRUCTOR:
2833           return 0;
2834
2835         case COND_EXPR:
2836           return (contains_placeholder_p (TREE_OPERAND (exp, 0))
2837                   || contains_placeholder_p (TREE_OPERAND (exp, 1))
2838                   || contains_placeholder_p (TREE_OPERAND (exp, 2)));
2839
2840         case SAVE_EXPR:
2841           /* If we already know this doesn't have a placeholder, don't
2842              check again.  */
2843           if (SAVE_EXPR_NOPLACEHOLDER (exp) || SAVE_EXPR_RTL (exp) != 0)
2844             return 0;
2845
2846           SAVE_EXPR_NOPLACEHOLDER (exp) = 1;
2847           result = contains_placeholder_p (TREE_OPERAND (exp, 0));
2848           if (result)
2849             SAVE_EXPR_NOPLACEHOLDER (exp) = 0;
2850
2851           return result;
2852
2853         case CALL_EXPR:
2854           return (TREE_OPERAND (exp, 1) != 0
2855                   && contains_placeholder_p (TREE_OPERAND (exp, 1)));
2856
2857         default:
2858           break;
2859         }
2860
2861       switch (TREE_CODE_LENGTH (code))
2862         {
2863         case 1:
2864           return contains_placeholder_p (TREE_OPERAND (exp, 0));
2865         case 2:
2866           return (contains_placeholder_p (TREE_OPERAND (exp, 0))
2867                   || contains_placeholder_p (TREE_OPERAND (exp, 1)));
2868         default:
2869           return 0;
2870         }
2871
2872     default:
2873       return 0;
2874     }
2875   return 0;
2876 }
2877
2878 /* Return 1 if EXP contains any expressions that produce cleanups for an
2879    outer scope to deal with.  Used by fold.  */
2880
2881 int
2882 has_cleanups (exp)
2883      tree exp;
2884 {
2885   int i, nops, cmp;
2886
2887   if (! TREE_SIDE_EFFECTS (exp))
2888     return 0;
2889
2890   switch (TREE_CODE (exp))
2891     {
2892     case TARGET_EXPR:
2893     case GOTO_SUBROUTINE_EXPR:
2894     case WITH_CLEANUP_EXPR:
2895       return 1;
2896
2897     case CLEANUP_POINT_EXPR:
2898       return 0;
2899
2900     case CALL_EXPR:
2901       for (exp = TREE_OPERAND (exp, 1); exp; exp = TREE_CHAIN (exp))
2902         {
2903           cmp = has_cleanups (TREE_VALUE (exp));
2904           if (cmp)
2905             return cmp;
2906         }
2907       return 0;
2908
2909     default:
2910       break;
2911     }
2912
2913   /* This general rule works for most tree codes.  All exceptions should be
2914      handled above.  If this is a language-specific tree code, we can't
2915      trust what might be in the operand, so say we don't know
2916      the situation.  */
2917   if ((int) TREE_CODE (exp) >= (int) LAST_AND_UNUSED_TREE_CODE)
2918     return -1;
2919
2920   nops = first_rtl_op (TREE_CODE (exp));
2921   for (i = 0; i < nops; i++)
2922     if (TREE_OPERAND (exp, i) != 0)
2923       {
2924         int type = TREE_CODE_CLASS (TREE_CODE (TREE_OPERAND (exp, i)));
2925         if (type == 'e' || type == '<' || type == '1' || type == '2'
2926             || type == 'r' || type == 's')
2927           {
2928             cmp = has_cleanups (TREE_OPERAND (exp, i));
2929             if (cmp)
2930               return cmp;
2931           }
2932       }
2933
2934   return 0;
2935 }
2936 \f
2937 /* Given a tree EXP, a FIELD_DECL F, and a replacement value R,
2938    return a tree with all occurrences of references to F in a
2939    PLACEHOLDER_EXPR replaced by R.   Note that we assume here that EXP
2940    contains only arithmetic expressions or a CALL_EXPR with a
2941    PLACEHOLDER_EXPR occurring only in its arglist.  */
2942
2943 tree
2944 substitute_in_expr (exp, f, r)
2945      tree exp;
2946      tree f;
2947      tree r;
2948 {
2949   enum tree_code code = TREE_CODE (exp);
2950   tree op0, op1, op2;
2951   tree new;
2952   tree inner;
2953
2954   switch (TREE_CODE_CLASS (code))
2955     {
2956     case 'c':
2957     case 'd':
2958       return exp;
2959
2960     case 'x':
2961       if (code == PLACEHOLDER_EXPR)
2962         return exp;
2963       else if (code == TREE_LIST)
2964         {
2965           op0 = (TREE_CHAIN (exp) == 0
2966                  ? 0 : substitute_in_expr (TREE_CHAIN (exp), f, r));
2967           op1 = substitute_in_expr (TREE_VALUE (exp), f, r);
2968           if (op0 == TREE_CHAIN (exp) && op1 == TREE_VALUE (exp))
2969             return exp;
2970
2971           return tree_cons (TREE_PURPOSE (exp), op1, op0);
2972         }
2973
2974       abort ();
2975
2976     case '1':
2977     case '2':
2978     case '<':
2979     case 'e':
2980       switch (TREE_CODE_LENGTH (code))
2981         {
2982         case 1:
2983           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2984           if (op0 == TREE_OPERAND (exp, 0))
2985             return exp;
2986           
2987           new = fold (build1 (code, TREE_TYPE (exp), op0));
2988           break;
2989
2990         case 2:
2991           /* An RTL_EXPR cannot contain a PLACEHOLDER_EXPR; a CONSTRUCTOR
2992              could, but we don't support it.  */
2993           if (code == RTL_EXPR)
2994             return exp;
2995           else if (code == CONSTRUCTOR)
2996             abort ();
2997
2998           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2999           op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
3000           if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1))
3001             return exp;
3002
3003           new = fold (build (code, TREE_TYPE (exp), op0, op1));
3004           break;
3005
3006         case 3:
3007           /* It cannot be that anything inside a SAVE_EXPR contains a
3008              PLACEHOLDER_EXPR.  */
3009           if (code == SAVE_EXPR)
3010             return exp;
3011
3012           else if (code == CALL_EXPR)
3013             {
3014               op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
3015               if (op1 == TREE_OPERAND (exp, 1))
3016                 return exp;
3017
3018               return build (code, TREE_TYPE (exp),
3019                             TREE_OPERAND (exp, 0), op1, NULL_TREE);
3020             }
3021
3022           else if (code != COND_EXPR)
3023             abort ();
3024
3025           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
3026           op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
3027           op2 = substitute_in_expr (TREE_OPERAND (exp, 2), f, r);
3028           if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1)
3029               && op2 == TREE_OPERAND (exp, 2))
3030             return exp;
3031
3032           new = fold (build (code, TREE_TYPE (exp), op0, op1, op2));
3033           break;
3034
3035         default:
3036           abort ();
3037         }
3038
3039       break;
3040
3041     case 'r':
3042       switch (code)
3043         {
3044         case COMPONENT_REF:
3045           /* If this expression is getting a value from a PLACEHOLDER_EXPR
3046              and it is the right field, replace it with R.  */
3047           for (inner = TREE_OPERAND (exp, 0);
3048                TREE_CODE_CLASS (TREE_CODE (inner)) == 'r';
3049                inner = TREE_OPERAND (inner, 0))
3050             ;
3051           if (TREE_CODE (inner) == PLACEHOLDER_EXPR
3052               && TREE_OPERAND (exp, 1) == f)
3053             return r;
3054
3055           /* If this expression hasn't been completed let, leave it 
3056              alone.  */
3057           if (TREE_CODE (inner) == PLACEHOLDER_EXPR
3058               && TREE_TYPE (inner) == 0)
3059             return exp;
3060
3061           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
3062           if (op0 == TREE_OPERAND (exp, 0))
3063             return exp;
3064
3065           new = fold (build (code, TREE_TYPE (exp), op0,
3066                              TREE_OPERAND (exp, 1)));
3067           break;
3068
3069         case BIT_FIELD_REF:
3070           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
3071           op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
3072           op2 = substitute_in_expr (TREE_OPERAND (exp, 2), f, r);
3073           if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1)
3074               && op2 == TREE_OPERAND (exp, 2))
3075             return exp;
3076
3077           new = fold (build (code, TREE_TYPE (exp), op0, op1, op2));
3078           break;
3079
3080         case INDIRECT_REF:
3081         case BUFFER_REF:
3082           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
3083           if (op0 == TREE_OPERAND (exp, 0))
3084             return exp;
3085
3086           new = fold (build1 (code, TREE_TYPE (exp), op0));
3087           break;
3088
3089         default:
3090           abort ();
3091         }
3092       break;
3093       
3094     default:
3095       abort ();
3096     }
3097
3098   TREE_READONLY (new) = TREE_READONLY (exp);
3099   return new;
3100 }
3101 \f
3102 /* Stabilize a reference so that we can use it any number of times
3103    without causing its operands to be evaluated more than once.
3104    Returns the stabilized reference.  This works by means of save_expr,
3105    so see the caveats in the comments about save_expr.
3106
3107    Also allows conversion expressions whose operands are references.
3108    Any other kind of expression is returned unchanged.  */
3109
3110 tree
3111 stabilize_reference (ref)
3112      tree ref;
3113 {
3114   register tree result;
3115   register enum tree_code code = TREE_CODE (ref);
3116
3117   switch (code)
3118     {
3119     case VAR_DECL:
3120     case PARM_DECL:
3121     case RESULT_DECL:
3122       /* No action is needed in this case.  */
3123       return ref;
3124
3125     case NOP_EXPR:
3126     case CONVERT_EXPR:
3127     case FLOAT_EXPR:
3128     case FIX_TRUNC_EXPR:
3129     case FIX_FLOOR_EXPR:
3130     case FIX_ROUND_EXPR:
3131     case FIX_CEIL_EXPR:
3132       result = build_nt (code, stabilize_reference (TREE_OPERAND (ref, 0)));
3133       break;
3134
3135     case INDIRECT_REF:
3136       result = build_nt (INDIRECT_REF,
3137                          stabilize_reference_1 (TREE_OPERAND (ref, 0)));
3138       break;
3139
3140     case COMPONENT_REF:
3141       result = build_nt (COMPONENT_REF,
3142                          stabilize_reference (TREE_OPERAND (ref, 0)),
3143                          TREE_OPERAND (ref, 1));
3144       break;
3145
3146     case BIT_FIELD_REF:
3147       result = build_nt (BIT_FIELD_REF,
3148                          stabilize_reference (TREE_OPERAND (ref, 0)),
3149                          stabilize_reference_1 (TREE_OPERAND (ref, 1)),
3150                          stabilize_reference_1 (TREE_OPERAND (ref, 2)));
3151       break;
3152
3153     case ARRAY_REF:
3154       result = build_nt (ARRAY_REF,
3155                          stabilize_reference (TREE_OPERAND (ref, 0)),
3156                          stabilize_reference_1 (TREE_OPERAND (ref, 1)));
3157       break;
3158
3159     case COMPOUND_EXPR:
3160       /* We cannot wrap the first expression in a SAVE_EXPR, as then
3161          it wouldn't be ignored.  This matters when dealing with
3162          volatiles.  */
3163       return stabilize_reference_1 (ref);
3164
3165     case RTL_EXPR:
3166       result = build1 (INDIRECT_REF, TREE_TYPE (ref),
3167                        save_expr (build1 (ADDR_EXPR,
3168                                           build_pointer_type (TREE_TYPE (ref)),
3169                                           ref)));
3170       break;
3171
3172
3173       /* If arg isn't a kind of lvalue we recognize, make no change.
3174          Caller should recognize the error for an invalid lvalue.  */
3175     default:
3176       return ref;
3177
3178     case ERROR_MARK:
3179       return error_mark_node;
3180     }
3181
3182   TREE_TYPE (result) = TREE_TYPE (ref);
3183   TREE_READONLY (result) = TREE_READONLY (ref);
3184   TREE_SIDE_EFFECTS (result) = TREE_SIDE_EFFECTS (ref);
3185   TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
3186
3187   return result;
3188 }
3189
3190 /* Subroutine of stabilize_reference; this is called for subtrees of
3191    references.  Any expression with side-effects must be put in a SAVE_EXPR
3192    to ensure that it is only evaluated once.
3193
3194    We don't put SAVE_EXPR nodes around everything, because assigning very
3195    simple expressions to temporaries causes us to miss good opportunities
3196    for optimizations.  Among other things, the opportunity to fold in the
3197    addition of a constant into an addressing mode often gets lost, e.g.
3198    "y[i+1] += x;".  In general, we take the approach that we should not make
3199    an assignment unless we are forced into it - i.e., that any non-side effect
3200    operator should be allowed, and that cse should take care of coalescing
3201    multiple utterances of the same expression should that prove fruitful.  */
3202
3203 tree
3204 stabilize_reference_1 (e)
3205      tree e;
3206 {
3207   register tree result;
3208   register enum tree_code code = TREE_CODE (e);
3209
3210   /* We cannot ignore const expressions because it might be a reference
3211      to a const array but whose index contains side-effects.  But we can
3212      ignore things that are actual constant or that already have been
3213      handled by this function.  */
3214
3215   if (TREE_CONSTANT (e) || code == SAVE_EXPR)
3216     return e;
3217
3218   switch (TREE_CODE_CLASS (code))
3219     {
3220     case 'x':
3221     case 't':
3222     case 'd':
3223     case 'b':
3224     case '<':
3225     case 's':
3226     case 'e':
3227     case 'r':
3228       /* If the expression has side-effects, then encase it in a SAVE_EXPR
3229          so that it will only be evaluated once.  */
3230       /* The reference (r) and comparison (<) classes could be handled as
3231          below, but it is generally faster to only evaluate them once.  */
3232       if (TREE_SIDE_EFFECTS (e))
3233         return save_expr (e);
3234       return e;
3235
3236     case 'c':
3237       /* Constants need no processing.  In fact, we should never reach
3238          here.  */
3239       return e;
3240       
3241     case '2':
3242       /* Division is slow and tends to be compiled with jumps,
3243          especially the division by powers of 2 that is often
3244          found inside of an array reference.  So do it just once.  */
3245       if (code == TRUNC_DIV_EXPR || code == TRUNC_MOD_EXPR
3246           || code == FLOOR_DIV_EXPR || code == FLOOR_MOD_EXPR
3247           || code == CEIL_DIV_EXPR || code == CEIL_MOD_EXPR
3248           || code == ROUND_DIV_EXPR || code == ROUND_MOD_EXPR)
3249         return save_expr (e);
3250       /* Recursively stabilize each operand.  */
3251       result = build_nt (code, stabilize_reference_1 (TREE_OPERAND (e, 0)),
3252                          stabilize_reference_1 (TREE_OPERAND (e, 1)));
3253       break;
3254
3255     case '1':
3256       /* Recursively stabilize each operand.  */
3257       result = build_nt (code, stabilize_reference_1 (TREE_OPERAND (e, 0)));
3258       break;
3259
3260     default:
3261       abort ();
3262     }
3263   
3264   TREE_TYPE (result) = TREE_TYPE (e);
3265   TREE_READONLY (result) = TREE_READONLY (e);
3266   TREE_SIDE_EFFECTS (result) = TREE_SIDE_EFFECTS (e);
3267   TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
3268
3269   return result;
3270 }
3271 \f
3272 /* Low-level constructors for expressions.  */
3273
3274 /* Build an expression of code CODE, data type TYPE,
3275    and operands as specified by the arguments ARG1 and following arguments.
3276    Expressions and reference nodes can be created this way.
3277    Constants, decls, types and misc nodes cannot be.  */
3278
3279 tree
3280 build VPARAMS ((enum tree_code code, tree tt, ...))
3281 {
3282 #ifndef ANSI_PROTOTYPES
3283   enum tree_code code;
3284   tree tt;
3285 #endif
3286   va_list p;
3287   register tree t;
3288   register int length;
3289   register int i;
3290   int fro;
3291
3292   VA_START (p, tt);
3293
3294 #ifndef ANSI_PROTOTYPES
3295   code = va_arg (p, enum tree_code);
3296   tt = va_arg (p, tree);
3297 #endif
3298
3299   t = make_node (code);
3300   length = TREE_CODE_LENGTH (code);
3301   TREE_TYPE (t) = tt;
3302
3303   /* Below, we automatically set TREE_SIDE_EFFECTS and TREE_RAISED for
3304      the result based on those same flags for the arguments.  But, if
3305      the arguments aren't really even `tree' expressions, we shouldn't
3306      be trying to do this.  */
3307   fro = first_rtl_op (code);
3308
3309   if (length == 2)
3310     {
3311       /* This is equivalent to the loop below, but faster.  */
3312       register tree arg0 = va_arg (p, tree);
3313       register tree arg1 = va_arg (p, tree);
3314       TREE_OPERAND (t, 0) = arg0;
3315       TREE_OPERAND (t, 1) = arg1;
3316       if (arg0 && fro > 0)
3317         {
3318           if (TREE_SIDE_EFFECTS (arg0))
3319             TREE_SIDE_EFFECTS (t) = 1;
3320         }
3321       if (arg1 && fro > 1)
3322         {
3323           if (TREE_SIDE_EFFECTS (arg1))
3324             TREE_SIDE_EFFECTS (t) = 1;
3325         }
3326     }
3327   else if (length == 1)
3328     {
3329       register tree arg0 = va_arg (p, tree);
3330
3331       /* Call build1 for this!  */
3332       if (TREE_CODE_CLASS (code) != 's')
3333         abort ();
3334       TREE_OPERAND (t, 0) = arg0;
3335       if (fro > 0)
3336         {
3337           if (arg0 && TREE_SIDE_EFFECTS (arg0))
3338             TREE_SIDE_EFFECTS (t) = 1;
3339         }
3340     }
3341   else
3342     {
3343       for (i = 0; i < length; i++)
3344         {
3345           register tree operand = va_arg (p, tree);
3346           TREE_OPERAND (t, i) = operand;
3347           if (operand && fro > i)
3348             {
3349               if (TREE_SIDE_EFFECTS (operand))
3350                 TREE_SIDE_EFFECTS (t) = 1;
3351             }
3352         }
3353     }
3354   va_end (p);
3355   return t;
3356 }
3357
3358 /* Same as above, but only builds for unary operators.
3359    Saves lions share of calls to `build'; cuts down use
3360    of varargs, which is expensive for RISC machines.  */
3361
3362 tree
3363 build1 (code, type, node)
3364      enum tree_code code;
3365      tree type;
3366      tree node;
3367 {
3368   register struct obstack *obstack = expression_obstack;
3369   register int length;
3370 #ifdef GATHER_STATISTICS
3371   register tree_node_kind kind;
3372 #endif
3373   register tree t;
3374
3375 #ifdef GATHER_STATISTICS
3376   if (TREE_CODE_CLASS (code) == 'r')
3377     kind = r_kind;
3378   else
3379     kind = e_kind;
3380 #endif
3381
3382   length = sizeof (struct tree_exp);
3383
3384   if (ggc_p)
3385     t = ggc_alloc_tree (length);
3386   else
3387     {
3388       t = (tree) obstack_alloc (obstack, length);
3389       memset ((PTR) t, 0, length);
3390     }
3391
3392 #ifdef GATHER_STATISTICS
3393   tree_node_counts[(int)kind]++;
3394   tree_node_sizes[(int)kind] += length;
3395 #endif
3396
3397   TREE_TYPE (t) = type;
3398   TREE_SET_CODE (t, code);
3399   TREE_SET_PERMANENT (t);
3400
3401   TREE_OPERAND (t, 0) = node;
3402   if (node && first_rtl_op (code) != 0 && TREE_SIDE_EFFECTS (node))
3403     TREE_SIDE_EFFECTS (t) = 1;
3404
3405   switch (code)
3406     {
3407     case INIT_EXPR:
3408     case MODIFY_EXPR:
3409     case VA_ARG_EXPR:
3410     case RTL_EXPR:
3411     case PREDECREMENT_EXPR:
3412     case PREINCREMENT_EXPR:
3413     case POSTDECREMENT_EXPR:
3414     case POSTINCREMENT_EXPR:
3415       /* All of these have side-effects, no matter what their
3416          operands are.  */
3417       TREE_SIDE_EFFECTS (t) = 1;
3418       break;
3419           
3420     default:
3421       break;
3422     }
3423
3424   return t;
3425 }
3426
3427 /* Similar except don't specify the TREE_TYPE
3428    and leave the TREE_SIDE_EFFECTS as 0.
3429    It is permissible for arguments to be null,
3430    or even garbage if their values do not matter.  */
3431
3432 tree
3433 build_nt VPARAMS ((enum tree_code code, ...))
3434 {
3435 #ifndef ANSI_PROTOTYPES
3436   enum tree_code code;
3437 #endif
3438   va_list p;
3439   register tree t;
3440   register int length;
3441   register int i;
3442
3443   VA_START (p, code);
3444
3445 #ifndef ANSI_PROTOTYPES
3446   code = va_arg (p, enum tree_code);
3447 #endif
3448
3449   t = make_node (code);
3450   length = TREE_CODE_LENGTH (code);
3451
3452   for (i = 0; i < length; i++)
3453     TREE_OPERAND (t, i) = va_arg (p, tree);
3454
3455   va_end (p);
3456   return t;
3457 }
3458
3459 /* Similar to `build_nt', except we build
3460    on the temp_decl_obstack, regardless.  */
3461
3462 tree
3463 build_parse_node VPARAMS ((enum tree_code code, ...))
3464 {
3465 #ifndef ANSI_PROTOTYPES
3466   enum tree_code code;
3467 #endif
3468   register struct obstack *ambient_obstack = expression_obstack;
3469   va_list p;
3470   register tree t;
3471   register int length;
3472   register int i;
3473
3474   VA_START (p, code);
3475
3476 #ifndef ANSI_PROTOTYPES
3477   code = va_arg (p, enum tree_code);
3478 #endif
3479
3480   expression_obstack = &temp_decl_obstack;
3481
3482   t = make_node (code);
3483   length = TREE_CODE_LENGTH (code);
3484
3485   for (i = 0; i < length; i++)
3486     TREE_OPERAND (t, i) = va_arg (p, tree);
3487
3488   va_end (p);
3489   expression_obstack = ambient_obstack;
3490   return t;
3491 }
3492
3493 #if 0
3494 /* Commented out because this wants to be done very
3495    differently.  See cp-lex.c.  */
3496 tree
3497 build_op_identifier (op1, op2)
3498      tree op1, op2;
3499 {
3500   register tree t = make_node (OP_IDENTIFIER);
3501   TREE_PURPOSE (t) = op1;
3502   TREE_VALUE (t) = op2;
3503   return t;
3504 }
3505 #endif
3506 \f
3507 /* Create a DECL_... node of code CODE, name NAME and data type TYPE.
3508    We do NOT enter this node in any sort of symbol table.
3509
3510    layout_decl is used to set up the decl's storage layout.
3511    Other slots are initialized to 0 or null pointers.  */
3512
3513 tree
3514 build_decl (code, name, type)
3515      enum tree_code code;
3516      tree name, type;
3517 {
3518   register tree t;
3519
3520   t = make_node (code);
3521
3522 /*  if (type == error_mark_node)
3523     type = integer_type_node; */
3524 /* That is not done, deliberately, so that having error_mark_node
3525    as the type can suppress useless errors in the use of this variable.  */
3526
3527   DECL_NAME (t) = name;
3528   DECL_ASSEMBLER_NAME (t) = name;
3529   TREE_TYPE (t) = type;
3530
3531   if (code == VAR_DECL || code == PARM_DECL || code == RESULT_DECL)
3532     layout_decl (t, 0);
3533   else if (code == FUNCTION_DECL)
3534     DECL_MODE (t) = FUNCTION_MODE;
3535
3536   return t;
3537 }
3538 \f
3539 /* BLOCK nodes are used to represent the structure of binding contours
3540    and declarations, once those contours have been exited and their contents
3541    compiled.  This information is used for outputting debugging info.  */
3542
3543 tree
3544 build_block (vars, tags, subblocks, supercontext, chain)
3545      tree vars, tags ATTRIBUTE_UNUSED, subblocks, supercontext, chain;
3546 {
3547   register tree block = make_node (BLOCK);
3548
3549   BLOCK_VARS (block) = vars;
3550   BLOCK_SUBBLOCKS (block) = subblocks;
3551   BLOCK_SUPERCONTEXT (block) = supercontext;
3552   BLOCK_CHAIN (block) = chain;
3553   return block;
3554 }
3555
3556 /* EXPR_WITH_FILE_LOCATION are used to keep track of the exact
3557    location where an expression or an identifier were encountered. It
3558    is necessary for languages where the frontend parser will handle
3559    recursively more than one file (Java is one of them).  */
3560
3561 tree
3562 build_expr_wfl (node, file, line, col)
3563      tree node;
3564      const char *file;
3565      int line, col;
3566 {
3567   static const char *last_file = 0;
3568   static tree last_filenode = NULL_TREE;
3569   register tree wfl = make_node (EXPR_WITH_FILE_LOCATION);
3570
3571   EXPR_WFL_NODE (wfl) = node;
3572   EXPR_WFL_SET_LINECOL (wfl, line, col);
3573   if (file != last_file)
3574     {
3575       last_file = file;
3576       last_filenode = file ? get_identifier (file) : NULL_TREE;
3577     }
3578
3579   EXPR_WFL_FILENAME_NODE (wfl) = last_filenode;
3580   if (node)
3581     {
3582       TREE_SIDE_EFFECTS (wfl) = TREE_SIDE_EFFECTS (node);
3583       TREE_TYPE (wfl) = TREE_TYPE (node);
3584     }
3585
3586   return wfl;
3587 }
3588 \f
3589 /* Return a declaration like DDECL except that its DECL_MACHINE_ATTRIBUTE
3590    is ATTRIBUTE.  */
3591
3592 tree
3593 build_decl_attribute_variant (ddecl, attribute)
3594      tree ddecl, attribute;
3595 {
3596   DECL_MACHINE_ATTRIBUTES (ddecl) = attribute;
3597   return ddecl;
3598 }
3599
3600 /* Return a type like TTYPE except that its TYPE_ATTRIBUTE
3601    is ATTRIBUTE.
3602
3603    Record such modified types already made so we don't make duplicates.  */
3604
3605 tree
3606 build_type_attribute_variant (ttype, attribute)
3607      tree ttype, attribute;
3608 {
3609   if ( ! attribute_list_equal (TYPE_ATTRIBUTES (ttype), attribute))
3610     {
3611       unsigned int hashcode;
3612       tree ntype;
3613
3614       push_obstacks (TYPE_OBSTACK (ttype), TYPE_OBSTACK (ttype));
3615       ntype = copy_node (ttype);
3616
3617       TYPE_POINTER_TO (ntype) = 0;
3618       TYPE_REFERENCE_TO (ntype) = 0;
3619       TYPE_ATTRIBUTES (ntype) = attribute;
3620
3621       /* Create a new main variant of TYPE.  */
3622       TYPE_MAIN_VARIANT (ntype) = ntype;
3623       TYPE_NEXT_VARIANT (ntype) = 0;
3624       set_type_quals (ntype, TYPE_UNQUALIFIED);
3625
3626       hashcode = (TYPE_HASH (TREE_CODE (ntype))
3627                   + TYPE_HASH (TREE_TYPE (ntype))
3628                   + attribute_hash_list (attribute));
3629
3630       switch (TREE_CODE (ntype))
3631         {
3632         case FUNCTION_TYPE:
3633           hashcode += TYPE_HASH (TYPE_ARG_TYPES (ntype));
3634           break;
3635         case ARRAY_TYPE:
3636           hashcode += TYPE_HASH (TYPE_DOMAIN (ntype));
3637           break;
3638         case INTEGER_TYPE:
3639           hashcode += TYPE_HASH (TYPE_MAX_VALUE (ntype));
3640           break;
3641         case REAL_TYPE:
3642           hashcode += TYPE_HASH (TYPE_PRECISION (ntype));
3643           break;
3644         default:
3645           break;
3646         }
3647
3648       ntype = type_hash_canon (hashcode, ntype);
3649       ttype = build_qualified_type (ntype, TYPE_QUALS (ttype));
3650       pop_obstacks ();
3651     }
3652
3653   return ttype;
3654 }
3655
3656 /* Return a 1 if ATTR_NAME and ATTR_ARGS is valid for either declaration DECL
3657    or type TYPE and 0 otherwise.  Validity is determined the configuration
3658    macros VALID_MACHINE_DECL_ATTRIBUTE and VALID_MACHINE_TYPE_ATTRIBUTE.  */
3659
3660 int
3661 valid_machine_attribute (attr_name, attr_args, decl, type)
3662   tree attr_name;
3663   tree attr_args ATTRIBUTE_UNUSED;
3664   tree decl ATTRIBUTE_UNUSED;
3665   tree type ATTRIBUTE_UNUSED;
3666 {
3667   int validated = 0;
3668 #ifdef VALID_MACHINE_DECL_ATTRIBUTE
3669   tree decl_attr_list = decl != 0 ? DECL_MACHINE_ATTRIBUTES (decl) : 0;
3670 #endif
3671 #ifdef VALID_MACHINE_TYPE_ATTRIBUTE
3672   tree type_attr_list = TYPE_ATTRIBUTES (type);
3673 #endif
3674
3675   if (TREE_CODE (attr_name) != IDENTIFIER_NODE)
3676     abort ();
3677
3678 #ifdef VALID_MACHINE_DECL_ATTRIBUTE
3679   if (decl != 0
3680       && VALID_MACHINE_DECL_ATTRIBUTE (decl, decl_attr_list, attr_name,
3681                                        attr_args))
3682     {
3683       tree attr = lookup_attribute (IDENTIFIER_POINTER (attr_name),
3684                                     decl_attr_list);
3685
3686       if (attr != NULL_TREE)
3687         {
3688           /* Override existing arguments.  Declarations are unique so we can
3689              modify this in place.  */
3690           TREE_VALUE (attr) = attr_args;
3691         }
3692       else
3693         {
3694           decl_attr_list = tree_cons (attr_name, attr_args, decl_attr_list);
3695           decl = build_decl_attribute_variant (decl, decl_attr_list);
3696         }
3697
3698       validated = 1;
3699     }
3700 #endif
3701
3702 #ifdef VALID_MACHINE_TYPE_ATTRIBUTE
3703   if (validated)
3704     /* Don't apply the attribute to both the decl and the type.  */;
3705   else if (VALID_MACHINE_TYPE_ATTRIBUTE (type, type_attr_list, attr_name,
3706                                          attr_args))
3707     {
3708       tree attr = lookup_attribute (IDENTIFIER_POINTER (attr_name),
3709                                     type_attr_list);
3710
3711       if (attr != NULL_TREE)
3712         {
3713           /* Override existing arguments.
3714              ??? This currently works since attribute arguments are not
3715              included in `attribute_hash_list'.  Something more complicated
3716              may be needed in the future.  */
3717           TREE_VALUE (attr) = attr_args;
3718         }
3719       else
3720         {
3721           /* If this is part of a declaration, create a type variant,
3722              otherwise, this is part of a type definition, so add it 
3723              to the base type.  */
3724           type_attr_list = tree_cons (attr_name, attr_args, type_attr_list);
3725           if (decl != 0)
3726             type = build_type_attribute_variant (type, type_attr_list);
3727           else
3728             TYPE_ATTRIBUTES (type) = type_attr_list;
3729         }
3730
3731       if (decl != 0)
3732         TREE_TYPE (decl) = type;
3733
3734       validated = 1;
3735     }
3736
3737   /* Handle putting a type attribute on pointer-to-function-type by putting
3738      the attribute on the function type.  */
3739   else if (POINTER_TYPE_P (type)
3740            && TREE_CODE (TREE_TYPE (type)) == FUNCTION_TYPE
3741            && VALID_MACHINE_TYPE_ATTRIBUTE (TREE_TYPE (type), type_attr_list,
3742                                             attr_name, attr_args))
3743     {
3744       tree inner_type = TREE_TYPE (type);
3745       tree inner_attr_list = TYPE_ATTRIBUTES (inner_type);
3746       tree attr = lookup_attribute (IDENTIFIER_POINTER (attr_name),
3747                                     type_attr_list);
3748
3749       if (attr != NULL_TREE)
3750         TREE_VALUE (attr) = attr_args;
3751       else
3752         {
3753           inner_attr_list = tree_cons (attr_name, attr_args, inner_attr_list);
3754           inner_type = build_type_attribute_variant (inner_type,
3755                                                      inner_attr_list);
3756         }
3757
3758       if (decl != 0)
3759         TREE_TYPE (decl) = build_pointer_type (inner_type);
3760       else
3761         {
3762           /* Clear TYPE_POINTER_TO for the old inner type, since
3763              `type' won't be pointing to it anymore.  */
3764           TYPE_POINTER_TO (TREE_TYPE (type)) = NULL_TREE;
3765           TREE_TYPE (type) = inner_type;
3766         }
3767
3768       validated = 1;
3769     }
3770 #endif
3771
3772   return validated;
3773 }
3774
3775 /* Return non-zero if IDENT is a valid name for attribute ATTR,
3776    or zero if not.
3777
3778    We try both `text' and `__text__', ATTR may be either one.  */
3779 /* ??? It might be a reasonable simplification to require ATTR to be only
3780    `text'.  One might then also require attribute lists to be stored in
3781    their canonicalized form.  */
3782
3783 int
3784 is_attribute_p (attr, ident)
3785      const char *attr;
3786      tree ident;
3787 {
3788   int ident_len, attr_len;
3789   char *p;
3790
3791   if (TREE_CODE (ident) != IDENTIFIER_NODE)
3792     return 0;
3793
3794   if (strcmp (attr, IDENTIFIER_POINTER (ident)) == 0)
3795     return 1;
3796
3797   p = IDENTIFIER_POINTER (ident);
3798   ident_len = strlen (p);
3799   attr_len = strlen (attr);
3800
3801   /* If ATTR is `__text__', IDENT must be `text'; and vice versa.  */
3802   if (attr[0] == '_')
3803     {
3804       if (attr[1] != '_'
3805           || attr[attr_len - 2] != '_'
3806           || attr[attr_len - 1] != '_')
3807         abort ();
3808       if (ident_len == attr_len - 4
3809           && strncmp (attr + 2, p, attr_len - 4) == 0)
3810         return 1;
3811     }
3812   else
3813     {
3814       if (ident_len == attr_len + 4
3815           && p[0] == '_' && p[1] == '_'
3816           && p[ident_len - 2] == '_' && p[ident_len - 1] == '_'
3817           && strncmp (attr, p + 2, attr_len) == 0)
3818         return 1;
3819     }
3820
3821   return 0;
3822 }
3823
3824 /* Given an attribute name and a list of attributes, return a pointer to the
3825    attribute's list element if the attribute is part of the list, or NULL_TREE
3826    if not found.  */
3827
3828 tree
3829 lookup_attribute (attr_name, list)
3830      const char *attr_name;
3831      tree list;
3832 {
3833   tree l;
3834
3835   for (l = list; l; l = TREE_CHAIN (l))
3836     {
3837       if (TREE_CODE (TREE_PURPOSE (l)) != IDENTIFIER_NODE)
3838         abort ();
3839       if (is_attribute_p (attr_name, TREE_PURPOSE (l)))
3840         return l;
3841     }
3842
3843   return NULL_TREE;
3844 }
3845
3846 /* Return an attribute list that is the union of a1 and a2.  */
3847
3848 tree
3849 merge_attributes (a1, a2)
3850      register tree a1, a2;
3851 {
3852   tree attributes;
3853
3854   /* Either one unset?  Take the set one.  */
3855
3856   if ((attributes = a1) == 0)
3857     attributes = a2;
3858
3859   /* One that completely contains the other?  Take it.  */
3860
3861   else if (a2 != 0 && ! attribute_list_contained (a1, a2))
3862   {
3863     if (attribute_list_contained (a2, a1))
3864       attributes = a2;
3865     else
3866       {
3867         /* Pick the longest list, and hang on the other list.  */
3868         /* ??? For the moment we punt on the issue of attrs with args.  */
3869
3870         if (list_length (a1) < list_length (a2))
3871           attributes = a2, a2 = a1;
3872
3873         for (; a2 != 0; a2 = TREE_CHAIN (a2))
3874           if (lookup_attribute (IDENTIFIER_POINTER (TREE_PURPOSE (a2)),
3875                                 attributes) == NULL_TREE)
3876             {
3877               a1 = copy_node (a2);
3878               TREE_CHAIN (a1) = attributes;
3879               attributes = a1;
3880             }
3881       }
3882   }
3883   return attributes;
3884 }
3885
3886 /* Given types T1 and T2, merge their attributes and return
3887    the result.  */
3888
3889 tree
3890 merge_machine_type_attributes (t1, t2)
3891      tree t1, t2;
3892 {
3893 #ifdef MERGE_MACHINE_TYPE_ATTRIBUTES
3894   return MERGE_MACHINE_TYPE_ATTRIBUTES (t1, t2);
3895 #else
3896   return merge_attributes (TYPE_ATTRIBUTES (t1),
3897                            TYPE_ATTRIBUTES (t2));
3898 #endif
3899 }
3900
3901 /* Given decls OLDDECL and NEWDECL, merge their attributes and return
3902    the result.  */
3903
3904 tree
3905 merge_machine_decl_attributes (olddecl, newdecl)
3906      tree olddecl, newdecl;
3907 {
3908 #ifdef MERGE_MACHINE_DECL_ATTRIBUTES
3909   return MERGE_MACHINE_DECL_ATTRIBUTES (olddecl, newdecl);
3910 #else
3911   return merge_attributes (DECL_MACHINE_ATTRIBUTES (olddecl),
3912                            DECL_MACHINE_ATTRIBUTES (newdecl));
3913 #endif
3914 }
3915 \f
3916 /* Set the type qualifiers for TYPE to TYPE_QUALS, which is a bitmask
3917    of the various TYPE_QUAL values.  */
3918
3919 static void
3920 set_type_quals (type, type_quals)
3921      tree type;
3922      int  type_quals;
3923 {
3924   TYPE_READONLY (type) = (type_quals & TYPE_QUAL_CONST) != 0;
3925   TYPE_VOLATILE (type) = (type_quals & TYPE_QUAL_VOLATILE) != 0;
3926   TYPE_RESTRICT (type) = (type_quals & TYPE_QUAL_RESTRICT) != 0;
3927 }
3928
3929 /* Given a type node TYPE and a TYPE_QUALIFIER_SET, return a type for
3930    the same kind of data as TYPE describes.  Variants point to the
3931    "main variant" (which has no qualifiers set) via TYPE_MAIN_VARIANT,
3932    and it points to a chain of other variants so that duplicate
3933    variants are never made.  Only main variants should ever appear as
3934    types of expressions.  */
3935
3936 tree
3937 build_qualified_type (type, type_quals)
3938      tree type;
3939      int type_quals;
3940 {
3941   register tree t;
3942   
3943   /* Search the chain of variants to see if there is already one there just
3944      like the one we need to have.  If so, use that existing one.  We must
3945      preserve the TYPE_NAME, since there is code that depends on this.  */
3946
3947   for (t = TYPE_MAIN_VARIANT (type); t; t = TYPE_NEXT_VARIANT (t))
3948     if (TYPE_QUALS (t) == type_quals && TYPE_NAME (t) == TYPE_NAME (type))
3949       return t;
3950
3951   /* We need a new one.  */
3952   t = build_type_copy (type);
3953   set_type_quals (t, type_quals);
3954   return t;
3955 }
3956
3957 /* Create a new variant of TYPE, equivalent but distinct.
3958    This is so the caller can modify it.  */
3959
3960 tree
3961 build_type_copy (type)
3962      tree type;
3963 {
3964   register tree t, m = TYPE_MAIN_VARIANT (type);
3965   register struct obstack *ambient_obstack = current_obstack;
3966
3967   current_obstack = TYPE_OBSTACK (type);
3968   t = copy_node (type);
3969   current_obstack = ambient_obstack;
3970
3971   TYPE_POINTER_TO (t) = 0;
3972   TYPE_REFERENCE_TO (t) = 0;
3973
3974   /* Add this type to the chain of variants of TYPE.  */
3975   TYPE_NEXT_VARIANT (t) = TYPE_NEXT_VARIANT (m);
3976   TYPE_NEXT_VARIANT (m) = t;
3977
3978   return t;
3979 }
3980 \f
3981 /* Hashing of types so that we don't make duplicates.
3982    The entry point is `type_hash_canon'.  */
3983
3984 /* Compute a hash code for a list of types (chain of TREE_LIST nodes
3985    with types in the TREE_VALUE slots), by adding the hash codes
3986    of the individual types.  */
3987
3988 unsigned int
3989 type_hash_list (list)
3990      tree list;
3991 {
3992   unsigned int hashcode;
3993   register tree tail;
3994
3995   for (hashcode = 0, tail = list; tail; tail = TREE_CHAIN (tail))
3996     hashcode += TYPE_HASH (TREE_VALUE (tail));
3997
3998   return hashcode;
3999 }
4000
4001 /* These are the Hashtable callback functions.  */
4002
4003 /* Returns true if the types are equal.  */
4004
4005 static int
4006 type_hash_eq (va, vb)
4007      const void *va;
4008      const void *vb;
4009 {
4010   const struct type_hash *a = va, *b = vb;
4011   if (a->hash == b->hash
4012       && TREE_CODE (a->type) == TREE_CODE (b->type)
4013       && TREE_TYPE (a->type) == TREE_TYPE (b->type)
4014       && attribute_list_equal (TYPE_ATTRIBUTES (a->type),
4015                                TYPE_ATTRIBUTES (b->type))
4016       && TYPE_ALIGN (a->type) == TYPE_ALIGN (b->type)
4017       && (TYPE_MAX_VALUE (a->type) == TYPE_MAX_VALUE (b->type)
4018           || tree_int_cst_equal (TYPE_MAX_VALUE (a->type),
4019                                  TYPE_MAX_VALUE (b->type)))
4020       && (TYPE_MIN_VALUE (a->type) == TYPE_MIN_VALUE (b->type)
4021           || tree_int_cst_equal (TYPE_MIN_VALUE (a->type),
4022                                  TYPE_MIN_VALUE (b->type)))
4023       /* Note that TYPE_DOMAIN is TYPE_ARG_TYPES for FUNCTION_TYPE.  */
4024       && (TYPE_DOMAIN (a->type) == TYPE_DOMAIN (b->type)
4025           || (TYPE_DOMAIN (a->type)
4026               && TREE_CODE (TYPE_DOMAIN (a->type)) == TREE_LIST
4027               && TYPE_DOMAIN (b->type)
4028               && TREE_CODE (TYPE_DOMAIN (b->type)) == TREE_LIST
4029               && type_list_equal (TYPE_DOMAIN (a->type),
4030                                   TYPE_DOMAIN (b->type)))))
4031     return 1;
4032   return 0;
4033 }
4034
4035 /* Return the cached hash value.  */
4036
4037 static unsigned int
4038 type_hash_hash (item)
4039      const void *item;
4040 {
4041   return ((const struct type_hash*)item)->hash;
4042 }
4043
4044 /* Look in the type hash table for a type isomorphic to TYPE.
4045    If one is found, return it.  Otherwise return 0.  */
4046
4047 tree
4048 type_hash_lookup (hashcode, type)
4049      unsigned int hashcode;
4050      tree type;
4051 {
4052   struct type_hash *h, in;
4053
4054   /* The TYPE_ALIGN field of a type is set by layout_type(), so we
4055      must call that routine before comparing TYPE_ALIGNs. */
4056   layout_type (type);
4057
4058   in.hash = hashcode;
4059   in.type = type;
4060
4061   h = htab_find_with_hash (type_hash_table, &in, hashcode);
4062   if (h)
4063     return h->type;
4064   return NULL_TREE;
4065 }
4066
4067 /* Add an entry to the type-hash-table
4068    for a type TYPE whose hash code is HASHCODE.  */
4069
4070 void
4071 type_hash_add (hashcode, type)
4072      unsigned int hashcode;
4073      tree type;
4074 {
4075   struct type_hash *h;
4076   void **loc;
4077
4078   h = (struct type_hash *) permalloc (sizeof (struct type_hash));
4079   h->hash = hashcode;
4080   h->type = type;
4081   loc = htab_find_slot_with_hash (type_hash_table, h, hashcode, INSERT);
4082   *(struct type_hash**) loc = h;
4083 }
4084
4085 /* Given TYPE, and HASHCODE its hash code, return the canonical
4086    object for an identical type if one already exists.
4087    Otherwise, return TYPE, and record it as the canonical object
4088    if it is a permanent object.
4089
4090    To use this function, first create a type of the sort you want.
4091    Then compute its hash code from the fields of the type that
4092    make it different from other similar types.
4093    Then call this function and use the value.
4094    This function frees the type you pass in if it is a duplicate.  */
4095
4096 /* Set to 1 to debug without canonicalization.  Never set by program.  */
4097 int debug_no_type_hash = 0;
4098
4099 tree
4100 type_hash_canon (hashcode, type)
4101      unsigned int hashcode;
4102      tree type;
4103 {
4104   tree t1;
4105
4106   if (debug_no_type_hash)
4107     return type;
4108
4109   t1 = type_hash_lookup (hashcode, type);
4110   if (t1 != 0)
4111     {
4112       if (!ggc_p)
4113         obstack_free (TYPE_OBSTACK (type), type);
4114
4115 #ifdef GATHER_STATISTICS
4116       tree_node_counts[(int) t_kind]--;
4117       tree_node_sizes[(int) t_kind] -= sizeof (struct tree_type);
4118 #endif
4119       return t1;
4120     }
4121
4122   /* If this is a permanent type, record it for later reuse.  */
4123   if (ggc_p || TREE_PERMANENT (type))
4124     type_hash_add (hashcode, type);
4125
4126   return type;
4127 }
4128
4129 /* Callback function for htab_traverse.  */
4130
4131 static int
4132 mark_hash_entry (entry, param)
4133      void **entry;
4134      void *param ATTRIBUTE_UNUSED;
4135 {
4136   struct type_hash *p = *(struct type_hash **)entry;
4137
4138   ggc_mark_tree (p->type);
4139
4140   /* Continue scan.  */
4141   return 1;
4142 }
4143
4144 /* Mark ARG (which is really a htab_t *) for GC.  */
4145
4146 static void
4147 mark_type_hash (arg)
4148      void *arg;
4149 {
4150   htab_t t = *(htab_t *) arg;
4151
4152   htab_traverse (t, mark_hash_entry, 0);
4153 }
4154
4155 static void
4156 print_type_hash_statistics ()
4157 {
4158   fprintf (stderr, "Type hash: size %ld, %ld elements, %f collisions\n",
4159            (long) htab_size (type_hash_table),
4160            (long) htab_elements (type_hash_table),
4161            htab_collisions (type_hash_table));
4162 }
4163
4164 /* Compute a hash code for a list of attributes (chain of TREE_LIST nodes
4165    with names in the TREE_PURPOSE slots and args in the TREE_VALUE slots),
4166    by adding the hash codes of the individual attributes.  */
4167
4168 unsigned int
4169 attribute_hash_list (list)
4170      tree list;
4171 {
4172   unsigned int hashcode;
4173   register tree tail;
4174
4175   for (hashcode = 0, tail = list; tail; tail = TREE_CHAIN (tail))
4176     /* ??? Do we want to add in TREE_VALUE too? */
4177     hashcode += TYPE_HASH (TREE_PURPOSE (tail));
4178   return hashcode;
4179 }
4180
4181 /* Given two lists of attributes, return true if list l2 is
4182    equivalent to l1.  */
4183
4184 int
4185 attribute_list_equal (l1, l2)
4186      tree l1, l2;
4187 {
4188    return attribute_list_contained (l1, l2)
4189           && attribute_list_contained (l2, l1);
4190 }
4191
4192 /* Given two lists of attributes, return true if list L2 is
4193    completely contained within L1.  */
4194 /* ??? This would be faster if attribute names were stored in a canonicalized
4195    form.  Otherwise, if L1 uses `foo' and L2 uses `__foo__', the long method
4196    must be used to show these elements are equivalent (which they are).  */
4197 /* ??? It's not clear that attributes with arguments will always be handled
4198    correctly.  */
4199
4200 int
4201 attribute_list_contained (l1, l2)
4202      tree l1, l2;
4203 {
4204   register tree t1, t2;
4205
4206   /* First check the obvious, maybe the lists are identical.  */
4207   if (l1 == l2)
4208      return 1;
4209
4210   /* Maybe the lists are similar.  */
4211   for (t1 = l1, t2 = l2;
4212        t1 != 0 && t2 != 0
4213         && TREE_PURPOSE (t1) == TREE_PURPOSE (t2)
4214         && TREE_VALUE (t1) == TREE_VALUE (t2);
4215        t1 = TREE_CHAIN (t1), t2 = TREE_CHAIN (t2));
4216
4217   /* Maybe the lists are equal.  */
4218   if (t1 == 0 && t2 == 0)
4219      return 1;
4220
4221   for (; t2 != 0; t2 = TREE_CHAIN (t2))
4222     {
4223       tree attr
4224         = lookup_attribute (IDENTIFIER_POINTER (TREE_PURPOSE (t2)), l1);
4225
4226       if (attr == 0)
4227         return 0;
4228
4229       if (simple_cst_equal (TREE_VALUE (t2), TREE_VALUE (attr)) != 1)
4230         return 0;
4231     }
4232
4233   return 1;
4234 }
4235
4236 /* Given two lists of types
4237    (chains of TREE_LIST nodes with types in the TREE_VALUE slots)
4238    return 1 if the lists contain the same types in the same order.
4239    Also, the TREE_PURPOSEs must match.  */
4240
4241 int
4242 type_list_equal (l1, l2)
4243      tree l1, l2;
4244 {
4245   register tree t1, t2;
4246
4247   for (t1 = l1, t2 = l2; t1 && t2; t1 = TREE_CHAIN (t1), t2 = TREE_CHAIN (t2))
4248     if (TREE_VALUE (t1) != TREE_VALUE (t2)
4249         || (TREE_PURPOSE (t1) != TREE_PURPOSE (t2)
4250             && ! (1 == simple_cst_equal (TREE_PURPOSE (t1), TREE_PURPOSE (t2))
4251                   && (TREE_TYPE (TREE_PURPOSE (t1))
4252                       == TREE_TYPE (TREE_PURPOSE (t2))))))
4253       return 0;
4254
4255   return t1 == t2;
4256 }
4257
4258 /* Nonzero if integer constants T1 and T2
4259    represent the same constant value.  */
4260
4261 int
4262 tree_int_cst_equal (t1, t2)
4263      tree t1, t2;
4264 {
4265   if (t1 == t2)
4266     return 1;
4267
4268   if (t1 == 0 || t2 == 0)
4269     return 0;
4270
4271   if (TREE_CODE (t1) == INTEGER_CST
4272       && TREE_CODE (t2) == INTEGER_CST
4273       && TREE_INT_CST_LOW (t1) == TREE_INT_CST_LOW (t2)
4274       && TREE_INT_CST_HIGH (t1) == TREE_INT_CST_HIGH (t2))
4275     return 1;
4276
4277   return 0;
4278 }
4279
4280 /* Nonzero if integer constants T1 and T2 represent values that satisfy <.
4281    The precise way of comparison depends on their data type.  */
4282
4283 int
4284 tree_int_cst_lt (t1, t2)
4285      tree t1, t2;
4286 {
4287   if (t1 == t2)
4288     return 0;
4289
4290   if (! TREE_UNSIGNED (TREE_TYPE (t1)))
4291     return INT_CST_LT (t1, t2);
4292
4293   return INT_CST_LT_UNSIGNED (t1, t2);
4294 }
4295
4296 /* Return 1 if T is an INTEGER_CST that can be represented in a single
4297    HOST_WIDE_INT value.  If POS is nonzero, the result must be positive.  */
4298
4299 int
4300 host_integerp (t, pos)
4301      tree t;
4302      int pos;
4303 {
4304   return (TREE_CODE (t) == INTEGER_CST
4305           && ! TREE_OVERFLOW (t)
4306           && ((TREE_INT_CST_HIGH (t) == 0
4307                && (HOST_WIDE_INT) TREE_INT_CST_LOW (t) >= 0)
4308               || (! pos && TREE_INT_CST_HIGH (t) == -1
4309                   && (HOST_WIDE_INT) TREE_INT_CST_LOW (t) < 0)));
4310 }
4311
4312 /* Return the HOST_WIDE_INT least significant bits of T if it is an
4313    INTEGER_CST and there is no overflow.  POS is nonzero if the result must
4314    be positive.  Abort if we cannot satisfy the above conditions.  */
4315
4316 HOST_WIDE_INT
4317 tree_low_cst (t, pos)
4318      tree t;
4319      int pos;
4320 {
4321   if (host_integerp (t, pos))
4322     return TREE_INT_CST_LOW (t);
4323   else
4324     abort ();
4325 }  
4326
4327 /* Return the most significant bit of the integer constant T.  */
4328
4329 int
4330 tree_int_cst_msb (t)
4331      tree t;
4332 {
4333   register int prec;
4334   HOST_WIDE_INT h;
4335   unsigned HOST_WIDE_INT l;
4336
4337   /* Note that using TYPE_PRECISION here is wrong.  We care about the
4338      actual bits, not the (arbitrary) range of the type.  */
4339   prec = GET_MODE_BITSIZE (TYPE_MODE (TREE_TYPE (t))) - 1;
4340   rshift_double (TREE_INT_CST_LOW (t), TREE_INT_CST_HIGH (t), prec,
4341                  2 * HOST_BITS_PER_WIDE_INT, &l, &h, 0);
4342   return (l & 1) == 1;
4343   }
4344
4345 /* Return an indication of the sign of the integer constant T.
4346    The return value is -1 if T < 0, 0 if T == 0, and 1 if T > 0.
4347    Note that -1 will never be returned it T's type is unsigned.  */
4348
4349 int
4350 tree_int_cst_sgn (t)
4351      tree t;
4352 {
4353   if (TREE_INT_CST_LOW (t) == 0 && TREE_INT_CST_HIGH (t) == 0)
4354     return 0;
4355   else if (TREE_UNSIGNED (TREE_TYPE (t)))
4356     return 1;
4357   else if (TREE_INT_CST_HIGH (t) < 0)
4358     return -1;
4359   else
4360     return 1;
4361 }
4362
4363 /* Return true if `t' is known to be non-negative.  */
4364
4365 int
4366 tree_expr_nonnegative_p (t)
4367      tree t;
4368 {
4369   switch (TREE_CODE (t))
4370     {
4371     case INTEGER_CST:
4372       return tree_int_cst_sgn (t) >= 0;
4373     case COND_EXPR:
4374       return tree_expr_nonnegative_p (TREE_OPERAND (t, 1))
4375         && tree_expr_nonnegative_p (TREE_OPERAND (t, 2));
4376     default:
4377       /* We don't know sign of `t', so be safe and return false.  */
4378       return 0;
4379     }
4380 }
4381
4382 /* Compare two constructor-element-type constants.  Return 1 if the lists
4383    are known to be equal; otherwise return 0.  */
4384
4385 int
4386 simple_cst_list_equal (l1, l2)
4387      tree l1, l2;
4388 {
4389   while (l1 != NULL_TREE && l2 != NULL_TREE)
4390     {
4391       if (simple_cst_equal (TREE_VALUE (l1), TREE_VALUE (l2)) != 1)
4392         return 0;
4393
4394       l1 = TREE_CHAIN (l1);
4395       l2 = TREE_CHAIN (l2);
4396     }
4397
4398   return l1 == l2;
4399 }
4400
4401 /* Return truthvalue of whether T1 is the same tree structure as T2.
4402    Return 1 if they are the same.
4403    Return 0 if they are understandably different.
4404    Return -1 if either contains tree structure not understood by
4405    this function.  */
4406
4407 int
4408 simple_cst_equal (t1, t2)
4409      tree t1, t2;
4410 {
4411   register enum tree_code code1, code2;
4412   int cmp;
4413   int i;
4414
4415   if (t1 == t2)
4416     return 1;
4417   if (t1 == 0 || t2 == 0)
4418     return 0;
4419
4420   code1 = TREE_CODE (t1);
4421   code2 = TREE_CODE (t2);
4422
4423   if (code1 == NOP_EXPR || code1 == CONVERT_EXPR || code1 == NON_LVALUE_EXPR)
4424     {
4425       if (code2 == NOP_EXPR || code2 == CONVERT_EXPR
4426           || code2 == NON_LVALUE_EXPR)
4427         return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
4428       else
4429         return simple_cst_equal (TREE_OPERAND (t1, 0), t2);
4430     }
4431
4432   else if (code2 == NOP_EXPR || code2 == CONVERT_EXPR
4433            || code2 == NON_LVALUE_EXPR)
4434     return simple_cst_equal (t1, TREE_OPERAND (t2, 0));
4435
4436   if (code1 != code2)
4437     return 0;
4438
4439   switch (code1)
4440     {
4441     case INTEGER_CST:
4442       return (TREE_INT_CST_LOW (t1) == TREE_INT_CST_LOW (t2)
4443               && TREE_INT_CST_HIGH (t1) == TREE_INT_CST_HIGH (t2));
4444
4445     case REAL_CST:
4446       return REAL_VALUES_IDENTICAL (TREE_REAL_CST (t1), TREE_REAL_CST (t2));
4447
4448     case STRING_CST:
4449       return (TREE_STRING_LENGTH (t1) == TREE_STRING_LENGTH (t2)
4450               && ! bcmp (TREE_STRING_POINTER (t1), TREE_STRING_POINTER (t2),
4451                          TREE_STRING_LENGTH (t1)));
4452
4453     case CONSTRUCTOR:
4454       if (CONSTRUCTOR_ELTS (t1) == CONSTRUCTOR_ELTS (t2))
4455         return 1;
4456       else
4457         abort ();
4458
4459     case SAVE_EXPR:
4460       return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
4461
4462     case CALL_EXPR:
4463       cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
4464       if (cmp <= 0)
4465         return cmp;
4466       return
4467         simple_cst_list_equal (TREE_OPERAND (t1, 1), TREE_OPERAND (t2, 1));
4468
4469     case TARGET_EXPR:
4470       /* Special case: if either target is an unallocated VAR_DECL,
4471          it means that it's going to be unified with whatever the
4472          TARGET_EXPR is really supposed to initialize, so treat it
4473          as being equivalent to anything.  */
4474       if ((TREE_CODE (TREE_OPERAND (t1, 0)) == VAR_DECL
4475            && DECL_NAME (TREE_OPERAND (t1, 0)) == NULL_TREE
4476            && DECL_RTL (TREE_OPERAND (t1, 0)) == 0)
4477           || (TREE_CODE (TREE_OPERAND (t2, 0)) == VAR_DECL
4478               && DECL_NAME (TREE_OPERAND (t2, 0)) == NULL_TREE
4479               && DECL_RTL (TREE_OPERAND (t2, 0)) == 0))
4480         cmp = 1;
4481       else
4482         cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
4483
4484       if (cmp <= 0)
4485         return cmp;
4486
4487       return simple_cst_equal (TREE_OPERAND (t1, 1), TREE_OPERAND (t2, 1));
4488
4489     case WITH_CLEANUP_EXPR:
4490       cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
4491       if (cmp <= 0)
4492         return cmp;
4493
4494       return simple_cst_equal (TREE_OPERAND (t1, 2), TREE_OPERAND (t1, 2));
4495
4496     case COMPONENT_REF:
4497       if (TREE_OPERAND (t1, 1) == TREE_OPERAND (t2, 1))
4498         return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
4499
4500       return 0;
4501
4502     case VAR_DECL:
4503     case PARM_DECL:
4504     case CONST_DECL:
4505     case FUNCTION_DECL:
4506       return 0;
4507       
4508     default:
4509       break;
4510     }
4511
4512   /* This general rule works for most tree codes.  All exceptions should be
4513      handled above.  If this is a language-specific tree code, we can't
4514      trust what might be in the operand, so say we don't know
4515      the situation.  */
4516   if ((int) code1 >= (int) LAST_AND_UNUSED_TREE_CODE)
4517     return -1;
4518
4519   switch (TREE_CODE_CLASS (code1))
4520     {
4521     case '1':
4522     case '2':
4523     case '<':
4524     case 'e':
4525     case 'r':
4526     case 's':
4527       cmp = 1;
4528       for (i = 0; i < TREE_CODE_LENGTH (code1); i++)
4529         {
4530           cmp = simple_cst_equal (TREE_OPERAND (t1, i), TREE_OPERAND (t2, i));
4531           if (cmp <= 0)
4532             return cmp;
4533         }
4534
4535       return cmp;
4536
4537     default:
4538       return -1;
4539     }
4540 }
4541
4542 /* Compare the value of T, an INTEGER_CST, with U, an unsigned integer value.
4543    Return -1, 0, or 1 if the value of T is less than, equal to, or greater
4544    than U, respectively.  */
4545
4546 int
4547 compare_tree_int (t, u)
4548      tree t;
4549      unsigned int u;
4550 {
4551   if (tree_int_cst_sgn (t) < 0)
4552     return -1;
4553   else if (TREE_INT_CST_HIGH (t) != 0)
4554     return 1;
4555   else if (TREE_INT_CST_LOW (t) == u)
4556     return 0;
4557   else if (TREE_INT_CST_LOW (t) < u)
4558     return -1;
4559   else
4560     return 1;
4561 }
4562 \f
4563 /* Constructors for pointer, array and function types.
4564    (RECORD_TYPE, UNION_TYPE and ENUMERAL_TYPE nodes are
4565    constructed by language-dependent code, not here.)  */
4566
4567 /* Construct, lay out and return the type of pointers to TO_TYPE.
4568    If such a type has already been constructed, reuse it.  */
4569
4570 tree
4571 build_pointer_type (to_type)
4572      tree to_type;
4573 {
4574   register tree t = TYPE_POINTER_TO (to_type);
4575
4576   /* First, if we already have a type for pointers to TO_TYPE, use it.  */
4577
4578   if (t != 0)
4579     return t;
4580
4581   /* We need a new one.  Put this in the same obstack as TO_TYPE.   */
4582   push_obstacks (TYPE_OBSTACK (to_type), TYPE_OBSTACK (to_type));
4583   t = make_node (POINTER_TYPE);
4584   pop_obstacks ();
4585
4586   TREE_TYPE (t) = to_type;
4587
4588   /* Record this type as the pointer to TO_TYPE.  */
4589   TYPE_POINTER_TO (to_type) = t;
4590
4591   /* Lay out the type.  This function has many callers that are concerned
4592      with expression-construction, and this simplifies them all.
4593      Also, it guarantees the TYPE_SIZE is in the same obstack as the type.  */
4594   layout_type (t);
4595
4596   return t;
4597 }
4598
4599 /* Build the node for the type of references-to-TO_TYPE.  */
4600
4601 tree
4602 build_reference_type (to_type)
4603      tree to_type;
4604 {
4605   register tree t = TYPE_REFERENCE_TO (to_type);
4606
4607   /* First, if we already have a type for pointers to TO_TYPE, use it.  */
4608
4609   if (t)
4610     return t;
4611
4612   /* We need a new one.  Put this in the same obstack as TO_TYPE.   */
4613   push_obstacks (TYPE_OBSTACK (to_type), TYPE_OBSTACK (to_type));
4614   t = make_node (REFERENCE_TYPE);
4615   pop_obstacks ();
4616
4617   TREE_TYPE (t) = to_type;
4618
4619   /* Record this type as the pointer to TO_TYPE.  */
4620   TYPE_REFERENCE_TO (to_type) = t;
4621
4622   layout_type (t);
4623
4624   return t;
4625 }
4626
4627 /* Create a type of integers to be the TYPE_DOMAIN of an ARRAY_TYPE.
4628    MAXVAL should be the maximum value in the domain
4629    (one less than the length of the array).
4630
4631    The maximum value that MAXVAL can have is INT_MAX for a HOST_WIDE_INT.
4632    We don't enforce this limit, that is up to caller (e.g. language front end).
4633    The limit exists because the result is a signed type and we don't handle
4634    sizes that use more than one HOST_WIDE_INT.  */
4635
4636 tree
4637 build_index_type (maxval)
4638      tree maxval;
4639 {
4640   register tree itype = make_node (INTEGER_TYPE);
4641
4642   TREE_TYPE (itype) = sizetype;
4643   TYPE_PRECISION (itype) = TYPE_PRECISION (sizetype);
4644   TYPE_MIN_VALUE (itype) = size_zero_node;
4645
4646   push_obstacks (TYPE_OBSTACK (itype), TYPE_OBSTACK (itype));
4647   TYPE_MAX_VALUE (itype) = convert (sizetype, maxval);
4648   pop_obstacks ();
4649
4650   TYPE_MODE (itype) = TYPE_MODE (sizetype);
4651   TYPE_SIZE (itype) = TYPE_SIZE (sizetype);
4652   TYPE_SIZE_UNIT (itype) = TYPE_SIZE_UNIT (sizetype);
4653   TYPE_ALIGN (itype) = TYPE_ALIGN (sizetype);
4654
4655   if (host_integerp (maxval, 1))
4656     return type_hash_canon (tree_low_cst (maxval, 1), itype);
4657   else
4658     return itype;
4659 }
4660
4661 /* Create a range of some discrete type TYPE (an INTEGER_TYPE,
4662    ENUMERAL_TYPE, BOOLEAN_TYPE, or CHAR_TYPE), with
4663    low bound LOWVAL and high bound HIGHVAL.
4664    if TYPE==NULL_TREE, sizetype is used.  */
4665
4666 tree
4667 build_range_type (type, lowval, highval)
4668      tree type, lowval, highval;
4669 {
4670   register tree itype = make_node (INTEGER_TYPE);
4671
4672   TREE_TYPE (itype) = type;
4673   if (type == NULL_TREE)
4674     type = sizetype;
4675
4676   push_obstacks (TYPE_OBSTACK (itype), TYPE_OBSTACK (itype));
4677   TYPE_MIN_VALUE (itype) = convert (type, lowval);
4678   TYPE_MAX_VALUE (itype) = highval ? convert (type, highval) : NULL;
4679   pop_obstacks ();
4680
4681   TYPE_PRECISION (itype) = TYPE_PRECISION (type);
4682   TYPE_MODE (itype) = TYPE_MODE (type);
4683   TYPE_SIZE (itype) = TYPE_SIZE (type);
4684   TYPE_SIZE_UNIT (itype) = TYPE_SIZE_UNIT (type);
4685   TYPE_ALIGN (itype) = TYPE_ALIGN (type);
4686
4687   if (host_integerp (lowval, 0) && highval != 0 && host_integerp (highval, 0))
4688     return type_hash_canon (tree_low_cst (highval, 0)
4689                             - tree_low_cst (lowval, 0),
4690                             itype);
4691   else
4692     return itype;
4693 }
4694
4695 /* Just like build_index_type, but takes lowval and highval instead
4696    of just highval (maxval).  */
4697
4698 tree
4699 build_index_2_type (lowval,highval)
4700      tree lowval, highval;
4701 {
4702   return build_range_type (sizetype, lowval, highval);
4703 }
4704
4705 /* Return nonzero iff ITYPE1 and ITYPE2 are equal (in the LISP sense).
4706    Needed because when index types are not hashed, equal index types
4707    built at different times appear distinct, even though structurally,
4708    they are not.  */
4709
4710 int
4711 index_type_equal (itype1, itype2)
4712      tree itype1, itype2;
4713 {
4714   if (TREE_CODE (itype1) != TREE_CODE (itype2))
4715     return 0;
4716
4717   if (TREE_CODE (itype1) == INTEGER_TYPE)
4718     {
4719       if (TYPE_PRECISION (itype1) != TYPE_PRECISION (itype2)
4720           || TYPE_MODE (itype1) != TYPE_MODE (itype2)
4721           || simple_cst_equal (TYPE_SIZE (itype1), TYPE_SIZE (itype2)) != 1
4722           || TYPE_ALIGN (itype1) != TYPE_ALIGN (itype2))
4723         return 0;
4724
4725       if (1 == simple_cst_equal (TYPE_MIN_VALUE (itype1),
4726                                  TYPE_MIN_VALUE (itype2))
4727           && 1 == simple_cst_equal (TYPE_MAX_VALUE (itype1),
4728                                     TYPE_MAX_VALUE (itype2)))
4729         return 1;
4730     }
4731
4732   return 0;
4733 }
4734
4735 /* Construct, lay out and return the type of arrays of elements with ELT_TYPE
4736    and number of elements specified by the range of values of INDEX_TYPE.
4737    If such a type has already been constructed, reuse it.  */
4738
4739 tree
4740 build_array_type (elt_type, index_type)
4741      tree elt_type, index_type;
4742 {
4743   register tree t;
4744   unsigned int hashcode;
4745
4746   if (TREE_CODE (elt_type) == FUNCTION_TYPE)
4747     {
4748       error ("arrays of functions are not meaningful");
4749       elt_type = integer_type_node;
4750     }
4751
4752   /* Make sure TYPE_POINTER_TO (elt_type) is filled in.  */
4753   build_pointer_type (elt_type);
4754
4755   /* Allocate the array after the pointer type,
4756      in case we free it in type_hash_canon.  */
4757   t = make_node (ARRAY_TYPE);
4758   TREE_TYPE (t) = elt_type;
4759   TYPE_DOMAIN (t) = index_type;
4760
4761   if (index_type == 0)
4762     {
4763       return t;
4764     }
4765
4766   hashcode = TYPE_HASH (elt_type) + TYPE_HASH (index_type);
4767   t = type_hash_canon (hashcode, t);
4768
4769   if (!COMPLETE_TYPE_P (t))
4770     layout_type (t);
4771   return t;
4772 }
4773
4774 /* Return the TYPE of the elements comprising
4775    the innermost dimension of ARRAY.  */
4776
4777 tree
4778 get_inner_array_type (array)
4779     tree array;
4780 {
4781   tree type = TREE_TYPE (array);
4782
4783   while (TREE_CODE (type) == ARRAY_TYPE)
4784     type = TREE_TYPE (type);
4785
4786   return type;
4787 }
4788
4789 /* Construct, lay out and return
4790    the type of functions returning type VALUE_TYPE
4791    given arguments of types ARG_TYPES.
4792    ARG_TYPES is a chain of TREE_LIST nodes whose TREE_VALUEs
4793    are data type nodes for the arguments of the function.
4794    If such a type has already been constructed, reuse it.  */
4795
4796 tree
4797 build_function_type (value_type, arg_types)
4798      tree value_type, arg_types;
4799 {
4800   register tree t;
4801   unsigned int hashcode;
4802
4803   if (TREE_CODE (value_type) == FUNCTION_TYPE)
4804     {
4805       error ("function return type cannot be function");
4806       value_type = integer_type_node;
4807     }
4808
4809   /* Make a node of the sort we want.  */
4810   t = make_node (FUNCTION_TYPE);
4811   TREE_TYPE (t) = value_type;
4812   TYPE_ARG_TYPES (t) = arg_types;
4813
4814   /* If we already have such a type, use the old one and free this one.  */
4815   hashcode = TYPE_HASH (value_type) + type_hash_list (arg_types);
4816   t = type_hash_canon (hashcode, t);
4817
4818   if (!COMPLETE_TYPE_P (t))
4819     layout_type (t);
4820   return t;
4821 }
4822
4823 /* Construct, lay out and return the type of methods belonging to class
4824    BASETYPE and whose arguments and values are described by TYPE.
4825    If that type exists already, reuse it.
4826    TYPE must be a FUNCTION_TYPE node.  */
4827
4828 tree
4829 build_method_type (basetype, type)
4830      tree basetype, type;
4831 {
4832   register tree t;
4833   unsigned int hashcode;
4834
4835   /* Make a node of the sort we want.  */
4836   t = make_node (METHOD_TYPE);
4837
4838   if (TREE_CODE (type) != FUNCTION_TYPE)
4839     abort ();
4840
4841   TYPE_METHOD_BASETYPE (t) = TYPE_MAIN_VARIANT (basetype);
4842   TREE_TYPE (t) = TREE_TYPE (type);
4843
4844   /* The actual arglist for this function includes a "hidden" argument
4845      which is "this".  Put it into the list of argument types.  */
4846
4847   TYPE_ARG_TYPES (t)
4848     = tree_cons (NULL_TREE,
4849                  build_pointer_type (basetype), TYPE_ARG_TYPES (type));
4850
4851   /* If we already have such a type, use the old one and free this one.  */
4852   hashcode = TYPE_HASH (basetype) + TYPE_HASH (type);
4853   t = type_hash_canon (hashcode, t);
4854
4855   if (!COMPLETE_TYPE_P (t))
4856     layout_type (t);
4857
4858   return t;
4859 }
4860
4861 /* Construct, lay out and return the type of offsets to a value
4862    of type TYPE, within an object of type BASETYPE.
4863    If a suitable offset type exists already, reuse it.  */
4864
4865 tree
4866 build_offset_type (basetype, type)
4867      tree basetype, type;
4868 {
4869   register tree t;
4870   unsigned int hashcode;
4871
4872   /* Make a node of the sort we want.  */
4873   t = make_node (OFFSET_TYPE);
4874
4875   TYPE_OFFSET_BASETYPE (t) = TYPE_MAIN_VARIANT (basetype);
4876   TREE_TYPE (t) = type;
4877
4878   /* If we already have such a type, use the old one and free this one.  */
4879   hashcode = TYPE_HASH (basetype) + TYPE_HASH (type);
4880   t = type_hash_canon (hashcode, t);
4881
4882   if (!COMPLETE_TYPE_P (t))
4883     layout_type (t);
4884
4885   return t;
4886 }
4887
4888 /* Create a complex type whose components are COMPONENT_TYPE.  */
4889
4890 tree
4891 build_complex_type (component_type)
4892      tree component_type;
4893 {
4894   register tree t;
4895   unsigned int hashcode;
4896
4897   /* Make a node of the sort we want.  */
4898   t = make_node (COMPLEX_TYPE);
4899
4900   TREE_TYPE (t) = TYPE_MAIN_VARIANT (component_type);
4901   set_type_quals (t, TYPE_QUALS (component_type));
4902
4903   /* If we already have such a type, use the old one and free this one.  */
4904   hashcode = TYPE_HASH (component_type);
4905   t = type_hash_canon (hashcode, t);
4906
4907   if (!COMPLETE_TYPE_P (t))
4908     layout_type (t);
4909
4910   /* If we are writing Dwarf2 output we need to create a name,
4911      since complex is a fundamental type.  */
4912   if (write_symbols == DWARF2_DEBUG && ! TYPE_NAME (t))
4913     {
4914       const char *name;
4915       if (component_type == char_type_node)
4916         name = "complex char";
4917       else if (component_type == signed_char_type_node)
4918         name = "complex signed char";
4919       else if (component_type == unsigned_char_type_node)
4920         name = "complex unsigned char";
4921       else if (component_type == short_integer_type_node)
4922         name = "complex short int";
4923       else if (component_type == short_unsigned_type_node)
4924         name = "complex short unsigned int";
4925       else if (component_type == integer_type_node)
4926         name = "complex int";
4927       else if (component_type == unsigned_type_node)
4928         name = "complex unsigned int";
4929       else if (component_type == long_integer_type_node)
4930         name = "complex long int";
4931       else if (component_type == long_unsigned_type_node)
4932         name = "complex long unsigned int";
4933       else if (component_type == long_long_integer_type_node)
4934         name = "complex long long int";
4935       else if (component_type == long_long_unsigned_type_node)
4936         name = "complex long long unsigned int";
4937       else
4938         name = 0;
4939
4940       if (name != 0)
4941         TYPE_NAME (t) = get_identifier (name);
4942     }
4943
4944   return t;
4945 }
4946 \f
4947 /* Return OP, stripped of any conversions to wider types as much as is safe.
4948    Converting the value back to OP's type makes a value equivalent to OP.
4949
4950    If FOR_TYPE is nonzero, we return a value which, if converted to
4951    type FOR_TYPE, would be equivalent to converting OP to type FOR_TYPE.
4952
4953    If FOR_TYPE is nonzero, unaligned bit-field references may be changed to the
4954    narrowest type that can hold the value, even if they don't exactly fit.
4955    Otherwise, bit-field references are changed to a narrower type
4956    only if they can be fetched directly from memory in that type.
4957
4958    OP must have integer, real or enumeral type.  Pointers are not allowed!
4959
4960    There are some cases where the obvious value we could return
4961    would regenerate to OP if converted to OP's type, 
4962    but would not extend like OP to wider types.
4963    If FOR_TYPE indicates such extension is contemplated, we eschew such values.
4964    For example, if OP is (unsigned short)(signed char)-1,
4965    we avoid returning (signed char)-1 if FOR_TYPE is int,
4966    even though extending that to an unsigned short would regenerate OP,
4967    since the result of extending (signed char)-1 to (int)
4968    is different from (int) OP.  */
4969
4970 tree
4971 get_unwidened (op, for_type)
4972      register tree op;
4973      tree for_type;
4974 {
4975   /* Set UNS initially if converting OP to FOR_TYPE is a zero-extension.  */
4976   register tree type = TREE_TYPE (op);
4977   register unsigned final_prec
4978     = TYPE_PRECISION (for_type != 0 ? for_type : type);
4979   register int uns
4980     = (for_type != 0 && for_type != type
4981        && final_prec > TYPE_PRECISION (type)
4982        && TREE_UNSIGNED (type));
4983   register tree win = op;
4984
4985   while (TREE_CODE (op) == NOP_EXPR)
4986     {
4987       register int bitschange
4988         = TYPE_PRECISION (TREE_TYPE (op))
4989           - TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (op, 0)));
4990
4991       /* Truncations are many-one so cannot be removed.
4992          Unless we are later going to truncate down even farther.  */
4993       if (bitschange < 0
4994           && final_prec > TYPE_PRECISION (TREE_TYPE (op)))
4995         break;
4996
4997       /* See what's inside this conversion.  If we decide to strip it,
4998          we will set WIN.  */
4999       op = TREE_OPERAND (op, 0);
5000
5001       /* If we have not stripped any zero-extensions (uns is 0),
5002          we can strip any kind of extension.
5003          If we have previously stripped a zero-extension,
5004          only zero-extensions can safely be stripped.
5005          Any extension can be stripped if the bits it would produce
5006          are all going to be discarded later by truncating to FOR_TYPE.  */
5007
5008       if (bitschange > 0)
5009         {
5010           if (! uns || final_prec <= TYPE_PRECISION (TREE_TYPE (op)))
5011             win = op;
5012           /* TREE_UNSIGNED says whether this is a zero-extension.
5013              Let's avoid computing it if it does not affect WIN
5014              and if UNS will not be needed again.  */
5015           if ((uns || TREE_CODE (op) == NOP_EXPR)
5016               && TREE_UNSIGNED (TREE_TYPE (op)))
5017             {
5018               uns = 1;
5019               win = op;
5020             }
5021         }
5022     }
5023
5024   if (TREE_CODE (op) == COMPONENT_REF
5025       /* Since type_for_size always gives an integer type.  */
5026       && TREE_CODE (type) != REAL_TYPE
5027       /* Don't crash if field not laid out yet.  */
5028       && DECL_SIZE (TREE_OPERAND (op, 1)) != 0)
5029     {
5030       unsigned int innerprec
5031         = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1)));
5032
5033       type = type_for_size (innerprec, TREE_UNSIGNED (TREE_OPERAND (op, 1)));
5034
5035       /* We can get this structure field in the narrowest type it fits in.
5036          If FOR_TYPE is 0, do this only for a field that matches the
5037          narrower type exactly and is aligned for it
5038          The resulting extension to its nominal type (a fullword type)
5039          must fit the same conditions as for other extensions.  */
5040
5041       if (innerprec < TYPE_PRECISION (TREE_TYPE (op))
5042           && (for_type || ! DECL_BIT_FIELD (TREE_OPERAND (op, 1)))
5043           && (! uns || final_prec <= innerprec
5044               || TREE_UNSIGNED (TREE_OPERAND (op, 1)))
5045           && type != 0)
5046         {
5047           win = build (COMPONENT_REF, type, TREE_OPERAND (op, 0),
5048                        TREE_OPERAND (op, 1));
5049           TREE_SIDE_EFFECTS (win) = TREE_SIDE_EFFECTS (op);
5050           TREE_THIS_VOLATILE (win) = TREE_THIS_VOLATILE (op);
5051         }
5052     }
5053   return win;
5054 }
5055 \f
5056 /* Return OP or a simpler expression for a narrower value
5057    which can be sign-extended or zero-extended to give back OP.
5058    Store in *UNSIGNEDP_PTR either 1 if the value should be zero-extended
5059    or 0 if the value should be sign-extended.  */
5060
5061 tree
5062 get_narrower (op, unsignedp_ptr)
5063      register tree op;
5064      int *unsignedp_ptr;
5065 {
5066   register int uns = 0;
5067   int first = 1;
5068   register tree win = op;
5069
5070   while (TREE_CODE (op) == NOP_EXPR)
5071     {
5072       register int bitschange
5073         = (TYPE_PRECISION (TREE_TYPE (op))
5074            - TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (op, 0))));
5075
5076       /* Truncations are many-one so cannot be removed.  */
5077       if (bitschange < 0)
5078         break;
5079
5080       /* See what's inside this conversion.  If we decide to strip it,
5081          we will set WIN.  */
5082       op = TREE_OPERAND (op, 0);
5083
5084       if (bitschange > 0)
5085         {
5086           /* An extension: the outermost one can be stripped,
5087              but remember whether it is zero or sign extension.  */
5088           if (first)
5089             uns = TREE_UNSIGNED (TREE_TYPE (op));
5090           /* Otherwise, if a sign extension has been stripped,
5091              only sign extensions can now be stripped;
5092              if a zero extension has been stripped, only zero-extensions.  */
5093           else if (uns != TREE_UNSIGNED (TREE_TYPE (op)))
5094             break;
5095           first = 0;
5096         }
5097       else /* bitschange == 0 */
5098         {
5099           /* A change in nominal type can always be stripped, but we must
5100              preserve the unsignedness.  */
5101           if (first)
5102             uns = TREE_UNSIGNED (TREE_TYPE (op));
5103           first = 0;
5104         }
5105
5106       win = op;
5107     }
5108
5109   if (TREE_CODE (op) == COMPONENT_REF
5110       /* Since type_for_size always gives an integer type.  */
5111       && TREE_CODE (TREE_TYPE (op)) != REAL_TYPE)
5112     {
5113       unsigned int innerprec
5114         = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1)));
5115
5116       tree type = type_for_size (innerprec, TREE_UNSIGNED (op));
5117
5118       /* We can get this structure field in a narrower type that fits it,
5119          but the resulting extension to its nominal type (a fullword type)
5120          must satisfy the same conditions as for other extensions.
5121
5122          Do this only for fields that are aligned (not bit-fields),
5123          because when bit-field insns will be used there is no
5124          advantage in doing this.  */
5125
5126       if (innerprec < TYPE_PRECISION (TREE_TYPE (op))
5127           && ! DECL_BIT_FIELD (TREE_OPERAND (op, 1))
5128           && (first || uns == TREE_UNSIGNED (TREE_OPERAND (op, 1)))
5129           && type != 0)
5130         {
5131           if (first)
5132             uns = TREE_UNSIGNED (TREE_OPERAND (op, 1));
5133           win = build (COMPONENT_REF, type, TREE_OPERAND (op, 0),
5134                        TREE_OPERAND (op, 1));
5135           TREE_SIDE_EFFECTS (win) = TREE_SIDE_EFFECTS (op);
5136           TREE_THIS_VOLATILE (win) = TREE_THIS_VOLATILE (op);
5137         }
5138     }
5139   *unsignedp_ptr = uns;
5140   return win;
5141 }
5142 \f
5143 /* Nonzero if integer constant C has a value that is permissible
5144    for type TYPE (an INTEGER_TYPE).  */
5145
5146 int
5147 int_fits_type_p (c, type)
5148      tree c, type;
5149 {
5150   if (TREE_UNSIGNED (type))
5151     return (! (TREE_CODE (TYPE_MAX_VALUE (type)) == INTEGER_CST
5152                && INT_CST_LT_UNSIGNED (TYPE_MAX_VALUE (type), c))
5153             && ! (TREE_CODE (TYPE_MIN_VALUE (type)) == INTEGER_CST
5154                   && INT_CST_LT_UNSIGNED (c, TYPE_MIN_VALUE (type)))
5155             /* Negative ints never fit unsigned types.  */
5156             && ! (TREE_INT_CST_HIGH (c) < 0
5157                   && ! TREE_UNSIGNED (TREE_TYPE (c))));
5158   else
5159     return (! (TREE_CODE (TYPE_MAX_VALUE (type)) == INTEGER_CST
5160                && INT_CST_LT (TYPE_MAX_VALUE (type), c))
5161             && ! (TREE_CODE (TYPE_MIN_VALUE (type)) == INTEGER_CST
5162                   && INT_CST_LT (c, TYPE_MIN_VALUE (type)))
5163             /* Unsigned ints with top bit set never fit signed types.  */
5164             && ! (TREE_INT_CST_HIGH (c) < 0
5165                   && TREE_UNSIGNED (TREE_TYPE (c))));
5166 }
5167
5168 /* Given a DECL or TYPE, return the scope in which it was declared, or
5169    NULL_TREE if there is no containing scope.  */
5170
5171 tree
5172 get_containing_scope (t)
5173      tree t;
5174 {
5175   return (TYPE_P (t) ? TYPE_CONTEXT (t) : DECL_CONTEXT (t));
5176 }
5177
5178 /* Return the innermost context enclosing DECL that is
5179    a FUNCTION_DECL, or zero if none.  */
5180
5181 tree
5182 decl_function_context (decl)
5183      tree decl;
5184 {
5185   tree context;
5186
5187   if (TREE_CODE (decl) == ERROR_MARK)
5188     return 0;
5189
5190   if (TREE_CODE (decl) == SAVE_EXPR)
5191     context = SAVE_EXPR_CONTEXT (decl);
5192
5193   /* C++ virtual functions use DECL_CONTEXT for the class of the vtable
5194      where we look up the function at runtime.  Such functions always take
5195      a first argument of type 'pointer to real context'.
5196
5197      C++ should really be fixed to use DECL_CONTEXT for the real context,
5198      and use something else for the "virtual context".  */
5199   else if (TREE_CODE (decl) == FUNCTION_DECL && DECL_VINDEX (decl))
5200     context
5201       = TYPE_MAIN_VARIANT
5202         (TREE_TYPE (TREE_VALUE (TYPE_ARG_TYPES (TREE_TYPE (decl)))));
5203   else
5204     context = DECL_CONTEXT (decl);
5205
5206   while (context && TREE_CODE (context) != FUNCTION_DECL)
5207     {
5208       if (TREE_CODE (context) == BLOCK)
5209         context = BLOCK_SUPERCONTEXT (context);
5210       else 
5211         context = get_containing_scope (context);
5212     }
5213
5214   return context;
5215 }
5216
5217 /* Return the innermost context enclosing DECL that is
5218    a RECORD_TYPE, UNION_TYPE or QUAL_UNION_TYPE, or zero if none.
5219    TYPE_DECLs and FUNCTION_DECLs are transparent to this function.  */
5220
5221 tree
5222 decl_type_context (decl)
5223      tree decl;
5224 {
5225   tree context = DECL_CONTEXT (decl);
5226
5227   while (context)
5228     {
5229       if (TREE_CODE (context) == RECORD_TYPE
5230           || TREE_CODE (context) == UNION_TYPE
5231           || TREE_CODE (context) == QUAL_UNION_TYPE)
5232         return context;
5233
5234       if (TREE_CODE (context) == TYPE_DECL
5235           || TREE_CODE (context) == FUNCTION_DECL)
5236         context = DECL_CONTEXT (context);
5237
5238       else if (TREE_CODE (context) == BLOCK)
5239         context = BLOCK_SUPERCONTEXT (context);
5240
5241       else
5242         /* Unhandled CONTEXT!?  */
5243         abort ();
5244     }
5245   return NULL_TREE;
5246 }
5247
5248 /* CALL is a CALL_EXPR.  Return the declaration for the function
5249    called, or NULL_TREE if the called function cannot be 
5250    determined.  */
5251
5252 tree
5253 get_callee_fndecl (call)
5254      tree call;
5255 {
5256   tree addr;
5257
5258   /* It's invalid to call this function with anything but a
5259      CALL_EXPR.  */
5260   if (TREE_CODE (call) != CALL_EXPR)
5261     abort ();
5262
5263   /* The first operand to the CALL is the address of the function
5264      called.  */
5265   addr = TREE_OPERAND (call, 0);
5266
5267   STRIP_NOPS (addr);
5268
5269   /* If this is a readonly function pointer, extract its initial value.  */
5270   if (DECL_P (addr) && TREE_CODE (addr) != FUNCTION_DECL
5271       && TREE_READONLY (addr) && ! TREE_THIS_VOLATILE (addr)
5272       && DECL_INITIAL (addr))
5273     addr = DECL_INITIAL (addr);
5274
5275   /* If the address is just `&f' for some function `f', then we know
5276      that `f' is being called.  */
5277   if (TREE_CODE (addr) == ADDR_EXPR
5278       && TREE_CODE (TREE_OPERAND (addr, 0)) == FUNCTION_DECL)
5279     return TREE_OPERAND (addr, 0);
5280
5281   /* We couldn't figure out what was being called.  */
5282   return NULL_TREE;
5283 }
5284
5285 /* Print debugging information about the obstack O, named STR.  */
5286
5287 void
5288 print_obstack_statistics (str, o)
5289      const char *str;
5290      struct obstack *o;
5291 {
5292   struct _obstack_chunk *chunk = o->chunk;
5293   int n_chunks = 1;
5294   int n_alloc = 0;
5295
5296   n_alloc += o->next_free - chunk->contents;
5297   chunk = chunk->prev;
5298   while (chunk)
5299     {
5300       n_chunks += 1;
5301       n_alloc += chunk->limit - &chunk->contents[0];
5302       chunk = chunk->prev;
5303     }
5304   fprintf (stderr, "obstack %s: %u bytes, %d chunks\n",
5305            str, n_alloc, n_chunks);
5306 }
5307
5308 /* Print debugging information about tree nodes generated during the compile,
5309    and any language-specific information.  */
5310
5311 void
5312 dump_tree_statistics ()
5313 {
5314 #ifdef GATHER_STATISTICS
5315   int i;
5316   int total_nodes, total_bytes;
5317 #endif
5318
5319   fprintf (stderr, "\n??? tree nodes created\n\n");
5320 #ifdef GATHER_STATISTICS
5321   fprintf (stderr, "Kind                  Nodes     Bytes\n");
5322   fprintf (stderr, "-------------------------------------\n");
5323   total_nodes = total_bytes = 0;
5324   for (i = 0; i < (int) all_kinds; i++)
5325     {
5326       fprintf (stderr, "%-20s %6d %9d\n", tree_node_kind_names[i],
5327                tree_node_counts[i], tree_node_sizes[i]);
5328       total_nodes += tree_node_counts[i];
5329       total_bytes += tree_node_sizes[i];
5330     }
5331   fprintf (stderr, "%-20s        %9d\n", "identifier names", id_string_size);
5332   fprintf (stderr, "-------------------------------------\n");
5333   fprintf (stderr, "%-20s %6d %9d\n", "Total", total_nodes, total_bytes);
5334   fprintf (stderr, "-------------------------------------\n");
5335 #else
5336   fprintf (stderr, "(No per-node statistics)\n");
5337 #endif
5338   print_obstack_statistics ("permanent_obstack", &permanent_obstack);
5339   print_obstack_statistics ("maybepermanent_obstack", &maybepermanent_obstack);
5340   print_obstack_statistics ("temporary_obstack", &temporary_obstack);
5341   print_obstack_statistics ("momentary_obstack", &momentary_obstack);
5342   print_obstack_statistics ("temp_decl_obstack", &temp_decl_obstack);
5343   print_type_hash_statistics ();
5344   print_lang_statistics ();
5345 }
5346 \f
5347 #define FILE_FUNCTION_PREFIX_LEN 9
5348
5349 #ifndef NO_DOLLAR_IN_LABEL
5350 #define FILE_FUNCTION_FORMAT "_GLOBAL_$%s$%s"
5351 #else /* NO_DOLLAR_IN_LABEL */
5352 #ifndef NO_DOT_IN_LABEL
5353 #define FILE_FUNCTION_FORMAT "_GLOBAL_.%s.%s"
5354 #else /* NO_DOT_IN_LABEL */
5355 #define FILE_FUNCTION_FORMAT "_GLOBAL__%s_%s"
5356 #endif  /* NO_DOT_IN_LABEL */
5357 #endif  /* NO_DOLLAR_IN_LABEL */
5358
5359 /* Appends 6 random characters to TEMPLATE to (hopefully) avoid name
5360    clashes in cases where we can't reliably choose a unique name.
5361
5362    Derived from mkstemp.c in libiberty.  */
5363
5364 static void
5365 append_random_chars (template)
5366      char *template;
5367 {
5368   static const char letters[]
5369     = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";
5370   static unsigned HOST_WIDE_INT value;
5371   unsigned HOST_WIDE_INT v;
5372
5373 #ifdef HAVE_GETTIMEOFDAY
5374   struct timeval tv;
5375 #endif
5376
5377   template += strlen (template);
5378
5379 #ifdef HAVE_GETTIMEOFDAY
5380   /* Get some more or less random data.  */
5381   gettimeofday (&tv, NULL);
5382   value += ((unsigned HOST_WIDE_INT) tv.tv_usec << 16) ^ tv.tv_sec ^ getpid ();
5383 #else
5384   value += getpid ();
5385 #endif
5386
5387   v = value;
5388
5389   /* Fill in the random bits.  */
5390   template[0] = letters[v % 62];
5391   v /= 62;
5392   template[1] = letters[v % 62];
5393   v /= 62;
5394   template[2] = letters[v % 62];
5395   v /= 62;
5396   template[3] = letters[v % 62];
5397   v /= 62;
5398   template[4] = letters[v % 62];
5399   v /= 62;
5400   template[5] = letters[v % 62];
5401
5402   template[6] = '\0';
5403 }
5404
5405 /* Generate a name for a function unique to this translation unit.
5406    TYPE is some string to identify the purpose of this function to the
5407    linker or collect2.  */
5408
5409 tree
5410 get_file_function_name_long (type)
5411      const char *type;
5412 {
5413   char *buf;
5414   const char *p;
5415   char *q;
5416
5417   if (first_global_object_name)
5418     p = first_global_object_name;
5419   else
5420     {
5421       /* We don't have anything that we know to be unique to this translation
5422          unit, so use what we do have and throw in some randomness.  */
5423
5424       const char *name = weak_global_object_name;
5425       const char *file = main_input_filename;
5426
5427       if (! name)
5428         name = "";
5429       if (! file)
5430         file = input_filename;
5431
5432       q = (char *) alloca (7 + strlen (name) + strlen (file));
5433
5434       sprintf (q, "%s%s", name, file);
5435       append_random_chars (q);
5436       p = q;
5437     }
5438
5439   buf = (char *) alloca (sizeof (FILE_FUNCTION_FORMAT) + strlen (p)
5440                          + strlen (type));
5441
5442   /* Set up the name of the file-level functions we may need. 
5443      Use a global object (which is already required to be unique over
5444      the program) rather than the file name (which imposes extra
5445      constraints).  */
5446   sprintf (buf, FILE_FUNCTION_FORMAT, type, p);
5447
5448   /* Don't need to pull weird characters out of global names.  */
5449   if (p != first_global_object_name)
5450     {
5451       for (q = buf+11; *q; q++)
5452         if (! ( ISDIGIT(*q)
5453 #ifndef NO_DOLLAR_IN_LABEL      /* this for `$'; unlikely, but... -- kr */
5454                || *q == '$'
5455 #endif
5456 #ifndef NO_DOT_IN_LABEL         /* this for `.'; unlikely, but...  */
5457                || *q == '.'
5458 #endif
5459                || ISUPPER(*q)
5460                || ISLOWER(*q)))
5461           *q = '_';
5462     }
5463
5464   return get_identifier (buf);
5465 }
5466
5467 /* If KIND=='I', return a suitable global initializer (constructor) name.
5468    If KIND=='D', return a suitable global clean-up (destructor) name.  */
5469
5470 tree
5471 get_file_function_name (kind)
5472      int kind;
5473 {
5474   char p[2];
5475
5476   p[0] = kind;
5477   p[1] = 0;
5478
5479   return get_file_function_name_long (p);
5480 }
5481 \f
5482 /* Expand (the constant part of) a SET_TYPE CONSTRUCTOR node.
5483    The result is placed in BUFFER (which has length BIT_SIZE),
5484    with one bit in each char ('\000' or '\001').
5485
5486    If the constructor is constant, NULL_TREE is returned.
5487    Otherwise, a TREE_LIST of the non-constant elements is emitted.  */
5488
5489 tree
5490 get_set_constructor_bits (init, buffer, bit_size)
5491      tree init;
5492      char *buffer;
5493      int bit_size;
5494 {
5495   int i;
5496   tree vals;
5497   HOST_WIDE_INT domain_min
5498     = TREE_INT_CST_LOW (TYPE_MIN_VALUE (TYPE_DOMAIN (TREE_TYPE (init))));
5499   tree non_const_bits = NULL_TREE;
5500   for (i = 0; i < bit_size; i++)
5501     buffer[i] = 0;
5502
5503   for (vals = TREE_OPERAND (init, 1); 
5504        vals != NULL_TREE; vals = TREE_CHAIN (vals))
5505     {
5506       if (TREE_CODE (TREE_VALUE (vals)) != INTEGER_CST
5507           || (TREE_PURPOSE (vals) != NULL_TREE
5508               && TREE_CODE (TREE_PURPOSE (vals)) != INTEGER_CST))
5509         non_const_bits
5510           = tree_cons (TREE_PURPOSE (vals), TREE_VALUE (vals), non_const_bits);
5511       else if (TREE_PURPOSE (vals) != NULL_TREE)
5512         {
5513           /* Set a range of bits to ones.  */
5514           HOST_WIDE_INT lo_index
5515             = TREE_INT_CST_LOW (TREE_PURPOSE (vals)) - domain_min;
5516           HOST_WIDE_INT hi_index
5517             = TREE_INT_CST_LOW (TREE_VALUE (vals)) - domain_min;
5518
5519           if (lo_index < 0 || lo_index >= bit_size
5520             || hi_index < 0 || hi_index >= bit_size)
5521             abort ();
5522           for ( ; lo_index <= hi_index; lo_index++)
5523             buffer[lo_index] = 1;
5524         }
5525       else
5526         {
5527           /* Set a single bit to one.  */
5528           HOST_WIDE_INT index
5529             = TREE_INT_CST_LOW (TREE_VALUE (vals)) - domain_min;
5530           if (index < 0 || index >= bit_size)
5531             {
5532               error ("invalid initializer for bit string");
5533               return NULL_TREE;
5534             }
5535           buffer[index] = 1;
5536         }
5537     }
5538   return non_const_bits;
5539 }
5540
5541 /* Expand (the constant part of) a SET_TYPE CONSTRUCTOR node.
5542    The result is placed in BUFFER (which is an array of bytes).
5543    If the constructor is constant, NULL_TREE is returned.
5544    Otherwise, a TREE_LIST of the non-constant elements is emitted.  */
5545
5546 tree
5547 get_set_constructor_bytes (init, buffer, wd_size)
5548      tree init;
5549      unsigned char *buffer;
5550      int wd_size;
5551 {
5552   int i;
5553   int set_word_size = BITS_PER_UNIT;
5554   int bit_size = wd_size * set_word_size;
5555   int bit_pos = 0;
5556   unsigned char *bytep = buffer;
5557   char *bit_buffer = (char *) alloca(bit_size);
5558   tree non_const_bits = get_set_constructor_bits (init, bit_buffer, bit_size);
5559
5560   for (i = 0; i < wd_size; i++)
5561     buffer[i] = 0;
5562
5563   for (i = 0; i < bit_size; i++)
5564     {
5565       if (bit_buffer[i])
5566         {
5567           if (BYTES_BIG_ENDIAN)
5568             *bytep |= (1 << (set_word_size - 1 - bit_pos));
5569           else
5570             *bytep |= 1 << bit_pos;
5571         }
5572       bit_pos++;
5573       if (bit_pos >= set_word_size)
5574         bit_pos = 0, bytep++;
5575     }
5576   return non_const_bits;
5577 }
5578 \f
5579 #if defined ENABLE_TREE_CHECKING && (GCC_VERSION >= 2007)
5580 /* Complain that the tree code of NODE does not match the expected CODE.
5581    FILE, LINE, and FUNCTION are of the caller.  */
5582 void
5583 tree_check_failed (node, code, file, line, function)
5584      const tree node;
5585      enum tree_code code;
5586      const char *file;
5587      int line;
5588      const char *function;
5589 {
5590   error ("Tree check: expected %s, have %s",
5591          tree_code_name[code], tree_code_name[TREE_CODE (node)]);
5592   fancy_abort (file, line, function);
5593 }
5594
5595 /* Similar to above, except that we check for a class of tree
5596    code, given in CL.  */
5597 void
5598 tree_class_check_failed (node, cl, file, line, function)
5599      const tree node;
5600      char cl;
5601      const char *file;
5602      int line;
5603      const char *function;
5604 {
5605   error ("Tree check: expected class '%c', have '%c' (%s)",
5606          cl, TREE_CODE_CLASS (TREE_CODE (node)),
5607          tree_code_name[TREE_CODE (node)]);
5608   fancy_abort (file, line, function);
5609 }
5610
5611 #endif /* ENABLE_TREE_CHECKING */
5612
5613 \f
5614 #ifndef CHAR_TYPE_SIZE
5615 #define CHAR_TYPE_SIZE BITS_PER_UNIT
5616 #endif
5617
5618 #ifndef SHORT_TYPE_SIZE
5619 #define SHORT_TYPE_SIZE (BITS_PER_UNIT * MIN ((UNITS_PER_WORD + 1) / 2, 2))
5620 #endif
5621
5622 #ifndef INT_TYPE_SIZE
5623 #define INT_TYPE_SIZE BITS_PER_WORD
5624 #endif
5625
5626 #ifndef LONG_TYPE_SIZE
5627 #define LONG_TYPE_SIZE BITS_PER_WORD
5628 #endif
5629
5630 #ifndef LONG_LONG_TYPE_SIZE
5631 #define LONG_LONG_TYPE_SIZE (BITS_PER_WORD * 2)
5632 #endif
5633
5634 #ifndef FLOAT_TYPE_SIZE
5635 #define FLOAT_TYPE_SIZE BITS_PER_WORD
5636 #endif
5637
5638 #ifndef DOUBLE_TYPE_SIZE
5639 #define DOUBLE_TYPE_SIZE (BITS_PER_WORD * 2)
5640 #endif
5641
5642 #ifndef LONG_DOUBLE_TYPE_SIZE
5643 #define LONG_DOUBLE_TYPE_SIZE (BITS_PER_WORD * 2)
5644 #endif
5645
5646 /* Create nodes for all integer types (and error_mark_node) using the sizes
5647    of C datatypes.  The caller should call set_sizetype soon after calling
5648    this function to select one of the types as sizetype.  */
5649    
5650 void
5651 build_common_tree_nodes (signed_char)
5652      int signed_char;
5653 {
5654   error_mark_node = make_node (ERROR_MARK);
5655   TREE_TYPE (error_mark_node) = error_mark_node;
5656
5657   initialize_sizetypes ();
5658
5659   /* Define both `signed char' and `unsigned char'.  */
5660   signed_char_type_node = make_signed_type (CHAR_TYPE_SIZE);
5661   unsigned_char_type_node = make_unsigned_type (CHAR_TYPE_SIZE);
5662
5663   /* Define `char', which is like either `signed char' or `unsigned char'
5664      but not the same as either.  */
5665   char_type_node
5666     = (signed_char
5667        ? make_signed_type (CHAR_TYPE_SIZE)
5668        : make_unsigned_type (CHAR_TYPE_SIZE));
5669
5670   short_integer_type_node = make_signed_type (SHORT_TYPE_SIZE);
5671   short_unsigned_type_node = make_unsigned_type (SHORT_TYPE_SIZE);
5672   integer_type_node = make_signed_type (INT_TYPE_SIZE);
5673   unsigned_type_node = make_unsigned_type (INT_TYPE_SIZE);
5674   long_integer_type_node = make_signed_type (LONG_TYPE_SIZE);
5675   long_unsigned_type_node = make_unsigned_type (LONG_TYPE_SIZE);
5676   long_long_integer_type_node = make_signed_type (LONG_LONG_TYPE_SIZE);
5677   long_long_unsigned_type_node = make_unsigned_type (LONG_LONG_TYPE_SIZE);
5678
5679   intQI_type_node = make_signed_type (GET_MODE_BITSIZE (QImode));
5680   intHI_type_node = make_signed_type (GET_MODE_BITSIZE (HImode));
5681   intSI_type_node = make_signed_type (GET_MODE_BITSIZE (SImode));
5682   intDI_type_node = make_signed_type (GET_MODE_BITSIZE (DImode));
5683 #if HOST_BITS_PER_WIDE_INT >= 64
5684   intTI_type_node = make_signed_type (GET_MODE_BITSIZE (TImode));
5685 #endif
5686
5687   unsigned_intQI_type_node = make_unsigned_type (GET_MODE_BITSIZE (QImode));
5688   unsigned_intHI_type_node = make_unsigned_type (GET_MODE_BITSIZE (HImode));
5689   unsigned_intSI_type_node = make_unsigned_type (GET_MODE_BITSIZE (SImode));
5690   unsigned_intDI_type_node = make_unsigned_type (GET_MODE_BITSIZE (DImode));
5691 #if HOST_BITS_PER_WIDE_INT >= 64
5692   unsigned_intTI_type_node = make_unsigned_type (GET_MODE_BITSIZE (TImode));
5693 #endif
5694 }
5695
5696 /* Call this function after calling build_common_tree_nodes and set_sizetype.
5697    It will create several other common tree nodes.  */
5698
5699 void
5700 build_common_tree_nodes_2 (short_double)
5701      int short_double;
5702 {
5703   /* Define these next since types below may used them.  */
5704   integer_zero_node = build_int_2 (0, 0);
5705   integer_one_node = build_int_2 (1, 0);
5706
5707   size_zero_node = size_int (0);
5708   size_one_node = size_int (1);
5709   bitsize_zero_node = bitsize_int (0);
5710   bitsize_one_node = bitsize_int (1);
5711   bitsize_unit_node = bitsize_int (BITS_PER_UNIT);
5712
5713   void_type_node = make_node (VOID_TYPE);
5714   layout_type (void_type_node);
5715
5716   /* We are not going to have real types in C with less than byte alignment,
5717      so we might as well not have any types that claim to have it.  */
5718   TYPE_ALIGN (void_type_node) = BITS_PER_UNIT;
5719
5720   null_pointer_node = build_int_2 (0, 0);
5721   TREE_TYPE (null_pointer_node) = build_pointer_type (void_type_node);
5722   layout_type (TREE_TYPE (null_pointer_node));
5723
5724   ptr_type_node = build_pointer_type (void_type_node);
5725   const_ptr_type_node
5726     = build_pointer_type (build_type_variant (void_type_node, 1, 0));
5727
5728   float_type_node = make_node (REAL_TYPE);
5729   TYPE_PRECISION (float_type_node) = FLOAT_TYPE_SIZE;
5730   layout_type (float_type_node);
5731
5732   double_type_node = make_node (REAL_TYPE);
5733   if (short_double)
5734     TYPE_PRECISION (double_type_node) = FLOAT_TYPE_SIZE;
5735   else
5736     TYPE_PRECISION (double_type_node) = DOUBLE_TYPE_SIZE;
5737   layout_type (double_type_node);
5738
5739   long_double_type_node = make_node (REAL_TYPE);
5740   TYPE_PRECISION (long_double_type_node) = LONG_DOUBLE_TYPE_SIZE;
5741   layout_type (long_double_type_node);
5742
5743   complex_integer_type_node = make_node (COMPLEX_TYPE);
5744   TREE_TYPE (complex_integer_type_node) = integer_type_node;
5745   layout_type (complex_integer_type_node);
5746
5747   complex_float_type_node = make_node (COMPLEX_TYPE);
5748   TREE_TYPE (complex_float_type_node) = float_type_node;
5749   layout_type (complex_float_type_node);
5750
5751   complex_double_type_node = make_node (COMPLEX_TYPE);
5752   TREE_TYPE (complex_double_type_node) = double_type_node;
5753   layout_type (complex_double_type_node);
5754
5755   complex_long_double_type_node = make_node (COMPLEX_TYPE);
5756   TREE_TYPE (complex_long_double_type_node) = long_double_type_node;
5757   layout_type (complex_long_double_type_node);
5758
5759 #ifdef BUILD_VA_LIST_TYPE
5760   BUILD_VA_LIST_TYPE(va_list_type_node);
5761 #else
5762   va_list_type_node = ptr_type_node;
5763 #endif
5764 }