From patchwork Tue Oct 12 22:10:31 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 67629 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 7DE32B6EDF for ; Wed, 13 Oct 2010 09:10:45 +1100 (EST) Received: (qmail 2292 invoked by alias); 12 Oct 2010 22:10:43 -0000 Received: (qmail 2278 invoked by uid 22791); 12 Oct 2010 22:10:41 -0000 X-SWARE-Spam-Status: No, hits=-1.2 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from smtp5.netcologne.de (HELO smtp5.netcologne.de) (194.8.194.25) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 12 Oct 2010 22:10:35 +0000 Received: from [192.168.0.197] (xdsl-84-44-141-169.netcologne.de [84.44.141.169]) by smtp5.netcologne.de (Postfix) with ESMTP id B81D140CDEC; Wed, 13 Oct 2010 00:10:31 +0200 (CEST) Subject: Re: [patch, fortran] Separate READ from WRITE From: Thomas Koenig To: Tobias Burnus Cc: Jerry DeLisle , fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org In-Reply-To: <4CB42327.5000900@net-b.de> References: <1286731389.6166.7.camel@linux-fd1f.site> <4CB236F9.6080904@frontier.com> <4CB2B84A.9090902@net-b.de> <1286822512.3841.7.camel@linux-fd1f.site> <4CB35E06.7020706@net-b.de> <4CB42327.5000900@net-b.de> Date: Wed, 13 Oct 2010 00:10:31 +0200 Message-ID: <1286921431.6440.28.camel@linux-fd1f.site> Mime-Version: 1.0 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Hi Tobias, > Thus, I think the first argument should be "w" (i.e. the attribute > should start with ".w"). However, I have still the feeling that READ > and > thus transfer_logical should have ".wW" (as it is now) while WRITE > should have ".wR" (and not ".rW"). Recall in that the first item in > the > string (".") skips over the *return value* (which here is "void"). > The > last argument (int4 len) has no spec as it is passed by value and > thus > does not need a fn-spec After having read the source in tree.h, I concur. Here's the updated patch; currently regression-testing. Note the small "r" for the array transfer. OK if it passes? I'll only be able to commit this on the weekend, due to business travel. Thomas 2010-10-11 Thomas Koenig PR fortran/20165 PR fortran/31593 PR fortran/43665 * gfortran.map: Add _gfortran_transfer_array_write, _gfortran_transfer_array_write, _gfortran_transfer_character_write, _gfortran_transfer_character_wide_write, _gfortran_transfer_complex_write, _gfortran_transfer_integer_write, _gfortran_transfer_logical_write and _gfortran_transfer_real_write. * io/transfer.c (transfer_integer_write): Add prototype and function body as call to the original function, without the _write. (transfer_real_write): Likewise. (transfer_logical_write): Likewise. (transfer_character_write): Likewise. (transfer_character_wide_write): Likewise. (transfer_complex_write): Likewise. (transfer_array_write): Likewise. 2010-10-11 Thomas Koenig PR fortran/20165 PR fortran/31593 PR fortran/43665 * trans-io.c (enum iocall): Add IOCALL_X_INTEGER_WRITE, IOCALL_X_LOGICAL_WRITE, IOCALL_X_CHARACTER_WRITE, IOCALL_X_CHARACTER_WIDE_WRIE, IOCALL_X_REAL_WRITE, IOCALL_X_COMPLEX_WRITE and IOCALL_X_ARRAY_WRITE. (gfc_build_io_library_fndecls): Add corresponding function decls. (transfer_expr): If the current transfer is a READ, use the iocall with the original version, otherwise the version with _WRITE. (transfer_array_desc): Likewise. Index: libgfortran/gfortran.map =================================================================== --- libgfortran/gfortran.map (Revision 165124) +++ libgfortran/gfortran.map (Arbeitskopie) @@ -1141,6 +1141,13 @@ GFORTRAN_1.4 { _gfortran_parity_l8; _gfortran_parity_l16; _gfortran_selected_real_kind2008; + _gfortran_transfer_array_write; + _gfortran_transfer_character_write; + _gfortran_transfer_character_wide_write; + _gfortran_transfer_complex_write; + _gfortran_transfer_integer_write; + _gfortran_transfer_logical_write; + _gfortran_transfer_real_write; } GFORTRAN_1.3; F2C_1.0 { Index: libgfortran/io/transfer.c =================================================================== --- libgfortran/io/transfer.c (Revision 165124) +++ libgfortran/io/transfer.c (Arbeitskopie) @@ -67,25 +67,48 @@ see the files COPYING3 and COPYING.RUNTIME respect extern void transfer_integer (st_parameter_dt *, void *, int); export_proto(transfer_integer); +extern void transfer_integer_write (st_parameter_dt *, void *, int); +export_proto(transfer_integer_write); + extern void transfer_real (st_parameter_dt *, void *, int); export_proto(transfer_real); +extern void transfer_real_write (st_parameter_dt *, void *, int); +export_proto(transfer_real_write); + extern void transfer_logical (st_parameter_dt *, void *, int); export_proto(transfer_logical); +extern void transfer_logical_write (st_parameter_dt *, void *, int); +export_proto(transfer_logical_write); + extern void transfer_character (st_parameter_dt *, void *, int); export_proto(transfer_character); +extern void transfer_character_write (st_parameter_dt *, void *, int); +export_proto(transfer_character_write); + extern void transfer_character_wide (st_parameter_dt *, void *, int, int); export_proto(transfer_character_wide); +extern void transfer_character_wide_write (st_parameter_dt *, + void *, int, int); +export_proto(transfer_character_wide_write); + extern void transfer_complex (st_parameter_dt *, void *, int); export_proto(transfer_complex); +extern void transfer_complex_write (st_parameter_dt *, void *, int); +export_proto(transfer_complex_write); + extern void transfer_array (st_parameter_dt *, gfc_array_char *, int, gfc_charlen_type); export_proto(transfer_array); +extern void transfer_array_write (st_parameter_dt *, gfc_array_char *, int, + gfc_charlen_type); +export_proto(transfer_array_write); + static void us_read (st_parameter_dt *, int); static void us_write (st_parameter_dt *, int); static void next_record_r_unf (st_parameter_dt *, int); @@ -1847,6 +1870,11 @@ transfer_integer (st_parameter_dt *dtp, void *p, i dtp->u.p.transfer (dtp, BT_INTEGER, p, kind, kind, 1); } +void +transfer_integer_write (st_parameter_dt *dtp, void *p, int kind) +{ + transfer_integer (dtp, p, kind); +} void transfer_real (st_parameter_dt *dtp, void *p, int kind) @@ -1858,6 +1886,11 @@ transfer_real (st_parameter_dt *dtp, void *p, int dtp->u.p.transfer (dtp, BT_REAL, p, kind, size, 1); } +void +transfer_real_write (st_parameter_dt *dtp, void *p, int kind) +{ + transfer_real (dtp, p, kind); +} void transfer_logical (st_parameter_dt *dtp, void *p, int kind) @@ -1867,6 +1900,11 @@ transfer_logical (st_parameter_dt *dtp, void *p, i dtp->u.p.transfer (dtp, BT_LOGICAL, p, kind, kind, 1); } +void +transfer_logical_write (st_parameter_dt *dtp, void *p, int kind) +{ + transfer_logical (dtp, p, kind); +} void transfer_character (st_parameter_dt *dtp, void *p, int len) @@ -1887,6 +1925,12 @@ transfer_character (st_parameter_dt *dtp, void *p, } void +transfer_character_write (st_parameter_dt *dtp, void *p, int len) +{ + transfer_character (dtp, p, len); +} + +void transfer_character_wide (st_parameter_dt *dtp, void *p, int len, int kind) { static char *empty_string[0]; @@ -1904,6 +1948,11 @@ transfer_character_wide (st_parameter_dt *dtp, voi dtp->u.p.transfer (dtp, BT_CHARACTER, p, kind, len, 1); } +void +transfer_character_wide_write (st_parameter_dt *dtp, void *p, int len, int kind) +{ + transfer_character_wide (dtp, p, len, kind); +} void transfer_complex (st_parameter_dt *dtp, void *p, int kind) @@ -1915,6 +1964,11 @@ transfer_complex (st_parameter_dt *dtp, void *p, i dtp->u.p.transfer (dtp, BT_COMPLEX, p, kind, size, 1); } +void +transfer_complex_write (st_parameter_dt *dtp, void *p, int kind) +{ + transfer_complex (dtp, p, kind); +} void transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind, @@ -2020,6 +2074,12 @@ transfer_array (st_parameter_dt *dtp, gfc_array_ch } } +void +transfer_array_write (st_parameter_dt *dtp, gfc_array_char *desc, int kind, + gfc_charlen_type charlen) +{ + transfer_array (dtp, desc, kind, charlen); +} /* Preposition a sequential unformatted file while reading. */ Index: gcc/fortran/trans-io.c =================================================================== --- gcc/fortran/trans-io.c (Revision 165124) +++ gcc/fortran/trans-io.c (Arbeitskopie) @@ -115,12 +115,19 @@ enum iocall IOCALL_WRITE, IOCALL_WRITE_DONE, IOCALL_X_INTEGER, + IOCALL_X_INTEGER_WRITE, IOCALL_X_LOGICAL, + IOCALL_X_LOGICAL_WRITE, IOCALL_X_CHARACTER, + IOCALL_X_CHARACTER_WRITE, IOCALL_X_CHARACTER_WIDE, + IOCALL_X_CHARACTER_WIDE_WRITE, IOCALL_X_REAL, + IOCALL_X_REAL_WRITE, IOCALL_X_COMPLEX, + IOCALL_X_COMPLEX_WRITE, IOCALL_X_ARRAY, + IOCALL_X_ARRAY_WRITE, IOCALL_OPEN, IOCALL_CLOSE, IOCALL_INQUIRE, @@ -303,9 +310,7 @@ gfc_build_io_library_fndecls (void) for (ptype = IOPARM_ptype_common; ptype < IOPARM_ptype_num; ptype++) gfc_build_st_parameter ((enum ioparam_type) ptype, types); - /* Define the transfer functions. - TODO: Split them between READ and WRITE to allow further - optimizations, e.g. by using aliases? */ + /* Define the transfer functions. */ dt_parm_type = build_pointer_type (st_parameter[IOPARM_ptype_dt].type); @@ -313,32 +318,63 @@ gfc_build_io_library_fndecls (void) get_identifier (PREFIX("transfer_integer")), ".wW", void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node); + iocall[IOCALL_X_INTEGER_WRITE] = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("transfer_integer_write")), ".wR", + void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node); + iocall[IOCALL_X_LOGICAL] = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("transfer_logical")), ".wW", void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node); + iocall[IOCALL_X_LOGICAL_WRITE] = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("transfer_logical_write")), ".wR", + void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node); + iocall[IOCALL_X_CHARACTER] = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("transfer_character")), ".wW", void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node); + iocall[IOCALL_X_CHARACTER_WRITE] = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("transfer_character_write")), ".wR", + void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node); + iocall[IOCALL_X_CHARACTER_WIDE] = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("transfer_character_wide")), ".wW", void_type_node, 4, dt_parm_type, pvoid_type_node, gfc_charlen_type_node, gfc_int4_type_node); + iocall[IOCALL_X_CHARACTER_WIDE_WRITE] = + gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("transfer_character_wide_write")), ".wR", + void_type_node, 4, dt_parm_type, pvoid_type_node, + gfc_charlen_type_node, gfc_int4_type_node); + iocall[IOCALL_X_REAL] = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("transfer_real")), ".wW", void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node); + iocall[IOCALL_X_REAL_WRITE] = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("transfer_real_write")), ".wR", + void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node); + iocall[IOCALL_X_COMPLEX] = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("transfer_complex")), ".wW", void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node); + iocall[IOCALL_X_COMPLEX_WRITE] = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("transfer_complex_write")), ".wR", + void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node); + iocall[IOCALL_X_ARRAY] = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("transfer_array")), ".wW", void_type_node, 4, dt_parm_type, pvoid_type_node, integer_type_node, gfc_charlen_type_node); + iocall[IOCALL_X_ARRAY_WRITE] = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("transfer_array_write")), ".wr", + void_type_node, 4, dt_parm_type, pvoid_type_node, + integer_type_node, gfc_charlen_type_node); + /* Library entry points */ iocall[IOCALL_READ] = gfc_build_library_function_decl_with_spec ( @@ -2037,22 +2073,38 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tre { case BT_INTEGER: arg2 = build_int_cst (NULL_TREE, kind); - function = iocall[IOCALL_X_INTEGER]; + if (last_dt == READ) + function = iocall[IOCALL_X_INTEGER]; + else + function = iocall[IOCALL_X_INTEGER_WRITE]; + break; case BT_REAL: arg2 = build_int_cst (NULL_TREE, kind); - function = iocall[IOCALL_X_REAL]; + if (last_dt == READ) + function = iocall[IOCALL_X_REAL]; + else + function = iocall[IOCALL_X_REAL_WRITE]; + break; case BT_COMPLEX: arg2 = build_int_cst (NULL_TREE, kind); - function = iocall[IOCALL_X_COMPLEX]; + if (last_dt == READ) + function = iocall[IOCALL_X_COMPLEX]; + else + function = iocall[IOCALL_X_COMPLEX_WRITE]; + break; case BT_LOGICAL: arg2 = build_int_cst (NULL_TREE, kind); - function = iocall[IOCALL_X_LOGICAL]; + if (last_dt == READ) + function = iocall[IOCALL_X_LOGICAL]; + else + function = iocall[IOCALL_X_LOGICAL_WRITE]; + break; case BT_CHARACTER: @@ -2069,7 +2121,11 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tre arg2 = fold_convert (gfc_charlen_type_node, arg2); } arg3 = build_int_cst (NULL_TREE, kind); - function = iocall[IOCALL_X_CHARACTER_WIDE]; + if (last_dt == READ) + function = iocall[IOCALL_X_CHARACTER_WIDE]; + else + function = iocall[IOCALL_X_CHARACTER_WIDE_WRITE]; + tmp = gfc_build_addr_expr (NULL_TREE, dt_parm); tmp = build_call_expr_loc (input_location, function, 4, tmp, addr_expr, arg2, arg3); @@ -2088,7 +2144,11 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tre gcc_assert (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE); arg2 = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (tmp))); } - function = iocall[IOCALL_X_CHARACTER]; + if (last_dt == READ) + function = iocall[IOCALL_X_CHARACTER]; + else + function = iocall[IOCALL_X_CHARACTER_WRITE]; + break; case BT_DERIVED: @@ -2139,7 +2199,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tre static void transfer_array_desc (gfc_se * se, gfc_typespec * ts, tree addr_expr) { - tree tmp, charlen_arg, kind_arg; + tree tmp, charlen_arg, kind_arg, io_call; if (ts->type == BT_CHARACTER) charlen_arg = se->string_length; @@ -2149,8 +2209,13 @@ transfer_array_desc (gfc_se * se, gfc_typespec * t kind_arg = build_int_cst (NULL_TREE, ts->kind); tmp = gfc_build_addr_expr (NULL_TREE, dt_parm); + if (last_dt == READ) + io_call = iocall[IOCALL_X_ARRAY]; + else + io_call = iocall[IOCALL_X_ARRAY_WRITE]; + tmp = build_call_expr_loc (UNKNOWN_LOCATION, - iocall[IOCALL_X_ARRAY], 4, + io_call, 4, tmp, addr_expr, kind_arg, charlen_arg); gfc_add_expr_to_block (&se->pre, tmp); gfc_add_block_to_block (&se->pre, &se->post);