OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Steven G. Kargl 2018-03-14 00:56:48 +00:00
parent 10f499af34
commit 17164de4f8
11 changed files with 152 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
gcc/fortran/ChangeLog
View File

@ -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

19
gcc/fortran/check.c
View File

@ -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;

4
gcc/fortran/intrinsic.c
View File

@ -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);

15
gcc/fortran/intrinsic.texi
View File

@ -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

29
gcc/fortran/iresolve.c
View File

@ -1491,19 +1491,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)
{
@ -3460,22 +3447,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)
{

12
gcc/fortran/trans-decl.c
View File

@ -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);
}

88
gcc/fortran/trans-intrinsic.c
View File

@ -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;

2
gcc/fortran/trans.h
View File

@ -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;

9
libgfortran/ChangeLog
View File

@ -1,3 +1,12 @@
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.
2018-02-23 Janne Blomqvist <jb@gcc.gnu.org>
PR fortran/84519

6
libgfortran/gfortran.map
View File

@ -318,10 +318,8 @@ GFORTRAN_8 {
_gfortran_ishftc8;
_gfortran_itime_i4;
_gfortran_itime_i8;
_gfortran_kill_i4;
_gfortran_kill_i4_sub;
_gfortran_kill_i8;
_gfortran_kill_i8_sub;
_gfortran_kill;
_gfortran_kill_sub;
_gfortran_link_i4;
_gfortran_link_i4_sub;
_gfortran_link_i8;

51
libgfortran/intrinsics/kill.c
View File

@ -32,61 +32,34 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
INTEGER, INTENT(IN) :: PID, SIGNAL
INTEGER(KIND=1), INTENT(OUT), OPTIONAL :: STATUS
INTEGER(KIND=1) FUNCTION KILL(PID, SIGNAL)
INTEGER FUNCTION KILL(PID, SIGNAL)
INTEGER, INTENT(IN) :: PID, SIGNAL */
#ifdef HAVE_KILL
extern void kill_i4_sub (GFC_INTEGER_4 *, GFC_INTEGER_4 *, GFC_INTEGER_4 *);
iexport_proto(kill_i4_sub);
extern void kill_sub (GFC_INTEGER_4, GFC_INTEGER_4, GFC_INTEGER_4 *);
iexport_proto(kill_sub);
void
kill_i4_sub (GFC_INTEGER_4 *pid, GFC_INTEGER_4 *signal,
GFC_INTEGER_4 *status)
kill_sub (GFC_INTEGER_4 pid, GFC_INTEGER_4 signal, GFC_INTEGER_4 *status)
{
int val;
val = kill (*pid, *signal);
val = kill (pid, signal);
if (status != NULL)
*status = (val == 0) ? 0 : errno;
}
iexport(kill_i4_sub);
iexport(kill_sub);
extern void kill_i8_sub (GFC_INTEGER_8 *, GFC_INTEGER_8 *, GFC_INTEGER_8 *);
iexport_proto(kill_i8_sub);
void
kill_i8_sub (GFC_INTEGER_8 *pid, GFC_INTEGER_8 *signal,
GFC_INTEGER_8 *status)
{
int val;
val = kill (*pid, *signal);
if (status != NULL)
*status = (val == 0) ? 0 : errno;
}
iexport(kill_i8_sub);
extern GFC_INTEGER_4 kill_i4 (GFC_INTEGER_4 *, GFC_INTEGER_4 *);
export_proto(kill_i4);
extern GFC_INTEGER_4 kill (GFC_INTEGER_4, GFC_INTEGER_4);
export_proto(kill);
GFC_INTEGER_4
kill_i4 (GFC_INTEGER_4 *pid, GFC_INTEGER_4 *signal)
kill (GFC_INTEGER_4 pid, GFC_INTEGER_4 signal)
{
GFC_INTEGER_4 val;
kill_i4_sub (pid, signal, &val);
return val;
int val;
val = (int)kill (pid, signal);
return ((val == 0) ? 0 : errno);
}
extern GFC_INTEGER_8 kill_i8 (GFC_INTEGER_8 *, GFC_INTEGER_8 *);
export_proto(kill_i8);
GFC_INTEGER_8
kill_i8 (GFC_INTEGER_8 *pid, GFC_INTEGER_8 *signal)
{
GFC_INTEGER_8 val;
kill_i8_sub (pid, signal, &val);
return val;
}
#endif