OSDN Git Service

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