OSDN Git Service

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