MatCat.OpenSource/8sa1-gcc
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

support array bounds checking

Browse Source 
From-SVN: r26592
This commit is contained in:
Craig Burley 1999-04-22 23:01:43 +00:00 committed by Craig Burley
parent 01680a2591
commit 6b55276ed9
10 changed files with 396 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
gcc/f/ChangeLog
View File

@ -1,3 +1,24 @@
Fri Apr 23 01:48:28 1999 Craig Burley <craig@jcb-sc.com>
Support new -fsubscript-check and -ff2c-subscript-check options:
* com-rt.def (FFECOM_gfrtRANGE): Describe s_rnge, in libf2c/libF77.
* com.c (ffecom_subscript_check_, ffecom_arrayref_): New functions.
(ffecom_char_args_x_): Use new ffecom_arrayref_ function for
FFEBLD_opARRAYREF case.
Compute character name, array type, and use new
ffecom_subscript_check_ function for FFEBLD_opSUBSTRING case.
(ffecom_expr_): Use new ffecom_arrayref_ function.
(ffecom_ptr_to_expr): Use new ffecom_arrayref_ function.
* g77.texi, news.texi: Document new options.
* top.c, top.h: Support new options.
* news.texi: Fix up some items to not be in "User-Visible Changes".
* ste.c (ffeste_R819B): Fix type for loop variable, to avoid
warnings.
* version.c: Bump version.
Tue Apr 20 01:38:57 1999 Craig Burley <craig@jcb-sc.com>
* bugs.texi, news.texi: Clarify -malign-double situation.

1
gcc/f/com-rt.def
View File

@ -66,6 +66,7 @@ DEFGFRT (FFECOM_gfrtCMP, "s_cmp", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtCOPY, "s_copy", FFECOM_rttypeVOID_, 0, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtPAUSE, "s_paus", FFECOM_rttypeVOID_, 0, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSTOP, "s_stop", FFECOM_rttypeVOID_, 0, TRUE, FALSE)
DEFGFRT (FFECOM_gfrtRANGE, "s_rnge", FFECOM_rttypeINTEGER_, 0, TRUE, FALSE)
DEFGFRT (FFECOM_gfrtSRDUE, "s_rdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtERDUE, "e_rdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)

361
gcc/f/com.c
View File

@ -745,6 +745,233 @@ static tree shadowed_labels;
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
/* 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
@ -1746,10 +1973,6 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
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)
@ -1758,26 +1981,7 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
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;
@ -1788,6 +1992,9 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
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);
@ -1795,6 +2002,16 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
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)
@ -1803,14 +2020,20 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
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)
{
@ -1823,8 +2046,12 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
}
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)
{
@ -1852,8 +2079,12 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_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)
{
@ -2973,17 +3204,11 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
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;
@ -2992,36 +3217,7 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
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;
}
@ -12522,10 +12718,6 @@ ffecom_ptr_to_expr (ffebld expr)
case FFEBLD_opARRAYREF:
{
ffebld dims[FFECOM_dimensionsMAX];
tree array;
int i;
item = ffecom_ptr_to_expr (ffebld_left (expr));
if (item == error_mark_node)
@ -12536,32 +12728,7 @@ ffecom_ptr_to_expr (ffebld expr)
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;

90
gcc/f/g77.texi
View File

@ -2,7 +2,7 @@
@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
@ -1471,6 +1471,7 @@ by type. Explanations are in the following sections.
-falias-check -fargument-alias
-fargument-noalias -fno-argument-noalias-global
-fno-globals
-fsubscript-check -ff2c-subscript-check
@end smallexample
@end table
@ -3370,6 +3371,73 @@ and warns about similar disagreements
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,
@ -11015,6 +11083,8 @@ themselves as @emph{visible} problems some time later.
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
@ -11028,11 +11098,13 @@ That is, these bugs can be quite sensitive to data, including
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
@ -11275,7 +11347,6 @@ Better diagnostics:
Run-time facilities:
* Uninitialized Variables at Run Time::
* Bounds Checking at Run Time::
* Portable Unformatted Files::
Debugging:
@ -12159,15 +12230,6 @@ some kinds of uninitialized variables at run time.
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

4
gcc/f/lang-options.h
View File

@ -147,6 +147,10 @@ FTNOPT( "-fglobals", "" )
FTNOPT( "-fno-globals", "Disable fatal diagnostics about inter-procedural problems" )
FTNOPT( "-ftypeless-boz", "Make prefix-radix non-decimal constants be typeless" )
FTNOPT( "-fno-typeless-boz", "" )
FTNOPT( "-fsubscript-check", "Generate code to check array-subscript ranges" )
FTNOPT( "-fno-subscript-check", "" )
FTNOPT( "-ff2c-subscript-check", "Generate f2c-like code to check array-subscript ranges")
FTNOPT( "-fno-f2c-subscript-check", "" )
FTNOPT( "-Wglobals", "" )
FTNOPT( "-Wno-globals", "Disable warnings about inter-procedural problems" )
/*"-Wimplicit",*/

17
gcc/f/news.texi
View File

@ -9,7 +9,7 @@
@c in the standalone derivations of this file (e.g. NEWS).
@set copyrights-news 1995-1999
@set last-update-news 1999-04-20
@set last-update-news 1999-04-23
@include root.texi
@ -187,6 +187,17 @@ The @samp{-ax} option is now obeyed when compiling Fortran programs.
(It is passed to the @file{f771} driver.)
@end ifclear
@item
The new @samp{-fsubscript-check} option
causes @code{g77} to compile run-time bounds checks
of array subscripts, as well as of substring start and end points.
The current implementation uses the @code{libf2c}
library routine @code{s_rnge} to print the diagnostic.
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.
@item
Source file names with the suffixes @samp{.FOR} and @samp{.FPP}
now are recognized by @code{g77}
@ -224,12 +235,15 @@ The @samp{-malign-double} option
now reliably aligns @emph{all} double-precision variables and arrays
on Intel x86 targets.
@ifclear USERVISONLY
@item
Even without the @samp{-malign-double} option,
@code{g77} reliably aligns local double-precision variables
that are not in @code{EQUIVALENCE} areas
and not @code{SAVE}'d.
@end ifclear
@ifclear USERVISONLY
@item
A substantial portion of the @code{g77} front end's code-generation component
was rewritten.
@ -238,6 +252,7 @@ by the @code{gcc} back end.
One effect of this rewrite is that some codes no longer produce
a spurious ``label @var{lab} used before containing binding contour''
message.
@end ifclear
@item
Support for the @samp{-fugly} option has been removed.

2
gcc/f/ste.c
View File

@ -3096,7 +3096,7 @@ ffeste_R819B (ffestw block, ffelab label UNUSED, ffebld expr)
if (expr)
{
tree loop;
struct nesting *loop;
result = ffecom_make_tempvar ("dowhile", integer_type_node,
FFETARGET_charactersizeNONE, -1);

9
gcc/f/top.c
View File

@ -82,6 +82,7 @@ bool ffe_is_mainprog_; /* TRUE if current prog unit known to be
bool ffe_is_null_version_ = FALSE;
bool ffe_is_onetrip_ = FALSE;
bool ffe_is_silent_ = TRUE;
bool ffe_is_subscript_check_ = FALSE;
bool ffe_is_typeless_boz_ = FALSE;
bool ffe_is_pedantic_ = FFETARGET_defaultIS_PEDANTIC;
bool ffe_is_saveall_; /* TRUE if mainprog or SAVE (no args) seen. */
@ -317,6 +318,14 @@ ffe_decode_option (argc, argv)
ffe_set_is_globals (TRUE);
else if (strcmp (&opt[2], "no-globals") == 0)
ffe_set_is_globals (FALSE);
else if (strcmp (&opt[2], "subscript-check") == 0)
ffe_set_is_subscript_check (TRUE);
else if (strcmp (&opt[2], "no-subscript-check") == 0)
ffe_set_is_subscript_check (FALSE);
else if (strcmp (&opt[2], "f2c-subscript-check") == 0)
ffe_set_is_subscript_check (TRUE);
else if (strcmp (&opt[2], "no-f2c-subscript-check") == 0)
ffe_set_is_subscript_check (FALSE);
else if (strcmp (&opt[2], "typeless-boz") == 0)
ffe_set_is_typeless_boz (TRUE);
else if (strcmp (&opt[2], "no-typeless-boz") == 0)

3
gcc/f/top.h
View File

@ -97,6 +97,7 @@ extern bool ffe_is_mainprog_;
extern bool ffe_is_null_version_;
extern bool ffe_is_onetrip_;
extern bool ffe_is_silent_;
extern bool ffe_is_subscript_check_;
extern bool ffe_is_typeless_boz_;
extern bool ffe_is_pedantic_;
extern bool ffe_is_saveall_;
@ -188,6 +189,7 @@ void ffe_terminate_4 (void);
#define ffe_is_saveall() ffe_is_saveall_
#define ffe_is_second_underscore() ffe_is_second_underscore_
#define ffe_is_silent() ffe_is_silent_
#define ffe_is_subscript_check() ffe_is_subscript_check_
#define ffe_is_typeless_boz() ffe_is_typeless_boz_
#define ffe_is_ugly_args() ffe_is_ugly_args_
#define ffe_is_ugly_assign() ffe_is_ugly_assign_
@ -238,6 +240,7 @@ void ffe_terminate_4 (void);
#define ffe_set_is_saveall(f) (ffe_is_saveall_ = (f))
#define ffe_set_is_second_underscore(f) (ffe_is_second_underscore_ = (f))
#define ffe_set_is_silent(f) (ffe_is_silent_ = (f))
#define ffe_set_is_subscript_check(f) (ffe_is_subscript_check_ = (f))
#define ffe_set_is_typeless_boz(f) (ffe_is_typeless_boz_ = (f))
#define ffe_set_is_ugly_args(f) (ffe_is_ugly_args_ = (f))
#define ffe_set_is_ugly_assign(f) (ffe_is_ugly_assign_ = (f))

2
gcc/f/version.c
View File

@ -1 +1 @@
const char *ffe_version_string = "0.5.24-19990420";
const char *ffe_version_string = "0.5.24-19990423";