Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/gcc-interface/misc.c @ 131:84e7813d76e9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
comparison
equal deleted inserted replaced
111:04ced10e8804 131:84e7813d76e9
4 * * 4 * *
5 * M I S C * 5 * M I S C *
6 * * 6 * *
7 * C Implementation File * 7 * C Implementation File *
8 * * 8 * *
9 * Copyright (C) 1992-2017, Free Software Foundation, Inc. * 9 * Copyright (C) 1992-2018, Free Software Foundation, Inc. *
10 * * 10 * *
11 * GNAT is free software; you can redistribute it and/or modify it under * 11 * GNAT is free software; you can redistribute it and/or modify it under *
12 * terms of the GNU General Public License as published by the Free Soft- * 12 * terms of the GNU General Public License as published by the Free Soft- *
13 * ware Foundation; either version 3, or (at your option) any later ver- * 13 * ware Foundation; either version 3, or (at your option) any later ver- *
14 * sion. GNAT is distributed in the hope that it will be useful, but WITH- * 14 * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
75 int optimize; 75 int optimize;
76 76
77 #undef optimize_size 77 #undef optimize_size
78 int optimize_size; 78 int optimize_size;
79 79
80 #undef flag_compare_debug
81 int flag_compare_debug;
82
83 #undef flag_short_enums 80 #undef flag_short_enums
84 int flag_short_enums; 81 int flag_short_enums;
85 82
86 #undef flag_stack_check 83 #undef flag_stack_check
87 enum stack_check_type flag_stack_check = NO_STACK_CHECK; 84 enum stack_check_type flag_stack_check = NO_STACK_CHECK;
136 /* Decode all the language specific options that cannot be decoded by GCC. 133 /* Decode all the language specific options that cannot be decoded by GCC.
137 The option decoding phase of GCC calls this routine on the flags that 134 The option decoding phase of GCC calls this routine on the flags that
138 are marked as Ada-specific. Return true on success or false on failure. */ 135 are marked as Ada-specific. Return true on success or false on failure. */
139 136
140 static bool 137 static bool
141 gnat_handle_option (size_t scode, const char *arg, int value, int kind, 138 gnat_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value,
142 location_t loc, const struct cl_option_handlers *handlers) 139 int kind, location_t loc,
140 const struct cl_option_handlers *handlers)
143 { 141 {
144 enum opt_code code = (enum opt_code) scode; 142 enum opt_code code = (enum opt_code) scode;
145 143
146 switch (code) 144 switch (code)
147 { 145 {
168 /* These are handled by the front-end. */ 166 /* These are handled by the front-end. */
169 break; 167 break;
170 168
171 case OPT_fshort_enums: 169 case OPT_fshort_enums:
172 case OPT_fsigned_char: 170 case OPT_fsigned_char:
171 case OPT_funsigned_char:
173 /* These are handled by the middle-end. */ 172 /* These are handled by the middle-end. */
174 break; 173 break;
175 174
176 case OPT_fbuiltin_printf: 175 case OPT_fbuiltin_printf:
177 /* This is ignored in Ada but needs to be accepted so it can be 176 /* This is ignored in Ada but needs to be accepted so it can be
260 flag_excess_precision_cmdline = EXCESS_PRECISION_FAST; 259 flag_excess_precision_cmdline = EXCESS_PRECISION_FAST;
261 260
262 /* No psABI change warnings for Ada. */ 261 /* No psABI change warnings for Ada. */
263 warn_psabi = 0; 262 warn_psabi = 0;
264 263
264 /* No return type warnings for Ada. */
265 warn_return_type = 0;
266
267 /* No string overflow warnings for Ada. */
268 warn_stringop_overflow = 0;
269
265 /* No caret by default for Ada. */ 270 /* No caret by default for Ada. */
266 if (!global_options_set.x_flag_diagnostics_show_caret) 271 if (!global_options_set.x_flag_diagnostics_show_caret)
267 global_dc->show_caret = false; 272 global_dc->show_caret = false;
268 273
269 /* Warn only if STABS is not the default: we don't want to emit a warning if 274 /* Warn only if STABS is not the default: we don't want to emit a warning if
274 279
275 /* Copy global settings to local versions. */ 280 /* Copy global settings to local versions. */
276 gnat_encodings = global_options.x_gnat_encodings; 281 gnat_encodings = global_options.x_gnat_encodings;
277 optimize = global_options.x_optimize; 282 optimize = global_options.x_optimize;
278 optimize_size = global_options.x_optimize_size; 283 optimize_size = global_options.x_optimize_size;
279 flag_compare_debug = global_options.x_flag_compare_debug;
280 flag_stack_check = global_options.x_flag_stack_check; 284 flag_stack_check = global_options.x_flag_stack_check;
281 flag_short_enums = global_options.x_flag_short_enums; 285 flag_short_enums = global_options.x_flag_short_enums;
282 286
283 /* Unfortunately the post_options hook is called before the value of 287 /* Unfortunately the post_options hook is called before the value of
284 flag_short_enums is autodetected, if need be. Mimic the process 288 flag_short_enums is autodetected, if need be. Mimic the process
337 temp_loc.Low_Bound = 1; 341 temp_loc.Low_Bound = 1;
338 temp_loc.High_Bound = strlen (loc); 342 temp_loc.High_Bound = strlen (loc);
339 sp_loc.Bounds = &temp_loc; 343 sp_loc.Bounds = &temp_loc;
340 sp_loc.Array = loc; 344 sp_loc.Array = loc;
341 345
342 Current_Error_Node = error_gnat_node;
343 Compiler_Abort (sp, sp_loc, true); 346 Compiler_Abort (sp, sp_loc, true);
344 } 347 }
345 348
346 /* Perform all the initialization steps that are language-specific. */ 349 /* Perform all the initialization steps that are language-specific. */
347 350
464 gnat_print_type (FILE *file, tree node, int indent) 467 gnat_print_type (FILE *file, tree node, int indent)
465 { 468 {
466 switch (TREE_CODE (node)) 469 switch (TREE_CODE (node))
467 { 470 {
468 case FUNCTION_TYPE: 471 case FUNCTION_TYPE:
472 case METHOD_TYPE:
469 print_node (file, "ci/co list", TYPE_CI_CO_LIST (node), indent + 4); 473 print_node (file, "ci/co list", TYPE_CI_CO_LIST (node), indent + 4);
470 break; 474 break;
471 475
472 case INTEGER_TYPE: 476 case INTEGER_TYPE:
473 if (TYPE_MODULAR_P (node)) 477 if (TYPE_MODULAR_P (node))
675 gcc_unreachable (); 679 gcc_unreachable ();
676 } 680 }
677 681
678 /* Return true if types T1 and T2 are identical for type hashing purposes. 682 /* Return true if types T1 and T2 are identical for type hashing purposes.
679 Called only after doing all language independent checks. At present, 683 Called only after doing all language independent checks. At present,
680 this function is only called when both types are FUNCTION_TYPE. */ 684 this is only called when both types are FUNCTION_TYPE or METHOD_TYPE. */
681 685
682 static bool 686 static bool
683 gnat_type_hash_eq (const_tree t1, const_tree t2) 687 gnat_type_hash_eq (const_tree t1, const_tree t2)
684 { 688 {
685 gcc_assert (TREE_CODE (t1) == FUNCTION_TYPE); 689 gcc_assert (FUNC_OR_METHOD_TYPE_P (t1) && TREE_CODE (t1) == TREE_CODE (t2));
686 return fntype_same_flags_p (t1, TYPE_CI_CO_LIST (t2), 690 return fntype_same_flags_p (t1, TYPE_CI_CO_LIST (t2),
687 TYPE_RETURN_UNCONSTRAINED_P (t2), 691 TYPE_RETURN_UNCONSTRAINED_P (t2),
688 TYPE_RETURN_BY_DIRECT_REF_P (t2), 692 TYPE_RETURN_BY_DIRECT_REF_P (t2),
689 TREE_ADDRESSABLE (t2)); 693 TREE_ADDRESSABLE (t2));
690 } 694 }
728 gnat_type_max_size (const_tree gnu_type) 732 gnat_type_max_size (const_tree gnu_type)
729 { 733 {
730 /* First see what we can get from TYPE_SIZE_UNIT, which might not 734 /* First see what we can get from TYPE_SIZE_UNIT, which might not
731 be constant even for simple expressions if it has already been 735 be constant even for simple expressions if it has already been
732 elaborated and possibly replaced by a VAR_DECL. */ 736 elaborated and possibly replaced by a VAR_DECL. */
733 tree max_unitsize = max_size (TYPE_SIZE_UNIT (gnu_type), true); 737 tree max_size_unit = max_size (TYPE_SIZE_UNIT (gnu_type), true);
734 738
735 /* If we don't have a constant, try to look at attributes which should have 739 /* If we don't have a constant, try to look at attributes which should have
736 stayed untouched. */ 740 stayed untouched. */
737 if (!tree_fits_uhwi_p (max_unitsize)) 741 if (!tree_fits_uhwi_p (max_size_unit))
738 { 742 {
739 /* For record types, see what we can get from TYPE_ADA_SIZE. */ 743 /* For record types, see what we can get from TYPE_ADA_SIZE. */
740 if (RECORD_OR_UNION_TYPE_P (gnu_type) 744 if (RECORD_OR_UNION_TYPE_P (gnu_type)
741 && !TYPE_FAT_POINTER_P (gnu_type) 745 && !TYPE_FAT_POINTER_P (gnu_type)
742 && TYPE_ADA_SIZE (gnu_type)) 746 && TYPE_ADA_SIZE (gnu_type))
743 { 747 {
744 tree max_adasize = max_size (TYPE_ADA_SIZE (gnu_type), true); 748 tree max_ada_size = max_size (TYPE_ADA_SIZE (gnu_type), true);
745 749
746 /* If we have succeeded in finding a constant, round it up to the 750 /* If we have succeeded in finding a constant, round it up to the
747 type's alignment and return the result in units. */ 751 type's alignment and return the result in units. */
748 if (tree_fits_uhwi_p (max_adasize)) 752 if (tree_fits_uhwi_p (max_ada_size))
749 max_unitsize 753 max_size_unit
750 = size_binop (CEIL_DIV_EXPR, 754 = size_binop (CEIL_DIV_EXPR,
751 round_up (max_adasize, TYPE_ALIGN (gnu_type)), 755 round_up (max_ada_size, TYPE_ALIGN (gnu_type)),
752 bitsize_unit_node); 756 bitsize_unit_node);
753 } 757 }
754 758
755 /* For array types, see what we can get from TYPE_INDEX_TYPE. */ 759 /* For array types, see what we can get from TYPE_INDEX_TYPE. */
756 else if (TREE_CODE (gnu_type) == ARRAY_TYPE 760 else if (TREE_CODE (gnu_type) == ARRAY_TYPE
776 { 780 {
777 tree length 781 tree length
778 = fold_build2 (PLUS_EXPR, ctype, 782 = fold_build2 (PLUS_EXPR, ctype,
779 fold_build2 (MINUS_EXPR, ctype, hb, lb), 783 fold_build2 (MINUS_EXPR, ctype, hb, lb),
780 build_int_cst (ctype, 1)); 784 build_int_cst (ctype, 1));
781 max_unitsize 785 max_size_unit
782 = fold_build2 (MULT_EXPR, sizetype, 786 = fold_build2 (MULT_EXPR, sizetype,
783 fold_convert (sizetype, length), 787 fold_convert (sizetype, length),
784 TYPE_SIZE_UNIT (TREE_TYPE (gnu_type))); 788 TYPE_SIZE_UNIT (TREE_TYPE (gnu_type)));
785 } 789 }
786 } 790 }
787 } 791 }
788 } 792 }
789 793
790 return max_unitsize; 794 return max_size_unit;
791 } 795 }
792 796
793 static tree get_array_bit_stride (tree); 797 static tree get_array_bit_stride (tree);
794 798
795 /* Provide information in INFO for debug output about the TYPE array type. 799 /* Provide information in INFO for debug output about the TYPE array type.
948 952
949 /* Now iterate over all dimensions in source-order and fill the info 953 /* Now iterate over all dimensions in source-order and fill the info
950 structure. */ 954 structure. */
951 for (i = (convention_fortran_p ? info->ndimensions - 1 : 0), 955 for (i = (convention_fortran_p ? info->ndimensions - 1 : 0),
952 dimen = first_dimen; 956 dimen = first_dimen;
953 0 <= i && i < info->ndimensions; 957 IN_RANGE (i, 0, info->ndimensions - 1);
954 i += (convention_fortran_p ? -1 : 1), 958 i += (convention_fortran_p ? -1 : 1),
955 dimen = TREE_TYPE (dimen)) 959 dimen = TREE_TYPE (dimen))
956 { 960 {
957 /* We are interested in the stored bounds for the debug info. */ 961 /* We are interested in the stored bounds for the debug info. */
958 tree index_type = TYPE_INDEX_TYPE (TYPE_DOMAIN (dimen)); 962 tree index_type = TYPE_INDEX_TYPE (TYPE_DOMAIN (dimen));
1139 reference if the target machine would either pass or return by 1143 reference if the target machine would either pass or return by
1140 reference. Strictly speaking, we need only check the return if this 1144 reference. Strictly speaking, we need only check the return if this
1141 is an In Out parameter, but it's probably best to err on the side of 1145 is an In Out parameter, but it's probably best to err on the side of
1142 passing more things by reference. */ 1146 passing more things by reference. */
1143 1147
1148 if (AGGREGATE_TYPE_P (gnu_type)
1149 && (!valid_constant_size_p (TYPE_SIZE_UNIT (gnu_type))
1150 || compare_tree_int (TYPE_SIZE_UNIT (gnu_type),
1151 TYPE_ALIGN (gnu_type)) > 0))
1152 return true;
1153
1144 if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, true)) 1154 if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, true))
1145 return true; 1155 return true;
1146 1156
1147 if (targetm.calls.return_in_memory (gnu_type, NULL_TREE)) 1157 if (targetm.calls.return_in_memory (gnu_type, NULL_TREE))
1148 return true;
1149
1150 if (AGGREGATE_TYPE_P (gnu_type)
1151 && (!valid_constant_size_p (TYPE_SIZE_UNIT (gnu_type))
1152 || 0 < compare_tree_int (TYPE_SIZE_UNIT (gnu_type),
1153 TYPE_ALIGN (gnu_type))))
1154 return true; 1158 return true;
1155 1159
1156 return false; 1160 return false;
1157 } 1161 }
1158 1162
1296 skip_p = true; 1300 skip_p = true;
1297 } 1301 }
1298 } 1302 }
1299 1303
1300 /* If no predefined C types were found, register the mode itself. */ 1304 /* If no predefined C types were found, register the mode itself. */
1301 if (!skip_p) 1305 int nunits, precision, bitsize;
1306 if (!skip_p
1307 && GET_MODE_NUNITS (i).is_constant (&nunits)
1308 && GET_MODE_PRECISION (i).is_constant (&precision)
1309 && GET_MODE_BITSIZE (i).is_constant (&bitsize))
1302 f (GET_MODE_NAME (i), digs, complex_p, 1310 f (GET_MODE_NAME (i), digs, complex_p,
1303 vector_p ? GET_MODE_NUNITS (i) : 0, float_rep, 1311 vector_p ? nunits : 0, float_rep,
1304 GET_MODE_PRECISION (i), GET_MODE_BITSIZE (i), 1312 precision, bitsize, GET_MODE_ALIGNMENT (i));
1305 GET_MODE_ALIGNMENT (i));
1306 } 1313 }
1307 } 1314 }
1308 1315
1309 /* Return the size of the FP mode with precision PREC. */ 1316 /* Return the size of the FP mode with precision PREC. */
1310 1317