OSDN Git Service

(contains_placeholder): Return 1 for PLACEHOLDER_EXPR.
[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         length = sizeof (struct tree_int_cst);
1137       else if (code == REAL_CST)
1138         length = sizeof (struct tree_real_cst);
1139       else
1140         length = (sizeof (struct tree_common)
1141                   + tree_code_length[(int) code] * sizeof (char *));
1142       break;
1143
1144     case 'x':  /* something random, like an identifier.  */
1145       length = sizeof (struct tree_common)
1146         + tree_code_length[(int) code] * sizeof (char *);
1147       if (code == TREE_VEC)
1148         length += (TREE_VEC_LENGTH (node) - 1) * sizeof (char *);
1149     }
1150
1151   t = (tree) obstack_alloc (current_obstack, length);
1152
1153   for (i = (length / sizeof (int)) - 1; i >= 0; i--)
1154     ((int *) t)[i] = ((int *) node)[i];
1155   /* Clear any extra bytes.  */
1156   for (i = length / sizeof (int) * sizeof (int); i < length; i++)
1157     ((char *) t)[i] = ((char *) node)[i];
1158
1159   TREE_CHAIN (t) = 0;
1160
1161   if (TREE_CODE_CLASS (code) == 'd')
1162     DECL_UID (t) = next_decl_uid++;
1163   else if (TREE_CODE_CLASS (code) == 't')
1164     {
1165       TYPE_UID (t) = next_type_uid++;
1166       TYPE_OBSTACK (t) = current_obstack;
1167
1168       /* The following is so that the debug code for
1169          the copy is different from the original type.
1170          The two statements usually duplicate each other
1171          (because they clear fields of the same union),
1172          but the optimizer should catch that.  */
1173       TYPE_SYMTAB_POINTER (t) = 0;
1174       TYPE_SYMTAB_ADDRESS (t) = 0;
1175     }
1176
1177   TREE_PERMANENT (t) = (current_obstack == &permanent_obstack);
1178
1179   return t;
1180 }
1181
1182 /* Return a copy of a chain of nodes, chained through the TREE_CHAIN field.
1183    For example, this can copy a list made of TREE_LIST nodes.  */
1184
1185 tree
1186 copy_list (list)
1187      tree list;
1188 {
1189   tree head;
1190   register tree prev, next;
1191
1192   if (list == 0)
1193     return 0;
1194
1195   head = prev = copy_node (list);
1196   next = TREE_CHAIN (list);
1197   while (next)
1198     {
1199       TREE_CHAIN (prev) = copy_node (next);
1200       prev = TREE_CHAIN (prev);
1201       next = TREE_CHAIN (next);
1202     }
1203   return head;
1204 }
1205 \f
1206 #define HASHBITS 30
1207
1208 /* Return an IDENTIFIER_NODE whose name is TEXT (a null-terminated string).
1209    If an identifier with that name has previously been referred to,
1210    the same node is returned this time.  */
1211
1212 tree
1213 get_identifier (text)
1214      register char *text;
1215 {
1216   register int hi;
1217   register int i;
1218   register tree idp;
1219   register int len, hash_len;
1220
1221   /* Compute length of text in len.  */
1222   for (len = 0; text[len]; len++);
1223
1224   /* Decide how much of that length to hash on */
1225   hash_len = len;
1226   if (warn_id_clash && len > id_clash_len)
1227     hash_len = id_clash_len;
1228
1229   /* Compute hash code */
1230   hi = hash_len * 613 + (unsigned) text[0];
1231   for (i = 1; i < hash_len; i += 2)
1232     hi = ((hi * 613) + (unsigned) (text[i]));
1233
1234   hi &= (1 << HASHBITS) - 1;
1235   hi %= MAX_HASH_TABLE;
1236   
1237   /* Search table for identifier */
1238   for (idp = hash_table[hi]; idp; idp = TREE_CHAIN (idp))
1239     if (IDENTIFIER_LENGTH (idp) == len
1240         && IDENTIFIER_POINTER (idp)[0] == text[0]
1241         && !bcmp (IDENTIFIER_POINTER (idp), text, len))
1242       return idp;               /* <-- return if found */
1243
1244   /* Not found; optionally warn about a similar identifier */
1245   if (warn_id_clash && do_identifier_warnings && len >= id_clash_len)
1246     for (idp = hash_table[hi]; idp; idp = TREE_CHAIN (idp))
1247       if (!strncmp (IDENTIFIER_POINTER (idp), text, id_clash_len))
1248         {
1249           warning ("`%s' and `%s' identical in first %d characters",
1250                    IDENTIFIER_POINTER (idp), text, id_clash_len);
1251           break;
1252         }
1253
1254   if (tree_code_length[(int) IDENTIFIER_NODE] < 0)
1255     abort ();                   /* set_identifier_size hasn't been called.  */
1256
1257   /* Not found, create one, add to chain */
1258   idp = make_node (IDENTIFIER_NODE);
1259   IDENTIFIER_LENGTH (idp) = len;
1260 #ifdef GATHER_STATISTICS
1261   id_string_size += len;
1262 #endif
1263
1264   IDENTIFIER_POINTER (idp) = obstack_copy0 (&permanent_obstack, text, len);
1265
1266   TREE_CHAIN (idp) = hash_table[hi];
1267   hash_table[hi] = idp;
1268   return idp;                   /* <-- return if created */
1269 }
1270
1271 /* Enable warnings on similar identifiers (if requested).
1272    Done after the built-in identifiers are created.  */
1273
1274 void
1275 start_identifier_warnings ()
1276 {
1277   do_identifier_warnings = 1;
1278 }
1279
1280 /* Record the size of an identifier node for the language in use.
1281    SIZE is the total size in bytes.
1282    This is called by the language-specific files.  This must be
1283    called before allocating any identifiers.  */
1284
1285 void
1286 set_identifier_size (size)
1287      int size;
1288 {
1289   tree_code_length[(int) IDENTIFIER_NODE]
1290     = (size - sizeof (struct tree_common)) / sizeof (tree);
1291 }
1292 \f
1293 /* Return a newly constructed INTEGER_CST node whose constant value
1294    is specified by the two ints LOW and HI.
1295    The TREE_TYPE is set to `int'. 
1296
1297    This function should be used via the `build_int_2' macro.  */
1298
1299 tree
1300 build_int_2_wide (low, hi)
1301      HOST_WIDE_INT low, hi;
1302 {
1303   register tree t = make_node (INTEGER_CST);
1304   TREE_INT_CST_LOW (t) = low;
1305   TREE_INT_CST_HIGH (t) = hi;
1306   TREE_TYPE (t) = integer_type_node;
1307   return t;
1308 }
1309
1310 /* Return a new REAL_CST node whose type is TYPE and value is D.  */
1311
1312 tree
1313 build_real (type, d)
1314      tree type;
1315      REAL_VALUE_TYPE d;
1316 {
1317   tree v;
1318   int overflow = 0;
1319
1320   /* Check for valid float value for this type on this target machine;
1321      if not, can print error message and store a valid value in D.  */
1322 #ifdef CHECK_FLOAT_VALUE
1323   CHECK_FLOAT_VALUE (TYPE_MODE (type), d, overflow);
1324 #endif
1325
1326   v = make_node (REAL_CST);
1327   TREE_TYPE (v) = type;
1328   TREE_REAL_CST (v) = d;
1329   TREE_OVERFLOW (v) = TREE_CONSTANT_OVERFLOW (v) = overflow;
1330   return v;
1331 }
1332
1333 /* Return a new REAL_CST node whose type is TYPE
1334    and whose value is the integer value of the INTEGER_CST node I.  */
1335
1336 #if !defined (REAL_IS_NOT_DOUBLE) || defined (REAL_ARITHMETIC)
1337
1338 REAL_VALUE_TYPE
1339 real_value_from_int_cst (type, i)
1340      tree type, i;
1341 {
1342   REAL_VALUE_TYPE d;
1343   REAL_VALUE_TYPE e;
1344   /* Some 386 compilers mishandle unsigned int to float conversions,
1345      so introduce a temporary variable E to avoid those bugs.  */
1346
1347 #ifdef REAL_ARITHMETIC
1348   if (! TREE_UNSIGNED (TREE_TYPE (i)))
1349     REAL_VALUE_FROM_INT (d, TREE_INT_CST_LOW (i), TREE_INT_CST_HIGH (i),
1350                          TYPE_MODE (type));
1351   else
1352     REAL_VALUE_FROM_UNSIGNED_INT (d, TREE_INT_CST_LOW (i),
1353                                   TREE_INT_CST_HIGH (i), TYPE_MODE (type));
1354 #else /* not REAL_ARITHMETIC */
1355   if (TREE_INT_CST_HIGH (i) < 0 && ! TREE_UNSIGNED (TREE_TYPE (i)))
1356     {
1357       d = (double) (~ TREE_INT_CST_HIGH (i));
1358       e = ((double) ((HOST_WIDE_INT) 1 << (HOST_BITS_PER_WIDE_INT / 2))
1359             * (double) ((HOST_WIDE_INT) 1 << (HOST_BITS_PER_WIDE_INT / 2)));
1360       d *= e;
1361       e = (double) (unsigned HOST_WIDE_INT) (~ TREE_INT_CST_LOW (i));
1362       d += e;
1363       d = (- d - 1.0);
1364     }
1365   else
1366     {
1367       d = (double) (unsigned HOST_WIDE_INT) TREE_INT_CST_HIGH (i);
1368       e = ((double) ((HOST_WIDE_INT) 1 << (HOST_BITS_PER_WIDE_INT / 2))
1369             * (double) ((HOST_WIDE_INT) 1 << (HOST_BITS_PER_WIDE_INT / 2)));
1370       d *= e;
1371       e = (double) (unsigned HOST_WIDE_INT) TREE_INT_CST_LOW (i);
1372       d += e;
1373     }
1374 #endif /* not REAL_ARITHMETIC */
1375   return d;
1376 }
1377
1378 /* This function can't be implemented if we can't do arithmetic
1379    on the float representation.  */
1380
1381 tree
1382 build_real_from_int_cst (type, i)
1383      tree type;
1384      tree i;
1385 {
1386   tree v;
1387   int overflow = TREE_OVERFLOW (i);
1388   REAL_VALUE_TYPE d;
1389   jmp_buf float_error;
1390
1391   v = make_node (REAL_CST);
1392   TREE_TYPE (v) = type;
1393
1394   if (setjmp (float_error))
1395     {
1396       d = dconst0;
1397       overflow = 1;
1398       goto got_it;
1399     }
1400
1401   set_float_handler (float_error);
1402
1403 #ifdef REAL_ARITHMETIC
1404   d = real_value_from_int_cst (type, i);
1405 #else
1406   d = REAL_VALUE_TRUNCATE (TYPE_MODE (type),
1407                            real_value_from_int_cst (type, i));
1408 #endif
1409
1410   /* Check for valid float value for this type on this target machine.  */
1411
1412  got_it:
1413   set_float_handler (NULL_PTR);
1414
1415 #ifdef CHECK_FLOAT_VALUE
1416   CHECK_FLOAT_VALUE (TYPE_MODE (type), d, overflow);
1417 #endif
1418
1419   TREE_REAL_CST (v) = d;
1420   TREE_OVERFLOW (v) = TREE_CONSTANT_OVERFLOW (v) = overflow;
1421   return v;
1422 }
1423
1424 #endif /* not REAL_IS_NOT_DOUBLE, or REAL_ARITHMETIC */
1425
1426 /* Return a newly constructed STRING_CST node whose value is
1427    the LEN characters at STR.
1428    The TREE_TYPE is not initialized.  */
1429
1430 tree
1431 build_string (len, str)
1432      int len;
1433      char *str;
1434 {
1435   /* Put the string in saveable_obstack since it will be placed in the RTL
1436      for an "asm" statement and will also be kept around a while if
1437      deferring constant output in varasm.c.  */
1438
1439   register tree s = make_node (STRING_CST);
1440   TREE_STRING_LENGTH (s) = len;
1441   TREE_STRING_POINTER (s) = obstack_copy0 (saveable_obstack, str, len);
1442   return s;
1443 }
1444
1445 /* Return a newly constructed COMPLEX_CST node whose value is
1446    specified by the real and imaginary parts REAL and IMAG.
1447    Both REAL and IMAG should be constant nodes.
1448    The TREE_TYPE is not initialized.  */
1449
1450 tree
1451 build_complex (real, imag)
1452      tree real, imag;
1453 {
1454   register tree t = make_node (COMPLEX_CST);
1455
1456   TREE_REALPART (t) = real;
1457   TREE_IMAGPART (t) = imag;
1458   TREE_TYPE (t) = build_complex_type (TREE_TYPE (real));
1459   TREE_OVERFLOW (t) = TREE_OVERFLOW (real) | TREE_OVERFLOW (imag);
1460   TREE_CONSTANT_OVERFLOW (t)
1461     = TREE_CONSTANT_OVERFLOW (real) | TREE_CONSTANT_OVERFLOW (imag);
1462   return t;
1463 }
1464
1465 /* Build a newly constructed TREE_VEC node of length LEN.  */
1466
1467 tree
1468 make_tree_vec (len)
1469      int len;
1470 {
1471   register tree t;
1472   register int length = (len-1) * sizeof (tree) + sizeof (struct tree_vec);
1473   register struct obstack *obstack = current_obstack;
1474   register int i;
1475
1476 #ifdef GATHER_STATISTICS
1477   tree_node_counts[(int)vec_kind]++;
1478   tree_node_sizes[(int)vec_kind] += length;
1479 #endif
1480
1481   t = (tree) obstack_alloc (obstack, length);
1482
1483   for (i = (length / sizeof (int)) - 1; i >= 0; i--)
1484     ((int *) t)[i] = 0;
1485
1486   TREE_SET_CODE (t, TREE_VEC);
1487   TREE_VEC_LENGTH (t) = len;
1488   if (obstack == &permanent_obstack)
1489     TREE_PERMANENT (t) = 1;
1490
1491   return t;
1492 }
1493 \f
1494 /* Return 1 if EXPR is the integer constant zero or a complex constant
1495    of zero.  */
1496
1497 int
1498 integer_zerop (expr)
1499      tree expr;
1500 {
1501   STRIP_NOPS (expr);
1502
1503   return ((TREE_CODE (expr) == INTEGER_CST
1504            && TREE_INT_CST_LOW (expr) == 0
1505            && TREE_INT_CST_HIGH (expr) == 0)
1506           || (TREE_CODE (expr) == COMPLEX_CST
1507               && integer_zerop (TREE_REALPART (expr))
1508               && integer_zerop (TREE_IMAGPART (expr))));
1509 }
1510
1511 /* Return 1 if EXPR is the integer constant one or the corresponding
1512    complex constant.  */
1513
1514 int
1515 integer_onep (expr)
1516      tree expr;
1517 {
1518   STRIP_NOPS (expr);
1519
1520   return ((TREE_CODE (expr) == INTEGER_CST
1521            && TREE_INT_CST_LOW (expr) == 1
1522            && TREE_INT_CST_HIGH (expr) == 0)
1523           || (TREE_CODE (expr) == COMPLEX_CST
1524               && integer_onep (TREE_REALPART (expr))
1525               && integer_zerop (TREE_IMAGPART (expr))));
1526 }
1527
1528 /* Return 1 if EXPR is an integer containing all 1's in as much precision as
1529    it contains.  Likewise for the corresponding complex constant.  */
1530
1531 int
1532 integer_all_onesp (expr)
1533      tree expr;
1534 {
1535   register int prec;
1536   register int uns;
1537
1538   STRIP_NOPS (expr);
1539
1540   if (TREE_CODE (expr) == COMPLEX_CST
1541       && integer_all_onesp (TREE_REALPART (expr))
1542       && integer_zerop (TREE_IMAGPART (expr)))
1543     return 1;
1544
1545   else if (TREE_CODE (expr) != INTEGER_CST)
1546     return 0;
1547
1548   uns = TREE_UNSIGNED (TREE_TYPE (expr));
1549   if (!uns)
1550     return TREE_INT_CST_LOW (expr) == -1 && TREE_INT_CST_HIGH (expr) == -1;
1551
1552   /* Note that using TYPE_PRECISION here is wrong.  We care about the
1553      actual bits, not the (arbitrary) range of the type.  */
1554   prec = GET_MODE_BITSIZE (TYPE_MODE (TREE_TYPE (expr)));
1555   if (prec >= HOST_BITS_PER_WIDE_INT)
1556     {
1557       int high_value, shift_amount;
1558
1559       shift_amount = prec - HOST_BITS_PER_WIDE_INT;
1560
1561       if (shift_amount > HOST_BITS_PER_WIDE_INT)
1562         /* Can not handle precisions greater than twice the host int size.  */
1563         abort ();
1564       else if (shift_amount == HOST_BITS_PER_WIDE_INT)
1565         /* Shifting by the host word size is undefined according to the ANSI
1566            standard, so we must handle this as a special case.  */
1567         high_value = -1;
1568       else
1569         high_value = ((HOST_WIDE_INT) 1 << shift_amount) - 1;
1570
1571       return TREE_INT_CST_LOW (expr) == -1
1572         && TREE_INT_CST_HIGH (expr) == high_value;
1573     }
1574   else
1575     return TREE_INT_CST_LOW (expr) == ((HOST_WIDE_INT) 1 << prec) - 1;
1576 }
1577
1578 /* Return 1 if EXPR is an integer constant that is a power of 2 (i.e., has only
1579    one bit on).  */
1580
1581 int
1582 integer_pow2p (expr)
1583      tree expr;
1584 {
1585   HOST_WIDE_INT high, low;
1586
1587   STRIP_NOPS (expr);
1588
1589   if (TREE_CODE (expr) == COMPLEX_CST
1590       && integer_pow2p (TREE_REALPART (expr))
1591       && integer_zerop (TREE_IMAGPART (expr)))
1592     return 1;
1593
1594   if (TREE_CODE (expr) != INTEGER_CST)
1595     return 0;
1596
1597   high = TREE_INT_CST_HIGH (expr);
1598   low = TREE_INT_CST_LOW (expr);
1599
1600   if (high == 0 && low == 0)
1601     return 0;
1602
1603   return ((high == 0 && (low & (low - 1)) == 0)
1604           || (low == 0 && (high & (high - 1)) == 0));
1605 }
1606
1607 /* Return 1 if EXPR is the real constant zero.  */
1608
1609 int
1610 real_zerop (expr)
1611      tree expr;
1612 {
1613   STRIP_NOPS (expr);
1614
1615   return ((TREE_CODE (expr) == REAL_CST
1616            && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst0))
1617           || (TREE_CODE (expr) == COMPLEX_CST
1618               && real_zerop (TREE_REALPART (expr))
1619               && real_zerop (TREE_IMAGPART (expr))));
1620 }
1621
1622 /* Return 1 if EXPR is the real constant one in real or complex form.  */
1623
1624 int
1625 real_onep (expr)
1626      tree expr;
1627 {
1628   STRIP_NOPS (expr);
1629
1630   return ((TREE_CODE (expr) == REAL_CST
1631            && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst1))
1632           || (TREE_CODE (expr) == COMPLEX_CST
1633               && real_onep (TREE_REALPART (expr))
1634               && real_zerop (TREE_IMAGPART (expr))));
1635 }
1636
1637 /* Return 1 if EXPR is the real constant two.  */
1638
1639 int
1640 real_twop (expr)
1641      tree expr;
1642 {
1643   STRIP_NOPS (expr);
1644
1645   return ((TREE_CODE (expr) == REAL_CST
1646            && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst2))
1647           || (TREE_CODE (expr) == COMPLEX_CST
1648               && real_twop (TREE_REALPART (expr))
1649               && real_zerop (TREE_IMAGPART (expr))));
1650 }
1651
1652 /* Nonzero if EXP is a constant or a cast of a constant.  */
1653  
1654 int
1655 really_constant_p (exp)
1656      tree exp;
1657 {
1658   /* This is not quite the same as STRIP_NOPS.  It does more.  */
1659   while (TREE_CODE (exp) == NOP_EXPR
1660          || TREE_CODE (exp) == CONVERT_EXPR
1661          || TREE_CODE (exp) == NON_LVALUE_EXPR)
1662     exp = TREE_OPERAND (exp, 0);
1663   return TREE_CONSTANT (exp);
1664 }
1665 \f
1666 /* Return first list element whose TREE_VALUE is ELEM.
1667    Return 0 if ELEM is not in LIST.  */
1668
1669 tree
1670 value_member (elem, list)
1671      tree elem, list;
1672 {
1673   while (list)
1674     {
1675       if (elem == TREE_VALUE (list))
1676         return list;
1677       list = TREE_CHAIN (list);
1678     }
1679   return NULL_TREE;
1680 }
1681
1682 /* Return first list element whose TREE_PURPOSE is ELEM.
1683    Return 0 if ELEM is not in LIST.  */
1684
1685 tree
1686 purpose_member (elem, list)
1687      tree elem, list;
1688 {
1689   while (list)
1690     {
1691       if (elem == TREE_PURPOSE (list))
1692         return list;
1693       list = TREE_CHAIN (list);
1694     }
1695   return NULL_TREE;
1696 }
1697
1698 /* Return first list element whose BINFO_TYPE is ELEM.
1699    Return 0 if ELEM is not in LIST.  */
1700
1701 tree
1702 binfo_member (elem, list)
1703      tree elem, list;
1704 {
1705   while (list)
1706     {
1707       if (elem == BINFO_TYPE (list))
1708         return list;
1709       list = TREE_CHAIN (list);
1710     }
1711   return NULL_TREE;
1712 }
1713
1714 /* Return nonzero if ELEM is part of the chain CHAIN.  */
1715
1716 int
1717 chain_member (elem, chain)
1718      tree elem, chain;
1719 {
1720   while (chain)
1721     {
1722       if (elem == chain)
1723         return 1;
1724       chain = TREE_CHAIN (chain);
1725     }
1726
1727   return 0;
1728 }
1729
1730 /* Return nonzero if ELEM is equal to TREE_VALUE (CHAIN) for any piece of
1731    chain CHAIN.  */
1732 /* ??? This function was added for machine specific attributes but is no
1733    longer used.  It could be deleted if we could confirm all front ends
1734    don't use it.  */
1735
1736 int
1737 chain_member_value (elem, chain)
1738      tree elem, chain;
1739 {
1740   while (chain)
1741     {
1742       if (elem == TREE_VALUE (chain))
1743         return 1;
1744       chain = TREE_CHAIN (chain);
1745     }
1746
1747   return 0;
1748 }
1749
1750 /* Return nonzero if ELEM is equal to TREE_PURPOSE (CHAIN)
1751    for any piece of chain CHAIN.  */
1752 /* ??? This function was added for machine specific attributes but is no
1753    longer used.  It could be deleted if we could confirm all front ends
1754    don't use it.  */
1755
1756 int
1757 chain_member_purpose (elem, chain)
1758      tree elem, chain;
1759 {
1760   while (chain)
1761     {
1762       if (elem == TREE_PURPOSE (chain))
1763         return 1;
1764       chain = TREE_CHAIN (chain);
1765     }
1766
1767   return 0;
1768 }
1769
1770 /* Return the length of a chain of nodes chained through TREE_CHAIN.
1771    We expect a null pointer to mark the end of the chain.
1772    This is the Lisp primitive `length'.  */
1773
1774 int
1775 list_length (t)
1776      tree t;
1777 {
1778   register tree tail;
1779   register int len = 0;
1780
1781   for (tail = t; tail; tail = TREE_CHAIN (tail))
1782     len++;
1783
1784   return len;
1785 }
1786
1787 /* Concatenate two chains of nodes (chained through TREE_CHAIN)
1788    by modifying the last node in chain 1 to point to chain 2.
1789    This is the Lisp primitive `nconc'.  */
1790
1791 tree
1792 chainon (op1, op2)
1793      tree op1, op2;
1794 {
1795
1796   if (op1)
1797     {
1798       register tree t1;
1799       register tree t2;
1800
1801       for (t1 = op1; TREE_CHAIN (t1); t1 = TREE_CHAIN (t1))
1802         ;
1803       TREE_CHAIN (t1) = op2;
1804       for (t2 = op2; t2; t2 = TREE_CHAIN (t2))
1805         if (t2 == t1)
1806           abort ();  /* Circularity created.  */
1807       return op1;
1808     }
1809   else return op2;
1810 }
1811
1812 /* Return the last node in a chain of nodes (chained through TREE_CHAIN).  */
1813
1814 tree
1815 tree_last (chain)
1816      register tree chain;
1817 {
1818   register tree next;
1819   if (chain)
1820     while (next = TREE_CHAIN (chain))
1821       chain = next;
1822   return chain;
1823 }
1824
1825 /* Reverse the order of elements in the chain T,
1826    and return the new head of the chain (old last element).  */
1827
1828 tree
1829 nreverse (t)
1830      tree t;
1831 {
1832   register tree prev = 0, decl, next;
1833   for (decl = t; decl; decl = next)
1834     {
1835       next = TREE_CHAIN (decl);
1836       TREE_CHAIN (decl) = prev;
1837       prev = decl;
1838     }
1839   return prev;
1840 }
1841
1842 /* Given a chain CHAIN of tree nodes,
1843    construct and return a list of those nodes.  */
1844
1845 tree
1846 listify (chain)
1847      tree chain;
1848 {
1849   tree result = NULL_TREE;
1850   tree in_tail = chain;
1851   tree out_tail = NULL_TREE;
1852
1853   while (in_tail)
1854     {
1855       tree next = tree_cons (NULL_TREE, in_tail, NULL_TREE);
1856       if (out_tail)
1857         TREE_CHAIN (out_tail) = next;
1858       else
1859         result = next;
1860       out_tail = next;
1861       in_tail = TREE_CHAIN (in_tail);
1862     }
1863
1864   return result;
1865 }
1866 \f
1867 /* Return a newly created TREE_LIST node whose
1868    purpose and value fields are PARM and VALUE.  */
1869
1870 tree
1871 build_tree_list (parm, value)
1872      tree parm, value;
1873 {
1874   register tree t = make_node (TREE_LIST);
1875   TREE_PURPOSE (t) = parm;
1876   TREE_VALUE (t) = value;
1877   return t;
1878 }
1879
1880 /* Similar, but build on the temp_decl_obstack.  */
1881
1882 tree
1883 build_decl_list (parm, value)
1884      tree parm, value;
1885 {
1886   register tree node;
1887   register struct obstack *ambient_obstack = current_obstack;
1888   current_obstack = &temp_decl_obstack;
1889   node = build_tree_list (parm, value);
1890   current_obstack = ambient_obstack;
1891   return node;
1892 }
1893
1894 /* Return a newly created TREE_LIST node whose
1895    purpose and value fields are PARM and VALUE
1896    and whose TREE_CHAIN is CHAIN.  */
1897
1898 tree
1899 tree_cons (purpose, value, chain)
1900      tree purpose, value, chain;
1901 {
1902 #if 0
1903   register tree node = make_node (TREE_LIST);
1904 #else
1905   register int i;
1906   register tree node = (tree) obstack_alloc (current_obstack, sizeof (struct tree_list));
1907 #ifdef GATHER_STATISTICS
1908   tree_node_counts[(int)x_kind]++;
1909   tree_node_sizes[(int)x_kind] += sizeof (struct tree_list);
1910 #endif
1911
1912   for (i = (sizeof (struct tree_common) / sizeof (int)) - 1; i >= 0; i--)
1913     ((int *) node)[i] = 0;
1914
1915   TREE_SET_CODE (node, TREE_LIST);
1916   if (current_obstack == &permanent_obstack)
1917     TREE_PERMANENT (node) = 1;
1918 #endif
1919
1920   TREE_CHAIN (node) = chain;
1921   TREE_PURPOSE (node) = purpose;
1922   TREE_VALUE (node) = value;
1923   return node;
1924 }
1925
1926 /* Similar, but build on the temp_decl_obstack.  */
1927
1928 tree
1929 decl_tree_cons (purpose, value, chain)
1930      tree purpose, value, chain;
1931 {
1932   register tree node;
1933   register struct obstack *ambient_obstack = current_obstack;
1934   current_obstack = &temp_decl_obstack;
1935   node = tree_cons (purpose, value, chain);
1936   current_obstack = ambient_obstack;
1937   return node;
1938 }
1939
1940 /* Same as `tree_cons' but make a permanent object.  */
1941
1942 tree
1943 perm_tree_cons (purpose, value, chain)
1944      tree purpose, value, chain;
1945 {
1946   register tree node;
1947   register struct obstack *ambient_obstack = current_obstack;
1948   current_obstack = &permanent_obstack;
1949
1950   node = tree_cons (purpose, value, chain);
1951   current_obstack = ambient_obstack;
1952   return node;
1953 }
1954
1955 /* Same as `tree_cons', but make this node temporary, regardless.  */
1956
1957 tree
1958 temp_tree_cons (purpose, value, chain)
1959      tree purpose, value, chain;
1960 {
1961   register tree node;
1962   register struct obstack *ambient_obstack = current_obstack;
1963   current_obstack = &temporary_obstack;
1964
1965   node = tree_cons (purpose, value, chain);
1966   current_obstack = ambient_obstack;
1967   return node;
1968 }
1969
1970 /* Same as `tree_cons', but save this node if the function's RTL is saved.  */
1971
1972 tree
1973 saveable_tree_cons (purpose, value, chain)
1974      tree purpose, value, chain;
1975 {
1976   register tree node;
1977   register struct obstack *ambient_obstack = current_obstack;
1978   current_obstack = saveable_obstack;
1979
1980   node = tree_cons (purpose, value, chain);
1981   current_obstack = ambient_obstack;
1982   return node;
1983 }
1984 \f
1985 /* Return the size nominally occupied by an object of type TYPE
1986    when it resides in memory.  The value is measured in units of bytes,
1987    and its data type is that normally used for type sizes
1988    (which is the first type created by make_signed_type or
1989    make_unsigned_type).  */
1990
1991 tree
1992 size_in_bytes (type)
1993      tree type;
1994 {
1995   tree t;
1996
1997   if (type == error_mark_node)
1998     return integer_zero_node;
1999   type = TYPE_MAIN_VARIANT (type);
2000   if (TYPE_SIZE (type) == 0)
2001     {
2002       incomplete_type_error (NULL_TREE, type);
2003       return integer_zero_node;
2004     }
2005   t = size_binop (CEIL_DIV_EXPR, TYPE_SIZE (type),
2006                   size_int (BITS_PER_UNIT));
2007   if (TREE_CODE (t) == INTEGER_CST)
2008     force_fit_type (t, 0);
2009   return t;
2010 }
2011
2012 /* Return the size of TYPE (in bytes) as an integer,
2013    or return -1 if the size can vary.  */
2014
2015 int
2016 int_size_in_bytes (type)
2017      tree type;
2018 {
2019   unsigned int size;
2020   if (type == error_mark_node)
2021     return 0;
2022   type = TYPE_MAIN_VARIANT (type);
2023   if (TYPE_SIZE (type) == 0)
2024     return -1;
2025   if (TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST)
2026     return -1;
2027   if (TREE_INT_CST_HIGH (TYPE_SIZE (type)) != 0)
2028     {
2029       tree t = size_binop (CEIL_DIV_EXPR, TYPE_SIZE (type),
2030                            size_int (BITS_PER_UNIT));
2031       return TREE_INT_CST_LOW (t);
2032     }
2033   size = TREE_INT_CST_LOW (TYPE_SIZE (type));
2034   return (size + BITS_PER_UNIT - 1) / BITS_PER_UNIT;
2035 }
2036 \f
2037 /* Return, as a tree node, the number of elements for TYPE (which is an
2038    ARRAY_TYPE) minus one. This counts only elements of the top array.  */
2039
2040 tree
2041 array_type_nelts (type)
2042      tree type;
2043 {
2044   tree index_type = TYPE_DOMAIN (type);
2045
2046   return (integer_zerop (TYPE_MIN_VALUE (index_type))
2047           ? TYPE_MAX_VALUE (index_type)
2048           : fold (build (MINUS_EXPR, TREE_TYPE (TYPE_MAX_VALUE (index_type)),
2049                          TYPE_MAX_VALUE (index_type),
2050                          TYPE_MIN_VALUE (index_type))));
2051 }
2052 \f
2053 /* Return nonzero if arg is static -- a reference to an object in
2054    static storage.  This is not the same as the C meaning of `static'.  */
2055
2056 int
2057 staticp (arg)
2058      tree arg;
2059 {
2060   switch (TREE_CODE (arg))
2061     {
2062     case FUNCTION_DECL:
2063       /* Nested functions aren't static, since taking their address
2064          involves a trampoline.  */
2065        return decl_function_context (arg) == 0 || DECL_NO_STATIC_CHAIN (arg);
2066     case VAR_DECL:
2067       return TREE_STATIC (arg) || DECL_EXTERNAL (arg);
2068
2069     case CONSTRUCTOR:
2070       return TREE_STATIC (arg);
2071
2072     case STRING_CST:
2073       return 1;
2074
2075     case COMPONENT_REF:
2076     case BIT_FIELD_REF:
2077       return staticp (TREE_OPERAND (arg, 0));
2078
2079 #if 0
2080        /* This case is technically correct, but results in setting
2081           TREE_CONSTANT on ADDR_EXPRs that cannot be evaluated at
2082           compile time.  */
2083     case INDIRECT_REF:
2084       return TREE_CONSTANT (TREE_OPERAND (arg, 0));
2085 #endif
2086
2087     case ARRAY_REF:
2088       if (TREE_CODE (TYPE_SIZE (TREE_TYPE (arg))) == INTEGER_CST
2089           && TREE_CODE (TREE_OPERAND (arg, 1)) == INTEGER_CST)
2090         return staticp (TREE_OPERAND (arg, 0));
2091     }
2092
2093   return 0;
2094 }
2095 \f
2096 /* Wrap a SAVE_EXPR around EXPR, if appropriate.
2097    Do this to any expression which may be used in more than one place,
2098    but must be evaluated only once.
2099
2100    Normally, expand_expr would reevaluate the expression each time.
2101    Calling save_expr produces something that is evaluated and recorded
2102    the first time expand_expr is called on it.  Subsequent calls to
2103    expand_expr just reuse the recorded value.
2104
2105    The call to expand_expr that generates code that actually computes
2106    the value is the first call *at compile time*.  Subsequent calls
2107    *at compile time* generate code to use the saved value.
2108    This produces correct result provided that *at run time* control
2109    always flows through the insns made by the first expand_expr
2110    before reaching the other places where the save_expr was evaluated.
2111    You, the caller of save_expr, must make sure this is so.
2112
2113    Constants, and certain read-only nodes, are returned with no
2114    SAVE_EXPR because that is safe.  Expressions containing placeholders
2115    are not touched; see tree.def for an explanation of what these
2116    are used for.  */
2117
2118 tree
2119 save_expr (expr)
2120      tree expr;
2121 {
2122   register tree t = fold (expr);
2123
2124   /* We don't care about whether this can be used as an lvalue in this
2125      context.  */
2126   while (TREE_CODE (t) == NON_LVALUE_EXPR)
2127     t = TREE_OPERAND (t, 0);
2128
2129   /* If the tree evaluates to a constant, then we don't want to hide that
2130      fact (i.e. this allows further folding, and direct checks for constants).
2131      However, a read-only object that has side effects cannot be bypassed.
2132      Since it is no problem to reevaluate literals, we just return the 
2133      literal node.  */
2134
2135   if (TREE_CONSTANT (t) || (TREE_READONLY (t) && ! TREE_SIDE_EFFECTS (t))
2136       || TREE_CODE (t) == SAVE_EXPR || TREE_CODE (t) == ERROR_MARK)
2137     return t;
2138
2139   /* If T contains a PLACEHOLDER_EXPR, we must evaluate it each time, since
2140      it means that the size or offset of some field of an object depends on
2141      the value within another field.
2142
2143      Note that it must not be the case that T contains both a PLACEHOLDER_EXPR
2144      and some variable since it would then need to be both evaluated once and
2145      evaluated more than once.  Front-ends must assure this case cannot
2146      happen by surrounding any such subexpressions in their own SAVE_EXPR
2147      and forcing evaluation at the proper time.  */
2148   if (contains_placeholder_p (t))
2149     return t;
2150
2151   t = build (SAVE_EXPR, TREE_TYPE (expr), t, current_function_decl, NULL_TREE);
2152
2153   /* This expression might be placed ahead of a jump to ensure that the
2154      value was computed on both sides of the jump.  So make sure it isn't
2155      eliminated as dead.  */
2156   TREE_SIDE_EFFECTS (t) = 1;
2157   return t;
2158 }
2159
2160 /* Arrange for an expression to be expanded multiple independent
2161    times.  This is useful for cleanup actions, as the backend can
2162    expand them multiple times in different places.  */
2163
2164 tree
2165 unsave_expr (expr)
2166      tree expr;
2167 {
2168   tree t;
2169
2170   /* If this is already protected, no sense in protecting it again.  */
2171   if (TREE_CODE (expr) == UNSAVE_EXPR)
2172     return expr;
2173
2174   t = build1 (UNSAVE_EXPR, TREE_TYPE (expr), expr);
2175   TREE_SIDE_EFFECTS (t) = TREE_SIDE_EFFECTS (expr);
2176   return t;
2177 }
2178
2179 /* Modify a tree in place so that all the evaluate only once things
2180    are cleared out.  Return the EXPR given.  */
2181
2182 tree
2183 unsave_expr_now (expr)
2184      tree expr;
2185 {
2186   enum tree_code code;
2187   register int i;
2188
2189   if (expr == NULL_TREE)
2190     return expr;
2191
2192   code = TREE_CODE (expr);
2193   switch (code)
2194     {
2195     case SAVE_EXPR:
2196       SAVE_EXPR_RTL (expr) = 0;
2197       break;
2198
2199     case TARGET_EXPR:
2200       TREE_OPERAND (expr, 1) = TREE_OPERAND (expr, 3);
2201       TREE_OPERAND (expr, 3) = NULL_TREE;
2202       break;
2203       
2204     case RTL_EXPR:
2205       /* I don't yet know how to emit a sequence multiple times.  */
2206       if (RTL_EXPR_SEQUENCE (expr) != 0)
2207         abort ();
2208       break;
2209
2210     case CALL_EXPR:
2211       CALL_EXPR_RTL (expr) = 0;
2212       if (TREE_OPERAND (expr, 1)
2213           && TREE_CODE (TREE_OPERAND (expr, 1)) == TREE_LIST)
2214         {
2215           tree exp = TREE_OPERAND (expr, 1);
2216           while (exp)
2217             {
2218               unsave_expr_now (TREE_VALUE (exp));
2219               exp = TREE_CHAIN (exp);
2220             }
2221         }
2222       break;
2223     }
2224
2225   switch (TREE_CODE_CLASS (code))
2226     {
2227     case 'c':  /* a constant */
2228     case 't':  /* a type node */
2229     case 'x':  /* something random, like an identifier or an ERROR_MARK.  */
2230     case 'd':  /* A decl node */
2231     case 'b':  /* A block node */
2232       return expr;
2233
2234     case 'e':  /* an expression */
2235     case 'r':  /* a reference */
2236     case 's':  /* an expression with side effects */
2237     case '<':  /* a comparison expression */
2238     case '2':  /* a binary arithmetic expression */
2239     case '1':  /* a unary arithmetic expression */
2240       for (i = tree_code_length[(int) code] - 1; i >= 0; i--)
2241         unsave_expr_now (TREE_OPERAND (expr, i));
2242       return expr;
2243
2244     default:
2245       abort ();
2246     }
2247 }
2248 \f
2249 /* Return 1 if EXP contains a PLACEHOLDER_EXPR; i.e., if it represents a size
2250    or offset that depends on a field within a record.
2251
2252    Note that we only allow such expressions within simple arithmetic
2253    or a COND_EXPR.  */
2254
2255 int
2256 contains_placeholder_p (exp)
2257      tree exp;
2258 {
2259   register enum tree_code code = TREE_CODE (exp);
2260   tree inner;
2261
2262   /* If we have a WITH_RECORD_EXPR, it "cancels" any PLACEHOLDER_EXPR
2263      in it since it is supplying a value for it.  */
2264   if (code == WITH_RECORD_EXPR)
2265     return 0;
2266   else if (code == PLACEHOLDER_EXPR)
2267     return 1;
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 = expression_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   length = sizeof (struct tree_exp);
2708
2709   t = (tree) obstack_alloc (obstack, length);
2710
2711 #ifdef GATHER_STATISTICS
2712   tree_node_counts[(int)kind]++;
2713   tree_node_sizes[(int)kind] += length;
2714 #endif
2715
2716   for (i = (length / sizeof (int)) - 1; i >= 0; i--)
2717     ((int *) t)[i] = 0;
2718
2719   TREE_TYPE (t) = type;
2720   TREE_SET_CODE (t, code);
2721
2722   if (obstack == &permanent_obstack)
2723     TREE_PERMANENT (t) = 1;
2724
2725   TREE_OPERAND (t, 0) = node;
2726   if (node)
2727     {
2728       if (TREE_SIDE_EFFECTS (node))
2729         TREE_SIDE_EFFECTS (t) = 1;
2730       if (TREE_RAISES (node))
2731         TREE_RAISES (t) = 1;
2732     }
2733
2734   return t;
2735 }
2736
2737 /* Similar except don't specify the TREE_TYPE
2738    and leave the TREE_SIDE_EFFECTS as 0.
2739    It is permissible for arguments to be null,
2740    or even garbage if their values do not matter.  */
2741
2742 tree
2743 build_nt VPROTO((enum tree_code code, ...))
2744 {
2745 #ifndef __STDC__
2746   enum tree_code code;
2747 #endif
2748   va_list p;
2749   register tree t;
2750   register int length;
2751   register int i;
2752
2753   VA_START (p, code);
2754
2755 #ifndef __STDC__
2756   code = va_arg (p, enum tree_code);
2757 #endif
2758
2759   t = make_node (code);
2760   length = tree_code_length[(int) code];
2761
2762   for (i = 0; i < length; i++)
2763     TREE_OPERAND (t, i) = va_arg (p, tree);
2764
2765   va_end (p);
2766   return t;
2767 }
2768
2769 /* Similar to `build_nt', except we build
2770    on the temp_decl_obstack, regardless.  */
2771
2772 tree
2773 build_parse_node VPROTO((enum tree_code code, ...))
2774 {
2775 #ifndef __STDC__
2776   enum tree_code code;
2777 #endif
2778   register struct obstack *ambient_obstack = expression_obstack;
2779   va_list p;
2780   register tree t;
2781   register int length;
2782   register int i;
2783
2784   VA_START (p, code);
2785
2786 #ifndef __STDC__
2787   code = va_arg (p, enum tree_code);
2788 #endif
2789
2790   expression_obstack = &temp_decl_obstack;
2791
2792   t = make_node (code);
2793   length = tree_code_length[(int) code];
2794
2795   for (i = 0; i < length; i++)
2796     TREE_OPERAND (t, i) = va_arg (p, tree);
2797
2798   va_end (p);
2799   expression_obstack = ambient_obstack;
2800   return t;
2801 }
2802
2803 #if 0
2804 /* Commented out because this wants to be done very
2805    differently.  See cp-lex.c.  */
2806 tree
2807 build_op_identifier (op1, op2)
2808      tree op1, op2;
2809 {
2810   register tree t = make_node (OP_IDENTIFIER);
2811   TREE_PURPOSE (t) = op1;
2812   TREE_VALUE (t) = op2;
2813   return t;
2814 }
2815 #endif
2816 \f
2817 /* Create a DECL_... node of code CODE, name NAME and data type TYPE.
2818    We do NOT enter this node in any sort of symbol table.
2819
2820    layout_decl is used to set up the decl's storage layout.
2821    Other slots are initialized to 0 or null pointers.  */
2822
2823 tree
2824 build_decl (code, name, type)
2825      enum tree_code code;
2826      tree name, type;
2827 {
2828   register tree t;
2829
2830   t = make_node (code);
2831
2832 /*  if (type == error_mark_node)
2833     type = integer_type_node; */
2834 /* That is not done, deliberately, so that having error_mark_node
2835    as the type can suppress useless errors in the use of this variable.  */
2836
2837   DECL_NAME (t) = name;
2838   DECL_ASSEMBLER_NAME (t) = name;
2839   TREE_TYPE (t) = type;
2840
2841   if (code == VAR_DECL || code == PARM_DECL || code == RESULT_DECL)
2842     layout_decl (t, 0);
2843   else if (code == FUNCTION_DECL)
2844     DECL_MODE (t) = FUNCTION_MODE;
2845
2846   return t;
2847 }
2848 \f
2849 /* BLOCK nodes are used to represent the structure of binding contours
2850    and declarations, once those contours have been exited and their contents
2851    compiled.  This information is used for outputting debugging info.  */
2852
2853 tree
2854 build_block (vars, tags, subblocks, supercontext, chain)
2855      tree vars, tags, subblocks, supercontext, chain;
2856 {
2857   register tree block = make_node (BLOCK);
2858   BLOCK_VARS (block) = vars;
2859   BLOCK_TYPE_TAGS (block) = tags;
2860   BLOCK_SUBBLOCKS (block) = subblocks;
2861   BLOCK_SUPERCONTEXT (block) = supercontext;
2862   BLOCK_CHAIN (block) = chain;
2863   return block;
2864 }
2865 \f
2866 /* Return a declaration like DDECL except that its DECL_MACHINE_ATTRIBUTE
2867    is ATTRIBUTE.  */
2868
2869 tree
2870 build_decl_attribute_variant (ddecl, attribute)
2871      tree ddecl, attribute;
2872 {
2873   DECL_MACHINE_ATTRIBUTES (ddecl) = attribute;
2874   return ddecl;
2875 }
2876
2877 /* Return a type like TTYPE except that its TYPE_ATTRIBUTE
2878    is ATTRIBUTE.
2879
2880    Record such modified types already made so we don't make duplicates.  */
2881
2882 tree
2883 build_type_attribute_variant (ttype, attribute)
2884      tree ttype, attribute;
2885 {
2886   if ( ! attribute_list_equal (TYPE_ATTRIBUTES (ttype), attribute))
2887     {
2888       register int hashcode;
2889       register struct obstack *ambient_obstack = current_obstack;
2890       tree ntype;
2891
2892       if (ambient_obstack != &permanent_obstack)
2893         current_obstack = TYPE_OBSTACK (ttype);
2894
2895       ntype = copy_node (ttype);
2896       current_obstack = ambient_obstack;
2897
2898       TYPE_POINTER_TO (ntype) = 0;
2899       TYPE_REFERENCE_TO (ntype) = 0;
2900       TYPE_ATTRIBUTES (ntype) = attribute;
2901
2902       /* Create a new main variant of TYPE.  */
2903       TYPE_MAIN_VARIANT (ntype) = ntype;
2904       TYPE_NEXT_VARIANT (ntype) = 0;
2905       TYPE_READONLY (ntype) = TYPE_VOLATILE (ntype) = 0;
2906
2907       hashcode = TYPE_HASH (TREE_CODE (ntype))
2908                  + TYPE_HASH (TREE_TYPE (ntype))
2909                  + attribute_hash_list (attribute);
2910
2911       switch (TREE_CODE (ntype))
2912         {
2913           case FUNCTION_TYPE:
2914             hashcode += TYPE_HASH (TYPE_ARG_TYPES (ntype));
2915             break;
2916           case ARRAY_TYPE:
2917             hashcode += TYPE_HASH (TYPE_DOMAIN (ntype));
2918             break;
2919           case INTEGER_TYPE:
2920             hashcode += TYPE_HASH (TYPE_MAX_VALUE (ntype));
2921             break;
2922           case REAL_TYPE:
2923             hashcode += TYPE_HASH (TYPE_PRECISION (ntype));
2924             break;
2925         }
2926
2927       ntype = type_hash_canon (hashcode, ntype);
2928       ttype = build_type_variant (ntype, TYPE_READONLY (ttype),
2929                                   TYPE_VOLATILE (ttype));
2930     }
2931
2932   return ttype;
2933 }
2934
2935 /* Return a 1 if ATTR_NAME and ATTR_ARGS is valid for either declaration DECL
2936    or type TYPE and 0 otherwise.  Validity is determined the configuration
2937    macros VALID_MACHINE_DECL_ATTRIBUTE and VALID_MACHINE_TYPE_ATTRIBUTE.  */
2938
2939 int
2940 valid_machine_attribute (attr_name, attr_args, decl, type)
2941      tree attr_name, attr_args;
2942      tree decl;
2943      tree type;
2944 {
2945   int valid = 0;
2946   tree decl_attr_list = decl != 0 ? DECL_MACHINE_ATTRIBUTES (decl) : 0;
2947   tree type_attr_list = TYPE_ATTRIBUTES (type);
2948
2949   if (TREE_CODE (attr_name) != IDENTIFIER_NODE)
2950     abort ();
2951
2952 #ifdef VALID_MACHINE_DECL_ATTRIBUTE
2953   if (decl != 0
2954       && VALID_MACHINE_DECL_ATTRIBUTE (decl, decl_attr_list, attr_name, attr_args))
2955     {
2956       tree attr = lookup_attribute (IDENTIFIER_POINTER (attr_name),
2957                                     decl_attr_list);
2958
2959       if (attr != NULL_TREE)
2960         {
2961           /* Override existing arguments.  Declarations are unique so we can
2962              modify this in place.  */
2963           TREE_VALUE (attr) = attr_args;
2964         }
2965       else
2966         {
2967           decl_attr_list = tree_cons (attr_name, attr_args, decl_attr_list);
2968           decl = build_decl_attribute_variant (decl, decl_attr_list);
2969         }
2970
2971       valid = 1;
2972     }
2973 #endif
2974
2975 #ifdef VALID_MACHINE_TYPE_ATTRIBUTE
2976   if (VALID_MACHINE_TYPE_ATTRIBUTE (type, type_attr_list, attr_name, attr_args))
2977     {
2978       tree attr = lookup_attribute (IDENTIFIER_POINTER (attr_name),
2979                                     type_attr_list);
2980
2981       if (attr != NULL_TREE)
2982         {
2983           /* Override existing arguments.
2984              ??? This currently works since attribute arguments are not
2985              included in `attribute_hash_list'.  Something more complicated
2986              may be needed in the future.  */
2987           TREE_VALUE (attr) = attr_args;
2988         }
2989       else
2990         {
2991           type_attr_list = tree_cons (attr_name, attr_args, type_attr_list);
2992           type = build_type_attribute_variant (type, type_attr_list);
2993         }
2994       if (decl != 0)
2995         TREE_TYPE (decl) = type;
2996       valid = 1;
2997     }
2998
2999   /* Handle putting a type attribute on pointer-to-function-type by putting
3000      the attribute on the function type.  */
3001   else if (TREE_CODE (type) == POINTER_TYPE
3002            && TREE_CODE (TREE_TYPE (type)) == FUNCTION_TYPE
3003            && VALID_MACHINE_TYPE_ATTRIBUTE (TREE_TYPE (type), type_attr_list,
3004                                             attr_name, attr_args))
3005     {
3006       tree inner_type = TREE_TYPE (type);
3007       tree inner_attr_list = TYPE_ATTRIBUTES (inner_type);
3008       tree attr = lookup_attribute (IDENTIFIER_POINTER (attr_name),
3009                                     type_attr_list);
3010
3011       if (attr != NULL_TREE)
3012         TREE_VALUE (attr) = attr_args;
3013       else
3014         {
3015           inner_attr_list = tree_cons (attr_name, attr_args, inner_attr_list);
3016           inner_type = build_type_attribute_variant (inner_type,
3017                                                      inner_attr_list);
3018         }
3019
3020       if (decl != 0)
3021         TREE_TYPE (decl) = build_pointer_type (inner_type);
3022
3023       valid = 1;
3024     }
3025 #endif
3026
3027   return valid;
3028 }
3029
3030 /* Return non-zero if IDENT is a valid name for attribute ATTR,
3031    or zero if not.
3032
3033    We try both `text' and `__text__', ATTR may be either one.  */
3034 /* ??? It might be a reasonable simplification to require ATTR to be only
3035    `text'.  One might then also require attribute lists to be stored in
3036    their canonicalized form.  */
3037
3038 int
3039 is_attribute_p (attr, ident)
3040      char *attr;
3041      tree ident;
3042 {
3043   int ident_len, attr_len;
3044   char *p;
3045
3046   if (TREE_CODE (ident) != IDENTIFIER_NODE)
3047     return 0;
3048
3049   if (strcmp (attr, IDENTIFIER_POINTER (ident)) == 0)
3050     return 1;
3051
3052   p = IDENTIFIER_POINTER (ident);
3053   ident_len = strlen (p);
3054   attr_len = strlen (attr);
3055
3056   /* If ATTR is `__text__', IDENT must be `text'; and vice versa.  */
3057   if (attr[0] == '_')
3058     {
3059       if (attr[1] != '_'
3060           || attr[attr_len - 2] != '_'
3061           || attr[attr_len - 1] != '_')
3062         abort ();
3063       if (ident_len == attr_len - 4
3064           && strncmp (attr + 2, p, attr_len - 4) == 0)
3065         return 1;
3066     }
3067   else
3068     {
3069       if (ident_len == attr_len + 4
3070           && p[0] == '_' && p[1] == '_'
3071           && p[ident_len - 2] == '_' && p[ident_len - 1] == '_'
3072           && strncmp (attr, p + 2, attr_len) == 0)
3073         return 1;
3074     }
3075
3076   return 0;
3077 }
3078
3079 /* Given an attribute name and a list of attributes, return a pointer to the
3080    attribute's list element if the attribute is part of the list, or NULL_TREE
3081    if not found.  */
3082
3083 tree
3084 lookup_attribute (attr_name, list)
3085      char *attr_name;
3086      tree list;
3087 {
3088   tree l;
3089
3090   for (l = list; l; l = TREE_CHAIN (l))
3091     {
3092       if (TREE_CODE (TREE_PURPOSE (l)) != IDENTIFIER_NODE)
3093         abort ();
3094       if (is_attribute_p (attr_name, TREE_PURPOSE (l)))
3095         return l;
3096     }
3097
3098   return NULL_TREE;
3099 }
3100
3101 /* Return an attribute list that is the union of a1 and a2.  */
3102
3103 tree
3104 merge_attributes (a1, a2)
3105      register tree a1, a2;
3106 {
3107   tree attributes;
3108
3109   /* Either one unset?  Take the set one.  */
3110
3111   if (! (attributes = a1))
3112     attributes = a2;
3113
3114   /* One that completely contains the other?  Take it.  */
3115
3116   else if (a2 && ! attribute_list_contained (a1, a2))
3117     if (attribute_list_contained (a2, a1))
3118       attributes = a2;
3119     else
3120       {
3121         /* Pick the longest list, and hang on the other list.  */
3122         /* ??? For the moment we punt on the issue of attrs with args.  */
3123
3124         if (list_length (a1) < list_length (a2))
3125           attributes = a2, a2 = a1;
3126
3127         for (; a2; a2 = TREE_CHAIN (a2))
3128           if (lookup_attribute (IDENTIFIER_POINTER (TREE_PURPOSE (a2)),
3129                                 attributes) == NULL_TREE)
3130             {
3131               a1 = copy_node (a2);
3132               TREE_CHAIN (a1) = attributes;
3133               attributes = a1;
3134             }
3135       }
3136   return attributes;
3137 }
3138 \f
3139 /* Return a type like TYPE except that its TYPE_READONLY is CONSTP
3140    and its TYPE_VOLATILE is VOLATILEP.
3141
3142    Such variant types already made are recorded so that duplicates
3143    are not made.
3144
3145    A variant types should never be used as the type of an expression.
3146    Always copy the variant information into the TREE_READONLY
3147    and TREE_THIS_VOLATILE of the expression, and then give the expression
3148    as its type the "main variant", the variant whose TYPE_READONLY
3149    and TYPE_VOLATILE are zero.  Use TYPE_MAIN_VARIANT to find the
3150    main variant.  */
3151
3152 tree
3153 build_type_variant (type, constp, volatilep)
3154      tree type;
3155      int constp, volatilep;
3156 {
3157   register tree t;
3158
3159   /* Treat any nonzero argument as 1.  */
3160   constp = !!constp;
3161   volatilep = !!volatilep;
3162
3163   /* Search the chain of variants to see if there is already one there just
3164      like the one we need to have.  If so, use that existing one.  We must
3165      preserve the TYPE_NAME, since there is code that depends on this.  */
3166
3167   for (t = TYPE_MAIN_VARIANT(type); t; t = TYPE_NEXT_VARIANT (t))
3168     if (constp == TYPE_READONLY (t) && volatilep == TYPE_VOLATILE (t)
3169         && TYPE_NAME (t) == TYPE_NAME (type))
3170       return t;
3171
3172   /* We need a new one.  */
3173
3174   t = build_type_copy (type);
3175   TYPE_READONLY (t) = constp;
3176   TYPE_VOLATILE (t) = volatilep;
3177
3178   return t;
3179 }
3180
3181 /* Give TYPE a new main variant: NEW_MAIN.
3182    This is the right thing to do only when something else
3183    about TYPE is modified in place.  */
3184
3185 void
3186 change_main_variant (type, new_main)
3187      tree type, new_main;
3188 {
3189   tree t;
3190   tree omain = TYPE_MAIN_VARIANT (type);
3191
3192   /* Remove TYPE from the TYPE_NEXT_VARIANT chain of its main variant.  */
3193   if (TYPE_NEXT_VARIANT (omain) == type)
3194     TYPE_NEXT_VARIANT (omain) = TYPE_NEXT_VARIANT (type);
3195   else
3196     for (t = TYPE_NEXT_VARIANT (omain); t && TYPE_NEXT_VARIANT (t);
3197          t = TYPE_NEXT_VARIANT (t))
3198       if (TYPE_NEXT_VARIANT (t) == type)
3199         {
3200           TYPE_NEXT_VARIANT (t) = TYPE_NEXT_VARIANT (type);
3201           break;
3202         }
3203
3204   TYPE_MAIN_VARIANT (type) = new_main;
3205   TYPE_NEXT_VARIANT (type) = TYPE_NEXT_VARIANT (new_main);
3206   TYPE_NEXT_VARIANT (new_main) = type;
3207 }
3208
3209 /* Create a new variant of TYPE, equivalent but distinct.
3210    This is so the caller can modify it.  */
3211
3212 tree
3213 build_type_copy (type)
3214      tree type;
3215 {
3216   register tree t, m = TYPE_MAIN_VARIANT (type);
3217   register struct obstack *ambient_obstack = current_obstack;
3218
3219   current_obstack = TYPE_OBSTACK (type);
3220   t = copy_node (type);
3221   current_obstack = ambient_obstack;
3222
3223   TYPE_POINTER_TO (t) = 0;
3224   TYPE_REFERENCE_TO (t) = 0;
3225
3226   /* Add this type to the chain of variants of TYPE.  */
3227   TYPE_NEXT_VARIANT (t) = TYPE_NEXT_VARIANT (m);
3228   TYPE_NEXT_VARIANT (m) = t;
3229
3230   return t;
3231 }
3232 \f
3233 /* Hashing of types so that we don't make duplicates.
3234    The entry point is `type_hash_canon'.  */
3235
3236 /* Each hash table slot is a bucket containing a chain
3237    of these structures.  */
3238
3239 struct type_hash
3240 {
3241   struct type_hash *next;       /* Next structure in the bucket.  */
3242   int hashcode;                 /* Hash code of this type.  */
3243   tree type;                    /* The type recorded here.  */
3244 };
3245
3246 /* Now here is the hash table.  When recording a type, it is added
3247    to the slot whose index is the hash code mod the table size.
3248    Note that the hash table is used for several kinds of types
3249    (function types, array types and array index range types, for now).
3250    While all these live in the same table, they are completely independent,
3251    and the hash code is computed differently for each of these.  */
3252
3253 #define TYPE_HASH_SIZE 59
3254 struct type_hash *type_hash_table[TYPE_HASH_SIZE];
3255
3256 /* Compute a hash code for a list of types (chain of TREE_LIST nodes
3257    with types in the TREE_VALUE slots), by adding the hash codes
3258    of the individual types.  */
3259
3260 int
3261 type_hash_list (list)
3262      tree list;
3263 {
3264   register int hashcode;
3265   register tree tail;
3266   for (hashcode = 0, tail = list; tail; tail = TREE_CHAIN (tail))
3267     hashcode += TYPE_HASH (TREE_VALUE (tail));
3268   return hashcode;
3269 }
3270
3271 /* Look in the type hash table for a type isomorphic to TYPE.
3272    If one is found, return it.  Otherwise return 0.  */
3273
3274 tree
3275 type_hash_lookup (hashcode, type)
3276      int hashcode;
3277      tree type;
3278 {
3279   register struct type_hash *h;
3280   for (h = type_hash_table[hashcode % TYPE_HASH_SIZE]; h; h = h->next)
3281     if (h->hashcode == hashcode
3282         && TREE_CODE (h->type) == TREE_CODE (type)
3283         && TREE_TYPE (h->type) == TREE_TYPE (type)
3284         && attribute_list_equal (TYPE_ATTRIBUTES (h->type),
3285                                    TYPE_ATTRIBUTES (type))
3286         && (TYPE_MAX_VALUE (h->type) == TYPE_MAX_VALUE (type)
3287             || tree_int_cst_equal (TYPE_MAX_VALUE (h->type),
3288                                    TYPE_MAX_VALUE (type)))
3289         && (TYPE_MIN_VALUE (h->type) == TYPE_MIN_VALUE (type)
3290             || tree_int_cst_equal (TYPE_MIN_VALUE (h->type),
3291                                    TYPE_MIN_VALUE (type)))
3292         /* Note that TYPE_DOMAIN is TYPE_ARG_TYPES for FUNCTION_TYPE.  */
3293         && (TYPE_DOMAIN (h->type) == TYPE_DOMAIN (type)
3294             || (TYPE_DOMAIN (h->type)
3295                 && TREE_CODE (TYPE_DOMAIN (h->type)) == TREE_LIST
3296                 && TYPE_DOMAIN (type)
3297                 && TREE_CODE (TYPE_DOMAIN (type)) == TREE_LIST
3298                 && type_list_equal (TYPE_DOMAIN (h->type),
3299                                     TYPE_DOMAIN (type)))))
3300       return h->type;
3301   return 0;
3302 }
3303
3304 /* Add an entry to the type-hash-table
3305    for a type TYPE whose hash code is HASHCODE.  */
3306
3307 void
3308 type_hash_add (hashcode, type)
3309      int hashcode;
3310      tree type;
3311 {
3312   register struct type_hash *h;
3313
3314   h = (struct type_hash *) oballoc (sizeof (struct type_hash));
3315   h->hashcode = hashcode;
3316   h->type = type;
3317   h->next = type_hash_table[hashcode % TYPE_HASH_SIZE];
3318   type_hash_table[hashcode % TYPE_HASH_SIZE] = h;
3319 }
3320
3321 /* Given TYPE, and HASHCODE its hash code, return the canonical
3322    object for an identical type if one already exists.
3323    Otherwise, return TYPE, and record it as the canonical object
3324    if it is a permanent object.
3325
3326    To use this function, first create a type of the sort you want.
3327    Then compute its hash code from the fields of the type that
3328    make it different from other similar types.
3329    Then call this function and use the value.
3330    This function frees the type you pass in if it is a duplicate.  */
3331
3332 /* Set to 1 to debug without canonicalization.  Never set by program.  */
3333 int debug_no_type_hash = 0;
3334
3335 tree
3336 type_hash_canon (hashcode, type)
3337      int hashcode;
3338      tree type;
3339 {
3340   tree t1;
3341
3342   if (debug_no_type_hash)
3343     return type;
3344
3345   t1 = type_hash_lookup (hashcode, type);
3346   if (t1 != 0)
3347     {
3348       obstack_free (TYPE_OBSTACK (type), type);
3349 #ifdef GATHER_STATISTICS
3350       tree_node_counts[(int)t_kind]--;
3351       tree_node_sizes[(int)t_kind] -= sizeof (struct tree_type);
3352 #endif
3353       return t1;
3354     }
3355
3356   /* If this is a permanent type, record it for later reuse.  */
3357   if (TREE_PERMANENT (type))
3358     type_hash_add (hashcode, type);
3359
3360   return type;
3361 }
3362
3363 /* Compute a hash code for a list of attributes (chain of TREE_LIST nodes
3364    with names in the TREE_PURPOSE slots and args in the TREE_VALUE slots),
3365    by adding the hash codes of the individual attributes.  */
3366
3367 int
3368 attribute_hash_list (list)
3369      tree list;
3370 {
3371   register int hashcode;
3372   register tree tail;
3373   for (hashcode = 0, tail = list; tail; tail = TREE_CHAIN (tail))
3374     /* ??? Do we want to add in TREE_VALUE too? */
3375     hashcode += TYPE_HASH (TREE_PURPOSE (tail));
3376   return hashcode;
3377 }
3378
3379 /* Given two lists of attributes, return true if list l2 is
3380    equivalent to l1.  */
3381
3382 int
3383 attribute_list_equal (l1, l2)
3384      tree l1, l2;
3385 {
3386    return attribute_list_contained (l1, l2)
3387           && attribute_list_contained (l2, l1);
3388 }
3389
3390 /* Given two lists of attributes, return true if list L2 is
3391    completely contained within L1.  */
3392 /* ??? This would be faster if attribute names were stored in a canonicalized
3393    form.  Otherwise, if L1 uses `foo' and L2 uses `__foo__', the long method
3394    must be used to show these elements are equivalent (which they are).  */
3395 /* ??? It's not clear that attributes with arguments will always be handled
3396    correctly.  */
3397
3398 int
3399 attribute_list_contained (l1, l2)
3400      tree l1, l2;
3401 {
3402   register tree t1, t2;
3403
3404   /* First check the obvious, maybe the lists are identical.  */
3405   if (l1 == l2)
3406      return 1;
3407
3408   /* Maybe the lists are similar.  */
3409   for (t1 = l1, t2 = l2;
3410        t1 && t2
3411         && TREE_PURPOSE (t1) == TREE_PURPOSE (t2)
3412         && TREE_VALUE (t1) == TREE_VALUE (t2);
3413        t1 = TREE_CHAIN (t1), t2 = TREE_CHAIN (t2));
3414
3415   /* Maybe the lists are equal.  */
3416   if (t1 == 0 && t2 == 0)
3417      return 1;
3418
3419   for (; t2; t2 = TREE_CHAIN (t2))
3420     {
3421       tree attr
3422         = lookup_attribute (IDENTIFIER_POINTER (TREE_PURPOSE (t2)), l1);
3423
3424       if (attr == NULL_TREE)
3425         return 0;
3426       if (simple_cst_equal (TREE_VALUE (t2), TREE_VALUE (attr)) != 1)
3427         return 0;
3428     }
3429
3430   return 1;
3431 }
3432
3433 /* Given two lists of types
3434    (chains of TREE_LIST nodes with types in the TREE_VALUE slots)
3435    return 1 if the lists contain the same types in the same order.
3436    Also, the TREE_PURPOSEs must match.  */
3437
3438 int
3439 type_list_equal (l1, l2)
3440      tree l1, l2;
3441 {
3442   register tree t1, t2;
3443
3444   for (t1 = l1, t2 = l2; t1 && t2; t1 = TREE_CHAIN (t1), t2 = TREE_CHAIN (t2))
3445     if (TREE_VALUE (t1) != TREE_VALUE (t2)
3446         || (TREE_PURPOSE (t1) != TREE_PURPOSE (t2)
3447             && ! (1 == simple_cst_equal (TREE_PURPOSE (t1), TREE_PURPOSE (t2))
3448                   && (TREE_TYPE (TREE_PURPOSE (t1))
3449                       == TREE_TYPE (TREE_PURPOSE (t2))))))
3450       return 0;
3451
3452   return t1 == t2;
3453 }
3454
3455 /* Nonzero if integer constants T1 and T2
3456    represent the same constant value.  */
3457
3458 int
3459 tree_int_cst_equal (t1, t2)
3460      tree t1, t2;
3461 {
3462   if (t1 == t2)
3463     return 1;
3464   if (t1 == 0 || t2 == 0)
3465     return 0;
3466   if (TREE_CODE (t1) == INTEGER_CST
3467       && TREE_CODE (t2) == INTEGER_CST
3468       && TREE_INT_CST_LOW (t1) == TREE_INT_CST_LOW (t2)
3469       && TREE_INT_CST_HIGH (t1) == TREE_INT_CST_HIGH (t2))
3470     return 1;
3471   return 0;
3472 }
3473
3474 /* Nonzero if integer constants T1 and T2 represent values that satisfy <.
3475    The precise way of comparison depends on their data type.  */
3476
3477 int
3478 tree_int_cst_lt (t1, t2)
3479      tree t1, t2;
3480 {
3481   if (t1 == t2)
3482     return 0;
3483
3484   if (!TREE_UNSIGNED (TREE_TYPE (t1)))
3485     return INT_CST_LT (t1, t2);
3486   return INT_CST_LT_UNSIGNED (t1, t2);
3487 }
3488
3489 /* Return an indication of the sign of the integer constant T.
3490    The return value is -1 if T < 0, 0 if T == 0, and 1 if T > 0.
3491    Note that -1 will never be returned it T's type is unsigned.  */
3492
3493 int
3494 tree_int_cst_sgn (t)
3495      tree t;
3496 {
3497   if (TREE_INT_CST_LOW (t) == 0 && TREE_INT_CST_HIGH (t) == 0)
3498     return 0;
3499   else if (TREE_UNSIGNED (TREE_TYPE (t)))
3500     return 1;
3501   else if (TREE_INT_CST_HIGH (t) < 0)
3502     return -1;
3503   else
3504     return 1;
3505 }
3506
3507 /* Compare two constructor-element-type constants.  Return 1 if the lists
3508    are known to be equal; otherwise return 0.  */
3509
3510 int
3511 simple_cst_list_equal (l1, l2)
3512      tree l1, l2;
3513 {
3514   while (l1 != NULL_TREE && l2 != NULL_TREE)
3515     {
3516       if (simple_cst_equal (TREE_VALUE (l1), TREE_VALUE (l2)) != 1)
3517         return 0;
3518
3519       l1 = TREE_CHAIN (l1);
3520       l2 = TREE_CHAIN (l2);
3521     }
3522
3523   return (l1 == l2);
3524 }
3525
3526 /* Return truthvalue of whether T1 is the same tree structure as T2.
3527    Return 1 if they are the same.
3528    Return 0 if they are understandably different.
3529    Return -1 if either contains tree structure not understood by
3530    this function.  */
3531
3532 int
3533 simple_cst_equal (t1, t2)
3534      tree t1, t2;
3535 {
3536   register enum tree_code code1, code2;
3537   int cmp;
3538
3539   if (t1 == t2)
3540     return 1;
3541   if (t1 == 0 || t2 == 0)
3542     return 0;
3543
3544   code1 = TREE_CODE (t1);
3545   code2 = TREE_CODE (t2);
3546
3547   if (code1 == NOP_EXPR || code1 == CONVERT_EXPR || code1 == NON_LVALUE_EXPR)
3548     if (code2 == NOP_EXPR || code2 == CONVERT_EXPR || code2 == NON_LVALUE_EXPR)
3549       return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3550     else
3551       return simple_cst_equal (TREE_OPERAND (t1, 0), t2);
3552   else if (code2 == NOP_EXPR || code2 == CONVERT_EXPR
3553            || code2 == NON_LVALUE_EXPR)
3554     return simple_cst_equal (t1, TREE_OPERAND (t2, 0));
3555
3556   if (code1 != code2)
3557     return 0;
3558
3559   switch (code1)
3560     {
3561     case INTEGER_CST:
3562       return TREE_INT_CST_LOW (t1) == TREE_INT_CST_LOW (t2)
3563         && TREE_INT_CST_HIGH (t1) == TREE_INT_CST_HIGH (t2);
3564
3565     case REAL_CST:
3566       return REAL_VALUES_EQUAL (TREE_REAL_CST (t1), TREE_REAL_CST (t2));
3567
3568     case STRING_CST:
3569       return TREE_STRING_LENGTH (t1) == TREE_STRING_LENGTH (t2)
3570         && !bcmp (TREE_STRING_POINTER (t1), TREE_STRING_POINTER (t2),
3571                   TREE_STRING_LENGTH (t1));
3572
3573     case CONSTRUCTOR:
3574       abort ();
3575
3576     case SAVE_EXPR:
3577       return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3578
3579     case CALL_EXPR:
3580       cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3581       if (cmp <= 0)
3582         return cmp;
3583       return simple_cst_list_equal (TREE_OPERAND (t1, 1), TREE_OPERAND (t2, 1));
3584
3585     case TARGET_EXPR:
3586       /* Special case: if either target is an unallocated VAR_DECL,
3587          it means that it's going to be unified with whatever the
3588          TARGET_EXPR is really supposed to initialize, so treat it
3589          as being equivalent to anything.  */
3590       if ((TREE_CODE (TREE_OPERAND (t1, 0)) == VAR_DECL
3591            && DECL_NAME (TREE_OPERAND (t1, 0)) == NULL_TREE
3592            && DECL_RTL (TREE_OPERAND (t1, 0)) == 0)
3593           || (TREE_CODE (TREE_OPERAND (t2, 0)) == VAR_DECL
3594               && DECL_NAME (TREE_OPERAND (t2, 0)) == NULL_TREE
3595               && DECL_RTL (TREE_OPERAND (t2, 0)) == 0))
3596         cmp = 1;
3597       else
3598         cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3599       if (cmp <= 0)
3600         return cmp;
3601       return simple_cst_equal (TREE_OPERAND (t1, 1), TREE_OPERAND (t2, 1));
3602
3603     case WITH_CLEANUP_EXPR:
3604       cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3605       if (cmp <= 0)
3606         return cmp;
3607       return simple_cst_equal (TREE_OPERAND (t1, 2), TREE_OPERAND (t1, 2));
3608
3609     case COMPONENT_REF:
3610       if (TREE_OPERAND (t1, 1) == TREE_OPERAND (t2, 1))
3611         return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
3612       return 0;
3613
3614     case VAR_DECL:
3615     case PARM_DECL:
3616     case CONST_DECL:
3617     case FUNCTION_DECL:
3618       return 0;
3619     }
3620
3621   /* This general rule works for most tree codes.  All exceptions should be
3622      handled above.  If this is a language-specific tree code, we can't
3623      trust what might be in the operand, so say we don't know
3624      the situation.  */
3625   if ((int) code1
3626       >= sizeof standard_tree_code_type / sizeof standard_tree_code_type[0])
3627     return -1;
3628
3629   switch (TREE_CODE_CLASS (code1))
3630     {
3631       int i;
3632     case '1':
3633     case '2':
3634     case '<':
3635     case 'e':
3636     case 'r':
3637     case 's':
3638       cmp = 1;
3639       for (i=0; i<tree_code_length[(int) code1]; ++i)
3640         {
3641           cmp = simple_cst_equal (TREE_OPERAND (t1, i), TREE_OPERAND (t2, i));
3642           if (cmp <= 0)
3643             return cmp;
3644         }
3645       return cmp;
3646     }
3647
3648   return -1;
3649 }
3650 \f
3651 /* Constructors for pointer, array and function types.
3652    (RECORD_TYPE, UNION_TYPE and ENUMERAL_TYPE nodes are
3653    constructed by language-dependent code, not here.)  */
3654
3655 /* Construct, lay out and return the type of pointers to TO_TYPE.
3656    If such a type has already been constructed, reuse it.  */
3657
3658 tree
3659 build_pointer_type (to_type)
3660      tree to_type;
3661 {
3662   register tree t = TYPE_POINTER_TO (to_type);
3663
3664   /* First, if we already have a type for pointers to TO_TYPE, use it.  */
3665
3666   if (t)
3667     return t;
3668
3669   /* We need a new one.  Put this in the same obstack as TO_TYPE.   */
3670   push_obstacks (TYPE_OBSTACK (to_type), TYPE_OBSTACK (to_type));
3671   t = make_node (POINTER_TYPE);
3672   pop_obstacks ();
3673
3674   TREE_TYPE (t) = to_type;
3675
3676   /* Record this type as the pointer to TO_TYPE.  */
3677   TYPE_POINTER_TO (to_type) = t;
3678
3679   /* Lay out the type.  This function has many callers that are concerned
3680      with expression-construction, and this simplifies them all.
3681      Also, it guarantees the TYPE_SIZE is in the same obstack as the type.  */
3682   layout_type (t);
3683
3684   return t;
3685 }
3686
3687 /* Create a type of integers to be the TYPE_DOMAIN of an ARRAY_TYPE.
3688    MAXVAL should be the maximum value in the domain
3689    (one less than the length of the array).  */
3690
3691 tree
3692 build_index_type (maxval)
3693      tree maxval;
3694 {
3695   register tree itype = make_node (INTEGER_TYPE);
3696   TYPE_PRECISION (itype) = TYPE_PRECISION (sizetype);
3697   TYPE_MIN_VALUE (itype) = build_int_2 (0, 0);
3698   TREE_TYPE (TYPE_MIN_VALUE (itype)) = sizetype;
3699   TYPE_MAX_VALUE (itype) = convert (sizetype, maxval);
3700   TYPE_MODE (itype) = TYPE_MODE (sizetype);
3701   TYPE_SIZE (itype) = TYPE_SIZE (sizetype);
3702   TYPE_ALIGN (itype) = TYPE_ALIGN (sizetype);
3703   if (TREE_CODE (maxval) == INTEGER_CST)
3704     {
3705       int maxint = (int) TREE_INT_CST_LOW (maxval);
3706       /* If the domain should be empty, make sure the maxval
3707          remains -1 and is not spoiled by truncation.  */
3708       if (INT_CST_LT (maxval, integer_zero_node))
3709         {
3710           TYPE_MAX_VALUE (itype) = build_int_2 (-1, -1);
3711           TREE_TYPE (TYPE_MAX_VALUE (itype)) = sizetype;
3712         }
3713       return type_hash_canon (maxint < 0 ? ~maxint : maxint, itype);
3714     }
3715   else
3716     return itype;
3717 }
3718
3719 /* Create a range of some discrete type TYPE (an INTEGER_TYPE,
3720    ENUMERAL_TYPE, BOOLEAN_TYPE, or CHAR_TYPE), with
3721    low bound LOWVAL and high bound HIGHVAL.
3722    if TYPE==NULL_TREE, sizetype is used.  */
3723
3724 tree
3725 build_range_type (type, lowval, highval)
3726      tree type, lowval, highval;
3727 {
3728   register tree itype = make_node (INTEGER_TYPE);
3729   TREE_TYPE (itype) = type;
3730   if (type == NULL_TREE)
3731     type = sizetype;
3732   TYPE_PRECISION (itype) = TYPE_PRECISION (type);
3733   TYPE_MIN_VALUE (itype) = convert (type, lowval);
3734   TYPE_MAX_VALUE (itype) = convert (type, highval);
3735   TYPE_MODE (itype) = TYPE_MODE (type);
3736   TYPE_SIZE (itype) = TYPE_SIZE (type);
3737   TYPE_ALIGN (itype) = TYPE_ALIGN (type);
3738   if ((TREE_CODE (lowval) == INTEGER_CST)
3739       && (TREE_CODE (highval) == INTEGER_CST))
3740     {
3741       HOST_WIDE_INT highint = TREE_INT_CST_LOW (highval);
3742       HOST_WIDE_INT lowint = TREE_INT_CST_LOW (lowval);
3743       int maxint = (int) (highint - lowint);
3744       return type_hash_canon (maxint < 0 ? ~maxint : maxint, itype);
3745     }
3746   else
3747     return itype;
3748 }
3749
3750 /* Just like build_index_type, but takes lowval and highval instead
3751    of just highval (maxval).  */
3752
3753 tree
3754 build_index_2_type (lowval,highval)
3755      tree lowval, highval;
3756 {
3757   return build_range_type (NULL_TREE, lowval, highval);
3758 }
3759
3760 /* Return nonzero iff ITYPE1 and ITYPE2 are equal (in the LISP sense).
3761    Needed because when index types are not hashed, equal index types
3762    built at different times appear distinct, even though structurally,
3763    they are not.  */
3764
3765 int
3766 index_type_equal (itype1, itype2)
3767      tree itype1, itype2;
3768 {
3769   if (TREE_CODE (itype1) != TREE_CODE (itype2))
3770     return 0;
3771   if (TREE_CODE (itype1) == INTEGER_TYPE)
3772     {
3773       if (TYPE_PRECISION (itype1) != TYPE_PRECISION (itype2)
3774           || TYPE_MODE (itype1) != TYPE_MODE (itype2)
3775           || simple_cst_equal (TYPE_SIZE (itype1), TYPE_SIZE (itype2)) != 1
3776           || TYPE_ALIGN (itype1) != TYPE_ALIGN (itype2))
3777         return 0;
3778       if (1 == simple_cst_equal (TYPE_MIN_VALUE (itype1),
3779                                  TYPE_MIN_VALUE (itype2))
3780           && 1 == simple_cst_equal (TYPE_MAX_VALUE (itype1),
3781                                     TYPE_MAX_VALUE (itype2)))
3782         return 1;
3783     }
3784
3785   return 0;
3786 }
3787
3788 /* Construct, lay out and return the type of arrays of elements with ELT_TYPE
3789    and number of elements specified by the range of values of INDEX_TYPE.
3790    If such a type has already been constructed, reuse it.  */
3791
3792 tree
3793 build_array_type (elt_type, index_type)
3794      tree elt_type, index_type;
3795 {
3796   register tree t;
3797   int hashcode;
3798
3799   if (TREE_CODE (elt_type) == FUNCTION_TYPE)
3800     {
3801       error ("arrays of functions are not meaningful");
3802       elt_type = integer_type_node;
3803     }
3804
3805   /* Make sure TYPE_POINTER_TO (elt_type) is filled in.  */
3806   build_pointer_type (elt_type);
3807
3808   /* Allocate the array after the pointer type,
3809      in case we free it in type_hash_canon.  */
3810   t = make_node (ARRAY_TYPE);
3811   TREE_TYPE (t) = elt_type;
3812   TYPE_DOMAIN (t) = index_type;
3813
3814   if (index_type == 0)
3815     {
3816       return t;
3817     }
3818
3819   hashcode = TYPE_HASH (elt_type) + TYPE_HASH (index_type);
3820   t = type_hash_canon (hashcode, t);
3821
3822 #if 0 /* This led to crashes, because it could put a temporary node
3823          on the TYPE_NEXT_VARIANT chain of a permanent one.  */
3824   /* The main variant of an array type should always
3825      be an array whose element type is the main variant.  */
3826   if (elt_type != TYPE_MAIN_VARIANT (elt_type))
3827     change_main_variant (t, build_array_type (TYPE_MAIN_VARIANT (elt_type),
3828                                               index_type));
3829 #endif
3830
3831   if (TYPE_SIZE (t) == 0)
3832     layout_type (t);
3833   return t;
3834 }
3835
3836 /* Construct, lay out and return
3837    the type of functions returning type VALUE_TYPE
3838    given arguments of types ARG_TYPES.
3839    ARG_TYPES is a chain of TREE_LIST nodes whose TREE_VALUEs
3840    are data type nodes for the arguments of the function.
3841    If such a type has already been constructed, reuse it.  */
3842
3843 tree
3844 build_function_type (value_type, arg_types)
3845      tree value_type, arg_types;
3846 {
3847   register tree t;
3848   int hashcode;
3849
3850   if (TREE_CODE (value_type) == FUNCTION_TYPE)
3851     {
3852       error ("function return type cannot be function");
3853       value_type = integer_type_node;
3854     }
3855
3856   /* Make a node of the sort we want.  */
3857   t = make_node (FUNCTION_TYPE);
3858   TREE_TYPE (t) = value_type;
3859   TYPE_ARG_TYPES (t) = arg_types;
3860
3861   /* If we already have such a type, use the old one and free this one.  */
3862   hashcode = TYPE_HASH (value_type) + type_hash_list (arg_types);
3863   t = type_hash_canon (hashcode, t);
3864
3865   if (TYPE_SIZE (t) == 0)
3866     layout_type (t);
3867   return t;
3868 }
3869
3870 /* Build the node for the type of references-to-TO_TYPE.  */
3871
3872 tree
3873 build_reference_type (to_type)
3874      tree to_type;
3875 {
3876   register tree t = TYPE_REFERENCE_TO (to_type);
3877   register struct obstack *ambient_obstack = current_obstack;
3878   register struct obstack *ambient_saveable_obstack = saveable_obstack;
3879
3880   /* First, if we already have a type for pointers to TO_TYPE, use it.  */
3881
3882   if (t)
3883     return t;
3884
3885   /* We need a new one.  If TO_TYPE is permanent, make this permanent too.  */
3886   if (TREE_PERMANENT (to_type))
3887     {
3888       current_obstack = &permanent_obstack;
3889       saveable_obstack = &permanent_obstack;
3890     }
3891
3892   t = make_node (REFERENCE_TYPE);
3893   TREE_TYPE (t) = to_type;
3894
3895   /* Record this type as the pointer to TO_TYPE.  */
3896   TYPE_REFERENCE_TO (to_type) = t;
3897
3898   layout_type (t);
3899
3900   current_obstack = ambient_obstack;
3901   saveable_obstack = ambient_saveable_obstack;
3902   return t;
3903 }
3904
3905 /* Construct, lay out and return the type of methods belonging to class
3906    BASETYPE and whose arguments and values are described by TYPE.
3907    If that type exists already, reuse it.
3908    TYPE must be a FUNCTION_TYPE node.  */
3909
3910 tree
3911 build_method_type (basetype, type)
3912      tree basetype, type;
3913 {
3914   register tree t;
3915   int hashcode;
3916
3917   /* Make a node of the sort we want.  */
3918   t = make_node (METHOD_TYPE);
3919
3920   if (TREE_CODE (type) != FUNCTION_TYPE)
3921     abort ();
3922
3923   TYPE_METHOD_BASETYPE (t) = TYPE_MAIN_VARIANT (basetype);
3924   TREE_TYPE (t) = TREE_TYPE (type);
3925
3926   /* The actual arglist for this function includes a "hidden" argument
3927      which is "this".  Put it into the list of argument types.  */
3928
3929   TYPE_ARG_TYPES (t)
3930     = tree_cons (NULL_TREE,
3931                  build_pointer_type (basetype), TYPE_ARG_TYPES (type));
3932
3933   /* If we already have such a type, use the old one and free this one.  */
3934   hashcode = TYPE_HASH (basetype) + TYPE_HASH (type);
3935   t = type_hash_canon (hashcode, t);
3936
3937   if (TYPE_SIZE (t) == 0)
3938     layout_type (t);
3939
3940   return t;
3941 }
3942
3943 /* Construct, lay out and return the type of offsets to a value
3944    of type TYPE, within an object of type BASETYPE.
3945    If a suitable offset type exists already, reuse it.  */
3946
3947 tree
3948 build_offset_type (basetype, type)
3949      tree basetype, type;
3950 {
3951   register tree t;
3952   int hashcode;
3953
3954   /* Make a node of the sort we want.  */
3955   t = make_node (OFFSET_TYPE);
3956
3957   TYPE_OFFSET_BASETYPE (t) = TYPE_MAIN_VARIANT (basetype);
3958   TREE_TYPE (t) = type;
3959
3960   /* If we already have such a type, use the old one and free this one.  */
3961   hashcode = TYPE_HASH (basetype) + TYPE_HASH (type);
3962   t = type_hash_canon (hashcode, t);
3963
3964   if (TYPE_SIZE (t) == 0)
3965     layout_type (t);
3966
3967   return t;
3968 }
3969
3970 /* Create a complex type whose components are COMPONENT_TYPE.  */
3971
3972 tree
3973 build_complex_type (component_type)
3974      tree component_type;
3975 {
3976   register tree t;
3977   int hashcode;
3978
3979   /* Make a node of the sort we want.  */
3980   t = make_node (COMPLEX_TYPE);
3981
3982   TREE_TYPE (t) = TYPE_MAIN_VARIANT (component_type);
3983   TYPE_VOLATILE (t) = TYPE_VOLATILE (component_type);
3984   TYPE_READONLY (t) = TYPE_READONLY (component_type);
3985
3986   /* If we already have such a type, use the old one and free this one.  */
3987   hashcode = TYPE_HASH (component_type);
3988   t = type_hash_canon (hashcode, t);
3989
3990   if (TYPE_SIZE (t) == 0)
3991     layout_type (t);
3992
3993   return t;
3994 }
3995 \f
3996 /* Return OP, stripped of any conversions to wider types as much as is safe.
3997    Converting the value back to OP's type makes a value equivalent to OP.
3998
3999    If FOR_TYPE is nonzero, we return a value which, if converted to
4000    type FOR_TYPE, would be equivalent to converting OP to type FOR_TYPE.
4001
4002    If FOR_TYPE is nonzero, unaligned bit-field references may be changed to the
4003    narrowest type that can hold the value, even if they don't exactly fit.
4004    Otherwise, bit-field references are changed to a narrower type
4005    only if they can be fetched directly from memory in that type.
4006
4007    OP must have integer, real or enumeral type.  Pointers are not allowed!
4008
4009    There are some cases where the obvious value we could return
4010    would regenerate to OP if converted to OP's type, 
4011    but would not extend like OP to wider types.
4012    If FOR_TYPE indicates such extension is contemplated, we eschew such values.
4013    For example, if OP is (unsigned short)(signed char)-1,
4014    we avoid returning (signed char)-1 if FOR_TYPE is int,
4015    even though extending that to an unsigned short would regenerate OP,
4016    since the result of extending (signed char)-1 to (int)
4017    is different from (int) OP.  */
4018
4019 tree
4020 get_unwidened (op, for_type)
4021      register tree op;
4022      tree for_type;
4023 {
4024   /* Set UNS initially if converting OP to FOR_TYPE is a zero-extension.  */
4025   /* TYPE_PRECISION is safe in place of type_precision since
4026      pointer types are not allowed.  */
4027   register tree type = TREE_TYPE (op);
4028   register unsigned final_prec
4029     = TYPE_PRECISION (for_type != 0 ? for_type : type);
4030   register int uns
4031     = (for_type != 0 && for_type != type
4032        && final_prec > TYPE_PRECISION (type)
4033        && TREE_UNSIGNED (type));
4034   register tree win = op;
4035
4036   while (TREE_CODE (op) == NOP_EXPR)
4037     {
4038       register int bitschange
4039         = TYPE_PRECISION (TREE_TYPE (op))
4040           - TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (op, 0)));
4041
4042       /* Truncations are many-one so cannot be removed.
4043          Unless we are later going to truncate down even farther.  */
4044       if (bitschange < 0
4045           && final_prec > TYPE_PRECISION (TREE_TYPE (op)))
4046         break;
4047
4048       /* See what's inside this conversion.  If we decide to strip it,
4049          we will set WIN.  */
4050       op = TREE_OPERAND (op, 0);
4051
4052       /* If we have not stripped any zero-extensions (uns is 0),
4053          we can strip any kind of extension.
4054          If we have previously stripped a zero-extension,
4055          only zero-extensions can safely be stripped.
4056          Any extension can be stripped if the bits it would produce
4057          are all going to be discarded later by truncating to FOR_TYPE.  */
4058
4059       if (bitschange > 0)
4060         {
4061           if (! uns || final_prec <= TYPE_PRECISION (TREE_TYPE (op)))
4062             win = op;
4063           /* TREE_UNSIGNED says whether this is a zero-extension.
4064              Let's avoid computing it if it does not affect WIN
4065              and if UNS will not be needed again.  */
4066           if ((uns || TREE_CODE (op) == NOP_EXPR)
4067               && TREE_UNSIGNED (TREE_TYPE (op)))
4068             {
4069               uns = 1;
4070               win = op;
4071             }
4072         }
4073     }
4074
4075   if (TREE_CODE (op) == COMPONENT_REF
4076       /* Since type_for_size always gives an integer type.  */
4077       && TREE_CODE (type) != REAL_TYPE)
4078     {
4079       unsigned innerprec = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1)));
4080       type = type_for_size (innerprec, TREE_UNSIGNED (TREE_OPERAND (op, 1)));
4081
4082       /* We can get this structure field in the narrowest type it fits in.
4083          If FOR_TYPE is 0, do this only for a field that matches the
4084          narrower type exactly and is aligned for it
4085          The resulting extension to its nominal type (a fullword type)
4086          must fit the same conditions as for other extensions.  */
4087
4088       if (innerprec < TYPE_PRECISION (TREE_TYPE (op))
4089           && (for_type || ! DECL_BIT_FIELD (TREE_OPERAND (op, 1)))
4090           && (! uns || final_prec <= innerprec
4091               || TREE_UNSIGNED (TREE_OPERAND (op, 1)))
4092           && type != 0)
4093         {
4094           win = build (COMPONENT_REF, type, TREE_OPERAND (op, 0),
4095                        TREE_OPERAND (op, 1));
4096           TREE_SIDE_EFFECTS (win) = TREE_SIDE_EFFECTS (op);
4097           TREE_THIS_VOLATILE (win) = TREE_THIS_VOLATILE (op);
4098           TREE_RAISES (win) = TREE_RAISES (op);
4099         }
4100     }
4101   return win;
4102 }
4103 \f
4104 /* Return OP or a simpler expression for a narrower value
4105    which can be sign-extended or zero-extended to give back OP.
4106    Store in *UNSIGNEDP_PTR either 1 if the value should be zero-extended
4107    or 0 if the value should be sign-extended.  */
4108
4109 tree
4110 get_narrower (op, unsignedp_ptr)
4111      register tree op;
4112      int *unsignedp_ptr;
4113 {
4114   register int uns = 0;
4115   int first = 1;
4116   register tree win = op;
4117
4118   while (TREE_CODE (op) == NOP_EXPR)
4119     {
4120       register int bitschange
4121         = TYPE_PRECISION (TREE_TYPE (op))
4122           - TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (op, 0)));
4123
4124       /* Truncations are many-one so cannot be removed.  */
4125       if (bitschange < 0)
4126         break;
4127
4128       /* See what's inside this conversion.  If we decide to strip it,
4129          we will set WIN.  */
4130       op = TREE_OPERAND (op, 0);
4131
4132       if (bitschange > 0)
4133         {
4134           /* An extension: the outermost one can be stripped,
4135              but remember whether it is zero or sign extension.  */
4136           if (first)
4137             uns = TREE_UNSIGNED (TREE_TYPE (op));
4138           /* Otherwise, if a sign extension has been stripped,
4139              only sign extensions can now be stripped;
4140              if a zero extension has been stripped, only zero-extensions.  */
4141           else if (uns != TREE_UNSIGNED (TREE_TYPE (op)))
4142             break;
4143           first = 0;
4144         }
4145       else /* bitschange == 0 */
4146         {
4147           /* A change in nominal type can always be stripped, but we must
4148              preserve the unsignedness.  */
4149           if (first)
4150             uns = TREE_UNSIGNED (TREE_TYPE (op));
4151           first = 0;
4152         }
4153
4154       win = op;
4155     }
4156
4157   if (TREE_CODE (op) == COMPONENT_REF
4158       /* Since type_for_size always gives an integer type.  */
4159       && TREE_CODE (TREE_TYPE (op)) != REAL_TYPE)
4160     {
4161       unsigned innerprec = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1)));
4162       tree type = type_for_size (innerprec, TREE_UNSIGNED (op));
4163
4164       /* We can get this structure field in a narrower type that fits it,
4165          but the resulting extension to its nominal type (a fullword type)
4166          must satisfy the same conditions as for other extensions.
4167
4168          Do this only for fields that are aligned (not bit-fields),
4169          because when bit-field insns will be used there is no
4170          advantage in doing this.  */
4171
4172       if (innerprec < TYPE_PRECISION (TREE_TYPE (op))
4173           && ! DECL_BIT_FIELD (TREE_OPERAND (op, 1))
4174           && (first || uns == TREE_UNSIGNED (TREE_OPERAND (op, 1)))
4175           && type != 0)
4176         {
4177           if (first)
4178             uns = TREE_UNSIGNED (TREE_OPERAND (op, 1));
4179           win = build (COMPONENT_REF, type, TREE_OPERAND (op, 0),
4180                        TREE_OPERAND (op, 1));
4181           TREE_SIDE_EFFECTS (win) = TREE_SIDE_EFFECTS (op);
4182           TREE_THIS_VOLATILE (win) = TREE_THIS_VOLATILE (op);
4183           TREE_RAISES (win) = TREE_RAISES (op);
4184         }
4185     }
4186   *unsignedp_ptr = uns;
4187   return win;
4188 }
4189 \f
4190 /* Return the precision of a type, for arithmetic purposes.
4191    Supports all types on which arithmetic is possible
4192    (including pointer types).
4193    It's not clear yet what will be right for complex types.  */
4194
4195 int
4196 type_precision (type)
4197      register tree type;
4198 {
4199   return ((TREE_CODE (type) == INTEGER_TYPE
4200            || TREE_CODE (type) == ENUMERAL_TYPE
4201            || TREE_CODE (type) == REAL_TYPE)
4202           ? TYPE_PRECISION (type) : POINTER_SIZE);
4203 }
4204
4205 /* Nonzero if integer constant C has a value that is permissible
4206    for type TYPE (an INTEGER_TYPE).  */
4207
4208 int
4209 int_fits_type_p (c, type)
4210      tree c, type;
4211 {
4212   if (TREE_UNSIGNED (type))
4213     return (! (TREE_CODE (TYPE_MAX_VALUE (type)) == INTEGER_CST
4214                && INT_CST_LT_UNSIGNED (TYPE_MAX_VALUE (type), c))
4215             && ! (TREE_CODE (TYPE_MIN_VALUE (type)) == INTEGER_CST
4216                   && INT_CST_LT_UNSIGNED (c, TYPE_MIN_VALUE (type))));
4217   else
4218     return (! (TREE_CODE (TYPE_MAX_VALUE (type)) == INTEGER_CST
4219                && INT_CST_LT (TYPE_MAX_VALUE (type), c))
4220             && ! (TREE_CODE (TYPE_MIN_VALUE (type)) == INTEGER_CST
4221                   && INT_CST_LT (c, TYPE_MIN_VALUE (type))));
4222 }
4223
4224 /* Return the innermost context enclosing DECL that is
4225    a FUNCTION_DECL, or zero if none.  */
4226
4227 tree
4228 decl_function_context (decl)
4229      tree decl;
4230 {
4231   tree context;
4232
4233   if (TREE_CODE (decl) == ERROR_MARK)
4234     return 0;
4235
4236   if (TREE_CODE (decl) == SAVE_EXPR)
4237     context = SAVE_EXPR_CONTEXT (decl);
4238   else
4239     context = DECL_CONTEXT (decl);
4240
4241   while (context && TREE_CODE (context) != FUNCTION_DECL)
4242     {
4243       if (TREE_CODE (context) == RECORD_TYPE
4244           || TREE_CODE (context) == UNION_TYPE)
4245         context = TYPE_CONTEXT (context);
4246       else if (TREE_CODE (context) == TYPE_DECL)
4247         context = DECL_CONTEXT (context);
4248       else if (TREE_CODE (context) == BLOCK)
4249         context = BLOCK_SUPERCONTEXT (context);
4250       else
4251         /* Unhandled CONTEXT !?  */
4252         abort ();
4253     }
4254
4255   return context;
4256 }
4257
4258 /* Return the innermost context enclosing DECL that is
4259    a RECORD_TYPE, UNION_TYPE or QUAL_UNION_TYPE, or zero if none.
4260    TYPE_DECLs and FUNCTION_DECLs are transparent to this function.  */
4261
4262 tree
4263 decl_type_context (decl)
4264      tree decl;
4265 {
4266   tree context = DECL_CONTEXT (decl);
4267
4268   while (context)
4269     {
4270       if (TREE_CODE (context) == RECORD_TYPE
4271           || TREE_CODE (context) == UNION_TYPE
4272           || TREE_CODE (context) == QUAL_UNION_TYPE)
4273         return context;
4274       if (TREE_CODE (context) == TYPE_DECL
4275           || TREE_CODE (context) == FUNCTION_DECL)
4276         context = DECL_CONTEXT (context);
4277       else if (TREE_CODE (context) == BLOCK)
4278         context = BLOCK_SUPERCONTEXT (context);
4279       else
4280         /* Unhandled CONTEXT!?  */
4281         abort ();
4282     }
4283   return NULL_TREE;
4284 }
4285
4286 void
4287 print_obstack_statistics (str, o)
4288      char *str;
4289      struct obstack *o;
4290 {
4291   struct _obstack_chunk *chunk = o->chunk;
4292   int n_chunks = 0;
4293   int n_alloc = 0;
4294
4295   while (chunk)
4296     {
4297       n_chunks += 1;
4298       n_alloc += chunk->limit - &chunk->contents[0];
4299       chunk = chunk->prev;
4300     }
4301   fprintf (stderr, "obstack %s: %d bytes, %d chunks\n",
4302            str, n_alloc, n_chunks);
4303 }
4304 void
4305 dump_tree_statistics ()
4306 {
4307   int i;
4308   int total_nodes, total_bytes;
4309
4310   fprintf (stderr, "\n??? tree nodes created\n\n");
4311 #ifdef GATHER_STATISTICS
4312   fprintf (stderr, "Kind                  Nodes     Bytes\n");
4313   fprintf (stderr, "-------------------------------------\n");
4314   total_nodes = total_bytes = 0;
4315   for (i = 0; i < (int) all_kinds; i++)
4316     {
4317       fprintf (stderr, "%-20s %6d %9d\n", tree_node_kind_names[i],
4318                tree_node_counts[i], tree_node_sizes[i]);
4319       total_nodes += tree_node_counts[i];
4320       total_bytes += tree_node_sizes[i];
4321     }
4322   fprintf (stderr, "%-20s        %9d\n", "identifier names", id_string_size);
4323   fprintf (stderr, "-------------------------------------\n");
4324   fprintf (stderr, "%-20s %6d %9d\n", "Total", total_nodes, total_bytes);
4325   fprintf (stderr, "-------------------------------------\n");
4326 #else
4327   fprintf (stderr, "(No per-node statistics)\n");
4328 #endif
4329   print_lang_statistics ();
4330 }
4331 \f
4332 #define FILE_FUNCTION_PREFIX_LEN 9
4333
4334 #ifndef NO_DOLLAR_IN_LABEL
4335 #define FILE_FUNCTION_FORMAT "_GLOBAL_$D$%s"
4336 #else /* NO_DOLLAR_IN_LABEL */
4337 #ifndef NO_DOT_IN_LABEL
4338 #define FILE_FUNCTION_FORMAT "_GLOBAL_.D.%s"
4339 #else /* NO_DOT_IN_LABEL */
4340 #define FILE_FUNCTION_FORMAT "_GLOBAL__D_%s"
4341 #endif  /* NO_DOT_IN_LABEL */
4342 #endif  /* NO_DOLLAR_IN_LABEL */
4343
4344 extern char * first_global_object_name;
4345
4346 /* If KIND=='I', return a suitable global initializer (constructor) name.
4347    If KIND=='D', return a suitable global clean-up (destructor) name.  */
4348
4349 tree
4350 get_file_function_name (kind)
4351      int kind;
4352 {
4353   char *buf;
4354   register char *p;
4355
4356   if (first_global_object_name)
4357     p = first_global_object_name;
4358   else if (main_input_filename)
4359     p = main_input_filename;
4360   else
4361     p = input_filename;
4362
4363   buf = (char *) alloca (sizeof (FILE_FUNCTION_FORMAT) + strlen (p));
4364
4365   /* Set up the name of the file-level functions we may need.  */
4366   /* Use a global object (which is already required to be unique over
4367      the program) rather than the file name (which imposes extra
4368      constraints).  -- Raeburn@MIT.EDU, 10 Jan 1990.  */
4369   sprintf (buf, FILE_FUNCTION_FORMAT, p);
4370
4371   /* Don't need to pull weird characters out of global names.  */
4372   if (p != first_global_object_name)
4373     {
4374       for (p = buf+11; *p; p++)
4375         if (! ((*p >= '0' && *p <= '9')
4376 #if 0 /* we always want labels, which are valid C++ identifiers (+ `$') */
4377 #ifndef ASM_IDENTIFY_GCC        /* this is required if `.' is invalid -- k. raeburn */
4378                || *p == '.'
4379 #endif
4380 #endif
4381 #ifndef NO_DOLLAR_IN_LABEL      /* this for `$'; unlikely, but... -- kr */
4382                || *p == '$'
4383 #endif
4384 #ifndef NO_DOT_IN_LABEL         /* this for `.'; unlikely, but...  */
4385                || *p == '.'
4386 #endif
4387                || (*p >= 'A' && *p <= 'Z')
4388                || (*p >= 'a' && *p <= 'z')))
4389           *p = '_';
4390     }
4391
4392   buf[FILE_FUNCTION_PREFIX_LEN] = kind;
4393
4394   return get_identifier (buf);
4395 }
4396 \f
4397 /* Expand (the constant part of) a SET_TYPE CONSTRUCTOR node.
4398    The result is placed in BUFFER (which has length BIT_SIZE),
4399    with one bit in each char ('\000' or '\001').
4400
4401    If the constructor is constant, NULL_TREE is returned.
4402    Otherwise, a TREE_LIST of the non-constant elements is emitted.  */
4403
4404 tree
4405 get_set_constructor_bits (init, buffer, bit_size)
4406      tree init;
4407      char *buffer;
4408      int bit_size;
4409 {
4410   int i;
4411   tree vals;
4412   HOST_WIDE_INT domain_min
4413     = TREE_INT_CST_LOW (TYPE_MIN_VALUE (TYPE_DOMAIN (TREE_TYPE (init))));
4414   tree non_const_bits = NULL_TREE;
4415   for (i = 0; i < bit_size; i++)
4416     buffer[i] = 0;
4417
4418   for (vals = TREE_OPERAND (init, 1); 
4419        vals != NULL_TREE; vals = TREE_CHAIN (vals))
4420     {
4421       if (TREE_CODE (TREE_VALUE (vals)) != INTEGER_CST
4422           || (TREE_PURPOSE (vals) != NULL_TREE
4423               && TREE_CODE (TREE_PURPOSE (vals)) != INTEGER_CST))
4424         non_const_bits =
4425           tree_cons (TREE_PURPOSE (vals), TREE_VALUE (vals), non_const_bits);
4426       else if (TREE_PURPOSE (vals) != NULL_TREE)
4427         {
4428           /* Set a range of bits to ones.  */
4429           HOST_WIDE_INT lo_index
4430             = TREE_INT_CST_LOW (TREE_PURPOSE (vals)) - domain_min;
4431           HOST_WIDE_INT hi_index
4432             = TREE_INT_CST_LOW (TREE_VALUE (vals)) - domain_min;
4433           if (lo_index < 0 || lo_index >= bit_size
4434             || hi_index < 0 || hi_index >= bit_size)
4435             abort ();
4436           for ( ; lo_index <= hi_index; lo_index++)
4437             buffer[lo_index] = 1;
4438         }
4439       else
4440         {
4441           /* Set a single bit to one.  */
4442           HOST_WIDE_INT index
4443             = TREE_INT_CST_LOW (TREE_VALUE (vals)) - domain_min;
4444           if (index < 0 || index >= bit_size)
4445             {
4446               error ("invalid initializer for bit string");
4447               return NULL_TREE;
4448             }
4449           buffer[index] = 1;
4450         }
4451     }
4452   return non_const_bits;
4453 }
4454
4455 /* Expand (the constant part of) a SET_TYPE CONSTRUCTOR node.
4456    The result is placed in BUFFER (which is an array of bytes).
4457    If the constructor is constant, NULL_TREE is returned.
4458    Otherwise, a TREE_LIST of the non-constant elements is emitted.  */
4459
4460 tree
4461 get_set_constructor_bytes (init, buffer, wd_size)
4462      tree init;
4463      unsigned char *buffer;
4464      int wd_size;
4465 {
4466   int i;
4467   tree vals = TREE_OPERAND (init, 1);
4468   int set_word_size = BITS_PER_UNIT;
4469   int bit_size = wd_size * set_word_size;
4470   int bit_pos = 0;
4471   unsigned char *bytep = buffer;
4472   char *bit_buffer = (char *) alloca(bit_size);
4473   tree non_const_bits = get_set_constructor_bits (init, bit_buffer, bit_size);
4474
4475   for (i = 0; i < wd_size; i++)
4476     buffer[i] = 0;
4477
4478   for (i = 0; i < bit_size; i++)
4479     {
4480       if (bit_buffer[i])
4481         {
4482           if (BYTES_BIG_ENDIAN)
4483             *bytep |= (1 << (set_word_size - 1 - bit_pos));
4484           else
4485             *bytep |= 1 << bit_pos;
4486         }
4487       bit_pos++;
4488       if (bit_pos >= set_word_size)
4489         bit_pos = 0, bytep++;
4490     }
4491   return non_const_bits;
4492 }