OSDN Git Service

* collect2.c (find_a_file): Use HAVE_DOS_BASED_FILE_SYSTEM in place
[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       for (t2 = op2; t2; t2 = TREE_CHAIN (t2))
1960         if (t2 == t1)
1961           abort ();  /* Circularity created.  */
1962       return op1;
1963     }
1964   else return op2;
1965 }
1966
1967 /* Return the last node in a chain of nodes (chained through TREE_CHAIN).  */
1968
1969 tree
1970 tree_last (chain)
1971      register tree chain;
1972 {
1973   register tree next;
1974   if (chain)
1975     while ((next = TREE_CHAIN (chain)))
1976       chain = next;
1977   return chain;
1978 }
1979
1980 /* Reverse the order of elements in the chain T,
1981    and return the new head of the chain (old last element).  */
1982
1983 tree
1984 nreverse (t)
1985      tree t;
1986 {
1987   register tree prev = 0, decl, next;
1988   for (decl = t; decl; decl = next)
1989     {
1990       next = TREE_CHAIN (decl);
1991       TREE_CHAIN (decl) = prev;
1992       prev = decl;
1993     }
1994   return prev;
1995 }
1996
1997 /* Given a chain CHAIN of tree nodes,
1998    construct and return a list of those nodes.  */
1999
2000 tree
2001 listify (chain)
2002      tree chain;
2003 {
2004   tree result = NULL_TREE;
2005   tree in_tail = chain;
2006   tree out_tail = NULL_TREE;
2007
2008   while (in_tail)
2009     {
2010       tree next = tree_cons (NULL_TREE, in_tail, NULL_TREE);
2011       if (out_tail)
2012         TREE_CHAIN (out_tail) = next;
2013       else
2014         result = next;
2015       out_tail = next;
2016       in_tail = TREE_CHAIN (in_tail);
2017     }
2018
2019   return result;
2020 }
2021 \f
2022 /* Return a newly created TREE_LIST node whose
2023    purpose and value fields are PARM and VALUE.  */
2024
2025 tree
2026 build_tree_list (parm, value)
2027      tree parm, value;
2028 {
2029   register tree t = make_node (TREE_LIST);
2030   TREE_PURPOSE (t) = parm;
2031   TREE_VALUE (t) = value;
2032   return t;
2033 }
2034
2035 /* Similar, but build on the temp_decl_obstack.  */
2036
2037 tree
2038 build_decl_list (parm, value)
2039      tree parm, value;
2040 {
2041   register tree node;
2042   register struct obstack *ambient_obstack = current_obstack;
2043   current_obstack = &temp_decl_obstack;
2044   node = build_tree_list (parm, value);
2045   current_obstack = ambient_obstack;
2046   return node;
2047 }
2048
2049 /* Similar, but build on the expression_obstack.  */
2050
2051 tree
2052 build_expr_list (parm, value)
2053      tree parm, value;
2054 {
2055   register tree node;
2056   register struct obstack *ambient_obstack = current_obstack;
2057   current_obstack = expression_obstack;
2058   node = build_tree_list (parm, value);
2059   current_obstack = ambient_obstack;
2060   return node;
2061 }
2062
2063 /* Return a newly created TREE_LIST node whose
2064    purpose and value fields are PARM and VALUE
2065    and whose TREE_CHAIN is CHAIN.  */
2066
2067 tree
2068 tree_cons (purpose, value, chain)
2069      tree purpose, value, chain;
2070 {
2071 #if 0
2072   register tree node = make_node (TREE_LIST);
2073 #else
2074   register int i;
2075   register tree node = (tree) obstack_alloc (current_obstack, sizeof (struct tree_list));
2076 #ifdef GATHER_STATISTICS
2077   tree_node_counts[(int)x_kind]++;
2078   tree_node_sizes[(int)x_kind] += sizeof (struct tree_list);
2079 #endif
2080
2081   for (i = (sizeof (struct tree_common) / sizeof (int)) - 1; i >= 0; i--)
2082     ((int *) node)[i] = 0;
2083
2084   TREE_SET_CODE (node, TREE_LIST);
2085   if (current_obstack == &permanent_obstack)
2086     TREE_PERMANENT (node) = 1;
2087 #endif
2088
2089   TREE_CHAIN (node) = chain;
2090   TREE_PURPOSE (node) = purpose;
2091   TREE_VALUE (node) = value;
2092   return node;
2093 }
2094
2095 /* Similar, but build on the temp_decl_obstack.  */
2096
2097 tree
2098 decl_tree_cons (purpose, value, chain)
2099      tree purpose, value, chain;
2100 {
2101   register tree node;
2102   register struct obstack *ambient_obstack = current_obstack;
2103   current_obstack = &temp_decl_obstack;
2104   node = tree_cons (purpose, value, chain);
2105   current_obstack = ambient_obstack;
2106   return node;
2107 }
2108
2109 /* Similar, but build on the expression_obstack.  */
2110
2111 tree
2112 expr_tree_cons (purpose, value, chain)
2113      tree purpose, value, chain;
2114 {
2115   register tree node;
2116   register struct obstack *ambient_obstack = current_obstack;
2117   current_obstack = expression_obstack;
2118   node = tree_cons (purpose, value, chain);
2119   current_obstack = ambient_obstack;
2120   return node;
2121 }
2122
2123 /* Same as `tree_cons' but make a permanent object.  */
2124
2125 tree
2126 perm_tree_cons (purpose, value, chain)
2127      tree purpose, value, chain;
2128 {
2129   register tree node;
2130   register struct obstack *ambient_obstack = current_obstack;
2131   current_obstack = &permanent_obstack;
2132
2133   node = tree_cons (purpose, value, chain);
2134   current_obstack = ambient_obstack;
2135   return node;
2136 }
2137
2138 /* Same as `tree_cons', but make this node temporary, regardless.  */
2139
2140 tree
2141 temp_tree_cons (purpose, value, chain)
2142      tree purpose, value, chain;
2143 {
2144   register tree node;
2145   register struct obstack *ambient_obstack = current_obstack;
2146   current_obstack = &temporary_obstack;
2147
2148   node = tree_cons (purpose, value, chain);
2149   current_obstack = ambient_obstack;
2150   return node;
2151 }
2152
2153 /* Same as `tree_cons', but save this node if the function's RTL is saved.  */
2154
2155 tree
2156 saveable_tree_cons (purpose, value, chain)
2157      tree purpose, value, chain;
2158 {
2159   register tree node;
2160   register struct obstack *ambient_obstack = current_obstack;
2161   current_obstack = saveable_obstack;
2162
2163   node = tree_cons (purpose, value, chain);
2164   current_obstack = ambient_obstack;
2165   return node;
2166 }
2167 \f
2168 /* Return the size nominally occupied by an object of type TYPE
2169    when it resides in memory.  The value is measured in units of bytes,
2170    and its data type is that normally used for type sizes
2171    (which is the first type created by make_signed_type or
2172    make_unsigned_type).  */
2173
2174 tree
2175 size_in_bytes (type)
2176      tree type;
2177 {
2178   tree t;
2179
2180   if (type == error_mark_node)
2181     return integer_zero_node;
2182
2183   type = TYPE_MAIN_VARIANT (type);
2184   t = TYPE_SIZE_UNIT (type);
2185   if (t == 0)
2186     {
2187       incomplete_type_error (NULL_TREE, type);
2188       return integer_zero_node;
2189     }
2190   if (TREE_CODE (t) == INTEGER_CST)
2191     force_fit_type (t, 0);
2192
2193   return t;
2194 }
2195
2196 /* Return the size of TYPE (in bytes) as a wide integer
2197    or return -1 if the size can vary or is larger than an integer.  */
2198
2199 HOST_WIDE_INT
2200 int_size_in_bytes (type)
2201      tree type;
2202 {
2203   tree t;
2204
2205   if (type == error_mark_node)
2206     return 0;
2207
2208   type = TYPE_MAIN_VARIANT (type);
2209   t = TYPE_SIZE_UNIT (type);
2210   if (t == 0
2211       || TREE_CODE (t) != INTEGER_CST
2212       || TREE_INT_CST_HIGH (t) != 0)
2213     return -1;
2214
2215   return TREE_INT_CST_LOW (t);
2216 }
2217 \f
2218 /* Return, as a tree node, the number of elements for TYPE (which is an
2219    ARRAY_TYPE) minus one. This counts only elements of the top array.
2220
2221    Don't let any SAVE_EXPRs escape; if we are called as part of a cleanup
2222    action, they would get unsaved.  */
2223
2224 tree
2225 array_type_nelts (type)
2226      tree type;
2227 {
2228   tree index_type, min, max;
2229
2230   /* If they did it with unspecified bounds, then we should have already
2231      given an error about it before we got here.  */
2232   if (! TYPE_DOMAIN (type))
2233     return error_mark_node;
2234
2235   index_type = TYPE_DOMAIN (type);
2236   min = TYPE_MIN_VALUE (index_type);
2237   max = TYPE_MAX_VALUE (index_type);
2238
2239   if (! TREE_CONSTANT (min))
2240     {
2241       STRIP_NOPS (min);
2242       if (TREE_CODE (min) == SAVE_EXPR)
2243         min = build (RTL_EXPR, TREE_TYPE (TYPE_MIN_VALUE (index_type)), 0,
2244                      SAVE_EXPR_RTL (min));
2245       else
2246         min = TYPE_MIN_VALUE (index_type);
2247     }
2248
2249   if (! TREE_CONSTANT (max))
2250     {
2251       STRIP_NOPS (max);
2252       if (TREE_CODE (max) == SAVE_EXPR)
2253         max = build (RTL_EXPR, TREE_TYPE (TYPE_MAX_VALUE (index_type)), 0,
2254                      SAVE_EXPR_RTL (max));
2255       else
2256         max = TYPE_MAX_VALUE (index_type);
2257     }
2258
2259   return (integer_zerop (min)
2260           ? max
2261           : fold (build (MINUS_EXPR, TREE_TYPE (max), max, min)));
2262 }
2263 \f
2264 /* Return nonzero if arg is static -- a reference to an object in
2265    static storage.  This is not the same as the C meaning of `static'.  */
2266
2267 int
2268 staticp (arg)
2269      tree arg;
2270 {
2271   switch (TREE_CODE (arg))
2272     {
2273     case FUNCTION_DECL:
2274       /* Nested functions aren't static, since taking their address
2275          involves a trampoline.  */
2276        return (decl_function_context (arg) == 0 || DECL_NO_STATIC_CHAIN (arg))
2277               && ! DECL_NON_ADDR_CONST_P (arg);
2278
2279     case VAR_DECL:
2280       return (TREE_STATIC (arg) || DECL_EXTERNAL (arg))
2281              && ! DECL_NON_ADDR_CONST_P (arg);
2282
2283     case CONSTRUCTOR:
2284       return TREE_STATIC (arg);
2285
2286     case STRING_CST:
2287       return 1;
2288
2289       /* If we are referencing a bitfield, we can't evaluate an
2290          ADDR_EXPR at compile time and so it isn't a constant.  */
2291     case COMPONENT_REF:
2292       return (! DECL_BIT_FIELD (TREE_OPERAND (arg, 1))
2293               && staticp (TREE_OPERAND (arg, 0)));
2294
2295     case BIT_FIELD_REF:
2296       return 0;
2297
2298 #if 0
2299        /* This case is technically correct, but results in setting
2300           TREE_CONSTANT on ADDR_EXPRs that cannot be evaluated at
2301           compile time.  */
2302     case INDIRECT_REF:
2303       return TREE_CONSTANT (TREE_OPERAND (arg, 0));
2304 #endif
2305
2306     case ARRAY_REF:
2307       if (TREE_CODE (TYPE_SIZE (TREE_TYPE (arg))) == INTEGER_CST
2308           && TREE_CODE (TREE_OPERAND (arg, 1)) == INTEGER_CST)
2309         return staticp (TREE_OPERAND (arg, 0));
2310
2311     default:
2312       return 0;
2313     }
2314 }
2315 \f
2316 /* Wrap a SAVE_EXPR around EXPR, if appropriate.
2317    Do this to any expression which may be used in more than one place,
2318    but must be evaluated only once.
2319
2320    Normally, expand_expr would reevaluate the expression each time.
2321    Calling save_expr produces something that is evaluated and recorded
2322    the first time expand_expr is called on it.  Subsequent calls to
2323    expand_expr just reuse the recorded value.
2324
2325    The call to expand_expr that generates code that actually computes
2326    the value is the first call *at compile time*.  Subsequent calls
2327    *at compile time* generate code to use the saved value.
2328    This produces correct result provided that *at run time* control
2329    always flows through the insns made by the first expand_expr
2330    before reaching the other places where the save_expr was evaluated.
2331    You, the caller of save_expr, must make sure this is so.
2332
2333    Constants, and certain read-only nodes, are returned with no
2334    SAVE_EXPR because that is safe.  Expressions containing placeholders
2335    are not touched; see tree.def for an explanation of what these
2336    are used for.  */
2337
2338 tree
2339 save_expr (expr)
2340      tree expr;
2341 {
2342   register tree t = fold (expr);
2343
2344   /* We don't care about whether this can be used as an lvalue in this
2345      context.  */
2346   while (TREE_CODE (t) == NON_LVALUE_EXPR)
2347     t = TREE_OPERAND (t, 0);
2348
2349   /* If the tree evaluates to a constant, then we don't want to hide that
2350      fact (i.e. this allows further folding, and direct checks for constants).
2351      However, a read-only object that has side effects cannot be bypassed.
2352      Since it is no problem to reevaluate literals, we just return the 
2353      literal node.  */
2354
2355   if (TREE_CONSTANT (t) || (TREE_READONLY (t) && ! TREE_SIDE_EFFECTS (t))
2356       || TREE_CODE (t) == SAVE_EXPR || TREE_CODE (t) == ERROR_MARK)
2357     return t;
2358
2359   /* If T contains a PLACEHOLDER_EXPR, we must evaluate it each time, since
2360      it means that the size or offset of some field of an object depends on
2361      the value within another field.
2362
2363      Note that it must not be the case that T contains both a PLACEHOLDER_EXPR
2364      and some variable since it would then need to be both evaluated once and
2365      evaluated more than once.  Front-ends must assure this case cannot
2366      happen by surrounding any such subexpressions in their own SAVE_EXPR
2367      and forcing evaluation at the proper time.  */
2368   if (contains_placeholder_p (t))
2369     return t;
2370
2371   t = build (SAVE_EXPR, TREE_TYPE (expr), t, current_function_decl, NULL_TREE);
2372
2373   /* This expression might be placed ahead of a jump to ensure that the
2374      value was computed on both sides of the jump.  So make sure it isn't
2375      eliminated as dead.  */
2376   TREE_SIDE_EFFECTS (t) = 1;
2377   return t;
2378 }
2379
2380 /* Arrange for an expression to be expanded multiple independent
2381    times.  This is useful for cleanup actions, as the backend can
2382    expand them multiple times in different places.  */
2383
2384 tree
2385 unsave_expr (expr)
2386      tree expr;
2387 {
2388   tree t;
2389
2390   /* If this is already protected, no sense in protecting it again.  */
2391   if (TREE_CODE (expr) == UNSAVE_EXPR)
2392     return expr;
2393
2394   t = build1 (UNSAVE_EXPR, TREE_TYPE (expr), expr);
2395   TREE_SIDE_EFFECTS (t) = TREE_SIDE_EFFECTS (expr);
2396   return t;
2397 }
2398
2399 /* Returns the index of the first non-tree operand for CODE, or the number
2400    of operands if all are trees.  */
2401
2402 int
2403 first_rtl_op (code)
2404      enum tree_code code;
2405 {
2406   switch (code)
2407     {
2408     case SAVE_EXPR:
2409       return 2;
2410     case GOTO_SUBROUTINE_EXPR:
2411     case RTL_EXPR:
2412       return 0;
2413     case CALL_EXPR:
2414       return 2;
2415     case WITH_CLEANUP_EXPR:
2416       /* Should be defined to be 2.  */
2417       return 1;
2418     case METHOD_CALL_EXPR:
2419       return 3;
2420     default:
2421       return tree_code_length [(int) code];
2422     }
2423 }
2424
2425 /* Modify a tree in place so that all the evaluate only once things
2426    are cleared out.  Return the EXPR given.  */
2427
2428 tree
2429 unsave_expr_now (expr)
2430      tree expr;
2431 {
2432   enum tree_code code;
2433   register int i;
2434   int first_rtl;
2435
2436   if (expr == NULL_TREE)
2437     return expr;
2438
2439   code = TREE_CODE (expr);
2440   first_rtl = first_rtl_op (code);
2441   switch (code)
2442     {
2443     case SAVE_EXPR:
2444       SAVE_EXPR_RTL (expr) = 0;
2445       break;
2446
2447     case TARGET_EXPR:
2448       TREE_OPERAND (expr, 1) = TREE_OPERAND (expr, 3);
2449       TREE_OPERAND (expr, 3) = NULL_TREE;
2450       break;
2451       
2452     case RTL_EXPR:
2453       /* I don't yet know how to emit a sequence multiple times.  */
2454       if (RTL_EXPR_SEQUENCE (expr) != 0)
2455         abort ();
2456       break;
2457
2458     case CALL_EXPR:
2459       CALL_EXPR_RTL (expr) = 0;
2460       if (TREE_OPERAND (expr, 1)
2461           && TREE_CODE (TREE_OPERAND (expr, 1)) == TREE_LIST)
2462         {
2463           tree exp = TREE_OPERAND (expr, 1);
2464           while (exp)
2465             {
2466               unsave_expr_now (TREE_VALUE (exp));
2467               exp = TREE_CHAIN (exp);
2468             }
2469         }
2470       break;
2471
2472     default:
2473       break;
2474     }
2475
2476   switch (TREE_CODE_CLASS (code))
2477     {
2478     case 'c':  /* a constant */
2479     case 't':  /* a type node */
2480     case 'x':  /* something random, like an identifier or an ERROR_MARK.  */
2481     case 'd':  /* A decl node */
2482     case 'b':  /* A block node */
2483       return expr;
2484
2485     case 'e':  /* an expression */
2486     case 'r':  /* a reference */
2487     case 's':  /* an expression with side effects */
2488     case '<':  /* a comparison expression */
2489     case '2':  /* a binary arithmetic expression */
2490     case '1':  /* a unary arithmetic expression */
2491       for (i = first_rtl - 1; i >= 0; i--)
2492         unsave_expr_now (TREE_OPERAND (expr, i));
2493       return expr;
2494
2495     default:
2496       abort ();
2497     }
2498 }
2499 \f
2500 /* Return 1 if EXP contains a PLACEHOLDER_EXPR; i.e., if it represents a size
2501    or offset that depends on a field within a record.  */
2502
2503 int
2504 contains_placeholder_p (exp)
2505      tree exp;
2506 {
2507   register enum tree_code code = TREE_CODE (exp);
2508   int result;
2509
2510   /* If we have a WITH_RECORD_EXPR, it "cancels" any PLACEHOLDER_EXPR
2511      in it since it is supplying a value for it.  */
2512   if (code == WITH_RECORD_EXPR)
2513     return 0;
2514   else if (code == PLACEHOLDER_EXPR)
2515     return 1;
2516
2517   switch (TREE_CODE_CLASS (code))
2518     {
2519     case 'r':
2520       /* Don't look at any PLACEHOLDER_EXPRs that might be in index or bit
2521          position computations since they will be converted into a
2522          WITH_RECORD_EXPR involving the reference, which will assume
2523          here will be valid.  */
2524       return contains_placeholder_p (TREE_OPERAND (exp, 0));
2525
2526     case 'x':
2527       if (code == TREE_LIST)
2528         return (contains_placeholder_p (TREE_VALUE (exp))
2529                 || (TREE_CHAIN (exp) != 0
2530                     && contains_placeholder_p (TREE_CHAIN (exp))));
2531       break;
2532                                         
2533     case '1':
2534     case '2':  case '<':
2535     case 'e':
2536       switch (code)
2537         {
2538         case COMPOUND_EXPR:
2539           /* Ignoring the first operand isn't quite right, but works best. */
2540           return contains_placeholder_p (TREE_OPERAND (exp, 1));
2541
2542         case RTL_EXPR:
2543         case CONSTRUCTOR:
2544           return 0;
2545
2546         case COND_EXPR:
2547           return (contains_placeholder_p (TREE_OPERAND (exp, 0))
2548                   || contains_placeholder_p (TREE_OPERAND (exp, 1))
2549                   || contains_placeholder_p (TREE_OPERAND (exp, 2)));
2550
2551         case SAVE_EXPR:
2552           /* If we already know this doesn't have a placeholder, don't
2553              check again.  */
2554           if (SAVE_EXPR_NOPLACEHOLDER (exp) || SAVE_EXPR_RTL (exp) != 0)
2555             return 0;
2556
2557           SAVE_EXPR_NOPLACEHOLDER (exp) = 1;
2558           result = contains_placeholder_p (TREE_OPERAND (exp, 0));
2559           if (result)
2560             SAVE_EXPR_NOPLACEHOLDER (exp) = 0;
2561
2562           return result;
2563
2564         case CALL_EXPR:
2565           return (TREE_OPERAND (exp, 1) != 0
2566                   && contains_placeholder_p (TREE_OPERAND (exp, 1)));
2567
2568         default:
2569           break;
2570         }
2571
2572       switch (tree_code_length[(int) code])
2573         {
2574         case 1:
2575           return contains_placeholder_p (TREE_OPERAND (exp, 0));
2576         case 2:
2577           return (contains_placeholder_p (TREE_OPERAND (exp, 0))
2578                   || contains_placeholder_p (TREE_OPERAND (exp, 1)));
2579         default:
2580           return 0;
2581         }
2582
2583     default:
2584       return 0;
2585     }
2586   return 0;
2587 }
2588
2589 /* Return 1 if EXP contains any expressions that produce cleanups for an
2590    outer scope to deal with.  Used by fold.  */
2591
2592 int
2593 has_cleanups (exp)
2594      tree exp;
2595 {
2596   int i, nops, cmp;
2597
2598   if (! TREE_SIDE_EFFECTS (exp))
2599     return 0;
2600
2601   switch (TREE_CODE (exp))
2602     {
2603     case TARGET_EXPR:
2604     case GOTO_SUBROUTINE_EXPR:
2605     case WITH_CLEANUP_EXPR:
2606       return 1;
2607
2608     case CLEANUP_POINT_EXPR:
2609       return 0;
2610
2611     case CALL_EXPR:
2612       for (exp = TREE_OPERAND (exp, 1); exp; exp = TREE_CHAIN (exp))
2613         {
2614           cmp = has_cleanups (TREE_VALUE (exp));
2615           if (cmp)
2616             return cmp;
2617         }
2618       return 0;
2619
2620     default:
2621       break;
2622     }
2623
2624   /* This general rule works for most tree codes.  All exceptions should be
2625      handled above.  If this is a language-specific tree code, we can't
2626      trust what might be in the operand, so say we don't know
2627      the situation.  */
2628   if ((int) TREE_CODE (exp) >= (int) LAST_AND_UNUSED_TREE_CODE)
2629     return -1;
2630
2631   nops = first_rtl_op (TREE_CODE (exp));
2632   for (i = 0; i < nops; i++)
2633     if (TREE_OPERAND (exp, i) != 0)
2634       {
2635         int type = TREE_CODE_CLASS (TREE_CODE (TREE_OPERAND (exp, i)));
2636         if (type == 'e' || type == '<' || type == '1' || type == '2'
2637             || type == 'r' || type == 's')
2638           {
2639             cmp = has_cleanups (TREE_OPERAND (exp, i));
2640             if (cmp)
2641               return cmp;
2642           }
2643       }
2644
2645   return 0;
2646 }
2647 \f
2648 /* Given a tree EXP, a FIELD_DECL F, and a replacement value R,
2649    return a tree with all occurrences of references to F in a
2650    PLACEHOLDER_EXPR replaced by R.   Note that we assume here that EXP
2651    contains only arithmetic expressions or a CALL_EXPR with a
2652    PLACEHOLDER_EXPR occurring only in its arglist.  */
2653
2654 tree
2655 substitute_in_expr (exp, f, r)
2656      tree exp;
2657      tree f;
2658      tree r;
2659 {
2660   enum tree_code code = TREE_CODE (exp);
2661   tree op0, op1, op2;
2662   tree new;
2663   tree inner;
2664
2665   switch (TREE_CODE_CLASS (code))
2666     {
2667     case 'c':
2668     case 'd':
2669       return exp;
2670
2671     case 'x':
2672       if (code == PLACEHOLDER_EXPR)
2673         return exp;
2674       else if (code == TREE_LIST)
2675         {
2676           op0 = (TREE_CHAIN (exp) == 0
2677                  ? 0 : substitute_in_expr (TREE_CHAIN (exp), f, r));
2678           op1 = substitute_in_expr (TREE_VALUE (exp), f, r);
2679           if (op0 == TREE_CHAIN (exp) && op1 == TREE_VALUE (exp))
2680             return exp;
2681
2682           return tree_cons (TREE_PURPOSE (exp), op1, op0);
2683         }
2684
2685       abort ();
2686
2687     case '1':
2688     case '2':
2689     case '<':
2690     case 'e':
2691       switch (tree_code_length[(int) code])
2692         {
2693         case 1:
2694           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2695           if (op0 == TREE_OPERAND (exp, 0))
2696             return exp;
2697           
2698           new = fold (build1 (code, TREE_TYPE (exp), op0));
2699           break;
2700
2701         case 2:
2702           /* An RTL_EXPR cannot contain a PLACEHOLDER_EXPR; a CONSTRUCTOR
2703              could, but we don't support it.  */
2704           if (code == RTL_EXPR)
2705             return exp;
2706           else if (code == CONSTRUCTOR)
2707             abort ();
2708
2709           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2710           op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
2711           if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1))
2712             return exp;
2713
2714           new = fold (build (code, TREE_TYPE (exp), op0, op1));
2715           break;
2716
2717         case 3:
2718           /* It cannot be that anything inside a SAVE_EXPR contains a
2719              PLACEHOLDER_EXPR.  */
2720           if (code == SAVE_EXPR)
2721             return exp;
2722
2723           else if (code == CALL_EXPR)
2724             {
2725               op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
2726               if (op1 == TREE_OPERAND (exp, 1))
2727                 return exp;
2728
2729               return build (code, TREE_TYPE (exp),
2730                             TREE_OPERAND (exp, 0), op1, NULL_TREE);
2731             }
2732
2733           else if (code != COND_EXPR)
2734             abort ();
2735
2736           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2737           op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
2738           op2 = substitute_in_expr (TREE_OPERAND (exp, 2), f, r);
2739           if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1)
2740               && op2 == TREE_OPERAND (exp, 2))
2741             return exp;
2742
2743           new = fold (build (code, TREE_TYPE (exp), op0, op1, op2));
2744           break;
2745
2746         default:
2747           abort ();
2748         }
2749
2750       break;
2751
2752     case 'r':
2753       switch (code)
2754         {
2755         case COMPONENT_REF:
2756           /* If this expression is getting a value from a PLACEHOLDER_EXPR
2757              and it is the right field, replace it with R.  */
2758           for (inner = TREE_OPERAND (exp, 0);
2759                TREE_CODE_CLASS (TREE_CODE (inner)) == 'r';
2760                inner = TREE_OPERAND (inner, 0))
2761             ;
2762           if (TREE_CODE (inner) == PLACEHOLDER_EXPR
2763               && TREE_OPERAND (exp, 1) == f)
2764             return r;
2765
2766           /* If this expression hasn't been completed let, leave it 
2767              alone.  */
2768           if (TREE_CODE (inner) == PLACEHOLDER_EXPR
2769               && TREE_TYPE (inner) == 0)
2770             return exp;
2771
2772           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2773           if (op0 == TREE_OPERAND (exp, 0))
2774             return exp;
2775
2776           new = fold (build (code, TREE_TYPE (exp), op0,
2777                              TREE_OPERAND (exp, 1)));
2778           break;
2779
2780         case BIT_FIELD_REF:
2781           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2782           op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
2783           op2 = substitute_in_expr (TREE_OPERAND (exp, 2), f, r);
2784           if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1)
2785               && op2 == TREE_OPERAND (exp, 2))
2786             return exp;
2787
2788           new = fold (build (code, TREE_TYPE (exp), op0, op1, op2));
2789           break;
2790
2791         case INDIRECT_REF:
2792         case BUFFER_REF:
2793           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2794           if (op0 == TREE_OPERAND (exp, 0))
2795             return exp;
2796
2797           new = fold (build1 (code, TREE_TYPE (exp), op0));
2798           break;
2799
2800         default:
2801           abort ();
2802         }
2803       break;
2804       
2805     default:
2806       abort ();
2807     }
2808
2809   TREE_READONLY (new) = TREE_READONLY (exp);
2810   return new;
2811 }
2812 \f
2813 /* Stabilize a reference so that we can use it any number of times
2814    without causing its operands to be evaluated more than once.
2815    Returns the stabilized reference.  This works by means of save_expr,
2816    so see the caveats in the comments about save_expr.
2817
2818    Also allows conversion expressions whose operands are references.
2819    Any other kind of expression is returned unchanged.  */
2820
2821 tree
2822 stabilize_reference (ref)
2823      tree ref;
2824 {
2825   register tree result;
2826   register enum tree_code code = TREE_CODE (ref);
2827
2828   switch (code)
2829     {
2830     case VAR_DECL:
2831     case PARM_DECL:
2832     case RESULT_DECL:
2833       /* No action is needed in this case.  */
2834       return ref;
2835
2836     case NOP_EXPR:
2837     case CONVERT_EXPR:
2838     case FLOAT_EXPR:
2839     case FIX_TRUNC_EXPR:
2840     case FIX_FLOOR_EXPR:
2841     case FIX_ROUND_EXPR:
2842     case FIX_CEIL_EXPR:
2843       result = build_nt (code, stabilize_reference (TREE_OPERAND (ref, 0)));
2844       break;
2845
2846     case INDIRECT_REF:
2847       result = build_nt (INDIRECT_REF,
2848                          stabilize_reference_1 (TREE_OPERAND (ref, 0)));
2849       break;
2850
2851     case COMPONENT_REF:
2852       result = build_nt (COMPONENT_REF,
2853                          stabilize_reference (TREE_OPERAND (ref, 0)),
2854                          TREE_OPERAND (ref, 1));
2855       break;
2856
2857     case BIT_FIELD_REF:
2858       result = build_nt (BIT_FIELD_REF,
2859                          stabilize_reference (TREE_OPERAND (ref, 0)),
2860                          stabilize_reference_1 (TREE_OPERAND (ref, 1)),
2861                          stabilize_reference_1 (TREE_OPERAND (ref, 2)));
2862       break;
2863
2864     case ARRAY_REF:
2865       result = build_nt (ARRAY_REF,
2866                          stabilize_reference (TREE_OPERAND (ref, 0)),
2867                          stabilize_reference_1 (TREE_OPERAND (ref, 1)));
2868       break;
2869
2870     case COMPOUND_EXPR:
2871       /* We cannot wrap the first expression in a SAVE_EXPR, as then
2872          it wouldn't be ignored.  This matters when dealing with
2873          volatiles.  */
2874       return stabilize_reference_1 (ref);
2875
2876     case RTL_EXPR:
2877       result = build1 (INDIRECT_REF, TREE_TYPE (ref),
2878                        save_expr (build1 (ADDR_EXPR,
2879                                           build_pointer_type (TREE_TYPE (ref)),
2880                                           ref)));
2881       break;
2882
2883
2884       /* If arg isn't a kind of lvalue we recognize, make no change.
2885          Caller should recognize the error for an invalid lvalue.  */
2886     default:
2887       return ref;
2888
2889     case ERROR_MARK:
2890       return error_mark_node;
2891     }
2892
2893   TREE_TYPE (result) = TREE_TYPE (ref);
2894   TREE_READONLY (result) = TREE_READONLY (ref);
2895   TREE_SIDE_EFFECTS (result) = TREE_SIDE_EFFECTS (ref);
2896   TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
2897   TREE_RAISES (result) = TREE_RAISES (ref);
2898
2899   return result;
2900 }
2901
2902 /* Subroutine of stabilize_reference; this is called for subtrees of
2903    references.  Any expression with side-effects must be put in a SAVE_EXPR
2904    to ensure that it is only evaluated once.
2905
2906    We don't put SAVE_EXPR nodes around everything, because assigning very
2907    simple expressions to temporaries causes us to miss good opportunities
2908    for optimizations.  Among other things, the opportunity to fold in the
2909    addition of a constant into an addressing mode often gets lost, e.g.
2910    "y[i+1] += x;".  In general, we take the approach that we should not make
2911    an assignment unless we are forced into it - i.e., that any non-side effect
2912    operator should be allowed, and that cse should take care of coalescing
2913    multiple utterances of the same expression should that prove fruitful.  */
2914
2915 tree
2916 stabilize_reference_1 (e)
2917      tree e;
2918 {
2919   register tree result;
2920   register enum tree_code code = TREE_CODE (e);
2921
2922   /* We cannot ignore const expressions because it might be a reference
2923      to a const array but whose index contains side-effects.  But we can
2924      ignore things that are actual constant or that already have been
2925      handled by this function.  */
2926
2927   if (TREE_CONSTANT (e) || code == SAVE_EXPR)
2928     return e;
2929
2930   switch (TREE_CODE_CLASS (code))
2931     {
2932     case 'x':
2933     case 't':
2934     case 'd':
2935     case 'b':
2936     case '<':
2937     case 's':
2938     case 'e':
2939     case 'r':
2940       /* If the expression has side-effects, then encase it in a SAVE_EXPR
2941          so that it will only be evaluated once.  */
2942       /* The reference (r) and comparison (<) classes could be handled as
2943          below, but it is generally faster to only evaluate them once.  */
2944       if (TREE_SIDE_EFFECTS (e))
2945         return save_expr (e);
2946       return e;
2947
2948     case 'c':
2949       /* Constants need no processing.  In fact, we should never reach
2950          here.  */
2951       return e;
2952       
2953     case '2':
2954       /* Division is slow and tends to be compiled with jumps,
2955          especially the division by powers of 2 that is often
2956          found inside of an array reference.  So do it just once.  */
2957       if (code == TRUNC_DIV_EXPR || code == TRUNC_MOD_EXPR
2958           || code == FLOOR_DIV_EXPR || code == FLOOR_MOD_EXPR
2959           || code == CEIL_DIV_EXPR || code == CEIL_MOD_EXPR
2960           || code == ROUND_DIV_EXPR || code == ROUND_MOD_EXPR)
2961         return save_expr (e);
2962       /* Recursively stabilize each operand.  */
2963       result = build_nt (code, stabilize_reference_1 (TREE_OPERAND (e, 0)),
2964                          stabilize_reference_1 (TREE_OPERAND (e, 1)));
2965       break;
2966
2967     case '1':
2968       /* Recursively stabilize each operand.  */
2969       result = build_nt (code, stabilize_reference_1 (TREE_OPERAND (e, 0)));
2970       break;
2971
2972     default:
2973       abort ();
2974     }
2975   
2976   TREE_TYPE (result) = TREE_TYPE (e);
2977   TREE_READONLY (result) = TREE_READONLY (e);
2978   TREE_SIDE_EFFECTS (result) = TREE_SIDE_EFFECTS (e);
2979   TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
2980   TREE_RAISES (result) = TREE_RAISES (e);
2981
2982   return result;
2983 }
2984 \f
2985 /* Low-level constructors for expressions.  */
2986
2987 /* Build an expression of code CODE, data type TYPE,
2988    and operands as specified by the arguments ARG1 and following arguments.
2989    Expressions and reference nodes can be created this way.
2990    Constants, decls, types and misc nodes cannot be.  */
2991
2992 tree
2993 build VPROTO((enum tree_code code, tree tt, ...))
2994 {
2995 #ifndef ANSI_PROTOTYPES
2996   enum tree_code code;
2997   tree tt;
2998 #endif
2999   va_list p;
3000   register tree t;
3001   register int length;
3002   register int i;
3003
3004   VA_START (p, tt);
3005
3006 #ifndef ANSI_PROTOTYPES
3007   code = va_arg (p, enum tree_code);
3008   tt = va_arg (p, tree);
3009 #endif
3010
3011   t = make_node (code);
3012   length = tree_code_length[(int) code];
3013   TREE_TYPE (t) = tt;
3014
3015   if (length == 2)
3016     {
3017       /* This is equivalent to the loop below, but faster.  */
3018       register tree arg0 = va_arg (p, tree);
3019       register tree arg1 = va_arg (p, tree);
3020       TREE_OPERAND (t, 0) = arg0;
3021       TREE_OPERAND (t, 1) = arg1;
3022       if ((arg0 && TREE_SIDE_EFFECTS (arg0))
3023           || (arg1 && TREE_SIDE_EFFECTS (arg1)))
3024         TREE_SIDE_EFFECTS (t) = 1;
3025       TREE_RAISES (t)
3026         = (arg0 && TREE_RAISES (arg0)) || (arg1 && TREE_RAISES (arg1));
3027     }
3028   else if (length == 1)
3029     {
3030       register tree arg0 = va_arg (p, tree);
3031
3032       /* Call build1 for this!  */
3033       if (TREE_CODE_CLASS (code) != 's')
3034         abort ();
3035       TREE_OPERAND (t, 0) = arg0;
3036       if (arg0 && TREE_SIDE_EFFECTS (arg0))
3037         TREE_SIDE_EFFECTS (t) = 1;
3038       TREE_RAISES (t) = (arg0 && TREE_RAISES (arg0));
3039     }
3040   else
3041     {
3042       for (i = 0; i < length; i++)
3043         {
3044           register tree operand = va_arg (p, tree);
3045           TREE_OPERAND (t, i) = operand;
3046           if (operand)
3047             {
3048               if (TREE_SIDE_EFFECTS (operand))
3049                 TREE_SIDE_EFFECTS (t) = 1;
3050               if (TREE_RAISES (operand))
3051                 TREE_RAISES (t) = 1;
3052             }
3053         }
3054     }
3055   va_end (p);
3056   return t;
3057 }
3058
3059 /* Same as above, but only builds for unary operators.
3060    Saves lions share of calls to `build'; cuts down use
3061    of varargs, which is expensive for RISC machines.  */
3062
3063 tree
3064 build1 (code, type, node)
3065      enum tree_code code;
3066      tree type;
3067      tree node;
3068 {
3069   register struct obstack *obstack = expression_obstack;
3070   register int length;
3071 #ifdef GATHER_STATISTICS
3072   register tree_node_kind kind;
3073 #endif
3074   register tree t;
3075
3076 #ifdef GATHER_STATISTICS
3077   if (TREE_CODE_CLASS (code) == 'r')
3078     kind = r_kind;
3079   else
3080     kind = e_kind;
3081 #endif
3082
3083   length = sizeof (struct tree_exp);
3084
3085   t = (tree) obstack_alloc (obstack, length);
3086   bzero ((PTR) t, length);
3087
3088 #ifdef GATHER_STATISTICS
3089   tree_node_counts[(int)kind]++;
3090   tree_node_sizes[(int)kind] += length;
3091 #endif
3092
3093   TREE_TYPE (t) = type;
3094   TREE_SET_CODE (t, code);
3095
3096   if (obstack == &permanent_obstack)
3097     TREE_PERMANENT (t) = 1;
3098
3099   TREE_OPERAND (t, 0) = node;
3100   if (node)
3101     {
3102       if (TREE_SIDE_EFFECTS (node))
3103         TREE_SIDE_EFFECTS (t) = 1;
3104       if (TREE_RAISES (node))
3105         TREE_RAISES (t) = 1;
3106     }
3107
3108   return t;
3109 }
3110
3111 /* Similar except don't specify the TREE_TYPE
3112    and leave the TREE_SIDE_EFFECTS as 0.
3113    It is permissible for arguments to be null,
3114    or even garbage if their values do not matter.  */
3115
3116 tree
3117 build_nt VPROTO((enum tree_code code, ...))
3118 {
3119 #ifndef ANSI_PROTOTYPES
3120   enum tree_code code;
3121 #endif
3122   va_list p;
3123   register tree t;
3124   register int length;
3125   register int i;
3126
3127   VA_START (p, code);
3128
3129 #ifndef ANSI_PROTOTYPES
3130   code = va_arg (p, enum tree_code);
3131 #endif
3132
3133   t = make_node (code);
3134   length = tree_code_length[(int) code];
3135
3136   for (i = 0; i < length; i++)
3137     TREE_OPERAND (t, i) = va_arg (p, tree);
3138
3139   va_end (p);
3140   return t;
3141 }
3142
3143 /* Similar to `build_nt', except we build
3144    on the temp_decl_obstack, regardless.  */
3145
3146 tree
3147 build_parse_node VPROTO((enum tree_code code, ...))
3148 {
3149 #ifndef ANSI_PROTOTYPES
3150   enum tree_code code;
3151 #endif
3152   register struct obstack *ambient_obstack = expression_obstack;
3153   va_list p;
3154   register tree t;
3155   register int length;
3156   register int i;
3157
3158   VA_START (p, code);
3159
3160 #ifndef ANSI_PROTOTYPES
3161   code = va_arg (p, enum tree_code);
3162 #endif
3163
3164   expression_obstack = &temp_decl_obstack;
3165
3166   t = make_node (code);
3167   length = tree_code_length[(int) code];
3168
3169   for (i = 0; i < length; i++)
3170     TREE_OPERAND (t, i) = va_arg (p, tree);
3171
3172   va_end (p);
3173   expression_obstack = ambient_obstack;
3174   return t;
3175 }
3176
3177 #if 0
3178 /* Commented out because this wants to be done very
3179    differently.  See cp-lex.c.  */
3180 tree
3181 build_op_identifier (op1, op2)
3182      tree op1, op2;
3183 {
3184   register tree t = make_node (OP_IDENTIFIER);
3185   TREE_PURPOSE (t) = op1;
3186   TREE_VALUE (t) = op2;
3187   return t;
3188 }
3189 #endif
3190 \f
3191 /* Create a DECL_... node of code CODE, name NAME and data type TYPE.
3192    We do NOT enter this node in any sort of symbol table.
3193
3194    layout_decl is used to set up the decl's storage layout.
3195    Other slots are initialized to 0 or null pointers.  */
3196
3197 tree
3198 build_decl (code, name, type)
3199      enum tree_code code;
3200      tree name, type;
3201 {
3202   register tree t;
3203
3204   t = make_node (code);
3205
3206 /*  if (type == error_mark_node)
3207     type = integer_type_node; */
3208 /* That is not done, deliberately, so that having error_mark_node
3209    as the type can suppress useless errors in the use of this variable.  */
3210
3211   DECL_NAME (t) = name;
3212   DECL_ASSEMBLER_NAME (t) = name;
3213   TREE_TYPE (t) = type;
3214
3215   if (code == VAR_DECL || code == PARM_DECL || code == RESULT_DECL)
3216     layout_decl (t, 0);
3217   else if (code == FUNCTION_DECL)
3218     DECL_MODE (t) = FUNCTION_MODE;
3219
3220   return t;
3221 }
3222 \f
3223 /* BLOCK nodes are used to represent the structure of binding contours
3224    and declarations, once those contours have been exited and their contents
3225    compiled.  This information is used for outputting debugging info.  */
3226
3227 tree
3228 build_block (vars, tags, subblocks, supercontext, chain)
3229      tree vars, tags, subblocks, supercontext, chain;
3230 {
3231   register tree block = make_node (BLOCK);
3232   BLOCK_VARS (block) = vars;
3233   BLOCK_TYPE_TAGS (block) = tags;
3234   BLOCK_SUBBLOCKS (block) = subblocks;
3235   BLOCK_SUPERCONTEXT (block) = supercontext;
3236   BLOCK_CHAIN (block) = chain;
3237   return block;
3238 }
3239
3240 /* EXPR_WITH_FILE_LOCATION are used to keep track of the exact
3241    location where an expression or an identifier were encountered. It
3242    is necessary for languages where the frontend parser will handle
3243    recursively more than one file (Java is one of them).  */
3244
3245 tree
3246 build_expr_wfl (node, file, line, col)
3247      tree node;
3248      const char *file;
3249      int line, col;
3250 {
3251   static const char *last_file = 0;
3252   static tree  last_filenode = NULL_TREE;
3253   register tree wfl = make_node (EXPR_WITH_FILE_LOCATION);
3254
3255   EXPR_WFL_NODE (wfl) = node;
3256   EXPR_WFL_SET_LINECOL (wfl, line, col);
3257   if (file != last_file)
3258     {
3259       last_file = file;
3260       last_filenode = file ? get_identifier (file) : NULL_TREE;
3261     }
3262   EXPR_WFL_FILENAME_NODE (wfl) = last_filenode;
3263   if (node)
3264     {
3265       TREE_SIDE_EFFECTS (wfl) = TREE_SIDE_EFFECTS (node);
3266       TREE_TYPE (wfl) = TREE_TYPE (node);
3267     }
3268   return wfl;
3269 }
3270 \f
3271 /* Return a declaration like DDECL except that its DECL_MACHINE_ATTRIBUTE
3272    is ATTRIBUTE.  */
3273
3274 tree
3275 build_decl_attribute_variant (ddecl, attribute)
3276      tree ddecl, attribute;
3277 {
3278   DECL_MACHINE_ATTRIBUTES (ddecl) = attribute;
3279   return ddecl;
3280 }
3281
3282 /* Return a type like TTYPE except that its TYPE_ATTRIBUTE
3283    is ATTRIBUTE.
3284
3285    Record such modified types already made so we don't make duplicates.  */
3286
3287 tree
3288 build_type_attribute_variant (ttype, attribute)
3289      tree ttype, attribute;
3290 {
3291   if ( ! attribute_list_equal (TYPE_ATTRIBUTES (ttype), attribute))
3292     {
3293       register int hashcode;
3294       register struct obstack *ambient_obstack = current_obstack;
3295       tree ntype;
3296
3297       if (ambient_obstack != &permanent_obstack)
3298         current_obstack = TYPE_OBSTACK (ttype);
3299
3300       ntype = copy_node (ttype);
3301       current_obstack = ambient_obstack;
3302
3303       TYPE_POINTER_TO (ntype) = 0;
3304       TYPE_REFERENCE_TO (ntype) = 0;
3305       TYPE_ATTRIBUTES (ntype) = attribute;
3306
3307       /* Create a new main variant of TYPE.  */
3308       TYPE_MAIN_VARIANT (ntype) = ntype;
3309       TYPE_NEXT_VARIANT (ntype) = 0;
3310       set_type_quals (ntype, TYPE_UNQUALIFIED);
3311
3312       hashcode = TYPE_HASH (TREE_CODE (ntype))
3313                  + TYPE_HASH (TREE_TYPE (ntype))
3314                  + attribute_hash_list (attribute);
3315
3316       switch (TREE_CODE (ntype))
3317         {
3318         case FUNCTION_TYPE:
3319           hashcode += TYPE_HASH (TYPE_ARG_TYPES (ntype));
3320           break;
3321         case ARRAY_TYPE:
3322           hashcode += TYPE_HASH (TYPE_DOMAIN (ntype));
3323           break;
3324         case INTEGER_TYPE:
3325           hashcode += TYPE_HASH (TYPE_MAX_VALUE (ntype));
3326           break;
3327         case REAL_TYPE:
3328           hashcode += TYPE_HASH (TYPE_PRECISION (ntype));
3329           break;
3330         default:
3331           break;
3332         }
3333
3334       ntype = type_hash_canon (hashcode, ntype);
3335       ttype = build_qualified_type (ntype, TYPE_QUALS (ttype));
3336     }
3337
3338   return ttype;
3339 }
3340
3341 /* Return a 1 if ATTR_NAME and ATTR_ARGS is valid for either declaration DECL
3342    or type TYPE and 0 otherwise.  Validity is determined the configuration
3343    macros VALID_MACHINE_DECL_ATTRIBUTE and VALID_MACHINE_TYPE_ATTRIBUTE.  */
3344
3345 int
3346 valid_machine_attribute (attr_name, attr_args, decl, type)
3347   tree attr_name;
3348   tree attr_args ATTRIBUTE_UNUSED;
3349   tree decl ATTRIBUTE_UNUSED;
3350   tree type ATTRIBUTE_UNUSED;
3351 {
3352   int validated = 0;
3353 #ifdef VALID_MACHINE_DECL_ATTRIBUTE
3354   tree decl_attr_list = decl != 0 ? DECL_MACHINE_ATTRIBUTES (decl) : 0;
3355 #endif
3356 #ifdef VALID_MACHINE_TYPE_ATTRIBUTE
3357   tree type_attr_list = TYPE_ATTRIBUTES (type);
3358 #endif
3359
3360   if (TREE_CODE (attr_name) != IDENTIFIER_NODE)
3361     abort ();
3362
3363 #ifdef VALID_MACHINE_DECL_ATTRIBUTE
3364   if (decl != 0
3365       && VALID_MACHINE_DECL_ATTRIBUTE (decl, decl_attr_list, attr_name, attr_args))
3366     {
3367       tree attr = lookup_attribute (IDENTIFIER_POINTER (attr_name),
3368                                     decl_attr_list);
3369
3370       if (attr != NULL_TREE)
3371         {
3372           /* Override existing arguments.  Declarations are unique so we can
3373              modify this in place.  */
3374           TREE_VALUE (attr) = attr_args;
3375         }
3376       else
3377         {
3378           decl_attr_list = tree_cons (attr_name, attr_args, decl_attr_list);
3379           decl = build_decl_attribute_variant (decl, decl_attr_list);
3380         }
3381
3382       validated = 1;
3383     }
3384 #endif
3385
3386 #ifdef VALID_MACHINE_TYPE_ATTRIBUTE
3387   if (validated)
3388     /* Don't apply the attribute to both the decl and the type.  */;
3389   else if (VALID_MACHINE_TYPE_ATTRIBUTE (type, type_attr_list, attr_name,
3390                                          attr_args))
3391     {
3392       tree attr = lookup_attribute (IDENTIFIER_POINTER (attr_name),
3393                                     type_attr_list);
3394
3395       if (attr != NULL_TREE)
3396         {
3397           /* Override existing arguments.
3398              ??? This currently works since attribute arguments are not
3399              included in `attribute_hash_list'.  Something more complicated
3400              may be needed in the future.  */
3401           TREE_VALUE (attr) = attr_args;
3402         }
3403       else
3404         {
3405           /* If this is part of a declaration, create a type variant,
3406              otherwise, this is part of a type definition, so add it 
3407              to the base type.  */
3408           type_attr_list = tree_cons (attr_name, attr_args, type_attr_list);
3409           if (decl != 0)
3410             type = build_type_attribute_variant (type, type_attr_list);
3411           else
3412             TYPE_ATTRIBUTES (type) = type_attr_list;
3413         }
3414       if (decl != 0)
3415         TREE_TYPE (decl) = type;
3416       validated = 1;
3417     }
3418
3419   /* Handle putting a type attribute on pointer-to-function-type by putting
3420      the attribute on the function type.  */
3421   else if (POINTER_TYPE_P (type)
3422            && TREE_CODE (TREE_TYPE (type)) == FUNCTION_TYPE
3423            && VALID_MACHINE_TYPE_ATTRIBUTE (TREE_TYPE (type), type_attr_list,
3424                                             attr_name, attr_args))
3425     {
3426       tree inner_type = TREE_TYPE (type);
3427       tree inner_attr_list = TYPE_ATTRIBUTES (inner_type);
3428       tree attr = lookup_attribute (IDENTIFIER_POINTER (attr_name),
3429                                     type_attr_list);
3430
3431       if (attr != NULL_TREE)
3432         TREE_VALUE (attr) = attr_args;
3433       else
3434         {
3435           inner_attr_list = tree_cons (attr_name, attr_args, inner_attr_list);
3436           inner_type = build_type_attribute_variant (inner_type,
3437                                                      inner_attr_list);
3438         }
3439
3440       if (decl != 0)
3441         TREE_TYPE (decl) = build_pointer_type (inner_type);
3442
3443       validated = 1;
3444     }
3445 #endif
3446
3447   return validated;
3448 }
3449
3450 /* Return non-zero if IDENT is a valid name for attribute ATTR,
3451    or zero if not.
3452
3453    We try both `text' and `__text__', ATTR may be either one.  */
3454 /* ??? It might be a reasonable simplification to require ATTR to be only
3455    `text'.  One might then also require attribute lists to be stored in
3456    their canonicalized form.  */
3457
3458 int
3459 is_attribute_p (attr, ident)
3460      const char *attr;
3461      tree ident;
3462 {
3463   int ident_len, attr_len;
3464   char *p;
3465
3466   if (TREE_CODE (ident) != IDENTIFIER_NODE)
3467     return 0;
3468
3469   if (strcmp (attr, IDENTIFIER_POINTER (ident)) == 0)
3470     return 1;
3471
3472   p = IDENTIFIER_POINTER (ident);
3473   ident_len = strlen (p);
3474   attr_len = strlen (attr);
3475
3476   /* If ATTR is `__text__', IDENT must be `text'; and vice versa.  */
3477   if (attr[0] == '_')
3478     {
3479       if (attr[1] != '_'
3480           || attr[attr_len - 2] != '_'
3481           || attr[attr_len - 1] != '_')
3482         abort ();
3483       if (ident_len == attr_len - 4
3484           && strncmp (attr + 2, p, attr_len - 4) == 0)
3485         return 1;
3486     }
3487   else
3488     {
3489       if (ident_len == attr_len + 4
3490           && p[0] == '_' && p[1] == '_'
3491           && p[ident_len - 2] == '_' && p[ident_len - 1] == '_'
3492           && strncmp (attr, p + 2, attr_len) == 0)
3493         return 1;
3494     }
3495
3496   return 0;
3497 }
3498
3499 /* Given an attribute name and a list of attributes, return a pointer to the
3500    attribute's list element if the attribute is part of the list, or NULL_TREE
3501    if not found.  */
3502
3503 tree
3504 lookup_attribute (attr_name, list)
3505      const char *attr_name;
3506      tree list;
3507 {
3508   tree l;
3509
3510   for (l = list; l; l = TREE_CHAIN (l))
3511     {
3512       if (TREE_CODE (TREE_PURPOSE (l)) != IDENTIFIER_NODE)
3513         abort ();
3514       if (is_attribute_p (attr_name, TREE_PURPOSE (l)))
3515         return l;
3516     }
3517
3518   return NULL_TREE;
3519 }
3520
3521 /* Return an attribute list that is the union of a1 and a2.  */
3522
3523 tree
3524 merge_attributes (a1, a2)
3525      register tree a1, a2;
3526 {
3527   tree attributes;
3528
3529   /* Either one unset?  Take the set one.  */
3530
3531   if (! (attributes = a1))
3532     attributes = a2;
3533
3534   /* One that completely contains the other?  Take it.  */
3535
3536   else if (a2 && ! attribute_list_contained (a1, a2))
3537   {
3538     if (attribute_list_contained (a2, a1))
3539       attributes = a2;
3540     else
3541       {
3542         /* Pick the longest list, and hang on the other list.  */
3543         /* ??? For the moment we punt on the issue of attrs with args.  */
3544
3545         if (list_length (a1) < list_length (a2))
3546           attributes = a2, a2 = a1;
3547
3548         for (; a2; a2 = TREE_CHAIN (a2))
3549           if (lookup_attribute (IDENTIFIER_POINTER (TREE_PURPOSE (a2)),
3550                                 attributes) == NULL_TREE)
3551             {
3552               a1 = copy_node (a2);
3553               TREE_CHAIN (a1) = attributes;
3554               attributes = a1;
3555             }
3556       }
3557   }
3558   return attributes;
3559 }
3560
3561 /* Given types T1 and T2, merge their attributes and return
3562    the result.  */
3563
3564 tree
3565 merge_machine_type_attributes (t1, t2)
3566      tree t1, t2;
3567 {
3568 #ifdef MERGE_MACHINE_TYPE_ATTRIBUTES
3569   return MERGE_MACHINE_TYPE_ATTRIBUTES (t1, t2);
3570 #else
3571   return merge_attributes (TYPE_ATTRIBUTES (t1),
3572                            TYPE_ATTRIBUTES (t2));
3573 #endif
3574 }
3575
3576 /* Given decls OLDDECL and NEWDECL, merge their attributes and return
3577    the result.  */
3578
3579 tree
3580 merge_machine_decl_attributes (olddecl, newdecl)
3581      tree olddecl, newdecl;
3582 {
3583 #ifdef MERGE_MACHINE_DECL_ATTRIBUTES
3584   return MERGE_MACHINE_DECL_ATTRIBUTES (olddecl, newdecl);
3585 #else
3586   return merge_attributes (DECL_MACHINE_ATTRIBUTES (olddecl),
3587                            DECL_MACHINE_ATTRIBUTES (newdecl));
3588 #endif
3589 }
3590 \f
3591 /* Set the type qualifiers for TYPE to TYPE_QUALS, which is a bitmask
3592    of the various TYPE_QUAL values.  */
3593
3594 static void
3595 set_type_quals (type, type_quals)
3596      tree type;
3597      int  type_quals;
3598 {
3599   TYPE_READONLY (type) = (type_quals & TYPE_QUAL_CONST) != 0;
3600   TYPE_VOLATILE (type) = (type_quals & TYPE_QUAL_VOLATILE) != 0;
3601   TYPE_RESTRICT (type) = (type_quals & TYPE_QUAL_RESTRICT) != 0;
3602 }
3603
3604 /* Given a type node TYPE and a TYPE_QUALIFIER_SET, return a type for
3605    the same kind of data as TYPE describes.  Variants point to the
3606    "main variant" (which has no qualifiers set) via TYPE_MAIN_VARIANT,
3607    and it points to a chain of other variants so that duplicate
3608    variants are never made.  Only main variants should ever appear as
3609    types of expressions.  */
3610
3611 tree
3612 build_qualified_type (type, type_quals)
3613      tree type;
3614      int type_quals;
3615 {
3616   register tree t;
3617   
3618   /* Search the chain of variants to see if there is already one there just
3619      like the one we need to have.  If so, use that existing one.  We must
3620      preserve the TYPE_NAME, since there is code that depends on this.  */
3621
3622   for (t = TYPE_MAIN_VARIANT (type); t; t = TYPE_NEXT_VARIANT (t))
3623     if (TYPE_QUALS (t) == type_quals && TYPE_NAME (t) == TYPE_NAME (type))
3624       return t;
3625
3626   /* We need a new one.  */
3627   t = build_type_copy (type);
3628   set_type_quals (t, type_quals);
3629   return t;
3630 }
3631
3632 /* Create a new variant of TYPE, equivalent but distinct.
3633    This is so the caller can modify it.  */
3634
3635 tree
3636 build_type_copy (type)
3637      tree type;
3638 {
3639   register tree t, m = TYPE_MAIN_VARIANT (type);
3640   register struct obstack *ambient_obstack = current_obstack;
3641
3642   current_obstack = TYPE_OBSTACK (type);
3643   t = copy_node (type);
3644   current_obstack = ambient_obstack;
3645
3646   TYPE_POINTER_TO (t) = 0;
3647   TYPE_REFERENCE_TO (t) = 0;
3648
3649   /* Add this type to the chain of variants of TYPE.  */
3650   TYPE_NEXT_VARIANT (t) = TYPE_NEXT_VARIANT (m);
3651   TYPE_NEXT_VARIANT (m) = t;
3652
3653   return t;
3654 }
3655 \f
3656 /* Hashing of types so that we don't make duplicates.
3657    The entry point is `type_hash_canon'.  */
3658
3659 /* Each hash table slot is a bucket containing a chain
3660    of these structures.  */
3661
3662 struct type_hash
3663 {
3664   struct type_hash *next;       /* Next structure in the bucket.  */
3665   int hashcode;                 /* Hash code of this type.  */
3666   tree type;                    /* The type recorded here.  */
3667 };
3668
3669 /* Now here is the hash table.  When recording a type, it is added
3670    to the slot whose index is the hash code mod the table size.
3671    Note that the hash table is used for several kinds of types
3672    (function types, array types and array index range types, for now).
3673    While all these live in the same table, they are completely independent,
3674    and the hash code is computed differently for each of these.  */
3675
3676 #define TYPE_HASH_SIZE 59
3677 struct type_hash *type_hash_table[TYPE_HASH_SIZE];
3678
3679 /* Compute a hash code for a list of types (chain of TREE_LIST nodes
3680    with types in the TREE_VALUE slots), by adding the hash codes
3681    of the individual types.  */
3682
3683 int
3684 type_hash_list (list)
3685      tree list;
3686 {
3687   register int hashcode;
3688   register tree tail;
3689   for (hashcode = 0, tail = list; tail; tail = TREE_CHAIN (tail))
3690     hashcode += TYPE_HASH (TREE_VALUE (tail));
3691   return hashcode;
3692 }
3693
3694 /* Look in the type hash table for a type isomorphic to TYPE.
3695    If one is found, return it.  Otherwise return 0.  */
3696
3697 tree
3698 type_hash_lookup (hashcode, type)
3699      int hashcode;
3700      tree type;
3701 {
3702   register struct type_hash *h;
3703   for (h = type_hash_table[hashcode % TYPE_HASH_SIZE]; h; h = h->next)
3704     if (h->hashcode == hashcode
3705         && TREE_CODE (h->type) == TREE_CODE (type)
3706         && TREE_TYPE (h->type) == TREE_TYPE (type)
3707         && attribute_list_equal (TYPE_ATTRIBUTES (h->type),
3708                                    TYPE_ATTRIBUTES (type))
3709         && (TYPE_MAX_VALUE (h->type) == TYPE_MAX_VALUE (type)
3710             || tree_int_cst_equal (TYPE_MAX_VALUE (h->type),
3711                                    TYPE_MAX_VALUE (type)))
3712         && (TYPE_MIN_VALUE (h->type) == TYPE_MIN_VALUE (type)
3713             || tree_int_cst_equal (TYPE_MIN_VALUE (h->type),
3714                                    TYPE_MIN_VALUE (type)))
3715         /* Note that TYPE_DOMAIN is TYPE_ARG_TYPES for FUNCTION_TYPE.  */
3716         && (TYPE_DOMAIN (h->type) == TYPE_DOMAIN (type)
3717             || (TYPE_DOMAIN (h->type)
3718                 && TREE_CODE (TYPE_DOMAIN (h->type)) == TREE_LIST
3719                 && TYPE_DOMAIN (type)
3720                 && TREE_CODE (TYPE_DOMAIN (type)) == TREE_LIST
3721                 && type_list_equal (TYPE_DOMAIN (h->type),
3722                                     TYPE_DOMAIN (type)))))
3723       return h->type;
3724   return 0;
3725 }
3726
3727 /* Add an entry to the type-hash-table
3728    for a type TYPE whose hash code is HASHCODE.  */
3729
3730 void
3731 type_hash_add (hashcode, type)
3732      int hashcode;
3733      tree type;
3734 {
3735   register struct type_hash *h;
3736
3737   h = (struct type_hash *) oballoc (sizeof (struct type_hash));
3738   h->hashcode = hashcode;
3739   h->type = type;
3740   h->next = type_hash_table[hashcode % TYPE_HASH_SIZE];
3741   type_hash_table[hashcode % TYPE_HASH_SIZE] = h;
3742 }
3743
3744 /* Given TYPE, and HASHCODE its hash code, return the canonical
3745    object for an identical type if one already exists.
3746    Otherwise, return TYPE, and record it as the canonical object
3747    if it is a permanent object.
3748
3749    To use this function, first create a type of the sort you want.
3750    Then compute its hash code from the fields of the type that
3751    make it different from other similar types.
3752    Then call this function and use the value.
3753    This function frees the type you pass in if it is a duplicate.  */
3754
3755 /* Set to 1 to debug without canonicalization.  Never set by program.  */
3756 int debug_no_type_hash = 0;
3757
3758 tree
3759 type_hash_canon (hashcode, type)
3760      int hashcode;
3761      tree type;
3762 {
3763   tree t1;
3764
3765   if (debug_no_type_hash)
3766     return type;
3767
3768   t1 = type_hash_lookup (hashcode, type);
3769   if (t1 != 0)
3770     {
3771       obstack_free (TYPE_OBSTACK (type), type);
3772 #ifdef GATHER_STATISTICS
3773       tree_node_counts[(int)t_kind]--;
3774       tree_node_sizes[(int)t_kind] -= sizeof (struct tree_type);
3775 #endif
3776       return t1;
3777     }
3778
3779   /* If this is a permanent type, record it for later reuse.  */
3780   if (TREE_PERMANENT (type))
3781     type_hash_add (hashcode, type);
3782
3783   return type;
3784 }
3785
3786 /* Compute a hash code for a list of attributes (chain of TREE_LIST nodes
3787    with names in the TREE_PURPOSE slots and args in the TREE_VALUE slots),
3788    by adding the hash codes of the individual attributes.  */
3789
3790 int
3791 attribute_hash_list (list)
3792      tree list;
3793 {
3794   register int hashcode;
3795   register tree tail;
3796   for (hashcode = 0, tail = list; tail; tail = TREE_CHAIN (tail))
3797     /* ??? Do we want to add in TREE_VALUE too? */
3798     hashcode += TYPE_HASH (TREE_PURPOSE (tail));
3799   return hashcode;
3800 }
3801
3802 /* Given two lists of attributes, return true if list l2 is
3803    equivalent to l1.  */
3804
3805 int
3806 attribute_list_equal (l1, l2)
3807      tree l1, l2;
3808 {
3809    return attribute_list_contained (l1, l2)
3810           && attribute_list_contained (l2, l1);
3811 }
3812
3813 /* Given two lists of attributes, return true if list L2 is
3814    completely contained within L1.  */
3815 /* ??? This would be faster if attribute names were stored in a canonicalized
3816    form.  Otherwise, if L1 uses `foo' and L2 uses `__foo__', the long method
3817    must be used to show these elements are equivalent (which they are).  */
3818 /* ??? It's not clear that attributes with arguments will always be handled
3819    correctly.  */
3820
3821 int
3822 attribute_list_contained (l1, l2)
3823      tree l1, l2;
3824 {
3825   register tree t1, t2;
3826
3827   /* First check the obvious, maybe the lists are identical.  */
3828   if (l1 == l2)
3829      return 1;
3830
3831   /* Maybe the lists are similar.  */
3832   for (t1 = l1, t2 = l2;
3833        t1 && t2
3834         && TREE_PURPOSE (t1) == TREE_PURPOSE (t2)
3835         && TREE_VALUE (t1) == TREE_VALUE (t2);
3836        t1 = TREE_CHAIN (t1), t2 = TREE_CHAIN (t2));
3837
3838   /* Maybe the lists are equal.  */
3839   if (t1 == 0 && t2 == 0)
3840      return 1;
3841
3842   for (; t2; t2 = TREE_CHAIN (t2))
3843     {
3844       tree attr
3845         = lookup_attribute (IDENTIFIER_POINTER (TREE_PURPOSE (t2)), l1);
3846
3847       if (attr == NULL_TREE)
3848         return 0;
3849       if (simple_cst_equal (TREE_VALUE (t2), TREE_VALUE (attr)) != 1)
3850         return 0;
3851     }
3852
3853   return 1;
3854 }
3855
3856 /* Given two lists of types
3857    (chains of TREE_LIST nodes with types in the TREE_VALUE slots)
3858    return 1 if the lists contain the same types in the same order.
3859    Also, the TREE_PURPOSEs must match.  */
3860
3861 int
3862 type_list_equal (l1, l2)
3863      tree l1, l2;
3864 {
3865   register tree t1, t2;
3866
3867   for (t1 = l1, t2 = l2; t1 && t2; t1 = TREE_CHAIN (t1), t2 = TREE_CHAIN (t2))
3868     if (TREE_VALUE (t1) != TREE_VALUE (t2)
3869         || (TREE_PURPOSE (t1) != TREE_PURPOSE (t2)
3870             && ! (1 == simple_cst_equal (TREE_PURPOSE (t1), TREE_PURPOSE (t2))
3871                   && (TREE_TYPE (TREE_PURPOSE (t1))
3872                       == TREE_TYPE (TREE_PURPOSE (t2))))))
3873       return 0;
3874
3875   return t1 == t2;
3876 }
3877
3878 /* Nonzero if integer constants T1 and T2
3879    represent the same constant value.  */
3880
3881 int
3882 tree_int_cst_equal (t1, t2)
3883      tree t1, t2;
3884 {
3885   if (t1 == t2)
3886     return 1;
3887   if (t1 == 0 || t2 == 0)
3888     return 0;
3889   if (TREE_CODE (t1) == INTEGER_CST
3890       && TREE_CODE (t2) == INTEGER_CST
3891       && TREE_INT_CST_LOW (t1) == TREE_INT_CST_LOW (t2)
3892       && TREE_INT_CST_HIGH (t1) == TREE_INT_CST_HIGH (t2))
3893     return 1;
3894   return 0;
3895 }
3896
3897 /* Nonzero if integer constants T1 and T2 represent values that satisfy <.
3898    The precise way of comparison depends on their data type.  */
3899
3900 int
3901 tree_int_cst_lt (t1, t2)
3902      tree t1, t2;
3903 {
3904   if (t1 == t2)
3905     return 0;
3906
3907   if (!TREE_UNSIGNED (TREE_TYPE (t1)))
3908     return INT_CST_LT (t1, t2);
3909   return INT_CST_LT_UNSIGNED (t1, t2);
3910 }
3911
3912 /* Return an indication of the sign of the integer constant T.
3913    The return value is -1 if T < 0, 0 if T == 0, and 1 if T > 0.
3914    Note that -1 will never be returned it T's type is unsigned.  */
3915
3916 int
3917 tree_int_cst_sgn (t)
3918      tree t;
3919 {
3920   if (TREE_INT_CST_LOW (t) == 0 && TREE_INT_CST_HIGH (t) == 0)
3921     return 0;
3922   else if (TREE_UNSIGNED (TREE_TYPE (t)))
3923     return 1;
3924   else if (TREE_INT_CST_HIGH (t) < 0)
3925     return -1;
3926   else
3927     return 1;
3928 }
3929
3930 /* Compare two constructor-element-type constants.  Return 1 if the lists
3931    are known to be equal; otherwise return 0.  */
3932
3933 int
3934 simple_cst_list_equal (l1, l2)
3935      tree l1, l2;
3936 {
3937   while (l1 != NULL_TREE && l2 != NULL_TREE)
3938     {
3939       if (simple_cst_equal (TREE_VALUE (l1), TREE_VALUE (l2)) != 1)
3940         return 0;
3941
3942       l1 = TREE_CHAIN (l1);
3943       l2 = TREE_CHAIN (l2);
3944     }
3945
3946   return (l1 == l2);
3947 }
3948
3949 /* Return truthvalue of whether T1 is the same tree structure as T2.
3950    Return 1 if they are the same.
3951    Return 0 if they are understandably different.
3952    Return -1 if either contains tree structure not understood by
3953    this function.  */
3954
3955 int
3956 simple_cst_equal (t1, t2)
3957      tree t1, t2;
3958 {
3959   register enum tree_code code1, code2;
3960   int cmp;
3961
3962   if (t1 == t2)
3963     return 1;
3964   if (t1 == 0 || t2 == 0)
3965     return 0;
3966
3967   code1 = TREE_CODE (t1);
3968   code2 = TREE_CODE (t2);
3969
3970   if (code1 == NOP_EXPR || code1 == CONVERT_EXPR || code1 == NON_LVALUE_EXPR)
3971     {
3972       if (code2 == NOP_EXPR || code2 == CONVERT_EXPR
3973           || code2 == NON_LVALUE_EXPR)
3974         return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3975       else
3976         return simple_cst_equal (TREE_OPERAND (t1, 0), t2);
3977     }
3978   else if (code2 == NOP_EXPR || code2 == CONVERT_EXPR
3979            || code2 == NON_LVALUE_EXPR)
3980     return simple_cst_equal (t1, TREE_OPERAND (t2, 0));
3981
3982   if (code1 != code2)
3983     return 0;
3984
3985   switch (code1)
3986     {
3987     case INTEGER_CST:
3988       return TREE_INT_CST_LOW (t1) == TREE_INT_CST_LOW (t2)
3989         && TREE_INT_CST_HIGH (t1) == TREE_INT_CST_HIGH (t2);
3990
3991     case REAL_CST:
3992       return REAL_VALUES_IDENTICAL (TREE_REAL_CST (t1), TREE_REAL_CST (t2));
3993
3994     case STRING_CST:
3995       return TREE_STRING_LENGTH (t1) == TREE_STRING_LENGTH (t2)
3996         && !bcmp (TREE_STRING_POINTER (t1), TREE_STRING_POINTER (t2),
3997                   TREE_STRING_LENGTH (t1));
3998
3999     case CONSTRUCTOR:
4000       if (CONSTRUCTOR_ELTS (t1) == CONSTRUCTOR_ELTS (t2))
4001         return 1;
4002       else
4003         abort ();
4004
4005     case SAVE_EXPR:
4006       return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
4007
4008     case CALL_EXPR:
4009       cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
4010       if (cmp <= 0)
4011         return cmp;
4012       return simple_cst_list_equal (TREE_OPERAND (t1, 1), TREE_OPERAND (t2, 1));
4013
4014     case TARGET_EXPR:
4015       /* Special case: if either target is an unallocated VAR_DECL,
4016          it means that it's going to be unified with whatever the
4017          TARGET_EXPR is really supposed to initialize, so treat it
4018          as being equivalent to anything.  */
4019       if ((TREE_CODE (TREE_OPERAND (t1, 0)) == VAR_DECL
4020            && DECL_NAME (TREE_OPERAND (t1, 0)) == NULL_TREE
4021            && DECL_RTL (TREE_OPERAND (t1, 0)) == 0)
4022           || (TREE_CODE (TREE_OPERAND (t2, 0)) == VAR_DECL
4023               && DECL_NAME (TREE_OPERAND (t2, 0)) == NULL_TREE
4024               && DECL_RTL (TREE_OPERAND (t2, 0)) == 0))
4025         cmp = 1;
4026       else
4027         cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
4028       if (cmp <= 0)
4029         return cmp;
4030       return simple_cst_equal (TREE_OPERAND (t1, 1), TREE_OPERAND (t2, 1));
4031
4032     case WITH_CLEANUP_EXPR:
4033       cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
4034       if (cmp <= 0)
4035         return cmp;
4036       return simple_cst_equal (TREE_OPERAND (t1, 2), TREE_OPERAND (t1, 2));
4037
4038     case COMPONENT_REF:
4039       if (TREE_OPERAND (t1, 1) == TREE_OPERAND (t2, 1))
4040         return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
4041       return 0;
4042
4043     case VAR_DECL:
4044     case PARM_DECL:
4045     case CONST_DECL:
4046     case FUNCTION_DECL:
4047       return 0;
4048       
4049     default:
4050       break;
4051     }
4052
4053   /* This general rule works for most tree codes.  All exceptions should be
4054      handled above.  If this is a language-specific tree code, we can't
4055      trust what might be in the operand, so say we don't know
4056      the situation.  */
4057   if ((int) code1 >= (int) LAST_AND_UNUSED_TREE_CODE)
4058     return -1;
4059
4060   switch (TREE_CODE_CLASS (code1))
4061     {
4062       int i;
4063     case '1':
4064     case '2':
4065     case '<':
4066     case 'e':
4067     case 'r':
4068     case 's':
4069       cmp = 1;
4070       for (i=0; i<tree_code_length[(int) code1]; ++i)
4071         {
4072           cmp = simple_cst_equal (TREE_OPERAND (t1, i), TREE_OPERAND (t2, i));
4073           if (cmp <= 0)
4074             return cmp;
4075         }
4076       return cmp;
4077
4078     default:
4079       return -1;
4080     }
4081 }
4082 \f
4083 /* Constructors for pointer, array and function types.
4084    (RECORD_TYPE, UNION_TYPE and ENUMERAL_TYPE nodes are
4085    constructed by language-dependent code, not here.)  */
4086
4087 /* Construct, lay out and return the type of pointers to TO_TYPE.
4088    If such a type has already been constructed, reuse it.  */
4089
4090 tree
4091 build_pointer_type (to_type)
4092      tree to_type;
4093 {
4094   register tree t = TYPE_POINTER_TO (to_type);
4095
4096   /* First, if we already have a type for pointers to TO_TYPE, use it.  */
4097
4098   if (t)
4099     return t;
4100
4101   /* We need a new one.  Put this in the same obstack as TO_TYPE.   */
4102   push_obstacks (TYPE_OBSTACK (to_type), TYPE_OBSTACK (to_type));
4103   t = make_node (POINTER_TYPE);
4104   pop_obstacks ();
4105
4106   TREE_TYPE (t) = to_type;
4107
4108   /* Record this type as the pointer to TO_TYPE.  */
4109   TYPE_POINTER_TO (to_type) = t;
4110
4111   /* Lay out the type.  This function has many callers that are concerned
4112      with expression-construction, and this simplifies them all.
4113      Also, it guarantees the TYPE_SIZE is in the same obstack as the type.  */
4114   layout_type (t);
4115
4116   return t;
4117 }
4118
4119 /* Create a type of integers to be the TYPE_DOMAIN of an ARRAY_TYPE.
4120    MAXVAL should be the maximum value in the domain
4121    (one less than the length of the array).
4122
4123    The maximum value that MAXVAL can have is INT_MAX for a HOST_WIDE_INT.
4124    We don't enforce this limit, that is up to caller (e.g. language front end).
4125    The limit exists because the result is a signed type and we don't handle
4126    sizes that use more than one HOST_WIDE_INT.  */
4127
4128 tree
4129 build_index_type (maxval)
4130      tree maxval;
4131 {
4132   register tree itype = make_node (INTEGER_TYPE);
4133
4134   TYPE_PRECISION (itype) = TYPE_PRECISION (sizetype);
4135   TYPE_MIN_VALUE (itype) = size_zero_node;
4136
4137   push_obstacks (TYPE_OBSTACK (itype), TYPE_OBSTACK (itype));
4138   TYPE_MAX_VALUE (itype) = convert (sizetype, maxval);
4139   pop_obstacks ();
4140
4141   TYPE_MODE (itype) = TYPE_MODE (sizetype);
4142   TYPE_SIZE (itype) = TYPE_SIZE (sizetype);
4143   TYPE_SIZE_UNIT (itype) = TYPE_SIZE_UNIT (sizetype);
4144   TYPE_ALIGN (itype) = TYPE_ALIGN (sizetype);
4145   if (TREE_CODE (maxval) == INTEGER_CST)
4146     {
4147       int maxint = (int) TREE_INT_CST_LOW (maxval);
4148       /* If the domain should be empty, make sure the maxval
4149          remains -1 and is not spoiled by truncation.  */
4150       if (INT_CST_LT (maxval, integer_zero_node))
4151         {
4152           TYPE_MAX_VALUE (itype) = build_int_2 (-1, -1);
4153           TREE_TYPE (TYPE_MAX_VALUE (itype)) = sizetype;
4154         }
4155       return type_hash_canon (maxint < 0 ? ~maxint : maxint, itype);
4156     }
4157   else
4158     return itype;
4159 }
4160
4161 /* Create a range of some discrete type TYPE (an INTEGER_TYPE,
4162    ENUMERAL_TYPE, BOOLEAN_TYPE, or CHAR_TYPE), with
4163    low bound LOWVAL and high bound HIGHVAL.
4164    if TYPE==NULL_TREE, sizetype is used.  */
4165
4166 tree
4167 build_range_type (type, lowval, highval)
4168      tree type, lowval, highval;
4169 {
4170   register tree itype = make_node (INTEGER_TYPE);
4171
4172   TREE_TYPE (itype) = type;
4173   if (type == NULL_TREE)
4174     type = sizetype;
4175
4176   push_obstacks (TYPE_OBSTACK (itype), TYPE_OBSTACK (itype));
4177   TYPE_MIN_VALUE (itype) = convert (type, lowval);
4178   TYPE_MAX_VALUE (itype) = highval ? convert (type, highval) : NULL;
4179   pop_obstacks ();
4180
4181   TYPE_PRECISION (itype) = TYPE_PRECISION (type);
4182   TYPE_MODE (itype) = TYPE_MODE (type);
4183   TYPE_SIZE (itype) = TYPE_SIZE (type);
4184   TYPE_SIZE_UNIT (itype) = TYPE_SIZE_UNIT (type);
4185   TYPE_ALIGN (itype) = TYPE_ALIGN (type);
4186   if (TREE_CODE (lowval) == INTEGER_CST)
4187     {
4188       HOST_WIDE_INT lowint, highint;
4189       int maxint;
4190
4191       lowint = TREE_INT_CST_LOW (lowval);
4192       if (highval && TREE_CODE (highval) == INTEGER_CST)
4193         highint = TREE_INT_CST_LOW (highval);
4194       else
4195         highint = (~(unsigned HOST_WIDE_INT)0) >> 1;
4196
4197       maxint = (int) (highint - lowint);
4198       return type_hash_canon (maxint < 0 ? ~maxint : maxint, itype);
4199     }
4200   else
4201     return itype;
4202 }
4203
4204 /* Just like build_index_type, but takes lowval and highval instead
4205    of just highval (maxval).  */
4206
4207 tree
4208 build_index_2_type (lowval,highval)
4209      tree lowval, highval;
4210 {
4211   return build_range_type (NULL_TREE, lowval, highval);
4212 }
4213
4214 /* Return nonzero iff ITYPE1 and ITYPE2 are equal (in the LISP sense).
4215    Needed because when index types are not hashed, equal index types
4216    built at different times appear distinct, even though structurally,
4217    they are not.  */
4218
4219 int
4220 index_type_equal (itype1, itype2)
4221      tree itype1, itype2;
4222 {
4223   if (TREE_CODE (itype1) != TREE_CODE (itype2))
4224     return 0;
4225   if (TREE_CODE (itype1) == INTEGER_TYPE)
4226     {
4227       if (TYPE_PRECISION (itype1) != TYPE_PRECISION (itype2)
4228           || TYPE_MODE (itype1) != TYPE_MODE (itype2)
4229           || simple_cst_equal (TYPE_SIZE (itype1), TYPE_SIZE (itype2)) != 1
4230           || TYPE_ALIGN (itype1) != TYPE_ALIGN (itype2))
4231         return 0;
4232       if (1 == simple_cst_equal (TYPE_MIN_VALUE (itype1),
4233                                  TYPE_MIN_VALUE (itype2))
4234           && 1 == simple_cst_equal (TYPE_MAX_VALUE (itype1),
4235                                     TYPE_MAX_VALUE (itype2)))
4236         return 1;
4237     }
4238
4239   return 0;
4240 }
4241
4242 /* Construct, lay out and return the type of arrays of elements with ELT_TYPE
4243    and number of elements specified by the range of values of INDEX_TYPE.
4244    If such a type has already been constructed, reuse it.  */
4245
4246 tree
4247 build_array_type (elt_type, index_type)
4248      tree elt_type, index_type;
4249 {
4250   register tree t;
4251   int hashcode;
4252
4253   if (TREE_CODE (elt_type) == FUNCTION_TYPE)
4254     {
4255       error ("arrays of functions are not meaningful");
4256       elt_type = integer_type_node;
4257     }
4258
4259   /* Make sure TYPE_POINTER_TO (elt_type) is filled in.  */
4260   build_pointer_type (elt_type);
4261
4262   /* Allocate the array after the pointer type,
4263      in case we free it in type_hash_canon.  */
4264   t = make_node (ARRAY_TYPE);
4265   TREE_TYPE (t) = elt_type;
4266   TYPE_DOMAIN (t) = index_type;
4267
4268   if (index_type == 0)
4269     {
4270       return t;
4271     }
4272
4273   hashcode = TYPE_HASH (elt_type) + TYPE_HASH (index_type);
4274   t = type_hash_canon (hashcode, t);
4275
4276   if (TYPE_SIZE (t) == 0)
4277     layout_type (t);
4278   return t;
4279 }
4280
4281 /* Return the TYPE of the elements comprising
4282    the innermost dimension of ARRAY.  */
4283
4284 tree
4285 get_inner_array_type (array)
4286     tree array;
4287 {
4288   tree type = TREE_TYPE (array);
4289
4290   while (TREE_CODE (type) == ARRAY_TYPE)
4291     type = TREE_TYPE (type);
4292
4293   return type;
4294 }
4295
4296 /* Construct, lay out and return
4297    the type of functions returning type VALUE_TYPE
4298    given arguments of types ARG_TYPES.
4299    ARG_TYPES is a chain of TREE_LIST nodes whose TREE_VALUEs
4300    are data type nodes for the arguments of the function.
4301    If such a type has already been constructed, reuse it.  */
4302
4303 tree
4304 build_function_type (value_type, arg_types)
4305      tree value_type, arg_types;
4306 {
4307   register tree t;
4308   int hashcode;
4309
4310   if (TREE_CODE (value_type) == FUNCTION_TYPE)
4311     {
4312       error ("function return type cannot be function");
4313       value_type = integer_type_node;
4314     }
4315
4316   /* Make a node of the sort we want.  */
4317   t = make_node (FUNCTION_TYPE);
4318   TREE_TYPE (t) = value_type;
4319   TYPE_ARG_TYPES (t) = arg_types;
4320
4321   /* If we already have such a type, use the old one and free this one.  */
4322   hashcode = TYPE_HASH (value_type) + type_hash_list (arg_types);
4323   t = type_hash_canon (hashcode, t);
4324
4325   if (TYPE_SIZE (t) == 0)
4326     layout_type (t);
4327   return t;
4328 }
4329
4330 /* Build the node for the type of references-to-TO_TYPE.  */
4331
4332 tree
4333 build_reference_type (to_type)
4334      tree to_type;
4335 {
4336   register tree t = TYPE_REFERENCE_TO (to_type);
4337
4338   /* First, if we already have a type for pointers to TO_TYPE, use it.  */
4339
4340   if (t)
4341     return t;
4342
4343   /* We need a new one.  Put this in the same obstack as TO_TYPE.   */
4344   push_obstacks (TYPE_OBSTACK (to_type), TYPE_OBSTACK (to_type));
4345   t = make_node (REFERENCE_TYPE);
4346   pop_obstacks ();
4347
4348   TREE_TYPE (t) = to_type;
4349
4350   /* Record this type as the pointer to TO_TYPE.  */
4351   TYPE_REFERENCE_TO (to_type) = t;
4352
4353   layout_type (t);
4354
4355   return t;
4356 }
4357
4358 /* Construct, lay out and return the type of methods belonging to class
4359    BASETYPE and whose arguments and values are described by TYPE.
4360    If that type exists already, reuse it.
4361    TYPE must be a FUNCTION_TYPE node.  */
4362
4363 tree
4364 build_method_type (basetype, type)
4365      tree basetype, type;
4366 {
4367   register tree t;
4368   int hashcode;
4369
4370   /* Make a node of the sort we want.  */
4371   t = make_node (METHOD_TYPE);
4372
4373   if (TREE_CODE (type) != FUNCTION_TYPE)
4374     abort ();
4375
4376   TYPE_METHOD_BASETYPE (t) = TYPE_MAIN_VARIANT (basetype);
4377   TREE_TYPE (t) = TREE_TYPE (type);
4378
4379   /* The actual arglist for this function includes a "hidden" argument
4380      which is "this".  Put it into the list of argument types.  */
4381
4382   TYPE_ARG_TYPES (t)
4383     = tree_cons (NULL_TREE,
4384                  build_pointer_type (basetype), TYPE_ARG_TYPES (type));
4385
4386   /* If we already have such a type, use the old one and free this one.  */
4387   hashcode = TYPE_HASH (basetype) + TYPE_HASH (type);
4388   t = type_hash_canon (hashcode, t);
4389
4390   if (TYPE_SIZE (t) == 0)
4391     layout_type (t);
4392
4393   return t;
4394 }
4395
4396 /* Construct, lay out and return the type of offsets to a value
4397    of type TYPE, within an object of type BASETYPE.
4398    If a suitable offset type exists already, reuse it.  */
4399
4400 tree
4401 build_offset_type (basetype, type)
4402      tree basetype, type;
4403 {
4404   register tree t;
4405   int hashcode;
4406
4407   /* Make a node of the sort we want.  */
4408   t = make_node (OFFSET_TYPE);
4409
4410   TYPE_OFFSET_BASETYPE (t) = TYPE_MAIN_VARIANT (basetype);
4411   TREE_TYPE (t) = type;
4412
4413   /* If we already have such a type, use the old one and free this one.  */
4414   hashcode = TYPE_HASH (basetype) + TYPE_HASH (type);
4415   t = type_hash_canon (hashcode, t);
4416
4417   if (TYPE_SIZE (t) == 0)
4418     layout_type (t);
4419
4420   return t;
4421 }
4422
4423 /* Create a complex type whose components are COMPONENT_TYPE.  */
4424
4425 tree
4426 build_complex_type (component_type)
4427      tree component_type;
4428 {
4429   register tree t;
4430   int hashcode;
4431
4432   /* Make a node of the sort we want.  */
4433   t = make_node (COMPLEX_TYPE);
4434
4435   TREE_TYPE (t) = TYPE_MAIN_VARIANT (component_type);
4436   set_type_quals (t, TYPE_QUALS (component_type));
4437
4438   /* If we already have such a type, use the old one and free this one.  */
4439   hashcode = TYPE_HASH (component_type);
4440   t = type_hash_canon (hashcode, t);
4441
4442   if (TYPE_SIZE (t) == 0)
4443     layout_type (t);
4444
4445   return t;
4446 }
4447 \f
4448 /* Return OP, stripped of any conversions to wider types as much as is safe.
4449    Converting the value back to OP's type makes a value equivalent to OP.
4450
4451    If FOR_TYPE is nonzero, we return a value which, if converted to
4452    type FOR_TYPE, would be equivalent to converting OP to type FOR_TYPE.
4453
4454    If FOR_TYPE is nonzero, unaligned bit-field references may be changed to the
4455    narrowest type that can hold the value, even if they don't exactly fit.
4456    Otherwise, bit-field references are changed to a narrower type
4457    only if they can be fetched directly from memory in that type.
4458
4459    OP must have integer, real or enumeral type.  Pointers are not allowed!
4460
4461    There are some cases where the obvious value we could return
4462    would regenerate to OP if converted to OP's type, 
4463    but would not extend like OP to wider types.
4464    If FOR_TYPE indicates such extension is contemplated, we eschew such values.
4465    For example, if OP is (unsigned short)(signed char)-1,
4466    we avoid returning (signed char)-1 if FOR_TYPE is int,
4467    even though extending that to an unsigned short would regenerate OP,
4468    since the result of extending (signed char)-1 to (int)
4469    is different from (int) OP.  */
4470
4471 tree
4472 get_unwidened (op, for_type)
4473      register tree op;
4474      tree for_type;
4475 {
4476   /* Set UNS initially if converting OP to FOR_TYPE is a zero-extension.  */
4477   register tree type = TREE_TYPE (op);
4478   register unsigned final_prec
4479     = TYPE_PRECISION (for_type != 0 ? for_type : type);
4480   register int uns
4481     = (for_type != 0 && for_type != type
4482        && final_prec > TYPE_PRECISION (type)
4483        && TREE_UNSIGNED (type));
4484   register tree win = op;
4485
4486   while (TREE_CODE (op) == NOP_EXPR)
4487     {
4488       register int bitschange
4489         = TYPE_PRECISION (TREE_TYPE (op))
4490           - TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (op, 0)));
4491
4492       /* Truncations are many-one so cannot be removed.
4493          Unless we are later going to truncate down even farther.  */
4494       if (bitschange < 0
4495           && final_prec > TYPE_PRECISION (TREE_TYPE (op)))
4496         break;
4497
4498       /* See what's inside this conversion.  If we decide to strip it,
4499          we will set WIN.  */
4500       op = TREE_OPERAND (op, 0);
4501
4502       /* If we have not stripped any zero-extensions (uns is 0),
4503          we can strip any kind of extension.
4504          If we have previously stripped a zero-extension,
4505          only zero-extensions can safely be stripped.
4506          Any extension can be stripped if the bits it would produce
4507          are all going to be discarded later by truncating to FOR_TYPE.  */
4508
4509       if (bitschange > 0)
4510         {
4511           if (! uns || final_prec <= TYPE_PRECISION (TREE_TYPE (op)))
4512             win = op;
4513           /* TREE_UNSIGNED says whether this is a zero-extension.
4514              Let's avoid computing it if it does not affect WIN
4515              and if UNS will not be needed again.  */
4516           if ((uns || TREE_CODE (op) == NOP_EXPR)
4517               && TREE_UNSIGNED (TREE_TYPE (op)))
4518             {
4519               uns = 1;
4520               win = op;
4521             }
4522         }
4523     }
4524
4525   if (TREE_CODE (op) == COMPONENT_REF
4526       /* Since type_for_size always gives an integer type.  */
4527       && TREE_CODE (type) != REAL_TYPE
4528       /* Don't crash if field not laid out yet.  */
4529       && DECL_SIZE (TREE_OPERAND (op, 1)) != 0)
4530     {
4531       unsigned innerprec = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1)));
4532       type = type_for_size (innerprec, TREE_UNSIGNED (TREE_OPERAND (op, 1)));
4533
4534       /* We can get this structure field in the narrowest type it fits in.
4535          If FOR_TYPE is 0, do this only for a field that matches the
4536          narrower type exactly and is aligned for it
4537          The resulting extension to its nominal type (a fullword type)
4538          must fit the same conditions as for other extensions.  */
4539
4540       if (innerprec < TYPE_PRECISION (TREE_TYPE (op))
4541           && (for_type || ! DECL_BIT_FIELD (TREE_OPERAND (op, 1)))
4542           && (! uns || final_prec <= innerprec
4543               || TREE_UNSIGNED (TREE_OPERAND (op, 1)))
4544           && type != 0)
4545         {
4546           win = build (COMPONENT_REF, type, TREE_OPERAND (op, 0),
4547                        TREE_OPERAND (op, 1));
4548           TREE_SIDE_EFFECTS (win) = TREE_SIDE_EFFECTS (op);
4549           TREE_THIS_VOLATILE (win) = TREE_THIS_VOLATILE (op);
4550           TREE_RAISES (win) = TREE_RAISES (op);
4551         }
4552     }
4553   return win;
4554 }
4555 \f
4556 /* Return OP or a simpler expression for a narrower value
4557    which can be sign-extended or zero-extended to give back OP.
4558    Store in *UNSIGNEDP_PTR either 1 if the value should be zero-extended
4559    or 0 if the value should be sign-extended.  */
4560
4561 tree
4562 get_narrower (op, unsignedp_ptr)
4563      register tree op;
4564      int *unsignedp_ptr;
4565 {
4566   register int uns = 0;
4567   int first = 1;
4568   register tree win = op;
4569
4570   while (TREE_CODE (op) == NOP_EXPR)
4571     {
4572       register int bitschange
4573         = TYPE_PRECISION (TREE_TYPE (op))
4574           - TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (op, 0)));
4575
4576       /* Truncations are many-one so cannot be removed.  */
4577       if (bitschange < 0)
4578         break;
4579
4580       /* See what's inside this conversion.  If we decide to strip it,
4581          we will set WIN.  */
4582       op = TREE_OPERAND (op, 0);
4583
4584       if (bitschange > 0)
4585         {
4586           /* An extension: the outermost one can be stripped,
4587              but remember whether it is zero or sign extension.  */
4588           if (first)
4589             uns = TREE_UNSIGNED (TREE_TYPE (op));
4590           /* Otherwise, if a sign extension has been stripped,
4591              only sign extensions can now be stripped;
4592              if a zero extension has been stripped, only zero-extensions.  */
4593           else if (uns != TREE_UNSIGNED (TREE_TYPE (op)))
4594             break;
4595           first = 0;
4596         }
4597       else /* bitschange == 0 */
4598         {
4599           /* A change in nominal type can always be stripped, but we must
4600              preserve the unsignedness.  */
4601           if (first)
4602             uns = TREE_UNSIGNED (TREE_TYPE (op));
4603           first = 0;
4604         }
4605
4606       win = op;
4607     }
4608
4609   if (TREE_CODE (op) == COMPONENT_REF
4610       /* Since type_for_size always gives an integer type.  */
4611       && TREE_CODE (TREE_TYPE (op)) != REAL_TYPE)
4612     {
4613       unsigned innerprec = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1)));
4614       tree type = type_for_size (innerprec, TREE_UNSIGNED (op));
4615
4616       /* We can get this structure field in a narrower type that fits it,
4617          but the resulting extension to its nominal type (a fullword type)
4618          must satisfy the same conditions as for other extensions.
4619
4620          Do this only for fields that are aligned (not bit-fields),
4621          because when bit-field insns will be used there is no
4622          advantage in doing this.  */
4623
4624       if (innerprec < TYPE_PRECISION (TREE_TYPE (op))
4625           && ! DECL_BIT_FIELD (TREE_OPERAND (op, 1))
4626           && (first || uns == TREE_UNSIGNED (TREE_OPERAND (op, 1)))
4627           && type != 0)
4628         {
4629           if (first)
4630             uns = TREE_UNSIGNED (TREE_OPERAND (op, 1));
4631           win = build (COMPONENT_REF, type, TREE_OPERAND (op, 0),
4632                        TREE_OPERAND (op, 1));
4633           TREE_SIDE_EFFECTS (win) = TREE_SIDE_EFFECTS (op);
4634           TREE_THIS_VOLATILE (win) = TREE_THIS_VOLATILE (op);
4635           TREE_RAISES (win) = TREE_RAISES (op);
4636         }
4637     }
4638   *unsignedp_ptr = uns;
4639   return win;
4640 }
4641 \f
4642 /* Nonzero if integer constant C has a value that is permissible
4643    for type TYPE (an INTEGER_TYPE).  */
4644
4645 int
4646 int_fits_type_p (c, type)
4647      tree c, type;
4648 {
4649   if (TREE_UNSIGNED (type))
4650     return (! (TREE_CODE (TYPE_MAX_VALUE (type)) == INTEGER_CST
4651                && INT_CST_LT_UNSIGNED (TYPE_MAX_VALUE (type), c))
4652             && ! (TREE_CODE (TYPE_MIN_VALUE (type)) == INTEGER_CST
4653                   && INT_CST_LT_UNSIGNED (c, TYPE_MIN_VALUE (type)))
4654             /* Negative ints never fit unsigned types.  */
4655             && ! (TREE_INT_CST_HIGH (c) < 0
4656                   && ! TREE_UNSIGNED (TREE_TYPE (c))));
4657   else
4658     return (! (TREE_CODE (TYPE_MAX_VALUE (type)) == INTEGER_CST
4659                && INT_CST_LT (TYPE_MAX_VALUE (type), c))
4660             && ! (TREE_CODE (TYPE_MIN_VALUE (type)) == INTEGER_CST
4661                   && INT_CST_LT (c, TYPE_MIN_VALUE (type)))
4662             /* Unsigned ints with top bit set never fit signed types.  */
4663             && ! (TREE_INT_CST_HIGH (c) < 0
4664                   && TREE_UNSIGNED (TREE_TYPE (c))));
4665 }
4666
4667 /* Return the innermost context enclosing DECL that is
4668    a FUNCTION_DECL, or zero if none.  */
4669
4670 tree
4671 decl_function_context (decl)
4672      tree decl;
4673 {
4674   tree context;
4675
4676   if (TREE_CODE (decl) == ERROR_MARK)
4677     return 0;
4678
4679   if (TREE_CODE (decl) == SAVE_EXPR)
4680     context = SAVE_EXPR_CONTEXT (decl);
4681   else
4682     context = DECL_CONTEXT (decl);
4683
4684   while (context && TREE_CODE (context) != FUNCTION_DECL)
4685     {
4686       if (TREE_CODE_CLASS (TREE_CODE (context)) == 't')
4687         context = TYPE_CONTEXT (context);
4688       else if (TREE_CODE_CLASS (TREE_CODE (context)) == 'd')
4689         context = DECL_CONTEXT (context);
4690       else if (TREE_CODE (context) == BLOCK)
4691         context = BLOCK_SUPERCONTEXT (context);
4692       else
4693         /* Unhandled CONTEXT !?  */
4694         abort ();
4695     }
4696
4697   return context;
4698 }
4699
4700 /* Return the innermost context enclosing DECL that is
4701    a RECORD_TYPE, UNION_TYPE or QUAL_UNION_TYPE, or zero if none.
4702    TYPE_DECLs and FUNCTION_DECLs are transparent to this function.  */
4703
4704 tree
4705 decl_type_context (decl)
4706      tree decl;
4707 {
4708   tree context = DECL_CONTEXT (decl);
4709
4710   while (context)
4711     {
4712       if (TREE_CODE (context) == RECORD_TYPE
4713           || TREE_CODE (context) == UNION_TYPE
4714           || TREE_CODE (context) == QUAL_UNION_TYPE)
4715         return context;
4716       if (TREE_CODE (context) == TYPE_DECL
4717           || TREE_CODE (context) == FUNCTION_DECL)
4718         context = DECL_CONTEXT (context);
4719       else if (TREE_CODE (context) == BLOCK)
4720         context = BLOCK_SUPERCONTEXT (context);
4721       else
4722         /* Unhandled CONTEXT!?  */
4723         abort ();
4724     }
4725   return NULL_TREE;
4726 }
4727
4728 /* Print debugging information about the size of the
4729    toplev_inline_obstacks.  */
4730
4731 void
4732 print_inline_obstack_statistics ()
4733 {
4734   struct simple_obstack_stack *current = toplev_inline_obstacks;
4735   int n_obstacks = 0;
4736   int n_alloc = 0;
4737   int n_chunks = 0;
4738
4739   for (; current; current = current->next, ++n_obstacks)
4740     {
4741       struct obstack *o = current->obstack;
4742       struct _obstack_chunk *chunk = o->chunk;
4743
4744       n_alloc += o->next_free - chunk->contents;
4745       chunk = chunk->prev;
4746       ++n_chunks;
4747       for (; chunk; chunk = chunk->prev, ++n_chunks)
4748         n_alloc += chunk->limit - &chunk->contents[0];
4749     }
4750   fprintf (stderr, "inline obstacks: %d obstacks, %d bytes, %d chunks\n",
4751            n_obstacks, n_alloc, n_chunks);
4752 }
4753
4754 /* Print debugging information about the obstack O, named STR.  */
4755
4756 void
4757 print_obstack_statistics (str, o)
4758      const char *str;
4759      struct obstack *o;
4760 {
4761   struct _obstack_chunk *chunk = o->chunk;
4762   int n_chunks = 1;
4763   int n_alloc = 0;
4764
4765   n_alloc += o->next_free - chunk->contents;
4766   chunk = chunk->prev;
4767   while (chunk)
4768     {
4769       n_chunks += 1;
4770       n_alloc += chunk->limit - &chunk->contents[0];
4771       chunk = chunk->prev;
4772     }
4773   fprintf (stderr, "obstack %s: %u bytes, %d chunks\n",
4774            str, n_alloc, n_chunks);
4775 }
4776
4777 /* Print debugging information about tree nodes generated during the compile,
4778    and any language-specific information.  */
4779
4780 void
4781 dump_tree_statistics ()
4782 {
4783 #ifdef GATHER_STATISTICS
4784   int i;
4785   int total_nodes, total_bytes;
4786 #endif
4787
4788   fprintf (stderr, "\n??? tree nodes created\n\n");
4789 #ifdef GATHER_STATISTICS
4790   fprintf (stderr, "Kind                  Nodes     Bytes\n");
4791   fprintf (stderr, "-------------------------------------\n");
4792   total_nodes = total_bytes = 0;
4793   for (i = 0; i < (int) all_kinds; i++)
4794     {
4795       fprintf (stderr, "%-20s %6d %9d\n", tree_node_kind_names[i],
4796                tree_node_counts[i], tree_node_sizes[i]);
4797       total_nodes += tree_node_counts[i];
4798       total_bytes += tree_node_sizes[i];
4799     }
4800   fprintf (stderr, "%-20s        %9d\n", "identifier names", id_string_size);
4801   fprintf (stderr, "-------------------------------------\n");
4802   fprintf (stderr, "%-20s %6d %9d\n", "Total", total_nodes, total_bytes);
4803   fprintf (stderr, "-------------------------------------\n");
4804 #else
4805   fprintf (stderr, "(No per-node statistics)\n");
4806 #endif
4807   print_obstack_statistics ("permanent_obstack", &permanent_obstack);
4808   print_obstack_statistics ("maybepermanent_obstack", &maybepermanent_obstack);
4809   print_obstack_statistics ("temporary_obstack", &temporary_obstack);
4810   print_obstack_statistics ("momentary_obstack", &momentary_obstack);
4811   print_obstack_statistics ("temp_decl_obstack", &temp_decl_obstack);
4812   print_inline_obstack_statistics ();
4813   print_lang_statistics ();
4814 }
4815 \f
4816 #define FILE_FUNCTION_PREFIX_LEN 9
4817
4818 #ifndef NO_DOLLAR_IN_LABEL
4819 #define FILE_FUNCTION_FORMAT "_GLOBAL_$%s$%s"
4820 #else /* NO_DOLLAR_IN_LABEL */
4821 #ifndef NO_DOT_IN_LABEL
4822 #define FILE_FUNCTION_FORMAT "_GLOBAL_.%s.%s"
4823 #else /* NO_DOT_IN_LABEL */
4824 #define FILE_FUNCTION_FORMAT "_GLOBAL__%s_%s"
4825 #endif  /* NO_DOT_IN_LABEL */
4826 #endif  /* NO_DOLLAR_IN_LABEL */
4827
4828 extern char * first_global_object_name;
4829 extern char * weak_global_object_name;
4830
4831 /* Appends 6 random characters to TEMPLATE to (hopefully) avoid name
4832    clashes in cases where we can't reliably choose a unique name.
4833
4834    Derived from mkstemp.c in libiberty.  */
4835
4836 static void
4837 append_random_chars (template)
4838      char *template;
4839 {
4840   static const char letters[]
4841     = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";
4842   static unsigned HOST_WIDE_INT value;
4843   unsigned HOST_WIDE_INT v;
4844
4845 #ifdef HAVE_GETTIMEOFDAY
4846   struct timeval tv;
4847 #endif
4848
4849   template += strlen (template);
4850
4851 #ifdef HAVE_GETTIMEOFDAY
4852   /* Get some more or less random data.  */
4853   gettimeofday (&tv, NULL);
4854   value += ((unsigned HOST_WIDE_INT) tv.tv_usec << 16) ^ tv.tv_sec ^ getpid ();
4855 #else
4856   value += getpid ();
4857 #endif
4858
4859   v = value;
4860
4861   /* Fill in the random bits.  */
4862   template[0] = letters[v % 62];
4863   v /= 62;
4864   template[1] = letters[v % 62];
4865   v /= 62;
4866   template[2] = letters[v % 62];
4867   v /= 62;
4868   template[3] = letters[v % 62];
4869   v /= 62;
4870   template[4] = letters[v % 62];
4871   v /= 62;
4872   template[5] = letters[v % 62];
4873
4874   template[6] = '\0';
4875 }
4876
4877 /* Generate a name for a function unique to this translation unit.
4878    TYPE is some string to identify the purpose of this function to the
4879    linker or collect2.  */
4880
4881 tree
4882 get_file_function_name_long (type)
4883      const char *type;
4884 {
4885   char *buf;
4886   register char *p;
4887
4888   if (first_global_object_name)
4889     p = first_global_object_name;
4890   else
4891     {
4892       /* We don't have anything that we know to be unique to this translation
4893          unit, so use what we do have and throw in some randomness.  */
4894
4895       const char *name = weak_global_object_name;
4896       const char *file = main_input_filename;
4897
4898       if (! name)
4899         name = "";
4900       if (! file)
4901         file = input_filename;
4902
4903       p = (char *) alloca (7 + strlen (name) + strlen (file));
4904
4905       sprintf (p, "%s%s", name, file);
4906       append_random_chars (p);
4907     }
4908
4909   buf = (char *) alloca (sizeof (FILE_FUNCTION_FORMAT) + strlen (p)
4910                          + strlen (type));
4911
4912   /* Set up the name of the file-level functions we may need.  */
4913   /* Use a global object (which is already required to be unique over
4914      the program) rather than the file name (which imposes extra
4915      constraints).  -- Raeburn@MIT.EDU, 10 Jan 1990.  */
4916   sprintf (buf, FILE_FUNCTION_FORMAT, type, p);
4917
4918   /* Don't need to pull weird characters out of global names.  */
4919   if (p != first_global_object_name)
4920     {
4921       for (p = buf+11; *p; p++)
4922         if (! ((*p >= '0' && *p <= '9')
4923 #if 0 /* we always want labels, which are valid C++ identifiers (+ `$') */
4924 #ifndef ASM_IDENTIFY_GCC        /* this is required if `.' is invalid -- k. raeburn */
4925                || *p == '.'
4926 #endif
4927 #endif
4928 #ifndef NO_DOLLAR_IN_LABEL      /* this for `$'; unlikely, but... -- kr */
4929                || *p == '$'
4930 #endif
4931 #ifndef NO_DOT_IN_LABEL         /* this for `.'; unlikely, but...  */
4932                || *p == '.'
4933 #endif
4934                || (*p >= 'A' && *p <= 'Z')
4935                || (*p >= 'a' && *p <= 'z')))
4936           *p = '_';
4937     }
4938
4939   return get_identifier (buf);
4940 }
4941
4942 /* If KIND=='I', return a suitable global initializer (constructor) name.
4943    If KIND=='D', return a suitable global clean-up (destructor) name.  */
4944
4945 tree
4946 get_file_function_name (kind)
4947      int kind;
4948 {
4949   char p[2];
4950   p[0] = kind;
4951   p[1] = 0;
4952
4953   return get_file_function_name_long (p);
4954 }
4955
4956 \f
4957 /* Expand (the constant part of) a SET_TYPE CONSTRUCTOR node.
4958    The result is placed in BUFFER (which has length BIT_SIZE),
4959    with one bit in each char ('\000' or '\001').
4960
4961    If the constructor is constant, NULL_TREE is returned.
4962    Otherwise, a TREE_LIST of the non-constant elements is emitted.  */
4963
4964 tree
4965 get_set_constructor_bits (init, buffer, bit_size)
4966      tree init;
4967      char *buffer;
4968      int bit_size;
4969 {
4970   int i;
4971   tree vals;
4972   HOST_WIDE_INT domain_min
4973     = TREE_INT_CST_LOW (TYPE_MIN_VALUE (TYPE_DOMAIN (TREE_TYPE (init))));
4974   tree non_const_bits = NULL_TREE;
4975   for (i = 0; i < bit_size; i++)
4976     buffer[i] = 0;
4977
4978   for (vals = TREE_OPERAND (init, 1); 
4979        vals != NULL_TREE; vals = TREE_CHAIN (vals))
4980     {
4981       if (TREE_CODE (TREE_VALUE (vals)) != INTEGER_CST
4982           || (TREE_PURPOSE (vals) != NULL_TREE
4983               && TREE_CODE (TREE_PURPOSE (vals)) != INTEGER_CST))
4984         non_const_bits
4985           = tree_cons (TREE_PURPOSE (vals), TREE_VALUE (vals), non_const_bits);
4986       else if (TREE_PURPOSE (vals) != NULL_TREE)
4987         {
4988           /* Set a range of bits to ones.  */
4989           HOST_WIDE_INT lo_index
4990             = TREE_INT_CST_LOW (TREE_PURPOSE (vals)) - domain_min;
4991           HOST_WIDE_INT hi_index
4992             = TREE_INT_CST_LOW (TREE_VALUE (vals)) - domain_min;
4993           if (lo_index < 0 || lo_index >= bit_size
4994             || hi_index < 0 || hi_index >= bit_size)
4995             abort ();
4996           for ( ; lo_index <= hi_index; lo_index++)
4997             buffer[lo_index] = 1;
4998         }
4999       else
5000         {
5001           /* Set a single bit to one.  */
5002           HOST_WIDE_INT index
5003             = TREE_INT_CST_LOW (TREE_VALUE (vals)) - domain_min;
5004           if (index < 0 || index >= bit_size)
5005             {
5006               error ("invalid initializer for bit string");
5007               return NULL_TREE;
5008             }
5009           buffer[index] = 1;
5010         }
5011     }
5012   return non_const_bits;
5013 }
5014
5015 /* Expand (the constant part of) a SET_TYPE CONSTRUCTOR node.
5016    The result is placed in BUFFER (which is an array of bytes).
5017    If the constructor is constant, NULL_TREE is returned.
5018    Otherwise, a TREE_LIST of the non-constant elements is emitted.  */
5019
5020 tree
5021 get_set_constructor_bytes (init, buffer, wd_size)
5022      tree init;
5023      unsigned char *buffer;
5024      int wd_size;
5025 {
5026   int i;
5027   int set_word_size = BITS_PER_UNIT;
5028   int bit_size = wd_size * set_word_size;
5029   int bit_pos = 0;
5030   unsigned char *bytep = buffer;
5031   char *bit_buffer = (char *) alloca(bit_size);
5032   tree non_const_bits = get_set_constructor_bits (init, bit_buffer, bit_size);
5033
5034   for (i = 0; i < wd_size; i++)
5035     buffer[i] = 0;
5036
5037   for (i = 0; i < bit_size; i++)
5038     {
5039       if (bit_buffer[i])
5040         {
5041           if (BYTES_BIG_ENDIAN)
5042             *bytep |= (1 << (set_word_size - 1 - bit_pos));
5043           else
5044             *bytep |= 1 << bit_pos;
5045         }
5046       bit_pos++;
5047       if (bit_pos >= set_word_size)
5048         bit_pos = 0, bytep++;
5049     }
5050   return non_const_bits;
5051 }
5052 \f
5053 #ifdef ENABLE_CHECKING
5054
5055 /* Complain if the tree code does not match the expected one.
5056    NODE is the tree node in question, CODE is the expected tree code,
5057    and FILE and LINE are the filename and line number, respectively,
5058    of the line on which the check was done.  If NONFATAL is nonzero,
5059    don't abort if the reference is invalid; instead, return 0.
5060    If the reference is valid, return NODE.  */
5061
5062 tree
5063 tree_check (node, code, file, line, nofatal)
5064      tree node;
5065      enum tree_code code;
5066      const char *file;
5067      int line;
5068      int nofatal;
5069 {
5070   if (TREE_CODE (node) == code)
5071     return node;
5072   else if (nofatal)
5073     return 0;
5074   else
5075     fatal ("%s:%d: Expect %s, have %s\n", file, line,
5076            tree_code_name[code], tree_code_name[TREE_CODE (node)]);
5077 }
5078
5079 /* Similar to above, except that we check for a class of tree
5080    code, given in CL.  */
5081
5082 tree
5083 tree_class_check (node, cl, file, line, nofatal)
5084      tree node;
5085      char cl;
5086      const char *file;
5087      int line;
5088      int nofatal;
5089 {
5090   if (TREE_CODE_CLASS (TREE_CODE (node)) == cl)
5091     return node;
5092   else if (nofatal)
5093     return 0;
5094   else
5095     fatal ("%s:%d: Expect '%c', have '%s'\n", file, line,
5096            cl, tree_code_name[TREE_CODE (node)]);
5097 }
5098
5099 /* Likewise, but complain if the tree node is not an expression.  */
5100
5101 tree
5102 expr_check (node, ignored, file, line, nofatal)
5103      tree node;
5104      int ignored;
5105      const char *file;
5106      int line;
5107      int nofatal;
5108 {
5109   switch (TREE_CODE_CLASS (TREE_CODE (node)))
5110     {
5111     case 'r':
5112     case 's':
5113     case 'e':
5114     case '<':
5115     case '1':
5116     case '2':
5117       break;
5118
5119     default:
5120       if (nofatal)
5121         return 0;
5122       else
5123         fatal ("%s:%d: Expect expression, have '%s'\n", file, line,
5124                tree_code_name[TREE_CODE (node)]);
5125     }
5126
5127   return node;
5128 }
5129 #endif
5130
5131 /* Return the alias set for T, which may be either a type or an
5132    expression.  */
5133
5134 int
5135 get_alias_set (t)
5136      tree t;
5137 {
5138   if (!flag_strict_aliasing || !lang_get_alias_set)
5139     /* If we're not doing any lanaguage-specific alias analysis, just
5140        assume everything aliases everything else.  */
5141     return 0;
5142   else
5143     return (*lang_get_alias_set) (t);
5144 }
5145
5146 /* Return a brand-new alias set.  */
5147
5148 int
5149 new_alias_set ()
5150 {
5151   static int last_alias_set;
5152   if (flag_strict_aliasing)
5153     return ++last_alias_set;
5154   else
5155     return 0;
5156 }