OSDN Git Service

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