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