OSDN Git Service

(simple_cst_equal): New default case handles most
[pf3gnuchains/gcc-fork.git] / gcc / tree.c
1 /* Language-independent node constructors for parse phase of GNU compiler.
2    Copyright (C) 1987, 1988, 1992 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, 675 Mass Ave, Cambridge, MA 02139, USA.  */
19
20
21 /* This file contains the low level primitives for operating on tree nodes,
22    including allocation, list operations, interning of identifiers,
23    construction of data type nodes and statement nodes,
24    and construction of type conversion nodes.  It also contains
25    tables index by tree code that describe how to take apart
26    nodes of that code.
27
28    It is intended to be language-independent, but occasionally
29    calls language-dependent routines defined (for C) in typecheck.c.
30
31    The low-level allocation routines oballoc and permalloc
32    are used also for allocating many other kinds of objects
33    by all passes of the compiler.  */
34
35 #include "config.h"
36 #include "flags.h"
37 #include "tree.h"
38 #include "function.h"
39 #include "obstack.h"
40 #include "gvarargs.h"
41 #include <stdio.h>
42
43 #define obstack_chunk_alloc xmalloc
44 #define obstack_chunk_free free
45
46 /* Tree nodes of permanent duration are allocated in this obstack.
47    They are the identifier nodes, and everything outside of
48    the bodies and parameters of function definitions.  */
49
50 struct obstack permanent_obstack;
51
52 /* The initial RTL, and all ..._TYPE nodes, in a function
53    are allocated in this obstack.  Usually they are freed at the
54    end of the function, but if the function is inline they are saved.
55    For top-level functions, this is maybepermanent_obstack.
56    Separate obstacks are made for nested functions.  */
57
58 struct obstack *function_maybepermanent_obstack;
59
60 /* This is the function_maybepermanent_obstack for top-level functions.  */
61
62 struct obstack maybepermanent_obstack;
63
64 /* The contents of the current function definition are allocated
65    in this obstack, and all are freed at the end of the function.
66    For top-level functions, this is temporary_obstack.
67    Separate obstacks are made for nested functions.  */
68
69 struct obstack *function_obstack;
70
71 /* This is used for reading initializers of global variables.  */
72
73 struct obstack temporary_obstack;
74
75 /* The tree nodes of an expression are allocated
76    in this obstack, and all are freed at the end of the expression.  */
77
78 struct obstack momentary_obstack;
79
80 /* The tree nodes of a declarator are allocated
81    in this obstack, and all are freed when the declarator
82    has been parsed.  */
83
84 static struct obstack temp_decl_obstack;
85
86 /* This points at either permanent_obstack
87    or the current function_maybepermanent_obstack.  */
88
89 struct obstack *saveable_obstack;
90
91 /* This is same as saveable_obstack during parse and expansion phase;
92    it points to the current function's obstack during optimization.
93    This is the obstack to be used for creating rtl objects.  */
94
95 struct obstack *rtl_obstack;
96
97 /* This points at either permanent_obstack or the current function_obstack.  */
98
99 struct obstack *current_obstack;
100
101 /* This points at either permanent_obstack or the current function_obstack
102    or momentary_obstack.  */
103
104 struct obstack *expression_obstack;
105
106 /* Stack of obstack selections for push_obstacks and pop_obstacks.  */
107
108 struct obstack_stack
109 {
110   struct obstack_stack *next;
111   struct obstack *current;
112   struct obstack *saveable;
113   struct obstack *expression;
114   struct obstack *rtl;
115 };
116
117 struct obstack_stack *obstack_stack;
118
119 /* Obstack for allocating struct obstack_stack entries.  */
120
121 static struct obstack obstack_stack_obstack;
122
123 /* Addresses of first objects in some obstacks.
124    This is for freeing their entire contents.  */
125 char *maybepermanent_firstobj;
126 char *temporary_firstobj;
127 char *momentary_firstobj;
128 char *temp_decl_firstobj;
129
130 /* Nonzero means all ..._TYPE nodes should be allocated permanently.  */
131
132 int all_types_permanent;
133
134 /* Stack of places to restore the momentary obstack back to.  */
135    
136 struct momentary_level
137 {
138   /* Pointer back to previous such level.  */
139   struct momentary_level *prev;
140   /* First object allocated within this level.  */
141   char *base;
142   /* Value of expression_obstack saved at entry to this level.  */
143   struct obstack *obstack;
144 };
145
146 struct momentary_level *momentary_stack;
147
148 /* Table indexed by tree code giving a string containing a character
149    classifying the tree code.  Possibilities are
150    t, d, s, c, r, <, 1, 2 and e.  See tree.def for details.  */
151
152 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
153
154 char *standard_tree_code_type[] = {
155 #include "tree.def"
156 };
157 #undef DEFTREECODE
158
159 /* Table indexed by tree code giving number of expression
160    operands beyond the fixed part of the node structure.
161    Not used for types or decls.  */
162
163 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
164
165 int standard_tree_code_length[] = {
166 #include "tree.def"
167 };
168 #undef DEFTREECODE
169
170 /* Names of tree components.
171    Used for printing out the tree and error messages.  */
172 #define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
173
174 char *standard_tree_code_name[] = {
175 #include "tree.def"
176 };
177 #undef DEFTREECODE
178
179 /* Table indexed by tree code giving a string containing a character
180    classifying the tree code.  Possibilities are
181    t, d, s, c, r, e, <, 1 and 2.  See tree.def for details.  */
182
183 char **tree_code_type;
184
185 /* Table indexed by tree code giving number of expression
186    operands beyond the fixed part of the node structure.
187    Not used for types or decls.  */
188
189 int *tree_code_length;
190
191 /* Table indexed by tree code giving name of tree code, as a string.  */
192
193 char **tree_code_name;
194
195 /* Statistics-gathering stuff.  */
196 typedef enum
197 {
198   d_kind,
199   t_kind,
200   b_kind,
201   s_kind,
202   r_kind,
203   e_kind,
204   c_kind,
205   id_kind,
206   op_id_kind,
207   perm_list_kind,
208   temp_list_kind,
209   vec_kind,
210   x_kind,
211   lang_decl,
212   lang_type,
213   all_kinds
214 } tree_node_kind;
215
216 int tree_node_counts[(int)all_kinds];
217 int tree_node_sizes[(int)all_kinds];
218 int id_string_size = 0;
219
220 char *tree_node_kind_names[] = {
221   "decls",
222   "types",
223   "blocks",
224   "stmts",
225   "refs",
226   "exprs",
227   "constants",
228   "identifiers",
229   "op_identifiers",
230   "perm_tree_lists",
231   "temp_tree_lists",
232   "vecs",
233   "random kinds",
234   "lang_decl kinds",
235   "lang_type kinds"
236 };
237
238 /* Hash table for uniquizing IDENTIFIER_NODEs by name.  */
239
240 #define MAX_HASH_TABLE 1009
241 static tree hash_table[MAX_HASH_TABLE]; /* id hash buckets */
242
243 /* 0 while creating built-in identifiers.  */
244 static int do_identifier_warnings;
245
246 /* Unique id for next decl created.  */
247 static int next_decl_uid;
248
249 extern char *mode_name[];
250
251 void gcc_obstack_init ();
252 static tree stabilize_reference_1 ();
253 \f
254 /* Init the principal obstacks.  */
255
256 void
257 init_obstacks ()
258 {
259   gcc_obstack_init (&obstack_stack_obstack);
260   gcc_obstack_init (&permanent_obstack);
261
262   gcc_obstack_init (&temporary_obstack);
263   temporary_firstobj = (char *) obstack_alloc (&temporary_obstack, 0);
264   gcc_obstack_init (&momentary_obstack);
265   momentary_firstobj = (char *) obstack_alloc (&momentary_obstack, 0);
266   gcc_obstack_init (&maybepermanent_obstack);
267   maybepermanent_firstobj
268     = (char *) obstack_alloc (&maybepermanent_obstack, 0);
269   gcc_obstack_init (&temp_decl_obstack);
270   temp_decl_firstobj = (char *) obstack_alloc (&temp_decl_obstack, 0);
271
272   function_obstack = &temporary_obstack;
273   function_maybepermanent_obstack = &maybepermanent_obstack;
274   current_obstack = &permanent_obstack;
275   expression_obstack = &permanent_obstack;
276   rtl_obstack = saveable_obstack = &permanent_obstack;
277
278   /* Init the hash table of identifiers.  */
279   bzero (hash_table, sizeof hash_table);
280 }
281
282 void
283 gcc_obstack_init (obstack)
284      struct obstack *obstack;
285 {
286   /* Let particular systems override the size of a chunk.  */
287 #ifndef OBSTACK_CHUNK_SIZE
288 #define OBSTACK_CHUNK_SIZE 0
289 #endif
290   /* Let them override the alloc and free routines too.  */
291 #ifndef OBSTACK_CHUNK_ALLOC
292 #define OBSTACK_CHUNK_ALLOC xmalloc
293 #endif
294 #ifndef OBSTACK_CHUNK_FREE
295 #define OBSTACK_CHUNK_FREE free
296 #endif
297   _obstack_begin (obstack, OBSTACK_CHUNK_SIZE, 0,
298                   (void *(*) ()) OBSTACK_CHUNK_ALLOC,
299                   (void (*) ()) OBSTACK_CHUNK_FREE);
300 }
301
302 /* Save all variables describing the current status into the structure *P.
303    This is used before starting a nested function.  */
304
305 void
306 save_tree_status (p)
307      struct function *p;
308 {
309   p->all_types_permanent = all_types_permanent;
310   p->momentary_stack = momentary_stack;
311   p->maybepermanent_firstobj = maybepermanent_firstobj;
312   p->momentary_firstobj = momentary_firstobj;
313   p->function_obstack = function_obstack;
314   p->function_maybepermanent_obstack = function_maybepermanent_obstack;
315   p->current_obstack = current_obstack;
316   p->expression_obstack = expression_obstack;
317   p->saveable_obstack = saveable_obstack;
318   p->rtl_obstack = rtl_obstack;
319
320   function_obstack = (struct obstack *) xmalloc (sizeof (struct obstack));
321   gcc_obstack_init (function_obstack);
322
323   function_maybepermanent_obstack
324     = (struct obstack *) xmalloc (sizeof (struct obstack));
325   gcc_obstack_init (function_maybepermanent_obstack);
326
327   current_obstack = &permanent_obstack;
328   expression_obstack = &permanent_obstack;
329   rtl_obstack = saveable_obstack = &permanent_obstack;
330
331   momentary_firstobj = (char *) obstack_finish (&momentary_obstack);
332   maybepermanent_firstobj
333     = (char *) obstack_finish (function_maybepermanent_obstack);
334 }
335
336 /* Restore all variables describing the current status from the structure *P.
337    This is used after a nested function.  */
338
339 void
340 restore_tree_status (p)
341      struct function *p;
342 {
343   all_types_permanent = p->all_types_permanent;
344   momentary_stack = p->momentary_stack;
345
346   obstack_free (&momentary_obstack, momentary_firstobj);
347   obstack_free (function_obstack, 0);
348   obstack_free (function_maybepermanent_obstack, 0);
349   free (function_obstack);
350
351   momentary_firstobj = p->momentary_firstobj;
352   maybepermanent_firstobj = p->maybepermanent_firstobj;
353   function_obstack = p->function_obstack;
354   function_maybepermanent_obstack = p->function_maybepermanent_obstack;
355   current_obstack = p->current_obstack;
356   expression_obstack = p->expression_obstack;
357   saveable_obstack = p->saveable_obstack;
358   rtl_obstack = p->rtl_obstack;
359 }
360 \f
361 /* Start allocating on the temporary (per function) obstack.
362    This is done in start_function before parsing the function body,
363    and before each initialization at top level, and to go back
364    to temporary allocation after doing end_temporary_allocation.  */
365
366 void
367 temporary_allocation ()
368 {
369   /* Note that function_obstack at top level points to temporary_obstack.
370      But within a nested function context, it is a separate obstack.  */
371   current_obstack = function_obstack;
372   expression_obstack = function_obstack;
373   rtl_obstack = saveable_obstack = function_maybepermanent_obstack;
374   momentary_stack = 0;
375 }
376
377 /* Start allocating on the permanent obstack but don't
378    free the temporary data.  After calling this, call
379    `permanent_allocation' to fully resume permanent allocation status.  */
380
381 void
382 end_temporary_allocation ()
383 {
384   current_obstack = &permanent_obstack;
385   expression_obstack = &permanent_obstack;
386   rtl_obstack = saveable_obstack = &permanent_obstack;
387 }
388
389 /* Resume allocating on the temporary obstack, undoing
390    effects of `end_temporary_allocation'.  */
391
392 void
393 resume_temporary_allocation ()
394 {
395   current_obstack = function_obstack;
396   expression_obstack = function_obstack;
397   rtl_obstack = saveable_obstack = function_maybepermanent_obstack;
398 }
399
400 /* While doing temporary allocation, switch to allocating in such a
401    way as to save all nodes if the function is inlined.  Call
402    resume_temporary_allocation to go back to ordinary temporary
403    allocation.  */
404
405 void
406 saveable_allocation ()
407 {
408   /* Note that function_obstack at top level points to temporary_obstack.
409      But within a nested function context, it is a separate obstack.  */
410   expression_obstack = current_obstack = saveable_obstack;
411 }
412
413 /* Switch to current obstack CURRENT and maybepermanent obstack SAVEABLE,
414    recording the previously current obstacks on a stack.
415    This does not free any storage in any obstack.  */
416
417 void
418 push_obstacks (current, saveable)
419      struct obstack *current, *saveable;
420 {
421   struct obstack_stack *p
422     = (struct obstack_stack *) obstack_alloc (&obstack_stack_obstack,
423                                               (sizeof (struct obstack_stack)));
424
425   p->current = current_obstack;
426   p->saveable = saveable_obstack;
427   p->expression = expression_obstack;
428   p->rtl = rtl_obstack;
429   p->next = obstack_stack;
430   obstack_stack = p;
431
432   current_obstack = current;
433   expression_obstack = current;
434   rtl_obstack = saveable_obstack = saveable;
435 }
436
437 /* Save the current set of obstacks, but don't change them.  */
438
439 void
440 push_obstacks_nochange ()
441 {
442   struct obstack_stack *p
443     = (struct obstack_stack *) obstack_alloc (&obstack_stack_obstack,
444                                               (sizeof (struct obstack_stack)));
445
446   p->current = current_obstack;
447   p->saveable = saveable_obstack;
448   p->expression = expression_obstack;
449   p->rtl = rtl_obstack;
450   p->next = obstack_stack;
451   obstack_stack = p;
452 }
453
454 /* Pop the obstack selection stack.  */
455
456 void
457 pop_obstacks ()
458 {
459   struct obstack_stack *p = obstack_stack;
460   obstack_stack = p->next;
461
462   current_obstack = p->current;
463   saveable_obstack = p->saveable;
464   expression_obstack = p->expression;
465   rtl_obstack = p->rtl;
466
467   obstack_free (&obstack_stack_obstack, p);
468 }
469
470 /* Nonzero if temporary allocation is currently in effect.
471    Zero if currently doing permanent allocation.  */
472
473 int
474 allocation_temporary_p ()
475 {
476   return current_obstack != &permanent_obstack;
477 }
478
479 /* Go back to allocating on the permanent obstack
480    and free everything in the temporary obstack.
481    This is done in finish_function after fully compiling a function.  */
482
483 void
484 permanent_allocation ()
485 {
486   /* Free up previous temporary obstack data */
487   obstack_free (&temporary_obstack, temporary_firstobj);
488   obstack_free (&momentary_obstack, momentary_firstobj);
489   obstack_free (&maybepermanent_obstack, maybepermanent_firstobj);
490   obstack_free (&temp_decl_obstack, temp_decl_firstobj);
491
492   current_obstack = &permanent_obstack;
493   expression_obstack = &permanent_obstack;
494   rtl_obstack = saveable_obstack = &permanent_obstack;
495 }
496
497 /* Save permanently everything on the maybepermanent_obstack.  */
498
499 void
500 preserve_data ()
501 {
502   maybepermanent_firstobj
503     = (char *) obstack_alloc (function_maybepermanent_obstack, 0);
504 }
505
506 void
507 preserve_initializer ()
508 {
509   temporary_firstobj
510     = (char *) obstack_alloc (&temporary_obstack, 0);
511   momentary_firstobj
512     = (char *) obstack_alloc (&momentary_obstack, 0);
513   maybepermanent_firstobj
514     = (char *) obstack_alloc (function_maybepermanent_obstack, 0);
515 }
516
517 /* Start allocating new rtl in current_obstack.
518    Use resume_temporary_allocation
519    to go back to allocating rtl in saveable_obstack.  */
520
521 void
522 rtl_in_current_obstack ()
523 {
524   rtl_obstack = current_obstack;
525 }
526
527 /* Temporarily allocate rtl from saveable_obstack.  Return 1 if we were
528    previously allocating it from current_obstack.  */
529
530 int
531 rtl_in_saveable_obstack ()
532 {
533   if (rtl_obstack == current_obstack)
534     {
535       rtl_obstack = saveable_obstack;
536       return 1;
537     }
538   else
539     return 0;
540 }
541 \f
542 /* Allocate SIZE bytes in the current obstack
543    and return a pointer to them.
544    In practice the current obstack is always the temporary one.  */
545
546 char *
547 oballoc (size)
548      int size;
549 {
550   return (char *) obstack_alloc (current_obstack, size);
551 }
552
553 /* Free the object PTR in the current obstack
554    as well as everything allocated since PTR.
555    In practice the current obstack is always the temporary one.  */
556
557 void
558 obfree (ptr)
559      char *ptr;
560 {
561   obstack_free (current_obstack, ptr);
562 }
563
564 /* Allocate SIZE bytes in the permanent obstack
565    and return a pointer to them.  */
566
567 char *
568 permalloc (size)
569      int size;
570 {
571   return (char *) obstack_alloc (&permanent_obstack, size);
572 }
573
574 /* Allocate NELEM items of SIZE bytes in the permanent obstack
575    and return a pointer to them.  The storage is cleared before
576    returning the value.  */
577
578 char *
579 perm_calloc (nelem, size)
580      int nelem;
581      long size;
582 {
583   char *rval = (char *) obstack_alloc (&permanent_obstack, nelem * size);
584   bzero (rval, nelem * size);
585   return rval;
586 }
587
588 /* Allocate SIZE bytes in the saveable obstack
589    and return a pointer to them.  */
590
591 char *
592 savealloc (size)
593      int size;
594 {
595   return (char *) obstack_alloc (saveable_obstack, size);
596 }
597 \f
598 /* Print out which obstack an object is in.  */
599
600 void
601 debug_obstack (object)
602      char *object;
603 {
604   struct obstack *obstack = NULL;
605   char *obstack_name = NULL;
606   struct function *p;
607
608   for (p = outer_function_chain; p; p = p->next)
609     {
610       if (_obstack_allocated_p (p->function_obstack, object))
611         {
612           obstack = p->function_obstack;
613           obstack_name = "containing function obstack";
614         }
615       if (_obstack_allocated_p (p->function_maybepermanent_obstack, object))
616         {
617           obstack = p->function_maybepermanent_obstack;
618           obstack_name = "containing function maybepermanent obstack";
619         }
620     }
621
622   if (_obstack_allocated_p (&obstack_stack_obstack, object))
623     {
624       obstack = &obstack_stack_obstack;
625       obstack_name = "obstack_stack_obstack";
626     }
627   else if (_obstack_allocated_p (function_obstack, object))
628     {
629       obstack = function_obstack;
630       obstack_name = "function obstack";
631     }
632   else if (_obstack_allocated_p (&permanent_obstack, object))
633     {
634       obstack = &permanent_obstack;
635       obstack_name = "permanent_obstack";
636     }
637   else if (_obstack_allocated_p (&momentary_obstack, object))
638     {
639       obstack = &momentary_obstack;
640       obstack_name = "momentary_obstack";
641     }
642   else if (_obstack_allocated_p (function_maybepermanent_obstack, object))
643     {
644       obstack = function_maybepermanent_obstack;
645       obstack_name = "function maybepermanent obstack";
646     }
647   else if (_obstack_allocated_p (&temp_decl_obstack, object))
648     {
649       obstack = &temp_decl_obstack;
650       obstack_name = "temp_decl_obstack";
651     }
652
653   /* Check to see if the object is in the free area of the obstack. */
654   if (obstack != NULL)
655     {
656       if (object >= obstack->next_free
657           && object < obstack->chunk_limit)
658         fprintf (stderr, "object in free portion of obstack %s.\n",
659                  obstack_name);
660       else
661         fprintf (stderr, "object allocated from %s.\n", obstack_name);
662     }
663   else
664     fprintf (stderr, "object not allocated from any obstack.\n");
665 }
666
667 /* Return 1 if OBJ is in the permanent obstack.
668    This is slow, and should be used only for debugging.
669    Use TREE_PERMANENT for other purposes.  */
670
671 int
672 object_permanent_p (obj)
673      tree obj;
674 {
675   return _obstack_allocated_p (&permanent_obstack, obj);
676 }
677 \f
678 /* Start a level of momentary allocation.
679    In C, each compound statement has its own level
680    and that level is freed at the end of each statement.
681    All expression nodes are allocated in the momentary allocation level.  */
682
683 void
684 push_momentary ()
685 {
686   struct momentary_level *tem
687     = (struct momentary_level *) obstack_alloc (&momentary_obstack,
688                                                 sizeof (struct momentary_level));
689   tem->prev = momentary_stack;
690   tem->base = (char *) obstack_base (&momentary_obstack);
691   tem->obstack = expression_obstack;
692   momentary_stack = tem;
693   expression_obstack = &momentary_obstack;
694 }
695
696 /* Free all the storage in the current momentary-allocation level.
697    In C, this happens at the end of each statement.  */
698
699 void
700 clear_momentary ()
701 {
702   obstack_free (&momentary_obstack, momentary_stack->base);
703 }
704
705 /* Discard a level of momentary allocation.
706    In C, this happens at the end of each compound statement.
707    Restore the status of expression node allocation
708    that was in effect before this level was created.  */
709
710 void
711 pop_momentary ()
712 {
713   struct momentary_level *tem = momentary_stack;
714   momentary_stack = tem->prev;
715   expression_obstack = tem->obstack;
716   obstack_free (&momentary_obstack, tem);
717 }
718
719 /* Call when starting to parse a declaration:
720    make expressions in the declaration last the length of the function.
721    Returns an argument that should be passed to resume_momentary later.  */
722
723 int
724 suspend_momentary ()
725 {
726   register int tem = expression_obstack == &momentary_obstack;
727   expression_obstack = saveable_obstack;
728   return tem;
729 }
730
731 /* Call when finished parsing a declaration:
732    restore the treatment of node-allocation that was
733    in effect before the suspension.
734    YES should be the value previously returned by suspend_momentary.  */
735
736 void
737 resume_momentary (yes)
738      int yes;
739 {
740   if (yes)
741     expression_obstack = &momentary_obstack;
742 }
743 \f
744 /* Init the tables indexed by tree code.
745    Note that languages can add to these tables to define their own codes.  */
746
747 void
748 init_tree_codes ()
749 {
750   tree_code_type = (char **) xmalloc (sizeof (standard_tree_code_type));
751   tree_code_length = (int *) xmalloc (sizeof (standard_tree_code_length));
752   tree_code_name = (char **) xmalloc (sizeof (standard_tree_code_name));
753   bcopy (standard_tree_code_type, tree_code_type,
754          sizeof (standard_tree_code_type));
755   bcopy (standard_tree_code_length, tree_code_length,
756          sizeof (standard_tree_code_length));
757   bcopy (standard_tree_code_name, tree_code_name,
758          sizeof (standard_tree_code_name));
759 }
760
761 /* Return a newly allocated node of code CODE.
762    Initialize the node's unique id and its TREE_PERMANENT flag.
763    For decl and type nodes, some other fields are initialized.
764    The rest of the node is initialized to zero.
765
766    Achoo!  I got a code in the node.  */
767
768 tree
769 make_node (code)
770      enum tree_code code;
771 {
772   register tree t;
773   register int type = TREE_CODE_CLASS (code);
774   register int length;
775   register struct obstack *obstack = current_obstack;
776   register int i;
777   register tree_node_kind kind;
778
779   switch (type)
780     {
781     case 'd':  /* A decl node */
782 #ifdef GATHER_STATISTICS
783       kind = d_kind;
784 #endif
785       length = sizeof (struct tree_decl);
786       /* All decls in an inline function need to be saved.  */
787       if (obstack != &permanent_obstack)
788         obstack = saveable_obstack;
789       /* PARM_DECLs always go on saveable_obstack, not permanent,
790          even though we may make them before the function turns
791          on temporary allocation.  */
792       else if (code == PARM_DECL)
793         obstack = function_maybepermanent_obstack;
794       break;
795
796     case 't':  /* a type node */
797 #ifdef GATHER_STATISTICS
798       kind = t_kind;
799 #endif
800       length = sizeof (struct tree_type);
801       /* All data types are put where we can preserve them if nec.  */
802       if (obstack != &permanent_obstack)
803         obstack = all_types_permanent ? &permanent_obstack : saveable_obstack;
804       break;
805
806     case 'b':  /* a lexical block */
807 #ifdef GATHER_STATISTICS
808       kind = b_kind;
809 #endif
810       length = sizeof (struct tree_block);
811       /* All BLOCK nodes are put where we can preserve them if nec.  */
812       if (obstack != &permanent_obstack)
813         obstack = saveable_obstack;
814       break;
815
816     case 's':  /* an expression with side effects */
817 #ifdef GATHER_STATISTICS
818       kind = s_kind;
819       goto usual_kind;
820 #endif
821     case 'r':  /* a reference */
822 #ifdef GATHER_STATISTICS
823       kind = r_kind;
824       goto usual_kind;
825 #endif
826     case 'e':  /* an expression */
827     case '<':  /* a comparison expression */
828     case '1':  /* a unary arithmetic expression */
829     case '2':  /* a binary arithmetic expression */
830 #ifdef GATHER_STATISTICS
831       kind = e_kind;
832     usual_kind:
833 #endif
834       obstack = expression_obstack;
835       /* All BIND_EXPR nodes are put where we can preserve them if nec.  */
836       if (code == BIND_EXPR && obstack != &permanent_obstack)
837         obstack = saveable_obstack;
838       length = sizeof (struct tree_exp)
839         + (tree_code_length[(int) code] - 1) * sizeof (char *);
840       break;
841
842     case 'c':  /* a constant */
843 #ifdef GATHER_STATISTICS
844       kind = c_kind;
845 #endif
846       obstack = expression_obstack;
847
848       /* We can't use tree_code_length for INTEGER_CST, since the number of
849          words is machine-dependent due to varying length of HOST_WIDE_INT,
850          which might be wider than a pointer (e.g., long long).  Similarly
851          for REAL_CST, since the number of words is machine-dependent due
852          to varying size and alignment of `double'.  */
853
854       if (code == INTEGER_CST)
855         length = sizeof (struct tree_int_cst);
856       else if (code == REAL_CST)
857         length = sizeof (struct tree_real_cst);
858       else
859         length = sizeof (struct tree_common)
860           + tree_code_length[(int) code] * sizeof (char *);
861       break;
862
863     case 'x':  /* something random, like an identifier.  */
864 #ifdef GATHER_STATISTICS
865       if (code == IDENTIFIER_NODE)
866         kind = id_kind;
867       else if (code == OP_IDENTIFIER)
868         kind = op_id_kind;
869       else if (code == TREE_VEC)
870         kind = vec_kind;
871       else
872         kind = x_kind;
873 #endif
874       length = sizeof (struct tree_common)
875         + tree_code_length[(int) code] * sizeof (char *);
876       /* Identifier nodes are always permanent since they are
877          unique in a compiler run.  */
878       if (code == IDENTIFIER_NODE) obstack = &permanent_obstack;
879     }
880
881   t = (tree) obstack_alloc (obstack, length);
882
883 #ifdef GATHER_STATISTICS
884   tree_node_counts[(int)kind]++;
885   tree_node_sizes[(int)kind] += length;
886 #endif
887
888   /* Clear a word at a time.  */
889   for (i = (length / sizeof (int)) - 1; i >= 0; i--)
890     ((int *) t)[i] = 0;
891   /* Clear any extra bytes.  */
892   for (i = length / sizeof (int) * sizeof (int); i < length; i++)
893     ((char *) t)[i] = 0;
894
895   TREE_SET_CODE (t, code);
896   if (obstack == &permanent_obstack)
897     TREE_PERMANENT (t) = 1;
898
899   switch (type)
900     {
901     case 's':
902       TREE_SIDE_EFFECTS (t) = 1;
903       TREE_TYPE (t) = void_type_node;
904       break;
905
906     case 'd':
907       if (code != FUNCTION_DECL)
908         DECL_ALIGN (t) = 1;
909       DECL_IN_SYSTEM_HEADER (t)
910         = in_system_header && (obstack == &permanent_obstack);
911       DECL_SOURCE_LINE (t) = lineno;
912       DECL_SOURCE_FILE (t) = (input_filename) ? input_filename : "<built-in>";
913       DECL_UID (t) = next_decl_uid++;
914       break;
915
916     case 't':
917       {
918         static unsigned next_type_uid = 1;
919
920         TYPE_UID (t) = next_type_uid++;
921       }
922       TYPE_ALIGN (t) = 1;
923       TYPE_MAIN_VARIANT (t) = t;
924       break;
925
926     case 'c':
927       TREE_CONSTANT (t) = 1;
928       break;
929     }
930
931   return t;
932 }
933 \f
934 /* Return a new node with the same contents as NODE
935    except that its TREE_CHAIN is zero and it has a fresh uid.  */
936
937 tree
938 copy_node (node)
939      tree node;
940 {
941   register tree t;
942   register enum tree_code code = TREE_CODE (node);
943   register int length;
944   register int i;
945
946   switch (TREE_CODE_CLASS (code))
947     {
948     case 'd':  /* A decl node */
949       length = sizeof (struct tree_decl);
950       break;
951
952     case 't':  /* a type node */
953       length = sizeof (struct tree_type);
954       break;
955
956     case 'b':  /* a lexical block node */
957       length = sizeof (struct tree_block);
958       break;
959
960     case 'r':  /* a reference */
961     case 'e':  /* an expression */
962     case 's':  /* an expression with side effects */
963     case '<':  /* a comparison expression */
964     case '1':  /* a unary arithmetic expression */
965     case '2':  /* a binary arithmetic expression */
966       length = sizeof (struct tree_exp)
967         + (tree_code_length[(int) code] - 1) * sizeof (char *);
968       break;
969
970     case 'c':  /* a constant */
971       /* We can't use tree_code_length for this, since the number of words
972          is machine-dependent due to varying alignment of `double'.  */
973       if (code == REAL_CST)
974         {
975           length = sizeof (struct tree_real_cst);
976           break;
977         }
978
979     case 'x':  /* something random, like an identifier.  */
980       length = sizeof (struct tree_common)
981         + tree_code_length[(int) code] * sizeof (char *);
982       if (code == TREE_VEC)
983         length += (TREE_VEC_LENGTH (node) - 1) * sizeof (char *);
984     }
985
986   t = (tree) obstack_alloc (current_obstack, length);
987
988   for (i = (length / sizeof (int)) - 1; i >= 0; i--)
989     ((int *) t)[i] = ((int *) node)[i];
990   /* Clear any extra bytes.  */
991   for (i = length / sizeof (int) * sizeof (int); i < length; i++)
992     ((char *) t)[i] = ((char *) node)[i];
993
994   TREE_CHAIN (t) = 0;
995
996   TREE_PERMANENT (t) = (current_obstack == &permanent_obstack);
997
998   return t;
999 }
1000
1001 /* Return a copy of a chain of nodes, chained through the TREE_CHAIN field.
1002    For example, this can copy a list made of TREE_LIST nodes.  */
1003
1004 tree
1005 copy_list (list)
1006      tree list;
1007 {
1008   tree head;
1009   register tree prev, next;
1010
1011   if (list == 0)
1012     return 0;
1013
1014   head = prev = copy_node (list);
1015   next = TREE_CHAIN (list);
1016   while (next)
1017     {
1018       TREE_CHAIN (prev) = copy_node (next);
1019       prev = TREE_CHAIN (prev);
1020       next = TREE_CHAIN (next);
1021     }
1022   return head;
1023 }
1024 \f
1025 #define HASHBITS 30
1026
1027 /* Return an IDENTIFIER_NODE whose name is TEXT (a null-terminated string).
1028    If an identifier with that name has previously been referred to,
1029    the same node is returned this time.  */
1030
1031 tree
1032 get_identifier (text)
1033      register char *text;
1034 {
1035   register int hi;
1036   register int i;
1037   register tree idp;
1038   register int len, hash_len;
1039
1040   /* Compute length of text in len.  */
1041   for (len = 0; text[len]; len++);
1042
1043   /* Decide how much of that length to hash on */
1044   hash_len = len;
1045   if (warn_id_clash && len > id_clash_len)
1046     hash_len = id_clash_len;
1047
1048   /* Compute hash code */
1049   hi = hash_len * 613 + (unsigned)text[0];
1050   for (i = 1; i < hash_len; i += 2)
1051     hi = ((hi * 613) + (unsigned)(text[i]));
1052
1053   hi &= (1 << HASHBITS) - 1;
1054   hi %= MAX_HASH_TABLE;
1055   
1056   /* Search table for identifier */
1057   for (idp = hash_table[hi]; idp; idp = TREE_CHAIN (idp))
1058     if (IDENTIFIER_LENGTH (idp) == len
1059         && IDENTIFIER_POINTER (idp)[0] == text[0]
1060         && !bcmp (IDENTIFIER_POINTER (idp), text, len))
1061       return idp;               /* <-- return if found */
1062
1063   /* Not found; optionally warn about a similar identifier */
1064   if (warn_id_clash && do_identifier_warnings && len >= id_clash_len)
1065     for (idp = hash_table[hi]; idp; idp = TREE_CHAIN (idp))
1066       if (!strncmp (IDENTIFIER_POINTER (idp), text, id_clash_len))
1067         {
1068           warning ("`%s' and `%s' identical in first %d characters",
1069                    IDENTIFIER_POINTER (idp), text, id_clash_len);
1070           break;
1071         }
1072
1073   if (tree_code_length[(int) IDENTIFIER_NODE] < 0)
1074     abort ();                   /* set_identifier_size hasn't been called.  */
1075
1076   /* Not found, create one, add to chain */
1077   idp = make_node (IDENTIFIER_NODE);
1078   IDENTIFIER_LENGTH (idp) = len;
1079 #ifdef GATHER_STATISTICS
1080   id_string_size += len;
1081 #endif
1082
1083   IDENTIFIER_POINTER (idp) = obstack_copy0 (&permanent_obstack, text, len);
1084
1085   TREE_CHAIN (idp) = hash_table[hi];
1086   hash_table[hi] = idp;
1087   return idp;                   /* <-- return if created */
1088 }
1089
1090 /* Enable warnings on similar identifiers (if requested).
1091    Done after the built-in identifiers are created.  */
1092
1093 void
1094 start_identifier_warnings ()
1095 {
1096   do_identifier_warnings = 1;
1097 }
1098
1099 /* Record the size of an identifier node for the language in use.
1100    SIZE is the total size in bytes.
1101    This is called by the language-specific files.  This must be
1102    called before allocating any identifiers.  */
1103
1104 void
1105 set_identifier_size (size)
1106      int size;
1107 {
1108   tree_code_length[(int) IDENTIFIER_NODE]
1109     = (size - sizeof (struct tree_common)) / sizeof (tree);
1110 }
1111 \f
1112 /* Return a newly constructed INTEGER_CST node whose constant value
1113    is specified by the two ints LOW and HI.
1114    The TREE_TYPE is set to `int'. 
1115
1116    This function should be used via the `build_int_2' macro.  */
1117
1118 tree
1119 build_int_2_wide (low, hi)
1120      HOST_WIDE_INT low, hi;
1121 {
1122   register tree t = make_node (INTEGER_CST);
1123   TREE_INT_CST_LOW (t) = low;
1124   TREE_INT_CST_HIGH (t) = hi;
1125   TREE_TYPE (t) = integer_type_node;
1126   return t;
1127 }
1128
1129 /* Return a new REAL_CST node whose type is TYPE and value is D.  */
1130
1131 tree
1132 build_real (type, d)
1133      tree type;
1134      REAL_VALUE_TYPE d;
1135 {
1136   tree v;
1137
1138   /* Check for valid float value for this type on this target machine;
1139      if not, can print error message and store a valid value in D.  */
1140 #ifdef CHECK_FLOAT_VALUE
1141   CHECK_FLOAT_VALUE (TYPE_MODE (type), d);
1142 #endif
1143
1144   v = make_node (REAL_CST);
1145   TREE_TYPE (v) = type;
1146   TREE_REAL_CST (v) = d;
1147   return v;
1148 }
1149
1150 /* Return a new REAL_CST node whose type is TYPE
1151    and whose value is the integer value of the INTEGER_CST node I.  */
1152
1153 #if !defined (REAL_IS_NOT_DOUBLE) || defined (REAL_ARITHMETIC)
1154
1155 REAL_VALUE_TYPE
1156 real_value_from_int_cst (i)
1157      tree i;
1158 {
1159   REAL_VALUE_TYPE d;
1160 #ifdef REAL_ARITHMETIC
1161   REAL_VALUE_FROM_INT (d, TREE_INT_CST_LOW (i), TREE_INT_CST_HIGH (i));
1162 #else /* not REAL_ARITHMETIC */
1163   if (TREE_INT_CST_HIGH (i) < 0 && ! TREE_UNSIGNED (TREE_TYPE (i)))
1164     {
1165       d = (double) (~ TREE_INT_CST_HIGH (i));
1166       d *= ((double) ((HOST_WIDE_INT) 1 << (HOST_BITS_PER_WIDE_INT / 2))
1167             * (double) ((HOST_WIDE_INT) 1 << (HOST_BITS_PER_WIDE_INT / 2)));
1168       d += (double) (unsigned HOST_WIDE_INT) (~ TREE_INT_CST_LOW (i));
1169       d = (- d - 1.0);
1170     }
1171   else
1172     {
1173       d = (double) (unsigned HOST_WIDE_INT) TREE_INT_CST_HIGH (i);
1174       d *= ((double) ((HOST_WIDE_INT) 1 << (HOST_BITS_PER_WIDE_INT / 2))
1175             * (double) ((HOST_WIDE_INT) 1 << (HOST_BITS_PER_WIDE_INT / 2)));
1176       d += (double) (unsigned HOST_WIDE_INT) TREE_INT_CST_LOW (i);
1177     }
1178 #endif /* not REAL_ARITHMETIC */
1179   return d;
1180 }
1181
1182 /* This function can't be implemented if we can't do arithmetic
1183    on the float representation.  */
1184
1185 tree
1186 build_real_from_int_cst (type, i)
1187      tree type;
1188      tree i;
1189 {
1190   tree v;
1191   REAL_VALUE_TYPE d;
1192
1193   v = make_node (REAL_CST);
1194   TREE_TYPE (v) = type;
1195
1196   d = REAL_VALUE_TRUNCATE (TYPE_MODE (type), real_value_from_int_cst (i));
1197   /* Check for valid float value for this type on this target machine;
1198      if not, can print error message and store a valid value in D.  */
1199 #ifdef CHECK_FLOAT_VALUE
1200   CHECK_FLOAT_VALUE (TYPE_MODE (type), d);
1201 #endif
1202
1203   TREE_REAL_CST (v) = d;
1204   return v;
1205 }
1206
1207 #endif /* not REAL_IS_NOT_DOUBLE, or REAL_ARITHMETIC */
1208
1209 /* Return a newly constructed STRING_CST node whose value is
1210    the LEN characters at STR.
1211    The TREE_TYPE is not initialized.  */
1212
1213 tree
1214 build_string (len, str)
1215      int len;
1216      char *str;
1217 {
1218   register tree s = make_node (STRING_CST);
1219   TREE_STRING_LENGTH (s) = len;
1220   TREE_STRING_POINTER (s) = obstack_copy0 (saveable_obstack, str, len);
1221   return s;
1222 }
1223
1224 /* Return a newly constructed COMPLEX_CST node whose value is
1225    specified by the real and imaginary parts REAL and IMAG.
1226    Both REAL and IMAG should be constant nodes.
1227    The TREE_TYPE is not initialized.  */
1228
1229 tree
1230 build_complex (real, imag)
1231      tree real, imag;
1232 {
1233   register tree t = make_node (COMPLEX_CST);
1234   TREE_REALPART (t) = real;
1235   TREE_IMAGPART (t) = imag;
1236   return t;
1237 }
1238
1239 /* Build a newly constructed TREE_VEC node of length LEN.  */
1240 tree
1241 make_tree_vec (len)
1242      int len;
1243 {
1244   register tree t;
1245   register int length = (len-1) * sizeof (tree) + sizeof (struct tree_vec);
1246   register struct obstack *obstack = current_obstack;
1247   register int i;
1248
1249 #ifdef GATHER_STATISTICS
1250   tree_node_counts[(int)vec_kind]++;
1251   tree_node_sizes[(int)vec_kind] += length;
1252 #endif
1253
1254   t = (tree) obstack_alloc (obstack, length);
1255
1256   for (i = (length / sizeof (int)) - 1; i >= 0; i--)
1257     ((int *) t)[i] = 0;
1258
1259   TREE_SET_CODE (t, TREE_VEC);
1260   TREE_VEC_LENGTH (t) = len;
1261   if (obstack == &permanent_obstack)
1262     TREE_PERMANENT (t) = 1;
1263
1264   return t;
1265 }
1266 \f
1267 /* Return 1 if EXPR is the integer constant zero.  */
1268
1269 int
1270 integer_zerop (expr)
1271      tree expr;
1272 {
1273   STRIP_NOPS (expr);
1274
1275   return (TREE_CODE (expr) == INTEGER_CST
1276           && TREE_INT_CST_LOW (expr) == 0
1277           && TREE_INT_CST_HIGH (expr) == 0);
1278 }
1279
1280 /* Return 1 if EXPR is the integer constant one.  */
1281
1282 int
1283 integer_onep (expr)
1284      tree expr;
1285 {
1286   STRIP_NOPS (expr);
1287
1288   return (TREE_CODE (expr) == INTEGER_CST
1289           && TREE_INT_CST_LOW (expr) == 1
1290           && TREE_INT_CST_HIGH (expr) == 0);
1291 }
1292
1293 /* Return 1 if EXPR is an integer containing all 1's
1294    in as much precision as it contains.  */
1295
1296 int
1297 integer_all_onesp (expr)
1298      tree expr;
1299 {
1300   register int prec;
1301   register int uns;
1302
1303   STRIP_NOPS (expr);
1304
1305   if (TREE_CODE (expr) != INTEGER_CST)
1306     return 0;
1307
1308   uns = TREE_UNSIGNED (TREE_TYPE (expr));
1309   if (!uns)
1310     return TREE_INT_CST_LOW (expr) == -1 && TREE_INT_CST_HIGH (expr) == -1;
1311
1312   prec = TYPE_PRECISION (TREE_TYPE (expr));
1313   if (prec >= HOST_BITS_PER_WIDE_INT)
1314     {
1315       int high_value, shift_amount;
1316
1317       shift_amount = prec - HOST_BITS_PER_WIDE_INT;
1318
1319       if (shift_amount > HOST_BITS_PER_WIDE_INT)
1320         /* Can not handle precisions greater than twice the host int size.  */
1321         abort ();
1322       else if (shift_amount == HOST_BITS_PER_WIDE_INT)
1323         /* Shifting by the host word size is undefined according to the ANSI
1324            standard, so we must handle this as a special case.  */
1325         high_value = -1;
1326       else
1327         high_value = ((HOST_WIDE_INT) 1 << shift_amount) - 1;
1328
1329       return TREE_INT_CST_LOW (expr) == -1
1330         && TREE_INT_CST_HIGH (expr) == high_value;
1331     }
1332   else
1333     return TREE_INT_CST_LOW (expr) == ((HOST_WIDE_INT) 1 << prec) - 1;
1334 }
1335
1336 /* Return 1 if EXPR is an integer constant that is a power of 2 (i.e., has only
1337    one bit on).  */
1338
1339 int
1340 integer_pow2p (expr)
1341      tree expr;
1342 {
1343   HOST_WIDE_INT high, low;
1344
1345   STRIP_NOPS (expr);
1346
1347   if (TREE_CODE (expr) != INTEGER_CST)
1348     return 0;
1349
1350   high = TREE_INT_CST_HIGH (expr);
1351   low = TREE_INT_CST_LOW (expr);
1352
1353   if (high == 0 && low == 0)
1354     return 0;
1355
1356   return ((high == 0 && (low & (low - 1)) == 0)
1357           || (low == 0 && (high & (high - 1)) == 0));
1358 }
1359
1360 /* Return 1 if EXPR is the real constant zero.  */
1361
1362 int
1363 real_zerop (expr)
1364      tree expr;
1365 {
1366   STRIP_NOPS (expr);
1367
1368   return (TREE_CODE (expr) == REAL_CST
1369           && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst0));
1370 }
1371
1372 /* Return 1 if EXPR is the real constant one.  */
1373
1374 int
1375 real_onep (expr)
1376      tree expr;
1377 {
1378   STRIP_NOPS (expr);
1379
1380   return (TREE_CODE (expr) == REAL_CST
1381           && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst1));
1382 }
1383
1384 /* Return 1 if EXPR is the real constant two.  */
1385
1386 int
1387 real_twop (expr)
1388      tree expr;
1389 {
1390   STRIP_NOPS (expr);
1391
1392   return (TREE_CODE (expr) == REAL_CST
1393           && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst2));
1394 }
1395
1396 /* Nonzero if EXP is a constant or a cast of a constant.  */
1397  
1398 int
1399 really_constant_p (exp)
1400      tree exp;
1401 {
1402   /* This is not quite the same as STRIP_NOPS.  It does more.  */
1403   while (TREE_CODE (exp) == NOP_EXPR
1404          || TREE_CODE (exp) == CONVERT_EXPR
1405          || TREE_CODE (exp) == NON_LVALUE_EXPR)
1406     exp = TREE_OPERAND (exp, 0);
1407   return TREE_CONSTANT (exp);
1408 }
1409 \f
1410 /* Return first list element whose TREE_VALUE is ELEM.
1411    Return 0 if ELEM is not it LIST.  */
1412
1413 tree
1414 value_member (elem, list)
1415      tree elem, list;
1416 {
1417   while (list)
1418     {
1419       if (elem == TREE_VALUE (list))
1420         return list;
1421       list = TREE_CHAIN (list);
1422     }
1423   return NULL_TREE;
1424 }
1425
1426 /* Return first list element whose TREE_PURPOSE is ELEM.
1427    Return 0 if ELEM is not it LIST.  */
1428
1429 tree
1430 purpose_member (elem, list)
1431      tree elem, list;
1432 {
1433   while (list)
1434     {
1435       if (elem == TREE_PURPOSE (list))
1436         return list;
1437       list = TREE_CHAIN (list);
1438     }
1439   return NULL_TREE;
1440 }
1441
1442 /* Return first list element whose BINFO_TYPE is ELEM.
1443    Return 0 if ELEM is not it LIST.  */
1444
1445 tree
1446 binfo_member (elem, list)
1447      tree elem, list;
1448 {
1449   while (list)
1450     {
1451       if (elem == BINFO_TYPE (list))
1452         return list;
1453       list = TREE_CHAIN (list);
1454     }
1455   return NULL_TREE;
1456 }
1457
1458 /* Return nonzero if ELEM is part of the chain CHAIN.  */
1459
1460 int
1461 chain_member (elem, chain)
1462      tree elem, chain;
1463 {
1464   while (chain)
1465     {
1466       if (elem == chain)
1467         return 1;
1468       chain = TREE_CHAIN (chain);
1469     }
1470
1471   return 0;
1472 }
1473
1474 /* Return the length of a chain of nodes chained through TREE_CHAIN.
1475    We expect a null pointer to mark the end of the chain.
1476    This is the Lisp primitive `length'.  */
1477
1478 int
1479 list_length (t)
1480      tree t;
1481 {
1482   register tree tail;
1483   register int len = 0;
1484
1485   for (tail = t; tail; tail = TREE_CHAIN (tail))
1486     len++;
1487
1488   return len;
1489 }
1490
1491 /* Concatenate two chains of nodes (chained through TREE_CHAIN)
1492    by modifying the last node in chain 1 to point to chain 2.
1493    This is the Lisp primitive `nconc'.  */
1494
1495 tree
1496 chainon (op1, op2)
1497      tree op1, op2;
1498 {
1499   tree t;
1500
1501   if (op1)
1502     {
1503       for (t = op1; TREE_CHAIN (t); t = TREE_CHAIN (t))
1504         if (t == op2) abort (); /* Circularity being created */
1505       if (t == op2) abort ();   /* Circularity being created */
1506       TREE_CHAIN (t) = op2;
1507       return op1;
1508     }
1509   else return op2;
1510 }
1511
1512 /* Return the last node in a chain of nodes (chained through TREE_CHAIN).  */
1513
1514 tree
1515 tree_last (chain)
1516      register tree chain;
1517 {
1518   register tree next;
1519   if (chain)
1520     while (next = TREE_CHAIN (chain))
1521       chain = next;
1522   return chain;
1523 }
1524
1525 /* Reverse the order of elements in the chain T,
1526    and return the new head of the chain (old last element).  */
1527
1528 tree
1529 nreverse (t)
1530      tree t;
1531 {
1532   register tree prev = 0, decl, next;
1533   for (decl = t; decl; decl = next)
1534     {
1535       next = TREE_CHAIN (decl);
1536       TREE_CHAIN (decl) = prev;
1537       prev = decl;
1538     }
1539   return prev;
1540 }
1541
1542 /* Given a chain CHAIN of tree nodes,
1543    construct and return a list of those nodes.  */
1544
1545 tree
1546 listify (chain)
1547      tree chain;
1548 {
1549   tree result = NULL_TREE;
1550   tree in_tail = chain;
1551   tree out_tail = NULL_TREE;
1552
1553   while (in_tail)
1554     {
1555       tree next = tree_cons (NULL_TREE, in_tail, NULL_TREE);
1556       if (out_tail)
1557         TREE_CHAIN (out_tail) = next;
1558       else
1559         result = next;
1560       out_tail = next;
1561       in_tail = TREE_CHAIN (in_tail);
1562     }
1563
1564   return result;
1565 }
1566 \f
1567 /* Return a newly created TREE_LIST node whose
1568    purpose and value fields are PARM and VALUE.  */
1569
1570 tree
1571 build_tree_list (parm, value)
1572      tree parm, value;
1573 {
1574   register tree t = make_node (TREE_LIST);
1575   TREE_PURPOSE (t) = parm;
1576   TREE_VALUE (t) = value;
1577   return t;
1578 }
1579
1580 /* Similar, but build on the temp_decl_obstack.  */
1581
1582 tree
1583 build_decl_list (parm, value)
1584      tree parm, value;
1585 {
1586   register tree node;
1587   register struct obstack *ambient_obstack = current_obstack;
1588   current_obstack = &temp_decl_obstack;
1589   node = build_tree_list (parm, value);
1590   current_obstack = ambient_obstack;
1591   return node;
1592 }
1593
1594 /* Return a newly created TREE_LIST node whose
1595    purpose and value fields are PARM and VALUE
1596    and whose TREE_CHAIN is CHAIN.  */
1597
1598 tree
1599 tree_cons (purpose, value, chain)
1600      tree purpose, value, chain;
1601 {
1602 #if 0
1603   register tree node = make_node (TREE_LIST);
1604 #else
1605   register int i;
1606   register tree node = (tree) obstack_alloc (current_obstack, sizeof (struct tree_list));
1607 #ifdef GATHER_STATISTICS
1608   tree_node_counts[(int)x_kind]++;
1609   tree_node_sizes[(int)x_kind] += sizeof (struct tree_list);
1610 #endif
1611
1612   for (i = (sizeof (struct tree_common) / sizeof (int)) - 1; i >= 0; i--)
1613     ((int *) node)[i] = 0;
1614
1615   TREE_SET_CODE (node, TREE_LIST);
1616   if (current_obstack == &permanent_obstack)
1617     TREE_PERMANENT (node) = 1;
1618 #endif
1619
1620   TREE_CHAIN (node) = chain;
1621   TREE_PURPOSE (node) = purpose;
1622   TREE_VALUE (node) = value;
1623   return node;
1624 }
1625
1626 /* Similar, but build on the temp_decl_obstack.  */
1627
1628 tree
1629 decl_tree_cons (purpose, value, chain)
1630      tree purpose, value, chain;
1631 {
1632   register tree node;
1633   register struct obstack *ambient_obstack = current_obstack;
1634   current_obstack = &temp_decl_obstack;
1635   node = tree_cons (purpose, value, chain);
1636   current_obstack = ambient_obstack;
1637   return node;
1638 }
1639
1640 /* Same as `tree_cons' but make a permanent object.  */
1641
1642 tree
1643 perm_tree_cons (purpose, value, chain)
1644      tree purpose, value, chain;
1645 {
1646   register tree node;
1647   register struct obstack *ambient_obstack = current_obstack;
1648   current_obstack = &permanent_obstack;
1649
1650   node = tree_cons (purpose, value, chain);
1651   current_obstack = ambient_obstack;
1652   return node;
1653 }
1654
1655 /* Same as `tree_cons', but make this node temporary, regardless.  */
1656
1657 tree
1658 temp_tree_cons (purpose, value, chain)
1659      tree purpose, value, chain;
1660 {
1661   register tree node;
1662   register struct obstack *ambient_obstack = current_obstack;
1663   current_obstack = &temporary_obstack;
1664
1665   node = tree_cons (purpose, value, chain);
1666   current_obstack = ambient_obstack;
1667   return node;
1668 }
1669
1670 /* Same as `tree_cons', but save this node if the function's RTL is saved.  */
1671
1672 tree
1673 saveable_tree_cons (purpose, value, chain)
1674      tree purpose, value, chain;
1675 {
1676   register tree node;
1677   register struct obstack *ambient_obstack = current_obstack;
1678   current_obstack = saveable_obstack;
1679
1680   node = tree_cons (purpose, value, chain);
1681   current_obstack = ambient_obstack;
1682   return node;
1683 }
1684 \f
1685 /* Return the size nominally occupied by an object of type TYPE
1686    when it resides in memory.  The value is measured in units of bytes,
1687    and its data type is that normally used for type sizes
1688    (which is the first type created by make_signed_type or
1689    make_unsigned_type).  */
1690
1691 tree
1692 size_in_bytes (type)
1693      tree type;
1694 {
1695   tree t;
1696
1697   if (type == error_mark_node)
1698     return integer_zero_node;
1699   type = TYPE_MAIN_VARIANT (type);
1700   if (TYPE_SIZE (type) == 0)
1701     {
1702       incomplete_type_error (NULL_TREE, type);
1703       return integer_zero_node;
1704     }
1705   t = size_binop (CEIL_DIV_EXPR, TYPE_SIZE (type),
1706                   size_int (BITS_PER_UNIT));
1707   if (TREE_CODE (t) == INTEGER_CST)
1708     force_fit_type (t, 0);
1709   return t;
1710 }
1711
1712 /* Return the size of TYPE (in bytes) as an integer,
1713    or return -1 if the size can vary.  */
1714
1715 int
1716 int_size_in_bytes (type)
1717      tree type;
1718 {
1719   unsigned int size;
1720   if (type == error_mark_node)
1721     return 0;
1722   type = TYPE_MAIN_VARIANT (type);
1723   if (TYPE_SIZE (type) == 0)
1724     return -1;
1725   if (TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST)
1726     return -1;
1727   if (TREE_INT_CST_HIGH (TYPE_SIZE (type)) != 0)
1728     {
1729       tree t = size_binop (CEIL_DIV_EXPR, TYPE_SIZE (type),
1730                            size_int (BITS_PER_UNIT));
1731       return TREE_INT_CST_LOW (t);
1732     }
1733   size = TREE_INT_CST_LOW (TYPE_SIZE (type));
1734   return (size + BITS_PER_UNIT - 1) / BITS_PER_UNIT;
1735 }
1736
1737 /* Return, as an INTEGER_CST node, the number of elements for
1738    TYPE (which is an ARRAY_TYPE) minus one. 
1739    This counts only elements of the top array.  */
1740
1741 tree
1742 array_type_nelts (type)
1743      tree type;
1744 {
1745   tree index_type = TYPE_DOMAIN (type);
1746   return (tree_int_cst_equal (TYPE_MIN_VALUE (index_type), integer_zero_node)
1747           ? TYPE_MAX_VALUE (index_type)
1748           : fold (build (MINUS_EXPR, integer_type_node,
1749                          TYPE_MAX_VALUE (index_type),
1750                          TYPE_MIN_VALUE (index_type))));
1751 }
1752 \f
1753 /* Return nonzero if arg is static -- a reference to an object in
1754    static storage.  This is not the same as the C meaning of `static'.  */
1755
1756 int
1757 staticp (arg)
1758      tree arg;
1759 {
1760   switch (TREE_CODE (arg))
1761     {
1762     case VAR_DECL:
1763     case FUNCTION_DECL:
1764     case CONSTRUCTOR:
1765       return TREE_STATIC (arg) || DECL_EXTERNAL (arg);
1766
1767     case STRING_CST:
1768       return 1;
1769
1770     case COMPONENT_REF:
1771     case BIT_FIELD_REF:
1772       return staticp (TREE_OPERAND (arg, 0));
1773
1774     case INDIRECT_REF:
1775       return TREE_CONSTANT (TREE_OPERAND (arg, 0));
1776
1777     case ARRAY_REF:
1778       if (TREE_CODE (TYPE_SIZE (TREE_TYPE (arg))) == INTEGER_CST
1779           && TREE_CODE (TREE_OPERAND (arg, 1)) == INTEGER_CST)
1780         return staticp (TREE_OPERAND (arg, 0));
1781     }
1782
1783   return 0;
1784 }
1785 \f
1786 /* This should be applied to any node which may be used in more than one place,
1787    but must be evaluated only once.  Normally, the code generator would
1788    reevaluate the node each time; this forces it to compute it once and save
1789    the result.  This is done by encapsulating the node in a SAVE_EXPR.  */
1790
1791 tree
1792 save_expr (expr)
1793      tree expr;
1794 {
1795   register tree t = fold (expr);
1796
1797   /* We don't care about whether this can be used as an lvalue in this
1798      context.  */
1799   while (TREE_CODE (t) == NON_LVALUE_EXPR)
1800     t = TREE_OPERAND (t, 0);
1801
1802   /* If the tree evaluates to a constant, then we don't want to hide that
1803      fact (i.e. this allows further folding, and direct checks for constants).
1804      However, a read-only object that has side effects cannot be bypassed.
1805      Since it is no problem to reevaluate literals, we just return the 
1806      literal node. */
1807
1808   if (TREE_CONSTANT (t) || (TREE_READONLY (t) && ! TREE_SIDE_EFFECTS (t))
1809       || TREE_CODE (t) == SAVE_EXPR)
1810     return t;
1811
1812   t = build (SAVE_EXPR, TREE_TYPE (expr), t, current_function_decl, NULL_TREE);
1813
1814   /* This expression might be placed ahead of a jump to ensure that the
1815      value was computed on both sides of the jump.  So make sure it isn't
1816      eliminated as dead.  */
1817   TREE_SIDE_EFFECTS (t) = 1;
1818   return t;
1819 }
1820
1821 /* Stabilize a reference so that we can use it any number of times
1822    without causing its operands to be evaluated more than once.
1823    Returns the stabilized reference.
1824
1825    Also allows conversion expressions whose operands are references.
1826    Any other kind of expression is returned unchanged.  */
1827
1828 tree
1829 stabilize_reference (ref)
1830      tree ref;
1831 {
1832   register tree result;
1833   register enum tree_code code = TREE_CODE (ref);
1834
1835   switch (code)
1836     {
1837     case VAR_DECL:
1838     case PARM_DECL:
1839     case RESULT_DECL:
1840       /* No action is needed in this case.  */
1841       return ref;
1842
1843     case NOP_EXPR:
1844     case CONVERT_EXPR:
1845     case FLOAT_EXPR:
1846     case FIX_TRUNC_EXPR:
1847     case FIX_FLOOR_EXPR:
1848     case FIX_ROUND_EXPR:
1849     case FIX_CEIL_EXPR:
1850       result = build_nt (code, stabilize_reference (TREE_OPERAND (ref, 0)));
1851       break;
1852
1853     case INDIRECT_REF:
1854       result = build_nt (INDIRECT_REF,
1855                          stabilize_reference_1 (TREE_OPERAND (ref, 0)));
1856       break;
1857
1858     case COMPONENT_REF:
1859       result = build_nt (COMPONENT_REF,
1860                          stabilize_reference (TREE_OPERAND (ref, 0)),
1861                          TREE_OPERAND (ref, 1));
1862       break;
1863
1864     case BIT_FIELD_REF:
1865       result = build_nt (BIT_FIELD_REF,
1866                          stabilize_reference (TREE_OPERAND (ref, 0)),
1867                          stabilize_reference_1 (TREE_OPERAND (ref, 1)),
1868                          stabilize_reference_1 (TREE_OPERAND (ref, 2)));
1869       break;
1870
1871     case ARRAY_REF:
1872       result = build_nt (ARRAY_REF,
1873                          stabilize_reference (TREE_OPERAND (ref, 0)),
1874                          stabilize_reference_1 (TREE_OPERAND (ref, 1)));
1875       break;
1876
1877       /* If arg isn't a kind of lvalue we recognize, make no change.
1878          Caller should recognize the error for an invalid lvalue.  */
1879     default:
1880       return ref;
1881
1882     case ERROR_MARK:
1883       return error_mark_node;
1884     }
1885
1886   TREE_TYPE (result) = TREE_TYPE (ref);
1887   TREE_READONLY (result) = TREE_READONLY (ref);
1888   TREE_SIDE_EFFECTS (result) = TREE_SIDE_EFFECTS (ref);
1889   TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
1890   TREE_RAISES (result) = TREE_RAISES (ref);
1891
1892   return result;
1893 }
1894
1895 /* Subroutine of stabilize_reference; this is called for subtrees of
1896    references.  Any expression with side-effects must be put in a SAVE_EXPR
1897    to ensure that it is only evaluated once.
1898
1899    We don't put SAVE_EXPR nodes around everything, because assigning very
1900    simple expressions to temporaries causes us to miss good opportunities
1901    for optimizations.  Among other things, the opportunity to fold in the
1902    addition of a constant into an addressing mode often gets lost, e.g.
1903    "y[i+1] += x;".  In general, we take the approach that we should not make
1904    an assignment unless we are forced into it - i.e., that any non-side effect
1905    operator should be allowed, and that cse should take care of coalescing
1906    multiple utterances of the same expression should that prove fruitful.  */
1907
1908 static tree
1909 stabilize_reference_1 (e)
1910      tree e;
1911 {
1912   register tree result;
1913   register int length;
1914   register enum tree_code code = TREE_CODE (e);
1915
1916   /* We cannot ignore const expressions because it might be a reference
1917      to a const array but whose index contains side-effects.  But we can
1918      ignore things that are actual constant or that already have been
1919      handled by this function.  */
1920
1921   if (TREE_CONSTANT (e) || code == SAVE_EXPR)
1922     return e;
1923
1924   switch (TREE_CODE_CLASS (code))
1925     {
1926     case 'x':
1927     case 't':
1928     case 'd':
1929     case 'b':
1930     case '<':
1931     case 's':
1932     case 'e':
1933     case 'r':
1934       /* If the expression has side-effects, then encase it in a SAVE_EXPR
1935          so that it will only be evaluated once.  */
1936       /* The reference (r) and comparison (<) classes could be handled as
1937          below, but it is generally faster to only evaluate them once.  */
1938       if (TREE_SIDE_EFFECTS (e))
1939         return save_expr (e);
1940       return e;
1941
1942     case 'c':
1943       /* Constants need no processing.  In fact, we should never reach
1944          here.  */
1945       return e;
1946       
1947     case '2':
1948       /* Recursively stabilize each operand.  */
1949       result = build_nt (code, stabilize_reference_1 (TREE_OPERAND (e, 0)),
1950                          stabilize_reference_1 (TREE_OPERAND (e, 1)));
1951       break;
1952
1953     case '1':
1954       /* Recursively stabilize each operand.  */
1955       result = build_nt (code, stabilize_reference_1 (TREE_OPERAND (e, 0)));
1956       break;
1957     }
1958   
1959   TREE_TYPE (result) = TREE_TYPE (e);
1960   TREE_READONLY (result) = TREE_READONLY (e);
1961   TREE_SIDE_EFFECTS (result) = TREE_SIDE_EFFECTS (e);
1962   TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
1963   TREE_RAISES (result) = TREE_RAISES (e);
1964
1965   return result;
1966 }
1967 \f
1968 /* Low-level constructors for expressions.  */
1969
1970 /* Build an expression of code CODE, data type TYPE,
1971    and operands as specified by the arguments ARG1 and following arguments.
1972    Expressions and reference nodes can be created this way.
1973    Constants, decls, types and misc nodes cannot be.  */
1974
1975 tree
1976 build (va_alist)
1977      va_dcl
1978 {
1979   va_list p;
1980   enum tree_code code;
1981   register tree t;
1982   register int length;
1983   register int i;
1984
1985   va_start (p);
1986
1987   code = va_arg (p, enum tree_code);
1988   t = make_node (code);
1989   length = tree_code_length[(int) code];
1990   TREE_TYPE (t) = va_arg (p, tree);
1991
1992   if (length == 2)
1993     {
1994       /* This is equivalent to the loop below, but faster.  */
1995       register tree arg0 = va_arg (p, tree);
1996       register tree arg1 = va_arg (p, tree);
1997       TREE_OPERAND (t, 0) = arg0;
1998       TREE_OPERAND (t, 1) = arg1;
1999       if ((arg0 && TREE_SIDE_EFFECTS (arg0))
2000           || (arg1 && TREE_SIDE_EFFECTS (arg1)))
2001         TREE_SIDE_EFFECTS (t) = 1;
2002       TREE_RAISES (t)
2003         = (arg0 && TREE_RAISES (arg0)) || (arg1 && TREE_RAISES (arg1));
2004     }
2005   else if (length == 1)
2006     {
2007       register tree arg0 = va_arg (p, tree);
2008
2009       /* Call build1 for this!  */
2010       if (TREE_CODE_CLASS (code) != 's')
2011         abort ();
2012       TREE_OPERAND (t, 0) = arg0;
2013       if (arg0 && TREE_SIDE_EFFECTS (arg0))
2014         TREE_SIDE_EFFECTS (t) = 1;
2015       TREE_RAISES (t) = (arg0 && TREE_RAISES (arg0));
2016     }
2017   else
2018     {
2019       for (i = 0; i < length; i++)
2020         {
2021           register tree operand = va_arg (p, tree);
2022           TREE_OPERAND (t, i) = operand;
2023           if (operand)
2024             {
2025               if (TREE_SIDE_EFFECTS (operand))
2026                 TREE_SIDE_EFFECTS (t) = 1;
2027               if (TREE_RAISES (operand))
2028                 TREE_RAISES (t) = 1;
2029             }
2030         }
2031     }
2032   va_end (p);
2033   return t;
2034 }
2035
2036 /* Same as above, but only builds for unary operators.
2037    Saves lions share of calls to `build'; cuts down use
2038    of varargs, which is expensive for RISC machines.  */
2039 tree
2040 build1 (code, type, node)
2041      enum tree_code code;
2042      tree type;
2043      tree node;
2044 {
2045   register struct obstack *obstack = current_obstack;
2046   register int i, length;
2047   register tree_node_kind kind;
2048   register tree t;
2049
2050 #ifdef GATHER_STATISTICS
2051   if (TREE_CODE_CLASS (code) == 'r')
2052     kind = r_kind;
2053   else
2054     kind = e_kind;
2055 #endif
2056
2057   obstack = expression_obstack;
2058   length = sizeof (struct tree_exp);
2059
2060   t = (tree) obstack_alloc (obstack, length);
2061
2062 #ifdef GATHER_STATISTICS
2063   tree_node_counts[(int)kind]++;
2064   tree_node_sizes[(int)kind] += length;
2065 #endif
2066
2067   for (i = (length / sizeof (int)) - 1; i >= 0; i--)
2068     ((int *) t)[i] = 0;
2069
2070   TREE_TYPE (t) = type;
2071   TREE_SET_CODE (t, code);
2072
2073   if (obstack == &permanent_obstack)
2074     TREE_PERMANENT (t) = 1;
2075
2076   TREE_OPERAND (t, 0) = node;
2077   if (node)
2078     {
2079       if (TREE_SIDE_EFFECTS (node))
2080         TREE_SIDE_EFFECTS (t) = 1;
2081       if (TREE_RAISES (node))
2082         TREE_RAISES (t) = 1;
2083     }
2084
2085   return t;
2086 }
2087
2088 /* Similar except don't specify the TREE_TYPE
2089    and leave the TREE_SIDE_EFFECTS as 0.
2090    It is permissible for arguments to be null,
2091    or even garbage if their values do not matter.  */
2092
2093 tree
2094 build_nt (va_alist)
2095      va_dcl
2096 {
2097   va_list p;
2098   register enum tree_code code;
2099   register tree t;
2100   register int length;
2101   register int i;
2102
2103   va_start (p);
2104
2105   code = va_arg (p, enum tree_code);
2106   t = make_node (code);
2107   length = tree_code_length[(int) code];
2108
2109   for (i = 0; i < length; i++)
2110     TREE_OPERAND (t, i) = va_arg (p, tree);
2111
2112   va_end (p);
2113   return t;
2114 }
2115
2116 /* Similar to `build_nt', except we build
2117    on the temp_decl_obstack, regardless.  */
2118
2119 tree
2120 build_parse_node (va_alist)
2121      va_dcl
2122 {
2123   register struct obstack *ambient_obstack = expression_obstack;
2124   va_list p;
2125   register enum tree_code code;
2126   register tree t;
2127   register int length;
2128   register int i;
2129
2130   expression_obstack = &temp_decl_obstack;
2131
2132   va_start (p);
2133
2134   code = va_arg (p, enum tree_code);
2135   t = make_node (code);
2136   length = tree_code_length[(int) code];
2137
2138   for (i = 0; i < length; i++)
2139     TREE_OPERAND (t, i) = va_arg (p, tree);
2140
2141   va_end (p);
2142   expression_obstack = ambient_obstack;
2143   return t;
2144 }
2145
2146 #if 0
2147 /* Commented out because this wants to be done very
2148    differently.  See cp-lex.c.  */
2149 tree
2150 build_op_identifier (op1, op2)
2151      tree op1, op2;
2152 {
2153   register tree t = make_node (OP_IDENTIFIER);
2154   TREE_PURPOSE (t) = op1;
2155   TREE_VALUE (t) = op2;
2156   return t;
2157 }
2158 #endif
2159 \f
2160 /* Create a DECL_... node of code CODE, name NAME and data type TYPE.
2161    We do NOT enter this node in any sort of symbol table.
2162
2163    layout_decl is used to set up the decl's storage layout.
2164    Other slots are initialized to 0 or null pointers.  */
2165
2166 tree
2167 build_decl (code, name, type)
2168      enum tree_code code;
2169      tree name, type;
2170 {
2171   register tree t;
2172
2173   t = make_node (code);
2174
2175 /*  if (type == error_mark_node)
2176     type = integer_type_node; */
2177 /* That is not done, deliberately, so that having error_mark_node
2178    as the type can suppress useless errors in the use of this variable.  */
2179
2180   DECL_NAME (t) = name;
2181   DECL_ASSEMBLER_NAME (t) = name;
2182   TREE_TYPE (t) = type;
2183
2184   if (code == VAR_DECL || code == PARM_DECL || code == RESULT_DECL)
2185     layout_decl (t, 0);
2186   else if (code == FUNCTION_DECL)
2187     DECL_MODE (t) = FUNCTION_MODE;
2188
2189   return t;
2190 }
2191 \f
2192 /* BLOCK nodes are used to represent the structure of binding contours
2193    and declarations, once those contours have been exited and their contents
2194    compiled.  This information is used for outputting debugging info.  */
2195
2196 tree
2197 build_block (vars, tags, subblocks, supercontext, chain)
2198      tree vars, tags, subblocks, supercontext, chain;
2199 {
2200   register tree block = make_node (BLOCK);
2201   BLOCK_VARS (block) = vars;
2202   BLOCK_TYPE_TAGS (block) = tags;
2203   BLOCK_SUBBLOCKS (block) = subblocks;
2204   BLOCK_SUPERCONTEXT (block) = supercontext;
2205   BLOCK_CHAIN (block) = chain;
2206   return block;
2207 }
2208 \f
2209 /* Return a type like TYPE except that its TYPE_READONLY is CONSTP
2210    and its TYPE_VOLATILE is VOLATILEP.
2211
2212    Such variant types already made are recorded so that duplicates
2213    are not made.
2214
2215    A variant types should never be used as the type of an expression.
2216    Always copy the variant information into the TREE_READONLY
2217    and TREE_THIS_VOLATILE of the expression, and then give the expression
2218    as its type the "main variant", the variant whose TYPE_READONLY
2219    and TYPE_VOLATILE are zero.  Use TYPE_MAIN_VARIANT to find the
2220    main variant.  */
2221
2222 tree
2223 build_type_variant (type, constp, volatilep)
2224      tree type;
2225      int constp, volatilep;
2226 {
2227   register tree t, m = TYPE_MAIN_VARIANT (type);
2228   register struct obstack *ambient_obstack = current_obstack;
2229
2230   /* Treat any nonzero argument as 1.  */
2231   constp = !!constp;
2232   volatilep = !!volatilep;
2233
2234   /* If not generating auxiliary info, search the chain of variants to see
2235      if there is already one there just like the one we need to have.  If so,
2236      use that existing one.
2237
2238      We don't do this in the case where we are generating aux info because
2239      in that case we want each typedef names to get it's own distinct type
2240      node, even if the type of this new typedef is the same as some other
2241      (existing) type.  */
2242
2243   if (!flag_gen_aux_info)
2244     for (t = m; t; t = TYPE_NEXT_VARIANT (t))
2245       if (constp == TYPE_READONLY (t) && volatilep == TYPE_VOLATILE (t))
2246         return t;
2247
2248   /* We need a new one.  */
2249   current_obstack
2250     = TREE_PERMANENT (type) ? &permanent_obstack : saveable_obstack;
2251
2252   t = copy_node (type);
2253   TYPE_READONLY (t) = constp;
2254   TYPE_VOLATILE (t) = volatilep;
2255   TYPE_POINTER_TO (t) = 0;
2256   TYPE_REFERENCE_TO (t) = 0;
2257
2258   /* Add this type to the chain of variants of TYPE.  */
2259   TYPE_NEXT_VARIANT (t) = TYPE_NEXT_VARIANT (m);
2260   TYPE_NEXT_VARIANT (m) = t;
2261
2262   current_obstack = ambient_obstack;
2263   return t;
2264 }
2265
2266 /* Create a new variant of TYPE, equivalent but distinct.
2267    This is so the caller can modify it.  */
2268
2269 tree
2270 build_type_copy (type)
2271      tree type;
2272 {
2273   register tree t, m = TYPE_MAIN_VARIANT (type);
2274   register struct obstack *ambient_obstack = current_obstack;
2275
2276   current_obstack
2277     = TREE_PERMANENT (type) ? &permanent_obstack : saveable_obstack;
2278
2279   t = copy_node (type);
2280   TYPE_POINTER_TO (t) = 0;
2281   TYPE_REFERENCE_TO (t) = 0;
2282
2283   /* Add this type to the chain of variants of TYPE.  */
2284   TYPE_NEXT_VARIANT (t) = TYPE_NEXT_VARIANT (m);
2285   TYPE_NEXT_VARIANT (m) = t;
2286
2287   current_obstack = ambient_obstack;
2288   return t;
2289 }
2290 \f
2291 /* Hashing of types so that we don't make duplicates.
2292    The entry point is `type_hash_canon'.  */
2293
2294 /* Each hash table slot is a bucket containing a chain
2295    of these structures.  */
2296
2297 struct type_hash
2298 {
2299   struct type_hash *next;       /* Next structure in the bucket.  */
2300   int hashcode;                 /* Hash code of this type.  */
2301   tree type;                    /* The type recorded here.  */
2302 };
2303
2304 /* Now here is the hash table.  When recording a type, it is added
2305    to the slot whose index is the hash code mod the table size.
2306    Note that the hash table is used for several kinds of types
2307    (function types, array types and array index range types, for now).
2308    While all these live in the same table, they are completely independent,
2309    and the hash code is computed differently for each of these.  */
2310
2311 #define TYPE_HASH_SIZE 59
2312 struct type_hash *type_hash_table[TYPE_HASH_SIZE];
2313
2314 /* Here is how primitive or already-canonicalized types' hash
2315    codes are made.  */
2316 #define TYPE_HASH(TYPE) ((HOST_WIDE_INT) (TYPE) & 0777777)
2317
2318 /* Compute a hash code for a list of types (chain of TREE_LIST nodes
2319    with types in the TREE_VALUE slots), by adding the hash codes
2320    of the individual types.  */
2321
2322 int
2323 type_hash_list (list)
2324      tree list;
2325 {
2326   register int hashcode;
2327   register tree tail;
2328   for (hashcode = 0, tail = list; tail; tail = TREE_CHAIN (tail))
2329     hashcode += TYPE_HASH (TREE_VALUE (tail));
2330   return hashcode;
2331 }
2332
2333 /* Look in the type hash table for a type isomorphic to TYPE.
2334    If one is found, return it.  Otherwise return 0.  */
2335
2336 tree
2337 type_hash_lookup (hashcode, type)
2338      int hashcode;
2339      tree type;
2340 {
2341   register struct type_hash *h;
2342   for (h = type_hash_table[hashcode % TYPE_HASH_SIZE]; h; h = h->next)
2343     if (h->hashcode == hashcode
2344         && TREE_CODE (h->type) == TREE_CODE (type)
2345         && TREE_TYPE (h->type) == TREE_TYPE (type)
2346         && (TYPE_MAX_VALUE (h->type) == TYPE_MAX_VALUE (type)
2347             || tree_int_cst_equal (TYPE_MAX_VALUE (h->type),
2348                                    TYPE_MAX_VALUE (type)))
2349         && (TYPE_MIN_VALUE (h->type) == TYPE_MIN_VALUE (type)
2350             || tree_int_cst_equal (TYPE_MIN_VALUE (h->type),
2351                                    TYPE_MIN_VALUE (type)))
2352         && (TYPE_DOMAIN (h->type) == TYPE_DOMAIN (type)
2353             || (TYPE_DOMAIN (h->type)
2354                 && TREE_CODE (TYPE_DOMAIN (h->type)) == TREE_LIST
2355                 && TYPE_DOMAIN (type)
2356                 && TREE_CODE (TYPE_DOMAIN (type)) == TREE_LIST
2357                 && type_list_equal (TYPE_DOMAIN (h->type), TYPE_DOMAIN (type)))))
2358       return h->type;
2359   return 0;
2360 }
2361
2362 /* Add an entry to the type-hash-table
2363    for a type TYPE whose hash code is HASHCODE.  */
2364
2365 void
2366 type_hash_add (hashcode, type)
2367      int hashcode;
2368      tree type;
2369 {
2370   register struct type_hash *h;
2371
2372   h = (struct type_hash *) oballoc (sizeof (struct type_hash));
2373   h->hashcode = hashcode;
2374   h->type = type;
2375   h->next = type_hash_table[hashcode % TYPE_HASH_SIZE];
2376   type_hash_table[hashcode % TYPE_HASH_SIZE] = h;
2377 }
2378
2379 /* Given TYPE, and HASHCODE its hash code, return the canonical
2380    object for an identical type if one already exists.
2381    Otherwise, return TYPE, and record it as the canonical object
2382    if it is a permanent object.
2383
2384    To use this function, first create a type of the sort you want.
2385    Then compute its hash code from the fields of the type that
2386    make it different from other similar types.
2387    Then call this function and use the value.
2388    This function frees the type you pass in if it is a duplicate.  */
2389
2390 /* Set to 1 to debug without canonicalization.  Never set by program.  */
2391 int debug_no_type_hash = 0;
2392
2393 tree
2394 type_hash_canon (hashcode, type)
2395      int hashcode;
2396      tree type;
2397 {
2398   tree t1;
2399
2400   if (debug_no_type_hash)
2401     return type;
2402
2403   t1 = type_hash_lookup (hashcode, type);
2404   if (t1 != 0)
2405     {
2406       struct obstack *o
2407         = TREE_PERMANENT (type) ? &permanent_obstack : saveable_obstack;
2408       obstack_free (o, type);
2409 #ifdef GATHER_STATISTICS
2410       tree_node_counts[(int)t_kind]--;
2411       tree_node_sizes[(int)t_kind] -= sizeof (struct tree_type);
2412 #endif
2413       return t1;
2414     }
2415
2416   /* If this is a new type, record it for later reuse.  */
2417   if (current_obstack == &permanent_obstack)
2418     type_hash_add (hashcode, type);
2419
2420   return type;
2421 }
2422
2423 /* Given two lists of types
2424    (chains of TREE_LIST nodes with types in the TREE_VALUE slots)
2425    return 1 if the lists contain the same types in the same order.
2426    Also, the TREE_PURPOSEs must match.  */
2427
2428 int
2429 type_list_equal (l1, l2)
2430      tree l1, l2;
2431 {
2432   register tree t1, t2;
2433   for (t1 = l1, t2 = l2; t1 && t2; t1 = TREE_CHAIN (t1), t2 = TREE_CHAIN (t2))
2434     {
2435       if (TREE_VALUE (t1) != TREE_VALUE (t2))
2436         return 0;
2437       if (TREE_PURPOSE (t1) != TREE_PURPOSE (t2))
2438         {
2439           int cmp = simple_cst_equal (TREE_PURPOSE (t1), TREE_PURPOSE (t2));
2440           if (cmp < 0)
2441             abort ();
2442           if (cmp == 0)
2443             return 0;
2444         }
2445     }
2446
2447   return t1 == t2;
2448 }
2449
2450 /* Nonzero if integer constants T1 and T2
2451    represent the same constant value.  */
2452
2453 int
2454 tree_int_cst_equal (t1, t2)
2455      tree t1, t2;
2456 {
2457   if (t1 == t2)
2458     return 1;
2459   if (t1 == 0 || t2 == 0)
2460     return 0;
2461   if (TREE_CODE (t1) == INTEGER_CST
2462       && TREE_CODE (t2) == INTEGER_CST
2463       && TREE_INT_CST_LOW (t1) == TREE_INT_CST_LOW (t2)
2464       && TREE_INT_CST_HIGH (t1) == TREE_INT_CST_HIGH (t2))
2465     return 1;
2466   return 0;
2467 }
2468
2469 /* Nonzero if integer constants T1 and T2 represent values that satisfy <.
2470    The precise way of comparison depends on their data type.  */
2471
2472 int
2473 tree_int_cst_lt (t1, t2)
2474      tree t1, t2;
2475 {
2476   if (t1 == t2)
2477     return 0;
2478
2479   if (!TREE_UNSIGNED (TREE_TYPE (t1)))
2480     return INT_CST_LT (t1, t2);
2481   return INT_CST_LT_UNSIGNED (t1, t2);
2482 }
2483
2484 /* Compare two constructor-element-type constants.  */
2485 int
2486 simple_cst_list_equal (l1, l2)
2487      tree l1, l2;
2488 {
2489   while (l1 != NULL_TREE && l2 != NULL_TREE)
2490     {
2491       int cmp = simple_cst_equal (TREE_VALUE (l1), TREE_VALUE (l2));
2492       if (cmp < 0)
2493         abort ();
2494       if (cmp == 0)
2495         return 0;
2496       l1 = TREE_CHAIN (l1);
2497       l2 = TREE_CHAIN (l2);
2498     }
2499   return (l1 == l2);
2500 }
2501
2502 /* Return truthvalue of whether T1 is the same tree structure as T2.
2503    Return 1 if they are the same.
2504    Return 0 if they are understandably different.
2505    Return -1 if either contains tree structure not understood by
2506    this function.  */
2507
2508 int
2509 simple_cst_equal (t1, t2)
2510      tree t1, t2;
2511 {
2512   register enum tree_code code1, code2;
2513   int cmp;
2514
2515   if (t1 == t2)
2516     return 1;
2517   if (t1 == 0 || t2 == 0)
2518     return 0;
2519
2520   code1 = TREE_CODE (t1);
2521   code2 = TREE_CODE (t2);
2522
2523   if (code1 == NOP_EXPR || code1 == CONVERT_EXPR || code1 == NON_LVALUE_EXPR)
2524     if (code2 == NOP_EXPR || code2 == CONVERT_EXPR || code2 == NON_LVALUE_EXPR)
2525       return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
2526     else
2527       return simple_cst_equal (TREE_OPERAND (t1, 0), t2);
2528   else if (code2 == NOP_EXPR || code2 == CONVERT_EXPR
2529            || code2 == NON_LVALUE_EXPR)
2530     return simple_cst_equal (t1, TREE_OPERAND (t2, 0));
2531
2532   if (code1 != code2)
2533     return 0;
2534
2535   switch (code1)
2536     {
2537     case INTEGER_CST:
2538       return TREE_INT_CST_LOW (t1) == TREE_INT_CST_LOW (t2)
2539         && TREE_INT_CST_HIGH (t1) == TREE_INT_CST_HIGH (t2);
2540
2541     case REAL_CST:
2542       return REAL_VALUES_EQUAL (TREE_REAL_CST (t1), TREE_REAL_CST (t2));
2543
2544     case STRING_CST:
2545       return TREE_STRING_LENGTH (t1) == TREE_STRING_LENGTH (t2)
2546         && !bcmp (TREE_STRING_POINTER (t1), TREE_STRING_POINTER (t2),
2547                   TREE_STRING_LENGTH (t1));
2548
2549     case CONSTRUCTOR:
2550       abort ();
2551
2552     case SAVE_EXPR:
2553       return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
2554
2555     case CALL_EXPR:
2556       cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
2557       if (cmp <= 0)
2558         return cmp;
2559       return simple_cst_list_equal (TREE_OPERAND (t1, 1), TREE_OPERAND (t2, 1));
2560
2561     case TARGET_EXPR:
2562       /* Special case: if either target is an unallocated VAR_DECL,
2563          it means that it's going to be unified with whatever the
2564          TARGET_EXPR is really supposed to initialize, so treat it
2565          as being equivalent to anything.  */
2566       if ((TREE_CODE (TREE_OPERAND (t1, 0)) == VAR_DECL
2567            && DECL_NAME (TREE_OPERAND (t1, 0)) == NULL_TREE
2568            && DECL_RTL (TREE_OPERAND (t1, 0)) == 0)
2569           || (TREE_CODE (TREE_OPERAND (t2, 0)) == VAR_DECL
2570               && DECL_NAME (TREE_OPERAND (t2, 0)) == NULL_TREE
2571               && DECL_RTL (TREE_OPERAND (t2, 0)) == 0))
2572         cmp = 1;
2573       else
2574         cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
2575       if (cmp <= 0)
2576         return cmp;
2577       return simple_cst_equal (TREE_OPERAND (t1, 1), TREE_OPERAND (t2, 1));
2578
2579     case WITH_CLEANUP_EXPR:
2580       cmp = simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
2581       if (cmp <= 0)
2582         return cmp;
2583       return simple_cst_equal (TREE_OPERAND (t1, 2), TREE_OPERAND (t1, 2));
2584
2585     case COMPONENT_REF:
2586       if (TREE_OPERAND (t1, 1) == TREE_OPERAND (t2, 1))
2587         return simple_cst_equal (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0));
2588       return 0;
2589
2590     case VAR_DECL:
2591     case PARM_DECL:
2592     case CONST_DECL:
2593     case FUNCTION_DECL:
2594       return 0;
2595     }
2596
2597   /* This general rule works for most tree codes.
2598      All exceptions should be handled above.  */
2599
2600   switch (TREE_CODE_CLASS (code1))
2601     {
2602       int i;
2603     case '1':
2604     case '2':
2605     case '<':
2606     case 'e':
2607     case 'r':
2608     case 's':
2609       cmp = 1;
2610       for (i=0; i<tree_code_length[(int) code1]; ++i)
2611         {
2612           cmp = simple_cst_equal (TREE_OPERAND (t1, i), TREE_OPERAND (t2, i));
2613           if (cmp <= 0)
2614             return cmp;
2615         }
2616       return cmp;
2617     }
2618
2619   return -1;
2620 }
2621 \f
2622 /* Constructors for pointer, array and function types.
2623    (RECORD_TYPE, UNION_TYPE and ENUMERAL_TYPE nodes are
2624    constructed by language-dependent code, not here.)  */
2625
2626 /* Construct, lay out and return the type of pointers to TO_TYPE.
2627    If such a type has already been constructed, reuse it.  */
2628
2629 tree
2630 build_pointer_type (to_type)
2631      tree to_type;
2632 {
2633   register tree t = TYPE_POINTER_TO (to_type);
2634   register struct obstack *ambient_obstack = current_obstack;
2635   register struct obstack *ambient_saveable_obstack = saveable_obstack;
2636
2637   /* First, if we already have a type for pointers to TO_TYPE, use it.  */
2638
2639   if (t)
2640     return t;
2641
2642   /* We need a new one.  If TO_TYPE is permanent, make this permanent too.  */
2643   if (TREE_PERMANENT (to_type))
2644     {
2645       current_obstack = &permanent_obstack;
2646       saveable_obstack = &permanent_obstack;
2647     }
2648
2649   t = make_node (POINTER_TYPE);
2650   TREE_TYPE (t) = to_type;
2651
2652   /* Record this type as the pointer to TO_TYPE.  */
2653   TYPE_POINTER_TO (to_type) = t;
2654
2655   /* Lay out the type.  This function has many callers that are concerned
2656      with expression-construction, and this simplifies them all.
2657      Also, it guarantees the TYPE_SIZE is permanent if the type is.  */
2658   layout_type (t);
2659
2660   current_obstack = ambient_obstack;
2661   saveable_obstack = ambient_saveable_obstack;
2662   return t;
2663 }
2664
2665 /* Create a type of integers to be the TYPE_DOMAIN of an ARRAY_TYPE.
2666    MAXVAL should be the maximum value in the domain
2667    (one less than the length of the array).  */
2668
2669 tree
2670 build_index_type (maxval)
2671      tree maxval;
2672 {
2673   register tree itype = make_node (INTEGER_TYPE);
2674   TYPE_PRECISION (itype) = TYPE_PRECISION (sizetype);
2675   TYPE_MIN_VALUE (itype) = build_int_2 (0, 0);
2676   TREE_TYPE (TYPE_MIN_VALUE (itype)) = sizetype;
2677   TYPE_MAX_VALUE (itype) = convert (sizetype, maxval);
2678   TYPE_MODE (itype) = TYPE_MODE (sizetype);
2679   TYPE_SIZE (itype) = TYPE_SIZE (sizetype);
2680   TYPE_ALIGN (itype) = TYPE_ALIGN (sizetype);
2681   if (TREE_CODE (maxval) == INTEGER_CST)
2682     {
2683       int maxint = (int) TREE_INT_CST_LOW (maxval);
2684       /* If the domain should be empty, make sure the maxval
2685          remains -1 and is not spoiled by truncation.  */
2686       if (INT_CST_LT (maxval, integer_zero_node))
2687         {
2688           TYPE_MAX_VALUE (itype) = build_int_2 (-1, -1);
2689           TREE_TYPE (TYPE_MAX_VALUE (itype)) = sizetype;
2690         }
2691       return type_hash_canon (maxint < 0 ? ~maxint : maxint, itype);
2692     }
2693   else
2694     return itype;
2695 }
2696
2697 /* Just like build_index_type, but takes lowval and highval instead
2698    of just highval (maxval). */
2699
2700 tree
2701 build_index_2_type (lowval,highval)
2702      tree lowval, highval;
2703 {
2704   register tree itype = make_node (INTEGER_TYPE);
2705   TYPE_PRECISION (itype) = TYPE_PRECISION (sizetype);
2706   TYPE_MIN_VALUE (itype) = convert (sizetype, lowval);
2707   TYPE_MAX_VALUE (itype) = convert (sizetype, highval);
2708   TYPE_MODE (itype) = TYPE_MODE (sizetype);
2709   TYPE_SIZE (itype) = TYPE_SIZE (sizetype);
2710   TYPE_ALIGN (itype) = TYPE_ALIGN (sizetype);
2711   if ((TREE_CODE (lowval) == INTEGER_CST)
2712       && (TREE_CODE (highval) == INTEGER_CST))
2713     {
2714       HOST_WIDE_INT highint = TREE_INT_CST_LOW (highval);
2715       HOST_WIDE_INT lowint = TREE_INT_CST_LOW (lowval);
2716       int maxint = (int) (highint - lowint);
2717       return type_hash_canon (maxint < 0 ? ~maxint : maxint, itype);
2718     }
2719   else
2720     return itype;
2721 }
2722
2723 /* Return nonzero iff ITYPE1 and ITYPE2 are equal (in the LISP sense).
2724    Needed because when index types are not hashed, equal index types
2725    built at different times appear distinct, even though structurally,
2726    they are not.  */
2727
2728 int
2729 index_type_equal (itype1, itype2)
2730      tree itype1, itype2;
2731 {
2732   if (TREE_CODE (itype1) != TREE_CODE (itype2))
2733     return 0;
2734   if (TREE_CODE (itype1) == INTEGER_TYPE)
2735     {
2736       if (TYPE_PRECISION (itype1) != TYPE_PRECISION (itype2)
2737           || TYPE_MODE (itype1) != TYPE_MODE (itype2)
2738           || ! simple_cst_equal (TYPE_SIZE (itype1), TYPE_SIZE (itype2))
2739           || TYPE_ALIGN (itype1) != TYPE_ALIGN (itype2))
2740         return 0;
2741       if (simple_cst_equal (TYPE_MIN_VALUE (itype1), TYPE_MIN_VALUE (itype2))
2742           && simple_cst_equal (TYPE_MAX_VALUE (itype1), TYPE_MAX_VALUE (itype2)))
2743         return 1;
2744     }
2745   return 0;
2746 }
2747
2748 /* Construct, lay out and return the type of arrays of elements with ELT_TYPE
2749    and number of elements specified by the range of values of INDEX_TYPE.
2750    If such a type has already been constructed, reuse it.  */
2751
2752 tree
2753 build_array_type (elt_type, index_type)
2754      tree elt_type, index_type;
2755 {
2756   register tree t;
2757   int hashcode;
2758
2759   if (TREE_CODE (elt_type) == FUNCTION_TYPE)
2760     {
2761       error ("arrays of functions are not meaningful");
2762       elt_type = integer_type_node;
2763     }
2764
2765   /* Make sure TYPE_POINTER_TO (elt_type) is filled in.  */
2766   build_pointer_type (elt_type);
2767
2768   /* Allocate the array after the pointer type,
2769      in case we free it in type_hash_canon.  */
2770   t = make_node (ARRAY_TYPE);
2771   TREE_TYPE (t) = elt_type;
2772   TYPE_DOMAIN (t) = index_type;
2773
2774   if (index_type == 0)
2775     return t;
2776
2777   hashcode = TYPE_HASH (elt_type) + TYPE_HASH (index_type);
2778   t = type_hash_canon (hashcode, t);
2779
2780   if (TYPE_SIZE (t) == 0)
2781     layout_type (t);
2782   return t;
2783 }
2784
2785 /* Construct, lay out and return
2786    the type of functions returning type VALUE_TYPE
2787    given arguments of types ARG_TYPES.
2788    ARG_TYPES is a chain of TREE_LIST nodes whose TREE_VALUEs
2789    are data type nodes for the arguments of the function.
2790    If such a type has already been constructed, reuse it.  */
2791
2792 tree
2793 build_function_type (value_type, arg_types)
2794      tree value_type, arg_types;
2795 {
2796   register tree t;
2797   int hashcode;
2798
2799   if (TREE_CODE (value_type) == FUNCTION_TYPE
2800       || TREE_CODE (value_type) == ARRAY_TYPE)
2801     {
2802       error ("function return type cannot be function or array");
2803       value_type = integer_type_node;
2804     }
2805
2806   /* Make a node of the sort we want.  */
2807   t = make_node (FUNCTION_TYPE);
2808   TREE_TYPE (t) = value_type;
2809   TYPE_ARG_TYPES (t) = arg_types;
2810
2811   /* If we already have such a type, use the old one and free this one.  */
2812   hashcode = TYPE_HASH (value_type) + type_hash_list (arg_types);
2813   t = type_hash_canon (hashcode, t);
2814
2815   if (TYPE_SIZE (t) == 0)
2816     layout_type (t);
2817   return t;
2818 }
2819
2820 /* Build the node for the type of references-to-TO_TYPE.  */
2821
2822 tree
2823 build_reference_type (to_type)
2824      tree to_type;
2825 {
2826   register tree t = TYPE_REFERENCE_TO (to_type);
2827   register struct obstack *ambient_obstack = current_obstack;
2828   register struct obstack *ambient_saveable_obstack = saveable_obstack;
2829
2830   /* First, if we already have a type for pointers to TO_TYPE, use it.  */
2831
2832   if (t)
2833     return t;
2834
2835   /* We need a new one.  If TO_TYPE is permanent, make this permanent too.  */
2836   if (TREE_PERMANENT (to_type))
2837     {
2838       current_obstack = &permanent_obstack;
2839       saveable_obstack = &permanent_obstack;
2840     }
2841
2842   t = make_node (REFERENCE_TYPE);
2843   TREE_TYPE (t) = to_type;
2844
2845   /* Record this type as the pointer to TO_TYPE.  */
2846   TYPE_REFERENCE_TO (to_type) = t;
2847
2848   layout_type (t);
2849
2850   current_obstack = ambient_obstack;
2851   saveable_obstack = ambient_saveable_obstack;
2852   return t;
2853 }
2854
2855 /* Construct, lay out and return the type of methods belonging to class
2856    BASETYPE and whose arguments and values are described by TYPE.
2857    If that type exists already, reuse it.
2858    TYPE must be a FUNCTION_TYPE node.  */
2859
2860 tree
2861 build_method_type (basetype, type)
2862      tree basetype, type;
2863 {
2864   register tree t;
2865   int hashcode;
2866
2867   /* Make a node of the sort we want.  */
2868   t = make_node (METHOD_TYPE);
2869
2870   if (TREE_CODE (type) != FUNCTION_TYPE)
2871     abort ();
2872
2873   TYPE_METHOD_BASETYPE (t) = TYPE_MAIN_VARIANT (basetype);
2874   TREE_TYPE (t) = TREE_TYPE (type);
2875
2876   /* The actual arglist for this function includes a "hidden" argument
2877      which is "this".  Put it into the list of argument types.  */
2878
2879   TYPE_ARG_TYPES (t)
2880     = tree_cons (NULL_TREE,
2881                  build_pointer_type (basetype), TYPE_ARG_TYPES (type));
2882
2883   /* If we already have such a type, use the old one and free this one.  */
2884   hashcode = TYPE_HASH (basetype) + TYPE_HASH (type);
2885   t = type_hash_canon (hashcode, t);
2886
2887   if (TYPE_SIZE (t) == 0)
2888     layout_type (t);
2889
2890   return t;
2891 }
2892
2893 /* Construct, lay out and return the type of offsets to a value
2894    of type TYPE, within an object of type BASETYPE.
2895    If a suitable offset type exists already, reuse it.  */
2896
2897 tree
2898 build_offset_type (basetype, type)
2899      tree basetype, type;
2900 {
2901   register tree t;
2902   int hashcode;
2903
2904   /* Make a node of the sort we want.  */
2905   t = make_node (OFFSET_TYPE);
2906
2907   TYPE_OFFSET_BASETYPE (t) = TYPE_MAIN_VARIANT (basetype);
2908   TREE_TYPE (t) = type;
2909
2910   /* If we already have such a type, use the old one and free this one.  */
2911   hashcode = TYPE_HASH (basetype) + TYPE_HASH (type);
2912   t = type_hash_canon (hashcode, t);
2913
2914   if (TYPE_SIZE (t) == 0)
2915     layout_type (t);
2916
2917   return t;
2918 }
2919
2920 /* Create a complex type whose components are COMPONENT_TYPE.  */
2921
2922 tree
2923 build_complex_type (component_type)
2924      tree component_type;
2925 {
2926   register tree t;
2927   int hashcode;
2928
2929   /* Make a node of the sort we want.  */
2930   t = make_node (COMPLEX_TYPE);
2931
2932   TREE_TYPE (t) = TYPE_MAIN_VARIANT (component_type);
2933   TYPE_VOLATILE (t) = TYPE_VOLATILE (component_type);
2934   TYPE_READONLY (t) = TYPE_READONLY (component_type);
2935
2936   /* If we already have such a type, use the old one and free this one.  */
2937   hashcode = TYPE_HASH (component_type);
2938   t = type_hash_canon (hashcode, t);
2939
2940   if (TYPE_SIZE (t) == 0)
2941     layout_type (t);
2942
2943   return t;
2944 }
2945 \f
2946 /* Return OP, stripped of any conversions to wider types as much as is safe.
2947    Converting the value back to OP's type makes a value equivalent to OP.
2948
2949    If FOR_TYPE is nonzero, we return a value which, if converted to
2950    type FOR_TYPE, would be equivalent to converting OP to type FOR_TYPE.
2951
2952    If FOR_TYPE is nonzero, unaligned bit-field references may be changed to the
2953    narrowest type that can hold the value, even if they don't exactly fit.
2954    Otherwise, bit-field references are changed to a narrower type
2955    only if they can be fetched directly from memory in that type.
2956
2957    OP must have integer, real or enumeral type.  Pointers are not allowed!
2958
2959    There are some cases where the obvious value we could return
2960    would regenerate to OP if converted to OP's type, 
2961    but would not extend like OP to wider types.
2962    If FOR_TYPE indicates such extension is contemplated, we eschew such values.
2963    For example, if OP is (unsigned short)(signed char)-1,
2964    we avoid returning (signed char)-1 if FOR_TYPE is int,
2965    even though extending that to an unsigned short would regenerate OP,
2966    since the result of extending (signed char)-1 to (int)
2967    is different from (int) OP.  */
2968
2969 tree
2970 get_unwidened (op, for_type)
2971      register tree op;
2972      tree for_type;
2973 {
2974   /* Set UNS initially if converting OP to FOR_TYPE is a zero-extension.  */
2975   /* TYPE_PRECISION is safe in place of type_precision since
2976      pointer types are not allowed.  */
2977   register tree type = TREE_TYPE (op);
2978   register unsigned final_prec
2979     = TYPE_PRECISION (for_type != 0 ? for_type : type);
2980   register int uns
2981     = (for_type != 0 && for_type != type
2982        && final_prec > TYPE_PRECISION (type)
2983        && TREE_UNSIGNED (type));
2984   register tree win = op;
2985
2986   while (TREE_CODE (op) == NOP_EXPR)
2987     {
2988       register int bitschange
2989         = TYPE_PRECISION (TREE_TYPE (op))
2990           - TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (op, 0)));
2991
2992       /* Truncations are many-one so cannot be removed.
2993          Unless we are later going to truncate down even farther.  */
2994       if (bitschange < 0
2995           && final_prec > TYPE_PRECISION (TREE_TYPE (op)))
2996         break;
2997
2998       /* See what's inside this conversion.  If we decide to strip it,
2999          we will set WIN.  */
3000       op = TREE_OPERAND (op, 0);
3001
3002       /* If we have not stripped any zero-extensions (uns is 0),
3003          we can strip any kind of extension.
3004          If we have previously stripped a zero-extension,
3005          only zero-extensions can safely be stripped.
3006          Any extension can be stripped if the bits it would produce
3007          are all going to be discarded later by truncating to FOR_TYPE.  */
3008
3009       if (bitschange > 0)
3010         {
3011           if (! uns || final_prec <= TYPE_PRECISION (TREE_TYPE (op)))
3012             win = op;
3013           /* TREE_UNSIGNED says whether this is a zero-extension.
3014              Let's avoid computing it if it does not affect WIN
3015              and if UNS will not be needed again.  */
3016           if ((uns || TREE_CODE (op) == NOP_EXPR)
3017               && TREE_UNSIGNED (TREE_TYPE (op)))
3018             {
3019               uns = 1;
3020               win = op;
3021             }
3022         }
3023     }
3024
3025   if (TREE_CODE (op) == COMPONENT_REF
3026       /* Since type_for_size always gives an integer type.  */
3027       && TREE_CODE (type) != REAL_TYPE)
3028     {
3029       unsigned innerprec = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1)));
3030       type = type_for_size (innerprec, TREE_UNSIGNED (TREE_OPERAND (op, 1)));
3031
3032       /* We can get this structure field in the narrowest type it fits in.
3033          If FOR_TYPE is 0, do this only for a field that matches the
3034          narrower type exactly and is aligned for it
3035          The resulting extension to its nominal type (a fullword type)
3036          must fit the same conditions as for other extensions.  */
3037
3038       if (innerprec < TYPE_PRECISION (TREE_TYPE (op))
3039           && (for_type || ! DECL_BIT_FIELD (TREE_OPERAND (op, 1)))
3040           && (! uns || final_prec <= innerprec
3041               || TREE_UNSIGNED (TREE_OPERAND (op, 1)))
3042           && type != 0)
3043         {
3044           win = build (COMPONENT_REF, type, TREE_OPERAND (op, 0),
3045                        TREE_OPERAND (op, 1));
3046           TREE_SIDE_EFFECTS (win) = TREE_SIDE_EFFECTS (op);
3047           TREE_THIS_VOLATILE (win) = TREE_THIS_VOLATILE (op);
3048           TREE_RAISES (win) = TREE_RAISES (op);
3049         }
3050     }
3051   return win;
3052 }
3053 \f
3054 /* Return OP or a simpler expression for a narrower value
3055    which can be sign-extended or zero-extended to give back OP.
3056    Store in *UNSIGNEDP_PTR either 1 if the value should be zero-extended
3057    or 0 if the value should be sign-extended.  */
3058
3059 tree
3060 get_narrower (op, unsignedp_ptr)
3061      register tree op;
3062      int *unsignedp_ptr;
3063 {
3064   register int uns = 0;
3065   int first = 1;
3066   register tree win = op;
3067
3068   while (TREE_CODE (op) == NOP_EXPR)
3069     {
3070       register int bitschange
3071         = TYPE_PRECISION (TREE_TYPE (op))
3072           - TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (op, 0)));
3073
3074       /* Truncations are many-one so cannot be removed.  */
3075       if (bitschange < 0)
3076         break;
3077
3078       /* See what's inside this conversion.  If we decide to strip it,
3079          we will set WIN.  */
3080       op = TREE_OPERAND (op, 0);
3081
3082       if (bitschange > 0)
3083         {
3084           /* An extension: the outermost one can be stripped,
3085              but remember whether it is zero or sign extension.  */
3086           if (first)
3087             uns = TREE_UNSIGNED (TREE_TYPE (op));
3088           /* Otherwise, if a sign extension has been stripped,
3089              only sign extensions can now be stripped;
3090              if a zero extension has been stripped, only zero-extensions.  */
3091           else if (uns != TREE_UNSIGNED (TREE_TYPE (op)))
3092             break;
3093           first = 0;
3094         }
3095       /* A change in nominal type can always be stripped.  */
3096
3097       win = op;
3098     }
3099
3100   if (TREE_CODE (op) == COMPONENT_REF
3101       /* Since type_for_size always gives an integer type.  */
3102       && TREE_CODE (TREE_TYPE (op)) != REAL_TYPE)
3103     {
3104       unsigned innerprec = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1)));
3105       tree type = type_for_size (innerprec, TREE_UNSIGNED (op));
3106
3107       /* We can get this structure field in a narrower type that fits it,
3108          but the resulting extension to its nominal type (a fullword type)
3109          must satisfy the same conditions as for other extensions.
3110
3111          Do this only for fields that are aligned (not bit-fields),
3112          because when bit-field insns will be used there is no
3113          advantage in doing this.  */
3114
3115       if (innerprec < TYPE_PRECISION (TREE_TYPE (op))
3116           && ! DECL_BIT_FIELD (TREE_OPERAND (op, 1))
3117           && (first || uns == TREE_UNSIGNED (TREE_OPERAND (op, 1)))
3118           && type != 0)
3119         {
3120           if (first)
3121             uns = TREE_UNSIGNED (TREE_OPERAND (op, 1));
3122           win = build (COMPONENT_REF, type, TREE_OPERAND (op, 0),
3123                        TREE_OPERAND (op, 1));
3124           TREE_SIDE_EFFECTS (win) = TREE_SIDE_EFFECTS (op);
3125           TREE_THIS_VOLATILE (win) = TREE_THIS_VOLATILE (op);
3126           TREE_RAISES (win) = TREE_RAISES (op);
3127         }
3128     }
3129   *unsignedp_ptr = uns;
3130   return win;
3131 }
3132 \f
3133 /* Return the precision of a type, for arithmetic purposes.
3134    Supports all types on which arithmetic is possible
3135    (including pointer types).
3136    It's not clear yet what will be right for complex types.  */
3137
3138 int
3139 type_precision (type)
3140      register tree type;
3141 {
3142   return ((TREE_CODE (type) == INTEGER_TYPE
3143            || TREE_CODE (type) == ENUMERAL_TYPE
3144            || TREE_CODE (type) == REAL_TYPE)
3145           ? TYPE_PRECISION (type) : POINTER_SIZE);
3146 }
3147
3148 /* Nonzero if integer constant C has a value that is permissible
3149    for type TYPE (an INTEGER_TYPE).  */
3150
3151 int
3152 int_fits_type_p (c, type)
3153      tree c, type;
3154 {
3155   if (TREE_UNSIGNED (type))
3156     return (!INT_CST_LT_UNSIGNED (TYPE_MAX_VALUE (type), c)
3157             && !INT_CST_LT_UNSIGNED (c, TYPE_MIN_VALUE (type))
3158             && (TREE_INT_CST_HIGH (c) >= 0 || TREE_UNSIGNED (TREE_TYPE (c))));
3159   else
3160     return (!INT_CST_LT (TYPE_MAX_VALUE (type), c)
3161             && !INT_CST_LT (c, TYPE_MIN_VALUE (type))
3162             && (TREE_INT_CST_HIGH (c) >= 0 || !TREE_UNSIGNED (TREE_TYPE (c))));
3163 }
3164
3165 /* Return the innermost context enclosing DECL that is
3166    a FUNCTION_DECL, or zero if none.  */
3167
3168 tree
3169 decl_function_context (decl)
3170      tree decl;
3171 {
3172   tree context;
3173
3174   if (TREE_CODE (decl) == ERROR_MARK)
3175     return 0;
3176
3177   if (TREE_CODE (decl) == SAVE_EXPR)
3178     context = SAVE_EXPR_CONTEXT (decl);
3179   else
3180     context = DECL_CONTEXT (decl);
3181
3182   while (context && TREE_CODE (context) != FUNCTION_DECL)
3183     {
3184       if (TREE_CODE (context) == RECORD_TYPE
3185           || TREE_CODE (context) == UNION_TYPE)
3186         context = TYPE_CONTEXT (context);
3187       else if (TREE_CODE (context) == TYPE_DECL)
3188         context = DECL_CONTEXT (context);
3189       else if (TREE_CODE (context) == BLOCK)
3190         context = BLOCK_SUPERCONTEXT (context);
3191       else
3192         /* Unhandled CONTEXT !?  */
3193         abort ();
3194     }
3195
3196   return context;
3197 }
3198
3199 /* Return the innermost context enclosing DECL that is
3200    a RECORD_TYPE or UNION_TYPE, or zero if none.
3201    TYPE_DECLs and FUNCTION_DECLs are transparent to this function.  */
3202
3203 tree
3204 decl_type_context (decl)
3205      tree decl;
3206 {
3207   tree context = DECL_CONTEXT (decl);
3208
3209   while (context)
3210     {
3211       if (TREE_CODE (context) == RECORD_TYPE
3212           || TREE_CODE (context) == UNION_TYPE)
3213         return context;
3214       if (TREE_CODE (context) == TYPE_DECL
3215           || TREE_CODE (context) == FUNCTION_DECL)
3216         context = DECL_CONTEXT (context);
3217       else if (TREE_CODE (context) == BLOCK)
3218         context = BLOCK_SUPERCONTEXT (context);
3219       else
3220         /* Unhandled CONTEXT!?  */
3221         abort ();
3222     }
3223   return NULL_TREE;
3224 }
3225
3226 void
3227 print_obstack_statistics (str, o)
3228      char *str;
3229      struct obstack *o;
3230 {
3231   struct _obstack_chunk *chunk = o->chunk;
3232   int n_chunks = 0;
3233   int n_alloc = 0;
3234
3235   while (chunk)
3236     {
3237       n_chunks += 1;
3238       n_alloc += chunk->limit - &chunk->contents[0];
3239       chunk = chunk->prev;
3240     }
3241   fprintf (stderr, "obstack %s: %d bytes, %d chunks\n",
3242            str, n_alloc, n_chunks);
3243 }
3244 void
3245 dump_tree_statistics ()
3246 {
3247   int i;
3248   int total_nodes, total_bytes;
3249
3250   fprintf (stderr, "\n??? tree nodes created\n\n");
3251 #ifdef GATHER_STATISTICS
3252   fprintf (stderr, "Kind                  Nodes     Bytes\n");
3253   fprintf (stderr, "-------------------------------------\n");
3254   total_nodes = total_bytes = 0;
3255   for (i = 0; i < (int) all_kinds; i++)
3256     {
3257       fprintf (stderr, "%-20s %6d %9d\n", tree_node_kind_names[i],
3258                tree_node_counts[i], tree_node_sizes[i]);
3259       total_nodes += tree_node_counts[i];
3260       total_bytes += tree_node_sizes[i];
3261     }
3262   fprintf (stderr, "%-20s        %9d\n", "identifier names", id_string_size);
3263   fprintf (stderr, "-------------------------------------\n");
3264   fprintf (stderr, "%-20s %6d %9d\n", "Total", total_nodes, total_bytes);
3265   fprintf (stderr, "-------------------------------------\n");
3266 #else
3267   fprintf (stderr, "(No per-node statistics)\n");
3268 #endif
3269   print_lang_statistics ();
3270 }