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