From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 91518 invoked by alias); 13 Mar 2018 04:08:15 -0000 Mailing-List: contact fortran-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Subscribe: List-Post: List-Help: , Sender: fortran-owner@gcc.gnu.org Received: (qmail 91487 invoked by uid 89); 13 Mar 2018 04:08:14 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-8.7 required=5.0 tests=AWL,BAYES_00,GIT_PATCH_2,GIT_PATCH_3,KAM_ASCII_DIVIDERS,KAM_LAZY_DOMAIN_SECURITY,KAM_STOCKGEN,RCVD_IN_DNSWL_LOW,T_RP_MATCHES_RCVD autolearn=ham version=3.3.2 spammy= X-Spam-User: qpsmtpd, 2 recipients X-HELO: troutmask.apl.washington.edu Received: from troutmask.apl.washington.edu (HELO troutmask.apl.washington.edu) (128.95.76.21) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Tue, 13 Mar 2018 04:08:11 +0000 Received: from troutmask.apl.washington.edu (localhost [127.0.0.1]) by troutmask.apl.washington.edu (8.15.2/8.15.2) with ESMTPS id w2D489B3069163 (version=TLSv1.2 cipher=DHE-RSA-AES256-GCM-SHA384 bits=256 verify=NO); Mon, 12 Mar 2018 21:08:09 -0700 (PDT) (envelope-from sgk@troutmask.apl.washington.edu) Received: (from sgk@localhost) by troutmask.apl.washington.edu (8.15.2/8.15.2/Submit) id w2D489uI069162; Mon, 12 Mar 2018 21:08:09 -0700 (PDT) (envelope-from sgk) Date: Tue, 13 Mar 2018 04:08:00 -0000 From: Steve Kargl To: Janne Blomqvist Cc: Fortran List , GCC Patches Subject: Re: [PATCH] Fortran -- clean up KILL Message-ID: <20180313040809.GA69151@troutmask.apl.washington.edu> Reply-To: sgk@troutmask.apl.washington.edu References: <20180311165209.GA60279@troutmask.apl.washington.edu> <20180311204239.GA56613@troutmask.apl.washington.edu> <20180312173706.GB61632@troutmask.apl.washington.edu> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="zhXaljGHf11kAtnf" Content-Disposition: inline In-Reply-To: User-Agent: Mutt/1.9.2 (2017-12-15) X-IsSubscribed: yes X-SW-Source: 2018-03/txt/msg00050.txt.bz2 --zhXaljGHf11kAtnf Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Content-length: 2071 On Mon, Mar 12, 2018 at 09:05:09PM +0200, Janne Blomqvist wrote: > > Yes, I understand that -fdefault-integer-8 (or whatever the equivalent > option was called on g77) is the original motivation. Like I said, I > don't have any particular opinion on whether we should keep that > restriction or not. On one hand, more recent versions of the standard > has lifted restrictions that integer intrinsic arguments have to be of > default kind in many cases, OTOH KILL is not a standard intrinsic but > something inherited from g77. So, meh. The Fortran standard specifically permits a Fortran processor to supply additional subprograms not contained in the Fortran standard. I personally can't any person person using INTEGER(1) or even INTEGER(2) with KILL as pid_t on typical modern OS's exceeds HUGE() in those types. My original patch simply fixed KILL to actually conform to its documentation. But is this what you want 2018-03-12 Steven G. Kargl * 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-12 Steven G. Kargl * 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. -- Steve --zhXaljGHf11kAtnf Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="kill.diff" Content-length: 12608 Index: gcc/fortran/check.c =================================================================== --- gcc/fortran/check.c (revision 258468) +++ gcc/fortran/check.c (working copy) @@ -2783,20 +2783,13 @@ gfc_check_kill_sub (gfc_expr *pid, gfc_expr *sig, gfc_ 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; Index: gcc/fortran/intrinsic.c =================================================================== --- gcc/fortran/intrinsic.c (revision 258468) +++ gcc/fortran/intrinsic.c (working copy) @@ -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); Index: gcc/fortran/intrinsic.texi =================================================================== --- gcc/fortran/intrinsic.texi (revision 258468) +++ gcc/fortran/intrinsic.texi (working copy) @@ -8719,7 +8719,7 @@ Sends the signal specified by @var{SIG} to the process 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 Index: gcc/fortran/iresolve.c =================================================================== --- gcc/fortran/iresolve.c (revision 258468) +++ gcc/fortran/iresolve.c (working copy) @@ -1492,19 +1492,6 @@ gfc_resolve_ishftc (gfc_expr *f, gfc_expr *i, gfc_expr 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); @@ -3456,22 +3443,6 @@ gfc_resolve_rename_sub (gfc_code *c) kind = gfc_default_integer_kind; name = gfc_get_string (PREFIX ("rename_i%d_sub"), kind); - c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); -} - - -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); } Index: gcc/fortran/trans-decl.c =================================================================== --- gcc/fortran/trans-decl.c (revision 258468) +++ gcc/fortran/trans-decl.c (working copy) @@ -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,7 +214,10 @@ 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; tree gfor_fndecl_si_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); } Index: gcc/fortran/trans-intrinsic.c =================================================================== --- gcc/fortran/trans-intrinsic.c (revision 258468) +++ gcc/fortran/trans-intrinsic.c (working copy) @@ -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. */ @@ -8962,6 +9041,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * e gfc_conv_intrinsic_conjg (se, expr); break; + case GFC_ISYM_KILL: + conv_intrinsic_kill (se, expr); + break; + case GFC_ISYM_COUNT: gfc_conv_intrinsic_count (se, expr); break; @@ -9344,7 +9427,6 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * e 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: @@ -10819,6 +10901,10 @@ gfc_conv_intrinsic_subroutine (gfc_code *code) case GFC_ISYM_FREE: res = conv_intrinsic_free (code); + break; + + case GFC_ISYM_KILL: + res = conv_intrinsic_kill_sub (code); break; case GFC_ISYM_SYSTEM_CLOCK: Index: gcc/fortran/trans.h =================================================================== --- gcc/fortran/trans.h (revision 258468) +++ gcc/fortran/trans.h (working copy) @@ -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; Index: libgfortran/gfortran.map =================================================================== --- libgfortran/gfortran.map (revision 258468) +++ libgfortran/gfortran.map (working copy) @@ -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; Index: libgfortran/intrinsics/kill.c =================================================================== --- libgfortran/intrinsics/kill.c (revision 258468) +++ libgfortran/intrinsics/kill.c (working copy) @@ -32,61 +32,32 @@ see the files COPYING3 and COPYING.RUNTIME respectivel 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); +extern GFC_INTEGER_4 kill (GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(kill); -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); - 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; + return (int)kill (pid, signal); } -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 --zhXaljGHf11kAtnf--