This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
Re: [patch, fortran] Add _gfortran_error_stop_numeric
- From: Jerry DeLisle <jvdelisle at verizon dot net>
- To: fortran at gcc dot gnu dot org
- Cc: gcc patches <gcc-patches at gcc dot gnu dot org>
- Date: Thu, 13 May 2010 20:52:40 -0700
- Subject: Re: [patch, fortran] Add _gfortran_error_stop_numeric
- References: <4BE5C54F.4040608@verizon.net>
On 05/08/2010 01:10 PM, Jerry DeLisle wrote:
Hi all,
The attached patch adds this run-time function.
I decided to go ahead and incorporate some additional changes. The attached
patch uses the NULL expression to signal that the STOP, ERROR STOP, or PAUSE
statements are empty. I pass a flag to the run-time functions to signal the
library this condition rather than use the -1 stop code. This allows a program
to actually use a -1 stop code.
I also pass to the runtime a kind=8 integer for the integer stop code to allow
-fdefault-integer-8 to work with no problems. I chose to not go larger than
this since most if not all systems can not use large values regardless.
The statements now match constant expressions and I have added checks to
generate errors if non-integer, non-character, or not constant expressions are
given. I got rid of the old digit counting matcher. Seemed pointless since we
now accept expressions.
The empty ERROR STOP issues a 1 exit code. The PAUSE run-time was updated since
it uses the gfc_match_stopcode function. PAUSE is a "deleted" feature and it now
takes an expression. (A two for one deal)
Regression tested on x86_64.
OK for trunk?
Jerry
2010-05-14 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/43851
* runtime/stop.c (error_stop_numeric): Update comment and add new
function. (stop_numeric): Modify function to accept a flag to indicate
an empty stop statement. Add missing attribute noreturn.
* runtime/pause.c (do_pause): Likewise. (pause_numeric): Likewise.
* gfortran.map: Add new symbol _gfortran_error_stop_numeric to
run-time library.
* libgfortran.h: Revise declaration for stop_numeric.
2010-05-14 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/43851
* trans-stmt.c (gfc_trans_stop): Add generation of call to
gfortran_error_stop_numeric. Fix up some whitespace. Modify the call
creation to include a new parameter to signal an empty stop. Use kind 8
integer types to allow -fdefault-integer-8 to work. Use the constant
expression. (gfc_trans_pause): Likewise.
* trans.h: Add external function declaration for error_stop_numeric.
* trans-decl.c (gfc_build_builtin_function_decls): Add the building of
the declaration for the library call. Fix whitespaces
* match.c (gfc_match_stopcode): Remove use of the actual stop code to
signal no stop code. Match the expression following the stop and pass
that to the translators. Remove the old use of digit matching. Add
checks that the stop_code expression is INTEGER or CHARACTER and also
a constant expression.
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (revision 159348)
+++ gcc/fortran/trans-stmt.c (working copy)
@@ -541,7 +541,7 @@ gfc_trans_return (gfc_code * code ATTRIBUTE_UNUSED
tree
gfc_trans_pause (gfc_code * code)
{
- tree gfc_int4_type_node = gfc_get_int_type (4);
+ tree gfc_int8_type_node = gfc_get_int_type (8);
gfc_se se;
tree tmp;
@@ -552,10 +552,19 @@ gfc_trans_pause (gfc_code * code)
if (code->expr1 == NULL)
{
- tmp = build_int_cst (gfc_int4_type_node, code->ext.stop_code);
+ tmp = build_int_cst (gfc_int8_type_node, 1);
tmp = build_call_expr_loc (input_location,
- gfor_fndecl_pause_numeric, 1, tmp);
+ gfor_fndecl_pause_numeric, 2, tmp, tmp);
}
+ else if (code->expr1->ts.type == BT_INTEGER)
+ {
+ gfc_conv_expr (&se, code->expr1);
+ tmp = build_int_cst (gfc_int8_type_node, 0);
+ tmp = build_call_expr_loc (input_location,
+ gfor_fndecl_pause_numeric, 2,
+ fold_convert (gfc_int8_type_node, se.expr),
+ tmp);
+ }
else
{
gfc_conv_expr_reference (&se, code->expr1);
@@ -578,7 +587,7 @@ gfc_trans_pause (gfc_code * code)
tree
gfc_trans_stop (gfc_code *code, bool error_stop)
{
- tree gfc_int4_type_node = gfc_get_int_type (4);
+ tree gfc_int8_type_node = gfc_get_int_type (8);
gfc_se se;
tree tmp;
@@ -588,17 +597,28 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
if (code->expr1 == NULL)
{
- tmp = build_int_cst (gfc_int4_type_node, code->ext.stop_code);
+ tmp = build_int_cst (gfc_int8_type_node, 1);
tmp = build_call_expr_loc (input_location,
- gfor_fndecl_stop_numeric, 1, tmp);
+ error_stop ? gfor_fndecl_error_stop_numeric
+ : gfor_fndecl_stop_numeric, 2, tmp, tmp);
}
+ else if (code->expr1->ts.type == BT_INTEGER)
+ {
+ gfc_conv_expr (&se, code->expr1);
+ tmp = build_int_cst (gfc_int8_type_node, 0);
+ tmp = build_call_expr_loc (input_location,
+ error_stop ? gfor_fndecl_error_stop_numeric
+ : gfor_fndecl_stop_numeric, 2,
+ fold_convert (gfc_int8_type_node, se.expr),
+ tmp);
+ }
else
{
gfc_conv_expr_reference (&se, code->expr1);
tmp = build_call_expr_loc (input_location,
- error_stop ? gfor_fndecl_error_stop_string
- : gfor_fndecl_stop_string,
- 2, se.expr, se.string_length);
+ error_stop ? gfor_fndecl_error_stop_string
+ : gfor_fndecl_stop_string,
+ 2, se.expr, se.string_length);
}
gfc_add_expr_to_block (&se.pre, tmp);
Index: gcc/fortran/trans.h
===================================================================
--- gcc/fortran/trans.h (revision 159348)
+++ gcc/fortran/trans.h (working copy)
@@ -538,6 +538,7 @@ extern GTY(()) tree gfor_fndecl_pause_numeric;
extern GTY(()) tree gfor_fndecl_pause_string;
extern GTY(()) tree gfor_fndecl_stop_numeric;
extern GTY(()) tree gfor_fndecl_stop_string;
+extern GTY(()) tree gfor_fndecl_error_stop_numeric;
extern GTY(()) tree gfor_fndecl_error_stop_string;
extern GTY(()) tree gfor_fndecl_runtime_error;
extern GTY(()) tree gfor_fndecl_runtime_error_at;
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c (revision 159348)
+++ gcc/fortran/match.c (working copy)
@@ -2006,42 +2006,23 @@ gfc_match_cycle (void)
static match
gfc_match_stopcode (gfc_statement st)
{
- int stop_code;
gfc_expr *e;
match m;
- int cnt;
- stop_code = -1;
e = NULL;
if (gfc_match_eos () != MATCH_YES)
{
- m = gfc_match_small_literal_int (&stop_code, &cnt);
+ m = gfc_match_expr (&e);
if (m == MATCH_ERROR)
goto cleanup;
-
- if (m == MATCH_YES && cnt > 5)
- {
- gfc_error ("Too many digits in STOP code at %C");
- goto cleanup;
- }
-
if (m == MATCH_NO)
- {
- /* Try a character constant. */
- m = gfc_match_expr (&e);
- if (m == MATCH_ERROR)
- goto cleanup;
- if (m == MATCH_NO)
- goto syntax;
- if (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_CONSTANT)
- goto syntax;
- }
-
- if (gfc_match_eos () != MATCH_YES)
goto syntax;
}
+ if (gfc_match_eos () != MATCH_YES)
+ goto syntax;
+
if (gfc_pure (NULL))
{
gfc_error ("%s statement not allowed in PURE procedure at %C",
@@ -2055,6 +2036,19 @@ gfc_match_stopcode (gfc_statement st)
return MATCH_ERROR;
}
+ if (e != NULL && !(e->ts.type == BT_CHARACTER || e->ts.type == BT_INTEGER))
+ {
+ gfc_error ("STOP code at %L must be either INTEGER or CHARACTER type",
+ &e->where);
+ return MATCH_ERROR;
+ }
+
+ if (e != NULL && e->expr_type != EXPR_CONSTANT)
+ {
+ gfc_error ("STOP code at %L must be a constant expression", &e->where);
+ return MATCH_ERROR;
+ }
+
switch (st)
{
case ST_STOP:
@@ -2071,7 +2065,7 @@ gfc_match_stopcode (gfc_statement st)
}
new_st.expr1 = e;
- new_st.ext.stop_code = stop_code;
+ new_st.ext.stop_code = -1;
return MATCH_YES;
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c (revision 159348)
+++ gcc/fortran/trans-decl.c (working copy)
@@ -86,6 +86,7 @@ tree gfor_fndecl_pause_numeric;
tree gfor_fndecl_pause_string;
tree gfor_fndecl_stop_numeric;
tree gfor_fndecl_stop_string;
+tree gfor_fndecl_error_stop_numeric;
tree gfor_fndecl_error_stop_string;
tree gfor_fndecl_runtime_error;
tree gfor_fndecl_runtime_error_at;
@@ -2770,35 +2771,45 @@ void
gfc_build_builtin_function_decls (void)
{
tree gfc_int4_type_node = gfc_get_int_type (4);
+ tree gfc_int8_type_node = gfc_get_int_type (8);
gfor_fndecl_stop_numeric =
gfc_build_library_function_decl (get_identifier (PREFIX("stop_numeric")),
- void_type_node, 1, gfc_int4_type_node);
- /* Stop doesn't return. */
+ void_type_node, 1, gfc_int8_type_node,
+ gfc_int4_type_node);
+ /* STOP doesn't return. */
TREE_THIS_VOLATILE (gfor_fndecl_stop_numeric) = 1;
gfor_fndecl_stop_string =
gfc_build_library_function_decl (get_identifier (PREFIX("stop_string")),
void_type_node, 2, pchar_type_node,
- gfc_int4_type_node);
- /* Stop doesn't return. */
+ gfc_int4_type_node);
+ /* STOP doesn't return. */
TREE_THIS_VOLATILE (gfor_fndecl_stop_string) = 1;
gfor_fndecl_error_stop_string =
gfc_build_library_function_decl (get_identifier (PREFIX("error_stop_string")),
void_type_node, 2, pchar_type_node,
- gfc_int4_type_node);
+ gfc_int4_type_node);
/* ERROR STOP doesn't return. */
TREE_THIS_VOLATILE (gfor_fndecl_error_stop_string) = 1;
+ gfor_fndecl_error_stop_numeric =
+ gfc_build_library_function_decl (get_identifier (PREFIX("error_stop_numeric")),
+ void_type_node, 2, gfc_int8_type_node,
+ gfc_int4_type_node);
+ /* ERROR STOP doesn't return. */
+ TREE_THIS_VOLATILE (gfor_fndecl_error_stop_numeric) = 1;
+
gfor_fndecl_pause_numeric =
gfc_build_library_function_decl (get_identifier (PREFIX("pause_numeric")),
- void_type_node, 1, gfc_int4_type_node);
+ void_type_node, 2, gfc_int8_type_node,
+ gfc_int4_type_node);
gfor_fndecl_pause_string =
gfc_build_library_function_decl (get_identifier (PREFIX("pause_string")),
void_type_node, 2, pchar_type_node,
- gfc_int4_type_node);
+ gfc_int4_type_node);
gfor_fndecl_runtime_error =
gfc_build_library_function_decl (get_identifier (PREFIX("runtime_error")),
Index: libgfortran/runtime/pause.c
===================================================================
--- libgfortran/runtime/pause.c (revision 159348)
+++ libgfortran/runtime/pause.c (working copy)
@@ -36,22 +36,22 @@ do_pause (void)
fgets(buff, 4, stdin);
if (strncmp(buff, "go\n", 3) != 0)
- stop_numeric (-1);
+ stop_numeric (0, 1);
st_printf ("RESUMED\n");
}
/* A numeric or blank STOP statement. */
-extern void pause_numeric (GFC_INTEGER_4 code);
+extern void pause_numeric (GFC_INTEGER_8 code, GFC_INTEGER_4 flag);
export_proto(pause_numeric);
void
-pause_numeric (GFC_INTEGER_4 code)
+pause_numeric (GFC_INTEGER_8 code, GFC_INTEGER_4 flag)
{
- if (code == -1)
+ if (flag)
st_printf ("PAUSE\n");
else
- st_printf ("PAUSE %d\n", (int)code);
+ st_printf ("PAUSE %ld\n", (long int) code);
do_pause ();
}
Index: libgfortran/runtime/stop.c
===================================================================
--- libgfortran/runtime/stop.c (revision 159348)
+++ libgfortran/runtime/stop.c (working copy)
@@ -28,19 +28,20 @@ see the files COPYING3 and COPYING.RUNTIME respect
/* A numeric or blank STOP statement. */
void
-stop_numeric (GFC_INTEGER_4 code)
+stop_numeric (GFC_INTEGER_8 code, GFC_INTEGER_4 flag)
{
- if (code == -1)
+ if (flag)
code = 0;
else
- st_printf ("STOP %d\n", (int)code);
+ st_printf ("STOP %ld\n", (long int) code);
sys_exit (code);
}
iexport(stop_numeric);
-extern void stop_string (const char *string, GFC_INTEGER_4 len);
+extern void stop_string (const char *string, GFC_INTEGER_4 len)
+ __attribute__ ((noreturn));
export_proto(stop_string);
void
@@ -54,14 +55,15 @@ stop_string (const char *string, GFC_INTEGER_4 len
sys_exit (0);
}
-extern void error_stop_string (const char *, GFC_INTEGER_4);
+extern void error_stop_string (const char *, GFC_INTEGER_4)
+ __attribute__ ((noreturn));
export_proto(error_stop_string);
/* Per Fortran 2008, section 8.4: "Execution of a STOP statement initiates
normal termination of execution. Execution of an ERROR STOP statement
- initiates error termination of execution." Thus, error_stop_string returns
- a nonzero exit status code. */
+ initiates error termination of execution." Thus, error_stop_string and
+ error_stop_numeric return a nonzero exit status code. */
void
error_stop_string (const char *string, GFC_INTEGER_4 len)
{
@@ -72,3 +74,20 @@ error_stop_string (const char *string, GFC_INTEGER
sys_exit (1);
}
+
+extern void error_stop_numeric (GFC_INTEGER_8, GFC_INTEGER_4)
+ __attribute__ ((noreturn));
+export_proto(error_stop_numeric);
+
+void
+error_stop_numeric (GFC_INTEGER_8 code, GFC_INTEGER_4 flag)
+{
+ if (flag)
+ {
+ code = 1;
+ st_printf ("ERROR STOP\n");
+ }
+ else
+ st_printf ("ERROR STOP %ld\n", (long int) code);
+ sys_exit (code);
+}
Index: libgfortran/gfortran.map
===================================================================
--- libgfortran/gfortran.map (revision 159348)
+++ libgfortran/gfortran.map (working copy)
@@ -1103,6 +1103,11 @@ GFORTRAN_1.3 {
_gfortran_error_stop_string;
} GFORTRAN_1.2;
+GFORTRAN_1.4 {
+ global:
+ _gfortran_error_stop_numeric;
+} GFORTRAN_1.3;
+
F2C_1.0 {
global:
_gfortran_f2c_specific__abs_c4;
Index: libgfortran/libgfortran.h
===================================================================
--- libgfortran/libgfortran.h (revision 159348)
+++ libgfortran/libgfortran.h (working copy)
@@ -827,7 +827,8 @@ internal_proto(filename_from_unit);
/* stop.c */
-extern void stop_numeric (GFC_INTEGER_4) __attribute__ ((noreturn));
+extern void stop_numeric (GFC_INTEGER_8, GFC_INTEGER_4)
+ __attribute__ ((noreturn));
iexport_proto(stop_numeric);
/* reshape_packed.c */