OSDN Git Service

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