diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2005-09-05 07:53:10 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2005-09-05 07:53:10 +0000 |
| commit | 6e62b6c3b01ad9adc92f4bbed7e97677b1fbcb07 (patch) | |
| tree | 3618aae5514f82a3f4fba73b73fe7fdd4c483062 /gcc/ada/exp_vfpt.adb | |
| parent | ad018b0cbec171fc39a144fb42471d2d99c64ffb (diff) | |
| download | gcc-6e62b6c3b01ad9adc92f4bbed7e97677b1fbcb07.tar.gz | |
2005-09-01 Robert Dewar <dewar@adacore.com>
Doug Rupp <rupp@adacore.com>
* exp_attr.adb: Handle vax fpt for 'Valid attribute
* exp_vfpt.ads, exp_vfpt.adb: (Expand_Vax_Valid): New procedure
* s-vaflop-vms-alpha.adb, s-vaflop.ads, s-vaflop.adb
(Valid_D, Valid_F, Valid_G): New functions
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@103860 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/exp_vfpt.adb')
| -rw-r--r-- | gcc/ada/exp_vfpt.adb | 38 |
1 files changed, 36 insertions, 2 deletions
diff --git a/gcc/ada/exp_vfpt.adb b/gcc/ada/exp_vfpt.adb index 8a4a9db3b75..98b2b075ce0 100644 --- a/gcc/ada/exp_vfpt.adb +++ b/gcc/ada/exp_vfpt.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1997-2002 Free Software Foundation, Inc. -- +-- Copyright (C) 1997-2005 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- -- @@ -353,7 +353,7 @@ package body Exp_VFpt is Make_Real_Literal (Loc, Realval => Ureal_1 / Small_Value (T_Typ)))))); - -- All other cases. + -- All other cases else -- Compute types for call @@ -499,4 +499,38 @@ package body Exp_VFpt is end if; end Expand_Vax_Real_Literal; + ---------------------- + -- Expand_Vax_Valid -- + ---------------------- + + procedure Expand_Vax_Valid (N : Node_Id) is + Loc : constant Source_Ptr := Sloc (N); + Pref : constant Node_Id := Prefix (N); + Ptyp : constant Entity_Id := Root_Type (Etype (Pref)); + Rtyp : constant Entity_Id := Etype (N); + Vtyp : RE_Id; + Func : RE_Id; + + begin + if Digits_Value (Ptyp) = VAXFF_Digits then + Func := RE_Valid_F; + Vtyp := RE_F; + elsif Digits_Value (Ptyp) = VAXDF_Digits then + Func := RE_Valid_D; + Vtyp := RE_D; + else pragma Assert (Digits_Value (Ptyp) = VAXGF_Digits); + Func := RE_Valid_G; + Vtyp := RE_G; + end if; + + Rewrite (N, + Convert_To (Rtyp, + Make_Function_Call (Loc, + Name => New_Occurrence_Of (RTE (Func), Loc), + Parameter_Associations => New_List ( + Convert_To (RTE (Vtyp), Pref))))); + + Analyze_And_Resolve (N); + end Expand_Vax_Valid; + end Exp_VFpt; |