OSDN Git Service

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