From patchwork Wed Nov 9 23:09:58 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andreas Kloeckner X-Patchwork-Id: 124741 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 B7309B6F82 for ; Thu, 10 Nov 2011 10:10:22 +1100 (EST) Received: (qmail 12820 invoked by alias); 9 Nov 2011 23:10:19 -0000 Received: (qmail 12792 invoked by uid 22791); 9 Nov 2011 23:10:15 -0000 X-SWARE-Spam-Status: No, hits=-1.9 required=5.0 tests=BAYES_00, T_TVD_MIME_NO_HEADERS X-Spam-Check-By: sourceware.org Received: from buster.xen.prgmr.com (HELO buster.xen.prgmr.com) (68.68.97.44) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Wed, 09 Nov 2011 23:10:00 +0000 Received: from 128-122-81-227.dynapool.nyu.edu ([128.122.81.227] helo=ding.tiker.net) by buster.xen.prgmr.com with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:32) (Exim 4.77) (envelope-from ) id 1ROHHy-0003Y3-Jf; Wed, 09 Nov 2011 15:10:38 -0800 Received: from andreas by ding.tiker.net with local (Exim 4.77) (envelope-from ) id 1ROHHK-00084C-Pf; Wed, 09 Nov 2011 18:09:58 -0500 From: Andreas Kloeckner To: gcc-patches@gcc.gnu.org, fortran@gcc.gnu.org, Zydrunas Gimbutas Subject: [patch] Flag-controlled type conversions/promotions User-Agent: Notmuch/0.9 (http://notmuchmail.org) Emacs/23.3.1 (x86_64-pc-linux-gnu) Date: Wed, 09 Nov 2011 18:09:58 -0500 Message-ID: <871utgao55.fsf@ding.tiker.net> 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 there, please find attached the patch and the Changelog entry for our work on the fortran bug #48426. The attached patch implements the options -finteger-4-integer-8 -freal-4-real-8 -freal-4-real-10 -freal-4-real-16 -freal-8-real-4 -freal-8-real-10 -freal-8-real-16 to implement a variety of automatic type promotions. (This is particularly helpful if one wants to quickly check whether a certain code has a bug limiting its precision away from full machine accuracy.) A similar promotion feature is available in Fujitsu compilers, see here: http://www.lahey.com/docs/fujitsu%20compiler%20option%20list.pdf (e.g. -CcR8R16) The implementation work on this was done by Zydrunas Gimbutas, not by me. Zydrunas has authorized me to submit this for inclusion in gcc. Both he and I have gone through the FSF's copyright assignment process and have current papers for that on file. We tested the change by running Kahan's Fortran paranoia tests using all supported conversions, we ran the LINPACK tests (at all supported conversions) as well as a number of manually-written conversion tests. Zydrunas and Andreas Index: gcc/fortran/decl.c =================================================================== --- gcc/fortran/decl.c (revision 181224) +++ gcc/fortran/decl.c (working copy) @@ -2097,8 +2097,24 @@ return MATCH_ERROR; } ts->kind /= 2; + } + if (ts->type == BT_INTEGER) + { + if( ts->kind == 4 && gfc_option.flag_integer4_kind == 8) ts->kind = 8; + } + + if (ts->type == BT_REAL || ts->type == BT_COMPLEX) + { + if( ts->kind == 4 && gfc_option.flag_real4_kind == 8) ts->kind = 8; + if( ts->kind == 4 && gfc_option.flag_real4_kind == 10) ts->kind = 10; + if( ts->kind == 4 && gfc_option.flag_real4_kind == 16) ts->kind = 16; + if( ts->kind == 8 && gfc_option.flag_real8_kind == 4) ts->kind = 4; + if( ts->kind == 8 && gfc_option.flag_real8_kind == 10) ts->kind = 10; + if( ts->kind == 8 && gfc_option.flag_real8_kind == 16) ts->kind = 16; + } + if (gfc_validate_kind (ts->type, ts->kind, true) < 0) { gfc_error ("Old-style type declaration %s*%d not supported at %C", @@ -2243,6 +2259,22 @@ if(m == MATCH_ERROR) gfc_current_locus = where; + + if (ts->type == BT_INTEGER) + { + if( ts->kind == 4 && gfc_option.flag_integer4_kind == 8) ts->kind = 8; + } + + if (ts->type == BT_REAL || ts->type == BT_COMPLEX) + { + if( ts->kind == 4 && gfc_option.flag_real4_kind == 8) ts->kind = 8; + if( ts->kind == 4 && gfc_option.flag_real4_kind == 10) ts->kind = 10; + if( ts->kind == 4 && gfc_option.flag_real4_kind == 16) ts->kind = 16; + if( ts->kind == 8 && gfc_option.flag_real8_kind == 4) ts->kind = 4; + if( ts->kind == 8 && gfc_option.flag_real8_kind == 10) ts->kind = 10; + if( ts->kind == 8 && gfc_option.flag_real8_kind == 16) ts->kind = 16; + } + /* Return what we know from the test(s). */ return m; Index: gcc/fortran/gfortran.h =================================================================== --- gcc/fortran/gfortran.h (revision 181224) +++ gcc/fortran/gfortran.h (working copy) @@ -2215,6 +2215,9 @@ int flag_default_double; int flag_default_integer; int flag_default_real; + int flag_integer4_kind; + int flag_real4_kind; + int flag_real8_kind; int flag_dollar_ok; int flag_underscoring; int flag_second_underscore; Index: gcc/fortran/lang.opt =================================================================== --- gcc/fortran/lang.opt (revision 181224) +++ gcc/fortran/lang.opt (working copy) @@ -394,6 +394,10 @@ Fortran RejectNegative Assume that the source file is fixed form +finteger-4-integer-8 +Fortran RejectNegative +Interpret any 4-byte integer as an 8-byte integer + fintrinsic-modules-path Fortran RejectNegative Joined Separate Specify where to find the compiled intrinsic modules @@ -494,6 +498,30 @@ Fortran Enable range checking during compilation +freal-4-real-8 +Fortran RejectNegative +Interpret any 4-byte real as an 8-byte real + +freal-4-real-10 +Fortran RejectNegative +Interpret any 4-byte real as a 10-byte real + +freal-4-real-16 +Fortran RejectNegative +Interpret any 4-byte real as a 16-byte real + +freal-8-real-4 +Fortran RejectNegative +Interpret any 8-byte real as a 4-byte real + +freal-8-real-10 +Fortran RejectNegative +Interpret any 8-byte real as a 10-byte real + +freal-8-real-16 +Fortran RejectNegative +Interpret any 8-byte real as a 16-byte real + frealloc-lhs Fortran Reallocate the LHS in assignments Index: gcc/fortran/trans-types.c =================================================================== --- gcc/fortran/trans-types.c (revision 181224) +++ gcc/fortran/trans-types.c (working copy) @@ -362,7 +362,7 @@ unsigned int mode; int i_index, r_index, kind; bool saw_i4 = false, saw_i8 = false; - bool saw_r4 = false, saw_r8 = false, saw_r16 = false; + bool saw_r4 = false, saw_r8 = false, saw_r10 = false, saw_r16 = false; for (i_index = 0, mode = MIN_MODE_INT; mode <= MAX_MODE_INT; mode++) { @@ -456,6 +456,8 @@ saw_r4 = true; if (kind == 8) saw_r8 = true; + if (kind == 10) + saw_r10 = true; if (kind == 16) saw_r16 = true; @@ -495,6 +497,17 @@ be issued when NUMERIC_STORAGE_SIZE is used. */ gfc_numeric_storage_size = 4 * 8; } + else if (saw_i8 && gfc_option.flag_integer4_kind == 8 ) + { + if (!saw_i8) + fatal_error ("integer kind=8 not available for -finteger-4-integer-8 option"); + gfc_default_integer_kind = 8; + + /* Even if the user specified that the default integer kind be 8, + the numeric storage size isn't 64. In this case, a warning will + be issued when NUMERIC_STORAGE_SIZE is used. */ + gfc_numeric_storage_size = 4 * 8; + } else if (saw_i4) { gfc_default_integer_kind = 4; @@ -513,6 +526,24 @@ fatal_error ("real kind=8 not available for -fdefault-real-8 option"); gfc_default_real_kind = 8; } + else if (gfc_option.flag_real4_kind == 8 ) + { + if (!saw_r8) + fatal_error ("real kind=8 not available for -freal-4-real-8 option"); + gfc_default_real_kind = 8; + } + else if (gfc_option.flag_real4_kind == 10 ) + { + if (!saw_r10) + fatal_error ("real kind=10 not available for -freal-4-real-10 option"); + gfc_default_real_kind = 10; + } + else if (gfc_option.flag_real4_kind == 16 ) + { + if (!saw_r16) + fatal_error ("real kind=16 not available for -freal-4-real-16 option"); + gfc_default_real_kind = 16; + } else if (saw_r4) gfc_default_real_kind = 4; else @@ -529,6 +560,24 @@ gfc_default_double_kind = 8; else if (gfc_option.flag_default_real && saw_r16) gfc_default_double_kind = 16; + else if (gfc_option.flag_real8_kind == 4 ) + { + if (!saw_r4) + fatal_error ("real kind=4 not available for -freal-8-real-4 option"); + gfc_default_double_kind = 4; + } + else if (gfc_option.flag_real8_kind == 10 ) + { + if (!saw_r10) + fatal_error ("real kind=10 not available for -freal-8-real-10 option"); + gfc_default_double_kind = 10; + } + else if (gfc_option.flag_real8_kind == 16 ) + { + if (!saw_r16) + fatal_error ("real kind=10 not available for -freal-8-real-16 option"); + gfc_default_double_kind = 16; + } else if (saw_r4 && saw_r8) gfc_default_double_kind = 8; else Index: gcc/fortran/primary.c =================================================================== --- gcc/fortran/primary.c (revision 181224) +++ gcc/fortran/primary.c (working copy) @@ -224,6 +224,8 @@ if (kind == -1) return MATCH_ERROR; + if( kind == 4 && gfc_option.flag_integer4_kind == 8) kind = 8; + if (gfc_validate_kind (BT_INTEGER, kind, true) < 0) { gfc_error ("Integer kind %d at %C not available", kind); @@ -636,6 +638,14 @@ goto cleanup; } kind = gfc_default_double_kind; + + if (kind == 4 && gfc_option.flag_real4_kind == 8) kind = 8; + if (kind == 4 && gfc_option.flag_real4_kind == 10) kind = 10; + if (kind == 4 && gfc_option.flag_real4_kind == 16) kind = 16; + if (kind == 8 && gfc_option.flag_real8_kind == 4) kind = 4; + if (kind == 8 && gfc_option.flag_real8_kind == 10) kind = 10; + if (kind == 8 && gfc_option.flag_real8_kind == 16) kind = 16; + break; case 'q': @@ -666,6 +676,13 @@ if (kind == -2) kind = gfc_default_real_kind; + if (kind == 4 && gfc_option.flag_real4_kind == 8) kind = 8; + if (kind == 4 && gfc_option.flag_real4_kind == 10) kind = 10; + if (kind == 4 && gfc_option.flag_real4_kind == 16) kind = 16; + if (kind == 8 && gfc_option.flag_real8_kind == 4) kind = 4; + if (kind == 8 && gfc_option.flag_real8_kind == 10) kind = 10; + if (kind == 8 && gfc_option.flag_real8_kind == 16) kind = 16; + if (gfc_validate_kind (BT_REAL, kind, true) < 0) { gfc_error ("Invalid real kind %d at %C", kind); Index: gcc/fortran/options.c =================================================================== --- gcc/fortran/options.c (revision 181224) +++ gcc/fortran/options.c (working copy) @@ -116,6 +116,9 @@ gfc_option.flag_default_double = 0; gfc_option.flag_default_integer = 0; gfc_option.flag_default_real = 0; + gfc_option.flag_integer4_kind = 0; + gfc_option.flag_real4_kind = 0; + gfc_option.flag_real8_kind = 0; gfc_option.flag_dollar_ok = 0; gfc_option.flag_underscoring = 1; gfc_option.flag_whole_file = 1; @@ -849,6 +852,34 @@ gfc_option.flag_default_double = value; break; + case OPT_finteger_4_integer_8: + gfc_option.flag_integer4_kind = 8; + break; + + case OPT_freal_4_real_8: + gfc_option.flag_real4_kind = 8; + break; + + case OPT_freal_4_real_10: + gfc_option.flag_real4_kind = 10; + break; + + case OPT_freal_4_real_16: + gfc_option.flag_real4_kind = 16; + break; + + case OPT_freal_8_real_4: + gfc_option.flag_real8_kind = 4; + break; + + case OPT_freal_8_real_10: + gfc_option.flag_real8_kind = 10; + break; + + case OPT_freal_8_real_16: + gfc_option.flag_real8_kind = 16; + break; + case OPT_finit_local_zero: gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON; gfc_option.flag_init_integer_value = 0;