OSDN Git Service

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