?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Remove some compile time warnings about duplicate definitions.
[official-gcc.git] / gcc / ch / grant.c
blob806c944b0a969d2fa08a70d08fc73bbb61ae61a3
1 /* Implement grant-file output & seize-file input for CHILL.
2 Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001
3 Free Software Foundation, Inc.
4
5 This file is part of GNU CC.
6
7 GNU CC is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11
12 GNU CC is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU CC; see the file COPYING. If not, write to
19 the Free Software Foundation, 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
21
22 #include "config.h"
23 #include "system.h"
24 #include "tree.h"
25 #include "ch-tree.h"
26 #include "lex.h"
27 #include "flags.h"
28 #include "actions.h"
29 #include "input.h"
30 #include "rtl.h"
31 #include "tasking.h"
32 #include "toplev.h"
33 #include "output.h"
34 #include "target.h"
35
36 #define APPEND(X,Y) X = append (X, Y)
37 #define PREPEND(X,Y) X = prepend (X, Y);
38 #define FREE(x) strfree (x)
39 #define ALLOCAMOUNT 10000
40 /* may be we can handle this in a more exciting way,
41 but this also should work for the moment */
42 #define MAYBE_NEWLINE(X) \
43 do \
44 { \
45 if (X->len && X->str[X->len - 1] != '\n') \
46 APPEND (X, ";\n"); \
47 } while (0)
48
49 extern tree process_type;
50 extern char *asm_file_name;
51 extern char *dump_base_name;
52
53 /* forward declarations */
54
55 /* variable indicates compilation at module level */
56 int chill_at_module_level = 0;
57
58
59 /* mark that a SPEC MODULE was generated */
60 static int spec_module_generated = 0;
61
62 /* define a faster string handling */
63 typedef struct
64 {
65 char *str;
66 int len;
67 int allocated;
68 } MYSTRING;
69
70 /* structure used for handling multiple grant files */
71 char *grant_file_name;
72 MYSTRING *gstring = NULL;
73 MYSTRING *selective_gstring = NULL;
74
75 static MYSTRING *decode_decl PARAMS ((tree));
76 static MYSTRING *decode_constant PARAMS ((tree));
77 static void grant_one_decl PARAMS ((tree));
78 static MYSTRING *get_type PARAMS ((tree));
79 static MYSTRING *decode_mode PARAMS ((tree));
80 static MYSTRING *decode_prefix_rename PARAMS ((tree));
81 static MYSTRING *decode_constant_selective PARAMS ((tree, tree));
82 static MYSTRING *decode_mode_selective PARAMS ((tree, tree));
83 static MYSTRING *get_type_selective PARAMS ((tree, tree));
84 static MYSTRING *decode_decl_selective PARAMS ((tree, tree));
85 static MYSTRING *newstring PARAMS ((const char *));
86 static void strfree PARAMS ((MYSTRING *));
87 static MYSTRING *append PARAMS ((MYSTRING *, const char *));
88 static MYSTRING *prepend PARAMS ((MYSTRING *, const char *));
89 static void grant_use_seizefile PARAMS ((const char *));
90 static MYSTRING *decode_layout PARAMS ((tree));
91 static MYSTRING *grant_array_type PARAMS ((tree));
92 static MYSTRING *grant_array_type_selective PARAMS ((tree, tree));
93 static MYSTRING *get_tag_value PARAMS ((tree));
94 static MYSTRING *get_tag_value_selective PARAMS ((tree, tree));
95 static MYSTRING *print_enumeral PARAMS ((tree));
96 static MYSTRING *print_enumeral_selective PARAMS ((tree, tree));
97 static MYSTRING *print_integer_type PARAMS ((tree));
98 static tree find_enum_parent PARAMS ((tree, tree));
99 static MYSTRING *print_integer_selective PARAMS ((tree, tree));
100 static MYSTRING *print_struct PARAMS ((tree));
101 static MYSTRING *print_struct_selective PARAMS ((tree, tree));
102 static MYSTRING *print_proc_exceptions PARAMS ((tree));
103 static MYSTRING *print_proc_tail PARAMS ((tree, tree, int));
104 static MYSTRING *print_proc_tail_selective PARAMS ((tree, tree, tree));
105 static tree find_in_decls PARAMS ((tree, tree));
106 static int in_ridpointers PARAMS ((tree));
107 static void grant_seized_identifier PARAMS ((tree));
108 static void globalize_decl PARAMS ((tree));
109 static void grant_one_decl_selective PARAMS ((tree, tree));
110 static int compare_memory_file PARAMS ((const char *, const char *));
111 static int search_in_list PARAMS ((tree, tree));
112 static int really_grant_this PARAMS ((tree, tree));
113
114 /* list of the VAR_DECLs of the module initializer entries */
115 tree module_init_list = NULL_TREE;
116
117 /* handle different USE_SEIZE_FILE's in case of selective granting */
118 typedef struct SEIZEFILELIST
119 {
120 struct SEIZEFILELIST *next;
121 tree filename;
122 MYSTRING *seizes;
123 } seizefile_list;
124
125 static seizefile_list *selective_seizes = 0;
126
127 \f
128 static MYSTRING *
129 newstring (str)
130 const char *str;
131 {
132 MYSTRING *tmp = (MYSTRING *) xmalloc (sizeof (MYSTRING));
133 unsigned len = strlen (str);
134
135 tmp->allocated = len + ALLOCAMOUNT;
136 tmp->str = xmalloc ((unsigned)tmp->allocated);
137 strcpy (tmp->str, str);
138 tmp->len = len;
139 return (tmp);
140 }
141
142 static void
143 strfree (str)
144 MYSTRING *str;
145 {
146 free (str->str);
147 free (str);
148 }
149
150 static MYSTRING *
151 append (inout, in)
152 MYSTRING *inout;
153 const char *in;
154 {
155 int inlen = strlen (in);
156 int amount = ALLOCAMOUNT;
157
158 if (inlen >= amount)
159 amount += inlen;
160 if ((inout->len + inlen) >= inout->allocated)
161 inout->str = xrealloc (inout->str, inout->allocated += amount);
162 strcpy (inout->str + inout->len, in);
163 inout->len += inlen;
164 return (inout);
165 }
166
167 static MYSTRING *
168 prepend (inout, in)
169 MYSTRING *inout;
170 const char *in;
171 {
172 MYSTRING *res = inout;
173 if (strlen (in))
174 {
175 res = newstring (in);
176 res = APPEND (res, inout->str);
177 FREE (inout);
178 }
179 return res;
180 }
181 \f
182 static void
183 grant_use_seizefile (seize_filename)
184 const char *seize_filename;
185 {
186 APPEND (gstring, "<> USE_SEIZE_FILE \"");
187 APPEND (gstring, seize_filename);
188 APPEND (gstring, "\" <>\n");
189 }
190
191 static MYSTRING *
192 decode_layout (layout)
193 tree layout;
194 {
195 tree temp;
196 tree stepsize = NULL_TREE;
197 int was_step = 0;
198 MYSTRING *result = newstring ("");
199 MYSTRING *work;
200
201 if (layout == integer_zero_node) /* NOPACK */
202 {
203 APPEND (result, " NOPACK");
204 return result;
205 }
206
207 if (layout == integer_one_node) /* PACK */
208 {
209 APPEND (result, " PACK");
210 return result;
211 }
212
213 APPEND (result, " ");
214 temp = layout;
215 if (TREE_PURPOSE (temp) == NULL_TREE)
216 {
217 APPEND (result, "STEP(");
218 was_step = 1;
219 temp = TREE_VALUE (temp);
220 stepsize = TREE_VALUE (temp);
221 }
222 APPEND (result, "POS(");
223
224 /* Get the starting word */
225 temp = TREE_PURPOSE (temp);
226 work = decode_constant (TREE_PURPOSE (temp));
227 APPEND (result, work->str);
228 FREE (work);
229
230 temp = TREE_VALUE (temp);
231 if (temp != NULL_TREE)
232 {
233 /* Get the starting bit */
234 APPEND (result, ", ");
235 work = decode_constant (TREE_PURPOSE (temp));
236 APPEND (result, work->str);
237 FREE (work);
238
239 temp = TREE_VALUE (temp);
240 if (temp != NULL_TREE)
241 {
242 /* Get the length or the ending bit */
243 tree what = TREE_PURPOSE (temp);
244 if (what == integer_zero_node) /* length */
245 {
246 APPEND (result, ", ");
247 }
248 else
249 {
250 APPEND (result, ":");
251 }
252 work = decode_constant (TREE_VALUE (temp));
253 APPEND (result, work->str);
254 FREE (work);
255 }
256 }
257 APPEND (result, ")");
258
259 if (was_step)
260 {
261 if (stepsize != NULL_TREE)
262 {
263 APPEND (result, ", ");
264 work = decode_constant (stepsize);
265 APPEND (result, work->str);
266 FREE (work);
267 }
268 APPEND (result, ")");
269 }
270
271 return result;
272 }
273
274 static MYSTRING *
275 grant_array_type (type)
276 tree type;
277 {
278 MYSTRING *result = newstring ("");
279 MYSTRING *mode_string;
280 tree layout;
281 int varying = 0;
282
283 if (chill_varying_type_p (type))
284 {
285 varying = 1;
286 type = CH_VARYING_ARRAY_TYPE (type);
287 }
288 if (CH_STRING_TYPE_P (type))
289 {
290 tree fields = TYPE_DOMAIN (type);
291 tree maxval = TYPE_MAX_VALUE (fields);
292
293 if (TREE_CODE (TREE_TYPE (type)) == CHAR_TYPE)
294 APPEND (result, "CHARS (");
295 else
296 APPEND (result, "BOOLS (");
297 if (TREE_CODE (maxval) == INTEGER_CST)
298 {
299 char wrk[20];
300 sprintf (wrk, HOST_WIDE_INT_PRINT_DEC,
301 TREE_INT_CST_LOW (maxval) + 1);
302 APPEND (result, wrk);
303 }
304 else if (TREE_CODE (maxval) == MINUS_EXPR
305 && TREE_OPERAND (maxval, 1) == integer_one_node)
306 {
307 mode_string = decode_constant (TREE_OPERAND (maxval, 0));
308 APPEND (result, mode_string->str);
309 FREE (mode_string);
310 }
311 else
312 {
313 mode_string = decode_constant (maxval);
314 APPEND (result, mode_string->str);
315 FREE (mode_string);
316 APPEND (result, "+1");
317 }
318 APPEND (result, ")");
319 if (varying)
320 APPEND (result, " VARYING");
321 return result;
322 }
323
324 APPEND (result, "ARRAY (");
325 if (TREE_CODE (TYPE_DOMAIN (type)) == INTEGER_TYPE
326 && TREE_TYPE (TYPE_DOMAIN (type)) == ridpointers[(int) RID_RANGE])
327 {
328 mode_string = decode_constant (TYPE_MIN_VALUE (TYPE_DOMAIN (type)));
329 APPEND (result, mode_string->str);
330 FREE (mode_string);
331
332 APPEND (result, ":");
333 mode_string = decode_constant (TYPE_MAX_VALUE (TYPE_DOMAIN (type)));
334 APPEND (result, mode_string->str);
335 FREE (mode_string);
336 }
337 else
338 {
339 mode_string = decode_mode (TYPE_DOMAIN (type));
340 APPEND (result, mode_string->str);
341 FREE (mode_string);
342 }
343 APPEND (result, ") ");
344 if (varying)
345 APPEND (result, "VARYING ");
346
347 mode_string = get_type (TREE_TYPE (type));
348 APPEND (result, mode_string->str);
349 FREE (mode_string);
350
351 layout = TYPE_ATTRIBUTES (type);
352 if (layout != NULL_TREE)
353 {
354 mode_string = decode_layout (layout);
355 APPEND (result, mode_string->str);
356 FREE (mode_string);
357 }
358
359 return result;
360 }
361
362 static MYSTRING *
363 grant_array_type_selective (type, all_decls)
364 tree type;
365 tree all_decls;
366 {
367 MYSTRING *result = newstring ("");
368 MYSTRING *mode_string;
369 int varying = 0;
370
371 if (chill_varying_type_p (type))
372 {
373 varying = 1;
374 type = CH_VARYING_ARRAY_TYPE (type);
375 }
376 if (CH_STRING_TYPE_P (type))
377 {
378 tree fields = TYPE_DOMAIN (type);
379 tree maxval = TYPE_MAX_VALUE (fields);
380
381 if (TREE_CODE (maxval) != INTEGER_CST)
382 {
383 if (TREE_CODE (maxval) == MINUS_EXPR
384 && TREE_OPERAND (maxval, 1) == integer_one_node)
385 {
386 mode_string = decode_constant_selective (TREE_OPERAND (maxval, 0), all_decls);
387 if (mode_string->len)
388 APPEND (result, mode_string->str);
389 FREE (mode_string);
390 }
391 else
392 {
393 mode_string = decode_constant_selective (maxval, all_decls);
394 if (mode_string->len)
395 APPEND (result, mode_string->str);
396 FREE (mode_string);
397 }
398 }
399 return result;
400 }
401
402 if (TREE_CODE (TYPE_DOMAIN (type)) == INTEGER_TYPE
403 && TREE_TYPE (TYPE_DOMAIN (type)) == ridpointers[(int) RID_RANGE])
404 {
405 mode_string = decode_constant_selective (TYPE_MIN_VALUE (TYPE_DOMAIN (type)), all_decls);
406 if (mode_string->len)
407 APPEND (result, mode_string->str);
408 FREE (mode_string);
409
410 mode_string = decode_constant_selective (TYPE_MAX_VALUE (TYPE_DOMAIN (type)), all_decls);
411 if (mode_string->len)
412 {
413 MAYBE_NEWLINE (result);
414 APPEND (result, mode_string->str);
415 }
416 FREE (mode_string);
417 }
418 else
419 {
420 mode_string = decode_mode_selective (TYPE_DOMAIN (type), all_decls);
421 if (mode_string->len)
422 APPEND (result, mode_string->str);
423 FREE (mode_string);
424 }
425
426 mode_string = get_type_selective (TREE_TYPE (type), all_decls);
427 if (mode_string->len)
428 {
429 MAYBE_NEWLINE (result);
430 APPEND (result, mode_string->str);
431 }
432 FREE (mode_string);
433
434 return result;
435 }
436 \f
437 static MYSTRING *
438 get_tag_value (val)
439 tree val;
440 {
441 MYSTRING *result;
442
443 if (TREE_CODE (val) == CONST_DECL && DECL_NAME (val))
444 {
445 result = newstring (IDENTIFIER_POINTER (DECL_NAME (val)));
446 }
447 else if (TREE_CODE (val) == CONST_DECL)
448 {
449 /* it's a synonym -- get the value */
450 result = decode_constant (DECL_INITIAL (val));
451 }
452 else
453 {
454 result = decode_constant (val);
455 }
456 return (result);
457 }
458
459 static MYSTRING *
460 get_tag_value_selective (val, all_decls)
461 tree val;
462 tree all_decls;
463 {
464 MYSTRING *result;
465
466 if (TREE_CODE (val) == CONST_DECL && DECL_NAME (val))
467 result = newstring ("");
468 else if (TREE_CODE (val) == CONST_DECL)
469 {
470 /* it's a synonym -- get the value */
471 result = decode_constant_selective (DECL_INITIAL (val), all_decls);
472 }
473 else
474 {
475 result = decode_constant_selective (val, all_decls);
476 }
477 return (result);
478 }
479 \f
480 static MYSTRING *
481 print_enumeral (type)
482 tree type;
483 {
484 MYSTRING *result = newstring ("");
485 tree fields;
486
487 #if 0
488 if (TYPE_LANG_SPECIFIC (type) == NULL)
489 #endif
490 {
491
492 APPEND (result, "SET (");
493 for (fields = TYPE_VALUES (type);
494 fields != NULL_TREE;
495 fields = TREE_CHAIN (fields))
496 {
497 if (TREE_PURPOSE (fields) == NULL_TREE)
498 APPEND (result, "*");
499 else
500 {
501 tree decl = TREE_VALUE (fields);
502 APPEND (result, IDENTIFIER_POINTER (TREE_PURPOSE (fields)));
503 if (TREE_CODE (decl) == CONST_DECL && DECL_INITIAL (decl))
504 {
505 MYSTRING *val_string = decode_constant (DECL_INITIAL (decl));
506 APPEND (result, " = ");
507 APPEND (result, val_string->str);
508 FREE (val_string);
509 }
510 }
511 if (TREE_CHAIN (fields) != NULL_TREE)
512 APPEND (result, ",\n ");
513 }
514 APPEND (result, ")");
515 }
516 return result;
517 }
518
519 static MYSTRING *
520 print_enumeral_selective (type, all_decls)
521 tree type;
522 tree all_decls;
523 {
524 MYSTRING *result = newstring ("");
525 tree fields;
526
527 for (fields = TYPE_VALUES (type);
528 fields != NULL_TREE;
529 fields = TREE_CHAIN (fields))
530 {
531 if (TREE_PURPOSE (fields) != NULL_TREE)
532 {
533 tree decl = TREE_VALUE (fields);
534 if (TREE_CODE (decl) == CONST_DECL && DECL_INITIAL (decl))
535 {
536 MYSTRING *val_string = decode_constant_selective (DECL_INITIAL (decl), all_decls);
537 if (val_string->len)
538 APPEND (result, val_string->str);
539 FREE (val_string);
540 }
541 }
542 }
543 return result;
544 }
545 \f
546 static MYSTRING *
547 print_integer_type (type)
548 tree type;
549 {
550 MYSTRING *result = newstring ("");
551 MYSTRING *mode_string;
552 const char *name_ptr;
553 tree base_type;
554
555 if (TREE_TYPE (type))
556 {
557 mode_string = decode_mode (TREE_TYPE (type));
558 APPEND (result, mode_string->str);
559 FREE (mode_string);
560
561 APPEND (result, "(");
562 mode_string = decode_constant (TYPE_MIN_VALUE (type));
563 APPEND (result, mode_string->str);
564 FREE (mode_string);
565
566 if (TREE_TYPE (type) != ridpointers[(int) RID_BIN])
567 {
568 APPEND (result, ":");
569 mode_string = decode_constant (TYPE_MAX_VALUE (type));
570 APPEND (result, mode_string->str);
571 FREE (mode_string);
572 }
573
574 APPEND (result, ")");
575 return result;
576 }
577 /* We test TYPE_MAIN_VARIANT because pushdecl often builds
578 a copy of a built-in type node, which is logically id-
579 entical but has a different address, and the same
580 TYPE_MAIN_VARIANT. */
581 /* FIXME this should not be needed! */
582
583 base_type = TREE_TYPE (type) ? TREE_TYPE (type) : type;
584
585 if (TREE_UNSIGNED (base_type))
586 {
587 if (base_type == chill_unsigned_type_node
588 || TYPE_MAIN_VARIANT(base_type) ==
589 TYPE_MAIN_VARIANT (chill_unsigned_type_node))
590 name_ptr = "UINT";
591 else if (base_type == long_integer_type_node
592 || TYPE_MAIN_VARIANT(base_type) ==
593 TYPE_MAIN_VARIANT (long_unsigned_type_node))
594 name_ptr = "ULONG";
595 else if (type == unsigned_char_type_node
596 || TYPE_MAIN_VARIANT(base_type) ==
597 TYPE_MAIN_VARIANT (unsigned_char_type_node))
598 name_ptr = "UBYTE";
599 else if (type == duration_timing_type_node
600 || TYPE_MAIN_VARIANT (base_type) ==
601 TYPE_MAIN_VARIANT (duration_timing_type_node))
602 name_ptr = "DURATION";
603 else if (type == abs_timing_type_node
604 || TYPE_MAIN_VARIANT (base_type) ==
605 TYPE_MAIN_VARIANT (abs_timing_type_node))
606 name_ptr = "TIME";
607 else
608 name_ptr = "UINT";
609 }
610 else
611 {
612 if (base_type == chill_integer_type_node
613 || TYPE_MAIN_VARIANT (base_type) ==
614 TYPE_MAIN_VARIANT (chill_integer_type_node))
615 name_ptr = "INT";
616 else if (base_type == long_integer_type_node
617 || TYPE_MAIN_VARIANT (base_type) ==
618 TYPE_MAIN_VARIANT (long_integer_type_node))
619 name_ptr = "LONG";
620 else if (type == signed_char_type_node
621 || TYPE_MAIN_VARIANT (base_type) ==
622 TYPE_MAIN_VARIANT (signed_char_type_node))
623 name_ptr = "BYTE";
624 else
625 name_ptr = "INT";
626 }
627
628 APPEND (result, name_ptr);
629
630 /* see if we have a range */
631 if (TREE_TYPE (type) != NULL)
632 {
633 mode_string = decode_constant (TYPE_MIN_VALUE (type));
634 APPEND (result, mode_string->str);
635 FREE (mode_string);
636 APPEND (result, ":");
637 mode_string = decode_constant (TYPE_MAX_VALUE (type));
638 APPEND (result, mode_string->str);
639 FREE (mode_string);
640 }
641
642 return result;
643 }
644
645 static tree
646 find_enum_parent (enumname, all_decls)
647 tree enumname;
648 tree all_decls;
649 {
650 tree wrk;
651
652 for (wrk = all_decls; wrk != NULL_TREE; wrk = TREE_CHAIN (wrk))
653 {
654 if (TREE_TYPE (wrk) != NULL_TREE && TREE_CODE (wrk) != CONST_DECL &&
655 TREE_CODE (TREE_TYPE (wrk)) == ENUMERAL_TYPE)
656 {
657 tree list;
658 for (list = TYPE_VALUES (TREE_TYPE (wrk)); list != NULL_TREE; list = TREE_CHAIN (list))
659 {
660 if (DECL_NAME (TREE_VALUE (list)) == enumname)
661 return wrk;
662 }
663 }
664 }
665 return NULL_TREE;
666 }
667
668 static MYSTRING *
669 print_integer_selective (type, all_decls)
670 tree type;
671 tree all_decls;
672 {
673 MYSTRING *result = newstring ("");
674 MYSTRING *mode_string;
675
676 if (TREE_TYPE (type))
677 {
678 mode_string = decode_mode_selective (TREE_TYPE (type), all_decls);
679 if (mode_string->len)
680 APPEND (result, mode_string->str);
681 FREE (mode_string);
682
683 if (TREE_TYPE (type) == ridpointers[(int)RID_RANGE] &&
684 TREE_CODE (TYPE_MIN_VALUE (type)) == IDENTIFIER_NODE &&
685 TREE_CODE (TYPE_MAX_VALUE (type)) == IDENTIFIER_NODE)
686 {
687 /* we have a range of a set. Find parant mode and write it
688 to SPEC MODULE. This will loose if the parent mode was SEIZED from
689 another file.*/
690 tree minparent = find_enum_parent (TYPE_MIN_VALUE (type), all_decls);
691 tree maxparent = find_enum_parent (TYPE_MAX_VALUE (type), all_decls);
692
693 if (minparent != NULL_TREE)
694 {
695 if (! CH_ALREADY_GRANTED (minparent))
696 {
697 mode_string = decode_decl (minparent);
698 if (mode_string->len)
699 APPEND (result, mode_string->str);
700 FREE (mode_string);
701 CH_ALREADY_GRANTED (minparent) = 1;
702 }
703 }
704 if (minparent != maxparent && maxparent != NULL_TREE)
705 {
706 if (!CH_ALREADY_GRANTED (maxparent))
707 {
708 mode_string = decode_decl (maxparent);
709 if (mode_string->len)
710 {
711 MAYBE_NEWLINE (result);
712 APPEND (result, mode_string->str);
713 }
714 FREE (mode_string);
715 CH_ALREADY_GRANTED (maxparent) = 1;
716 }
717 }
718 }
719 else
720 {
721 mode_string = decode_constant_selective (TYPE_MIN_VALUE (type), all_decls);
722 if (mode_string->len)
723 {
724 MAYBE_NEWLINE (result);
725 APPEND (result, mode_string->str);
726 }
727 FREE (mode_string);
728
729 mode_string = decode_constant_selective (TYPE_MAX_VALUE (type), all_decls);
730 if (mode_string->len)
731 {
732 MAYBE_NEWLINE (result);
733 APPEND (result, mode_string->str);
734 }
735 FREE (mode_string);
736 }
737 return result;
738 }
739
740 /* see if we have a range */
741 if (TREE_TYPE (type) != NULL)
742 {
743 mode_string = decode_constant_selective (TYPE_MIN_VALUE (type), all_decls);
744 if (mode_string->len)
745 APPEND (result, mode_string->str);
746 FREE (mode_string);
747
748 mode_string = decode_constant_selective (TYPE_MAX_VALUE (type), all_decls);
749 if (mode_string->len)
750 {
751 MAYBE_NEWLINE (result);
752 APPEND (result, mode_string->str);
753 }
754 FREE (mode_string);
755 }
756
757 return result;
758 }
759 \f
760 static MYSTRING *
761 print_struct (type)
762 tree type;
763 {
764 MYSTRING *result = newstring ("");
765 MYSTRING *mode_string;
766 tree fields;
767
768 if (chill_varying_type_p (type))
769 {
770 mode_string = grant_array_type (type);
771 APPEND (result, mode_string->str);
772 FREE (mode_string);
773 }
774 else
775 {
776 fields = TYPE_FIELDS (type);
777
778 APPEND (result, "STRUCT (");
779 while (fields != NULL_TREE)
780 {
781 if (TREE_CODE (TREE_TYPE (fields)) == UNION_TYPE)
782 {
783 tree variants;
784 /* Format a tagged variant record type. */
785 APPEND (result, " CASE ");
786 if (TYPE_TAGFIELDS (TREE_TYPE (fields)) != NULL_TREE)
787 {
788 tree tag_list = TYPE_TAGFIELDS (TREE_TYPE (fields));
789 for (;;)
790 {
791 tree tag_name = DECL_NAME (TREE_VALUE (tag_list));
792 APPEND (result, IDENTIFIER_POINTER (tag_name));
793 tag_list = TREE_CHAIN (tag_list);
794 if (tag_list == NULL_TREE)
795 break;
796 APPEND (result, ", ");
797 }
798 }
799 APPEND (result, " OF\n");
800 variants = TYPE_FIELDS (TREE_TYPE (fields));
801
802 /* Each variant is a FIELD_DECL whose type is an anonymous
803 struct within the anonymous union. */
804 while (variants != NULL_TREE)
805 {
806 tree tag_list = TYPE_TAG_VALUES (TREE_TYPE (variants));
807 tree struct_elts = TYPE_FIELDS (TREE_TYPE (variants));
808
809 while (tag_list != NULL_TREE)
810 {
811 tree tag_values = TREE_VALUE (tag_list);
812 APPEND (result, " (");
813 while (tag_values != NULL_TREE)
814 {
815 mode_string = get_tag_value (TREE_VALUE (tag_values));
816 APPEND (result, mode_string->str);
817 FREE (mode_string);
818 if (TREE_CHAIN (tag_values) != NULL_TREE)
819 {
820 APPEND (result, ",\n ");
821 tag_values = TREE_CHAIN (tag_values);
822 }
823 else break;
824 }
825 APPEND (result, ")");
826 tag_list = TREE_CHAIN (tag_list);
827 if (tag_list)
828 APPEND (result, ",");
829 else
830 break;
831 }
832 APPEND (result, " : ");
833
834 while (struct_elts != NULL_TREE)
835 {
836 mode_string = decode_decl (struct_elts);
837 APPEND (result, mode_string->str);
838 FREE (mode_string);
839
840 if (TREE_CHAIN (struct_elts) != NULL_TREE)
841 APPEND (result, ",\n ");
842 struct_elts = TREE_CHAIN (struct_elts);
843 }
844
845 variants = TREE_CHAIN (variants);
846 if (variants != NULL_TREE
847 && TREE_CHAIN (variants) == NULL_TREE
848 && DECL_NAME (variants) == ELSE_VARIANT_NAME)
849 {
850 tree else_elts = TYPE_FIELDS (TREE_TYPE (variants));
851 APPEND (result, "\n ELSE ");
852 while (else_elts != NULL_TREE)
853 {
854 mode_string = decode_decl (else_elts);
855 APPEND (result, mode_string->str);
856 FREE (mode_string);
857 if (TREE_CHAIN (else_elts) != NULL_TREE)
858 APPEND (result, ",\n ");
859 else_elts = TREE_CHAIN (else_elts);
860 }
861 break;
862 }
863 if (variants != NULL_TREE)
864 APPEND (result, ",\n");
865 }
866
867 APPEND (result, "\n ESAC");
868 }
869 else
870 {
871 mode_string = decode_decl (fields);
872 APPEND (result, mode_string->str);
873 FREE (mode_string);
874 }
875
876 fields = TREE_CHAIN (fields);
877 if (fields != NULL_TREE)
878 APPEND (result, ",\n ");
879 }
880 APPEND (result, ")");
881 }
882 return result;
883 }
884
885 static MYSTRING *
886 print_struct_selective (type, all_decls)
887 tree type;
888 tree all_decls;
889 {
890 MYSTRING *result = newstring ("");
891 MYSTRING *mode_string;
892 tree fields;
893
894 if (chill_varying_type_p (type))
895 {
896 mode_string = grant_array_type_selective (type, all_decls);
897 if (mode_string->len)
898 APPEND (result, mode_string->str);
899 FREE (mode_string);
900 }
901 else
902 {
903 fields = TYPE_FIELDS (type);
904
905 while (fields != NULL_TREE)
906 {
907 if (TREE_CODE (TREE_TYPE (fields)) == UNION_TYPE)
908 {
909 tree variants;
910 /* Format a tagged variant record type. */
911
912 variants = TYPE_FIELDS (TREE_TYPE (fields));
913
914 /* Each variant is a FIELD_DECL whose type is an anonymous
915 struct within the anonymous union. */
916 while (variants != NULL_TREE)
917 {
918 tree tag_list = TYPE_TAG_VALUES (TREE_TYPE (variants));
919 tree struct_elts = TYPE_FIELDS (TREE_TYPE (variants));
920
921 while (tag_list != NULL_TREE)
922 {
923 tree tag_values = TREE_VALUE (tag_list);
924 while (tag_values != NULL_TREE)
925 {
926 mode_string = get_tag_value_selective (TREE_VALUE (tag_values),
927 all_decls);
928 if (mode_string->len)
929 {
930 MAYBE_NEWLINE (result);
931 APPEND (result, mode_string->str);
932 }
933 FREE (mode_string);
934 if (TREE_CHAIN (tag_values) != NULL_TREE)
935 tag_values = TREE_CHAIN (tag_values);
936 else break;
937 }
938 tag_list = TREE_CHAIN (tag_list);
939 if (!tag_list)
940 break;
941 }
942
943 while (struct_elts != NULL_TREE)
944 {
945 mode_string = decode_decl_selective (struct_elts, all_decls);
946 if (mode_string->len)
947 {
948 MAYBE_NEWLINE (result);
949 APPEND (result, mode_string->str);
950 }
951 FREE (mode_string);
952
953 struct_elts = TREE_CHAIN (struct_elts);
954 }
955
956 variants = TREE_CHAIN (variants);
957 if (variants != NULL_TREE
958 && TREE_CHAIN (variants) == NULL_TREE
959 && DECL_NAME (variants) == ELSE_VARIANT_NAME)
960 {
961 tree else_elts = TYPE_FIELDS (TREE_TYPE (variants));
962 while (else_elts != NULL_TREE)
963 {
964 mode_string = decode_decl_selective (else_elts, all_decls);
965 if (mode_string->len)
966 {
967 MAYBE_NEWLINE (result);
968 APPEND (result, mode_string->str);
969 }
970 FREE (mode_string);
971 else_elts = TREE_CHAIN (else_elts);
972 }
973 break;
974 }
975 }
976 }
977 else
978 {
979 mode_string = decode_decl_selective (fields, all_decls);
980 APPEND (result, mode_string->str);
981 FREE (mode_string);
982 }
983
984 fields = TREE_CHAIN (fields);
985 }
986 }
987 return result;
988 }
989 \f
990 static MYSTRING *
991 print_proc_exceptions (ex)
992 tree ex;
993 {
994 MYSTRING *result = newstring ("");
995
996 if (ex != NULL_TREE)
997 {
998 APPEND (result, "\n EXCEPTIONS (");
999 for ( ; ex != NULL_TREE; ex = TREE_CHAIN (ex))
1000 {
1001 APPEND (result, IDENTIFIER_POINTER (TREE_VALUE (ex)));
1002 if (TREE_CHAIN (ex) != NULL_TREE)
1003 APPEND (result, ",\n ");
1004 }
1005 APPEND (result, ")");
1006 }
1007 return result;
1008 }
1009
1010 static MYSTRING *
1011 print_proc_tail (type, args, print_argnames)
1012 tree type;
1013 tree args;
1014 int print_argnames;
1015 {
1016 MYSTRING *result = newstring ("");
1017 MYSTRING *mode_string;
1018 int count = 0;
1019 int stopat = list_length (args) - 3;
1020
1021 /* do the argument modes */
1022 for ( ; args != NULL_TREE;
1023 args = TREE_CHAIN (args), count++)
1024 {
1025 char buf[20];
1026 tree argmode = TREE_VALUE (args);
1027 tree attribute = TREE_PURPOSE (args);
1028
1029 if (argmode == void_type_node)
1030 continue;
1031
1032 /* if we have exceptions don't print last 2 arguments */
1033 if (TYPE_RAISES_EXCEPTIONS (type) && count == stopat)
1034 break;
1035
1036 if (count)
1037 APPEND (result, ",\n ");
1038 if (print_argnames)
1039 {
1040 sprintf(buf, "arg%d ", count);
1041 APPEND (result, buf);
1042 }
1043
1044 if (attribute == ridpointers[(int) RID_LOC])
1045 argmode = TREE_TYPE (argmode);
1046 mode_string = get_type (argmode);
1047 APPEND (result, mode_string->str);
1048 FREE (mode_string);
1049
1050 if (attribute != NULL_TREE)
1051 {
1052 sprintf (buf, " %s", IDENTIFIER_POINTER (attribute));
1053 APPEND (result, buf);
1054 }
1055 }
1056 APPEND (result, ")");
1057
1058 /* return type */
1059 {
1060 tree retn_type = TREE_TYPE (type);
1061
1062 if (retn_type != NULL_TREE
1063 && TREE_CODE (retn_type) != VOID_TYPE)
1064 {
1065 mode_string = get_type (retn_type);
1066 APPEND (result, "\n RETURNS (");
1067 APPEND (result, mode_string->str);
1068 FREE (mode_string);
1069 if (TREE_CODE (retn_type) == REFERENCE_TYPE)
1070 APPEND (result, " LOC");
1071 APPEND (result, ")");
1072 }
1073 }
1074
1075 mode_string = print_proc_exceptions (TYPE_RAISES_EXCEPTIONS (type));
1076 APPEND (result, mode_string->str);
1077 FREE (mode_string);
1078
1079 return result;
1080 }
1081
1082 static MYSTRING *
1083 print_proc_tail_selective (type, args, all_decls)
1084 tree type;
1085 tree args;
1086 tree all_decls;
1087 {
1088 MYSTRING *result = newstring ("");
1089 MYSTRING *mode_string;
1090 int count = 0;
1091 int stopat = list_length (args) - 3;
1092
1093 /* do the argument modes */
1094 for ( ; args != NULL_TREE;
1095 args = TREE_CHAIN (args), count++)
1096 {
1097 tree argmode = TREE_VALUE (args);
1098 tree attribute = TREE_PURPOSE (args);
1099
1100 if (argmode == void_type_node)
1101 continue;
1102
1103 /* if we have exceptions don't process last 2 arguments */
1104 if (TYPE_RAISES_EXCEPTIONS (type) && count == stopat)
1105 break;
1106
1107 if (attribute == ridpointers[(int) RID_LOC])
1108 argmode = TREE_TYPE (argmode);
1109 mode_string = get_type_selective (argmode, all_decls);
1110 if (mode_string->len)
1111 {
1112 MAYBE_NEWLINE (result);
1113 APPEND (result, mode_string->str);
1114 }
1115 FREE (mode_string);
1116 }
1117
1118 /* return type */
1119 {
1120 tree retn_type = TREE_TYPE (type);
1121
1122 if (retn_type != NULL_TREE
1123 && TREE_CODE (retn_type) != VOID_TYPE)
1124 {
1125 mode_string = get_type_selective (retn_type, all_decls);
1126 if (mode_string->len)
1127 {
1128 MAYBE_NEWLINE (result);
1129 APPEND (result, mode_string->str);
1130 }
1131 FREE (mode_string);
1132 }
1133 }
1134
1135 return result;
1136 }
1137 \f
1138 /* output a mode (or type). */
1139
1140 static MYSTRING *
1141 decode_mode (type)
1142 tree type;
1143 {
1144 MYSTRING *result = newstring ("");
1145 MYSTRING *mode_string;
1146
1147 switch ((enum chill_tree_code)TREE_CODE (type))
1148 {
1149 case TYPE_DECL:
1150 if (DECL_NAME (type))
1151 {
1152 APPEND (result, IDENTIFIER_POINTER (DECL_NAME (type)));
1153 return result;
1154 }
1155 type = TREE_TYPE (type);
1156 break;
1157
1158 case IDENTIFIER_NODE:
1159 APPEND (result, IDENTIFIER_POINTER (type));
1160 return result;
1161
1162 case LANG_TYPE:
1163 /* LANG_TYPE are only used until satisfy is done,
1164 as place-holders for 'READ T', NEWMODE/SYNMODE modes,
1165 parameterised modes, and old-fashioned CHAR(N). */
1166 if (TYPE_READONLY (type))
1167 APPEND (result, "READ ");
1168
1169 mode_string = get_type (TREE_TYPE (type));
1170 APPEND (result, mode_string->str);
1171 if (TYPE_DOMAIN (type) != NULL_TREE)
1172 {
1173 /* Parameterized mode,
1174 or old-fashioned CHAR(N) string declaration.. */
1175 APPEND (result, "(");
1176 mode_string = decode_constant (TYPE_DOMAIN (type));
1177 APPEND (result, mode_string->str);
1178 APPEND (result, ")");
1179 }
1180 FREE (mode_string);
1181 break;
1182
1183 case ARRAY_TYPE:
1184 mode_string = grant_array_type (type);
1185 APPEND (result, mode_string->str);
1186 FREE (mode_string);
1187 break;
1188
1189 case BOOLEAN_TYPE:
1190 APPEND (result, "BOOL");
1191 break;
1192
1193 case CHAR_TYPE:
1194 APPEND (result, "CHAR");
1195 break;
1196
1197 case ENUMERAL_TYPE:
1198 mode_string = print_enumeral (type);
1199 APPEND (result, mode_string->str);
1200 FREE (mode_string);
1201 break;
1202
1203 case FUNCTION_TYPE:
1204 {
1205 tree args = TYPE_ARG_TYPES (type);
1206
1207 APPEND (result, "PROC (");
1208
1209 mode_string = print_proc_tail (type, args, 0);
1210 APPEND (result, mode_string->str);
1211 FREE (mode_string);
1212 }
1213 break;
1214
1215 case INTEGER_TYPE:
1216 mode_string = print_integer_type (type);
1217 APPEND (result, mode_string->str);
1218 FREE (mode_string);
1219 break;
1220
1221 case RECORD_TYPE:
1222 if (CH_IS_INSTANCE_MODE (type))
1223 {
1224 APPEND (result, "INSTANCE");
1225 return result;
1226 }
1227 else if (CH_IS_BUFFER_MODE (type) || CH_IS_EVENT_MODE (type))
1228 { tree bufsize = max_queue_size (type);
1229 APPEND (result, CH_IS_BUFFER_MODE (type) ? "BUFFER " : "EVENT ");
1230 if (bufsize != NULL_TREE)
1231 {
1232 APPEND (result, "(");
1233 mode_string = decode_constant (bufsize);
1234 APPEND (result, mode_string->str);
1235 APPEND (result, ") ");
1236 FREE (mode_string);
1237 }
1238 if (CH_IS_BUFFER_MODE (type))
1239 {
1240 mode_string = decode_mode (buffer_element_mode (type));
1241 APPEND (result, mode_string->str);
1242 FREE (mode_string);
1243 }
1244 break;
1245 }
1246 else if (CH_IS_ACCESS_MODE (type))
1247 {
1248 tree indexmode, recordmode, dynamic;
1249
1250 APPEND (result, "ACCESS");
1251 recordmode = access_recordmode (type);
1252 indexmode = access_indexmode (type);
1253 dynamic = access_dynamic (type);
1254
1255 if (indexmode != void_type_node)
1256 {
1257 mode_string = decode_mode (indexmode);
1258 APPEND (result, " (");
1259 APPEND (result, mode_string->str);
1260 APPEND (result, ")");
1261 FREE (mode_string);
1262 }
1263 if (recordmode != void_type_node)
1264 {
1265 mode_string = decode_mode (recordmode);
1266 APPEND (result, " ");
1267 APPEND (result, mode_string->str);
1268 FREE (mode_string);
1269 }
1270 if (dynamic != integer_zero_node)
1271 APPEND (result, " DYNAMIC");
1272 break;
1273 }
1274 else if (CH_IS_TEXT_MODE (type))
1275 {
1276 tree indexmode, dynamic, length;
1277
1278 APPEND (result, "TEXT (");
1279 length = text_length (type);
1280 indexmode = text_indexmode (type);
1281 dynamic = text_dynamic (type);
1282
1283 mode_string = decode_constant (length);
1284 APPEND (result, mode_string->str);
1285 FREE (mode_string);
1286 APPEND (result, ")");
1287 if (indexmode != void_type_node)
1288 {
1289 APPEND (result, " ");
1290 mode_string = decode_mode (indexmode);
1291 APPEND (result, mode_string->str);
1292 FREE (mode_string);
1293 }
1294 if (dynamic != integer_zero_node)
1295 APPEND (result, " DYNAMIC");
1296 return result;
1297 }
1298 mode_string = print_struct (type);
1299 APPEND (result, mode_string->str);
1300 FREE (mode_string);
1301 break;
1302
1303 case POINTER_TYPE:
1304 if (TREE_CODE (TREE_TYPE (type)) == VOID_TYPE)
1305 APPEND (result, "PTR");
1306 else
1307 {
1308 if (TREE_CODE (TREE_TYPE (type)) == FUNCTION_TYPE)
1309 {
1310 mode_string = get_type (TREE_TYPE (type));
1311 APPEND (result, mode_string->str);
1312 FREE (mode_string);
1313 }
1314 else
1315 {
1316 APPEND (result, "REF ");
1317 mode_string = get_type (TREE_TYPE (type));
1318 APPEND (result, mode_string->str);
1319 FREE (mode_string);
1320 }
1321 }
1322 break;
1323
1324 case REAL_TYPE:
1325 if (TREE_INT_CST_LOW (TYPE_SIZE (type)) == 32)
1326 APPEND (result, "REAL");
1327 else
1328 APPEND (result, "LONG_REAL");
1329 break;
1330
1331 case SET_TYPE:
1332 if (CH_BOOLS_TYPE_P (type))
1333 mode_string = grant_array_type (type);
1334 else
1335 {
1336 APPEND (result, "POWERSET ");
1337 mode_string = get_type (TYPE_DOMAIN (type));
1338 }
1339 APPEND (result, mode_string->str);
1340 FREE (mode_string);
1341 break;
1342
1343 case REFERENCE_TYPE:
1344 mode_string = get_type (TREE_TYPE (type));
1345 APPEND (result, mode_string->str);
1346 FREE (mode_string);
1347 break;
1348
1349 default:
1350 APPEND (result, "/* ---- not implemented ---- */");
1351 break;
1352 }
1353
1354 return (result);
1355 }
1356
1357 static tree
1358 find_in_decls (id, all_decls)
1359 tree id;
1360 tree all_decls;
1361 {
1362 tree wrk;
1363
1364 for (wrk = all_decls; wrk != NULL_TREE; wrk = TREE_CHAIN (wrk))
1365 {
1366 if (DECL_NAME (wrk) == id || DECL_POSTFIX (wrk) == id)
1367 return wrk;
1368 }
1369 return NULL_TREE;
1370 }
1371
1372 static int
1373 in_ridpointers (id)
1374 tree id;
1375 {
1376 int i;
1377 for (i = RID_UNUSED; i < RID_MAX; i++)
1378 {
1379 if (id == ridpointers[i])
1380 return 1;
1381 }
1382 return 0;
1383 }
1384
1385 static void
1386 grant_seized_identifier (decl)
1387 tree decl;
1388 {
1389 seizefile_list *wrk = selective_seizes;
1390 MYSTRING *mode_string;
1391
1392 CH_ALREADY_GRANTED (decl) = 1;
1393
1394 /* comes from a SPEC MODULE in the module */
1395 if (DECL_SEIZEFILE (decl) == NULL_TREE)
1396 return;
1397
1398 /* search file already in process */
1399 while (wrk != 0)
1400 {
1401 if (wrk->filename == DECL_SEIZEFILE (decl))
1402 break;
1403 wrk = wrk->next;
1404 }
1405 if (!wrk)
1406 {
1407 wrk = (seizefile_list *)xmalloc (sizeof (seizefile_list));
1408 wrk->next = selective_seizes;
1409 selective_seizes = wrk;
1410 wrk->filename = DECL_SEIZEFILE (decl);
1411 wrk->seizes = newstring ("<> USE_SEIZE_FILE \"");
1412 APPEND (wrk->seizes, IDENTIFIER_POINTER (DECL_SEIZEFILE (decl)));
1413 APPEND (wrk->seizes, "\" <>\n");
1414 }
1415 APPEND (wrk->seizes, "SEIZE ");
1416 mode_string = decode_prefix_rename (decl);
1417 APPEND (wrk->seizes, mode_string->str);
1418 FREE (mode_string);
1419 APPEND (wrk->seizes, ";\n");
1420 }
1421
1422 static MYSTRING *
1423 decode_mode_selective (type, all_decls)
1424 tree type;
1425 tree all_decls;
1426 {
1427 MYSTRING *result = newstring ("");
1428 MYSTRING *mode_string;
1429 tree decl;
1430
1431 switch ((enum chill_tree_code)TREE_CODE (type))
1432 {
1433 case TYPE_DECL:
1434 /* FIXME: could this ever happen ?? */
1435 if (DECL_NAME (type))
1436 {
1437 FREE (result);
1438 result = decode_mode_selective (DECL_NAME (type), all_decls);
1439 return result;
1440 }
1441 break;
1442
1443 case IDENTIFIER_NODE:
1444 if (in_ridpointers (type))
1445 /* it's a predefined, we must not search the whole list */
1446 return result;
1447
1448 decl = find_in_decls (type, all_decls);
1449 if (decl != NULL_TREE)
1450 {
1451 if (CH_ALREADY_GRANTED (decl))
1452 /* already processed */
1453 return result;
1454
1455 if (TREE_CODE (decl) == ALIAS_DECL && DECL_POSTFIX (decl) != NULL_TREE)
1456 {
1457 /* If CH_DECL_GRANTED, decl was granted into this scope, and
1458 so wasn't in the source code. */
1459 if (!CH_DECL_GRANTED (decl))
1460 {
1461 grant_seized_identifier (decl);
1462 }
1463 }
1464 else
1465 {
1466 result = decode_decl (decl);
1467 mode_string = decode_decl_selective (decl, all_decls);
1468 if (mode_string->len)
1469 {
1470 PREPEND (result, mode_string->str);
1471 }
1472 FREE (mode_string);
1473 }
1474 }
1475 return result;
1476
1477 case LANG_TYPE:
1478 mode_string = get_type_selective (TREE_TYPE (type), all_decls);
1479 APPEND (result, mode_string->str);
1480 FREE (mode_string);
1481 break;
1482
1483 case ARRAY_TYPE:
1484 mode_string = grant_array_type_selective (type, all_decls);
1485 APPEND (result, mode_string->str);
1486 FREE (mode_string);
1487 break;
1488
1489 case BOOLEAN_TYPE:
1490 return result;
1491 break;
1492
1493 case CHAR_TYPE:
1494 return result;
1495 break;
1496
1497 case ENUMERAL_TYPE:
1498 mode_string = print_enumeral_selective (type, all_decls);
1499 if (mode_string->len)
1500 APPEND (result, mode_string->str);
1501 FREE (mode_string);
1502 break;
1503
1504 case FUNCTION_TYPE:
1505 {
1506 tree args = TYPE_ARG_TYPES (type);
1507
1508 mode_string = print_proc_tail_selective (type, args, all_decls);
1509 if (mode_string->len)
1510 APPEND (result, mode_string->str);
1511 FREE (mode_string);
1512 }
1513 break;
1514
1515 case INTEGER_TYPE:
1516 mode_string = print_integer_selective (type, all_decls);
1517 if (mode_string->len)
1518 APPEND (result, mode_string->str);
1519 FREE (mode_string);
1520 break;
1521
1522 case RECORD_TYPE:
1523 if (CH_IS_INSTANCE_MODE (type))
1524 {
1525 return result;
1526 }
1527 else if (CH_IS_BUFFER_MODE (type) || CH_IS_EVENT_MODE (type))
1528 {
1529 tree bufsize = max_queue_size (type);
1530 if (bufsize != NULL_TREE)
1531 {
1532 mode_string = decode_constant_selective (bufsize, all_decls);
1533 if (mode_string->len)
1534 APPEND (result, mode_string->str);
1535 FREE (mode_string);
1536 }
1537 if (CH_IS_BUFFER_MODE (type))
1538 {
1539 mode_string = decode_mode_selective (buffer_element_mode (type), all_decls);
1540 if (mode_string->len)
1541 {
1542 MAYBE_NEWLINE (result);
1543 APPEND (result, mode_string->str);
1544 }
1545 FREE (mode_string);
1546 }
1547 break;
1548 }
1549 else if (CH_IS_ACCESS_MODE (type))
1550 {
1551 tree indexmode = access_indexmode (type);
1552 tree recordmode = access_recordmode (type);
1553
1554 if (indexmode != void_type_node)
1555 {
1556 mode_string = decode_mode_selective (indexmode, all_decls);
1557 if (mode_string->len)
1558 {
1559 if (result->len && result->str[result->len - 1] != '\n')
1560 APPEND (result, ";\n");
1561 APPEND (result, mode_string->str);
1562 }
1563 FREE (mode_string);
1564 }
1565 if (recordmode != void_type_node)
1566 {
1567 mode_string = decode_mode_selective (recordmode, all_decls);
1568 if (mode_string->len)
1569 {
1570 if (result->len && result->str[result->len - 1] != '\n')
1571 APPEND (result, ";\n");
1572 APPEND (result, mode_string->str);
1573 }
1574 FREE (mode_string);
1575 }
1576 break;
1577 }
1578 else if (CH_IS_TEXT_MODE (type))
1579 {
1580 tree indexmode = text_indexmode (type);
1581 tree length = text_length (type);
1582
1583 mode_string = decode_constant_selective (length, all_decls);
1584 if (mode_string->len)
1585 APPEND (result, mode_string->str);
1586 FREE (mode_string);
1587 if (indexmode != void_type_node)
1588 {
1589 mode_string = decode_mode_selective (indexmode, all_decls);
1590 if (mode_string->len)
1591 {
1592 if (result->len && result->str[result->len - 1] != '\n')
1593 APPEND (result, ";\n");
1594 APPEND (result, mode_string->str);
1595 }
1596 FREE (mode_string);
1597 }
1598 break;
1599 }
1600 mode_string = print_struct_selective (type, all_decls);
1601 if (mode_string->len)
1602 {
1603 MAYBE_NEWLINE (result);
1604 APPEND (result, mode_string->str);
1605 }
1606 FREE (mode_string);
1607 break;
1608
1609 case POINTER_TYPE:
1610 if (TREE_CODE (TREE_TYPE (type)) == VOID_TYPE)
1611 break;
1612 else
1613 {
1614 if (TREE_CODE (TREE_TYPE (type)) == FUNCTION_TYPE)
1615 {
1616 mode_string = get_type_selective (TREE_TYPE (type), all_decls);
1617 if (mode_string->len)
1618 APPEND (result, mode_string->str);
1619 FREE (mode_string);
1620 }
1621 else
1622 {
1623 mode_string = get_type_selective (TREE_TYPE (type), all_decls);
1624 if (mode_string->len)
1625 APPEND (result, mode_string->str);
1626 FREE (mode_string);
1627 }
1628 }
1629 break;
1630
1631 case REAL_TYPE:
1632 return result;
1633 break;
1634
1635 case SET_TYPE:
1636 if (CH_BOOLS_TYPE_P (type))
1637 mode_string = grant_array_type_selective (type, all_decls);
1638 else
1639 mode_string = get_type_selective (TYPE_DOMAIN (type), all_decls);
1640 if (mode_string->len)
1641 APPEND (result, mode_string->str);
1642 FREE (mode_string);
1643 break;
1644
1645 case REFERENCE_TYPE:
1646 mode_string = get_type_selective (TREE_TYPE (type), all_decls);
1647 if (mode_string->len)
1648 APPEND (result, mode_string->str);
1649 FREE (mode_string);
1650 break;
1651
1652 default:
1653 APPEND (result, "/* ---- not implemented ---- */");
1654 break;
1655 }
1656
1657 return (result);
1658 }
1659 \f
1660 static MYSTRING *
1661 get_type (type)
1662 tree type;
1663 {
1664 if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
1665 return newstring ("");
1666
1667 return (decode_mode (type));
1668 }
1669
1670 static MYSTRING *
1671 get_type_selective (type, all_decls)
1672 tree type;
1673 tree all_decls;
1674 {
1675 if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
1676 return newstring ("");
1677
1678 return (decode_mode_selective (type, all_decls));
1679 }
1680
1681 #if 0
1682 static int
1683 is_forbidden (str, forbid)
1684 tree str;
1685 tree forbid;
1686 {
1687 if (forbid == NULL_TREE)
1688 return (0);
1689
1690 if (TREE_CODE (forbid) == INTEGER_CST)
1691 return (1);
1692
1693 while (forbid != NULL_TREE)
1694 {
1695 if (TREE_VALUE (forbid) == str)
1696 return (1);
1697 forbid = TREE_CHAIN (forbid);
1698 }
1699 /* nothing found */
1700 return (0);
1701 }
1702 #endif
1703
1704 static MYSTRING *
1705 decode_constant (init)
1706 tree init;
1707 {
1708 MYSTRING *result = newstring ("");
1709 MYSTRING *tmp_string;
1710 tree type = TREE_TYPE (init);
1711 tree val = init;
1712 const char *op;
1713 char wrk[256];
1714 MYSTRING *mode_string;
1715
1716 switch ((enum chill_tree_code)TREE_CODE (val))
1717 {
1718 case CALL_EXPR:
1719 tmp_string = decode_constant (TREE_OPERAND (val, 0));
1720 APPEND (result, tmp_string->str);
1721 FREE (tmp_string);
1722 val = TREE_OPERAND (val, 1); /* argument list */
1723 if (val != NULL_TREE && TREE_CODE (val) != TREE_LIST)
1724 {
1725 APPEND (result, " ");
1726 tmp_string = decode_constant (val);
1727 APPEND (result, tmp_string->str);
1728 FREE (tmp_string);
1729 }
1730 else
1731 {
1732 APPEND (result, " (");
1733 if (val != NULL_TREE)
1734 {
1735 for (;;)
1736 {
1737 tmp_string = decode_constant (TREE_VALUE (val));
1738 APPEND (result, tmp_string->str);
1739 FREE (tmp_string);
1740 val = TREE_CHAIN (val);
1741 if (val == NULL_TREE)
1742 break;
1743 APPEND (result, ", ");
1744 }
1745 }
1746 APPEND (result, ")");
1747 }
1748 return result;
1749
1750 case NOP_EXPR:
1751 /* Generate an "expression conversion" expression (a cast). */
1752 tmp_string = decode_mode (type);
1753
1754 APPEND (result, tmp_string->str);
1755 FREE (tmp_string);
1756 APPEND (result, "(");
1757 val = TREE_OPERAND (val, 0);
1758 type = TREE_TYPE (val);
1759
1760 /* If the coercee is a tuple, make sure it is prefixed by its mode. */
1761 if (TREE_CODE (val) == CONSTRUCTOR
1762 && !CH_BOOLS_TYPE_P (type) && !chill_varying_type_p (type))
1763 {
1764 tmp_string = decode_mode (type);
1765 APPEND (result, tmp_string->str);
1766 FREE (tmp_string);
1767 APPEND (result, " ");
1768 }
1769
1770 tmp_string = decode_constant (val);
1771 APPEND (result, tmp_string->str);
1772 FREE (tmp_string);
1773 APPEND (result, ")");
1774 return result;
1775
1776 case IDENTIFIER_NODE:
1777 APPEND (result, IDENTIFIER_POINTER (val));
1778 return result;
1779
1780 case PAREN_EXPR:
1781 APPEND (result, "(");
1782 tmp_string = decode_constant (TREE_OPERAND (val, 0));
1783 APPEND (result, tmp_string->str);
1784 FREE (tmp_string);
1785 APPEND (result, ")");
1786 return result;
1787
1788 case UNDEFINED_EXPR:
1789 APPEND (result, "*");
1790 return result;
1791
1792 case PLUS_EXPR: op = "+"; goto binary;
1793 case MINUS_EXPR: op = "-"; goto binary;
1794 case MULT_EXPR: op = "*"; goto binary;
1795 case TRUNC_DIV_EXPR: op = "/"; goto binary;
1796 case FLOOR_MOD_EXPR: op = " MOD "; goto binary;
1797 case TRUNC_MOD_EXPR: op = " REM "; goto binary;
1798 case CONCAT_EXPR: op = "//"; goto binary;
1799 case BIT_IOR_EXPR: op = " OR "; goto binary;
1800 case BIT_XOR_EXPR: op = " XOR "; goto binary;
1801 case TRUTH_ORIF_EXPR: op = " ORIF "; goto binary;
1802 case BIT_AND_EXPR: op = " AND "; goto binary;
1803 case TRUTH_ANDIF_EXPR: op = " ANDIF "; goto binary;
1804 case GT_EXPR: op = ">"; goto binary;
1805 case GE_EXPR: op = ">="; goto binary;
1806 case SET_IN_EXPR: op = " IN "; goto binary;
1807 case LT_EXPR: op = "<"; goto binary;
1808 case LE_EXPR: op = "<="; goto binary;
1809 case EQ_EXPR: op = "="; goto binary;
1810 case NE_EXPR: op = "/="; goto binary;
1811 case RANGE_EXPR:
1812 if (TREE_OPERAND (val, 0) == NULL_TREE)
1813 {
1814 APPEND (result, TREE_OPERAND (val, 1) == NULL_TREE ? "*" : "ELSE");
1815 return result;
1816 }
1817 op = ":"; goto binary;
1818 binary:
1819 tmp_string = decode_constant (TREE_OPERAND (val, 0));
1820 APPEND (result, tmp_string->str);
1821 FREE (tmp_string);
1822 APPEND (result, op);
1823 tmp_string = decode_constant (TREE_OPERAND (val, 1));
1824 APPEND (result, tmp_string->str);
1825 FREE (tmp_string);
1826 return result;
1827
1828 case REPLICATE_EXPR:
1829 APPEND (result, "(");
1830 tmp_string = decode_constant (TREE_OPERAND (val, 0));
1831 APPEND (result, tmp_string->str);
1832 FREE (tmp_string);
1833 APPEND (result, ")");
1834 tmp_string = decode_constant (TREE_OPERAND (val, 1));
1835 APPEND (result, tmp_string->str);
1836 FREE (tmp_string);
1837 return result;
1838
1839 case NEGATE_EXPR: op = "-"; goto unary;
1840 case BIT_NOT_EXPR: op = " NOT "; goto unary;
1841 case ADDR_EXPR: op = "->"; goto unary;
1842 unary:
1843 APPEND (result, op);
1844 tmp_string = decode_constant (TREE_OPERAND (val, 0));
1845 APPEND (result, tmp_string->str);
1846 FREE (tmp_string);
1847 return result;
1848
1849 case INTEGER_CST:
1850 APPEND (result, display_int_cst (val));
1851 return result;
1852
1853 case REAL_CST:
1854 #ifndef REAL_IS_NOT_DOUBLE
1855 sprintf (wrk, "%.20g", TREE_REAL_CST (val));
1856 #else
1857 REAL_VALUE_TO_DECIMAL (TREE_REAL_CST (val), "%.20g", wrk);
1858 #endif
1859 APPEND (result, wrk);
1860 return result;
1861
1862 case STRING_CST:
1863 {
1864 const char *ptr = TREE_STRING_POINTER (val);
1865 int i = TREE_STRING_LENGTH (val);
1866 APPEND (result, "\"");
1867 while (--i >= 0)
1868 {
1869 char buf[10];
1870 unsigned char c = *ptr++;
1871 if (c == '^')
1872 APPEND (result, "^^");
1873 else if (c == '"')
1874 APPEND (result, "\"\"");
1875 else if (c == '\n')
1876 APPEND (result, "^J");
1877 else if (c < ' ' || c > '~')
1878 {
1879 sprintf (buf, "^(%u)", c);
1880 APPEND (result, buf);
1881 }
1882 else
1883 {
1884 buf[0] = c;
1885 buf[1] = 0;
1886 APPEND (result, buf);
1887 }
1888 }
1889 APPEND (result, "\"");
1890 return result;
1891 }
1892
1893 case CONSTRUCTOR:
1894 val = TREE_OPERAND (val, 1);
1895 if (type != NULL && TREE_CODE (type) == SET_TYPE
1896 && CH_BOOLS_TYPE_P (type))
1897 {
1898 /* It's a bitstring. */
1899 tree domain = TYPE_DOMAIN (type);
1900 tree domain_max = TYPE_MAX_VALUE (domain);
1901 char *buf;
1902 register char *ptr;
1903 int len;
1904 if (TREE_CODE (domain_max) != INTEGER_CST
1905 || (val && TREE_CODE (val) != TREE_LIST))
1906 goto fail;
1907
1908 len = TREE_INT_CST_LOW (domain_max) + 1;
1909 if (TREE_CODE (init) != CONSTRUCTOR)
1910 goto fail;
1911 buf = (char *) alloca (len + 10);
1912 ptr = buf;
1913 *ptr++ = ' ';
1914 *ptr++ = 'B';
1915 *ptr++ = '\'';
1916 if (get_set_constructor_bits (init, ptr, len))
1917 goto fail;
1918 for (; --len >= 0; ptr++)
1919 *ptr += '0';
1920 *ptr++ = '\'';
1921 *ptr = '\0';
1922 APPEND (result, buf);
1923 return result;
1924 }
1925 else
1926 { /* It's some kind of tuple */
1927 if (type != NULL_TREE)
1928 {
1929 mode_string = get_type (type);
1930 APPEND (result, mode_string->str);
1931 FREE (mode_string);
1932 APPEND (result, " ");
1933 }
1934 if (val == NULL_TREE
1935 || TREE_CODE (val) == ERROR_MARK)
1936 APPEND (result, "[ ]");
1937 else if (TREE_CODE (val) != TREE_LIST)
1938 goto fail;
1939 else
1940 {
1941 APPEND (result, "[");
1942 for ( ; ; )
1943 {
1944 tree lo_val = TREE_PURPOSE (val);
1945 tree hi_val = TREE_VALUE (val);
1946 MYSTRING *val_string;
1947 if (TUPLE_NAMED_FIELD (val))
1948 APPEND(result, ".");
1949 if (lo_val != NULL_TREE)
1950 {
1951 val_string = decode_constant (lo_val);
1952 APPEND (result, val_string->str);
1953 FREE (val_string);
1954 APPEND (result, ":");
1955 }
1956 val_string = decode_constant (hi_val);
1957 APPEND (result, val_string->str);
1958 FREE (val_string);
1959 val = TREE_CHAIN (val);
1960 if (val == NULL_TREE)
1961 break;
1962 APPEND (result, ", ");
1963 }
1964 APPEND (result, "]");
1965 }
1966 }
1967 return result;
1968 case COMPONENT_REF:
1969 {
1970 tree op1;
1971
1972 mode_string = decode_constant (TREE_OPERAND (init, 0));
1973 APPEND (result, mode_string->str);
1974 FREE (mode_string);
1975 op1 = TREE_OPERAND (init, 1);
1976 if (TREE_CODE (op1) != IDENTIFIER_NODE)
1977 {
1978 error ("decode_constant: invalid component_ref");
1979 break;
1980 }
1981 APPEND (result, ".");
1982 APPEND (result, IDENTIFIER_POINTER (op1));
1983 return result;
1984 }
1985 fail:
1986 error ("decode_constant: mode and value mismatch");
1987 break;
1988 default:
1989 error ("decode_constant: cannot decode this mode");
1990 break;
1991 }
1992 return result;
1993 }
1994
1995 static MYSTRING *
1996 decode_constant_selective (init, all_decls)
1997 tree init;
1998 tree all_decls;
1999 {
2000 MYSTRING *result = newstring ("");
2001 MYSTRING *tmp_string;
2002 tree type = TREE_TYPE (init);
2003 tree val = init;
2004 MYSTRING *mode_string;
2005
2006 switch ((enum chill_tree_code)TREE_CODE (val))
2007 {
2008 case CALL_EXPR:
2009 tmp_string = decode_constant_selective (TREE_OPERAND (val, 0), all_decls);
2010 if (tmp_string->len)
2011 APPEND (result, tmp_string->str);
2012 FREE (tmp_string);
2013 val = TREE_OPERAND (val, 1); /* argument list */
2014 if (val != NULL_TREE && TREE_CODE (val) != TREE_LIST)
2015 {
2016 tmp_string = decode_constant_selective (val, all_decls);
2017 if (tmp_string->len)
2018 {
2019 MAYBE_NEWLINE (result);
2020 APPEND (result, tmp_string->str);
2021 }
2022 FREE (tmp_string);
2023 }
2024 else
2025 {
2026 if (val != NULL_TREE)
2027 {
2028 for (;;)
2029 {
2030 tmp_string = decode_constant_selective (TREE_VALUE (val), all_decls);
2031 if (tmp_string->len)
2032 {
2033 MAYBE_NEWLINE (result);
2034 APPEND (result, tmp_string->str);
2035 }
2036 FREE (tmp_string);
2037 val = TREE_CHAIN (val);
2038 if (val == NULL_TREE)
2039 break;
2040 }
2041 }
2042 }
2043 return result;
2044
2045 case NOP_EXPR:
2046 /* Generate an "expression conversion" expression (a cast). */
2047 tmp_string = decode_mode_selective (type, all_decls);
2048 if (tmp_string->len)
2049 APPEND (result, tmp_string->str);
2050 FREE (tmp_string);
2051 val = TREE_OPERAND (val, 0);
2052 type = TREE_TYPE (val);
2053
2054 /* If the coercee is a tuple, make sure it is prefixed by its mode. */
2055 if (TREE_CODE (val) == CONSTRUCTOR
2056 && !CH_BOOLS_TYPE_P (type) && !chill_varying_type_p (type))
2057 {
2058 tmp_string = decode_mode_selective (type, all_decls);
2059 if (tmp_string->len)
2060 APPEND (result, tmp_string->str);
2061 FREE (tmp_string);
2062 }
2063
2064 tmp_string = decode_constant_selective (val, all_decls);
2065 if (tmp_string->len)
2066 APPEND (result, tmp_string->str);
2067 FREE (tmp_string);
2068 return result;
2069
2070 case IDENTIFIER_NODE:
2071 tmp_string = decode_mode_selective (val, all_decls);
2072 if (tmp_string->len)
2073 APPEND (result, tmp_string->str);
2074 FREE (tmp_string);
2075 return result;
2076
2077 case PAREN_EXPR:
2078 tmp_string = decode_constant_selective (TREE_OPERAND (val, 0), all_decls);
2079 if (tmp_string->len)
2080 APPEND (result, tmp_string->str);
2081 FREE (tmp_string);
2082 return result;
2083
2084 case UNDEFINED_EXPR:
2085 return result;
2086
2087 case PLUS_EXPR:
2088 case MINUS_EXPR:
2089 case MULT_EXPR:
2090 case TRUNC_DIV_EXPR:
2091 case FLOOR_MOD_EXPR:
2092 case TRUNC_MOD_EXPR:
2093 case CONCAT_EXPR:
2094 case BIT_IOR_EXPR:
2095 case BIT_XOR_EXPR:
2096 case TRUTH_ORIF_EXPR:
2097 case BIT_AND_EXPR:
2098 case TRUTH_ANDIF_EXPR:
2099 case GT_EXPR:
2100 case GE_EXPR:
2101 case SET_IN_EXPR:
2102 case LT_EXPR:
2103 case LE_EXPR:
2104 case EQ_EXPR:
2105 case NE_EXPR:
2106 goto binary;
2107 case RANGE_EXPR:
2108 if (TREE_OPERAND (val, 0) == NULL_TREE)
2109 return result;
2110
2111 binary:
2112 tmp_string = decode_constant_selective (TREE_OPERAND (val, 0), all_decls);
2113 if (tmp_string->len)
2114 APPEND (result, tmp_string->str);
2115 FREE (tmp_string);
2116 tmp_string = decode_constant_selective (TREE_OPERAND (val, 1), all_decls);
2117 if (tmp_string->len)
2118 {
2119 MAYBE_NEWLINE (result);
2120 APPEND (result, tmp_string->str);
2121 }
2122 FREE (tmp_string);
2123 return result;
2124
2125 case REPLICATE_EXPR:
2126 tmp_string = decode_constant_selective (TREE_OPERAND (val, 0), all_decls);
2127 if (tmp_string->len)
2128 APPEND (result, tmp_string->str);
2129 FREE (tmp_string);
2130 tmp_string = decode_constant_selective (TREE_OPERAND (val, 1), all_decls);
2131 if (tmp_string->len)
2132 {
2133 MAYBE_NEWLINE (result);
2134 APPEND (result, tmp_string->str);
2135 }
2136 FREE (tmp_string);
2137 return result;
2138
2139 case NEGATE_EXPR:
2140 case BIT_NOT_EXPR:
2141 case ADDR_EXPR:
2142 tmp_string = decode_constant_selective (TREE_OPERAND (val, 0), all_decls);
2143 if (tmp_string->len)
2144 APPEND (result, tmp_string->str);
2145 FREE (tmp_string);
2146 return result;
2147
2148 case INTEGER_CST:
2149 return result;
2150
2151 case REAL_CST:
2152 return result;
2153
2154 case STRING_CST:
2155 return result;
2156
2157 case CONSTRUCTOR:
2158 val = TREE_OPERAND (val, 1);
2159 if (type != NULL && TREE_CODE (type) == SET_TYPE
2160 && CH_BOOLS_TYPE_P (type))
2161 /* It's a bitstring. */
2162 return result;
2163 else
2164 { /* It's some kind of tuple */
2165 if (type != NULL_TREE)
2166 {
2167 mode_string = get_type_selective (type, all_decls);
2168 if (mode_string->len)
2169 APPEND (result, mode_string->str);
2170 FREE (mode_string);
2171 }
2172 if (val == NULL_TREE
2173 || TREE_CODE (val) == ERROR_MARK)
2174 return result;
2175 else if (TREE_CODE (val) != TREE_LIST)
2176 goto fail;
2177 else
2178 {
2179 for ( ; ; )
2180 {
2181 tree lo_val = TREE_PURPOSE (val);
2182 tree hi_val = TREE_VALUE (val);
2183 MYSTRING *val_string;
2184 if (lo_val != NULL_TREE)
2185 {
2186 val_string = decode_constant_selective (lo_val, all_decls);
2187 if (val_string->len)
2188 APPEND (result, val_string->str);
2189 FREE (val_string);
2190 }
2191 val_string = decode_constant_selective (hi_val, all_decls);
2192 if (val_string->len)
2193 {
2194 MAYBE_NEWLINE (result);
2195 APPEND (result, val_string->str);
2196 }
2197 FREE (val_string);
2198 val = TREE_CHAIN (val);
2199 if (val == NULL_TREE)
2200 break;
2201 }
2202 }
2203 }
2204 return result;
2205 case COMPONENT_REF:
2206 {
2207 mode_string = decode_constant_selective (TREE_OPERAND (init, 0), all_decls);
2208 if (mode_string->len)
2209 APPEND (result, mode_string->str);
2210 FREE (mode_string);
2211 return result;
2212 }
2213 fail:
2214 error ("decode_constant_selective: mode and value mismatch");
2215 break;
2216 default:
2217 error ("decode_constant_selective: cannot decode this mode");
2218 break;
2219 }
2220 return result;
2221 }
2222 \f
2223 /* Assuming DECL is an ALIAS_DECL, return its prefix rename clause. */
2224
2225 static MYSTRING *
2226 decode_prefix_rename (decl)
2227 tree decl;
2228 {
2229 MYSTRING *result = newstring ("");
2230 if (DECL_OLD_PREFIX (decl) || DECL_NEW_PREFIX (decl))
2231 {
2232 APPEND (result, "(");
2233 if (DECL_OLD_PREFIX (decl))
2234 APPEND (result, IDENTIFIER_POINTER (DECL_OLD_PREFIX (decl)));
2235 APPEND (result, "->");
2236 if (DECL_NEW_PREFIX (decl))
2237 APPEND (result, IDENTIFIER_POINTER (DECL_NEW_PREFIX (decl)));
2238 APPEND (result, ")!");
2239 }
2240 if (DECL_POSTFIX_ALL (decl))
2241 APPEND (result, "ALL");
2242 else
2243 APPEND (result, IDENTIFIER_POINTER (DECL_POSTFIX (decl)));
2244 return result;
2245 }
2246
2247 static MYSTRING *
2248 decode_decl (decl)
2249 tree decl;
2250 {
2251 MYSTRING *result = newstring ("");
2252 MYSTRING *mode_string;
2253 tree type;
2254
2255 switch ((enum chill_tree_code)TREE_CODE (decl))
2256 {
2257 case VAR_DECL:
2258 case BASED_DECL:
2259 APPEND (result, "DCL ");
2260 APPEND (result, IDENTIFIER_POINTER (DECL_NAME (decl)));
2261 APPEND (result, " ");
2262 mode_string = get_type (TREE_TYPE (decl));
2263 APPEND (result, mode_string->str);
2264 FREE (mode_string);
2265 if ((enum chill_tree_code)TREE_CODE (decl) == BASED_DECL)
2266 {
2267 APPEND (result, " BASED (");
2268 APPEND (result, IDENTIFIER_POINTER (DECL_ABSTRACT_ORIGIN (decl)));
2269 APPEND (result, ")");
2270 }
2271 break;
2272
2273 case TYPE_DECL:
2274 if (CH_DECL_SIGNAL (decl))
2275 {
2276 /* this is really a signal */
2277 tree fields = TYPE_FIELDS (TREE_TYPE (decl));
2278 tree signame = DECL_NAME (decl);
2279 tree sigdest;
2280
2281 APPEND (result, "SIGNAL ");
2282 APPEND (result, IDENTIFIER_POINTER (signame));
2283 if (IDENTIFIER_SIGNAL_DATA (signame))
2284 {
2285 APPEND (result, " = (");
2286 for ( ; fields != NULL_TREE;
2287 fields = TREE_CHAIN (fields))
2288 {
2289 MYSTRING *mode_string;
2290
2291 mode_string = get_type (TREE_TYPE (fields));
2292 APPEND (result, mode_string->str);
2293 FREE (mode_string);
2294 if (TREE_CHAIN (fields) != NULL_TREE)
2295 APPEND (result, ", ");
2296 }
2297 APPEND (result, ")");
2298 }
2299 sigdest = IDENTIFIER_SIGNAL_DEST (signame);
2300 if (sigdest != NULL_TREE)
2301 {
2302 APPEND (result, " TO ");
2303 APPEND (result, IDENTIFIER_POINTER (DECL_NAME (sigdest)));
2304 }
2305 }
2306 else
2307 {
2308 /* avoid defining a mode as itself */
2309 if (CH_NOVELTY (TREE_TYPE (decl)) == decl)
2310 APPEND (result, "NEWMODE ");
2311 else
2312 APPEND (result, "SYNMODE ");
2313 APPEND (result, IDENTIFIER_POINTER (DECL_NAME (decl)));
2314 APPEND (result, " = ");
2315 mode_string = decode_mode (TREE_TYPE (decl));
2316 APPEND (result, mode_string->str);
2317 FREE (mode_string);
2318 }
2319 break;
2320
2321 case FUNCTION_DECL:
2322 {
2323 tree args;
2324
2325 type = TREE_TYPE (decl);
2326 args = TYPE_ARG_TYPES (type);
2327
2328 APPEND (result, IDENTIFIER_POINTER (DECL_NAME (decl)));
2329
2330 if (CH_DECL_PROCESS (decl))
2331 APPEND (result, ": PROCESS (");
2332 else
2333 APPEND (result, ": PROC (");
2334
2335 args = TYPE_ARG_TYPES (type);
2336
2337 mode_string = print_proc_tail (type, args, 1);
2338 APPEND (result, mode_string->str);
2339 FREE (mode_string);
2340
2341 /* generality */
2342 if (CH_DECL_GENERAL (decl))
2343 APPEND (result, " GENERAL");
2344 if (CH_DECL_SIMPLE (decl))
2345 APPEND (result, " SIMPLE");
2346 if (DECL_INLINE (decl))
2347 APPEND (result, " INLINE");
2348 if (CH_DECL_RECURSIVE (decl))
2349 APPEND (result, " RECURSIVE");
2350 APPEND (result, " END");
2351 }
2352 break;
2353
2354 case FIELD_DECL:
2355 APPEND (result, IDENTIFIER_POINTER (DECL_NAME (decl)));
2356 APPEND (result, " ");
2357 mode_string = get_type (TREE_TYPE (decl));
2358 APPEND (result, mode_string->str);
2359 FREE (mode_string);
2360 if (DECL_INITIAL (decl) != NULL_TREE)
2361 {
2362 mode_string = decode_layout (DECL_INITIAL (decl));
2363 APPEND (result, mode_string->str);
2364 FREE (mode_string);
2365 }
2366 #if 0
2367 if (is_forbidden (DECL_NAME (decl), forbid))
2368 APPEND (result, " FORBID");
2369 #endif
2370 break;
2371
2372 case CONST_DECL:
2373 if (DECL_INITIAL (decl) == NULL_TREE
2374 || TREE_CODE (DECL_INITIAL (decl)) == ERROR_MARK)
2375 break;
2376 APPEND (result, "SYN ");
2377 APPEND (result, IDENTIFIER_POINTER (DECL_NAME (decl)));
2378 APPEND (result, " ");
2379 mode_string = get_type (TREE_TYPE (decl));
2380 APPEND (result, mode_string->str);
2381 FREE (mode_string);
2382 APPEND (result, " = ");
2383 mode_string = decode_constant (DECL_INITIAL (decl));
2384 APPEND (result, mode_string->str);
2385 FREE (mode_string);
2386 break;
2387
2388 case ALIAS_DECL:
2389 /* If CH_DECL_GRANTED, decl was granted into this scope, and
2390 so wasn't in the source code. */
2391 if (!CH_DECL_GRANTED (decl))
2392 {
2393 static int restricted = 0;
2394
2395 if (DECL_SEIZEFILE (decl) != use_seizefile_name
2396 && DECL_SEIZEFILE (decl))
2397 {
2398 use_seizefile_name = DECL_SEIZEFILE (decl);
2399 restricted = use_seizefile_name == NULL_TREE ? 0 : CH_USE_SEIZEFILE_RESTRICTED (use_seizefile_name);
2400 if (! restricted)
2401 grant_use_seizefile (IDENTIFIER_POINTER (use_seizefile_name));
2402 mark_use_seizefile_written (use_seizefile_name);
2403 }
2404 if (! restricted)
2405 {
2406 APPEND (result, "SEIZE ");
2407 mode_string = decode_prefix_rename (decl);
2408 APPEND (result, mode_string->str);
2409 FREE (mode_string);
2410 }
2411 }
2412 break;
2413
2414 default:
2415 APPEND (result, "----- not implemented ------");
2416 break;
2417 }
2418 return (result);
2419 }
2420
2421 static MYSTRING *
2422 decode_decl_selective (decl, all_decls)
2423 tree decl;
2424 tree all_decls;
2425 {
2426 MYSTRING *result = newstring ("");
2427 MYSTRING *mode_string;
2428 tree type;
2429
2430 if (CH_ALREADY_GRANTED (decl))
2431 /* do nothing */
2432 return result;
2433
2434 CH_ALREADY_GRANTED (decl) = 1;
2435
2436 switch ((int)TREE_CODE (decl))
2437 {
2438 case VAR_DECL:
2439 case BASED_DECL:
2440 mode_string = get_type_selective (TREE_TYPE (decl), all_decls);
2441 if (mode_string->len)
2442 APPEND (result, mode_string->str);
2443 FREE (mode_string);
2444 if ((enum chill_tree_code)TREE_CODE (decl) == BASED_DECL)
2445 {
2446 mode_string = decode_mode_selective (DECL_ABSTRACT_ORIGIN (decl), all_decls);
2447 if (mode_string->len)
2448 PREPEND (result, mode_string->str);
2449 FREE (mode_string);
2450 }
2451 break;
2452
2453 case TYPE_DECL:
2454 if (CH_DECL_SIGNAL (decl))
2455 {
2456 /* this is really a signal */
2457 tree fields = TYPE_FIELDS (TREE_TYPE (decl));
2458 tree signame = DECL_NAME (decl);
2459 tree sigdest;
2460
2461 if (IDENTIFIER_SIGNAL_DATA (signame))
2462 {
2463 for ( ; fields != NULL_TREE;
2464 fields = TREE_CHAIN (fields))
2465 {
2466 MYSTRING *mode_string;
2467
2468 mode_string = get_type_selective (TREE_TYPE (fields),
2469 all_decls);
2470 if (mode_string->len)
2471 APPEND (result, mode_string->str);
2472 FREE (mode_string);
2473 }
2474 }
2475 sigdest = IDENTIFIER_SIGNAL_DEST (signame);
2476 if (sigdest != NULL_TREE)
2477 {
2478 mode_string = decode_mode_selective (DECL_NAME (sigdest), all_decls);
2479 if (mode_string->len)
2480 {
2481 MAYBE_NEWLINE (result);
2482 APPEND (result, mode_string->str);
2483 }
2484 FREE (mode_string);
2485 }
2486 }
2487 else
2488 {
2489 /* avoid defining a mode as itself */
2490 mode_string = decode_mode_selective (TREE_TYPE (decl), all_decls);
2491 APPEND (result, mode_string->str);
2492 FREE (mode_string);
2493 }
2494 break;
2495
2496 case FUNCTION_DECL:
2497 {
2498 tree args;
2499
2500 type = TREE_TYPE (decl);
2501 args = TYPE_ARG_TYPES (type);
2502
2503 args = TYPE_ARG_TYPES (type);
2504
2505 mode_string = print_proc_tail_selective (type, args, all_decls);
2506 if (mode_string->len)
2507 APPEND (result, mode_string->str);
2508 FREE (mode_string);
2509 }
2510 break;
2511
2512 case FIELD_DECL:
2513 mode_string = get_type_selective (TREE_TYPE (decl), all_decls);
2514 if (mode_string->len)
2515 APPEND (result, mode_string->str);
2516 FREE (mode_string);
2517 break;
2518
2519 case CONST_DECL:
2520 if (DECL_INITIAL (decl) == NULL_TREE
2521 || TREE_CODE (DECL_INITIAL (decl)) == ERROR_MARK)
2522 break;
2523 mode_string = get_type_selective (TREE_TYPE (decl), all_decls);
2524 if (mode_string->len)
2525 APPEND (result, mode_string->str);
2526 FREE (mode_string);
2527 mode_string = decode_constant_selective (DECL_INITIAL (decl), all_decls);
2528 if (mode_string->len)
2529 {
2530 MAYBE_NEWLINE (result);
2531 APPEND (result, mode_string->str);
2532 }
2533 FREE (mode_string);
2534 break;
2535
2536 }
2537 MAYBE_NEWLINE (result);
2538 return (result);
2539 }
2540
2541 static void
2542 globalize_decl (decl)
2543 tree decl;
2544 {
2545 if (!TREE_PUBLIC (decl) && DECL_NAME (decl) &&
2546 (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == FUNCTION_DECL))
2547 {
2548 const char *name = XSTR (XEXP (DECL_RTL (decl), 0), 0);
2549
2550 if (!first_global_object_name)
2551 first_global_object_name = name + (name[0] == '*');
2552 ASM_GLOBALIZE_LABEL (asm_out_file, name);
2553 }
2554 }
2555
2556
2557 static void
2558 grant_one_decl (decl)
2559 tree decl;
2560 {
2561 MYSTRING *result;
2562
2563 if (DECL_SOURCE_LINE (decl) == 0)
2564 return;
2565 result = decode_decl (decl);
2566 if (result->len)
2567 {
2568 APPEND (result, ";\n");
2569 APPEND (gstring, result->str);
2570 }
2571 FREE (result);
2572 }
2573
2574 static void
2575 grant_one_decl_selective (decl, all_decls)
2576 tree decl;
2577 tree all_decls;
2578 {
2579 MYSTRING *result;
2580 MYSTRING *fixups;
2581
2582 tree d = DECL_ABSTRACT_ORIGIN (decl);
2583
2584 if (CH_ALREADY_GRANTED (d))
2585 /* already done */
2586 return;
2587
2588 result = decode_decl (d);
2589 if (!result->len)
2590 {
2591 /* nothing to do */
2592 FREE (result);
2593 return;
2594 }
2595
2596 APPEND (result, ";\n");
2597
2598 /* now process all undefined items in the decl */
2599 fixups = decode_decl_selective (d, all_decls);
2600 if (fixups->len)
2601 {
2602 PREPEND (result, fixups->str);
2603 }
2604 FREE (fixups);
2605
2606 /* we have finished a decl */
2607 APPEND (selective_gstring, result->str);
2608 FREE (result);
2609 }
2610
2611 static int
2612 compare_memory_file (fname, buf)
2613 const char *fname;
2614 const char *buf;
2615 {
2616 FILE *fb;
2617 int c;
2618
2619 /* check if we have something to write */
2620 if (!buf || !strlen (buf))
2621 return (0);
2622
2623 if ((fb = fopen (fname, "r")) == NULL)
2624 return (1);
2625
2626 while ((c = getc (fb)) != EOF)
2627 {
2628 if (c != *buf++)
2629 {
2630 fclose (fb);
2631 return (1);
2632 }
2633 }
2634 fclose (fb);
2635 return (*buf ? 1 : 0);
2636 }
2637
2638 void
2639 write_grant_file ()
2640 {
2641 FILE *fb;
2642
2643 /* We only write out the grant file if it has changed,
2644 to avoid changing its time-stamp and triggering an
2645 unnecessary 'make' action. Return if no change. */
2646 if (gstring == NULL || !spec_module_generated ||
2647 !compare_memory_file (grant_file_name, gstring->str))
2648 return;
2649
2650 fb = fopen (grant_file_name, "w");
2651 if (fb == NULL)
2652 fatal_io_error ("can't open %s", grant_file_name);
2653
2654 /* write file. Due to problems with record sizes on VAX/VMS
2655 write string to '\n' */
2656 #ifdef VMS
2657 /* do it this way for VMS, cause of problems with
2658 record sizes */
2659 p = gstring->str;
2660 while (*p)
2661 {
2662 p1 = strchr (p, '\n');
2663 c = *++p1;
2664 *p1 = '\0';
2665 fprintf (fb, "%s", p);
2666 *p1 = c;
2667 p = p1;
2668 }
2669 #else
2670 /* faster way to write */
2671 if (write (fileno (fb), gstring->str, gstring->len) < 0)
2672 {
2673 int save_errno = errno;
2674
2675 unlink (grant_file_name);
2676 errno = save_errno;
2677 fatal_io_error ("can't write to %s", grant_file_name);
2678 }
2679 #endif
2680 fclose (fb);
2681 }
2682
2683
2684 /* handle grant statement */
2685
2686 void
2687 set_default_grant_file ()
2688 {
2689 char *p, *tmp;
2690 const char *fname;
2691
2692 if (dump_base_name)
2693 fname = dump_base_name; /* Probably invoked via gcc */
2694 else
2695 { /* Probably invoked directly (not via gcc) */
2696 fname = asm_file_name;
2697 if (!fname)
2698 fname = main_input_filename ? main_input_filename : input_filename;
2699 if (!fname)
2700 return;
2701 }
2702
2703 p = strrchr (fname, '.');
2704 if (!p)
2705 {
2706 tmp = (char *) alloca (strlen (fname) + 10);
2707 strcpy (tmp, fname);
2708 }
2709 else
2710 {
2711 int i = p - fname;
2712
2713 tmp = (char *) alloca (i + 10);
2714 strncpy (tmp, fname, i);
2715 tmp[i] = '\0';
2716 }
2717 strcat (tmp, ".grt");
2718 default_grant_file = build_string (strlen (tmp), tmp);
2719
2720 grant_file_name = TREE_STRING_POINTER (default_grant_file);
2721
2722 if (gstring == NULL)
2723 gstring = newstring ("");
2724 if (selective_gstring == NULL)
2725 selective_gstring = newstring ("");
2726 }
2727
2728 /* Make DECL visible under the name NAME in the (fake) outermost scope. */
2729
2730 void
2731 push_granted (name, decl)
2732 tree name ATTRIBUTE_UNUSED, decl ATTRIBUTE_UNUSED;
2733 {
2734 #if 0
2735 IDENTIFIER_GRANTED_VALUE (name) = decl;
2736 granted_decls = tree_cons (name, decl, granted_decls);
2737 #endif
2738 }
2739
2740 void
2741 chill_grant (old_prefix, new_prefix, postfix, forbid)
2742 tree old_prefix;
2743 tree new_prefix;
2744 tree postfix;
2745 tree forbid;
2746 {
2747 if (pass == 1)
2748 {
2749 #if 0
2750 tree old_name = old_prefix == NULL_TREE ? postfix
2751 : get_identifier3 (IDENTIFIER_POINTER (old_prefix),
2752 "!", IDENTIFIER_POINTER (postfix));
2753 tree new_name = new_prefix == NULL_TREE ? postfix
2754 : get_identifier3 (IDENTIFIER_POINTER (new_prefix),
2755 "!", IDENTIFIER_POINTER (postfix));
2756 #endif
2757 tree alias = build_alias_decl (old_prefix, new_prefix, postfix);
2758 CH_DECL_GRANTED (alias) = 1;
2759 DECL_SEIZEFILE (alias) = current_seizefile_name;
2760 TREE_CHAIN (alias) = current_module->granted_decls;
2761 current_module->granted_decls = alias;
2762
2763 if (forbid)
2764 warning ("FORBID is not yet implemented"); /* FIXME */
2765 }
2766 }
2767 \f
2768 /* flag GRANT ALL only once. Avoids search in case of GRANT ALL. */
2769 static int grant_all_seen = 0;
2770
2771 /* check if a decl is in the list of granted decls. */
2772 static int
2773 search_in_list (name, granted_decls)
2774 tree name;
2775 tree granted_decls;
2776 {
2777 tree vars;
2778
2779 for (vars = granted_decls; vars != NULL_TREE; vars = TREE_CHAIN (vars))
2780 if (DECL_SOURCE_LINE (vars))
2781 {
2782 if (DECL_POSTFIX_ALL (vars))
2783 {
2784 grant_all_seen = 1;
2785 return 1;
2786 }
2787 else if (name == DECL_NAME (vars))
2788 return 1;
2789 }
2790 /* not found */
2791 return 0;
2792 }
2793
2794 static int
2795 really_grant_this (decl, granted_decls)
2796 tree decl;
2797 tree granted_decls;
2798 {
2799 /* we never grant labels at module level */
2800 if ((enum chill_tree_code)TREE_CODE (decl) == LABEL_DECL)
2801 return 0;
2802
2803 if (grant_all_seen)
2804 return 1;
2805
2806 switch ((enum chill_tree_code)TREE_CODE (decl))
2807 {
2808 case VAR_DECL:
2809 case BASED_DECL:
2810 case FUNCTION_DECL:
2811 return search_in_list (DECL_NAME (decl), granted_decls);
2812 case ALIAS_DECL:
2813 case CONST_DECL:
2814 return 1;
2815 case TYPE_DECL:
2816 if (CH_DECL_SIGNAL (decl))
2817 return search_in_list (DECL_NAME (decl), granted_decls);
2818 else
2819 return 1;
2820 default:
2821 break;
2822 }
2823
2824 /* this nerver should happen */
2825 error_with_decl (decl, "function \"really_grant_this\" called for `%s'.");
2826 return 1;
2827 }
2828 \f
2829 /* Write a SPEC MODULE using the declarations in the list DECLS. */
2830 static int header_written = 0;
2831 #define HEADER_TEMPLATE "--\n-- WARNING: this file was generated by\n\
2832 -- GNUCHILL version %s\n-- based on gcc version %s\n--\n"
2833
2834 void
2835 write_spec_module (decls, granted_decls)
2836 tree decls;
2837 tree granted_decls;
2838 {
2839 tree vars;
2840 char *hdr;
2841
2842 if (granted_decls == NULL_TREE)
2843 return;
2844
2845 use_seizefile_name = NULL_TREE;
2846
2847 if (!header_written)
2848 {
2849 hdr = (char*) alloca (strlen (gnuchill_version)
2850 + strlen (version_string)
2851 + sizeof (HEADER_TEMPLATE) /* includes \0 */);
2852 sprintf (hdr, HEADER_TEMPLATE, gnuchill_version, version_string);
2853 APPEND (gstring, hdr);
2854 header_written = 1;
2855 }
2856 APPEND (gstring, IDENTIFIER_POINTER (current_module->name));
2857 APPEND (gstring, ": SPEC MODULE\n");
2858
2859 /* first of all we look for GRANT ALL specified */
2860 search_in_list (NULL_TREE, granted_decls);
2861
2862 if (grant_all_seen != 0)
2863 {
2864 /* write all identifiers to grant file */
2865 for (vars = decls; vars != NULL_TREE; vars = TREE_CHAIN (vars))
2866 {
2867 if (DECL_SOURCE_LINE (vars))
2868 {
2869 if (DECL_NAME (vars))
2870 {
2871 if ((TREE_CODE (vars) != CONST_DECL || !CH_DECL_ENUM (vars)) &&
2872 really_grant_this (vars, granted_decls))
2873 grant_one_decl (vars);
2874 }
2875 else if (DECL_POSTFIX_ALL (vars))
2876 {
2877 static int restricted = 0;
2878
2879 if (DECL_SEIZEFILE (vars) != use_seizefile_name
2880 && DECL_SEIZEFILE (vars))
2881 {
2882 use_seizefile_name = DECL_SEIZEFILE (vars);
2883 restricted = use_seizefile_name == NULL_TREE ? 0 : CH_USE_SEIZEFILE_RESTRICTED (use_seizefile_name);
2884 if (! restricted)
2885 grant_use_seizefile (IDENTIFIER_POINTER (use_seizefile_name));
2886 mark_use_seizefile_written (use_seizefile_name);
2887 }
2888 if (! restricted)
2889 {
2890 APPEND (gstring, "SEIZE ALL;\n");
2891 }
2892 }
2893 }
2894 }
2895 }
2896 else
2897 {
2898 seizefile_list *wrk, *x;
2899
2900 /* do a selective write to the grantfile. This will reduce the
2901 size of a grantfile and speed up compilation of
2902 modules depending on this grant file */
2903
2904 if (selective_gstring == 0)
2905 selective_gstring = newstring ("");
2906
2907 /* first of all process all SEIZE ALL's */
2908 for (vars = decls; vars != NULL_TREE; vars = TREE_CHAIN (vars))
2909 {
2910 if (DECL_SOURCE_LINE (vars)
2911 && DECL_POSTFIX_ALL (vars))
2912 grant_seized_identifier (vars);
2913 }
2914
2915 /* now walk through granted decls */
2916 granted_decls = nreverse (granted_decls);
2917 for (vars = granted_decls; vars != NULL_TREE; vars = TREE_CHAIN (vars))
2918 {
2919 grant_one_decl_selective (vars, decls);
2920 }
2921 granted_decls = nreverse (granted_decls);
2922
2923 /* append all SEIZES */
2924 wrk = selective_seizes;
2925 while (wrk != 0)
2926 {
2927 x = wrk->next;
2928 APPEND (gstring, wrk->seizes->str);
2929 FREE (wrk->seizes);
2930 free (wrk);
2931 wrk = x;
2932 }
2933 selective_seizes = 0;
2934
2935 /* append generated string to grant file */
2936 APPEND (gstring, selective_gstring->str);
2937 FREE (selective_gstring);
2938 selective_gstring = NULL;
2939 }
2940
2941 for (vars = granted_decls; vars != NULL_TREE; vars = TREE_CHAIN (vars))
2942 if (DECL_SOURCE_LINE (vars))
2943 {
2944 MYSTRING *mode_string = decode_prefix_rename (vars);
2945 APPEND (gstring, "GRANT ");
2946 APPEND (gstring, mode_string->str);
2947 FREE (mode_string);
2948 APPEND (gstring, ";\n");
2949 }
2950
2951 APPEND (gstring, "END;\n");
2952 spec_module_generated = 1;
2953
2954 /* initialize this for next spec module */
2955 grant_all_seen = 0;
2956 }
2957 \f
2958 /*
2959 * after the dark comes, after all of the modules are at rest,
2960 * we tuck the compilation unit to bed... A story in pass 1
2961 * and a hug-and-a-kiss goodnight in pass 2.
2962 */
2963 void
2964 chill_finish_compile ()
2965 {
2966 tree global_list;
2967 tree chill_init_function;
2968
2969 tasking_setup ();
2970 build_enum_tables ();
2971
2972 /* We only need an initializer function for the source file if
2973 a) there's module-level code to be called, or
2974 b) tasking-related stuff to be initialized. */
2975 if (module_init_list != NULL_TREE || tasking_list != NULL_TREE)
2976 {
2977 extern tree initializer_type;
2978 static tree chill_init_name;
2979
2980 /* declare the global initializer list */
2981 global_list = do_decl (get_identifier ("_ch_init_list"),
2982 build_chill_pointer_type (initializer_type), 1, 0,
2983 NULL_TREE, 1);
2984
2985 /* Now, we're building the function which is the *real*
2986 constructor - if there's any module-level code in this
2987 source file, the compiler puts the file's initializer entry
2988 onto the global initializer list, so each module's body code
2989 will eventually get called, after all of the processes have
2990 been started up. */
2991
2992 /* This is better done in pass 2 (when first_global_object_name
2993 may have been set), but that is too late.
2994 Perhaps rewrite this so nothing is done in pass 1. */
2995 if (pass == 1)
2996 {
2997 /* If we don't do this spoof, we get the name of the first
2998 tasking_code variable, and not the file name. */
2999 char *q;
3000 const char *tmp = first_global_object_name;
3001 first_global_object_name = NULL;
3002 chill_init_name = get_file_function_name ('I');
3003 first_global_object_name = tmp;
3004
3005 /* strip off the file's extension, if any. */
3006 q = strrchr (IDENTIFIER_POINTER (chill_init_name), '.');
3007 if (q)
3008 *q = '\0';
3009 }
3010
3011 start_chill_function (chill_init_name, void_type_node, NULL_TREE,
3012 NULL_TREE, NULL_TREE);
3013 TREE_PUBLIC (current_function_decl) = 1;
3014 chill_init_function = current_function_decl;
3015
3016 /* For each module that we've compiled, that had module-level
3017 code to be called, add its entry to the global initializer
3018 list. */
3019
3020 if (pass == 2)
3021 {
3022 tree module_init;
3023
3024 for (module_init = module_init_list;
3025 module_init != NULL_TREE;
3026 module_init = TREE_CHAIN (module_init))
3027 {
3028 tree init_entry = TREE_VALUE (module_init);
3029
3030 /* assign module_entry.next := _ch_init_list; */
3031 expand_expr_stmt (
3032 build_chill_modify_expr (
3033 build_component_ref (init_entry,
3034 get_identifier ("__INIT_NEXT")),
3035 global_list));
3036
3037 /* assign _ch_init_list := &module_entry; */
3038 expand_expr_stmt (
3039 build_chill_modify_expr (global_list,
3040 build1 (ADDR_EXPR, ptr_type_node, init_entry)));
3041 }
3042 }
3043
3044 tasking_registry ();
3045
3046 make_decl_rtl (current_function_decl, NULL, 1);
3047
3048 finish_chill_function ();
3049
3050 if (pass == 2 && targetm.have_ctors_dtors)
3051 (* targetm.asm_out.constructor)
3052 (XEXP (DECL_RTL (chill_init_function), 0), DEFAULT_INIT_PRIORITY);
3053
3054 /* ready now to link decls onto this list in pass 2. */
3055 module_init_list = NULL_TREE;
3056 tasking_list = NULL_TREE;
3057 }
3058 }
3059
3060
Mirror of the offical gcc git repository hosted at gcc.gnu.org