Patchwork [fortran] PR46079 ABI for empty stop statement broken

login
register
mail settings
Submitter Jerry DeLisle
Date Oct. 20, 2010, 4:22 a.m.
Message ID <4CBE6EA0.1030709@frontier.com>
Download mbox | patch
Permalink /patch/68389/
State New
Headers show

Comments

Jerry DeLisle - Oct. 20, 2010, 4:22 a.m.
On 10/19/2010 05:33 PM, Jerry DeLisle wrote:
> On 10/19/2010 12:45 PM, Mikael Morin wrote:
--- snip ---
>> Let's keep error_stop_string care about strings only. (Please!)
>>
> Thanks for bringing this up. It was bothering me too I will gladly do this
> diffently and will re-submit the patch.

Attached is a revised patch.  This produces for the following:

   real, dimension(5,5,5) :: i
   stop
   stop 47
   stop "string 1"
   stop size(i)
   error stop
   error stop 37
   error stop size(i)
   error stop "string 2"

   _gfortran_stop_string (0B, 0);
   _gfortran_stop_numeric_f08 (47);
   _gfortran_stop_string (&"string 1"[1]{lb: 1 sz: 1}, 8);
   _gfortran_stop_numeric_f08 (125);
   _gfortran_error_stop_string (0B, 0);
   _gfortran_error_stop_numeric (37);
   _gfortran_error_stop_numeric (125);
   _gfortran_error_stop_string (&"string 2"[1]{lb: 1 sz: 1}, 8);

Regression tested.  OK for trunk?

Jerry
Mikael Morin - Oct. 20, 2010, 7:25 p.m.
On Wednesday 20 October 2010 06:22:56 Jerry DeLisle wrote:
> Attached is a revised patch.  
> [...]
> Regression tested.  OK for trunk?
OK with...

> 
> newstop.diff
>   Index: libgfortran/runtime/stop.c
> ===================================================================
> --- libgfortran/runtime/stop.c  (revision 165674)
> +++ libgfortran/runtime/stop.c  (working copy)
> @@ -35,6 +35,22 @@ export_proto(stop_numeric);
>  void
>  stop_numeric (GFC_INTEGER_4 code)
>  {
> +  if (code == -1)
> +    code = 0;
> +  else
> +    st_printf ("STOP %d\n", (int)code);
> +
> +  sys_exit (code);
> +}

... some vertical space here.

> +/* A Fortran 2008 numeric STOP statement.  */
> +
> +extern void stop_numeric_f08 (GFC_INTEGER_4)
> +  __attribute__ ((noreturn));
> +export_proto(stop_numeric_f08);
> +
> +void
> +stop_numeric_f08 (GFC_INTEGER_4 code)
> +{
>    st_printf ("STOP %d\n", (int)code);
>    sys_exit (code);
>  }

Thanks!

Mikael

PS: Bonus point if you add a mention on the wiki to eventually rename 
stop_numeric_f08 back to stop_numeric. :-)
Jerry DeLisle - Oct. 21, 2010, 12:46 a.m.
On 10/20/2010 12:25 PM, Mikael Morin wrote:
> On Wednesday 20 October 2010 06:22:56 Jerry DeLisle wrote:
>> Attached is a revised patch.
>> [...]
>> Regression tested.  OK for trunk?
> OK with...
>
Committed revision 165746.

Thanks for review.

Jerry

Patch

Index: libgfortran/runtime/stop.c
===================================================================
--- libgfortran/runtime/stop.c	(revision 165674)
+++ libgfortran/runtime/stop.c	(working copy)
@@ -35,6 +35,22 @@  export_proto(stop_numeric);
 void
 stop_numeric (GFC_INTEGER_4 code)
 {
+  if (code == -1)
+    code = 0;
+  else
+    st_printf ("STOP %d\n", (int)code);
+
+  sys_exit (code);
+}
+/* A Fortran 2008 numeric STOP statement.  */
+
+extern void stop_numeric_f08 (GFC_INTEGER_4)
+  __attribute__ ((noreturn));
+export_proto(stop_numeric_f08);
+
+void
+stop_numeric_f08 (GFC_INTEGER_4 code)
+{
   st_printf ("STOP %d\n", (int)code);
   sys_exit (code);
 }
Index: libgfortran/gfortran.map
===================================================================
--- libgfortran/gfortran.map	(revision 165674)
+++ libgfortran/gfortran.map	(working copy)
@@ -1141,6 +1141,7 @@  GFORTRAN_1.4 {
     _gfortran_parity_l8;
     _gfortran_parity_l16;
     _gfortran_selected_real_kind2008;
+    _gfortran_stop_numeric_f08;
     _gfortran_transfer_array_write;
     _gfortran_transfer_character_write;
     _gfortran_transfer_character_wide_write;
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(revision 165674)
+++ gcc/fortran/trans-stmt.c	(working copy)
@@ -602,25 +602,25 @@  gfc_trans_stop (gfc_code *code, bool error_stop)
     {
       tmp = build_int_cst (gfc_int4_type_node, 0);
       tmp = build_call_expr_loc (input_location,
-			     	 error_stop ? gfor_fndecl_error_stop_string
+				 error_stop ? gfor_fndecl_error_stop_string
 				 : gfor_fndecl_stop_string,
-			     	 2, build_int_cst (pchar_type_node, 0), tmp);
+				 2, build_int_cst (pchar_type_node, 0), tmp);
     }
   else if (code->expr1->ts.type == BT_INTEGER)
     {
       gfc_conv_expr (&se, code->expr1);
       tmp = build_call_expr_loc (input_location,
-      				 error_stop ? gfor_fndecl_error_stop_numeric
-			   	 : gfor_fndecl_stop_numeric, 1,
+				 error_stop ? gfor_fndecl_error_stop_numeric
+				 : gfor_fndecl_stop_numeric_f08, 1, 
 				 fold_convert (gfc_int4_type_node, se.expr));
     }
   else
     {
       gfc_conv_expr_reference (&se, code->expr1);
       tmp = build_call_expr_loc (input_location,
-			     	 error_stop ? gfor_fndecl_error_stop_string
+				 error_stop ? gfor_fndecl_error_stop_string
 				 : gfor_fndecl_stop_string,
-			     	 2, se.expr, se.string_length);
+				 2, se.expr, se.string_length);
     }
 
   gfc_add_expr_to_block (&se.pre, tmp);
Index: gcc/fortran/trans.h
===================================================================
--- gcc/fortran/trans.h	(revision 165674)
+++ gcc/fortran/trans.h	(working copy)
@@ -589,6 +589,7 @@  void gfc_omp_firstprivatize_type_sizes (struct gim
 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_numeric_f08;
 extern GTY(()) tree gfor_fndecl_stop_string;
 extern GTY(()) tree gfor_fndecl_error_stop_numeric;
 extern GTY(()) tree gfor_fndecl_error_stop_string;
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(revision 165674)
+++ gcc/fortran/trans-decl.c	(working copy)
@@ -87,6 +87,7 @@  tree gfc_static_ctors;
 tree gfor_fndecl_pause_numeric;
 tree gfor_fndecl_pause_string;
 tree gfor_fndecl_stop_numeric;
+tree gfor_fndecl_stop_numeric_f08;
 tree gfor_fndecl_stop_string;
 tree gfor_fndecl_error_stop_numeric;
 tree gfor_fndecl_error_stop_string;
@@ -2802,6 +2803,12 @@  gfc_build_builtin_function_decls (void)
   /* STOP doesn't return.  */
   TREE_THIS_VOLATILE (gfor_fndecl_stop_numeric) = 1;
 
+  gfor_fndecl_stop_numeric_f08 = gfc_build_library_function_decl (
+	get_identifier (PREFIX("stop_numeric_f08")),
+	void_type_node, 1, gfc_int4_type_node);
+  /* STOP doesn't return.  */
+  TREE_THIS_VOLATILE (gfor_fndecl_stop_numeric_f08) = 1;
+
   gfor_fndecl_stop_string = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("stop_string")), ".R.",
 	void_type_node, 2, pchar_type_node, gfc_int4_type_node);