OSDN Git Service

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