OSDN Git Service

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