OSDN Git Service

formatting tweaks
[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
1468 tree
1469 make_tree_vec (len)
1470      int len;
1471 {
1472   register tree t;
1473   register int length = (len-1) * sizeof (tree) + sizeof (struct tree_vec);
1474   register struct obstack *obstack = current_obstack;
1475   register int i;
1476
1477 #ifdef GATHER_STATISTICS
1478   tree_node_counts[(int)vec_kind]++;
1479   tree_node_sizes[(int)vec_kind] += length;
1480 #endif
1481
1482   t = (tree) obstack_alloc (obstack, length);
1483
1484   for (i = (length / sizeof (int)) - 1; i >= 0; i--)
1485     ((int *) t)[i] = 0;
1486
1487   TREE_SET_CODE (t, TREE_VEC);
1488   TREE_VEC_LENGTH (t) = len;
1489   if (obstack == &permanent_obstack)
1490     TREE_PERMANENT (t) = 1;
1491
1492   return t;
1493 }
1494 \f
1495 /* Return 1 if EXPR is the integer constant zero or a complex constant
1496    of zero.  */
1497
1498 int
1499 integer_zerop (expr)
1500      tree expr;
1501 {
1502   STRIP_NOPS (expr);
1503
1504   return ((TREE_CODE (expr) == INTEGER_CST
1505            && TREE_INT_CST_LOW (expr) == 0
1506            && TREE_INT_CST_HIGH (expr) == 0)
1507           || (TREE_CODE (expr) == COMPLEX_CST
1508               && integer_zerop (TREE_REALPART (expr))
1509               && integer_zerop (TREE_IMAGPART (expr))));
1510 }
1511
1512 /* Return 1 if EXPR is the integer constant one or the corresponding
1513    complex constant.  */
1514
1515 int
1516 integer_onep (expr)
1517      tree expr;
1518 {
1519   STRIP_NOPS (expr);
1520
1521   return ((TREE_CODE (expr) == INTEGER_CST
1522            && TREE_INT_CST_LOW (expr) == 1
1523            && TREE_INT_CST_HIGH (expr) == 0)
1524           || (TREE_CODE (expr) == COMPLEX_CST
1525               && integer_onep (TREE_REALPART (expr))
1526               && integer_zerop (TREE_IMAGPART (expr))));
1527 }
1528
1529 /* Return 1 if EXPR is an integer containing all 1's in as much precision as
1530    it contains.  Likewise for the corresponding complex constant.  */
1531
1532 int
1533 integer_all_onesp (expr)
1534      tree expr;
1535 {
1536   register int prec;
1537   register int uns;
1538
1539   STRIP_NOPS (expr);
1540
1541   if (TREE_CODE (expr) == COMPLEX_CST
1542       && integer_all_onesp (TREE_REALPART (expr))
1543       && integer_zerop (TREE_IMAGPART (expr)))
1544     return 1;
1545
1546   else if (TREE_CODE (expr) != INTEGER_CST)
1547     return 0;
1548
1549   uns = TREE_UNSIGNED (TREE_TYPE (expr));
1550   if (!uns)
1551     return TREE_INT_CST_LOW (expr) == -1 && TREE_INT_CST_HIGH (expr) == -1;
1552
1553   /* Note that using TYPE_PRECISION here is wrong.  We care about the
1554      actual bits, not the (arbitrary) range of the type.  */
1555   prec = GET_MODE_BITSIZE (TYPE_MODE (TREE_TYPE (expr)));
1556   if (prec >= HOST_BITS_PER_WIDE_INT)
1557     {
1558       int high_value, shift_amount;
1559
1560       shift_amount = prec - HOST_BITS_PER_WIDE_INT;
1561
1562       if (shift_amount > HOST_BITS_PER_WIDE_INT)
1563         /* Can not handle precisions greater than twice the host int size.  */
1564         abort ();
1565       else if (shift_amount == HOST_BITS_PER_WIDE_INT)
1566         /* Shifting by the host word size is undefined according to the ANSI
1567            standard, so we must handle this as a special case.  */
1568         high_value = -1;
1569       else
1570         high_value = ((HOST_WIDE_INT) 1 << shift_amount) - 1;
1571
1572       return TREE_INT_CST_LOW (expr) == -1
1573         && TREE_INT_CST_HIGH (expr) == high_value;
1574     }
1575   else
1576     return TREE_INT_CST_LOW (expr) == ((HOST_WIDE_INT) 1 << prec) - 1;
1577 }
1578
1579 /* Return 1 if EXPR is an integer constant that is a power of 2 (i.e., has only
1580    one bit on).  */
1581
1582 int
1583 integer_pow2p (expr)
1584      tree expr;
1585 {
1586   HOST_WIDE_INT high, low;
1587
1588   STRIP_NOPS (expr);
1589
1590   if (TREE_CODE (expr) == COMPLEX_CST
1591       && integer_pow2p (TREE_REALPART (expr))
1592       && integer_zerop (TREE_IMAGPART (expr)))
1593     return 1;
1594
1595   if (TREE_CODE (expr) != INTEGER_CST)
1596     return 0;
1597
1598   high = TREE_INT_CST_HIGH (expr);
1599   low = TREE_INT_CST_LOW (expr);
1600
1601   if (high == 0 && low == 0)
1602     return 0;
1603
1604   return ((high == 0 && (low & (low - 1)) == 0)
1605           || (low == 0 && (high & (high - 1)) == 0));
1606 }
1607
1608 /* Return 1 if EXPR is the real constant zero.  */
1609
1610 int
1611 real_zerop (expr)
1612      tree expr;
1613 {
1614   STRIP_NOPS (expr);
1615
1616   return ((TREE_CODE (expr) == REAL_CST
1617            && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst0))
1618           || (TREE_CODE (expr) == COMPLEX_CST
1619               && real_zerop (TREE_REALPART (expr))
1620               && real_zerop (TREE_IMAGPART (expr))));
1621 }
1622
1623 /* Return 1 if EXPR is the real constant one in real or complex form.  */
1624
1625 int
1626 real_onep (expr)
1627      tree expr;
1628 {
1629   STRIP_NOPS (expr);
1630
1631   return ((TREE_CODE (expr) == REAL_CST
1632            && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst1))
1633           || (TREE_CODE (expr) == COMPLEX_CST
1634               && real_onep (TREE_REALPART (expr))
1635               && real_zerop (TREE_IMAGPART (expr))));
1636 }
1637
1638 /* Return 1 if EXPR is the real constant two.  */
1639
1640 int
1641 real_twop (expr)
1642      tree expr;
1643 {
1644   STRIP_NOPS (expr);
1645
1646   return ((TREE_CODE (expr) == REAL_CST
1647            && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst2))
1648           || (TREE_CODE (expr) == COMPLEX_CST
1649               && real_twop (TREE_REALPART (expr))
1650               && real_zerop (TREE_IMAGPART (expr))));
1651 }
1652
1653 /* Nonzero if EXP is a constant or a cast of a constant.  */
1654  
1655 int
1656 really_constant_p (exp)
1657      tree exp;
1658 {
1659   /* This is not quite the same as STRIP_NOPS.  It does more.  */
1660   while (TREE_CODE (exp) == NOP_EXPR
1661          || TREE_CODE (exp) == CONVERT_EXPR
1662          || TREE_CODE (exp) == NON_LVALUE_EXPR)
1663     exp = TREE_OPERAND (exp, 0);
1664   return TREE_CONSTANT (exp);
1665 }
1666 \f
1667 /* Return first list element whose TREE_VALUE is ELEM.
1668    Return 0 if ELEM is not in LIST.  */
1669
1670 tree
1671 value_member (elem, list)
1672      tree elem, list;
1673 {
1674   while (list)
1675     {
1676       if (elem == TREE_VALUE (list))
1677         return list;
1678       list = TREE_CHAIN (list);
1679     }
1680   return NULL_TREE;
1681 }
1682
1683 /* Return first list element whose TREE_PURPOSE is ELEM.
1684    Return 0 if ELEM is not in LIST.  */
1685
1686 tree
1687 purpose_member (elem, list)
1688      tree elem, list;
1689 {
1690   while (list)
1691     {
1692       if (elem == TREE_PURPOSE (list))
1693         return list;
1694       list = TREE_CHAIN (list);
1695     }
1696   return NULL_TREE;
1697 }
1698
1699 /* Return first list element whose BINFO_TYPE is ELEM.
1700    Return 0 if ELEM is not in LIST.  */
1701
1702 tree
1703 binfo_member (elem, list)
1704      tree elem, list;
1705 {
1706   while (list)
1707     {
1708       if (elem == BINFO_TYPE (list))
1709         return list;
1710       list = TREE_CHAIN (list);
1711     }
1712   return NULL_TREE;
1713 }
1714
1715 /* Return nonzero if ELEM is part of the chain CHAIN.  */
1716
1717 int
1718 chain_member (elem, chain)
1719      tree elem, chain;
1720 {
1721   while (chain)
1722     {
1723       if (elem == chain)
1724         return 1;
1725       chain = TREE_CHAIN (chain);
1726     }
1727
1728   return 0;
1729 }
1730
1731 /* Return nonzero if ELEM is equal to TREE_VALUE (CHAIN) for any piece of
1732    chain CHAIN.  */
1733 /* ??? This function was added for machine specific attributes but is no
1734    longer used.  It could be deleted if we could confirm all front ends
1735    don't use it.  */
1736
1737 int
1738 chain_member_value (elem, chain)
1739      tree elem, chain;
1740 {
1741   while (chain)
1742     {
1743       if (elem == TREE_VALUE (chain))
1744         return 1;
1745       chain = TREE_CHAIN (chain);
1746     }
1747
1748   return 0;
1749 }
1750
1751 /* Return nonzero if ELEM is equal to TREE_PURPOSE (CHAIN)
1752    for any piece of chain CHAIN.  */
1753 /* ??? This function was added for machine specific attributes but is no
1754    longer used.  It could be deleted if we could confirm all front ends
1755    don't use it.  */
1756
1757 int
1758 chain_member_purpose (elem, chain)
1759      tree elem, chain;
1760 {
1761   while (chain)
1762     {
1763       if (elem == TREE_PURPOSE (chain))
1764         return 1;
1765       chain = TREE_CHAIN (chain);
1766     }
1767
1768   return 0;
1769 }
1770
1771 /* Return the length of a chain of nodes chained through TREE_CHAIN.
1772    We expect a null pointer to mark the end of the chain.
1773    This is the Lisp primitive `length'.  */
1774
1775 int
1776 list_length (t)
1777      tree t;
1778 {
1779   register tree tail;
1780   register int len = 0;
1781
1782   for (tail = t; tail; tail = TREE_CHAIN (tail))
1783     len++;
1784
1785   return len;
1786 }
1787
1788 /* Concatenate two chains of nodes (chained through TREE_CHAIN)
1789    by modifying the last node in chain 1 to point to chain 2.
1790    This is the Lisp primitive `nconc'.  */
1791
1792 tree
1793 chainon (op1, op2)
1794      tree op1, op2;
1795 {
1796
1797   if (op1)
1798     {
1799       register tree t1;
1800       register tree t2;
1801
1802       for (t1 = op1; TREE_CHAIN (t1); t1 = TREE_CHAIN (t1))
1803         ;
1804       TREE_CHAIN (t1) = op2;
1805       for (t2 = op2; t2; t2 = TREE_CHAIN (t2))
1806         if (t2 == t1)
1807           abort ();  /* Circularity created.  */
1808       return op1;
1809     }
1810   else return op2;
1811 }
1812
1813 /* Return the last node in a chain of nodes (chained through TREE_CHAIN).  */
1814
1815 tree
1816 tree_last (chain)
1817      register tree chain;
1818 {
1819   register tree next;
1820   if (chain)
1821     while (next = TREE_CHAIN (chain))
1822       chain = next;
1823   return chain;
1824 }
1825
1826 /* Reverse the order of elements in the chain T,
1827    and return the new head of the chain (old last element).  */
1828
1829 tree
1830 nreverse (t)
1831      tree t;
1832 {
1833   register tree prev = 0, decl, next;
1834   for (decl = t; decl; decl = next)
1835     {
1836       next = TREE_CHAIN (decl);
1837       TREE_CHAIN (decl) = prev;
1838       prev = decl;
1839     }
1840   return prev;
1841 }
1842
1843 /* Given a chain CHAIN of tree nodes,
1844    construct and return a list of those nodes.  */
1845
1846 tree
1847 listify (chain)
1848      tree chain;
1849 {
1850   tree result = NULL_TREE;
1851   tree in_tail = chain;
1852   tree out_tail = NULL_TREE;
1853
1854   while (in_tail)
1855     {
1856       tree next = tree_cons (NULL_TREE, in_tail, NULL_TREE);
1857       if (out_tail)
1858         TREE_CHAIN (out_tail) = next;
1859       else
1860         result = next;
1861       out_tail = next;
1862       in_tail = TREE_CHAIN (in_tail);
1863     }
1864
1865   return result;
1866 }
1867 \f
1868 /* Return a newly created TREE_LIST node whose
1869    purpose and value fields are PARM and VALUE.  */
1870
1871 tree
1872 build_tree_list (parm, value)
1873      tree parm, value;
1874 {
1875   register tree t = make_node (TREE_LIST);
1876   TREE_PURPOSE (t) = parm;
1877   TREE_VALUE (t) = value;
1878   return t;
1879 }
1880
1881 /* Similar, but build on the temp_decl_obstack.  */
1882
1883 tree
1884 build_decl_list (parm, value)
1885      tree parm, value;
1886 {
1887   register tree node;
1888   register struct obstack *ambient_obstack = current_obstack;
1889   current_obstack = &temp_decl_obstack;
1890   node = build_tree_list (parm, value);
1891   current_obstack = ambient_obstack;
1892   return node;
1893 }
1894
1895 /* Return a newly created TREE_LIST node whose
1896    purpose and value fields are PARM and VALUE
1897    and whose TREE_CHAIN is CHAIN.  */
1898
1899 tree
1900 tree_cons (purpose, value, chain)
1901      tree purpose, value, chain;
1902 {
1903 #if 0
1904   register tree node = make_node (TREE_LIST);
1905 #else
1906   register int i;
1907   register tree node = (tree) obstack_alloc (current_obstack, sizeof (struct tree_list));
1908 #ifdef GATHER_STATISTICS
1909   tree_node_counts[(int)x_kind]++;
1910   tree_node_sizes[(int)x_kind] += sizeof (struct tree_list);
1911 #endif
1912
1913   for (i = (sizeof (struct tree_common) / sizeof (int)) - 1; i >= 0; i--)
1914     ((int *) node)[i] = 0;
1915
1916   TREE_SET_CODE (node, TREE_LIST);
1917   if (current_obstack == &permanent_obstack)
1918     TREE_PERMANENT (node) = 1;
1919 #endif
1920
1921   TREE_CHAIN (node) = chain;
1922   TREE_PURPOSE (node) = purpose;
1923   TREE_VALUE (node) = value;
1924   return node;
1925 }
1926
1927 /* Similar, but build on the temp_decl_obstack.  */
1928
1929 tree
1930 decl_tree_cons (purpose, value, chain)
1931      tree purpose, value, chain;
1932 {
1933   register tree node;
1934   register struct obstack *ambient_obstack = current_obstack;
1935   current_obstack = &temp_decl_obstack;
1936   node = tree_cons (purpose, value, chain);
1937   current_obstack = ambient_obstack;
1938   return node;
1939 }
1940
1941 /* Same as `tree_cons' but make a permanent object.  */
1942
1943 tree
1944 perm_tree_cons (purpose, value, chain)
1945      tree purpose, value, chain;
1946 {
1947   register tree node;
1948   register struct obstack *ambient_obstack = current_obstack;
1949   current_obstack = &permanent_obstack;
1950
1951   node = tree_cons (purpose, value, chain);
1952   current_obstack = ambient_obstack;
1953   return node;
1954 }
1955
1956 /* Same as `tree_cons', but make this node temporary, regardless.  */
1957
1958 tree
1959 temp_tree_cons (purpose, value, chain)
1960      tree purpose, value, chain;
1961 {
1962   register tree node;
1963   register struct obstack *ambient_obstack = current_obstack;
1964   current_obstack = &temporary_obstack;
1965
1966   node = tree_cons (purpose, value, chain);
1967   current_obstack = ambient_obstack;
1968   return node;
1969 }
1970
1971 /* Same as `tree_cons', but save this node if the function's RTL is saved.  */
1972
1973 tree
1974 saveable_tree_cons (purpose, value, chain)
1975      tree purpose, value, chain;
1976 {
1977   register tree node;
1978   register struct obstack *ambient_obstack = current_obstack;
1979   current_obstack = saveable_obstack;
1980
1981   node = tree_cons (purpose, value, chain);
1982   current_obstack = ambient_obstack;
1983   return node;
1984 }
1985 \f
1986 /* Return the size nominally occupied by an object of type TYPE
1987    when it resides in memory.  The value is measured in units of bytes,
1988    and its data type is that normally used for type sizes
1989    (which is the first type created by make_signed_type or
1990    make_unsigned_type).  */
1991
1992 tree
1993 size_in_bytes (type)
1994      tree type;
1995 {
1996   tree t;
1997
1998   if (type == error_mark_node)
1999     return integer_zero_node;
2000   type = TYPE_MAIN_VARIANT (type);
2001   if (TYPE_SIZE (type) == 0)
2002     {
2003       incomplete_type_error (NULL_TREE, type);
2004       return integer_zero_node;
2005     }
2006   t = size_binop (CEIL_DIV_EXPR, TYPE_SIZE (type),
2007                   size_int (BITS_PER_UNIT));
2008   if (TREE_CODE (t) == INTEGER_CST)
2009     force_fit_type (t, 0);
2010   return t;
2011 }
2012
2013 /* Return the size of TYPE (in bytes) as an integer,
2014    or return -1 if the size can vary.  */
2015
2016 int
2017 int_size_in_bytes (type)
2018      tree type;
2019 {
2020   unsigned int size;
2021   if (type == error_mark_node)
2022     return 0;
2023   type = TYPE_MAIN_VARIANT (type);
2024   if (TYPE_SIZE (type) == 0)
2025     return -1;
2026   if (TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST)
2027     return -1;
2028   if (TREE_INT_CST_HIGH (TYPE_SIZE (type)) != 0)
2029     {
2030       tree t = size_binop (CEIL_DIV_EXPR, TYPE_SIZE (type),
2031                            size_int (BITS_PER_UNIT));
2032       return TREE_INT_CST_LOW (t);
2033     }
2034   size = TREE_INT_CST_LOW (TYPE_SIZE (type));
2035   return (size + BITS_PER_UNIT - 1) / BITS_PER_UNIT;
2036 }
2037 \f
2038 /* Return, as a tree node, the number of elements for TYPE (which is an
2039    ARRAY_TYPE) minus one. This counts only elements of the top array.  */
2040
2041 tree
2042 array_type_nelts (type)
2043      tree type;
2044 {
2045   tree index_type = TYPE_DOMAIN (type);
2046
2047   return (integer_zerop (TYPE_MIN_VALUE (index_type))
2048           ? TYPE_MAX_VALUE (index_type)
2049           : fold (build (MINUS_EXPR, TREE_TYPE (TYPE_MAX_VALUE (index_type)),
2050                          TYPE_MAX_VALUE (index_type),
2051                          TYPE_MIN_VALUE (index_type))));
2052 }
2053 \f
2054 /* Return nonzero if arg is static -- a reference to an object in
2055    static storage.  This is not the same as the C meaning of `static'.  */
2056
2057 int
2058 staticp (arg)
2059      tree arg;
2060 {
2061   switch (TREE_CODE (arg))
2062     {
2063     case FUNCTION_DECL:
2064       /* Nested functions aren't static, since taking their address
2065          involves a trampoline.  */
2066        return decl_function_context (arg) == 0 || DECL_NO_STATIC_CHAIN (arg);
2067     case VAR_DECL:
2068       return TREE_STATIC (arg) || DECL_EXTERNAL (arg);
2069
2070     case CONSTRUCTOR:
2071       return TREE_STATIC (arg);
2072
2073     case STRING_CST:
2074       return 1;
2075
2076     case COMPONENT_REF:
2077     case BIT_FIELD_REF:
2078       return staticp (TREE_OPERAND (arg, 0));
2079
2080 #if 0
2081        /* This case is technically correct, but results in setting
2082           TREE_CONSTANT on ADDR_EXPRs that cannot be evaluated at
2083           compile time.  */
2084     case INDIRECT_REF:
2085       return TREE_CONSTANT (TREE_OPERAND (arg, 0));
2086 #endif
2087
2088     case ARRAY_REF:
2089       if (TREE_CODE (TYPE_SIZE (TREE_TYPE (arg))) == INTEGER_CST
2090           && TREE_CODE (TREE_OPERAND (arg, 1)) == INTEGER_CST)
2091         return staticp (TREE_OPERAND (arg, 0));
2092     }
2093
2094   return 0;
2095 }
2096 \f
2097 /* Wrap a SAVE_EXPR around EXPR, if appropriate.
2098    Do this to any expression which may be used in more than one place,
2099    but must be evaluated only once.
2100
2101    Normally, expand_expr would reevaluate the expression each time.
2102    Calling save_expr produces something that is evaluated and recorded
2103    the first time expand_expr is called on it.  Subsequent calls to
2104    expand_expr just reuse the recorded value.
2105
2106    The call to expand_expr that generates code that actually computes
2107    the value is the first call *at compile time*.  Subsequent calls
2108    *at compile time* generate code to use the saved value.
2109    This produces correct result provided that *at run time* control
2110    always flows through the insns made by the first expand_expr
2111    before reaching the other places where the save_expr was evaluated.
2112    You, the caller of save_expr, must make sure this is so.
2113
2114    Constants, and certain read-only nodes, are returned with no
2115    SAVE_EXPR because that is safe.  Expressions containing placeholders
2116    are not touched; see tree.def for an explanation of what these
2117    are used for.  */
2118
2119 tree
2120 save_expr (expr)
2121      tree expr;
2122 {
2123   register tree t = fold (expr);
2124
2125   /* We don't care about whether this can be used as an lvalue in this
2126      context.  */
2127   while (TREE_CODE (t) == NON_LVALUE_EXPR)
2128     t = TREE_OPERAND (t, 0);
2129
2130   /* If the tree evaluates to a constant, then we don't want to hide that
2131      fact (i.e. this allows further folding, and direct checks for constants).
2132      However, a read-only object that has side effects cannot be bypassed.
2133      Since it is no problem to reevaluate literals, we just return the 
2134      literal node.  */
2135
2136   if (TREE_CONSTANT (t) || (TREE_READONLY (t) && ! TREE_SIDE_EFFECTS (t))
2137       || TREE_CODE (t) == SAVE_EXPR || TREE_CODE (t) == ERROR_MARK)
2138     return t;
2139
2140   /* If T contains a PLACEHOLDER_EXPR, we must evaluate it each time, since
2141      it means that the size or offset of some field of an object depends on
2142      the value within another field.
2143
2144      Note that it must not be the case that T contains both a PLACEHOLDER_EXPR
2145      and some variable since it would then need to be both evaluated once and
2146      evaluated more than once.  Front-ends must assure this case cannot
2147      happen by surrounding any such subexpressions in their own SAVE_EXPR
2148      and forcing evaluation at the proper time.  */
2149   if (contains_placeholder_p (t))
2150     return t;
2151
2152   t = build (SAVE_EXPR, TREE_TYPE (expr), t, current_function_decl, NULL_TREE);
2153
2154   /* This expression might be placed ahead of a jump to ensure that the
2155      value was computed on both sides of the jump.  So make sure it isn't
2156      eliminated as dead.  */
2157   TREE_SIDE_EFFECTS (t) = 1;
2158   return t;
2159 }
2160
2161 /* Arrange for an expression to be expanded multiple independent
2162    times.  This is useful for cleanup actions, as the backend can
2163    expand them multiple times in different places.  */
2164
2165 tree
2166 unsave_expr (expr)
2167      tree expr;
2168 {
2169   tree t;
2170
2171   /* If this is already protected, no sense in protecting it again.  */
2172   if (TREE_CODE (expr) == UNSAVE_EXPR)
2173     return expr;
2174
2175   t = build1 (UNSAVE_EXPR, TREE_TYPE (expr), expr);
2176   TREE_SIDE_EFFECTS (t) = TREE_SIDE_EFFECTS (expr);
2177   return t;
2178 }
2179
2180 /* Modify a tree in place so that all the evaluate only once things
2181    are cleared out.  Return the EXPR given.  */
2182
2183 tree
2184 unsave_expr_now (expr)
2185      tree expr;
2186 {
2187   enum tree_code code;
2188   register int i;
2189
2190   if (expr == NULL_TREE)
2191     return expr;
2192
2193   code = TREE_CODE (expr);
2194   switch (code)
2195     {
2196     case SAVE_EXPR:
2197       SAVE_EXPR_RTL (expr) = 0;
2198       break;
2199
2200     case TARGET_EXPR:
2201       TREE_OPERAND (expr, 1) = TREE_OPERAND (expr, 3);
2202       TREE_OPERAND (expr, 3) = NULL_TREE;
2203       break;
2204       
2205     case RTL_EXPR:
2206       /* I don't yet know how to emit a sequence multiple times.  */
2207       if (RTL_EXPR_SEQUENCE (expr) != 0)
2208         abort ();
2209       break;
2210
2211     case CALL_EXPR:
2212       CALL_EXPR_RTL (expr) = 0;
2213       if (TREE_OPERAND (expr, 1)
2214           && TREE_CODE (TREE_OPERAND (expr, 1)) == TREE_LIST)
2215         {
2216           tree exp = TREE_OPERAND (expr, 1);
2217           while (exp)
2218             {
2219               unsave_expr_now (TREE_VALUE (exp));
2220               exp = TREE_CHAIN (exp);
2221             }
2222         }
2223       break;
2224     }
2225
2226   switch (TREE_CODE_CLASS (code))
2227     {
2228     case 'c':  /* a constant */
2229     case 't':  /* a type node */
2230     case 'x':  /* something random, like an identifier or an ERROR_MARK.  */
2231     case 'd':  /* A decl node */
2232     case 'b':  /* A block node */
2233       return expr;
2234
2235     case 'e':  /* an expression */
2236     case 'r':  /* a reference */
2237     case 's':  /* an expression with side effects */
2238     case '<':  /* a comparison expression */
2239     case '2':  /* a binary arithmetic expression */
2240     case '1':  /* a unary arithmetic expression */
2241       for (i = tree_code_length[(int) code] - 1; i >= 0; i--)
2242         unsave_expr_now (TREE_OPERAND (expr, i));
2243       return expr;
2244
2245     default:
2246       abort ();
2247     }
2248 }
2249 \f
2250 /* Return 1 if EXP contains a PLACEHOLDER_EXPR; i.e., if it represents a size
2251    or offset that depends on a field within a record.
2252
2253    Note that we only allow such expressions within simple arithmetic
2254    or a COND_EXPR.  */
2255
2256 int
2257 contains_placeholder_p (exp)
2258      tree exp;
2259 {
2260   register enum tree_code code = TREE_CODE (exp);
2261   tree inner;
2262
2263   /* If we have a WITH_RECORD_EXPR, it "cancels" any PLACEHOLDER_EXPR
2264      in it since it is supplying a value for it.  */
2265   if (code == WITH_RECORD_EXPR)
2266     return 0;
2267
2268   switch (TREE_CODE_CLASS (code))
2269     {
2270     case 'r':
2271       for (inner = TREE_OPERAND (exp, 0);
2272            TREE_CODE_CLASS (TREE_CODE (inner)) == 'r';
2273            inner = TREE_OPERAND (inner, 0))
2274         ;
2275       return TREE_CODE (inner) == PLACEHOLDER_EXPR;
2276
2277     case '1':
2278     case '2':  case '<':
2279     case 'e':
2280       switch (tree_code_length[(int) code])
2281         {
2282         case 1:
2283           return contains_placeholder_p (TREE_OPERAND (exp, 0));
2284         case 2:
2285           return (code != RTL_EXPR
2286                   && code != CONSTRUCTOR
2287                   && ! (code == SAVE_EXPR && SAVE_EXPR_RTL (exp) != 0)
2288                   && code != WITH_RECORD_EXPR
2289                   && (contains_placeholder_p (TREE_OPERAND (exp, 0))
2290                       || contains_placeholder_p (TREE_OPERAND (exp, 1))));
2291         case 3:
2292           return (code == COND_EXPR
2293                   && (contains_placeholder_p (TREE_OPERAND (exp, 0))
2294                       || contains_placeholder_p (TREE_OPERAND (exp, 1))
2295                       || contains_placeholder_p (TREE_OPERAND (exp, 2))));
2296         }
2297     }
2298
2299   return 0;
2300 }
2301 \f
2302 /* Given a tree EXP, a FIELD_DECL F, and a replacement value R,
2303    return a tree with all occurrences of references to F in a
2304    PLACEHOLDER_EXPR replaced by R.   Note that we assume here that EXP
2305    contains only arithmetic expressions.  */
2306
2307 tree
2308 substitute_in_expr (exp, f, r)
2309      tree exp;
2310      tree f;
2311      tree r;
2312 {
2313   enum tree_code code = TREE_CODE (exp);
2314   tree op0, op1, op2;
2315   tree new = 0;
2316   tree inner;
2317
2318   switch (TREE_CODE_CLASS (code))
2319     {
2320     case 'c':
2321     case 'd':
2322       return exp;
2323
2324     case 'x':
2325       if (code == PLACEHOLDER_EXPR)
2326         return exp;
2327       break;
2328
2329     case '1':
2330     case '2':
2331     case '<':
2332     case 'e':
2333       switch (tree_code_length[(int) code])
2334         {
2335         case 1:
2336           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2337           if (op0 == TREE_OPERAND (exp, 0))
2338             return exp;
2339           
2340           new = fold (build1 (code, TREE_TYPE (exp), op0));
2341           break;
2342
2343         case 2:
2344           /* An RTL_EXPR cannot contain a PLACEHOLDER_EXPR; a CONSTRUCTOR
2345              could, but we don't support it.  */
2346           if (code == RTL_EXPR)
2347             return exp;
2348           else if (code == CONSTRUCTOR)
2349             abort ();
2350
2351           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2352           op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
2353           if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1))
2354             return exp;
2355
2356           new = fold (build (code, TREE_TYPE (exp), op0, op1));
2357           break;
2358
2359         case 3:
2360           /* It cannot be that anything inside a SAVE_EXPR contains a
2361              PLACEHOLDER_EXPR.  */
2362           if (code == SAVE_EXPR)
2363             return exp;
2364
2365           if (code != COND_EXPR)
2366             abort ();
2367
2368           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2369           op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
2370           op2 = substitute_in_expr (TREE_OPERAND (exp, 2), f, r);
2371           if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1)
2372               && op2 == TREE_OPERAND (exp, 2))
2373             return exp;
2374
2375           new = fold (build (code, TREE_TYPE (exp), op0, op1, op2));
2376         }
2377
2378       break;
2379
2380     case 'r':
2381       switch (code)
2382         {
2383         case COMPONENT_REF:
2384           /* If this expression is getting a value from a PLACEHOLDER_EXPR
2385              and it is the right field, replace it with R.  */
2386           for (inner = TREE_OPERAND (exp, 0);
2387                TREE_CODE_CLASS (TREE_CODE (inner)) == 'r';
2388                inner = TREE_OPERAND (inner, 0))
2389             ;
2390           if (TREE_CODE (inner) == PLACEHOLDER_EXPR
2391               && TREE_OPERAND (exp, 1) == f)
2392             return r;
2393
2394           /* If this expression hasn't been completed let, leave it 
2395              alone.  */
2396           if (TREE_CODE (inner) == PLACEHOLDER_EXPR
2397               && TREE_TYPE (inner) == 0)
2398             return exp;
2399
2400           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2401           if (op0 == TREE_OPERAND (exp, 0))
2402             return exp;
2403
2404           new = fold (build (code, TREE_TYPE (exp), op0,
2405                              TREE_OPERAND (exp, 1)));
2406           break;
2407
2408         case BIT_FIELD_REF:
2409           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2410           op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
2411           op2 = substitute_in_expr (TREE_OPERAND (exp, 2), f, r);
2412           if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1)
2413               && op2 == TREE_OPERAND (exp, 2))
2414             return exp;
2415
2416           new = fold (build (code, TREE_TYPE (exp), op0, op1, op2));
2417           break;
2418
2419         case INDIRECT_REF:
2420         case BUFFER_REF:
2421           op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
2422           if (op0 == TREE_OPERAND (exp, 0))
2423             return exp;
2424
2425           new = fold (build1 (code, TREE_TYPE (exp), op0));
2426           break;
2427         }
2428     }
2429
2430   /* If it wasn't one of the cases we handle, give up.  */
2431   if (new == 0)
2432     abort ();
2433
2434   TREE_READONLY (new) = TREE_READONLY (exp);
2435   return new;
2436 }
2437 \f
2438 /* Stabilize a reference so that we can use it any number of times
2439    without causing its operands to be evaluated more than once.
2440    Returns the stabilized reference.  This works by means of save_expr,
2441    so see the caveats in the comments about save_expr.
2442
2443    Also allows conversion expressions whose operands are references.
2444    Any other kind of expression is returned unchanged.  */
2445
2446 tree
2447 stabilize_reference (ref)
2448      tree ref;
2449 {
2450   register tree result;
2451   register enum tree_code code = TREE_CODE (ref);
2452
2453   switch (code)
2454     {
2455     case VAR_DECL:
2456     case PARM_DECL:
2457     case RESULT_DECL:
2458       /* No action is needed in this case.  */
2459       return ref;
2460
2461     case NOP_EXPR:
2462     case CONVERT_EXPR:
2463     case FLOAT_EXPR:
2464     case FIX_TRUNC_EXPR:
2465     case FIX_FLOOR_EXPR:
2466     case FIX_ROUND_EXPR:
2467     case FIX_CEIL_EXPR:
2468       result = build_nt (code, stabilize_reference (TREE_OPERAND (ref, 0)));
2469       break;
2470
2471     case INDIRECT_REF:
2472       result = build_nt (INDIRECT_REF,
2473                          stabilize_reference_1 (TREE_OPERAND (ref, 0)));
2474       break;
2475
2476     case COMPONENT_REF:
2477       result = build_nt (COMPONENT_REF,
2478                          stabilize_reference (TREE_OPERAND (ref, 0)),
2479                          TREE_OPERAND (ref, 1));
2480       break;
2481
2482     case BIT_FIELD_REF:
2483       result = build_nt (BIT_FIELD_REF,
2484                          stabilize_reference (TREE_OPERAND (ref, 0)),
2485                          stabilize_reference_1 (TREE_OPERAND (ref, 1)),
2486                          stabilize_reference_1 (TREE_OPERAND (ref, 2)));
2487       break;
2488
2489     case ARRAY_REF:
2490       result = build_nt (ARRAY_REF,
2491                          stabilize_reference (TREE_OPERAND (ref, 0)),
2492                          stabilize_reference_1 (TREE_OPERAND (ref, 1)));
2493       break;
2494
2495     case COMPOUND_EXPR:
2496       /* We cannot wrap the first expression in a SAVE_EXPR, as then
2497          it wouldn't be ignored.  This matters when dealing with
2498          volatiles.  */
2499       return stabilize_reference_1 (ref);
2500
2501     case RTL_EXPR:
2502       result = build1 (INDIRECT_REF, TREE_TYPE (ref),
2503                        save_expr (build1 (ADDR_EXPR,
2504                                           build_pointer_type (TREE_TYPE (ref)),
2505                                           ref)));
2506       break;
2507
2508
2509       /* If arg isn't a kind of lvalue we recognize, make no change.
2510          Caller should recognize the error for an invalid lvalue.  */
2511     default:
2512       return ref;
2513
2514     case ERROR_MARK:
2515       return error_mark_node;
2516     }
2517
2518   TREE_TYPE (result) = TREE_TYPE (ref);
2519   TREE_READONLY (result) = TREE_READONLY (ref);
2520   TREE_SIDE_EFFECTS (result) = TREE_SIDE_EFFECTS (ref);
2521   TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
2522   TREE_RAISES (result) = TREE_RAISES (ref);
2523
2524   return result;
2525 }
2526
2527 /* Subroutine of stabilize_reference; this is called for subtrees of
2528    references.  Any expression with side-effects must be put in a SAVE_EXPR
2529    to ensure that it is only evaluated once.
2530
2531    We don't put SAVE_EXPR nodes around everything, because assigning very
2532    simple expressions to temporaries causes us to miss good opportunities
2533    for optimizations.  Among other things, the opportunity to fold in the
2534    addition of a constant into an addressing mode often gets lost, e.g.
2535    "y[i+1] += x;".  In general, we take the approach that we should not make
2536    an assignment unless we are forced into it - i.e., that any non-side effect
2537    operator should be allowed, and that cse should take care of coalescing
2538    multiple utterances of the same expression should that prove fruitful.  */
2539
2540 tree
2541 stabilize_reference_1 (e)
2542      tree e;
2543 {
2544   register tree result;
2545   register enum tree_code code = TREE_CODE (e);
2546
2547   /* We cannot ignore const expressions because it might be a reference
2548      to a const array but whose index contains side-effects.  But we can
2549      ignore things that are actual constant or that already have been
2550      handled by this function.  */
2551
2552   if (TREE_CONSTANT (e) || code == SAVE_EXPR)
2553     return e;
2554
2555   switch (TREE_CODE_CLASS (code))
2556     {
2557     case 'x':
2558     case 't':
2559     case 'd':
2560     case 'b':
2561     case '<':
2562     case 's':
2563     case 'e':
2564     case 'r':
2565       /* If the expression has side-effects, then encase it in a SAVE_EXPR
2566          so that it will only be evaluated once.  */
2567       /* The reference (r) and comparison (<) classes could be handled as
2568          below, but it is generally faster to only evaluate them once.  */
2569       if (TREE_SIDE_EFFECTS (e))
2570         return save_expr (e);
2571       return e;
2572
2573     case 'c':
2574       /* Constants need no processing.  In fact, we should never reach
2575          here.  */
2576       return e;
2577       
2578     case '2':
2579       /* Division is slow and tends to be compiled with jumps,
2580          especially the division by powers of 2 that is often
2581          found inside of an array reference.  So do it just once.  */
2582       if (code == TRUNC_DIV_EXPR || code == TRUNC_MOD_EXPR
2583           || code == FLOOR_DIV_EXPR || code == FLOOR_MOD_EXPR
2584           || code == CEIL_DIV_EXPR || code == CEIL_MOD_EXPR
2585           || code == ROUND_DIV_EXPR || code == ROUND_MOD_EXPR)
2586         return save_expr (e);
2587       /* Recursively stabilize each operand.  */
2588       result = build_nt (code, stabilize_reference_1 (TREE_OPERAND (e, 0)),
2589                          stabilize_reference_1 (TREE_OPERAND (e, 1)));
2590       break;
2591
2592     case '1':
2593       /* Recursively stabilize each operand.  */
2594       result = build_nt (code, stabilize_reference_1 (TREE_OPERAND (e, 0)));
2595       break;
2596
2597     default:
2598       abort ();
2599     }
2600   
2601   TREE_TYPE (result) = TREE_TYPE (e);
2602   TREE_READONLY (result) = TREE_READONLY (e);
2603   TREE_SIDE_EFFECTS (result) = TREE_SIDE_EFFECTS (e);
2604   TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
2605   TREE_RAISES (result) = TREE_RAISES (e);
2606
2607   return result;
2608 }
2609 \f
2610 /* Low-level constructors for expressions.  */
2611
2612 /* Build an expression of code CODE, data type TYPE,
2613    and operands as specified by the arguments ARG1 and following arguments.
2614    Expressions and reference nodes can be created this way.
2615    Constants, decls, types and misc nodes cannot be.  */
2616
2617 tree
2618 build VPROTO((enum tree_code code, tree tt, ...))
2619 {
2620 #ifndef __STDC__
2621   enum tree_code code;
2622   tree tt;
2623 #endif
2624   va_list p;
2625   register tree t;
2626   register int length;
2627   register int i;
2628
2629   VA_START (p, tt);
2630
2631 #ifndef __STDC__
2632   code = va_arg (p, enum tree_code);
2633   tt = va_arg (p, tree);
2634 #endif
2635
2636   t = make_node (code);
2637   length = tree_code_length[(int) code];
2638   TREE_TYPE (t) = tt;
2639
2640   if (length == 2)
2641     {
2642       /* This is equivalent to the loop below, but faster.  */
2643       register tree arg0 = va_arg (p, tree);
2644       register tree arg1 = va_arg (p, tree);
2645       TREE_OPERAND (t, 0) = arg0;
2646       TREE_OPERAND (t, 1) = arg1;
2647       if ((arg0 && TREE_SIDE_EFFECTS (arg0))
2648           || (arg1 && TREE_SIDE_EFFECTS (arg1)))
2649         TREE_SIDE_EFFECTS (t) = 1;
2650       TREE_RAISES (t)
2651         = (arg0 && TREE_RAISES (arg0)) || (arg1 && TREE_RAISES (arg1));
2652     }
2653   else if (length == 1)
2654     {
2655       register tree arg0 = va_arg (p, tree);
2656
2657       /* Call build1 for this!  */
2658       if (TREE_CODE_CLASS (code) != 's')
2659         abort ();
2660       TREE_OPERAND (t, 0) = arg0;
2661       if (arg0 && TREE_SIDE_EFFECTS (arg0))
2662         TREE_SIDE_EFFECTS (t) = 1;
2663       TREE_RAISES (t) = (arg0 && TREE_RAISES (arg0));
2664     }
2665   else
2666     {
2667       for (i = 0; i < length; i++)
2668         {
2669           register tree operand = va_arg (p, tree);
2670           TREE_OPERAND (t, i) = operand;
2671           if (operand)
2672             {
2673               if (TREE_SIDE_EFFECTS (operand))
2674                 TREE_SIDE_EFFECTS (t) = 1;
2675               if (TREE_RAISES (operand))
2676                 TREE_RAISES (t) = 1;
2677             }
2678         }
2679     }
2680   va_end (p);
2681   return t;
2682 }
2683
2684 /* Same as above, but only builds for unary operators.
2685    Saves lions share of calls to `build'; cuts down use
2686    of varargs, which is expensive for RISC machines.  */
2687
2688 tree
2689 build1 (code, type, node)
2690      enum tree_code code;
2691      tree type;
2692      tree node;
2693 {
2694   register struct obstack *obstack = current_obstack;
2695   register int i, length;
2696   register tree_node_kind kind;
2697   register tree t;
2698
2699 #ifdef GATHER_STATISTICS
2700   if (TREE_CODE_CLASS (code) == 'r')
2701     kind = r_kind;
2702   else
2703     kind = e_kind;
2704 #endif
2705
2706   obstack = expression_obstack;
2707   length = sizeof (struct tree_exp);
2708
2709   t = (tree) obstack_alloc (obstack, length);
2710
2711 #ifdef GATHER_STATISTICS
2712   tree_node_counts[(int)kind]++;
2713   tree_node_sizes[(int)kind] += length;
2714 #endif
2715
2716   for (i = (length / sizeof (int)) - 1; i >= 0; i--)
2717     ((int *) t)[i] = 0;
2718
2719   TREE_TYPE (t) = type;
2720   TREE_SET_CODE (t, code);
2721
2722   if (obstack == &permanent_obstack)
2723     TREE_PERMANENT (t) = 1;
2724
2725   TREE_OPERAND (t, 0) = node;
2726   if (node)
2727     {
2728       if (TREE_SIDE_EFFECTS (node))
2729         TREE_SIDE_EFFECTS (t) = 1;
2730       if (TREE_RAISES (node))
2731         TREE_RAISES (t) = 1;
2732     }
2733
2734   return t;
2735 }
2736
2737 /* Similar except don't specify the TREE_TYPE
2738    and leave the TREE_SIDE_EFFECTS as 0.
2739    It is permissible for arguments to be null,
2740    or even garbage if their values do not matter.  */
2741
2742 tree
2743 build_nt VPROTO((enum tree_code code, ...))
2744 {
2745 #ifndef __STDC__
2746   enum tree_code code;
2747 #endif
2748   va_list p;
2749   register tree t;
2750   register int length;
2751   register int i;
2752
2753   VA_START (p, code);
2754
2755 #ifndef __STDC__
2756   code = va_arg (p, enum tree_code);
2757 #endif
2758
2759   t = make_node (code);
2760   length = tree_code_length[(int) code];
2761
2762   for (i = 0; i < length; i++)
2763     TREE_OPERAND (t, i) = va_arg (p, tree);
2764
2765   va_end (p);
2766   return t;
2767 }
2768
2769 /* Similar to `build_nt', except we build
2770    on the temp_decl_obstack, regardless.  */
2771
2772 tree
2773 build_parse_node VPROTO((enum tree_code code, ...))
2774 {
2775 #ifndef __STDC__
2776   enum tree_code code;
2777 #endif
2778   register struct obstack *ambient_obstack = expression_obstack;
2779   va_list p;
2780   register tree t;
2781   register int length;
2782   register int i;
2783
2784   VA_START (p, code);
2785
2786 #ifndef __STDC__
2787   code = va_arg (p, enum tree_code);
2788 #endif
2789
2790   expression_obstack = &temp_decl_obstack;
2791
2792   t = make_node (code);
2793   length = tree_code_length[(int) code];
2794
2795   for (i = 0; i < length; i++)
2796     TREE_OPERAND (t, i) = va_arg (p, tree);
2797
2798   va_end (p);
2799   expression_obstack = ambient_obstack;
2800   return t;
2801 }
2802
2803 #if 0
2804 /* Commented out because this wants to be done very
2805    differently.  See cp-lex.c.  */
2806 tree
2807 build_op_identifier (op1, op2)
2808      tree op1, op2;
2809 {
2810   register tree t = make_node (OP_IDENTIFIER);
2811   TREE_PURPOSE (t) = op1;
2812   TREE_VALUE (t) = op2;
2813   return t;
2814 }
2815 #endif
2816 \f
2817 /* Create a DECL_... node of code CODE, name NAME and data type TYPE.
2818    We do NOT enter this node in any sort of symbol table.
2819
2820    layout_decl is used to set up the decl's storage layout.
2821    Other slots are initialized to 0 or null pointers.  */
2822
2823 tree
2824 build_decl (code, name, type)
2825      enum tree_code code;
2826      tree name, type;
2827 {
2828   register tree t;
2829
2830   t = make_node (code);
2831
2832 /*  if (type == error_mark_node)
2833     type = integer_type_node; */
2834 /* That is not done, deliberately, so that having error_mark_node
2835    as the type can suppress useless errors in the use of this variable.  */
2836
2837   DECL_NAME (t) = name;
2838   DECL_ASSEMBLER_NAME (t) = name;
2839   TREE_TYPE (t) = type;
2840
2841   if (code == VAR_DECL || code == PARM_DECL || code == RESULT_DECL)
2842     layout_decl (t, 0);
2843   else if (code == FUNCTION_DECL)
2844     DECL_MODE (t) = FUNCTION_MODE;
2845
2846   return t;
2847 }
2848 \f
2849 /* BLOCK nodes are used to represent the structure of binding contours
2850    and declarations, once those contours have been exited and their contents
2851    compiled.  This information is used for outputting debugging info.  */
2852
2853 tree
2854 build_block (vars, tags, subblocks, supercontext, chain)
2855      tree vars, tags, subblocks, supercontext, chain;
2856 {
2857   register tree block = make_node (BLOCK);
2858   BLOCK_VARS (block) = vars;
2859   BLOCK_TYPE_TAGS (block) = tags;
2860   BLOCK_SUBBLOCKS (block) = subblocks;
2861   BLOCK_SUPERCONTEXT (block) = supercontext;
2862   BLOCK_CHAIN (block) = chain;
2863   return block;
2864 }
2865 \f
2866 /* Return a declaration like DDECL except that its DECL_MACHINE_ATTRIBUTE
2867    is ATTRIBUTE.  */
2868
2869 tree
2870 build_decl_attribute_variant (ddecl, attribute)
2871      tree ddecl, attribute;
2872 {
2873   DECL_MACHINE_ATTRIBUTES (ddecl) = attribute;
2874   return ddecl;
2875 }
2876
2877 /* Return a type like TTYPE except that its TYPE_ATTRIBUTE
2878    is ATTRIBUTE.
2879
2880    Record such modified types already made so we don't make duplicates.  */
2881
2882 tree
2883 build_type_attribute_variant (ttype, attribute)
2884      tree ttype, attribute;
2885 {
2886   if ( ! attribute_list_equal (TYPE_ATTRIBUTES (ttype), attribute))
2887     {
2888       register int hashcode;
2889       register struct obstack *ambient_obstack = current_obstack;
2890       tree ntype;
2891
2892       if (ambient_obstack != &permanent_obstack)
2893         current_obstack = TYPE_OBSTACK (ttype);
2894
2895       ntype = copy_node (ttype);
2896       current_obstack = ambient_obstack;
2897
2898       TYPE_POINTER_TO (ntype) = 0;
2899       TYPE_REFERENCE_TO (ntype) = 0;
2900       TYPE_ATTRIBUTES (ntype) = attribute;
2901
2902       /* Create a new main variant of TYPE.  */
2903       TYPE_MAIN_VARIANT (ntype) = ntype;
2904       TYPE_NEXT_VARIANT (ntype) = 0;
2905       TYPE_READONLY (ntype) = TYPE_VOLATILE (ntype) = 0;
2906
2907       hashcode = TYPE_HASH (TREE_CODE (ntype))
2908                  + TYPE_HASH (TREE_TYPE (ntype))
2909                  + attribute_hash_list (attribute);
2910
2911       switch (TREE_CODE (ntype))
2912         {
2913           case FUNCTION_TYPE:
2914             hashcode += TYPE_HASH (TYPE_ARG_TYPES (ntype));
2915             break;
2916           case ARRAY_TYPE:
2917             hashcode += TYPE_HASH (TYPE_DOMAIN (ntype));
2918             break;
2919           case INTEGER_TYPE:
2920             hashcode += TYPE_HASH (TYPE_MAX_VALUE (ntype));
2921             break;
2922           case REAL_TYPE:
2923             hashcode += TYPE_HASH (TYPE_PRECISION (ntype));
2924             break;
2925         }
2926
2927       ntype = type_hash_canon (hashcode, ntype);
2928       ttype = build_type_variant (ntype, TYPE_READONLY (ttype),
2929                                   TYPE_VOLATILE (ttype));
2930     }
2931
2932   return ttype;
2933 }
2934
2935 /* Return a 1 if ATTR_NAME and ATTR_ARGS is valid for either declaration DECL
2936    or type TYPE and 0 otherwise.  Validity is determined the configuration
2937    macros VALID_MACHINE_DECL_ATTRIBUTE and VALID_MACHINE_TYPE_ATTRIBUTE.  */
2938
2939 int
2940 valid_machine_attribute (attr_name, attr_args, decl, type)
2941      tree attr_name, attr_args;
2942      tree decl;
2943      tree type;
2944 {
2945   int valid = 0;
2946   tree decl_attr_list = decl != 0 ? DECL_MACHINE_ATTRIBUTES (decl) : 0;
2947   tree type_attr_list = TYPE_ATTRIBUTES (type);
2948
2949   if (TREE_CODE (attr_name) != IDENTIFIER_NODE)
2950     abort ();
2951
2952 #ifdef VALID_MACHINE_DECL_ATTRIBUTE
2953   if (decl != 0
2954       && VALID_MACHINE_DECL_ATTRIBUTE (decl, decl_attr_list, attr_name, attr_args))
2955     {
2956       tree attr = lookup_attribute (IDENTIFIER_POINTER (attr_name),
2957                                     decl_attr_list);
2958
2959       if (attr != NULL_TREE)
2960         {
2961           /* Override existing arguments.  Declarations are unique so we can
2962              modify this in place.  */
2963           TREE_VALUE (attr) = attr_args;
2964         }
2965       else
2966         {
2967           decl_attr_list = tree_cons (attr_name, attr_args, decl_attr_list);
2968           decl = build_decl_attribute_variant (decl, decl_attr_list);
2969         }
2970
2971       valid = 1;
2972     }
2973 #endif
2974
2975 #ifdef VALID_MACHINE_TYPE_ATTRIBUTE
2976   if (VALID_MACHINE_TYPE_ATTRIBUTE (type, type_attr_list, attr_name, attr_args))
2977     {
2978       tree attr = lookup_attribute (IDENTIFIER_POINTER (attr_name),
2979                                     type_attr_list);
2980
2981       if (attr != NULL_TREE)
2982         {
2983           /* Override existing arguments.
2984              ??? This currently works since attribute arguments are not
2985              included in `attribute_hash_list'.  Something more complicated
2986              may be needed in the future.  */
2987           TREE_VALUE (attr) = attr_args;
2988         }
2989       else
2990         {
2991           type_attr_list = tree_cons (attr_name, attr_args, type_attr_list);
2992           type = build_type_attribute_variant (type, type_attr_list);
2993         }
2994       if (decl != 0)
2995         TREE_TYPE (decl) = type;
2996       valid = 1;
2997     }
2998
2999   /* Handle putting a type attribute on pointer-to-function-type by putting
3000      the attribute on the function type.  */
3001   else if (TREE_CODE (type) == POINTER_TYPE
3002            && TREE_CODE (TREE_TYPE (type)) == FUNCTION_TYPE
3003            && VALID_MACHINE_TYPE_ATTRIBUTE (TREE_TYPE (type), type_attr_list,
3004                                             attr_name, attr_args))
3005     {
3006       tree inner_type = TREE_TYPE (type);
3007       tree inner_attr_list = TYPE_ATTRIBUTES (inner_type);
3008       tree attr = lookup_attribute (IDENTIFIER_POINTER (attr_name),
3009                                     type_attr_list);
3010
3011       if (attr != NULL_TREE)
3012         TREE_VALUE (attr) = attr_args;
3013       else
3014         {
3015           inner_attr_list = tree_cons (attr_name, attr_args, inner_attr_list);
3016           inner_type = build_type_attribute_variant (inner_type,
3017                                                      inner_attr_list);
3018         }
3019
3020       if (decl != 0)
3021         TREE_TYPE (decl) = build_pointer_type (inner_type);
3022
3023       valid = 1;
3024     }
3025 #endif
3026
3027   return valid;
3028 }
3029
3030 /* Return non-zero if IDENT is a valid name for attribute ATTR,
3031    or zero if not.
3032
3033    We try both `text' and `__text__', ATTR may be either one.  */
3034 /* ??? It might be a reasonable simplification to require ATTR to be only
3035    `text'.  One might then also require attribute lists to be stored in
3036    their canonicalized form.  */
3037
3038 int
3039 is_attribute_p (attr, ident)
3040      char *attr;
3041      tree ident;
3042 {
3043   int ident_len, attr_len;
3044   char *p;
3045
3046   if (TREE_CODE (ident) != IDENTIFIER_NODE)
3047     return 0;
3048
3049   if (strcmp (attr, IDENTIFIER_POINTER (ident)) == 0)
3050     return 1;
3051
3052   p = IDENTIFIER_POINTER (ident);
3053   ident_len = strlen (p);
3054   attr_len = strlen (attr);
3055
3056   /* If ATTR is `__text__', IDENT must be `text'; and vice versa.  */
3057   if (attr[0] == '_')
3058     {
3059       if (attr[1] != '_'
3060           || attr[attr_len - 2] != '_'
3061           || attr[attr_len - 1] != '_')
3062         abort ();
3063       if (ident_len == attr_len - 4
3064           && strncmp (attr + 2, p, attr_len - 4) == 0)
3065         return 1;
3066     }
3067   else
3068     {
3069       if (ident_len == attr_len + 4
3070           && p[0] == '_' && p[1] == '_'
3071           && p[ident_len - 2] == '_' && p[ident_len - 1] == '_'
3072           && strncmp (attr, p + 2, attr_len) == 0)
3073         return 1;
3074     }
3075
3076   return 0;
3077 }
3078
3079 /* Given an attribute name and a list of attributes, return a pointer to the
3080    attribute's list element if the attribute is part of the list, or NULL_TREE
3081    if not found.  */
3082
3083 tree
3084 lookup_attribute (attr_name, list)
3085      char *attr_name;
3086      tree list;
3087 {
3088   tree l;
3089
3090   for (l = list; l; l = TREE_CHAIN (l))
3091     {
3092       if (TREE_CODE (TREE_PURPOSE (l)) != IDENTIFIER_NODE)
3093         abort ();
3094       if (is_attribute_p (attr_name, TREE_PURPOSE (l)))
3095         return l;
3096     }
3097
3098   return NULL_TREE;
3099 }
3100
3101 /* Return an attribute list that is the union of a1 and a2.  */
3102
3103 tree
3104 merge_attributes (a1, a2)
3105      register tree a1, a2;
3106 {
3107   tree attributes;
3108
3109   /* Either one unset?  Take the set one.  */
3110
3111   if (! (attributes = a1))
3112     attributes = a2;
3113
3114   /* One that completely contains the other?  Take it.  */
3115
3116   else if (a2 && ! attribute_list_contained (a1, a2))
3117     if (attribute_list_contained (a2, a1))
3118       attributes = a2;
3119     else
3120       {
3121         /* Pick the longest list, and hang on the other list.  */
3122         /* ??? For the moment we punt on the issue of attrs with args.  */
3123
3124         if (list_length (a1) < list_length (a2))
3125           attributes = a2, a2 = a1;
3126
3127         for (; a2; a2 = TREE_CHAIN (a2))
3128           if (lookup_attribute (IDENTIFIER_POINTER (TREE_PURPOSE (a2)),
3129                                 attributes) == NULL_TREE)
3130             {
3131               a1 = copy_node (a2);
3132               TREE_CHAIN (a1) = attributes;
3133               attributes = a1;
3134             }
3135       }
3136   return attributes;
3137 }
3138 \f
3139 /* Return a type like TYPE except that its TYPE_READONLY is CONSTP
3140    and its TYPE_VOLATILE is VOLATILEP.
3141
3142    Such variant types already made are recorded so that duplicates
3143    are not made.
3144
3145    A variant types should never be used as the type of an expression.
3146    Always copy the variant information into the TREE_READONLY
3147    and TREE_THIS_VOLATILE of the expression, and then give the expression
3148    as its type the "main variant", the variant whose TYPE_READONLY
3149    and TYPE_VOLATILE are zero.  Use TYPE_MAIN_VARIANT to find the
3150    main variant.  */
3151
3152 tree
3153 build_type_variant (type, constp, volatilep)
3154      tree type;
3155      int constp, volatilep;
3156 {
3157   register tree t;
3158
3159   /* Treat any nonzero argument as 1.  */
3160   constp = !!constp;
3161   volatilep = !!volatilep;
3162
3163   /* Search the chain of variants to see if there is already one there just
3164      like the one we need to have.  If so, use that existing one.  We must
3165      preserve the TYPE_NAME, since there is code that depends on this.  */
3166
3167   for (t = TYPE_MAIN_VARIANT(type); t; t = TYPE_NEXT_VARIANT (t))
3168     if (constp == TYPE_READONLY (t) && volatilep == TYPE_VOLATILE (t)
3169         && TYPE_NAME (t) == TYPE_NAME (type))
3170       return t;
3171
3172   /* We need a new one.  */
3173
3174   t = build_type_copy (type);
3175   TYPE_READONLY (t) = constp;
3176   TYPE_VOLATILE (t) = volatilep;
3177
3178   return t;
3179 }
3180
3181 /* Give TYPE a new main variant: NEW_MAIN.
3182    This is the right thing to do only when something else
3183    about TYPE is modified in place.  */
3184
3185 void
3186 change_main_variant (type, new_main)
3187      tree type, new_main;
3188 {
3189   tree t;
3190   tree omain = TYPE_MAIN_VARIANT (type);
3191
3192   /* Remove TYPE from the TYPE_NEXT_VARIANT chain of its main variant.  */
3193   if (TYPE_NEXT_VARIANT (omain) == type)
3194     TYPE_NEXT_VARIANT (omain) = TYPE_NEXT_VARIANT (type);
3195   else
3196     for (t = TYPE_NEXT_VARIANT (omain); t && TYPE_NEXT_VARIANT (t);
3197          t = TYPE_NEXT_VARIANT (t))
3198       if (TYPE_NEXT_VARIANT (t) == type)
3199         {
3200           TYPE_NEXT_VARIANT (t) = TYPE_NEXT_VARIANT (type);
3201           break;
3202         }
3203
3204   TYPE_MAIN_VARIANT (type) = new_main;
3205   TYPE_NEXT_VARIANT (type) = TYPE_NEXT_VARIANT (new_main);
3206   TYPE_NEXT_VARIANT (new_main) = type;
3207 }
3208
3209 /* Create a new variant of TYPE, equivalent but distinct.
3210    This is so the caller can modify it.  */
3211
3212 tree
3213 build_type_copy (type)
3214      tree type;
3215 {
3216   register tree t, m = TYPE_MAIN_VARIANT (type);
3217   register struct obstack *ambient_obstack = current_obstack;
3218
3219   current_obstack = TYPE_OBSTACK (type);
3220   t = copy_node (type);
3221   current_obstack = ambient_obstack;
3222
3223   TYPE_POINTER_TO (t) = 0;
3224   TYPE_REFERENCE_TO (t) = 0;
3225
3226   /* Add this type to the chain of variants of TYPE.  */
3227   TYPE_NEXT_VARIANT (t) = TYPE_NEXT_VARIANT (m);
3228   TYPE_NEXT_VARIANT (m) = t;
3229
3230   return t;
3231 }
3232 \f
3233 /* Hashing of types so that we don't make duplicates.
3234    The entry point is `type_hash_canon'.  */
3235
3236 /* Each hash table slot is a bucket containing a chain
3237    of these structures.  */
3238
3239 struct type_hash
3240 {
3241   struct type_hash *next;       /* Next structure in the bucket.  */
3242   int hashcode;                 /* Hash code of this type.  */
3243   tree type;                    /* The type recorded here.  */
3244 };
3245
3246 /* Now here is the hash table.  When recording a type, it is added
3247    to the slot whose index is the hash code mod the table size.
3248    Note that the hash table is used for several kinds of types
3249    (function types, array types and array index range types, for now).
3250    While all these live in the same table, they are completely independent,
3251    and the hash code is computed differently for each of these.  */
3252
3253 #define TYPE_HASH_SIZE 59
3254 struct type_hash *type_hash_table[TYPE_HASH_SIZE];
3255
3256 /* Compute a hash code for a list of types (chain of TREE_LIST nodes
3257    with types in the TREE_VALUE slots), by adding the hash codes
3258    of the individual types.  */
3259
3260 int
3261 type_hash_list (list)
3262      tree list;
3263 {
3264   register int hashcode;
3265   register tree tail;
3266   for (hashcode = 0, tail = list; tail; tail = TREE_CHAIN (tail))
3267     hashcode += TYPE_HASH (TREE_VALUE (tail));
3268   return hashcode;
3269 }
3270
3271 /* Look in the type hash table for a type isomorphic to TYPE.
3272    If one is found, return it.  Otherwise return 0.  */
3273
3274 tree
3275 type_hash_lookup (hashcode, type)
3276      int hashcode;
3277      tree type;
3278 {
3279   register struct type_hash *h;
3280   for (h = type_hash_table[hashcode % TYPE_HASH_SIZE]; h; h = h->next)
3281     if (h->hashcode == hashcode
3282         && TREE_CODE (h->type) == TREE_CODE (type)
3283         && TREE_TYPE (h->type) == TREE_TYPE (type)
3284         && attribute_list_equal (TYPE_ATTRIBUTES (h->type),
3285                                    TYPE_ATTRIBUTES (type))
3286         && (TYPE_MAX_VALUE (h->type) == TYPE_MAX_VALUE (type)
3287             || tree_int_cst_equal (TYPE_MAX_VALUE (h->type),
3288                                    TYPE_MAX_VALUE (type)))
3289         && (TYPE_MIN_VALUE (h->type) == TYPE_MIN_VALUE (type)
3290             || tree_int_cst_equal (TYPE_MIN_VALUE (h->type),
3291                                    TYPE_MIN_VALUE (type)))
3292         /* Note that TYPE_DOMAIN is TYPE_ARG_TYPES for FUNCTION_TYPE.  */
3293         && (TYPE_DOMAIN (h->type) == TYPE_DOMAIN (type)
3294             || (TYPE_DOMAIN (h->type)
3295                 && TREE_CODE (TYPE_DOMAIN (h->type)) == TREE_LIST
3296                 && TYPE_DOMAIN (type)
3297                 && TREE_CODE (TYPE_DOMAIN (type)) == TREE_LIST
3298                 && type_list_equal (TYPE_DOMAIN (h->type),
3299                                     TYPE_DOMAIN (type)))))
3300       return h->type;
3301   return 0;
3302 }
3303
3304 /* Add an entry to the type-hash-table
3305    for a type TYPE whose hash code is HASHCODE.  */
3306
3307 void
3308 type_hash_add (hashcode, type)
3309      int hashcode;
3310      tree type;
3311 {
3312   register struct type_hash *h;
3313
3314   h = (struct type_hash *) oballoc (sizeof (struct type_hash));
3315   h->hashcode = hashcode;
3316   h->type = type;
3317   h->next = type_hash_table[hashcode % TYPE_HASH_SIZE];
3318   type_hash_table[hashcode % TYPE_HASH_SIZE] = h;
3319 }
3320
3321 /* Given TYPE, and HASHCODE its hash code, return the canonical
3322    object for an identical type if one already exists.
3323    Otherwise, return TYPE, and record it as the canonical object
3324    if it is a permanent object.
3325
3326    To use this function, first create a type of the sort you want.
3327    Then compute its hash code from the fields of the type that
3328    make it different from other similar types.
3329    Then call this function and use the value.
3330    This function frees the type you pass in if it is a duplicate.  */
3331
3332 /* Set to 1 to debug without canonicalization.  Never set by program.  */
3333 int debug_no_type_hash = 0;
3334
3335 tree
3336 type_hash_canon (hashcode, type)
3337      int hashcode;
3338      tree type;
3339 {
3340   tree t1;
3341
3342   if (debug_no_type_hash)
3343     return type;
3344
3345   t1 = type_hash_lookup (hashcode, type);
3346   if (t1 != 0)
3347     {
3348       obstack_free (TYPE_OBSTACK (type), type);
3349 #ifdef GATHER_STATISTICS
3350       tree_node_counts[(int)t_kind]--;
3351       tree_node_sizes[(int)t_kind] -= sizeof (struct tree_type);
3352 #endif
3353       return t1;
3354     }
3355
3356   /* If this is a permanent type, record it for later reuse.  */
3357   if (TREE_PERMANENT (type))
3358     type_hash_add (hashcode, type);
3359
3360   return type;
3361 }
3362
3363 /* Compute a hash code for a list of attributes (chain of TREE_LIST nodes
3364    with names in the TREE_PURPOSE slots and args in the TREE_VALUE slots),
3365    by adding the hash codes of the individual attributes.  */
3366
3367 int
3368 attribute_hash_list (list)
3369      tree list;
3370 {
3371   register int hashcode;
3372   register tree tail;
3373   for (hashcode = 0, tail = list; tail; tail = TREE_CHAIN (tail))
3374     /* ??? Do we want to add in TREE_VALUE too? */
3375     hashcode += TYPE_HASH (TREE_PURPOSE (tail));
3376   return hashcode;
3377 }
3378
3379 /* Given two lists of attributes, return true if list l2 is
3380    equivalent to l1.  */
3381
3382 int
3383 attribute_list_equal (l1, l2)
3384      tree l1, l2;
3385 {
3386    return attribute_list_contained (l1, l2)
3387           && attribute_list_contained (l2, l1);
3388 }
3389
3390 /* Given two lists of attributes, return true if list L2 is
3391    completely contained within L1.  */
3392 /* ??? This would be faster if attribute names were stored in a canonicalized
3393    form.  Otherwise, if L1 uses `foo' and L2 uses `__foo__', the long method
3394    must be used to show these elements are equivalent (which they are).  */
3395 /* ??? It's not clear that attributes with arguments will always be handled
3396    correctly.  */
3397
3398 int
3399 attribute_list_contained (l1, l2)
3400      tree l1, l2;
3401 {
3402   register tree t1, t2;
3403
3404   /* First check the obvious, maybe the lists are identical.  */
3405   if (l1 == l2)
3406      return 1;
3407
3408   /* Maybe the lists are similar.  */
3409   for (t1 = l1, t2 = l2;
3410        t1 && t2
3411         && TREE_PURPOSE (t1) == TREE_PURPOSE (t2)
3412         && TREE_VALUE (t1) == TREE_VALUE (t2);
3413        t1 = TREE_CHAIN (t1), t2 = TREE_CHAIN (t2));
3414
3415   /* Maybe the lists are equal.  */
3416   if (t1 == 0 && t2 == 0)
3417      return 1;
3418
3419   for (; t2; t2 = TREE_CHAIN (t2))
3420     {
3421       tree attr
3422         = lookup_attribute (IDENTIFIER_POINTER (TREE_PURPOSE (t2)), l1);
3423
3424       if (attr == NULL_TREE)
3425         return 0;
3426       if (simple_cst_equal (TREE_VALUE (t2), TREE_VALUE (attr)) != 1)
3427         return 0;
3428     }
3429
3430   return 1;
3431 }
3432
3433 /* Given two lists of types
3434    (chains of TREE_LIST nodes with types in the TREE_VALUE slots)
3435    return 1 if the lists contain the same types in the same order.
3436    Also, the TREE_PURPOSEs must match.  */
3437
3438 int
3439 type_list_equal (l1, l2)
3440      tree l1, l2;
3441 {
3442   register tree t1, t2;
3443
3444   for (t1 = l1, t2 = l2; t1 && t2; t1 = TREE_CHAIN (t1), t2 = TREE_CHAIN (t2))
3445     if (TREE_VALUE (t1) != TREE_VALUE (t2)
3446         || (TREE_PURPOSE (t1) != TREE_PURPOSE (t2)
3447             && ! (1 == simple_cst_equal (TREE_PURPOSE (t1), TREE_PURPOSE (t2))
3448                   && (TREE_TYPE (TREE_PURPOSE (t1))
3449                       == TREE_TYPE (TREE_PURPOSE (t2))))))
3450       return 0;
3451
3452   return t1 == t2;
3453 }
3454
3455 /* Nonzero if integer constants T1 and T2
3456    represent the same constant value.  */
3457
3458 int
3459 tree_int_cst_equal (t1, t2)
3460      tree t1, t2;
3461 {
3462   if (t1 == t2)
3463     return 1;
3464   if (t1 == 0 || t2 == 0)
3465     return 0;
3466   if (TREE_CODE (t1) == INTEGER_CST
3467       && TREE_CODE (t2) == INTEGER_CST
3468       && TREE_INT_CST_LOW (t1) == TREE_INT_CST_LOW (t2)
3469       && TREE_INT_CST_HIGH (t1) == TREE_INT_CST_HIGH (t2))
3470     return 1;
3471   return 0;
3472 }
3473
3474 /* Nonzero if integer constants T1 and T2 represent values that satisfy <.
3475    The precise way of comparison depends on their data type.  */
3476
3477 int
3478 tree_int_cst_lt (t1, t2)
3479      tree t1, t2;
3480 {
3481   if (t1 == t2)
3482     return 0;
3483
3484   if (!TREE_UNSIGNED (TREE_TYPE (t1)))
3485     return INT_CST_LT (t1, t2);
3486   return INT_CST_LT_UNSIGNED (t1, t2);
3487 }
3488
3489 /* Return an indication of the sign of the integer constant T.
3490    The return value is -1 if T < 0, 0 if T == 0, and 1 if T > 0.
3491    Note that -1 will never be returned it T's type is unsigned.  */
3492
3493 int
3494 tree_int_cst_sgn (t)
3495      tree t;
3496 {
3497   if (TREE_INT_CST_LOW (t) == 0 && TREE_INT_CST_HIGH (t) == 0)
3498     return 0;
3499   else if (TREE_UNSIGNED (TREE_TYPE (t)))
3500     return 1;
3501   else if (TREE_INT_CST_HIGH (t) < 0)
3502     return -1;
3503   else
3504     return 1;
3505 }
3506
3507 /* Compare two constructor-element-type constants.  Return 1 if the lists
3508    are known to be equal; otherwise return 0.  */
3509
3510 int
3511 simple_cst_list_equal (l1, l2)
3512      tree l1, l2;
3513 {
3514   while (l1 != NULL_TREE && l2 != NULL_TREE)
3515     {
3516       if (simple_cst_equal (TREE_VALUE (l1), TREE_VALUE (l2)) != 1)
3517         return 0;
3518
3519       l1 = TREE_CHAIN (l1);
3520       l2 = TREE_CHAIN (l2);
3521     }
3522
3523   return (l1 == l2);
3524 }
3525
3526 /* Return truthvalue of whether T1 is the same tree structure as T2.
3527    Return 1 if they are the same.
3528    Return 0 if they are understandably different.
3529    Return -1 if either contains tree structure not understood by
3530    this function.  */
3531
3532 int
3533 simple_cst_equal (t1, t2)
3534      tree t1, t2;
3535 {
3536   register enum tree_code code1, code2;
3537   int cmp;
3538
3539   if (t1 == t2)
3540     return 1;
3541   if (t1 == 0 || t2 == 0)
3542     return 0;
3543
3544   code1 = TREE_CODE (t1);
3545   code2 = TREE_CODE (t2);
3546
3547   if (code1 == NOP_EXPR || code1 == CONVERT_EXPR || code1 == NON_LVALUE_EXPR)
3548     if (code2 == NOP_EXPR || code2 == CONVERT_EXPR || code2 == NON_LVALUE_EXPR)
3549       return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3550     else
3551       return simple_cst_equal (TREE_OPERAND (t1, 0), t2);
3552   else if (code2 == NOP_EXPR || code2 == CONVERT_EXPR
3553            || code2 == NON_LVALUE_EXPR)
3554     return simple_cst_equal (t1, TREE_OPERAND (t2, 0));
3555
3556   if (code1 != code2)
3557     return 0;
3558
3559   switch (code1)
3560     {
3561     case INTEGER_CST:
3562       return TREE_INT_CST_LOW (t1) == TREE_INT_CST_LOW (t2)
3563         && TREE_INT_CST_HIGH (t1) == TREE_INT_CST_HIGH (t2);
3564
3565     case REAL_CST:
3566       return REAL_VALUES_EQUAL (TREE_REAL_CST (t1), TREE_REAL_CST (t2));
3567
3568     case STRING_CST:
3569       return TREE_STRING_LENGTH (t1) == TREE_STRING_LENGTH (t2)
3570         && !bcmp (TREE_STRING_POINTER (t1), TREE_STRING_POINTER (t2),
3571                   TREE_STRING_LENGTH (t1));
3572
3573     case CONSTRUCTOR:
3574       abort ();
3575
3576     case SAVE_EXPR:
3577       return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3578
3579     case CALL_EXPR:
3580       cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3581       if (cmp <= 0)
3582         return cmp;
3583       return simple_cst_list_equal (TREE_OPERAND (t1, 1), TREE_OPERAND (t2, 1));
3584
3585     case TARGET_EXPR:
3586       /* Special case: if either target is an unallocated VAR_DECL,
3587          it means that it's going to be unified with whatever the
3588          TARGET_EXPR is really supposed to initialize, so treat it
3589          as being equivalent to anything.  */
3590       if ((TREE_CODE (TREE_OPERAND (t1, 0)) == VAR_DECL
3591            && DECL_NAME (TREE_OPERAND (t1, 0)) == NULL_TREE
3592            && DECL_RTL (TREE_OPERAND (t1, 0)) == 0)
3593           || (TREE_CODE (TREE_OPERAND (t2, 0)) == VAR_DECL
3594               && DECL_NAME (TREE_OPERAND (t2, 0)) == NULL_TREE
3595               && DECL_RTL (TREE_OPERAND (t2, 0)) == 0))
3596         cmp = 1;
3597       else
3598         cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3599       if (cmp <= 0)
3600         return cmp;
3601       return simple_cst_equal (TREE_OPERAND (t1, 1), TREE_OPERAND (t2, 1));
3602
3603     case WITH_CLEANUP_EXPR:
3604       cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3605       if (cmp <= 0)
3606         return cmp;
3607       return simple_cst_equal (TREE_OPERAND (t1, 2), TREE_OPERAND (t1, 2));
3608
3609     case COMPONENT_REF:
3610       if (TREE_OPERAND (t1, 1) == TREE_OPERAND (t2, 1))
3611         return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3612       return 0;
3613
3614     case VAR_DECL:
3615     case PARM_DECL:
3616     case CONST_DECL:
3617     case FUNCTION_DECL:
3618       return 0;
3619     }
3620
3621   /* This general rule works for most tree codes.  All exceptions should be
3622      handled above.  If this is a language-specific tree code, we can't
3623      trust what might be in the operand, so say we don't know
3624      the situation.  */
3625   if ((int) code1
3626       >= sizeof standard_tree_code_type / sizeof standard_tree_code_type[0])
3627     return -1;
3628
3629   switch (TREE_CODE_CLASS (code1))
3630     {
3631       int i;
3632     case '1':
3633     case '2':
3634     case '<':
3635     case 'e':
3636     case 'r':
3637     case 's':
3638       cmp = 1;
3639       for (i=0; i<tree_code_length[(int) code1]; ++i)
3640         {
3641           cmp = simple_cst_equal (TREE_OPERAND (t1, i), TREE_OPERAND (t2, i));
3642           if (cmp <= 0)
3643             return cmp;
3644         }
3645       return cmp;
3646     }
3647
3648   return -1;
3649 }
3650 \f
3651 /* Constructors for pointer, array and function types.
3652    (RECORD_TYPE, UNION_TYPE and ENUMERAL_TYPE nodes are
3653    constructed by language-dependent code, not here.)  */
3654
3655 /* Construct, lay out and return the type of pointers to TO_TYPE.
3656    If such a type has already been constructed, reuse it.  */
3657
3658 tree
3659 build_pointer_type (to_type)
3660      tree to_type;
3661 {
3662   register tree t = TYPE_POINTER_TO (to_type);
3663
3664   /* First, if we already have a type for pointers to TO_TYPE, use it.  */
3665
3666   if (t)
3667     return t;
3668
3669   /* We need a new one.  Put this in the same obstack as TO_TYPE.   */
3670   push_obstacks (TYPE_OBSTACK (to_type), TYPE_OBSTACK (to_type));
3671   t = make_node (POINTER_TYPE);
3672   pop_obstacks ();
3673
3674   TREE_TYPE (t) = to_type;
3675
3676   /* Record this type as the pointer to TO_TYPE.  */
3677   TYPE_POINTER_TO (to_type) = t;
3678
3679   /* Lay out the type.  This function has many callers that are concerned
3680      with expression-construction, and this simplifies them all.
3681      Also, it guarantees the TYPE_SIZE is in the same obstack as the type.  */
3682   layout_type (t);
3683
3684   return t;
3685 }
3686
3687 /* Create a type of integers to be the TYPE_DOMAIN of an ARRAY_TYPE.
3688    MAXVAL should be the maximum value in the domain
3689    (one less than the length of the array).  */
3690
3691 tree
3692 build_index_type (maxval)
3693      tree maxval;
3694 {
3695   register tree itype = make_node (INTEGER_TYPE);
3696   TYPE_PRECISION (itype) = TYPE_PRECISION (sizetype);
3697   TYPE_MIN_VALUE (itype) = build_int_2 (0, 0);
3698   TREE_TYPE (TYPE_MIN_VALUE (itype)) = sizetype;
3699   TYPE_MAX_VALUE (itype) = convert (sizetype, maxval);
3700   TYPE_MODE (itype) = TYPE_MODE (sizetype);
3701   TYPE_SIZE (itype) = TYPE_SIZE (sizetype);
3702   TYPE_ALIGN (itype) = TYPE_ALIGN (sizetype);
3703   if (TREE_CODE (maxval) == INTEGER_CST)
3704     {
3705       int maxint = (int) TREE_INT_CST_LOW (maxval);
3706       /* If the domain should be empty, make sure the maxval
3707          remains -1 and is not spoiled by truncation.  */
3708       if (INT_CST_LT (maxval, integer_zero_node))
3709         {
3710           TYPE_MAX_VALUE (itype) = build_int_2 (-1, -1);
3711           TREE_TYPE (TYPE_MAX_VALUE (itype)) = sizetype;
3712         }
3713       return type_hash_canon (maxint < 0 ? ~maxint : maxint, itype);
3714     }
3715   else
3716     return itype;
3717 }
3718
3719 /* Create a range of some discrete type TYPE (an INTEGER_TYPE,
3720    ENUMERAL_TYPE, BOOLEAN_TYPE, or CHAR_TYPE), with
3721    low bound LOWVAL and high bound HIGHVAL.
3722    if TYPE==NULL_TREE, sizetype is used.  */
3723
3724 tree
3725 build_range_type (type, lowval, highval)
3726      tree type, lowval, highval;
3727 {
3728   register tree itype = make_node (INTEGER_TYPE);
3729   TREE_TYPE (itype) = type;
3730   if (type == NULL_TREE)
3731     type = sizetype;
3732   TYPE_PRECISION (itype) = TYPE_PRECISION (type);
3733   TYPE_MIN_VALUE (itype) = convert (type, lowval);
3734   TYPE_MAX_VALUE (itype) = convert (type, highval);
3735   TYPE_MODE (itype) = TYPE_MODE (type);
3736   TYPE_SIZE (itype) = TYPE_SIZE (type);
3737   TYPE_ALIGN (itype) = TYPE_ALIGN (type);
3738   if ((TREE_CODE (lowval) == INTEGER_CST)
3739       && (TREE_CODE (highval) == INTEGER_CST))
3740     {
3741       HOST_WIDE_INT highint = TREE_INT_CST_LOW (highval);
3742       HOST_WIDE_INT lowint = TREE_INT_CST_LOW (lowval);
3743       int maxint = (int) (highint - lowint);
3744       return type_hash_canon (maxint < 0 ? ~maxint : maxint, itype);
3745     }
3746   else
3747     return itype;
3748 }
3749
3750 /* Just like build_index_type, but takes lowval and highval instead
3751    of just highval (maxval).  */
3752
3753 tree
3754 build_index_2_type (lowval,highval)
3755      tree lowval, highval;
3756 {
3757   return build_range_type (NULL_TREE, lowval, highval);
3758 }
3759
3760 /* Return nonzero iff ITYPE1 and ITYPE2 are equal (in the LISP sense).
3761    Needed because when index types are not hashed, equal index types
3762    built at different times appear distinct, even though structurally,
3763    they are not.  */
3764
3765 int
3766 index_type_equal (itype1, itype2)
3767      tree itype1, itype2;
3768 {
3769   if (TREE_CODE (itype1) != TREE_CODE (itype2))
3770     return 0;
3771   if (TREE_CODE (itype1) == INTEGER_TYPE)
3772     {
3773       if (TYPE_PRECISION (itype1) != TYPE_PRECISION (itype2)
3774           || TYPE_MODE (itype1) != TYPE_MODE (itype2)
3775           || simple_cst_equal (TYPE_SIZE (itype1), TYPE_SIZE (itype2)) != 1
3776           || TYPE_ALIGN (itype1) != TYPE_ALIGN (itype2))
3777         return 0;
3778       if (1 == simple_cst_equal (TYPE_MIN_VALUE (itype1),
3779                                  TYPE_MIN_VALUE (itype2))
3780           && 1 == simple_cst_equal (TYPE_MAX_VALUE (itype1),
3781                                     TYPE_MAX_VALUE (itype2)))
3782         return 1;
3783     }
3784
3785   return 0;
3786 }
3787
3788 /* Construct, lay out and return the type of arrays of elements with ELT_TYPE
3789    and number of elements specified by the range of values of INDEX_TYPE.
3790    If such a type has already been constructed, reuse it.  */
3791
3792 tree
3793 build_array_type (elt_type, index_type)
3794      tree elt_type, index_type;
3795 {
3796   register tree t;
3797   int hashcode;
3798
3799   if (TREE_CODE (elt_type) == FUNCTION_TYPE)
3800     {
3801       error ("arrays of functions are not meaningful");
3802       elt_type = integer_type_node;
3803     }
3804
3805   /* Make sure TYPE_POINTER_TO (elt_type) is filled in.  */
3806   build_pointer_type (elt_type);
3807
3808   /* Allocate the array after the pointer type,
3809      in case we free it in type_hash_canon.  */
3810   t = make_node (ARRAY_TYPE);
3811   TREE_TYPE (t) = elt_type;
3812   TYPE_DOMAIN (t) = index_type;
3813
3814   if (index_type == 0)
3815     {
3816       return t;
3817     }
3818
3819   hashcode = TYPE_HASH (elt_type) + TYPE_HASH (index_type);
3820   t = type_hash_canon (hashcode, t);
3821
3822 #if 0 /* This led to crashes, because it could put a temporary node
3823          on the TYPE_NEXT_VARIANT chain of a permanent one.  */
3824   /* The main variant of an array type should always
3825      be an array whose element type is the main variant.  */
3826   if (elt_type != TYPE_MAIN_VARIANT (elt_type))
3827     change_main_variant (t, build_array_type (TYPE_MAIN_VARIANT (elt_type),
3828                                               index_type));
3829 #endif
3830
3831   if (TYPE_SIZE (t) == 0)
3832     layout_type (t);
3833   return t;
3834 }
3835
3836 /* Construct, lay out and return
3837    the type of functions returning type VALUE_TYPE
3838    given arguments of types ARG_TYPES.
3839    ARG_TYPES is a chain of TREE_LIST nodes whose TREE_VALUEs
3840    are data type nodes for the arguments of the function.
3841    If such a type has already been constructed, reuse it.  */
3842
3843 tree
3844 build_function_type (value_type, arg_types)
3845      tree value_type, arg_types;
3846 {
3847   register tree t;
3848   int hashcode;
3849
3850   if (TREE_CODE (value_type) == FUNCTION_TYPE)
3851     {
3852       error ("function return type cannot be function");
3853       value_type = integer_type_node;
3854     }
3855
3856   /* Make a node of the sort we want.  */
3857   t = make_node (FUNCTION_TYPE);
3858   TREE_TYPE (t) = value_type;
3859   TYPE_ARG_TYPES (t) = arg_types;
3860
3861   /* If we already have such a type, use the old one and free this one.  */
3862   hashcode = TYPE_HASH (value_type) + type_hash_list (arg_types);
3863   t = type_hash_canon (hashcode, t);
3864
3865   if (TYPE_SIZE (t) == 0)
3866     layout_type (t);
3867   return t;
3868 }
3869
3870 /* Build the node for the type of references-to-TO_TYPE.  */
3871
3872 tree
3873 build_reference_type (to_type)
3874      tree to_type;
3875 {
3876   register tree t = TYPE_REFERENCE_TO (to_type);
3877   register struct obstack *ambient_obstack = current_obstack;
3878   register struct obstack *ambient_saveable_obstack = saveable_obstack;
3879
3880   /* First, if we already have a type for pointers to TO_TYPE, use it.  */
3881
3882   if (t)
3883     return t;
3884
3885   /* We need a new one.  If TO_TYPE is permanent, make this permanent too.  */
3886   if (TREE_PERMANENT (to_type))
3887     {
3888       current_obstack = &permanent_obstack;
3889       saveable_obstack = &permanent_obstack;
3890     }
3891
3892   t = make_node (REFERENCE_TYPE);
3893   TREE_TYPE (t) = to_type;
3894
3895   /* Record this type as the pointer to TO_TYPE.  */
3896   TYPE_REFERENCE_TO (to_type) = t;
3897
3898   layout_type (t);
3899
3900   current_obstack = ambient_obstack;
3901   saveable_obstack = ambient_saveable_obstack;
3902   return t;
3903 }
3904
3905 /* Construct, lay out and return the type of methods belonging to class
3906    BASETYPE and whose arguments and values are described by TYPE.
3907    If that type exists already, reuse it.
3908    TYPE must be a FUNCTION_TYPE node.  */
3909
3910 tree
3911 build_method_type (basetype, type)
3912      tree basetype, type;
3913 {
3914   register tree t;
3915   int hashcode;
3916
3917   /* Make a node of the sort we want.  */
3918   t = make_node (METHOD_TYPE);
3919
3920   if (TREE_CODE (type) != FUNCTION_TYPE)
3921     abort ();
3922
3923   TYPE_METHOD_BASETYPE (t) = TYPE_MAIN_VARIANT (basetype);
3924   TREE_TYPE (t) = TREE_TYPE (type);
3925
3926   /* The actual arglist for this function includes a "hidden" argument
3927      which is "this".  Put it into the list of argument types.  */
3928
3929   TYPE_ARG_TYPES (t)
3930     = tree_cons (NULL_TREE,
3931                  build_pointer_type (basetype), TYPE_ARG_TYPES (type));
3932
3933   /* If we already have such a type, use the old one and free this one.  */
3934   hashcode = TYPE_HASH (basetype) + TYPE_HASH (type);
3935   t = type_hash_canon (hashcode, t);
3936
3937   if (TYPE_SIZE (t) == 0)
3938     layout_type (t);
3939
3940   return t;
3941 }
3942
3943 /* Construct, lay out and return the type of offsets to a value
3944    of type TYPE, within an object of type BASETYPE.
3945    If a suitable offset type exists already, reuse it.  */
3946
3947 tree
3948 build_offset_type (basetype, type)
3949      tree basetype, type;
3950 {
3951   register tree t;
3952   int hashcode;
3953
3954   /* Make a node of the sort we want.  */
3955   t = make_node (OFFSET_TYPE);
3956
3957   TYPE_OFFSET_BASETYPE (t) = TYPE_MAIN_VARIANT (basetype);
3958   TREE_TYPE (t) = type;
3959
3960   /* If we already have such a type, use the old one and free this one.  */
3961   hashcode = TYPE_HASH (basetype) + TYPE_HASH (type);
3962   t = type_hash_canon (hashcode, t);
3963
3964   if (TYPE_SIZE (t) == 0)
3965     layout_type (t);
3966
3967   return t;
3968 }
3969
3970 /* Create a complex type whose components are COMPONENT_TYPE.  */
3971
3972 tree
3973 build_complex_type (component_type)
3974      tree component_type;
3975 {
3976   register tree t;
3977   int hashcode;
3978
3979   /* Make a node of the sort we want.  */
3980   t = make_node (COMPLEX_TYPE);
3981
3982   TREE_TYPE (t) = TYPE_MAIN_VARIANT (component_type);
3983   TYPE_VOLATILE (t) = TYPE_VOLATILE (component_type);
3984   TYPE_READONLY (t) = TYPE_READONLY (component_type);
3985
3986   /* If we already have such a type, use the old one and free this one.  */
3987   hashcode = TYPE_HASH (component_type);
3988   t = type_hash_canon (hashcode, t);
3989
3990   if (TYPE_SIZE (t) == 0)
3991     layout_type (t);
3992
3993   return t;
3994 }
3995 \f
3996 /* Return OP, stripped of any conversions to wider types as much as is safe.
3997    Converting the value back to OP's type makes a value equivalent to OP.
3998
3999    If FOR_TYPE is nonzero, we return a value which, if converted to
4000    type FOR_TYPE, would be equivalent to converting OP to type FOR_TYPE.
4001
4002    If FOR_TYPE is nonzero, unaligned bit-field references may be changed to the
4003    narrowest type that can hold the value, even if they don't exactly fit.
4004    Otherwise, bit-field references are changed to a narrower type
4005    only if they can be fetched directly from memory in that type.
4006
4007    OP must have integer, real or enumeral type.  Pointers are not allowed!
4008
4009    There are some cases where the obvious value we could return
4010    would regenerate to OP if converted to OP's type, 
4011    but would not extend like OP to wider types.
4012    If FOR_TYPE indicates such extension is contemplated, we eschew such values.
4013    For example, if OP is (unsigned short)(signed char)-1,
4014    we avoid returning (signed char)-1 if FOR_TYPE is int,
4015    even though extending that to an unsigned short would regenerate OP,
4016    since the result of extending (signed char)-1 to (int)
4017    is different from (int) OP.  */
4018
4019 tree
4020 get_unwidened (op, for_type)
4021      register tree op;
4022      tree for_type;
4023 {
4024   /* Set UNS initially if converting OP to FOR_TYPE is a zero-extension.  */
4025   /* TYPE_PRECISION is safe in place of type_precision since
4026      pointer types are not allowed.  */
4027   register tree type = TREE_TYPE (op);
4028   register unsigned final_prec
4029     = TYPE_PRECISION (for_type != 0 ? for_type : type);
4030   register int uns
4031     = (for_type != 0 && for_type != type
4032        && final_prec > TYPE_PRECISION (type)
4033        && TREE_UNSIGNED (type));
4034   register tree win = op;
4035
4036   while (TREE_CODE (op) == NOP_EXPR)
4037     {
4038       register int bitschange
4039         = TYPE_PRECISION (TREE_TYPE (op))
4040           - TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (op, 0)));
4041
4042       /* Truncations are many-one so cannot be removed.
4043          Unless we are later going to truncate down even farther.  */
4044       if (bitschange < 0
4045           && final_prec > TYPE_PRECISION (TREE_TYPE (op)))
4046         break;
4047
4048       /* See what's inside this conversion.  If we decide to strip it,
4049          we will set WIN.  */
4050       op = TREE_OPERAND (op, 0);
4051
4052       /* If we have not stripped any zero-extensions (uns is 0),
4053          we can strip any kind of extension.
4054          If we have previously stripped a zero-extension,
4055          only zero-extensions can safely be stripped.
4056          Any extension can be stripped if the bits it would produce
4057          are all going to be discarded later by truncating to FOR_TYPE.  */
4058
4059       if (bitschange > 0)
4060         {
4061           if (! uns || final_prec <= TYPE_PRECISION (TREE_TYPE (op)))
4062             win = op;
4063           /* TREE_UNSIGNED says whether this is a zero-extension.
4064              Let's avoid computing it if it does not affect WIN
4065              and if UNS will not be needed again.  */
4066           if ((uns || TREE_CODE (op) == NOP_EXPR)
4067               && TREE_UNSIGNED (TREE_TYPE (op)))
4068             {
4069               uns = 1;
4070               win = op;
4071             }
4072         }
4073     }
4074
4075   if (TREE_CODE (op) == COMPONENT_REF
4076       /* Since type_for_size always gives an integer type.  */
4077       && TREE_CODE (type) != REAL_TYPE)
4078     {
4079       unsigned innerprec = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1)));
4080       type = type_for_size (innerprec, TREE_UNSIGNED (TREE_OPERAND (op, 1)));
4081
4082       /* We can get this structure field in the narrowest type it fits in.
4083          If FOR_TYPE is 0, do this only for a field that matches the
4084          narrower type exactly and is aligned for it
4085          The resulting extension to its nominal type (a fullword type)
4086          must fit the same conditions as for other extensions.  */
4087
4088       if (innerprec < TYPE_PRECISION (TREE_TYPE (op))
4089           && (for_type || ! DECL_BIT_FIELD (TREE_OPERAND (op, 1)))
4090           && (! uns || final_prec <= innerprec
4091               || TREE_UNSIGNED (TREE_OPERAND (op, 1)))
4092           && type != 0)
4093         {
4094           win = build (COMPONENT_REF, type, TREE_OPERAND (op, 0),
4095                        TREE_OPERAND (op, 1));
4096           TREE_SIDE_EFFECTS (win) = TREE_SIDE_EFFECTS (op);
4097           TREE_THIS_VOLATILE (win) = TREE_THIS_VOLATILE (op);
4098           TREE_RAISES (win) = TREE_RAISES (op);
4099         }
4100     }
4101   return win;
4102 }
4103 \f
4104 /* Return OP or a simpler expression for a narrower value
4105    which can be sign-extended or zero-extended to give back OP.
4106    Store in *UNSIGNEDP_PTR either 1 if the value should be zero-extended
4107    or 0 if the value should be sign-extended.  */
4108
4109 tree
4110 get_narrower (op, unsignedp_ptr)
4111      register tree op;
4112      int *unsignedp_ptr;
4113 {
4114   register int uns = 0;
4115   int first = 1;
4116   register tree win = op;
4117
4118   while (TREE_CODE (op) == NOP_EXPR)
4119     {
4120       register int bitschange
4121         = TYPE_PRECISION (TREE_TYPE (op))
4122           - TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (op, 0)));
4123
4124       /* Truncations are many-one so cannot be removed.  */
4125       if (bitschange < 0)
4126         break;
4127
4128       /* See what's inside this conversion.  If we decide to strip it,
4129          we will set WIN.  */
4130       op = TREE_OPERAND (op, 0);
4131
4132       if (bitschange > 0)
4133         {
4134           /* An extension: the outermost one can be stripped,
4135              but remember whether it is zero or sign extension.  */
4136           if (first)
4137             uns = TREE_UNSIGNED (TREE_TYPE (op));
4138           /* Otherwise, if a sign extension has been stripped,
4139              only sign extensions can now be stripped;
4140              if a zero extension has been stripped, only zero-extensions.  */
4141           else if (uns != TREE_UNSIGNED (TREE_TYPE (op)))
4142             break;
4143           first = 0;
4144         }
4145       else /* bitschange == 0 */
4146         {
4147           /* A change in nominal type can always be stripped, but we must
4148              preserve the unsignedness.  */
4149           if (first)
4150             uns = TREE_UNSIGNED (TREE_TYPE (op));
4151           first = 0;
4152         }
4153
4154       win = op;
4155     }
4156
4157   if (TREE_CODE (op) == COMPONENT_REF
4158       /* Since type_for_size always gives an integer type.  */
4159       && TREE_CODE (TREE_TYPE (op)) != REAL_TYPE)
4160     {
4161       unsigned innerprec = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1)));
4162       tree type = type_for_size (innerprec, TREE_UNSIGNED (op));
4163
4164       /* We can get this structure field in a narrower type that fits it,
4165          but the resulting extension to its nominal type (a fullword type)
4166          must satisfy the same conditions as for other extensions.
4167
4168          Do this only for fields that are aligned (not bit-fields),
4169          because when bit-field insns will be used there is no
4170          advantage in doing this.  */
4171
4172       if (innerprec < TYPE_PRECISION (TREE_TYPE (op))
4173           && ! DECL_BIT_FIELD (TREE_OPERAND (op, 1))
4174           && (first || uns == TREE_UNSIGNED (TREE_OPERAND (op, 1)))
4175           && type != 0)
4176         {
4177           if (first)
4178             uns = TREE_UNSIGNED (TREE_OPERAND (op, 1));
4179           win = build (COMPONENT_REF, type, TREE_OPERAND (op, 0),
4180                        TREE_OPERAND (op, 1));
4181           TREE_SIDE_EFFECTS (win) = TREE_SIDE_EFFECTS (op);
4182           TREE_THIS_VOLATILE (win) = TREE_THIS_VOLATILE (op);
4183           TREE_RAISES (win) = TREE_RAISES (op);
4184         }
4185     }
4186   *unsignedp_ptr = uns;
4187   return win;
4188 }
4189 \f
4190 /* Return the precision of a type, for arithmetic purposes.
4191    Supports all types on which arithmetic is possible
4192    (including pointer types).
4193    It's not clear yet what will be right for complex types.  */
4194
4195 int
4196 type_precision (type)
4197      register tree type;
4198 {
4199   return ((TREE_CODE (type) == INTEGER_TYPE
4200            || TREE_CODE (type) == ENUMERAL_TYPE
4201            || TREE_CODE (type) == REAL_TYPE)
4202           ? TYPE_PRECISION (type) : POINTER_SIZE);
4203 }
4204
4205 /* Nonzero if integer constant C has a value that is permissible
4206    for type TYPE (an INTEGER_TYPE).  */
4207
4208 int
4209 int_fits_type_p (c, type)
4210      tree c, type;
4211 {
4212   if (TREE_UNSIGNED (type))
4213     return (! (TREE_CODE (TYPE_MAX_VALUE (type)) == INTEGER_CST
4214                && INT_CST_LT_UNSIGNED (TYPE_MAX_VALUE (type), c))
4215             && ! (TREE_CODE (TYPE_MIN_VALUE (type)) == INTEGER_CST
4216                   && INT_CST_LT_UNSIGNED (c, TYPE_MIN_VALUE (type))));
4217   else
4218     return (! (TREE_CODE (TYPE_MAX_VALUE (type)) == INTEGER_CST
4219                && INT_CST_LT (TYPE_MAX_VALUE (type), c))
4220             && ! (TREE_CODE (TYPE_MIN_VALUE (type)) == INTEGER_CST
4221                   && INT_CST_LT (c, TYPE_MIN_VALUE (type))));
4222 }
4223
4224 /* Return the innermost context enclosing DECL that is
4225    a FUNCTION_DECL, or zero if none.  */
4226
4227 tree
4228 decl_function_context (decl)
4229      tree decl;
4230 {
4231   tree context;
4232
4233   if (TREE_CODE (decl) == ERROR_MARK)
4234     return 0;
4235
4236   if (TREE_CODE (decl) == SAVE_EXPR)
4237     context = SAVE_EXPR_CONTEXT (decl);
4238   else
4239     context = DECL_CONTEXT (decl);
4240
4241   while (context && TREE_CODE (context) != FUNCTION_DECL)
4242     {
4243       if (TREE_CODE (context) == RECORD_TYPE
4244           || TREE_CODE (context) == UNION_TYPE)
4245         context = TYPE_CONTEXT (context);
4246       else if (TREE_CODE (context) == TYPE_DECL)
4247         context = DECL_CONTEXT (context);
4248       else if (TREE_CODE (context) == BLOCK)
4249         context = BLOCK_SUPERCONTEXT (context);
4250       else
4251         /* Unhandled CONTEXT !?  */
4252         abort ();
4253     }
4254
4255   return context;
4256 }
4257
4258 /* Return the innermost context enclosing DECL that is
4259    a RECORD_TYPE, UNION_TYPE or QUAL_UNION_TYPE, or zero if none.
4260    TYPE_DECLs and FUNCTION_DECLs are transparent to this function.  */
4261
4262 tree
4263 decl_type_context (decl)
4264      tree decl;
4265 {
4266   tree context = DECL_CONTEXT (decl);
4267
4268   while (context)
4269     {
4270       if (TREE_CODE (context) == RECORD_TYPE
4271           || TREE_CODE (context) == UNION_TYPE
4272           || TREE_CODE (context) == QUAL_UNION_TYPE)
4273         return context;
4274       if (TREE_CODE (context) == TYPE_DECL
4275           || TREE_CODE (context) == FUNCTION_DECL)
4276         context = DECL_CONTEXT (context);
4277       else if (TREE_CODE (context) == BLOCK)
4278         context = BLOCK_SUPERCONTEXT (context);
4279       else
4280         /* Unhandled CONTEXT!?  */
4281         abort ();
4282     }
4283   return NULL_TREE;
4284 }
4285
4286 void
4287 print_obstack_statistics (str, o)
4288      char *str;
4289      struct obstack *o;
4290 {
4291   struct _obstack_chunk *chunk = o->chunk;
4292   int n_chunks = 0;
4293   int n_alloc = 0;
4294
4295   while (chunk)
4296     {
4297       n_chunks += 1;
4298       n_alloc += chunk->limit - &chunk->contents[0];
4299       chunk = chunk->prev;
4300     }
4301   fprintf (stderr, "obstack %s: %d bytes, %d chunks\n",
4302            str, n_alloc, n_chunks);
4303 }
4304 void
4305 dump_tree_statistics ()
4306 {
4307   int i;
4308   int total_nodes, total_bytes;
4309
4310   fprintf (stderr, "\n??? tree nodes created\n\n");
4311 #ifdef GATHER_STATISTICS
4312   fprintf (stderr, "Kind                  Nodes     Bytes\n");
4313   fprintf (stderr, "-------------------------------------\n");
4314   total_nodes = total_bytes = 0;
4315   for (i = 0; i < (int) all_kinds; i++)
4316     {
4317       fprintf (stderr, "%-20s %6d %9d\n", tree_node_kind_names[i],
4318                tree_node_counts[i], tree_node_sizes[i]);
4319       total_nodes += tree_node_counts[i];
4320       total_bytes += tree_node_sizes[i];
4321     }
4322   fprintf (stderr, "%-20s        %9d\n", "identifier names", id_string_size);
4323   fprintf (stderr, "-------------------------------------\n");
4324   fprintf (stderr, "%-20s %6d %9d\n", "Total", total_nodes, total_bytes);
4325   fprintf (stderr, "-------------------------------------\n");
4326 #else
4327   fprintf (stderr, "(No per-node statistics)\n");
4328 #endif
4329   print_lang_statistics ();
4330 }
4331 \f
4332 #define FILE_FUNCTION_PREFIX_LEN 9
4333
4334 #ifndef NO_DOLLAR_IN_LABEL
4335 #define FILE_FUNCTION_FORMAT "_GLOBAL_$D$%s"
4336 #else /* NO_DOLLAR_IN_LABEL */
4337 #ifndef NO_DOT_IN_LABEL
4338 #define FILE_FUNCTION_FORMAT "_GLOBAL_.D.%s"
4339 #else /* NO_DOT_IN_LABEL */
4340 #define FILE_FUNCTION_FORMAT "_GLOBAL__D_%s"
4341 #endif  /* NO_DOT_IN_LABEL */
4342 #endif  /* NO_DOLLAR_IN_LABEL */
4343
4344 extern char * first_global_object_name;
4345
4346 /* If KIND=='I', return a suitable global initializer (constructor) name.
4347    If KIND=='D', return a suitable global clean-up (destructor) name.  */
4348
4349 tree
4350 get_file_function_name (kind)
4351      int kind;
4352 {
4353   char *buf;
4354   register char *p;
4355
4356   if (first_global_object_name)
4357     p = first_global_object_name;
4358   else if (main_input_filename)
4359     p = main_input_filename;
4360   else
4361     p = input_filename;
4362
4363   buf = (char *) alloca (sizeof (FILE_FUNCTION_FORMAT) + strlen (p));
4364
4365   /* Set up the name of the file-level functions we may need.  */
4366   /* Use a global object (which is already required to be unique over
4367      the program) rather than the file name (which imposes extra
4368      constraints).  -- Raeburn@MIT.EDU, 10 Jan 1990.  */
4369   sprintf (buf, FILE_FUNCTION_FORMAT, p);
4370
4371   /* Don't need to pull weird characters out of global names.  */
4372   if (p != first_global_object_name)
4373     {
4374       for (p = buf+11; *p; p++)
4375         if (! ((*p >= '0' && *p <= '9')
4376 #if 0 /* we always want labels, which are valid C++ identifiers (+ `$') */
4377 #ifndef ASM_IDENTIFY_GCC        /* this is required if `.' is invalid -- k. raeburn */
4378                || *p == '.'
4379 #endif
4380 #endif
4381 #ifndef NO_DOLLAR_IN_LABEL      /* this for `$'; unlikely, but... -- kr */
4382                || *p == '$'
4383 #endif
4384 #ifndef NO_DOT_IN_LABEL         /* this for `.'; unlikely, but...  */
4385                || *p == '.'
4386 #endif
4387                || (*p >= 'A' && *p <= 'Z')
4388                || (*p >= 'a' && *p <= 'z')))
4389           *p = '_';
4390     }
4391
4392   buf[FILE_FUNCTION_PREFIX_LEN] = kind;
4393
4394   return get_identifier (buf);
4395 }
4396 \f
4397 /* Expand (the constant part of) a SET_TYPE CONSTRUCTOR node.
4398    The result is placed in BUFFER (which has length BIT_SIZE),
4399    with one bit in each char ('\000' or '\001').
4400
4401    If the constructor is constant, NULL_TREE is returned.
4402    Otherwise, a TREE_LIST of the non-constant elements is emitted.  */
4403
4404 tree
4405 get_set_constructor_bits (init, buffer, bit_size)
4406      tree init;
4407      char *buffer;
4408      int bit_size;
4409 {
4410   int i;
4411   tree vals;
4412   HOST_WIDE_INT domain_min
4413     = TREE_INT_CST_LOW (TYPE_MIN_VALUE (TYPE_DOMAIN (TREE_TYPE (init))));
4414   tree non_const_bits = NULL_TREE;
4415   for (i = 0; i < bit_size; i++)
4416     buffer[i] = 0;
4417
4418   for (vals = TREE_OPERAND (init, 1); 
4419        vals != NULL_TREE; vals = TREE_CHAIN (vals))
4420     {
4421       if (TREE_CODE (TREE_VALUE (vals)) != INTEGER_CST
4422           || (TREE_PURPOSE (vals) != NULL_TREE
4423               && TREE_CODE (TREE_PURPOSE (vals)) != INTEGER_CST))
4424         non_const_bits =
4425           tree_cons (TREE_PURPOSE (vals), TREE_VALUE (vals), non_const_bits);
4426       else if (TREE_PURPOSE (vals) != NULL_TREE)
4427         {
4428           /* Set a range of bits to ones.  */
4429           HOST_WIDE_INT lo_index
4430             = TREE_INT_CST_LOW (TREE_PURPOSE (vals)) - domain_min;
4431           HOST_WIDE_INT hi_index
4432             = TREE_INT_CST_LOW (TREE_VALUE (vals)) - domain_min;
4433           if (lo_index < 0 || lo_index >= bit_size
4434             || hi_index < 0 || hi_index >= bit_size)
4435             abort ();
4436           for ( ; lo_index <= hi_index; lo_index++)
4437             buffer[lo_index] = 1;
4438         }
4439       else
4440         {
4441           /* Set a single bit to one.  */
4442           HOST_WIDE_INT index
4443             = TREE_INT_CST_LOW (TREE_VALUE (vals)) - domain_min;
4444           if (index < 0 || index >= bit_size)
4445             {
4446               error ("invalid initializer for bit string");
4447               return NULL_TREE;
4448             }
4449           buffer[index] = 1;
4450         }
4451     }
4452   return non_const_bits;
4453 }
4454
4455 /* Expand (the constant part of) a SET_TYPE CONSTRUCTOR node.
4456    The result is placed in BUFFER (which is an array of bytes).
4457    If the constructor is constant, NULL_TREE is returned.
4458    Otherwise, a TREE_LIST of the non-constant elements is emitted.  */
4459
4460 tree
4461 get_set_constructor_bytes (init, buffer, wd_size)
4462      tree init;
4463      unsigned char *buffer;
4464      int wd_size;
4465 {
4466   int i;
4467   tree vals = TREE_OPERAND (init, 1);
4468   int set_word_size = BITS_PER_UNIT;
4469   int bit_size = wd_size * set_word_size;
4470   int bit_pos = 0;
4471   unsigned char *bytep = buffer;
4472   char *bit_buffer = (char *) alloca(bit_size);
4473   tree non_const_bits = get_set_constructor_bits (init, bit_buffer, bit_size);
4474
4475   for (i = 0; i < wd_size; i++)
4476     buffer[i] = 0;
4477
4478   for (i = 0; i < bit_size; i++)
4479     {
4480       if (bit_buffer[i])
4481         {
4482           if (BYTES_BIG_ENDIAN)
4483             *bytep |= (1 << (set_word_size - 1 - bit_pos));
4484           else
4485             *bytep |= 1 << bit_pos;
4486         }
4487       bit_pos++;
4488       if (bit_pos >= set_word_size)
4489         bit_pos = 0, bytep++;
4490     }
4491   return non_const_bits;
4492 }