OSDN Git Service

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