OSDN Git Service

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