From patchwork Sun Oct 10 17:23:09 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 67357 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 99DD2B6EFE for ; Mon, 11 Oct 2010 04:23:26 +1100 (EST) Received: (qmail 17630 invoked by alias); 10 Oct 2010 17:23:23 -0000 Received: (qmail 17611 invoked by uid 22791); 10 Oct 2010 17:23:21 -0000 X-SWARE-Spam-Status: No, hits=-1.1 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; Sun, 10 Oct 2010 17:23:13 +0000 Received: from [192.168.0.197] (xdsl-84-44-143-200.netcologne.de [84.44.143.200]) by smtp5.netcologne.de (Postfix) with ESMTP id CFD5340D4A9; Sun, 10 Oct 2010 19:23:09 +0200 (CEST) Subject: [patch, fortran, RFC] Separate READ from WRITE From: Thomas Koenig To: fortran@gcc.gnu.org Cc: gcc-patches@gcc.gnu.org Date: Sun, 10 Oct 2010 19:23:09 +0200 Message-ID: <1286731389.6166.7.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 Hello world, this RFC patch separates reads from writes in Fortran, by establishing separate transfer functions for writing, with a different spec. For now, the write functions just call the original transfer functions, with the spec making all the difference. Do you think this is the right approach? Did I get the specs right (I didn't find any documentation, but I may have missed something)? This does speed up the test case from PR 31593, and should also at least partially fix PR 20165. No changelog yet, and a test case probably isn't needed. I'm currently regression-testing. If there is general agreement, I think this could still go into 4.6. Comments? Other/better ideas? Thomas Index: libgfortran/gfortran.map =================================================================== --- libgfortran/gfortran.map (Revision 165124) +++ libgfortran/gfortran.map (Arbeitskopie) @@ -1141,6 +1141,12 @@ _gfortran_parity_l8; _gfortran_parity_l16; _gfortran_selected_real_kind2008; + _gfortran_transfer_array_write; + _gfortran_transfer_character_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 @@ 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 @@ 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 @@ 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 @@ 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 @@ } 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 @@ 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 @@ 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 @@ } } +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 @@ 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 @@ 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 @@ 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")), ".rW", + 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")), ".rW", + 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")), ".rW", + 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")), ".rW", + 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")), ".rW", + 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")), ".rW", + 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")), ".rW", + 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 @@ { 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 @@ 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 @@ 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 @@ 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 @@ 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);