From patchwork Sat Mar 14 14:24:59 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Jerry DeLisle X-Patchwork-Id: 450204 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]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 1A82814007D for ; Sun, 15 Mar 2015 01:25:14 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass reason="1024-bit key; unprotected key" header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=FfDaQFRN; dkim-adsp=none (unprotected policy); dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:cc:subject:references :in-reply-to:content-type; q=dns; s=default; b=HICrSLMlwuddPcSWd 789o0tjeY+0Dwau2yi3FGu/gUJbJxHTAlPKM/mqk+kJa5px686V8a98TgHUEeP/i ZMe37sBtnVHUDnpYu4UUzqMmq1/mRo1EXQc/FLunsnH1bcmUZ/xtEvalLBOxW5MZ mtCkDxGYoH9x9+EKnPyh4+2O/o= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:cc:subject:references :in-reply-to:content-type; s=default; bh=n6ljiCWHAjjPKjkx1VfrRWn AvwM=; b=FfDaQFRNyx6V8TwxsYCRP4UfBkdQMrxjhkmEFf7LOiWB7Bsz/UuvHpN K++9YdD3FyB5NwE/6mD2zLZ+kUo3ama5aOtYdD1Mx/AUzfSzYQ8eRfrqEjzygbR0 xM9SU2Lr0ZWeaB2663OMRzQLJc2R2MKlk32sn1cZ986yqb1aP9T4= Received: (qmail 59782 invoked by alias); 14 Mar 2015 14:25:06 -0000 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 Received: (qmail 59242 invoked by uid 89); 14 Mar 2015 14:25:05 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-2.4 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, RP_MATCHES_RCVD, SPF_PASS autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mta31.charter.net Received: from mta31.charter.net (HELO mta31.charter.net) (216.33.127.82) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sat, 14 Mar 2015 14:25:03 +0000 Received: from imp11 ([10.20.200.11]) by mta31.charter.net (InterMail vM.8.01.05.02 201-2260-151-103-20110920) with ESMTP id <20150314142502.MZP10321.mta31.charter.net@imp11>; Sat, 14 Mar 2015 10:25:02 -0400 Received: from mtaout006.msg.strl.va.charter.net ([68.114.190.31]) by imp11 with smtp.charter.net id 3SR21q0010h5dSU05SR2my; Sat, 14 Mar 2015 10:25:02 -0400 Received: from impout004 ([68.114.189.19]) by mtaout006.msg.strl.va.charter.net (InterMail vM.9.00.015.01 201-2473-143-101) with ESMTP id <20150314142502.ZDAD1734.mtaout006.msg.strl.va.charter.net@impout004>; Sat, 14 Mar 2015 09:25:02 -0500 Received: from pavi.localdomain ([70.209.219.218]) by impout004 with charter.net id 3SR01q00N4jKFHS01SR19K; Sat, 14 Mar 2015 09:25:02 -0500 X-Authority-Analysis: v=2.1 cv=X/ncKQje c=1 sm=1 tr=0 a=5HZUQja+e7iVwhoKGZnbSA==:117 a=5HZUQja+e7iVwhoKGZnbSA==:17 a=hOpmn2quAAAA:8 a=XuYyiiJQKFMA:10 a=r77TgQKjGQsHNAKrUKIA:9 a=9iDbn-4jx3cA:10 a=cKsnjEOsciEA:10 a=gZbpxnkM3yUA:10 a=mDV3o1hIAAAA:8 a=f3ECXKI7tfInV35H5o4A:9 a=pILNOxqGKmIA:10 a=KCoLsI5rQWJg2YVEt2MA:9 X-Auth-id: anZkZWxpc2xlQGNoYXJ0ZXIubmV0 Message-ID: <550444BB.5070502@charter.net> Date: Sat, 14 Mar 2015 07:24:59 -0700 From: Jerry DeLisle User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:31.0) Gecko/20100101 Thunderbird/31.5.0 MIME-Version: 1.0 To: gfortran CC: Steve Kargl , Janne Blomqvist , gcc patches Subject: Re: [patch, fortran] Bug 64432 - [5 Regression] SYSTEM_CLOCK(COUNT_RATE=rate) wrong result for integer(4)::rate References: <54FBD37D.1070208@charter.net> <20150308235825.GA21673@troutmask.apl.washington.edu> <55044415.6090206@charter.net> In-Reply-To: <55044415.6090206@charter.net> Attachment on this one. On 03/14/2015 07:22 AM, Jerry DeLisle wrote: > On 03/08/2015 04:58 PM, Steve Kargl wrote: >> On Mon, Mar 09, 2015 at 01:07:25AM +0200, Janne Blomqvist wrote: >>> So I would prefer if we just hardcode the error values in the frontend >>> (-HUGE, 0, 0), in case somebody tries to use the kind=1,2 versions, >>> thus also removing the need for the new library functions, keeping the >>> existing simpler ones instead. AFAICT this would be standards >>> conforming. Any other opinions on this? >>> > > Revised patch attached as requested. Regression tested on x86_64 linux. Typical > results are shown below. I will provide a test case for the test-suite. > > $ ./a.out > KIND=1: -127 0 0 > KIND=1: -127 0 0 > KIND=1: -127 .00000000 0 > ----------------------------------------------------------- > KIND=2: -32767 0 0 > KIND=2: -32767 .00000000 0 > ----------------------------------------------------------- > KIND=4: 57496123 1000 2147483647 > KIND=4: 57496123 1000.00000 2147483647 > ----------------------------------------------------------- > KIND=8: 57496123484138 1000000000 9223372036854775807 > KIND=8: 57496123522116 1000000000.0000000 9223372036854775807 > ----------------------------------------------------------- > KIND=10: 57496123575504 1000000000 9223372036854775807 > KIND=10: 57496123612377 1000000000.00000000000 9223372036854775807 > ----------------------------------------------------------- > KIND=16: 57496123669210 1000000000 9223372036854775807 > KIND=16: 57496123698413 1000000000.00000000000000000000000000 9223372036854775807 > > > OK for trunk? > > Regards, > > Jerry > > 2015-03-14 Jerry DeLisle > > PR fortran/64432 > *trans-intrinisic.c (conv_intrinsic_system_clock): Check the > smallest kind passed in user arguments and hard-code results for > KIND=1 or KIND=2 to indicate no clock available. > > 2015-03-14 Jerry DeLisle > > PR libgfortran/64432 > * intrinsics/system_clock.c (system_clock4, system_clock8): > Cleanup some whitespace. Index: gcc/fortran/trans-intrinsic.c =================================================================== --- gcc/fortran/trans-intrinsic.c (revision 221405) +++ gcc/fortran/trans-intrinsic.c (working copy) @@ -2671,22 +2671,13 @@ conv_intrinsic_system_clock (gfc_code *code) stmtblock_t block; gfc_se count_se, count_rate_se, count_max_se; tree arg1 = NULL_TREE, arg2 = NULL_TREE, arg3 = NULL_TREE; - tree type, tmp; - int kind; + tree tmp; + int least; gfc_expr *count = code->ext.actual->expr; gfc_expr *count_rate = code->ext.actual->next->expr; gfc_expr *count_max = code->ext.actual->next->next->expr; - /* The INTEGER(8) version has higher precision, it is used if both COUNT - and COUNT_MAX can hold 64-bit values, or are absent. */ - if ((!count || count->ts.kind >= 8) - && (!count_max || count_max->ts.kind >= 8)) - kind = 8; - else - kind = gfc_default_integer_kind; - type = gfc_get_int_type (kind); - /* Evaluate our arguments. */ if (count) { @@ -2706,37 +2697,104 @@ conv_intrinsic_system_clock (gfc_code *code) gfc_conv_expr (&count_max_se, count_max); } - /* Prepare temporary variables if we need them. */ - if (count && count->ts.kind != kind) - arg1 = gfc_create_var (type, "count"); - else if (count) - arg1 = count_se.expr; + /* Find the smallest kind found of the arguments. */ + least = 16; + least = (count && count->ts.kind < least) ? count->ts.kind : least; + least = (count_rate && count_rate->ts.kind < least) ? count_rate->ts.kind + : least; + least = (count_max && count_max->ts.kind < least) ? count_max->ts.kind + : least; - if (count_rate && (count_rate->ts.kind != kind - || count_rate->ts.type != BT_INTEGER)) - arg2 = gfc_create_var (type, "count_rate"); - else if (count_rate) - arg2 = count_rate_se.expr; + /* Prepare temporary variables. */ - if (count_max && count_max->ts.kind != kind) - arg3 = gfc_create_var (type, "count_max"); - else if (count_max) - arg3 = count_max_se.expr; + if (count) + { + if (least >= 8) + arg1 = gfc_create_var (gfc_get_int_type (8), "count"); + else if (least == 4) + arg1 = gfc_create_var (gfc_get_int_type (4), "count"); + else if (count->ts.kind == 1) + arg1 = gfc_conv_mpz_to_tree (gfc_integer_kinds[0].pedantic_min_int, + count->ts.kind); + else + arg1 = gfc_conv_mpz_to_tree (gfc_integer_kinds[1].pedantic_min_int, + count->ts.kind); + } + if (count_rate) + { + if (least >= 8) + arg2 = gfc_create_var (gfc_get_int_type (8), "count_rate"); + else if (least == 4) + arg2 = gfc_create_var (gfc_get_int_type (4), "count_rate"); + else + arg2 = integer_zero_node; + } + + if (count_max) + { + if (least >= 8) + arg3 = gfc_create_var (gfc_get_int_type (8), "count_max"); + else if (least == 4) + arg3 = gfc_create_var (gfc_get_int_type (4), "count_max"); + else + arg3 = integer_zero_node; + } + /* Make the function call. */ gfc_init_block (&block); - tmp = build_call_expr_loc (input_location, - kind == 4 ? gfor_fndecl_system_clock4 - : gfor_fndecl_system_clock8, - 3, - arg1 ? gfc_build_addr_expr (NULL_TREE, arg1) - : null_pointer_node, - arg2 ? gfc_build_addr_expr (NULL_TREE, arg2) - : null_pointer_node, - arg3 ? gfc_build_addr_expr (NULL_TREE, arg3) - : null_pointer_node); - gfc_add_expr_to_block (&block, tmp); +if (least <= 2) + { + if (least == 1) + { + arg1 ? gfc_build_addr_expr (NULL_TREE, arg1) + : null_pointer_node; + arg2 ? gfc_build_addr_expr (NULL_TREE, arg2) + : null_pointer_node; + arg3 ? gfc_build_addr_expr (NULL_TREE, arg3) + : null_pointer_node; + } + + if (least == 2) + { + arg1 ? gfc_build_addr_expr (NULL_TREE, arg1) + : null_pointer_node; + arg2 ? gfc_build_addr_expr (NULL_TREE, arg2) + : null_pointer_node; + arg3 ? gfc_build_addr_expr (NULL_TREE, arg3) + : null_pointer_node; + } + } +else + { + if (least == 4) + { + tmp = build_call_expr_loc (input_location, + gfor_fndecl_system_clock4, 3, + arg1 ? gfc_build_addr_expr (NULL_TREE, arg1) + : null_pointer_node, + arg2 ? gfc_build_addr_expr (NULL_TREE, arg2) + : null_pointer_node, + arg3 ? gfc_build_addr_expr (NULL_TREE, arg3) + : null_pointer_node); + gfc_add_expr_to_block (&block, tmp); + } + /* Handle kind>=8, 10, or 16 arguments */ + if (least >= 8) + { + tmp = build_call_expr_loc (input_location, + gfor_fndecl_system_clock8, 3, + arg1 ? gfc_build_addr_expr (NULL_TREE, arg1) + : null_pointer_node, + arg2 ? gfc_build_addr_expr (NULL_TREE, arg2) + : null_pointer_node, + arg3 ? gfc_build_addr_expr (NULL_TREE, arg3) + : null_pointer_node); + gfc_add_expr_to_block (&block, tmp); + } + } + /* And store values back if needed. */ if (arg1 && arg1 != count_se.expr) gfc_add_modify (&block, count_se.expr, Index: libgfortran/intrinsics/system_clock.c =================================================================== --- libgfortran/intrinsics/system_clock.c (revision 221405) +++ libgfortran/intrinsics/system_clock.c (working copy) @@ -109,10 +109,14 @@ gf_gettime_mono (time_t * secs, long * fracsecs, l #endif /* !__MINGW32 && !__CYGWIN__ */ -extern void system_clock_4 (GFC_INTEGER_4 *, GFC_INTEGER_4 *, GFC_INTEGER_4 *); +extern void +system_clock_4 (GFC_INTEGER_4 *count, GFC_INTEGER_4 *count_rate, + GFC_INTEGER_4 *count_max); export_proto(system_clock_4); -extern void system_clock_8 (GFC_INTEGER_8 *, GFC_INTEGER_8 *, GFC_INTEGER_8 *); +extern void +system_clock_8 (GFC_INTEGER_8 *count, GFC_INTEGER_8 *count_rate, + GFC_INTEGER_8 *count_max); export_proto(system_clock_8); @@ -122,10 +126,10 @@ export_proto(system_clock_8); for COUNT. */ void -system_clock_4(GFC_INTEGER_4 *count, GFC_INTEGER_4 *count_rate, +system_clock_4 (GFC_INTEGER_4 *count, GFC_INTEGER_4 *count_rate, GFC_INTEGER_4 *count_max) { -#if defined(__MINGW32__) || defined(__CYGWIN__) +#if defined(__MINGW32__) || defined(__CYGWIN__) if (count) { /* Use GetTickCount here as the resolution and range is @@ -176,7 +180,7 @@ void void system_clock_8 (GFC_INTEGER_8 *count, GFC_INTEGER_8 *count_rate, - GFC_INTEGER_8 *count_max) + GFC_INTEGER_8 *count_max) { #if defined(__MINGW32__) || defined(__CYGWIN__) LARGE_INTEGER cnt;