OSDN Git Service

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