OSDN Git Service

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