check.c (gfc_check_kill_sub): Remove check for INTEGER(4) or (8).

2018-03-13  Steven G. Kargl  <kargl@gcc.gnu.org>

	* check.c (gfc_check_kill_sub):  Remove check for INTEGER(4) or (8).
	* intrinsic.c (add_functions): Remove reference to gfc_resolve_kill.
	(add_subroutines): Remove reference to gfc_resolve_kill_sub.
	* intrinsic.texi: Update documentation.
	* iresolve.c (gfc_resolve_kill, gfc_resolve_kill_sub): Remove.
	* trans-decl.c (gfc_build_intrinsic_function_decls):  Add
	gfor_fndecl_kill and gfor_fndecl_kill_sub
	* trans-intrinsic.c (conv_intrinsic_kill, conv_intrinsic_kill_sub): new
	functions.
	(gfc_conv_intrinsic_function): Use conv_intrinsic_kill.
        (gfc_conv_intrinsic_subroutine): Use conv_intrinsic_kill_sub.
	* trans.h: Declare gfor_fndecl_kill and gfor_fndecl_kill_sub.
 
2018-03-13  Steven G. Kargl  <kargl@gcc.gnu.org>

	* libgfortran/gfortran.map: Remove _gfortran_kill_i4,
	_gfortran_kill_i4_sub, _gfortran_kill_i8, and _gfortran_kill_i8_sub.
	Add _gfortran_kill and _gfortran_kill_sub.
	* libgfortran/intrinsics/kill.c: Eliminate _gfortran_kill_i4,
	_gfortran_kill_i4_sub, _gfortran_kill_i8, and _gfortran_kill_i8_sub.
	Add _gfortran_kill and _gfortran_kill_sub.

From-SVN: r258511

8 files changed, 129 insertions, 55 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e767908..19854f1 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,18 @@
+2018-03-13  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* check.c (gfc_check_kill_sub):  Remove check for INTEGER(4) or (8).
+	* intrinsic.c (add_functions): Remove reference to gfc_resolve_kill.
+	(add_subroutines): Remove reference to gfc_resolve_kill_sub.
+	* intrinsic.texi: Update documentation.
+	* iresolve.c (gfc_resolve_kill, gfc_resolve_kill_sub): Remove.
+	* trans-decl.c (gfc_build_intrinsic_function_decls):  Add
+	gfor_fndecl_kill and gfor_fndecl_kill_sub
+	* trans-intrinsic.c (conv_intrinsic_kill, conv_intrinsic_kill_sub): new
+	functions.
+	(gfc_conv_intrinsic_function): Use conv_intrinsic_kill.
+        (gfc_conv_intrinsic_subroutine): Use conv_intrinsic_kill_sub.
+	* trans.h: Declare gfor_fndecl_kill and gfor_fndecl_kill_sub.
+
 2018-03-11  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/84546
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 1971db0..23b1964 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -2783,20 +2783,13 @@ gfc_check_kill_sub (gfc_expr *pid, gfc_expr *sig, gfc_expr *status)
   if (!scalar_check (sig, 1))
     return false;
 
-  if (status == NULL)
-    return true;
-
-  if (!type_check (status, 2, BT_INTEGER))
-    return false;
-
-  if (!scalar_check (status, 2))
-    return false;
-
-  if (status->ts.kind != 4 && status->ts.kind != 8)
+  if (status)
     {
-      gfc_error ("Invalid kind type parameter for STATUS at %L",
-		 &status->where);
-      return false;
+      if (!type_check (status, 2, BT_INTEGER))
+	return false;
+
+      if (!scalar_check (status, 2))
+	return false;
     }
 
   return true;
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 006b114..d9cc249 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -2255,7 +2255,7 @@ add_functions (void)
   make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95);
 
   add_sym_2 ("kill", GFC_ISYM_KILL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
-	     di, GFC_STD_GNU, gfc_check_kill, NULL, gfc_resolve_kill,
+	     di, GFC_STD_GNU, gfc_check_kill, NULL, NULL,
 	     pid, BT_INTEGER, di, REQUIRED, sig, BT_INTEGER, di, REQUIRED);
 
   make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU);
@@ -3724,7 +3724,7 @@ add_subroutines (void)
 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
 
   add_sym_3s ("kill", GFC_ISYM_KILL, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
-	      gfc_check_kill_sub, NULL, gfc_resolve_kill_sub,
+	      gfc_check_kill_sub, NULL, NULL,
 	      pid, BT_INTEGER, di, REQUIRED, INTENT_IN,
 	      sig, BT_INTEGER, di, REQUIRED, INTENT_IN,
 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index bd77c1e..e38440d 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -8719,7 +8719,7 @@ Sends the signal specified by @var{SIG} to the process @var{PID}.
 See @code{kill(2)}.
 
 This intrinsic is provided in both subroutine and function forms;
-however,  only one form can be used in any given program unit.
+however, only one form can be used in any given program unit.
 
 @item @emph{Class}:
 Subroutine, function
@@ -8732,16 +8732,13 @@ Subroutine, function
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{PID} @tab Shall be a scalar @code{INTEGER} with
-@code{INTENT(IN)}
-@item @var{SIG} @tab Shall be a scalar @code{INTEGER} with
-@code{INTENT(IN)}
-@item @var{STATUS} @tab [Subroutine](Optional) status flag of type
-@code{INTEGER(4)} or @code{INTEGER(8)}.
+@item @var{PID} @tab Shall be a scalar @code{INTEGER} with @code{INTENT(IN)}.
+@item @var{SIG} @tab Shall be a scalar @code{INTEGER} with @code{INTENT(IN)}.
+@item @var{STATUS} @tab [Subroutine](Optional)
+Shall be a scalar @code{INTEGER}.
 Returns 0 on success; otherwise a system-specific error code is returned.
 @item @var{STATUS} @tab [Function] The kind type parameter is that of
-@code{pid} if @code{pid} is of type @code{INTEGER(4)} or @code{INTEGER(8)};
-otherwise, it is default integer kind.
+@code{pid}.
 Returns 0 on success; otherwise a system-specific error code is returned.
 @end multitable
 
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index f2208b4..f15b8f2 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1492,19 +1492,6 @@ gfc_resolve_ishftc (gfc_expr *f, gfc_expr *i, gfc_expr *shift, gfc_expr *size)
 
 
 void
-gfc_resolve_kill (gfc_expr *f, gfc_expr *pid,
-		  gfc_expr *sig ATTRIBUTE_UNUSED)
-{
-  f->ts.type = BT_INTEGER;
-  if (pid->ts.kind == 4 || pid->ts.kind == 8)
-    f->ts.kind = pid->ts.kind;
-  else
-    f->ts.kind = gfc_default_integer_kind;
-  f->value.function.name = gfc_get_string (PREFIX ("kill_i%d"), f->ts.kind);
-}
-
-
-void
 gfc_resolve_lbound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
 {
   resolve_bound (f, array, dim, kind, "__lbound", false);
@@ -3461,22 +3448,6 @@ gfc_resolve_rename_sub (gfc_code *c)
 
 
 void
-gfc_resolve_kill_sub (gfc_code *c)
-{
-  const char *name;
-  int kind;
-
-  if (c->ext.actual->next->next->expr != NULL)
-    kind = c->ext.actual->next->next->expr->ts.kind;
-  else
-    kind = gfc_default_integer_kind;
-
-  name = gfc_get_string (PREFIX ("kill_i%d_sub"), kind);
-  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
-}
-
-
-void
 gfc_resolve_link_sub (gfc_code *c)
 {
   const char *name;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 6742d2e..6c4a221 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -123,7 +123,6 @@ tree gfor_fndecl_system_clock8;
 tree gfor_fndecl_ieee_procedure_entry;
 tree gfor_fndecl_ieee_procedure_exit;
 
-
 /* Coarray run-time library function decls.  */
 tree gfor_fndecl_caf_init;
 tree gfor_fndecl_caf_finalize;
@@ -215,6 +214,9 @@ tree gfor_fndecl_convert_char4_to_char1;
 tree gfor_fndecl_size0;
 tree gfor_fndecl_size1;
 tree gfor_fndecl_iargc;
+tree gfor_fndecl_kill;
+tree gfor_fndecl_kill_sub;
+
 
 /* Intrinsic functions implemented in Fortran.  */
 tree gfor_fndecl_sc_kind;
@@ -3494,6 +3496,14 @@ gfc_build_intrinsic_function_decls (void)
   gfor_fndecl_iargc = gfc_build_library_function_decl (
 	get_identifier (PREFIX ("iargc")), gfc_int4_type_node, 0);
   TREE_NOTHROW (gfor_fndecl_iargc) = 1;
+
+  gfor_fndecl_kill_sub = gfc_build_library_function_decl (
+	get_identifier (PREFIX ("kill_sub")), void_type_node,
+	3, gfc_int4_type_node, gfc_int4_type_node, gfc_pint4_type_node);
+
+  gfor_fndecl_kill = gfc_build_library_function_decl (
+	get_identifier (PREFIX ("kill")), gfc_int4_type_node,
+	2, gfc_int4_type_node, gfc_int4_type_node);
 }
 
 
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 816f3b9..a45aec7 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -8115,6 +8115,85 @@ gfc_conv_intrinsic_iargc (gfc_se * se, gfc_expr * expr)
 }
 
 
+/* Generate code for the KILL intrinsic.  */
+
+static void
+conv_intrinsic_kill (gfc_se *se, gfc_expr *expr)
+{
+  tree *args;
+  tree int4_type_node = gfc_get_int_type (4);
+  tree pid;
+  tree sig;
+  tree tmp;
+  unsigned int num_args;
+
+  num_args = gfc_intrinsic_argument_list_length (expr);
+  args = XALLOCAVEC (tree, num_args);
+  gfc_conv_intrinsic_function_args (se, expr, args, num_args);
+
+  /* Convert PID to a INTEGER(4) entity.  */
+  pid = convert (int4_type_node, args[0]);
+
+  /* Convert SIG to a INTEGER(4) entity.  */
+  sig = convert (int4_type_node, args[1]);
+
+  tmp = build_call_expr_loc (input_location, gfor_fndecl_kill, 2, pid, sig);
+
+  se->expr = fold_convert (TREE_TYPE (args[0]), tmp);
+}
+
+
+static tree
+conv_intrinsic_kill_sub (gfc_code *code)
+{
+  stmtblock_t block;
+  gfc_se se, se_stat;
+  tree int4_type_node = gfc_get_int_type (4);
+  tree pid;
+  tree sig;
+  tree statp;
+  tree tmp;
+
+  /* Make the function call.  */
+  gfc_init_block (&block);
+  gfc_init_se (&se, NULL);
+
+  /* Convert PID to a INTEGER(4) entity.  */
+  gfc_conv_expr (&se, code->ext.actual->expr);
+  gfc_add_block_to_block (&block, &se.pre);
+  pid = fold_convert (int4_type_node, gfc_evaluate_now (se.expr, &block));
+  gfc_add_block_to_block (&block, &se.post);
+
+  /* Convert SIG to a INTEGER(4) entity.  */
+  gfc_conv_expr (&se, code->ext.actual->next->expr);
+  gfc_add_block_to_block (&block, &se.pre);
+  sig = fold_convert (int4_type_node, gfc_evaluate_now (se.expr, &block));
+  gfc_add_block_to_block (&block, &se.post);
+
+  /* Deal with an optional STATUS.  */
+  if (code->ext.actual->next->next->expr)
+    {
+      gfc_init_se (&se_stat, NULL);
+      gfc_conv_expr (&se_stat, code->ext.actual->next->next->expr);
+      statp = gfc_create_var (gfc_get_int_type (4), "_statp");
+    }
+  else
+    statp = NULL_TREE;
+
+  tmp = build_call_expr_loc (input_location, gfor_fndecl_kill_sub, 3, pid, sig,
+	statp ? gfc_build_addr_expr (NULL_TREE, statp) : null_pointer_node);
+
+  gfc_add_expr_to_block (&block, tmp);
+
+  if (statp && statp != se_stat.expr)
+    gfc_add_modify (&block, se_stat.expr,
+		    fold_convert (TREE_TYPE (se_stat.expr), statp));
+
+  return gfc_finish_block (&block);
+}
+
+
+
 /* The loc intrinsic returns the address of its argument as
    gfc_index_integer_kind integer.  */
 
@@ -9068,6 +9147,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_isnan (se, expr);
       break;
 
+    case GFC_ISYM_KILL:
+      conv_intrinsic_kill (se, expr);
+      break;
+
     case GFC_ISYM_LSHIFT:
       gfc_conv_intrinsic_shift (se, expr, false, false);
       break;
@@ -9344,7 +9427,6 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
     case GFC_ISYM_GETPID:
     case GFC_ISYM_GETUID:
     case GFC_ISYM_HOSTNM:
-    case GFC_ISYM_KILL:
     case GFC_ISYM_IERRNO:
     case GFC_ISYM_IRAND:
     case GFC_ISYM_ISATTY:
@@ -10821,6 +10903,10 @@ gfc_conv_intrinsic_subroutine (gfc_code *code)
       res = conv_intrinsic_free (code);
       break;
 
+    case GFC_ISYM_KILL:
+      res = conv_intrinsic_kill_sub (code);
+      break;
+
     case GFC_ISYM_SYSTEM_CLOCK:
       res = conv_intrinsic_system_clock (code);
       break;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 1bd8206..c6b3625 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -903,6 +903,8 @@ extern GTY(()) tree gfor_fndecl_convert_char4_to_char1;
 extern GTY(()) tree gfor_fndecl_size0;
 extern GTY(()) tree gfor_fndecl_size1;
 extern GTY(()) tree gfor_fndecl_iargc;
+extern GTY(()) tree gfor_fndecl_kill;
+extern GTY(()) tree gfor_fndecl_kill_sub;
 
 /* Implemented in Fortran.  */
 extern GTY(()) tree gfor_fndecl_sc_kind;