OSDN Git Service

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