From patchwork Tue Apr 19 10:36:11 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 91944 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 3CB9DB6F15 for ; Tue, 19 Apr 2011 20:36:44 +1000 (EST) Received: (qmail 3318 invoked by alias); 19 Apr 2011 10:36:40 -0000 Received: (qmail 3166 invoked by uid 22791); 19 Apr 2011 10:36:38 -0000 X-SWARE-Spam-Status: No, hits=1.0 required=5.0 tests=AWL, BAYES_00, KAM_STOCKTIP, RCVD_IN_DNSWL_NONE X-Spam-Check-By: sourceware.org Received: from mx01.qsc.de (HELO mx01.qsc.de) (213.148.129.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 19 Apr 2011 10:36:15 +0000 Received: from [192.168.178.22] (port-92-204-66-174.dynamic.qsc.de [92.204.66.174]) by mx01.qsc.de (Postfix) with ESMTP id 90C8B3CC1E; Tue, 19 Apr 2011 12:36:13 +0200 (CEST) Message-ID: <4DAD659B.1000708@net-b.de> Date: Tue, 19 Apr 2011 12:36:11 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.9.2.13) Gecko/20101206 SUSE/3.1.7 Thunderbird/3.1.7 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR 48588 - (4.6/4.7 regression) Resolve whole TU before generating code 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 Currently, gfortran ships (trans*.c) MODULEs directly while it waits until the end for subroutines, functions and PROGRAM. The latter are then first all resolved and afterwards the middle-end code is generated. In the PR this shows an issue: The a module procedure calls an external subroutine - which exists as gsym. In trans-decl one therefore uses the symbol information from gsym, which causes an ICE as the latter has not yet been resolved. The solution is to first resolve the whole translation unit (file) before starting to generate middle end code. The only disadvantage is that it increases the required memory, however, it might be easier to re-use the module data later when gfortran stops reading module files all the time. I am also not 100% sure that I free all structures, though the patch probably frees most. Build and regtested on x86-64-linux. OK for the trunk - and after some grace period - for the 4.6 branch? Tobias PS: The code works with -fno-whole-file as then the code is always generated immediately. (Additionally, gsym is not used then.) PPS: There are still three open 4.6/4.7 regressions - besides this one and the -frealloc-lhs issue Paul is working on. We should really fix those before 4.6.1 is released and Linux distributions and others start to heavily using 4.6.x. 2011-04-19 Tobias Burnus PR fortran/48588 * parse.c (resolve_all_program_units): Skip modules. (translate_all_program_units): Handle modules. (gfc_parse_file): Defer code generation for modules. 2011-04-19 Tobias Burnus PR fortran/48588 * gfortran.dg/whole_file_33.f90: New. diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index c09589b..5d2237a 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -4191,6 +4191,10 @@ resolve_all_program_units (gfc_namespace *gfc_global_ns_list) gfc_current_ns = gfc_global_ns_list; for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling) { + if (gfc_current_ns->proc_name + && gfc_current_ns->proc_name->attr.flavor == FL_MODULE) + continue; /* Already resolved. */ + if (gfc_current_ns->proc_name) gfc_current_locus = gfc_current_ns->proc_name->declared_at; gfc_resolve (gfc_current_ns); @@ -4231,8 +4235,28 @@ translate_all_program_units (gfc_namespace *gfc_global_ns_list) gfc_current_ns = gfc_global_ns_list; gfc_get_errors (NULL, &errors); + /* We first translate all modules to make sure that later parts + of the program can use the decl. Then we translate the nonmodules. */ + + for (; !errors && gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling) + { + if (!gfc_current_ns->proc_name + || gfc_current_ns->proc_name->attr.flavor != FL_MODULE) + continue; + + gfc_current_locus = gfc_current_ns->proc_name->declared_at; + gfc_derived_types = gfc_current_ns->derived_types; + gfc_generate_module_code (gfc_current_ns); + gfc_current_ns->translated = 1; + } + + gfc_current_ns = gfc_global_ns_list; for (; !errors && gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling) { + if (gfc_current_ns->proc_name + && gfc_current_ns->proc_name->attr.flavor == FL_MODULE) + continue; + gfc_current_locus = gfc_current_ns->proc_name->declared_at; gfc_derived_types = gfc_current_ns->derived_types; gfc_generate_code (gfc_current_ns); @@ -4243,7 +4267,16 @@ translate_all_program_units (gfc_namespace *gfc_global_ns_list) gfc_current_ns = gfc_global_ns_list; for (;gfc_current_ns;) { - gfc_namespace *ns = gfc_current_ns->sibling; + gfc_namespace *ns; + + if (gfc_current_ns->proc_name + && gfc_current_ns->proc_name->attr.flavor == FL_MODULE) + { + gfc_current_ns = gfc_current_ns->sibling; + continue; + } + + ns = gfc_current_ns->sibling; gfc_derived_types = gfc_current_ns->derived_types; gfc_done_2 (); gfc_current_ns = ns; @@ -4375,16 +4408,18 @@ loop: if (s.state == COMP_MODULE) { gfc_dump_module (s.sym->name, errors_before == errors); - if (errors == 0) - gfc_generate_module_code (gfc_current_ns); - pop_state (); if (!gfc_option.flag_whole_file) - gfc_done_2 (); + { + if (errors == 0) + gfc_generate_module_code (gfc_current_ns); + pop_state (); + gfc_done_2 (); + } else { gfc_current_ns->derived_types = gfc_derived_types; gfc_derived_types = NULL; - gfc_current_ns = NULL; + goto prog_units; } } else @@ -4429,10 +4464,12 @@ prog_units: = gfc_option.dump_fortran_original ? gfc_global_ns_list : NULL; for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling) - { - gfc_dump_parse_tree (gfc_current_ns, stdout); - fputs ("------------------------------------------\n\n", stdout); - } + if (!gfc_current_ns->proc_name + || gfc_current_ns->proc_name->attr.flavor != FL_MODULE) + { + gfc_dump_parse_tree (gfc_current_ns, stdout); + fputs ("------------------------------------------\n\n", stdout); + } /* Do the translation. */ translate_all_program_units (gfc_global_ns_list); --- /dev/null 2011-04-17 08:11:58.283889637 +0200 +++ b/gcc/testsuite/gfortran.dg/whole_file_33.f90 2011-04-19 10:33:23.502098186 +0200 @@ -0,0 +1,50 @@ +! { dg-do compile } +! +! PR fortran/48588 +! +! Contributed by Andres Legarra. +! + +MODULE LA_PRECISION +IMPLICIT NONE +INTEGER, PARAMETER :: dp = KIND(1.0D0) +END MODULE LA_PRECISION + +module lapack90 +INTERFACE + SUBROUTINE DGESV_F90( A, B, IPIV, INFO ) + USE la_precision, ONLY: wp => dp + IMPLICIT NONE + INTEGER, INTENT(OUT), OPTIONAL :: INFO + INTEGER, INTENT(OUT), OPTIONAL, TARGET :: IPIV(:) + REAL(WP), INTENT(IN OUT) :: A(:,:), B(:,:) + END SUBROUTINE DGESV_F90 +END INTERFACE +end module + +SUBROUTINE DGESV_F90( A, B, IPIV, INFO ) + USE la_precision, ONLY: wp => dp + IMPLICIT NONE + INTEGER, INTENT(OUT), OPTIONAL :: INFO + INTEGER, INTENT(OUT), OPTIONAL, TARGET :: IPIV(:) + REAL(WP), INTENT(IN OUT) :: A(:,:), B(:,:) +END SUBROUTINE DGESV_F90 + +MODULE DENSEOP + USE LAPACK90 + implicit none + integer, parameter :: r8 = SELECTED_REAL_KIND( 15, 307 ) + real(r8)::denseop_tol=1.d-50 + + CONTAINS + + SUBROUTINE GEINV8 (x) + real(r8)::x(:,:) + real(r8),allocatable::x_o(:,:) + allocate(x_o(size(x,1),size(x,1))) + CALL dgesv_f90(x,x_o) + x=x_o + END SUBROUTINE GEINV8 +END MODULE DENSEOP + +! { dg-final { cleanup-modules "la_precision lapack90 denseop" } }