OSDN Git Service

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