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