OSDN Git Service

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