OSDN Git Service

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