From patchwork Tue Nov 6 10:11:29 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 197439 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 6EFD62C00BD for ; Tue, 6 Nov 2012 21:11:50 +1100 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1352801511; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: Received:Received:Date:From:To:Cc:Subject:Message-ID: MIME-Version:Content-Type:Content-Disposition:User-Agent: Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:Sender:Delivered-To; bh=U+UCvmhbdAp/BrC1WtSe Q0J8/YU=; b=Bunr8xaYicfiQ2jYcHYdQXhaN2dQyAzWGgqB3YgsAzQx/PL0Dk8O Mxtj3yeYVC5bepLzlkW6DFKntteQXiv1bSsGp4/M2VK1d8zMm8lJNIWkfdRuv51N UnVvt9eHrYVh3eizZCwtybCSr06fDab6cPM0GnFl90EPFcmjtF/dDDo= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Received:Received:Date:From:To:Cc:Subject:Message-ID:MIME-Version:Content-Type:Content-Disposition:User-Agent:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=RbBx8cEj/+ikuAZqFsUSXVpgBWHKIqbdZGcBR0PFruTYRmng/gCqdL8uS22Ttp gM8hpuCghacXGcuQLWaYGXdvpVNQMuFyiIbINfGHL1OJGV4oS/2qGCfSLYJUhBPC s4cBjH+4MQtIGgFUq32k01N0FtUAp9nvmKzAfS0qZxT2A=; Received: (qmail 4805 invoked by alias); 6 Nov 2012 10:11:42 -0000 Received: (qmail 4796 invoked by uid 22791); 6 Nov 2012 10:11:41 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, RCVD_IN_HOSTKARMA_NO, TW_FP X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 06 Nov 2012 10:11:30 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 2CABF1C6FF3; Tue, 6 Nov 2012 05:11:29 -0500 (EST) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id v+xWBVzEg-Gc; Tue, 6 Nov 2012 05:11:29 -0500 (EST) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 082601C6F0F; Tue, 6 Nov 2012 05:11:29 -0500 (EST) Received: by kwai.gnat.com (Postfix, from userid 4192) id 048033FF09; Tue, 6 Nov 2012 05:11:29 -0500 (EST) Date: Tue, 6 Nov 2012 05:11:29 -0500 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Tristan Gingold Subject: [Ada] Directly emit binary representation of Vax float Message-ID: <20121106101128.GA16261@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) 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 Code generation for emitting a vax float is improved: instead of calling a runtime routine, the binary representation is directly emitted. No functionnal change (and also VMS specific). Tested on x86_64-pc-linux-gnu, committed on trunk 2012-11-06 Tristan Gingold * fe.h (Get_Vax_Real_Literal_As_Signed): Declare. * eval_fat.adb, eval_fat.ads (Decompose_Int): Move spec in package spec. * exp_vfpt.adb, exp_vfpt.ads (Vax_Real_Literal_As_Signed): New function. (Expand_Vax_Real_Literal): Remove. * exp_ch2.adb (Expand_N_Real_Literal): Do nothing. * sem_eval.adb (Expr_Value_R): Remove special Vax float case, as this is not anymore a special case. Index: fe.h =================================================================== --- fe.h (revision 193215) +++ fe.h (working copy) @@ -156,6 +156,11 @@ extern Boolean Is_Fully_Repped_Tagged_Type (Entity_Id); +/* exp_vfpt: */ + +#define Get_Vax_Real_Literal_As_Signed exp_vfpt__get_vax_real_literal_as_signed +extern Ureal Get_Vax_Real_Literal_As_Signed (Node_Id); + /* lib: */ #define Cunit lib__cunit Index: eval_fat.adb =================================================================== --- eval_fat.adb (revision 193222) +++ eval_fat.adb (working copy) @@ -57,20 +57,6 @@ -- parts. The fraction is in the interval 1.0 / Radix .. T'Pred (1.0) and -- uses Rbase = Radix. The result is rounded to a nearest machine number. - procedure Decompose_Int - (RT : R; - X : T; - Fraction : out UI; - Exponent : out UI; - Mode : Rounding_Mode); - -- This is similar to Decompose, except that the Fraction value returned - -- is an integer representing the value Fraction * Scale, where Scale is - -- the value (Machine_Radix_Value (RT) ** Machine_Mantissa_Value (RT)). The - -- value is obtained by using biased rounding (halfway cases round away - -- from zero), round to even, a floor operation or a ceiling operation - -- depending on the setting of Mode (see corresponding descriptions in - -- Urealp). - -------------- -- Adjacent -- -------------- Index: exp_vfpt.adb =================================================================== --- exp_vfpt.adb (revision 193223) +++ exp_vfpt.adb (working copy) @@ -32,8 +32,8 @@ with Sinfo; use Sinfo; with Stand; use Stand; with Tbuild; use Tbuild; -with Uintp; use Uintp; with Urealp; use Urealp; +with Eval_Fat; use Eval_Fat; package body Exp_VFpt is @@ -76,9 +76,13 @@ -- +--------------------------------+ -- | fraction | A + 4 -- +--------------------------------+ - -- | fraction | A + 6 + -- | fraction (low) | A + 6 -- +--------------------------------+ + -- Note that the fraction bits are not continuous in memory. Bytes in a + -- words are stored using little endianness, but words are stored using + -- big endianness (PDP endian) + -- Like Float F but with 55 bits for the fraction. -- Float G: @@ -93,10 +97,10 @@ -- +--------------------------------+ -- | fraction | A + 4 -- +--------------------------------+ - -- | fraction | A + 6 + -- | fraction (low) | A + 6 -- +--------------------------------+ - -- Exponent values of 1 through 2047 indicate trye binary exponents of + -- Exponent values of 1 through 2047 indicate true binary exponents of -- -1023 to +1023. -- Main differences compared to IEEE 754: @@ -553,94 +557,102 @@ Analyze_And_Resolve (N, Typ, Suppress => All_Checks); end Expand_Vax_Foreign_Return; - ----------------------------- - -- Expand_Vax_Real_Literal -- - ----------------------------- + -------------------------------- + -- Vax_Real_Literal_As_Signed -- + -------------------------------- - procedure Expand_Vax_Real_Literal (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Typ : constant Entity_Id := Etype (N); - Btyp : constant Entity_Id := Base_Type (Typ); - Stat : constant Boolean := Is_Static_Expression (N); - Nod : Node_Id; + function Get_Vax_Real_Literal_As_Signed (N : Node_Id) return Uint is + Btyp : constant Entity_Id := + Base_Type (Underlying_Type (Etype (N))); - RE_Source : RE_Id; - RE_Target : RE_Id; - RE_Fncall : RE_Id; - -- Entities for source, target and function call in conversion + Value : constant Ureal := Realval (N); + Negative : Boolean; + Fraction : UI; + Exponent : UI; + Res : UI; + Exponent_Size : Uint; + -- Number of bits for the exponent + + Fraction_Size : Uint; + -- Number of bits for the fraction + + Uintp_Mark : constant Uintp.Save_Mark := Mark; + -- Use the mark & release feature to delete temporaries begin - -- We do not know how to convert Vax format real literals, so what - -- we do is to convert these to be IEEE literals, and introduce the - -- necessary conversion operation. + -- Extract the sign now - if Vax_Float (Btyp) then - -- What we want to construct here is + Negative := UR_Is_Negative (Value); - -- x!(y_to_z (1.0E0)) + -- Decompose the number - -- where + Decompose_Int (Btyp, abs Value, Fraction, Exponent, Round_Even); - -- x is the base type of the literal (Btyp) + -- Number of bits for the fraction, leading fraction bit is implicit - -- y_to_z is + Fraction_Size := Machine_Mantissa_Value (Btyp) - Int'(1); - -- s_to_f for F_Float - -- t_to_g for G_Float - -- t_to_d for D_Float + -- Number of bits for the exponent (one bit for the sign) - -- The literal is typed as S (for F_Float) or T otherwise + Exponent_Size := RM_Size (Btyp) - Fraction_Size - Int'(1); - -- We do all our own construction, analysis, and expansion here, - -- since things are at too low a level to use Analyze or Expand - -- to get this built (we get circularities and other strange - -- problems if we try!) + if Fraction = Uint_0 then + -- Handle zero - if Digits_Value (Btyp) = VAXFF_Digits then - RE_Source := RE_S; - RE_Target := RE_F; - RE_Fncall := RE_S_To_F; + Res := Uint_0; - elsif Digits_Value (Btyp) = VAXDF_Digits then - RE_Source := RE_T; - RE_Target := RE_D; - RE_Fncall := RE_T_To_D; + elsif Exponent <= -(Uint_2 ** (Exponent_Size - 1)) then + -- Underflow - else pragma Assert (Digits_Value (Btyp) = VAXGF_Digits); - RE_Source := RE_T; - RE_Target := RE_G; - RE_Fncall := RE_T_To_G; - end if; + Res := Uint_0; + else + -- Check for overflow - Nod := Relocate_Node (N); + pragma Assert (Exponent < Uint_2 ** (Exponent_Size - 1)); - Set_Etype (Nod, RTE (RE_Source)); - Set_Analyzed (Nod, True); + -- MSB of the fraction must be 1 - Nod := - Make_Function_Call (Loc, - Name => New_Occurrence_Of (RTE (RE_Fncall), Loc), - Parameter_Associations => New_List (Nod)); + pragma Assert (Fraction / Uint_2 ** Fraction_Size = Uint_1); - Set_Etype (Nod, RTE (RE_Target)); - Set_Analyzed (Nod, True); + -- Remove the redudant most significant fraction bit - Nod := - Make_Unchecked_Type_Conversion (Loc, - Subtype_Mark => New_Occurrence_Of (Typ, Loc), - Expression => Nod); + Fraction := Fraction - Uint_2 ** Fraction_Size; - Set_Etype (Nod, Typ); - Set_Analyzed (Nod, True); - Rewrite (N, Nod); + -- Build the fraction part. Note that this field is in mixed + -- endianness: words are stored using little endianness, while bytes + -- in words are stored using big endianness. - -- This odd expression is still a static expression. Note that - -- the routine Sem_Eval.Expr_Value_R understands this. + Res := Uint_0; + for I in 1 .. UI_To_Int (RM_Size (Btyp)) / 16 loop + Res := (Res * (Uint_2 ** 16)) + (Fraction mod (Uint_2 ** 16)); + Fraction := Fraction / (Uint_2 ** 16); + end loop; - Set_Is_Static_Expression (N, Stat); + -- The sign bit + + if Negative then + Res := Res + Int (2**15); + end if; + + -- The exponent + + Res := Res + (Exponent + Uint_2 ** (Exponent_Size - 1)) + * Uint_2 ** (15 - Exponent_Size); + + -- Until now, we have created an unsigned number, but an underlying + -- type is a signed type. Convert to a signed number to avoid + -- overflow in gigi. + + if Res >= Uint_2 ** (Exponent_Size + Fraction_Size) then + Res := Res - Uint_2 ** (Exponent_Size + Fraction_Size + 1); + end if; end if; - end Expand_Vax_Real_Literal; + Release_And_Save (Uintp_Mark, Res); + + return Res; + end Get_Vax_Real_Literal_As_Signed; + ---------------------- -- Expand_Vax_Valid -- ---------------------- Index: eval_fat.ads =================================================================== --- eval_fat.ads (revision 193215) +++ eval_fat.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -99,4 +99,18 @@ Mode : Rounding_Mode; Enode : Node_Id) return T; + procedure Decompose_Int + (RT : R; + X : T; + Fraction : out UI; + Exponent : out UI; + Mode : Rounding_Mode); + -- Decomposes a floating-point number into fraction and exponent parts. + -- The Fraction value returned is an integer representing the value + -- Fraction * Scale, where Scale is the value (Machine_Radix_Value (RT) ** + -- Machine_Mantissa_Value (RT)). The value is obtained by using biased + -- rounding (halfway cases round away from zero), round to even, a floor + -- operation or a ceiling operation depending on the setting of Mode (see + -- corresponding descriptions in Urealp). + end Eval_Fat; Index: exp_vfpt.ads =================================================================== --- exp_vfpt.ads (revision 193215) +++ exp_vfpt.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -28,6 +28,7 @@ -- point formats as used on the Vax and the Alpha and the ia64. with Types; use Types; +with Uintp; use Uintp; package Exp_VFpt is @@ -51,10 +52,12 @@ -- that moves the return value to an integer location on Alpha/VMS, -- noop everywhere else. - procedure Expand_Vax_Real_Literal (N : Node_Id); - -- The node N is a real literal node where the type is a Vax floating-point - -- type. This procedure rewrites the node to eliminate the occurrence of - -- such constants. + function Get_Vax_Real_Literal_As_Signed (N : Node_Id) return Uint; + -- Get the Vax binary representation of a real literal whose type is a Vax + -- floating-point type. This is used by gigi. Previously we expanded + -- real literal to a call to a LIB$OTS routine that performed the + -- conversion. This worked well, but was not efficient and generated huge + -- functions for aggregate initialization. procedure Expand_Vax_Valid (N : Node_Id); -- The node N is an attribute reference node for the Valid attribute where Index: exp_ch2.adb =================================================================== --- exp_ch2.adb (revision 193215) +++ exp_ch2.adb (working copy) @@ -32,7 +32,6 @@ with Exp_Smem; use Exp_Smem; with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; -with Exp_VFpt; use Exp_VFpt; with Namet; use Namet; with Nmake; use Nmake; with Opt; use Opt; @@ -637,9 +636,8 @@ procedure Expand_N_Real_Literal (N : Node_Id) is begin - if Vax_Float (Etype (N)) then - Expand_Vax_Real_Literal (N); - end if; + -- Vax real literal are now allowed by gigi + null; end Expand_N_Real_Literal; -------------------------------- Index: sem_eval.adb =================================================================== --- sem_eval.adb (revision 193216) +++ sem_eval.adb (working copy) @@ -3862,7 +3862,6 @@ function Expr_Value_R (N : Node_Id) return Ureal is Kind : constant Node_Kind := Nkind (N); Ent : Entity_Id; - Expr : Node_Id; begin if Kind = N_Real_Literal then @@ -3876,25 +3875,6 @@ elsif Kind = N_Integer_Literal then return UR_From_Uint (Expr_Value (N)); - -- Strange case of VAX literals, which are at this stage transformed - -- into Vax_Type!x_To_y(IEEE_Literal). See Expand_N_Real_Literal in - -- Exp_Vfpt for further details. - - elsif Vax_Float (Etype (N)) - and then Nkind (N) = N_Unchecked_Type_Conversion - then - Expr := Expression (N); - - if Nkind (Expr) = N_Function_Call - and then Present (Parameter_Associations (Expr)) - then - Expr := First (Parameter_Associations (Expr)); - - if Nkind (Expr) = N_Real_Literal then - return Realval (Expr); - end if; - end if; - -- Peculiar VMS case, if we have xxx'Null_Parameter, return 0.0 elsif Kind = N_Attribute_Reference