#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
\f
+/* Return the subscript expression, modified to do range-checking.
+
+ `array' is the array to be checked against.
+ `element' is the subscript expression to check.
+ `dim' is the dimension number (starting at 0).
+ `total_dims' is the total number of dimensions (0 for CHARACTER substring).
+*/
+
+static tree
+ffecom_subscript_check_ (tree array, tree element, int dim, int total_dims,
+ char *array_name)
+{
+ tree low = TYPE_MIN_VALUE (TYPE_DOMAIN (array));
+ tree high = TYPE_MAX_VALUE (TYPE_DOMAIN (array));
+ tree cond;
+ tree die;
+ tree args;
+
+ if (element == error_mark_node)
+ return element;
+
+ element = ffecom_save_tree (element);
+ cond = ffecom_2 (LE_EXPR, integer_type_node,
+ low,
+ element);
+ if (high)
+ {
+ cond = ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node,
+ cond,
+ ffecom_2 (LE_EXPR, integer_type_node,
+ element,
+ high));
+ }
+
+ {
+ int len;
+ char *proc;
+ char *var;
+ tree arg3;
+ tree arg2;
+ tree arg1;
+ tree arg4;
+
+ switch (total_dims)
+ {
+ case 0:
+ var = xmalloc (strlen (array_name) + 20);
+ sprintf (&var[0], "%s[%s-substring]",
+ array_name,
+ dim ? "end" : "start");
+ len = strlen (var) + 1;
+ break;
+
+ case 1:
+ len = strlen (array_name) + 1;
+ var = array_name;
+ break;
+
+ default:
+ var = xmalloc (strlen (array_name) + 40);
+ sprintf (&var[0], "%s[subscript-%d-of-%d]",
+ array_name,
+ dim + 1, total_dims);
+ len = strlen (var) + 1;
+ break;
+ }
+
+ arg1 = build_string (len, var);
+
+ if (total_dims != 1)
+ free (var);
+
+ TREE_TYPE (arg1)
+ = build_type_variant (build_array_type (char_type_node,
+ build_range_type
+ (integer_type_node,
+ integer_one_node,
+ build_int_2 (len, 0))),
+ 1, 0);
+ TREE_CONSTANT (arg1) = 1;
+ TREE_STATIC (arg1) = 1;
+ arg1 = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (arg1)),
+ arg1);
+
+ /* s_rnge adds one to the element to print it, so bias against
+ that -- want to print a faithful *subscript* value. */
+ arg2 = convert (ffecom_f2c_ftnint_type_node,
+ ffecom_2 (MINUS_EXPR,
+ TREE_TYPE (element),
+ element,
+ convert (TREE_TYPE (element),
+ integer_one_node)));
+
+ proc = xmalloc ((len = strlen (input_filename)
+ + IDENTIFIER_LENGTH (DECL_NAME (current_function_decl))
+ + 2));
+
+ sprintf (&proc[0], "%s/%s",
+ input_filename,
+ IDENTIFIER_POINTER (DECL_NAME (current_function_decl)));
+ arg3 = build_string (len, proc);
+
+ free (proc);
+
+ TREE_TYPE (arg3)
+ = build_type_variant (build_array_type (char_type_node,
+ build_range_type
+ (integer_type_node,
+ integer_one_node,
+ build_int_2 (len, 0))),
+ 1, 0);
+ TREE_CONSTANT (arg3) = 1;
+ TREE_STATIC (arg3) = 1;
+ arg3 = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (arg3)),
+ arg3);
+
+ arg4 = convert (ffecom_f2c_ftnint_type_node,
+ build_int_2 (lineno, 0));
+
+ arg1 = build_tree_list (NULL_TREE, arg1);
+ arg2 = build_tree_list (NULL_TREE, arg2);
+ arg3 = build_tree_list (NULL_TREE, arg3);
+ arg4 = build_tree_list (NULL_TREE, arg4);
+ TREE_CHAIN (arg3) = arg4;
+ TREE_CHAIN (arg2) = arg3;
+ TREE_CHAIN (arg1) = arg2;
+
+ args = arg1;
+ }
+ die = ffecom_call_gfrt (FFECOM_gfrtRANGE,
+ args, NULL_TREE);
+ TREE_SIDE_EFFECTS (die) = 1;
+
+ element = ffecom_3 (COND_EXPR,
+ TREE_TYPE (element),
+ cond,
+ element,
+ die);
+
+ return element;
+}
+
+/* Return the computed element of an array reference.
+
+ `item' is the array or a pointer to the array. It must be a pointer
+ to the array if ffe_is_flat_arrays ().
+ `expr' is the original opARRAYREF expression.
+ `want_ptr' is non-zero if `item' is a pointer to the element, instead of
+ the element itself, is to be returned. */
+
+static tree
+ffecom_arrayref_ (tree item, ffebld expr, int want_ptr)
+{
+ ffebld dims[FFECOM_dimensionsMAX];
+ int i;
+ int total_dims;
+ int flatten = 0 /* ~~~ ffe_is_flat_arrays () */;
+ int need_ptr = want_ptr || flatten;
+ tree array;
+ tree element;
+ char *array_name;
+
+ if (ffebld_op (ffebld_left (expr)) == FFEBLD_opSYMTER)
+ array_name = ffesymbol_text (ffebld_symter (ffebld_left (expr)));
+ else
+ array_name = "[expr?]";
+
+ /* Build up ARRAY_REFs in reverse order (since we're column major
+ here in Fortran land). */
+
+ for (i = 0, expr = ffebld_right (expr);
+ expr != NULL;
+ expr = ffebld_trail (expr))
+ dims[i++] = ffebld_head (expr);
+
+ total_dims = i;
+
+ if (need_ptr)
+ {
+ for (--i, array = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item)));
+ i >= 0;
+ --i, array = TYPE_MAIN_VARIANT (TREE_TYPE (array)))
+ {
+ element = ffecom_expr (dims[i]);
+ if (ffe_is_subscript_check ())
+ element = ffecom_subscript_check_ (array, element, i, total_dims,
+ array_name);
+ item = ffecom_2 (PLUS_EXPR,
+ build_pointer_type (TREE_TYPE (array)),
+ item,
+ size_binop (MULT_EXPR,
+ size_in_bytes (TREE_TYPE (array)),
+ convert (sizetype,
+ fold (build (MINUS_EXPR,
+ TREE_TYPE (TYPE_MIN_VALUE (TYPE_DOMAIN (array))),
+ element,
+ TYPE_MIN_VALUE (TYPE_DOMAIN (array)))))));
+ }
+ if (! want_ptr)
+ {
+ item = ffecom_1 (INDIRECT_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item))),
+ item);
+ }
+ }
+ else
+ {
+ for (--i;
+ i >= 0;
+ --i)
+ {
+ array = TYPE_MAIN_VARIANT (TREE_TYPE (item));
+
+ element = ffecom_expr_ (dims[i], NULL, NULL, NULL, FALSE, TRUE);
+ if (ffe_is_subscript_check ())
+ element = ffecom_subscript_check_ (array, element, i, total_dims,
+ array_name);
+ item = ffecom_2 (ARRAY_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item))),
+ item,
+ element);
+ }
+ }
+
+ return item;
+}
+
/* This is like gcc's stabilize_reference -- in fact, most of the code
comes from that -- but it handles the situation where the reference
is going to have its subparts picked at, and it shouldn't change
case FFEBLD_opARRAYREF:
{
- ffebld dims[FFECOM_dimensionsMAX];
- tree array;
- int i;
-
ffecom_char_args_ (&item, length, ffebld_left (expr));
if (item == error_mark_node || *length == error_mark_node)
break;
}
- /* Build up ARRAY_REFs in reverse order (since we're column major
- here in Fortran land). */
-
- for (i = 0, expr = ffebld_right (expr);
- expr != NULL;
- expr = ffebld_trail (expr))
- dims[i++] = ffebld_head (expr);
-
- for (--i, array = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item)));
- i >= 0;
- --i, array = TYPE_MAIN_VARIANT (TREE_TYPE (array)))
- {
- item = ffecom_2 (PLUS_EXPR, build_pointer_type (TREE_TYPE (array)),
- item,
- size_binop (MULT_EXPR,
- size_in_bytes (TREE_TYPE (array)),
- size_binop (MINUS_EXPR,
- ffecom_expr (dims[i]),
- TYPE_MIN_VALUE (TYPE_DOMAIN (array)))));
- }
+ item = ffecom_arrayref_ (item, expr, 1);
}
break;
ffebld thing = ffebld_right (expr);
tree start_tree;
tree end_tree;
+ char *char_name;
+ ffebld left_symter;
+ tree array;
assert (ffebld_op (thing) == FFEBLD_opITEM);
start = ffebld_head (thing);
assert (ffebld_trail (thing) == NULL);
end = ffebld_head (thing);
+ /* Determine name for pretty-printing range-check errors. */
+ for (left_symter = ffebld_left (expr);
+ left_symter && ffebld_op (left_symter) == FFEBLD_opARRAYREF;
+ left_symter = ffebld_left (left_symter))
+ ;
+ if (ffebld_op (left_symter) == FFEBLD_opSYMTER)
+ char_name = ffesymbol_text (ffebld_symter (left_symter));
+ else
+ char_name = "[expr?]";
+
ffecom_char_args_ (&item, length, ffebld_left (expr));
if (item == error_mark_node || *length == error_mark_node)
break;
}
+ array = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item)));
+
if (start == NULL)
{
if (end == NULL)
;
else
{
+ end_tree = ffecom_expr (end);
+ if (ffe_is_subscript_check ())
+ end_tree = ffecom_subscript_check_ (array, end_tree, 1, 0,
+ char_name);
end_tree = convert (ffecom_f2c_ftnlen_type_node,
- ffecom_expr (end));
+ end_tree);
if (end_tree == error_mark_node)
{
}
else
{
+ start_tree = ffecom_expr (start);
+ if (ffe_is_subscript_check ())
+ start_tree = ffecom_subscript_check_ (array, start_tree, 0, 0,
+ char_name);
start_tree = convert (ffecom_f2c_ftnlen_type_node,
- ffecom_expr (start));
+ start_tree);
if (start_tree == error_mark_node)
{
}
else
{
+ end_tree = ffecom_expr (end);
+ if (ffe_is_subscript_check ())
+ end_tree = ffecom_subscript_check_ (array, end_tree, 1, 0,
+ char_name);
end_tree = convert (ffecom_f2c_ftnlen_type_node,
- ffecom_expr (end));
+ end_tree);
if (end_tree == error_mark_node)
{
case FFEBLD_opARRAYREF:
{
- ffebld dims[FFECOM_dimensionsMAX];
-#if FFECOM_FASTER_ARRAY_REFS
- tree array;
-#endif
- int i;
+ if (0 /* ~~~~~ ffe_is_flat_arrays () */)
+ t = ffecom_ptr_to_expr (ffebld_left (expr));
+ else
+ t = ffecom_expr (ffebld_left (expr));
-#if FFECOM_FASTER_ARRAY_REFS
- t = ffecom_ptr_to_expr (ffebld_left (expr));
-#else
- t = ffecom_expr (ffebld_left (expr));
-#endif
if (t == error_mark_node)
return t;
return error_mark_node; /* Make sure non-const ref is to
non-reg. */
- /* Build up ARRAY_REFs in reverse order (since we're column major
- here in Fortran land). */
-
- for (i = 0, expr = ffebld_right (expr);
- expr != NULL;
- expr = ffebld_trail (expr))
- dims[i++] = ffebld_head (expr);
-
-#if FFECOM_FASTER_ARRAY_REFS
- for (--i, array = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (t)));
- i >= 0;
- --i, array = TYPE_MAIN_VARIANT (TREE_TYPE (array)))
- t = ffecom_2 (PLUS_EXPR,
- build_pointer_type (TREE_TYPE (array)),
- t,
- size_binop (MULT_EXPR,
- size_in_bytes (TREE_TYPE (array)),
- size_binop (MINUS_EXPR,
- ffecom_expr (dims[i]),
- TYPE_MIN_VALUE (TYPE_DOMAIN (array)))));
- t = ffecom_1 (INDIRECT_REF,
- TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (t))),
- t);
-#else
- while (i > 0)
- t = ffecom_2 (ARRAY_REF,
- TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (t))),
- t,
- ffecom_expr_ (dims[--i], NULL, NULL, NULL, FALSE, TRUE));
-#endif
+ t = ffecom_arrayref_ (t, expr, 0);
return t;
}
case FFEBLD_opARRAYREF:
{
- ffebld dims[FFECOM_dimensionsMAX];
- tree array;
- int i;
-
item = ffecom_ptr_to_expr (ffebld_left (expr));
if (item == error_mark_node)
return error_mark_node; /* Make sure non-const ref is to
non-reg. */
- /* Build up ARRAY_REFs in reverse order (since we're column major
- here in Fortran land). */
-
- for (i = 0, expr = ffebld_right (expr);
- expr != NULL;
- expr = ffebld_trail (expr))
- dims[i++] = ffebld_head (expr);
-
- for (--i, array = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item)));
- i >= 0;
- --i, array = TYPE_MAIN_VARIANT (TREE_TYPE (array)))
- {
- /* The initial subtraction should happen in the original type so
- that (possible) negative values are handled appropriately. */
- item
- = ffecom_2 (PLUS_EXPR,
- build_pointer_type (TREE_TYPE (array)),
- item,
- size_binop (MULT_EXPR,
- size_in_bytes (TREE_TYPE (array)),
- convert (sizetype,
- fold (build (MINUS_EXPR,
- TREE_TYPE (TYPE_MIN_VALUE (TYPE_DOMAIN (array))),
- ffecom_expr (dims[i]),
- TYPE_MIN_VALUE (TYPE_DOMAIN (array)))))));
- }
+ item = ffecom_arrayref_ (item, expr, 1);
}
return item;
@c %**start of header
@setfilename g77.info
-@set last-update 1999-04-17
+@set last-update 1999-04-23
@set copyrights-g77 1995-1999
@include root.texi
-falias-check -fargument-alias
-fargument-noalias -fno-argument-noalias-global
-fno-globals
+-fsubscript-check -ff2c-subscript-check
@end smallexample
@end table
that are currently believed to not
likely to result in the compiler later crashing
or producing incorrect code.
+
+@cindex -fsubscript-check option
+@cindex -ff2c-subscript-check option
+@item -fsubscript-check
+@itemx -ff2c-subscript-check
+@cindex bounds checking
+@cindex range checking
+@cindex array bounds checking
+@cindex subscript checking
+@cindex substring checking
+@cindex checking subscripts
+@cindex checking substrings
+Enable generation of run-time checks for array subscripts
+and substring start and end points
+against the (locally) declared minimum and maximum values.
+
+The current implementation uses the @code{libf2c}
+library routine @code{s_rnge} to print the diagnostic.
+
+However, whereas @code{f2c} generates a single check per
+reference for a multi-dimensional array, of the computed
+offset against the valid offset range (0 through the size of the array),
+@code{g77} generates a single check per @emph{subscript} expression.
+This catches some cases of potential bugs that @code{f2c} does not,
+such as references to below the beginning of an assumed-size array.
+
+@code{g77} also generates checks for @code{CHARACTER} substring references,
+something @code{f2c} currently does not do.
+
+Since a future version of @code{g77} might use a different implementation,
+use the new @samp{-ff2c-subscript-check} option
+if your application requires use of @code{s_rnge} or a compile-time diagnostic.
+
+@emph{Note:} To provide more detailed information on the offending subscript,
+@code{g77} provides @code{s_rnge}
+with somewhat differently-formatted information.
+Here's a sample diagnostic:
+
+@smallexample
+Subscript out of range on file line 4, procedure rnge.f/bf.
+Attempt to access the -6-th element of variable b[subscript-2-of-2].
+Aborted
+@end smallexample
+
+The above message indicates that the offending source line is
+line 4 of the file @file{rnge.f},
+within the program unit (or statement function) named @samp{bf}.
+The offended array is named @samp{b}.
+The offended array dimension is the second for a two-dimensional array,
+and the offending, computed subscript expression was @samp{-6}.
+
+For a @code{CHARACTER} substring reference, the second line has
+this appearance:
+
+@smallexample
+Attempt to access the 11-th element of variable a[start-substring].
+@end smallexample
+
+This indicates that the offended @code{CHARACTER} variable or array
+is named @samp{a},
+the offended substring position is the starting (leftmost) position,
+and the offending substring expression is @samp{11}.
+
+(Though the verbage of @code{s_rnge} is not ideal
+for the purpose of the @code{g77} compiler,
+the above information should provide adequate diagnostic abilities
+to it users.)
@end table
@xref{Code Gen Options,,Options for Code Generation Conventions,
Overflowing the bounds of an array---usually by writing beyond
the end of it---is one of two kinds of bug that often occurs
in Fortran code.
+(Compile your code with the @samp{-fsubscript-check} option
+to catch many of these kinds of errors at program run time.)
The other kind of bug is a mismatch between the actual arguments
passed to a procedure and the dummy arguments as declared by that
data representing the placement of other data in memory (that is,
pointers, such as the placement of stack frames in memory).
-Plans call for improving @code{g77} so that it can offer the
+@code{g77} now offers the
ability to catch and report some of these problems at compile, link, or
run time, such as by generating code to detect references to
-beyond the bounds of an array, or checking for agreement between
-calling and called procedures.
+beyond the bounds of most arrays (except assumed-size arrays),
+and checking for agreement between calling and called procedures.
+Future improvements are likely to be made in the procedure-mismatch area,
+at least.
In the meantime, finding and fixing the programming
bugs that lead to these behaviors is, ultimately, the user's
Run-time facilities:
* Uninitialized Variables at Run Time::
-* Bounds Checking at Run Time::
* Portable Unformatted Files::
Debugging:
Note that use of the options @samp{-O -Wuninitialized} can catch
many such bugs at compile time.
-@node Bounds Checking at Run Time
-@subsection Bounds Checking at Run Time
-
-@code{g77} should offer run-time bounds-checking of array/subscript references
-in a fashion similar to @code{f2c}.
-
-Note that @code{g77} already warns about references to out-of-bounds
-elements of arrays when it detects these at compile time.
-
@node Portable Unformatted Files
@subsection Portable Unformatted Files
projects / gcc.git / commitdiff