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.
5 This file is part of GNU CC.
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)
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.
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. */
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) \
45 if (X->len && X->str[X->len - 1] != '\n') \
49 extern tree process_type
;
50 extern char *asm_file_name
;
51 extern char *dump_base_name
;
53 /* forward declarations */
55 /* variable indicates compilation at module level */
56 int chill_at_module_level
= 0;
59 /* mark that a SPEC MODULE was generated */
60 static int spec_module_generated
= 0;
62 /* define a faster string handling */
70 /* structure used for handling multiple grant files */
71 char *grant_file_name
;
72 MYSTRING
*gstring
= NULL
;
73 MYSTRING
*selective_gstring
= NULL
;
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
));
114 /* list of the VAR_DECLs of the module initializer entries */
115 tree module_init_list
= NULL_TREE
;
117 /* handle different USE_SEIZE_FILE's in case of selective granting */
118 typedef struct SEIZEFILELIST
120 struct SEIZEFILELIST
*next
;
125 static seizefile_list
*selective_seizes
= 0;
132 MYSTRING
*tmp
= (MYSTRING
*) xmalloc (sizeof (MYSTRING
));
133 unsigned len
= strlen (str
);
135 tmp
->allocated
= len
+ ALLOCAMOUNT
;
136 tmp
->str
= xmalloc ((unsigned)tmp
->allocated
);
137 strcpy (tmp
->str
, str
);
155 int inlen
= strlen (in
);
156 int amount
= ALLOCAMOUNT
;
160 if ((inout
->len
+ inlen
) >= inout
->allocated
)
161 inout
->str
= xrealloc (inout
->str
, inout
->allocated
+= amount
);
162 strcpy (inout
->str
+ inout
->len
, in
);
172 MYSTRING
*res
= inout
;
175 res
= newstring (in
);
176 res
= APPEND (res
, inout
->str
);
183 grant_use_seizefile (seize_filename
)
184 const char *seize_filename
;
186 APPEND (gstring
, "<> USE_SEIZE_FILE \"");
187 APPEND (gstring
, seize_filename
);
188 APPEND (gstring
, "\" <>\n");
192 decode_layout (layout
)
196 tree stepsize
= NULL_TREE
;
198 MYSTRING
*result
= newstring ("");
201 if (layout
== integer_zero_node
) /* NOPACK */
203 APPEND (result
, " NOPACK");
207 if (layout
== integer_one_node
) /* PACK */
209 APPEND (result
, " PACK");
213 APPEND (result
, " ");
215 if (TREE_PURPOSE (temp
) == NULL_TREE
)
217 APPEND (result
, "STEP(");
219 temp
= TREE_VALUE (temp
);
220 stepsize
= TREE_VALUE (temp
);
222 APPEND (result
, "POS(");
224 /* Get the starting word */
225 temp
= TREE_PURPOSE (temp
);
226 work
= decode_constant (TREE_PURPOSE (temp
));
227 APPEND (result
, work
->str
);
230 temp
= TREE_VALUE (temp
);
231 if (temp
!= NULL_TREE
)
233 /* Get the starting bit */
234 APPEND (result
, ", ");
235 work
= decode_constant (TREE_PURPOSE (temp
));
236 APPEND (result
, work
->str
);
239 temp
= TREE_VALUE (temp
);
240 if (temp
!= NULL_TREE
)
242 /* Get the length or the ending bit */
243 tree what
= TREE_PURPOSE (temp
);
244 if (what
== integer_zero_node
) /* length */
246 APPEND (result
, ", ");
250 APPEND (result
, ":");
252 work
= decode_constant (TREE_VALUE (temp
));
253 APPEND (result
, work
->str
);
257 APPEND (result
, ")");
261 if (stepsize
!= NULL_TREE
)
263 APPEND (result
, ", ");
264 work
= decode_constant (stepsize
);
265 APPEND (result
, work
->str
);
268 APPEND (result
, ")");
275 grant_array_type (type
)
278 MYSTRING
*result
= newstring ("");
279 MYSTRING
*mode_string
;
283 if (chill_varying_type_p (type
))
286 type
= CH_VARYING_ARRAY_TYPE (type
);
288 if (CH_STRING_TYPE_P (type
))
290 tree fields
= TYPE_DOMAIN (type
);
291 tree maxval
= TYPE_MAX_VALUE (fields
);
293 if (TREE_CODE (TREE_TYPE (type
)) == CHAR_TYPE
)
294 APPEND (result
, "CHARS (");
296 APPEND (result
, "BOOLS (");
297 if (TREE_CODE (maxval
) == INTEGER_CST
)
300 sprintf (wrk
, HOST_WIDE_INT_PRINT_DEC
,
301 TREE_INT_CST_LOW (maxval
) + 1);
302 APPEND (result
, wrk
);
304 else if (TREE_CODE (maxval
) == MINUS_EXPR
305 && TREE_OPERAND (maxval
, 1) == integer_one_node
)
307 mode_string
= decode_constant (TREE_OPERAND (maxval
, 0));
308 APPEND (result
, mode_string
->str
);
313 mode_string
= decode_constant (maxval
);
314 APPEND (result
, mode_string
->str
);
316 APPEND (result
, "+1");
318 APPEND (result
, ")");
320 APPEND (result
, " VARYING");
324 APPEND (result
, "ARRAY (");
325 if (TREE_CODE (TYPE_DOMAIN (type
)) == INTEGER_TYPE
326 && TREE_TYPE (TYPE_DOMAIN (type
)) == ridpointers
[(int) RID_RANGE
])
328 mode_string
= decode_constant (TYPE_MIN_VALUE (TYPE_DOMAIN (type
)));
329 APPEND (result
, mode_string
->str
);
332 APPEND (result
, ":");
333 mode_string
= decode_constant (TYPE_MAX_VALUE (TYPE_DOMAIN (type
)));
334 APPEND (result
, mode_string
->str
);
339 mode_string
= decode_mode (TYPE_DOMAIN (type
));
340 APPEND (result
, mode_string
->str
);
343 APPEND (result
, ") ");
345 APPEND (result
, "VARYING ");
347 mode_string
= get_type (TREE_TYPE (type
));
348 APPEND (result
, mode_string
->str
);
351 layout
= TYPE_ATTRIBUTES (type
);
352 if (layout
!= NULL_TREE
)
354 mode_string
= decode_layout (layout
);
355 APPEND (result
, mode_string
->str
);
363 grant_array_type_selective (type
, all_decls
)
367 MYSTRING
*result
= newstring ("");
368 MYSTRING
*mode_string
;
371 if (chill_varying_type_p (type
))
374 type
= CH_VARYING_ARRAY_TYPE (type
);
376 if (CH_STRING_TYPE_P (type
))
378 tree fields
= TYPE_DOMAIN (type
);
379 tree maxval
= TYPE_MAX_VALUE (fields
);
381 if (TREE_CODE (maxval
) != INTEGER_CST
)
383 if (TREE_CODE (maxval
) == MINUS_EXPR
384 && TREE_OPERAND (maxval
, 1) == integer_one_node
)
386 mode_string
= decode_constant_selective (TREE_OPERAND (maxval
, 0), all_decls
);
387 if (mode_string
->len
)
388 APPEND (result
, mode_string
->str
);
393 mode_string
= decode_constant_selective (maxval
, all_decls
);
394 if (mode_string
->len
)
395 APPEND (result
, mode_string
->str
);
402 if (TREE_CODE (TYPE_DOMAIN (type
)) == INTEGER_TYPE
403 && TREE_TYPE (TYPE_DOMAIN (type
)) == ridpointers
[(int) RID_RANGE
])
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
);
410 mode_string
= decode_constant_selective (TYPE_MAX_VALUE (TYPE_DOMAIN (type
)), all_decls
);
411 if (mode_string
->len
)
413 MAYBE_NEWLINE (result
);
414 APPEND (result
, mode_string
->str
);
420 mode_string
= decode_mode_selective (TYPE_DOMAIN (type
), all_decls
);
421 if (mode_string
->len
)
422 APPEND (result
, mode_string
->str
);
426 mode_string
= get_type_selective (TREE_TYPE (type
), all_decls
);
427 if (mode_string
->len
)
429 MAYBE_NEWLINE (result
);
430 APPEND (result
, mode_string
->str
);
443 if (TREE_CODE (val
) == CONST_DECL
&& DECL_NAME (val
))
445 result
= newstring (IDENTIFIER_POINTER (DECL_NAME (val
)));
447 else if (TREE_CODE (val
) == CONST_DECL
)
449 /* it's a synonym -- get the value */
450 result
= decode_constant (DECL_INITIAL (val
));
454 result
= decode_constant (val
);
460 get_tag_value_selective (val
, all_decls
)
466 if (TREE_CODE (val
) == CONST_DECL
&& DECL_NAME (val
))
467 result
= newstring ("");
468 else if (TREE_CODE (val
) == CONST_DECL
)
470 /* it's a synonym -- get the value */
471 result
= decode_constant_selective (DECL_INITIAL (val
), all_decls
);
475 result
= decode_constant_selective (val
, all_decls
);
481 print_enumeral (type
)
484 MYSTRING
*result
= newstring ("");
488 if (TYPE_LANG_SPECIFIC (type
) == NULL
)
492 APPEND (result
, "SET (");
493 for (fields
= TYPE_VALUES (type
);
495 fields
= TREE_CHAIN (fields
))
497 if (TREE_PURPOSE (fields
) == NULL_TREE
)
498 APPEND (result
, "*");
501 tree decl
= TREE_VALUE (fields
);
502 APPEND (result
, IDENTIFIER_POINTER (TREE_PURPOSE (fields
)));
503 if (TREE_CODE (decl
) == CONST_DECL
&& DECL_INITIAL (decl
))
505 MYSTRING
*val_string
= decode_constant (DECL_INITIAL (decl
));
506 APPEND (result
, " = ");
507 APPEND (result
, val_string
->str
);
511 if (TREE_CHAIN (fields
) != NULL_TREE
)
512 APPEND (result
, ",\n ");
514 APPEND (result
, ")");
520 print_enumeral_selective (type
, all_decls
)
524 MYSTRING
*result
= newstring ("");
527 for (fields
= TYPE_VALUES (type
);
529 fields
= TREE_CHAIN (fields
))
531 if (TREE_PURPOSE (fields
) != NULL_TREE
)
533 tree decl
= TREE_VALUE (fields
);
534 if (TREE_CODE (decl
) == CONST_DECL
&& DECL_INITIAL (decl
))
536 MYSTRING
*val_string
= decode_constant_selective (DECL_INITIAL (decl
), all_decls
);
538 APPEND (result
, val_string
->str
);
547 print_integer_type (type
)
550 MYSTRING
*result
= newstring ("");
551 MYSTRING
*mode_string
;
552 const char *name_ptr
;
555 if (TREE_TYPE (type
))
557 mode_string
= decode_mode (TREE_TYPE (type
));
558 APPEND (result
, mode_string
->str
);
561 APPEND (result
, "(");
562 mode_string
= decode_constant (TYPE_MIN_VALUE (type
));
563 APPEND (result
, mode_string
->str
);
566 if (TREE_TYPE (type
) != ridpointers
[(int) RID_BIN
])
568 APPEND (result
, ":");
569 mode_string
= decode_constant (TYPE_MAX_VALUE (type
));
570 APPEND (result
, mode_string
->str
);
574 APPEND (result
, ")");
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! */
583 base_type
= TREE_TYPE (type
) ? TREE_TYPE (type
) : type
;
585 if (TREE_UNSIGNED (base_type
))
587 if (base_type
== chill_unsigned_type_node
588 || TYPE_MAIN_VARIANT(base_type
) ==
589 TYPE_MAIN_VARIANT (chill_unsigned_type_node
))
591 else if (base_type
== long_integer_type_node
592 || TYPE_MAIN_VARIANT(base_type
) ==
593 TYPE_MAIN_VARIANT (long_unsigned_type_node
))
595 else if (type
== unsigned_char_type_node
596 || TYPE_MAIN_VARIANT(base_type
) ==
597 TYPE_MAIN_VARIANT (unsigned_char_type_node
))
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
))
612 if (base_type
== chill_integer_type_node
613 || TYPE_MAIN_VARIANT (base_type
) ==
614 TYPE_MAIN_VARIANT (chill_integer_type_node
))
616 else if (base_type
== long_integer_type_node
617 || TYPE_MAIN_VARIANT (base_type
) ==
618 TYPE_MAIN_VARIANT (long_integer_type_node
))
620 else if (type
== signed_char_type_node
621 || TYPE_MAIN_VARIANT (base_type
) ==
622 TYPE_MAIN_VARIANT (signed_char_type_node
))
628 APPEND (result
, name_ptr
);
630 /* see if we have a range */
631 if (TREE_TYPE (type
) != NULL
)
633 mode_string
= decode_constant (TYPE_MIN_VALUE (type
));
634 APPEND (result
, mode_string
->str
);
636 APPEND (result
, ":");
637 mode_string
= decode_constant (TYPE_MAX_VALUE (type
));
638 APPEND (result
, mode_string
->str
);
646 find_enum_parent (enumname
, all_decls
)
652 for (wrk
= all_decls
; wrk
!= NULL_TREE
; wrk
= TREE_CHAIN (wrk
))
654 if (TREE_TYPE (wrk
) != NULL_TREE
&& TREE_CODE (wrk
) != CONST_DECL
&&
655 TREE_CODE (TREE_TYPE (wrk
)) == ENUMERAL_TYPE
)
658 for (list
= TYPE_VALUES (TREE_TYPE (wrk
)); list
!= NULL_TREE
; list
= TREE_CHAIN (list
))
660 if (DECL_NAME (TREE_VALUE (list
)) == enumname
)
669 print_integer_selective (type
, all_decls
)
673 MYSTRING
*result
= newstring ("");
674 MYSTRING
*mode_string
;
676 if (TREE_TYPE (type
))
678 mode_string
= decode_mode_selective (TREE_TYPE (type
), all_decls
);
679 if (mode_string
->len
)
680 APPEND (result
, mode_string
->str
);
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
)
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
690 tree minparent
= find_enum_parent (TYPE_MIN_VALUE (type
), all_decls
);
691 tree maxparent
= find_enum_parent (TYPE_MAX_VALUE (type
), all_decls
);
693 if (minparent
!= NULL_TREE
)
695 if (! CH_ALREADY_GRANTED (minparent
))
697 mode_string
= decode_decl (minparent
);
698 if (mode_string
->len
)
699 APPEND (result
, mode_string
->str
);
701 CH_ALREADY_GRANTED (minparent
) = 1;
704 if (minparent
!= maxparent
&& maxparent
!= NULL_TREE
)
706 if (!CH_ALREADY_GRANTED (maxparent
))
708 mode_string
= decode_decl (maxparent
);
709 if (mode_string
->len
)
711 MAYBE_NEWLINE (result
);
712 APPEND (result
, mode_string
->str
);
715 CH_ALREADY_GRANTED (maxparent
) = 1;
721 mode_string
= decode_constant_selective (TYPE_MIN_VALUE (type
), all_decls
);
722 if (mode_string
->len
)
724 MAYBE_NEWLINE (result
);
725 APPEND (result
, mode_string
->str
);
729 mode_string
= decode_constant_selective (TYPE_MAX_VALUE (type
), all_decls
);
730 if (mode_string
->len
)
732 MAYBE_NEWLINE (result
);
733 APPEND (result
, mode_string
->str
);
740 /* see if we have a range */
741 if (TREE_TYPE (type
) != NULL
)
743 mode_string
= decode_constant_selective (TYPE_MIN_VALUE (type
), all_decls
);
744 if (mode_string
->len
)
745 APPEND (result
, mode_string
->str
);
748 mode_string
= decode_constant_selective (TYPE_MAX_VALUE (type
), all_decls
);
749 if (mode_string
->len
)
751 MAYBE_NEWLINE (result
);
752 APPEND (result
, mode_string
->str
);
764 MYSTRING
*result
= newstring ("");
765 MYSTRING
*mode_string
;
768 if (chill_varying_type_p (type
))
770 mode_string
= grant_array_type (type
);
771 APPEND (result
, mode_string
->str
);
776 fields
= TYPE_FIELDS (type
);
778 APPEND (result
, "STRUCT (");
779 while (fields
!= NULL_TREE
)
781 if (TREE_CODE (TREE_TYPE (fields
)) == UNION_TYPE
)
784 /* Format a tagged variant record type. */
785 APPEND (result
, " CASE ");
786 if (TYPE_TAGFIELDS (TREE_TYPE (fields
)) != NULL_TREE
)
788 tree tag_list
= TYPE_TAGFIELDS (TREE_TYPE (fields
));
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
)
796 APPEND (result
, ", ");
799 APPEND (result
, " OF\n");
800 variants
= TYPE_FIELDS (TREE_TYPE (fields
));
802 /* Each variant is a FIELD_DECL whose type is an anonymous
803 struct within the anonymous union. */
804 while (variants
!= NULL_TREE
)
806 tree tag_list
= TYPE_TAG_VALUES (TREE_TYPE (variants
));
807 tree struct_elts
= TYPE_FIELDS (TREE_TYPE (variants
));
809 while (tag_list
!= NULL_TREE
)
811 tree tag_values
= TREE_VALUE (tag_list
);
812 APPEND (result
, " (");
813 while (tag_values
!= NULL_TREE
)
815 mode_string
= get_tag_value (TREE_VALUE (tag_values
));
816 APPEND (result
, mode_string
->str
);
818 if (TREE_CHAIN (tag_values
) != NULL_TREE
)
820 APPEND (result
, ",\n ");
821 tag_values
= TREE_CHAIN (tag_values
);
825 APPEND (result
, ")");
826 tag_list
= TREE_CHAIN (tag_list
);
828 APPEND (result
, ",");
832 APPEND (result
, " : ");
834 while (struct_elts
!= NULL_TREE
)
836 mode_string
= decode_decl (struct_elts
);
837 APPEND (result
, mode_string
->str
);
840 if (TREE_CHAIN (struct_elts
) != NULL_TREE
)
841 APPEND (result
, ",\n ");
842 struct_elts
= TREE_CHAIN (struct_elts
);
845 variants
= TREE_CHAIN (variants
);
846 if (variants
!= NULL_TREE
847 && TREE_CHAIN (variants
) == NULL_TREE
848 && DECL_NAME (variants
) == ELSE_VARIANT_NAME
)
850 tree else_elts
= TYPE_FIELDS (TREE_TYPE (variants
));
851 APPEND (result
, "\n ELSE ");
852 while (else_elts
!= NULL_TREE
)
854 mode_string
= decode_decl (else_elts
);
855 APPEND (result
, mode_string
->str
);
857 if (TREE_CHAIN (else_elts
) != NULL_TREE
)
858 APPEND (result
, ",\n ");
859 else_elts
= TREE_CHAIN (else_elts
);
863 if (variants
!= NULL_TREE
)
864 APPEND (result
, ",\n");
867 APPEND (result
, "\n ESAC");
871 mode_string
= decode_decl (fields
);
872 APPEND (result
, mode_string
->str
);
876 fields
= TREE_CHAIN (fields
);
877 if (fields
!= NULL_TREE
)
878 APPEND (result
, ",\n ");
880 APPEND (result
, ")");
886 print_struct_selective (type
, all_decls
)
890 MYSTRING
*result
= newstring ("");
891 MYSTRING
*mode_string
;
894 if (chill_varying_type_p (type
))
896 mode_string
= grant_array_type_selective (type
, all_decls
);
897 if (mode_string
->len
)
898 APPEND (result
, mode_string
->str
);
903 fields
= TYPE_FIELDS (type
);
905 while (fields
!= NULL_TREE
)
907 if (TREE_CODE (TREE_TYPE (fields
)) == UNION_TYPE
)
910 /* Format a tagged variant record type. */
912 variants
= TYPE_FIELDS (TREE_TYPE (fields
));
914 /* Each variant is a FIELD_DECL whose type is an anonymous
915 struct within the anonymous union. */
916 while (variants
!= NULL_TREE
)
918 tree tag_list
= TYPE_TAG_VALUES (TREE_TYPE (variants
));
919 tree struct_elts
= TYPE_FIELDS (TREE_TYPE (variants
));
921 while (tag_list
!= NULL_TREE
)
923 tree tag_values
= TREE_VALUE (tag_list
);
924 while (tag_values
!= NULL_TREE
)
926 mode_string
= get_tag_value_selective (TREE_VALUE (tag_values
),
928 if (mode_string
->len
)
930 MAYBE_NEWLINE (result
);
931 APPEND (result
, mode_string
->str
);
934 if (TREE_CHAIN (tag_values
) != NULL_TREE
)
935 tag_values
= TREE_CHAIN (tag_values
);
938 tag_list
= TREE_CHAIN (tag_list
);
943 while (struct_elts
!= NULL_TREE
)
945 mode_string
= decode_decl_selective (struct_elts
, all_decls
);
946 if (mode_string
->len
)
948 MAYBE_NEWLINE (result
);
949 APPEND (result
, mode_string
->str
);
953 struct_elts
= TREE_CHAIN (struct_elts
);
956 variants
= TREE_CHAIN (variants
);
957 if (variants
!= NULL_TREE
958 && TREE_CHAIN (variants
) == NULL_TREE
959 && DECL_NAME (variants
) == ELSE_VARIANT_NAME
)
961 tree else_elts
= TYPE_FIELDS (TREE_TYPE (variants
));
962 while (else_elts
!= NULL_TREE
)
964 mode_string
= decode_decl_selective (else_elts
, all_decls
);
965 if (mode_string
->len
)
967 MAYBE_NEWLINE (result
);
968 APPEND (result
, mode_string
->str
);
971 else_elts
= TREE_CHAIN (else_elts
);
979 mode_string
= decode_decl_selective (fields
, all_decls
);
980 APPEND (result
, mode_string
->str
);
984 fields
= TREE_CHAIN (fields
);
991 print_proc_exceptions (ex
)
994 MYSTRING
*result
= newstring ("");
998 APPEND (result
, "\n EXCEPTIONS (");
999 for ( ; ex
!= NULL_TREE
; ex
= TREE_CHAIN (ex
))
1001 APPEND (result
, IDENTIFIER_POINTER (TREE_VALUE (ex
)));
1002 if (TREE_CHAIN (ex
) != NULL_TREE
)
1003 APPEND (result
, ",\n ");
1005 APPEND (result
, ")");
1011 print_proc_tail (type
, args
, print_argnames
)
1016 MYSTRING
*result
= newstring ("");
1017 MYSTRING
*mode_string
;
1019 int stopat
= list_length (args
) - 3;
1021 /* do the argument modes */
1022 for ( ; args
!= NULL_TREE
;
1023 args
= TREE_CHAIN (args
), count
++)
1026 tree argmode
= TREE_VALUE (args
);
1027 tree attribute
= TREE_PURPOSE (args
);
1029 if (argmode
== void_type_node
)
1032 /* if we have exceptions don't print last 2 arguments */
1033 if (TYPE_RAISES_EXCEPTIONS (type
) && count
== stopat
)
1037 APPEND (result
, ",\n ");
1040 sprintf(buf
, "arg%d ", count
);
1041 APPEND (result
, buf
);
1044 if (attribute
== ridpointers
[(int) RID_LOC
])
1045 argmode
= TREE_TYPE (argmode
);
1046 mode_string
= get_type (argmode
);
1047 APPEND (result
, mode_string
->str
);
1050 if (attribute
!= NULL_TREE
)
1052 sprintf (buf
, " %s", IDENTIFIER_POINTER (attribute
));
1053 APPEND (result
, buf
);
1056 APPEND (result
, ")");
1060 tree retn_type
= TREE_TYPE (type
);
1062 if (retn_type
!= NULL_TREE
1063 && TREE_CODE (retn_type
) != VOID_TYPE
)
1065 mode_string
= get_type (retn_type
);
1066 APPEND (result
, "\n RETURNS (");
1067 APPEND (result
, mode_string
->str
);
1069 if (TREE_CODE (retn_type
) == REFERENCE_TYPE
)
1070 APPEND (result
, " LOC");
1071 APPEND (result
, ")");
1075 mode_string
= print_proc_exceptions (TYPE_RAISES_EXCEPTIONS (type
));
1076 APPEND (result
, mode_string
->str
);
1083 print_proc_tail_selective (type
, args
, all_decls
)
1088 MYSTRING
*result
= newstring ("");
1089 MYSTRING
*mode_string
;
1091 int stopat
= list_length (args
) - 3;
1093 /* do the argument modes */
1094 for ( ; args
!= NULL_TREE
;
1095 args
= TREE_CHAIN (args
), count
++)
1097 tree argmode
= TREE_VALUE (args
);
1098 tree attribute
= TREE_PURPOSE (args
);
1100 if (argmode
== void_type_node
)
1103 /* if we have exceptions don't process last 2 arguments */
1104 if (TYPE_RAISES_EXCEPTIONS (type
) && count
== stopat
)
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
)
1112 MAYBE_NEWLINE (result
);
1113 APPEND (result
, mode_string
->str
);
1120 tree retn_type
= TREE_TYPE (type
);
1122 if (retn_type
!= NULL_TREE
1123 && TREE_CODE (retn_type
) != VOID_TYPE
)
1125 mode_string
= get_type_selective (retn_type
, all_decls
);
1126 if (mode_string
->len
)
1128 MAYBE_NEWLINE (result
);
1129 APPEND (result
, mode_string
->str
);
1138 /* output a mode (or type). */
1144 MYSTRING
*result
= newstring ("");
1145 MYSTRING
*mode_string
;
1147 switch ((enum chill_tree_code
)TREE_CODE (type
))
1150 if (DECL_NAME (type
))
1152 APPEND (result
, IDENTIFIER_POINTER (DECL_NAME (type
)));
1155 type
= TREE_TYPE (type
);
1158 case IDENTIFIER_NODE
:
1159 APPEND (result
, IDENTIFIER_POINTER (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 ");
1169 mode_string
= get_type (TREE_TYPE (type
));
1170 APPEND (result
, mode_string
->str
);
1171 if (TYPE_DOMAIN (type
) != NULL_TREE
)
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
, ")");
1184 mode_string
= grant_array_type (type
);
1185 APPEND (result
, mode_string
->str
);
1190 APPEND (result
, "BOOL");
1194 APPEND (result
, "CHAR");
1198 mode_string
= print_enumeral (type
);
1199 APPEND (result
, mode_string
->str
);
1205 tree args
= TYPE_ARG_TYPES (type
);
1207 APPEND (result
, "PROC (");
1209 mode_string
= print_proc_tail (type
, args
, 0);
1210 APPEND (result
, mode_string
->str
);
1216 mode_string
= print_integer_type (type
);
1217 APPEND (result
, mode_string
->str
);
1222 if (CH_IS_INSTANCE_MODE (type
))
1224 APPEND (result
, "INSTANCE");
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
)
1232 APPEND (result
, "(");
1233 mode_string
= decode_constant (bufsize
);
1234 APPEND (result
, mode_string
->str
);
1235 APPEND (result
, ") ");
1238 if (CH_IS_BUFFER_MODE (type
))
1240 mode_string
= decode_mode (buffer_element_mode (type
));
1241 APPEND (result
, mode_string
->str
);
1246 else if (CH_IS_ACCESS_MODE (type
))
1248 tree indexmode
, recordmode
, dynamic
;
1250 APPEND (result
, "ACCESS");
1251 recordmode
= access_recordmode (type
);
1252 indexmode
= access_indexmode (type
);
1253 dynamic
= access_dynamic (type
);
1255 if (indexmode
!= void_type_node
)
1257 mode_string
= decode_mode (indexmode
);
1258 APPEND (result
, " (");
1259 APPEND (result
, mode_string
->str
);
1260 APPEND (result
, ")");
1263 if (recordmode
!= void_type_node
)
1265 mode_string
= decode_mode (recordmode
);
1266 APPEND (result
, " ");
1267 APPEND (result
, mode_string
->str
);
1270 if (dynamic
!= integer_zero_node
)
1271 APPEND (result
, " DYNAMIC");
1274 else if (CH_IS_TEXT_MODE (type
))
1276 tree indexmode
, dynamic
, length
;
1278 APPEND (result
, "TEXT (");
1279 length
= text_length (type
);
1280 indexmode
= text_indexmode (type
);
1281 dynamic
= text_dynamic (type
);
1283 mode_string
= decode_constant (length
);
1284 APPEND (result
, mode_string
->str
);
1286 APPEND (result
, ")");
1287 if (indexmode
!= void_type_node
)
1289 APPEND (result
, " ");
1290 mode_string
= decode_mode (indexmode
);
1291 APPEND (result
, mode_string
->str
);
1294 if (dynamic
!= integer_zero_node
)
1295 APPEND (result
, " DYNAMIC");
1298 mode_string
= print_struct (type
);
1299 APPEND (result
, mode_string
->str
);
1304 if (TREE_CODE (TREE_TYPE (type
)) == VOID_TYPE
)
1305 APPEND (result
, "PTR");
1308 if (TREE_CODE (TREE_TYPE (type
)) == FUNCTION_TYPE
)
1310 mode_string
= get_type (TREE_TYPE (type
));
1311 APPEND (result
, mode_string
->str
);
1316 APPEND (result
, "REF ");
1317 mode_string
= get_type (TREE_TYPE (type
));
1318 APPEND (result
, mode_string
->str
);
1325 if (TREE_INT_CST_LOW (TYPE_SIZE (type
)) == 32)
1326 APPEND (result
, "REAL");
1328 APPEND (result
, "LONG_REAL");
1332 if (CH_BOOLS_TYPE_P (type
))
1333 mode_string
= grant_array_type (type
);
1336 APPEND (result
, "POWERSET ");
1337 mode_string
= get_type (TYPE_DOMAIN (type
));
1339 APPEND (result
, mode_string
->str
);
1343 case REFERENCE_TYPE
:
1344 mode_string
= get_type (TREE_TYPE (type
));
1345 APPEND (result
, mode_string
->str
);
1350 APPEND (result
, "/* ---- not implemented ---- */");
1358 find_in_decls (id
, all_decls
)
1364 for (wrk
= all_decls
; wrk
!= NULL_TREE
; wrk
= TREE_CHAIN (wrk
))
1366 if (DECL_NAME (wrk
) == id
|| DECL_POSTFIX (wrk
) == id
)
1377 for (i
= RID_UNUSED
; i
< RID_MAX
; i
++)
1379 if (id
== ridpointers
[i
])
1386 grant_seized_identifier (decl
)
1389 seizefile_list
*wrk
= selective_seizes
;
1390 MYSTRING
*mode_string
;
1392 CH_ALREADY_GRANTED (decl
) = 1;
1394 /* comes from a SPEC MODULE in the module */
1395 if (DECL_SEIZEFILE (decl
) == NULL_TREE
)
1398 /* search file already in process */
1401 if (wrk
->filename
== DECL_SEIZEFILE (decl
))
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");
1415 APPEND (wrk
->seizes
, "SEIZE ");
1416 mode_string
= decode_prefix_rename (decl
);
1417 APPEND (wrk
->seizes
, mode_string
->str
);
1419 APPEND (wrk
->seizes
, ";\n");
1423 decode_mode_selective (type
, all_decls
)
1427 MYSTRING
*result
= newstring ("");
1428 MYSTRING
*mode_string
;
1431 switch ((enum chill_tree_code
)TREE_CODE (type
))
1434 /* FIXME: could this ever happen ?? */
1435 if (DECL_NAME (type
))
1438 result
= decode_mode_selective (DECL_NAME (type
), all_decls
);
1443 case IDENTIFIER_NODE
:
1444 if (in_ridpointers (type
))
1445 /* it's a predefined, we must not search the whole list */
1448 decl
= find_in_decls (type
, all_decls
);
1449 if (decl
!= NULL_TREE
)
1451 if (CH_ALREADY_GRANTED (decl
))
1452 /* already processed */
1455 if (TREE_CODE (decl
) == ALIAS_DECL
&& DECL_POSTFIX (decl
) != NULL_TREE
)
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
))
1461 grant_seized_identifier (decl
);
1466 result
= decode_decl (decl
);
1467 mode_string
= decode_decl_selective (decl
, all_decls
);
1468 if (mode_string
->len
)
1470 PREPEND (result
, mode_string
->str
);
1478 mode_string
= get_type_selective (TREE_TYPE (type
), all_decls
);
1479 APPEND (result
, mode_string
->str
);
1484 mode_string
= grant_array_type_selective (type
, all_decls
);
1485 APPEND (result
, mode_string
->str
);
1498 mode_string
= print_enumeral_selective (type
, all_decls
);
1499 if (mode_string
->len
)
1500 APPEND (result
, mode_string
->str
);
1506 tree args
= TYPE_ARG_TYPES (type
);
1508 mode_string
= print_proc_tail_selective (type
, args
, all_decls
);
1509 if (mode_string
->len
)
1510 APPEND (result
, mode_string
->str
);
1516 mode_string
= print_integer_selective (type
, all_decls
);
1517 if (mode_string
->len
)
1518 APPEND (result
, mode_string
->str
);
1523 if (CH_IS_INSTANCE_MODE (type
))
1527 else if (CH_IS_BUFFER_MODE (type
) || CH_IS_EVENT_MODE (type
))
1529 tree bufsize
= max_queue_size (type
);
1530 if (bufsize
!= NULL_TREE
)
1532 mode_string
= decode_constant_selective (bufsize
, all_decls
);
1533 if (mode_string
->len
)
1534 APPEND (result
, mode_string
->str
);
1537 if (CH_IS_BUFFER_MODE (type
))
1539 mode_string
= decode_mode_selective (buffer_element_mode (type
), all_decls
);
1540 if (mode_string
->len
)
1542 MAYBE_NEWLINE (result
);
1543 APPEND (result
, mode_string
->str
);
1549 else if (CH_IS_ACCESS_MODE (type
))
1551 tree indexmode
= access_indexmode (type
);
1552 tree recordmode
= access_recordmode (type
);
1554 if (indexmode
!= void_type_node
)
1556 mode_string
= decode_mode_selective (indexmode
, all_decls
);
1557 if (mode_string
->len
)
1559 if (result
->len
&& result
->str
[result
->len
- 1] != '\n')
1560 APPEND (result
, ";\n");
1561 APPEND (result
, mode_string
->str
);
1565 if (recordmode
!= void_type_node
)
1567 mode_string
= decode_mode_selective (recordmode
, all_decls
);
1568 if (mode_string
->len
)
1570 if (result
->len
&& result
->str
[result
->len
- 1] != '\n')
1571 APPEND (result
, ";\n");
1572 APPEND (result
, mode_string
->str
);
1578 else if (CH_IS_TEXT_MODE (type
))
1580 tree indexmode
= text_indexmode (type
);
1581 tree length
= text_length (type
);
1583 mode_string
= decode_constant_selective (length
, all_decls
);
1584 if (mode_string
->len
)
1585 APPEND (result
, mode_string
->str
);
1587 if (indexmode
!= void_type_node
)
1589 mode_string
= decode_mode_selective (indexmode
, all_decls
);
1590 if (mode_string
->len
)
1592 if (result
->len
&& result
->str
[result
->len
- 1] != '\n')
1593 APPEND (result
, ";\n");
1594 APPEND (result
, mode_string
->str
);
1600 mode_string
= print_struct_selective (type
, all_decls
);
1601 if (mode_string
->len
)
1603 MAYBE_NEWLINE (result
);
1604 APPEND (result
, mode_string
->str
);
1610 if (TREE_CODE (TREE_TYPE (type
)) == VOID_TYPE
)
1614 if (TREE_CODE (TREE_TYPE (type
)) == FUNCTION_TYPE
)
1616 mode_string
= get_type_selective (TREE_TYPE (type
), all_decls
);
1617 if (mode_string
->len
)
1618 APPEND (result
, mode_string
->str
);
1623 mode_string
= get_type_selective (TREE_TYPE (type
), all_decls
);
1624 if (mode_string
->len
)
1625 APPEND (result
, mode_string
->str
);
1636 if (CH_BOOLS_TYPE_P (type
))
1637 mode_string
= grant_array_type_selective (type
, all_decls
);
1639 mode_string
= get_type_selective (TYPE_DOMAIN (type
), all_decls
);
1640 if (mode_string
->len
)
1641 APPEND (result
, mode_string
->str
);
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
);
1653 APPEND (result
, "/* ---- not implemented ---- */");
1664 if (type
== NULL_TREE
|| TREE_CODE (type
) == ERROR_MARK
)
1665 return newstring ("");
1667 return (decode_mode (type
));
1671 get_type_selective (type
, all_decls
)
1675 if (type
== NULL_TREE
|| TREE_CODE (type
) == ERROR_MARK
)
1676 return newstring ("");
1678 return (decode_mode_selective (type
, all_decls
));
1683 is_forbidden (str
, forbid
)
1687 if (forbid
== NULL_TREE
)
1690 if (TREE_CODE (forbid
) == INTEGER_CST
)
1693 while (forbid
!= NULL_TREE
)
1695 if (TREE_VALUE (forbid
) == str
)
1697 forbid
= TREE_CHAIN (forbid
);
1705 decode_constant (init
)
1708 MYSTRING
*result
= newstring ("");
1709 MYSTRING
*tmp_string
;
1710 tree type
= TREE_TYPE (init
);
1714 MYSTRING
*mode_string
;
1716 switch ((enum chill_tree_code
)TREE_CODE (val
))
1719 tmp_string
= decode_constant (TREE_OPERAND (val
, 0));
1720 APPEND (result
, tmp_string
->str
);
1722 val
= TREE_OPERAND (val
, 1); /* argument list */
1723 if (val
!= NULL_TREE
&& TREE_CODE (val
) != TREE_LIST
)
1725 APPEND (result
, " ");
1726 tmp_string
= decode_constant (val
);
1727 APPEND (result
, tmp_string
->str
);
1732 APPEND (result
, " (");
1733 if (val
!= NULL_TREE
)
1737 tmp_string
= decode_constant (TREE_VALUE (val
));
1738 APPEND (result
, tmp_string
->str
);
1740 val
= TREE_CHAIN (val
);
1741 if (val
== NULL_TREE
)
1743 APPEND (result
, ", ");
1746 APPEND (result
, ")");
1751 /* Generate an "expression conversion" expression (a cast). */
1752 tmp_string
= decode_mode (type
);
1754 APPEND (result
, tmp_string
->str
);
1756 APPEND (result
, "(");
1757 val
= TREE_OPERAND (val
, 0);
1758 type
= TREE_TYPE (val
);
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
))
1764 tmp_string
= decode_mode (type
);
1765 APPEND (result
, tmp_string
->str
);
1767 APPEND (result
, " ");
1770 tmp_string
= decode_constant (val
);
1771 APPEND (result
, tmp_string
->str
);
1773 APPEND (result
, ")");
1776 case IDENTIFIER_NODE
:
1777 APPEND (result
, IDENTIFIER_POINTER (val
));
1781 APPEND (result
, "(");
1782 tmp_string
= decode_constant (TREE_OPERAND (val
, 0));
1783 APPEND (result
, tmp_string
->str
);
1785 APPEND (result
, ")");
1788 case UNDEFINED_EXPR
:
1789 APPEND (result
, "*");
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
;
1812 if (TREE_OPERAND (val
, 0) == NULL_TREE
)
1814 APPEND (result
, TREE_OPERAND (val
, 1) == NULL_TREE
? "*" : "ELSE");
1817 op
= ":"; goto binary
;
1819 tmp_string
= decode_constant (TREE_OPERAND (val
, 0));
1820 APPEND (result
, tmp_string
->str
);
1822 APPEND (result
, op
);
1823 tmp_string
= decode_constant (TREE_OPERAND (val
, 1));
1824 APPEND (result
, tmp_string
->str
);
1828 case REPLICATE_EXPR
:
1829 APPEND (result
, "(");
1830 tmp_string
= decode_constant (TREE_OPERAND (val
, 0));
1831 APPEND (result
, tmp_string
->str
);
1833 APPEND (result
, ")");
1834 tmp_string
= decode_constant (TREE_OPERAND (val
, 1));
1835 APPEND (result
, tmp_string
->str
);
1839 case NEGATE_EXPR
: op
= "-"; goto unary
;
1840 case BIT_NOT_EXPR
: op
= " NOT "; goto unary
;
1841 case ADDR_EXPR
: op
= "->"; goto unary
;
1843 APPEND (result
, op
);
1844 tmp_string
= decode_constant (TREE_OPERAND (val
, 0));
1845 APPEND (result
, tmp_string
->str
);
1850 APPEND (result
, display_int_cst (val
));
1854 #ifndef REAL_IS_NOT_DOUBLE
1855 sprintf (wrk
, "%.20g", TREE_REAL_CST (val
));
1857 REAL_VALUE_TO_DECIMAL (TREE_REAL_CST (val
), "%.20g", wrk
);
1859 APPEND (result
, wrk
);
1864 const char *ptr
= TREE_STRING_POINTER (val
);
1865 int i
= TREE_STRING_LENGTH (val
);
1866 APPEND (result
, "\"");
1870 unsigned char c
= *ptr
++;
1872 APPEND (result
, "^^");
1874 APPEND (result
, "\"\"");
1876 APPEND (result
, "^J");
1877 else if (c
< ' ' || c
> '~')
1879 sprintf (buf
, "^(%u)", c
);
1880 APPEND (result
, buf
);
1886 APPEND (result
, buf
);
1889 APPEND (result
, "\"");
1894 val
= TREE_OPERAND (val
, 1);
1895 if (type
!= NULL
&& TREE_CODE (type
) == SET_TYPE
1896 && CH_BOOLS_TYPE_P (type
))
1898 /* It's a bitstring. */
1899 tree domain
= TYPE_DOMAIN (type
);
1900 tree domain_max
= TYPE_MAX_VALUE (domain
);
1904 if (TREE_CODE (domain_max
) != INTEGER_CST
1905 || (val
&& TREE_CODE (val
) != TREE_LIST
))
1908 len
= TREE_INT_CST_LOW (domain_max
) + 1;
1909 if (TREE_CODE (init
) != CONSTRUCTOR
)
1911 buf
= (char *) alloca (len
+ 10);
1916 if (get_set_constructor_bits (init
, ptr
, len
))
1918 for (; --len
>= 0; ptr
++)
1922 APPEND (result
, buf
);
1926 { /* It's some kind of tuple */
1927 if (type
!= NULL_TREE
)
1929 mode_string
= get_type (type
);
1930 APPEND (result
, mode_string
->str
);
1932 APPEND (result
, " ");
1934 if (val
== NULL_TREE
1935 || TREE_CODE (val
) == ERROR_MARK
)
1936 APPEND (result
, "[ ]");
1937 else if (TREE_CODE (val
) != TREE_LIST
)
1941 APPEND (result
, "[");
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
)
1951 val_string
= decode_constant (lo_val
);
1952 APPEND (result
, val_string
->str
);
1954 APPEND (result
, ":");
1956 val_string
= decode_constant (hi_val
);
1957 APPEND (result
, val_string
->str
);
1959 val
= TREE_CHAIN (val
);
1960 if (val
== NULL_TREE
)
1962 APPEND (result
, ", ");
1964 APPEND (result
, "]");
1972 mode_string
= decode_constant (TREE_OPERAND (init
, 0));
1973 APPEND (result
, mode_string
->str
);
1975 op1
= TREE_OPERAND (init
, 1);
1976 if (TREE_CODE (op1
) != IDENTIFIER_NODE
)
1978 error ("decode_constant: invalid component_ref");
1981 APPEND (result
, ".");
1982 APPEND (result
, IDENTIFIER_POINTER (op1
));
1986 error ("decode_constant: mode and value mismatch");
1989 error ("decode_constant: cannot decode this mode");
1996 decode_constant_selective (init
, all_decls
)
2000 MYSTRING
*result
= newstring ("");
2001 MYSTRING
*tmp_string
;
2002 tree type
= TREE_TYPE (init
);
2004 MYSTRING
*mode_string
;
2006 switch ((enum chill_tree_code
)TREE_CODE (val
))
2009 tmp_string
= decode_constant_selective (TREE_OPERAND (val
, 0), all_decls
);
2010 if (tmp_string
->len
)
2011 APPEND (result
, tmp_string
->str
);
2013 val
= TREE_OPERAND (val
, 1); /* argument list */
2014 if (val
!= NULL_TREE
&& TREE_CODE (val
) != TREE_LIST
)
2016 tmp_string
= decode_constant_selective (val
, all_decls
);
2017 if (tmp_string
->len
)
2019 MAYBE_NEWLINE (result
);
2020 APPEND (result
, tmp_string
->str
);
2026 if (val
!= NULL_TREE
)
2030 tmp_string
= decode_constant_selective (TREE_VALUE (val
), all_decls
);
2031 if (tmp_string
->len
)
2033 MAYBE_NEWLINE (result
);
2034 APPEND (result
, tmp_string
->str
);
2037 val
= TREE_CHAIN (val
);
2038 if (val
== NULL_TREE
)
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
);
2051 val
= TREE_OPERAND (val
, 0);
2052 type
= TREE_TYPE (val
);
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
))
2058 tmp_string
= decode_mode_selective (type
, all_decls
);
2059 if (tmp_string
->len
)
2060 APPEND (result
, tmp_string
->str
);
2064 tmp_string
= decode_constant_selective (val
, all_decls
);
2065 if (tmp_string
->len
)
2066 APPEND (result
, tmp_string
->str
);
2070 case IDENTIFIER_NODE
:
2071 tmp_string
= decode_mode_selective (val
, all_decls
);
2072 if (tmp_string
->len
)
2073 APPEND (result
, tmp_string
->str
);
2078 tmp_string
= decode_constant_selective (TREE_OPERAND (val
, 0), all_decls
);
2079 if (tmp_string
->len
)
2080 APPEND (result
, tmp_string
->str
);
2084 case UNDEFINED_EXPR
:
2090 case TRUNC_DIV_EXPR
:
2091 case FLOOR_MOD_EXPR
:
2092 case TRUNC_MOD_EXPR
:
2096 case TRUTH_ORIF_EXPR
:
2098 case TRUTH_ANDIF_EXPR
:
2108 if (TREE_OPERAND (val
, 0) == NULL_TREE
)
2112 tmp_string
= decode_constant_selective (TREE_OPERAND (val
, 0), all_decls
);
2113 if (tmp_string
->len
)
2114 APPEND (result
, tmp_string
->str
);
2116 tmp_string
= decode_constant_selective (TREE_OPERAND (val
, 1), all_decls
);
2117 if (tmp_string
->len
)
2119 MAYBE_NEWLINE (result
);
2120 APPEND (result
, tmp_string
->str
);
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
);
2130 tmp_string
= decode_constant_selective (TREE_OPERAND (val
, 1), all_decls
);
2131 if (tmp_string
->len
)
2133 MAYBE_NEWLINE (result
);
2134 APPEND (result
, tmp_string
->str
);
2142 tmp_string
= decode_constant_selective (TREE_OPERAND (val
, 0), all_decls
);
2143 if (tmp_string
->len
)
2144 APPEND (result
, tmp_string
->str
);
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. */
2164 { /* It's some kind of tuple */
2165 if (type
!= NULL_TREE
)
2167 mode_string
= get_type_selective (type
, all_decls
);
2168 if (mode_string
->len
)
2169 APPEND (result
, mode_string
->str
);
2172 if (val
== NULL_TREE
2173 || TREE_CODE (val
) == ERROR_MARK
)
2175 else if (TREE_CODE (val
) != TREE_LIST
)
2181 tree lo_val
= TREE_PURPOSE (val
);
2182 tree hi_val
= TREE_VALUE (val
);
2183 MYSTRING
*val_string
;
2184 if (lo_val
!= NULL_TREE
)
2186 val_string
= decode_constant_selective (lo_val
, all_decls
);
2187 if (val_string
->len
)
2188 APPEND (result
, val_string
->str
);
2191 val_string
= decode_constant_selective (hi_val
, all_decls
);
2192 if (val_string
->len
)
2194 MAYBE_NEWLINE (result
);
2195 APPEND (result
, val_string
->str
);
2198 val
= TREE_CHAIN (val
);
2199 if (val
== NULL_TREE
)
2207 mode_string
= decode_constant_selective (TREE_OPERAND (init
, 0), all_decls
);
2208 if (mode_string
->len
)
2209 APPEND (result
, mode_string
->str
);
2214 error ("decode_constant_selective: mode and value mismatch");
2217 error ("decode_constant_selective: cannot decode this mode");
2223 /* Assuming DECL is an ALIAS_DECL, return its prefix rename clause. */
2226 decode_prefix_rename (decl
)
2229 MYSTRING
*result
= newstring ("");
2230 if (DECL_OLD_PREFIX (decl
) || DECL_NEW_PREFIX (decl
))
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
, ")!");
2240 if (DECL_POSTFIX_ALL (decl
))
2241 APPEND (result
, "ALL");
2243 APPEND (result
, IDENTIFIER_POINTER (DECL_POSTFIX (decl
)));
2251 MYSTRING
*result
= newstring ("");
2252 MYSTRING
*mode_string
;
2255 switch ((enum chill_tree_code
)TREE_CODE (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
);
2265 if ((enum chill_tree_code
)TREE_CODE (decl
) == BASED_DECL
)
2267 APPEND (result
, " BASED (");
2268 APPEND (result
, IDENTIFIER_POINTER (DECL_ABSTRACT_ORIGIN (decl
)));
2269 APPEND (result
, ")");
2274 if (CH_DECL_SIGNAL (decl
))
2276 /* this is really a signal */
2277 tree fields
= TYPE_FIELDS (TREE_TYPE (decl
));
2278 tree signame
= DECL_NAME (decl
);
2281 APPEND (result
, "SIGNAL ");
2282 APPEND (result
, IDENTIFIER_POINTER (signame
));
2283 if (IDENTIFIER_SIGNAL_DATA (signame
))
2285 APPEND (result
, " = (");
2286 for ( ; fields
!= NULL_TREE
;
2287 fields
= TREE_CHAIN (fields
))
2289 MYSTRING
*mode_string
;
2291 mode_string
= get_type (TREE_TYPE (fields
));
2292 APPEND (result
, mode_string
->str
);
2294 if (TREE_CHAIN (fields
) != NULL_TREE
)
2295 APPEND (result
, ", ");
2297 APPEND (result
, ")");
2299 sigdest
= IDENTIFIER_SIGNAL_DEST (signame
);
2300 if (sigdest
!= NULL_TREE
)
2302 APPEND (result
, " TO ");
2303 APPEND (result
, IDENTIFIER_POINTER (DECL_NAME (sigdest
)));
2308 /* avoid defining a mode as itself */
2309 if (CH_NOVELTY (TREE_TYPE (decl
)) == decl
)
2310 APPEND (result
, "NEWMODE ");
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
);
2325 type
= TREE_TYPE (decl
);
2326 args
= TYPE_ARG_TYPES (type
);
2328 APPEND (result
, IDENTIFIER_POINTER (DECL_NAME (decl
)));
2330 if (CH_DECL_PROCESS (decl
))
2331 APPEND (result
, ": PROCESS (");
2333 APPEND (result
, ": PROC (");
2335 args
= TYPE_ARG_TYPES (type
);
2337 mode_string
= print_proc_tail (type
, args
, 1);
2338 APPEND (result
, mode_string
->str
);
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");
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
);
2360 if (DECL_INITIAL (decl
) != NULL_TREE
)
2362 mode_string
= decode_layout (DECL_INITIAL (decl
));
2363 APPEND (result
, mode_string
->str
);
2367 if (is_forbidden (DECL_NAME (decl
), forbid
))
2368 APPEND (result
, " FORBID");
2373 if (DECL_INITIAL (decl
) == NULL_TREE
2374 || TREE_CODE (DECL_INITIAL (decl
)) == ERROR_MARK
)
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
);
2382 APPEND (result
, " = ");
2383 mode_string
= decode_constant (DECL_INITIAL (decl
));
2384 APPEND (result
, mode_string
->str
);
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
))
2393 static int restricted
= 0;
2395 if (DECL_SEIZEFILE (decl
) != use_seizefile_name
2396 && DECL_SEIZEFILE (decl
))
2398 use_seizefile_name
= DECL_SEIZEFILE (decl
);
2399 restricted
= use_seizefile_name
== NULL_TREE
? 0 : CH_USE_SEIZEFILE_RESTRICTED (use_seizefile_name
);
2401 grant_use_seizefile (IDENTIFIER_POINTER (use_seizefile_name
));
2402 mark_use_seizefile_written (use_seizefile_name
);
2406 APPEND (result
, "SEIZE ");
2407 mode_string
= decode_prefix_rename (decl
);
2408 APPEND (result
, mode_string
->str
);
2415 APPEND (result
, "----- not implemented ------");
2422 decode_decl_selective (decl
, all_decls
)
2426 MYSTRING
*result
= newstring ("");
2427 MYSTRING
*mode_string
;
2430 if (CH_ALREADY_GRANTED (decl
))
2434 CH_ALREADY_GRANTED (decl
) = 1;
2436 switch ((int)TREE_CODE (decl
))
2440 mode_string
= get_type_selective (TREE_TYPE (decl
), all_decls
);
2441 if (mode_string
->len
)
2442 APPEND (result
, mode_string
->str
);
2444 if ((enum chill_tree_code
)TREE_CODE (decl
) == BASED_DECL
)
2446 mode_string
= decode_mode_selective (DECL_ABSTRACT_ORIGIN (decl
), all_decls
);
2447 if (mode_string
->len
)
2448 PREPEND (result
, mode_string
->str
);
2454 if (CH_DECL_SIGNAL (decl
))
2456 /* this is really a signal */
2457 tree fields
= TYPE_FIELDS (TREE_TYPE (decl
));
2458 tree signame
= DECL_NAME (decl
);
2461 if (IDENTIFIER_SIGNAL_DATA (signame
))
2463 for ( ; fields
!= NULL_TREE
;
2464 fields
= TREE_CHAIN (fields
))
2466 MYSTRING
*mode_string
;
2468 mode_string
= get_type_selective (TREE_TYPE (fields
),
2470 if (mode_string
->len
)
2471 APPEND (result
, mode_string
->str
);
2475 sigdest
= IDENTIFIER_SIGNAL_DEST (signame
);
2476 if (sigdest
!= NULL_TREE
)
2478 mode_string
= decode_mode_selective (DECL_NAME (sigdest
), all_decls
);
2479 if (mode_string
->len
)
2481 MAYBE_NEWLINE (result
);
2482 APPEND (result
, mode_string
->str
);
2489 /* avoid defining a mode as itself */
2490 mode_string
= decode_mode_selective (TREE_TYPE (decl
), all_decls
);
2491 APPEND (result
, mode_string
->str
);
2500 type
= TREE_TYPE (decl
);
2501 args
= TYPE_ARG_TYPES (type
);
2503 args
= TYPE_ARG_TYPES (type
);
2505 mode_string
= print_proc_tail_selective (type
, args
, all_decls
);
2506 if (mode_string
->len
)
2507 APPEND (result
, mode_string
->str
);
2513 mode_string
= get_type_selective (TREE_TYPE (decl
), all_decls
);
2514 if (mode_string
->len
)
2515 APPEND (result
, mode_string
->str
);
2520 if (DECL_INITIAL (decl
) == NULL_TREE
2521 || TREE_CODE (DECL_INITIAL (decl
)) == ERROR_MARK
)
2523 mode_string
= get_type_selective (TREE_TYPE (decl
), all_decls
);
2524 if (mode_string
->len
)
2525 APPEND (result
, mode_string
->str
);
2527 mode_string
= decode_constant_selective (DECL_INITIAL (decl
), all_decls
);
2528 if (mode_string
->len
)
2530 MAYBE_NEWLINE (result
);
2531 APPEND (result
, mode_string
->str
);
2537 MAYBE_NEWLINE (result
);
2542 globalize_decl (decl
)
2545 if (!TREE_PUBLIC (decl
) && DECL_NAME (decl
) &&
2546 (TREE_CODE (decl
) == VAR_DECL
|| TREE_CODE (decl
) == FUNCTION_DECL
))
2548 const char *name
= XSTR (XEXP (DECL_RTL (decl
), 0), 0);
2550 if (!first_global_object_name
)
2551 first_global_object_name
= name
+ (name
[0] == '*');
2552 ASM_GLOBALIZE_LABEL (asm_out_file
, name
);
2558 grant_one_decl (decl
)
2563 if (DECL_SOURCE_LINE (decl
) == 0)
2565 result
= decode_decl (decl
);
2568 APPEND (result
, ";\n");
2569 APPEND (gstring
, result
->str
);
2575 grant_one_decl_selective (decl
, all_decls
)
2582 tree d
= DECL_ABSTRACT_ORIGIN (decl
);
2584 if (CH_ALREADY_GRANTED (d
))
2588 result
= decode_decl (d
);
2596 APPEND (result
, ";\n");
2598 /* now process all undefined items in the decl */
2599 fixups
= decode_decl_selective (d
, all_decls
);
2602 PREPEND (result
, fixups
->str
);
2606 /* we have finished a decl */
2607 APPEND (selective_gstring
, result
->str
);
2612 compare_memory_file (fname
, buf
)
2619 /* check if we have something to write */
2620 if (!buf
|| !strlen (buf
))
2623 if ((fb
= fopen (fname
, "r")) == NULL
)
2626 while ((c
= getc (fb
)) != EOF
)
2635 return (*buf
? 1 : 0);
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
))
2650 fb
= fopen (grant_file_name
, "w");
2652 fatal_io_error ("can't open %s", grant_file_name
);
2654 /* write file. Due to problems with record sizes on VAX/VMS
2655 write string to '\n' */
2657 /* do it this way for VMS, cause of problems with
2662 p1
= strchr (p
, '\n');
2665 fprintf (fb
, "%s", p
);
2670 /* faster way to write */
2671 if (write (fileno (fb
), gstring
->str
, gstring
->len
) < 0)
2673 int save_errno
= errno
;
2675 unlink (grant_file_name
);
2677 fatal_io_error ("can't write to %s", grant_file_name
);
2684 /* handle grant statement */
2687 set_default_grant_file ()
2693 fname
= dump_base_name
; /* Probably invoked via gcc */
2695 { /* Probably invoked directly (not via gcc) */
2696 fname
= asm_file_name
;
2698 fname
= main_input_filename
? main_input_filename
: input_filename
;
2703 p
= strrchr (fname
, '.');
2706 tmp
= (char *) alloca (strlen (fname
) + 10);
2707 strcpy (tmp
, fname
);
2713 tmp
= (char *) alloca (i
+ 10);
2714 strncpy (tmp
, fname
, i
);
2717 strcat (tmp
, ".grt");
2718 default_grant_file
= build_string (strlen (tmp
), tmp
);
2720 grant_file_name
= TREE_STRING_POINTER (default_grant_file
);
2722 if (gstring
== NULL
)
2723 gstring
= newstring ("");
2724 if (selective_gstring
== NULL
)
2725 selective_gstring
= newstring ("");
2728 /* Make DECL visible under the name NAME in the (fake) outermost scope. */
2731 push_granted (name
, decl
)
2732 tree name ATTRIBUTE_UNUSED
, decl ATTRIBUTE_UNUSED
;
2735 IDENTIFIER_GRANTED_VALUE (name
) = decl
;
2736 granted_decls
= tree_cons (name
, decl
, granted_decls
);
2741 chill_grant (old_prefix
, new_prefix
, postfix
, forbid
)
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
));
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
;
2764 warning ("FORBID is not yet implemented"); /* FIXME */
2768 /* flag GRANT ALL only once. Avoids search in case of GRANT ALL. */
2769 static int grant_all_seen
= 0;
2771 /* check if a decl is in the list of granted decls. */
2773 search_in_list (name
, granted_decls
)
2779 for (vars
= granted_decls
; vars
!= NULL_TREE
; vars
= TREE_CHAIN (vars
))
2780 if (DECL_SOURCE_LINE (vars
))
2782 if (DECL_POSTFIX_ALL (vars
))
2787 else if (name
== DECL_NAME (vars
))
2795 really_grant_this (decl
, granted_decls
)
2799 /* we never grant labels at module level */
2800 if ((enum chill_tree_code
)TREE_CODE (decl
) == LABEL_DECL
)
2806 switch ((enum chill_tree_code
)TREE_CODE (decl
))
2811 return search_in_list (DECL_NAME (decl
), granted_decls
);
2816 if (CH_DECL_SIGNAL (decl
))
2817 return search_in_list (DECL_NAME (decl
), granted_decls
);
2824 /* this nerver should happen */
2825 error_with_decl (decl
, "function \"really_grant_this\" called for `%s'");
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"
2835 write_spec_module (decls
, granted_decls
)
2842 if (granted_decls
== NULL_TREE
)
2845 use_seizefile_name
= NULL_TREE
;
2847 if (!header_written
)
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
);
2856 APPEND (gstring
, IDENTIFIER_POINTER (current_module
->name
));
2857 APPEND (gstring
, ": SPEC MODULE\n");
2859 /* first of all we look for GRANT ALL specified */
2860 search_in_list (NULL_TREE
, granted_decls
);
2862 if (grant_all_seen
!= 0)
2864 /* write all identifiers to grant file */
2865 for (vars
= decls
; vars
!= NULL_TREE
; vars
= TREE_CHAIN (vars
))
2867 if (DECL_SOURCE_LINE (vars
))
2869 if (DECL_NAME (vars
))
2871 if ((TREE_CODE (vars
) != CONST_DECL
|| !CH_DECL_ENUM (vars
)) &&
2872 really_grant_this (vars
, granted_decls
))
2873 grant_one_decl (vars
);
2875 else if (DECL_POSTFIX_ALL (vars
))
2877 static int restricted
= 0;
2879 if (DECL_SEIZEFILE (vars
) != use_seizefile_name
2880 && DECL_SEIZEFILE (vars
))
2882 use_seizefile_name
= DECL_SEIZEFILE (vars
);
2883 restricted
= use_seizefile_name
== NULL_TREE
? 0 : CH_USE_SEIZEFILE_RESTRICTED (use_seizefile_name
);
2885 grant_use_seizefile (IDENTIFIER_POINTER (use_seizefile_name
));
2886 mark_use_seizefile_written (use_seizefile_name
);
2890 APPEND (gstring
, "SEIZE ALL;\n");
2898 seizefile_list
*wrk
, *x
;
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 */
2904 if (selective_gstring
== 0)
2905 selective_gstring
= newstring ("");
2907 /* first of all process all SEIZE ALL's */
2908 for (vars
= decls
; vars
!= NULL_TREE
; vars
= TREE_CHAIN (vars
))
2910 if (DECL_SOURCE_LINE (vars
)
2911 && DECL_POSTFIX_ALL (vars
))
2912 grant_seized_identifier (vars
);
2915 /* now walk through granted decls */
2916 granted_decls
= nreverse (granted_decls
);
2917 for (vars
= granted_decls
; vars
!= NULL_TREE
; vars
= TREE_CHAIN (vars
))
2919 grant_one_decl_selective (vars
, decls
);
2921 granted_decls
= nreverse (granted_decls
);
2923 /* append all SEIZES */
2924 wrk
= selective_seizes
;
2928 APPEND (gstring
, wrk
->seizes
->str
);
2933 selective_seizes
= 0;
2935 /* append generated string to grant file */
2936 APPEND (gstring
, selective_gstring
->str
);
2937 FREE (selective_gstring
);
2938 selective_gstring
= NULL
;
2941 for (vars
= granted_decls
; vars
!= NULL_TREE
; vars
= TREE_CHAIN (vars
))
2942 if (DECL_SOURCE_LINE (vars
))
2944 MYSTRING
*mode_string
= decode_prefix_rename (vars
);
2945 APPEND (gstring
, "GRANT ");
2946 APPEND (gstring
, mode_string
->str
);
2948 APPEND (gstring
, ";\n");
2951 APPEND (gstring
, "END;\n");
2952 spec_module_generated
= 1;
2954 /* initialize this for next spec module */
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.
2964 chill_finish_compile ()
2967 tree chill_init_function
;
2970 build_enum_tables ();
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
)
2977 extern tree initializer_type
;
2978 static tree chill_init_name
;
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,
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
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. */
2997 /* If we don't do this spoof, we get the name of the first
2998 tasking_code variable, and not the file name. */
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
;
3005 /* strip off the file's extension, if any. */
3006 q
= strrchr (IDENTIFIER_POINTER (chill_init_name
), '.');
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
;
3016 /* For each module that we've compiled, that had module-level
3017 code to be called, add its entry to the global initializer
3024 for (module_init
= module_init_list
;
3025 module_init
!= NULL_TREE
;
3026 module_init
= TREE_CHAIN (module_init
))
3028 tree init_entry
= TREE_VALUE (module_init
);
3030 /* assign module_entry.next := _ch_init_list; */
3032 build_chill_modify_expr (
3033 build_component_ref (init_entry
,
3034 get_identifier ("__INIT_NEXT")),
3037 /* assign _ch_init_list := &module_entry; */
3039 build_chill_modify_expr (global_list
,
3040 build1 (ADDR_EXPR
, ptr_type_node
, init_entry
)));
3044 tasking_registry ();
3046 make_decl_rtl (current_function_decl
, NULL
, 1);
3048 finish_chill_function ();
3050 if (pass
== 2 && targetm
.have_ctors_dtors
)
3051 (* targetm
.asm_out
.constructor
)
3052 (XEXP (DECL_RTL (chill_init_function
), 0), DEFAULT_INIT_PRIORITY
);
3054 /* ready now to link decls onto this list in pass 2. */
3055 module_init_list
= NULL_TREE
;
3056 tasking_list
= NULL_TREE
;