s-pooglo$(objext) \
s-pooloc$(objext) \
s-poosiz$(objext) \
- s-powtab$(objext) \
+ s-powflt$(objext) \
+ s-powlfl$(objext) \
+ s-powllf$(objext) \
s-purexc$(objext) \
s-putima$(objext) \
s-rannum$(objext) \
-- xx = [Long_Long_[Long_]]Unsigned
-- For floating-point types
- -- xx = Real
+ -- xx = [Long_[Long_]]Float
-- For decimal fixed-point types, typ'Value (X) expands into
then
Vid := RE_Value_Fixed128;
else
- Vid := RE_Value_Long_Long_Float;
+ Vid := RE_Value_Long_Float;
end if;
- if Vid /= RE_Value_Long_Long_Float then
+ if Vid /= RE_Value_Long_Float then
Append_To (Args,
Make_Integer_Literal (Loc, -Norm_Num (Small_Value (Rtyp))));
end;
elsif Is_Floating_Point_Type (Rtyp) then
+ -- Short_Float and Float are the same type for GNAT
+
if Rtyp = Standard_Short_Float or else Rtyp = Standard_Float then
Vid := RE_Value_Float;
- elsif Rtyp = Standard_Long_Float then
+ -- If Long_Float and Long_Long_Float are the same type, then use the
+ -- implementation of the former, which is faster and more accurate.
+
+ elsif Rtyp = Standard_Long_Float
+ or else (Rtyp = Standard_Long_Long_Float
+ and then
+ Standard_Long_Long_Float_Size = Standard_Long_Float_Size)
+ then
Vid := RE_Value_Long_Float;
elsif Rtyp = Standard_Long_Long_Float then
-- --
------------------------------------------------------------------------------
-with System.Img_LLU; use System.Img_LLU;
-with System.Img_Uns; use System.Img_Uns;
-with System.Powten_Table; use System.Powten_Table;
+with System.Img_LLU; use System.Img_LLU;
+with System.Img_Uns; use System.Img_Uns;
+with System.Powten_LLF; use System.Powten_LLF;
with System.Float_Control;
package body System.Img_Real is
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . P O W T E N _ F L T --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2020, 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package provides a powers of ten table used for real conversions
+
+package System.Powten_Flt is
+ pragma Pure;
+
+ Maxpow : constant := 38;
+ -- Largest power of ten representable with Float
+
+ Maxpow_Exact : constant := 10;
+ -- Largest power of ten exactly representable with Float. It is equal to
+ -- floor (M * log 2 / log 5), when M is the size of the mantissa (24).
+
+ Powten : constant array (0 .. Maxpow) of Float :=
+ (00 => 1.0E+00,
+ 01 => 1.0E+01,
+ 02 => 1.0E+02,
+ 03 => 1.0E+03,
+ 04 => 1.0E+04,
+ 05 => 1.0E+05,
+ 06 => 1.0E+06,
+ 07 => 1.0E+07,
+ 08 => 1.0E+08,
+ 09 => 1.0E+09,
+ 10 => 1.0E+10,
+ 11 => 1.0E+11,
+ 12 => 1.0E+12,
+ 13 => 1.0E+13,
+ 14 => 1.0E+14,
+ 15 => 1.0E+15,
+ 16 => 1.0E+16,
+ 17 => 1.0E+17,
+ 18 => 1.0E+18,
+ 19 => 1.0E+19,
+ 20 => 1.0E+20,
+ 21 => 1.0E+21,
+ 22 => 1.0E+22,
+ 23 => 1.0E+23,
+ 24 => 1.0E+24,
+ 25 => 1.0E+25,
+ 26 => 1.0E+26,
+ 27 => 1.0E+27,
+ 28 => 1.0E+28,
+ 29 => 1.0E+29,
+ 30 => 1.0E+30,
+ 31 => 1.0E+31,
+ 32 => 1.0E+32,
+ 33 => 1.0E+33,
+ 34 => 1.0E+34,
+ 35 => 1.0E+35,
+ 36 => 1.0E+36,
+ 37 => 1.0E+37,
+ 38 => 1.0E+38);
+
+end System.Powten_Flt;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . P O W T E N _ L F L T --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2020, 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package provides a powers of ten table used for real conversions
+
+package System.Powten_LFlt is
+ pragma Pure;
+
+ Maxpow : constant := 308;
+ -- Largest power of ten representable with Long_Float
+
+ Maxpow_Exact : constant := 22;
+ -- Largest power of ten exactly representable with Long_Float. It is equal
+ -- to floor (M * log 2 / log 5), when M is the size of the mantissa (53).
+
+ Powten : constant array (0 .. Maxpow) of Long_Float :=
+ (00 => 1.0E+00,
+ 01 => 1.0E+01,
+ 02 => 1.0E+02,
+ 03 => 1.0E+03,
+ 04 => 1.0E+04,
+ 05 => 1.0E+05,
+ 06 => 1.0E+06,
+ 07 => 1.0E+07,
+ 08 => 1.0E+08,
+ 09 => 1.0E+09,
+ 10 => 1.0E+10,
+ 11 => 1.0E+11,
+ 12 => 1.0E+12,
+ 13 => 1.0E+13,
+ 14 => 1.0E+14,
+ 15 => 1.0E+15,
+ 16 => 1.0E+16,
+ 17 => 1.0E+17,
+ 18 => 1.0E+18,
+ 19 => 1.0E+19,
+ 20 => 1.0E+20,
+ 21 => 1.0E+21,
+ 22 => 1.0E+22,
+ 23 => 1.0E+23,
+ 24 => 1.0E+24,
+ 25 => 1.0E+25,
+ 26 => 1.0E+26,
+ 27 => 1.0E+27,
+ 28 => 1.0E+28,
+ 29 => 1.0E+29,
+ 30 => 1.0E+30,
+ 31 => 1.0E+31,
+ 32 => 1.0E+32,
+ 33 => 1.0E+33,
+ 34 => 1.0E+34,
+ 35 => 1.0E+35,
+ 36 => 1.0E+36,
+ 37 => 1.0E+37,
+ 38 => 1.0E+38,
+ 39 => 1.0E+39,
+ 40 => 1.0E+40,
+ 41 => 1.0E+41,
+ 42 => 1.0E+42,
+ 43 => 1.0E+43,
+ 44 => 1.0E+44,
+ 45 => 1.0E+45,
+ 46 => 1.0E+46,
+ 47 => 1.0E+47,
+ 48 => 1.0E+48,
+ 49 => 1.0E+49,
+ 50 => 1.0E+50,
+ 51 => 1.0E+51,
+ 52 => 1.0E+52,
+ 53 => 1.0E+53,
+ 54 => 1.0E+54,
+ 55 => 1.0E+55,
+ 56 => 1.0E+56,
+ 57 => 1.0E+57,
+ 58 => 1.0E+58,
+ 59 => 1.0E+59,
+ 60 => 1.0E+60,
+ 61 => 1.0E+61,
+ 62 => 1.0E+62,
+ 63 => 1.0E+63,
+ 64 => 1.0E+64,
+ 65 => 1.0E+65,
+ 66 => 1.0E+66,
+ 67 => 1.0E+67,
+ 68 => 1.0E+68,
+ 69 => 1.0E+69,
+ 70 => 1.0E+70,
+ 71 => 1.0E+71,
+ 72 => 1.0E+72,
+ 73 => 1.0E+73,
+ 74 => 1.0E+74,
+ 75 => 1.0E+75,
+ 76 => 1.0E+76,
+ 77 => 1.0E+77,
+ 78 => 1.0E+78,
+ 79 => 1.0E+79,
+ 80 => 1.0E+80,
+ 81 => 1.0E+81,
+ 82 => 1.0E+82,
+ 83 => 1.0E+83,
+ 84 => 1.0E+84,
+ 85 => 1.0E+85,
+ 86 => 1.0E+86,
+ 87 => 1.0E+87,
+ 88 => 1.0E+88,
+ 89 => 1.0E+89,
+ 90 => 1.0E+90,
+ 91 => 1.0E+91,
+ 92 => 1.0E+92,
+ 93 => 1.0E+93,
+ 94 => 1.0E+94,
+ 95 => 1.0E+95,
+ 96 => 1.0E+96,
+ 97 => 1.0E+97,
+ 98 => 1.0E+98,
+ 99 => 1.0E+99,
+ 100 => 1.0E+100,
+ 101 => 1.0E+101,
+ 102 => 1.0E+102,
+ 103 => 1.0E+103,
+ 104 => 1.0E+104,
+ 105 => 1.0E+105,
+ 106 => 1.0E+106,
+ 107 => 1.0E+107,
+ 108 => 1.0E+108,
+ 109 => 1.0E+109,
+ 110 => 1.0E+110,
+ 111 => 1.0E+111,
+ 112 => 1.0E+112,
+ 113 => 1.0E+113,
+ 114 => 1.0E+114,
+ 115 => 1.0E+115,
+ 116 => 1.0E+116,
+ 117 => 1.0E+117,
+ 118 => 1.0E+118,
+ 119 => 1.0E+119,
+ 120 => 1.0E+120,
+ 121 => 1.0E+121,
+ 122 => 1.0E+122,
+ 123 => 1.0E+123,
+ 124 => 1.0E+124,
+ 125 => 1.0E+125,
+ 126 => 1.0E+126,
+ 127 => 1.0E+127,
+ 128 => 1.0E+128,
+ 129 => 1.0E+129,
+ 130 => 1.0E+130,
+ 131 => 1.0E+131,
+ 132 => 1.0E+132,
+ 133 => 1.0E+133,
+ 134 => 1.0E+134,
+ 135 => 1.0E+135,
+ 136 => 1.0E+136,
+ 137 => 1.0E+137,
+ 138 => 1.0E+138,
+ 139 => 1.0E+139,
+ 140 => 1.0E+140,
+ 141 => 1.0E+141,
+ 142 => 1.0E+142,
+ 143 => 1.0E+143,
+ 144 => 1.0E+144,
+ 145 => 1.0E+145,
+ 146 => 1.0E+146,
+ 147 => 1.0E+147,
+ 148 => 1.0E+148,
+ 149 => 1.0E+149,
+ 150 => 1.0E+150,
+ 151 => 1.0E+151,
+ 152 => 1.0E+152,
+ 153 => 1.0E+153,
+ 154 => 1.0E+154,
+ 155 => 1.0E+155,
+ 156 => 1.0E+156,
+ 157 => 1.0E+157,
+ 158 => 1.0E+158,
+ 159 => 1.0E+159,
+ 160 => 1.0E+160,
+ 161 => 1.0E+161,
+ 162 => 1.0E+162,
+ 163 => 1.0E+163,
+ 164 => 1.0E+164,
+ 165 => 1.0E+165,
+ 166 => 1.0E+166,
+ 167 => 1.0E+167,
+ 168 => 1.0E+168,
+ 169 => 1.0E+169,
+ 170 => 1.0E+170,
+ 171 => 1.0E+171,
+ 172 => 1.0E+172,
+ 173 => 1.0E+173,
+ 174 => 1.0E+174,
+ 175 => 1.0E+175,
+ 176 => 1.0E+176,
+ 177 => 1.0E+177,
+ 178 => 1.0E+178,
+ 179 => 1.0E+179,
+ 180 => 1.0E+180,
+ 181 => 1.0E+181,
+ 182 => 1.0E+182,
+ 183 => 1.0E+183,
+ 184 => 1.0E+184,
+ 185 => 1.0E+185,
+ 186 => 1.0E+186,
+ 187 => 1.0E+187,
+ 188 => 1.0E+188,
+ 189 => 1.0E+189,
+ 190 => 1.0E+190,
+ 191 => 1.0E+191,
+ 192 => 1.0E+192,
+ 193 => 1.0E+193,
+ 194 => 1.0E+194,
+ 195 => 1.0E+195,
+ 196 => 1.0E+196,
+ 197 => 1.0E+197,
+ 198 => 1.0E+198,
+ 199 => 1.0E+199,
+ 200 => 1.0E+200,
+ 201 => 1.0E+201,
+ 202 => 1.0E+202,
+ 203 => 1.0E+203,
+ 204 => 1.0E+204,
+ 205 => 1.0E+205,
+ 206 => 1.0E+206,
+ 207 => 1.0E+207,
+ 208 => 1.0E+208,
+ 209 => 1.0E+209,
+ 210 => 1.0E+210,
+ 211 => 1.0E+211,
+ 212 => 1.0E+212,
+ 213 => 1.0E+213,
+ 214 => 1.0E+214,
+ 215 => 1.0E+215,
+ 216 => 1.0E+216,
+ 217 => 1.0E+217,
+ 218 => 1.0E+218,
+ 219 => 1.0E+219,
+ 220 => 1.0E+220,
+ 221 => 1.0E+221,
+ 222 => 1.0E+222,
+ 223 => 1.0E+223,
+ 224 => 1.0E+224,
+ 225 => 1.0E+225,
+ 226 => 1.0E+226,
+ 227 => 1.0E+227,
+ 228 => 1.0E+228,
+ 229 => 1.0E+229,
+ 230 => 1.0E+230,
+ 231 => 1.0E+231,
+ 232 => 1.0E+232,
+ 233 => 1.0E+233,
+ 234 => 1.0E+234,
+ 235 => 1.0E+235,
+ 236 => 1.0E+236,
+ 237 => 1.0E+237,
+ 238 => 1.0E+238,
+ 239 => 1.0E+239,
+ 240 => 1.0E+240,
+ 241 => 1.0E+241,
+ 242 => 1.0E+242,
+ 243 => 1.0E+243,
+ 244 => 1.0E+244,
+ 245 => 1.0E+245,
+ 246 => 1.0E+246,
+ 247 => 1.0E+247,
+ 248 => 1.0E+248,
+ 249 => 1.0E+249,
+ 250 => 1.0E+250,
+ 251 => 1.0E+251,
+ 252 => 1.0E+252,
+ 253 => 1.0E+253,
+ 254 => 1.0E+254,
+ 255 => 1.0E+255,
+ 256 => 1.0E+256,
+ 257 => 1.0E+257,
+ 258 => 1.0E+258,
+ 259 => 1.0E+259,
+ 260 => 1.0E+260,
+ 261 => 1.0E+261,
+ 262 => 1.0E+262,
+ 263 => 1.0E+263,
+ 264 => 1.0E+264,
+ 265 => 1.0E+265,
+ 266 => 1.0E+266,
+ 267 => 1.0E+267,
+ 268 => 1.0E+268,
+ 269 => 1.0E+269,
+ 270 => 1.0E+270,
+ 271 => 1.0E+271,
+ 272 => 1.0E+272,
+ 273 => 1.0E+273,
+ 274 => 1.0E+274,
+ 275 => 1.0E+275,
+ 276 => 1.0E+276,
+ 277 => 1.0E+277,
+ 278 => 1.0E+278,
+ 279 => 1.0E+279,
+ 280 => 1.0E+280,
+ 281 => 1.0E+281,
+ 282 => 1.0E+282,
+ 283 => 1.0E+283,
+ 284 => 1.0E+284,
+ 285 => 1.0E+285,
+ 286 => 1.0E+286,
+ 287 => 1.0E+287,
+ 288 => 1.0E+288,
+ 289 => 1.0E+289,
+ 290 => 1.0E+290,
+ 291 => 1.0E+291,
+ 292 => 1.0E+292,
+ 293 => 1.0E+293,
+ 294 => 1.0E+294,
+ 295 => 1.0E+295,
+ 296 => 1.0E+296,
+ 297 => 1.0E+297,
+ 298 => 1.0E+298,
+ 299 => 1.0E+299,
+ 300 => 1.0E+300,
+ 301 => 1.0E+301,
+ 302 => 1.0E+302,
+ 303 => 1.0E+303,
+ 304 => 1.0E+304,
+ 305 => 1.0E+305,
+ 306 => 1.0E+306,
+ 307 => 1.0E+307,
+ 308 => 1.0E+308);
+
+end System.Powten_LFlt;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . P O W T E N _ L L F --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2020, 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package provides a powers of ten table used for real conversions
+
+package System.Powten_LLF is
+ pragma Pure;
+
+ Maxpow : constant := 22;
+ -- The number of entries in this table is chosen to include powers of ten
+ -- that are exactly representable with Long_Long_Float. Assuming that on
+ -- all targets we have 53 bits of mantissa for the type, the upper bound
+ -- is given by 53 * log 2 / log 5. If the scaling factor is greater than
+ -- Maxpow, it can be obtained by several multiplications, which is less
+ -- efficient than with a bigger table, but avoids anomalies at end points.
+
+ Powten : constant array (0 .. Maxpow) of Long_Long_Float :=
+ (00 => 1.0E+00,
+ 01 => 1.0E+01,
+ 02 => 1.0E+02,
+ 03 => 1.0E+03,
+ 04 => 1.0E+04,
+ 05 => 1.0E+05,
+ 06 => 1.0E+06,
+ 07 => 1.0E+07,
+ 08 => 1.0E+08,
+ 09 => 1.0E+09,
+ 10 => 1.0E+10,
+ 11 => 1.0E+11,
+ 12 => 1.0E+12,
+ 13 => 1.0E+13,
+ 14 => 1.0E+14,
+ 15 => 1.0E+15,
+ 16 => 1.0E+16,
+ 17 => 1.0E+17,
+ 18 => 1.0E+18,
+ 19 => 1.0E+19,
+ 20 => 1.0E+20,
+ 21 => 1.0E+21,
+ 22 => 1.0E+22);
+
+end System.Powten_LLF;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- S Y S T E M . P O W T E N _ T A B L E --
--- --
--- S p e c --
--- --
--- Copyright (C) 1992-2020, 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- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
--- This package provides a powers of ten table used for real conversions
-
-package System.Powten_Table is
- pragma Pure;
-
- Maxpow : constant := 22;
- -- The number of entries in this table is chosen to include powers of ten
- -- that are exactly representable with Long_Long_Float. Assuming that on
- -- all targets we have 53 bits of mantissa for the type, the upper bound
- -- is given by 53 * log 2 / log 5. If the scaling factor is greater than
- -- Maxpow, it can be obtained by several multiplications, which is less
- -- efficient than with a bigger table, but avoids anomalies at end points.
-
- Powten : constant array (0 .. Maxpow) of Long_Long_Float :=
- (00 => 1.0E+00,
- 01 => 1.0E+01,
- 02 => 1.0E+02,
- 03 => 1.0E+03,
- 04 => 1.0E+04,
- 05 => 1.0E+05,
- 06 => 1.0E+06,
- 07 => 1.0E+07,
- 08 => 1.0E+08,
- 09 => 1.0E+09,
- 10 => 1.0E+10,
- 11 => 1.0E+11,
- 12 => 1.0E+12,
- 13 => 1.0E+13,
- 14 => 1.0E+14,
- 15 => 1.0E+15,
- 16 => 1.0E+16,
- 17 => 1.0E+17,
- 18 => 1.0E+18,
- 19 => 1.0E+19,
- 20 => 1.0E+20,
- 21 => 1.0E+21,
- 22 => 1.0E+22);
-
-end System.Powten_Table;
-- type Float, for use in Text_IO.Float_IO and the Value attribute.
with Interfaces;
+with System.Powten_Flt;
with System.Val_Real;
package System.Val_Flt is
pragma Preelaborate;
- package Impl is new Val_Real (Float, Interfaces.Unsigned_32);
+ package Impl is new Val_Real
+ (Float,
+ Interfaces.Unsigned_32,
+ System.Powten_Flt.Maxpow,
+ System.Powten_Flt.Powten'Address);
function Scan_Float
(Str : String;
-- type Long_Float, for use in Text_IO.Float_IO and the Value attribute.
with Interfaces;
+with System.Powten_LFlt;
with System.Val_Real;
package System.Val_LFlt is
pragma Preelaborate;
- package Impl is new Val_Real (Long_Float, Interfaces.Unsigned_64);
+ package Impl is new Val_Real
+ (Long_Float,
+ Interfaces.Unsigned_64,
+ System.Powten_LFlt.Maxpow,
+ System.Powten_LFlt.Powten'Address);
function Scan_Long_Float
(Str : String;
-- type Long_Long_Float, for use in Text_IO.Float_IO and the Value attribute.
with Interfaces;
+with System.Powten_LLF;
with System.Val_Real;
package System.Val_LLF is
pragma Preelaborate;
- package Impl is new Val_Real (Long_Long_Float, Interfaces.Unsigned_64);
+ package Impl is new Val_Real
+ (Long_Long_Float,
+ Interfaces.Unsigned_64,
+ System.Powten_LLF.Maxpow,
+ System.Powten_LLF.Powten'Address);
function Scan_Long_Long_Float
(Str : String;
with System.Val_Util; use System.Val_Util;
with System.Value_R;
+pragma Warnings (Off, "non-static constant in preelaborated unit");
+-- Every constant is static given our instantiation model
+
package body System.Val_Real is
pragma Assert (Num'Machine_Mantissa <= Uns'Size);
-- We need an unsigned type large enough to represent the mantissa
- Precision_Limit : constant Uns := 2**Num'Machine_Mantissa - 1;
- -- We use the precision of the floating-point type
+ Need_Extra : constant Boolean := Num'Machine_Mantissa > Uns'Size - 4;
+ -- If the mantissa of the floating-point type is almost as large as that
+ -- of the unsigned type, we do not have enough space for an extra digit
+ -- in the unsigned type so we handle the extra digit separately, at the
+ -- cost of a potential roundoff error.
+
+ Precision_Limit : constant Uns :=
+ (if Need_Extra then 2**Num'Machine_Mantissa - 1 else 2**Uns'Size - 1);
+ -- If we handle the extra digit separately, we use the precision of the
+ -- floating-point type so that the conversion is exact.
- package Impl is new Value_R (Uns, Precision_Limit, Floating => True);
+ package Impl is new Value_R (Uns, Precision_Limit, Round => Need_Extra);
subtype Base_T is Unsigned range 2 .. 16;
is
pragma Assert (Base in 2 .. 16);
+ pragma Assert (Num'Machine_Radix = 2);
+
pragma Unsuppress (Range_Check);
Maxexp : constant Positive :=
System.Float_Control.Reset;
end if;
- -- Take into account the extra digit
+ -- Do the conversion
R_Val := Num (Val);
- if Extra > 0 then
+
+ -- Take into account the extra digit, if need be. In this case, the
+ -- three operands are exact, so using an FMA would be ideal.
+
+ if Need_Extra and then Extra > 0 then
R_Val := R_Val * B + Num (Extra);
S := S - 1;
end if;
- -- Compute the final value. When the exponent is positive, we can do the
- -- computation directly because, if the exponentiation overflows, then
- -- the final value overflows as well. But when the exponent is negative,
- -- we may need to do it in two steps to avoid an artificial underflow.
+ -- Compute the final value
+
+ if R_Val /= 0.0 and then S /= 0 then
+ case Base is
+ -- If the base is a power of two, we use the efficient Scaling
+ -- attribute with an overflow check, if it is not 2, to catch
+ -- ludicrous exponents that would result in an infinity or zero.
+
+ when 2 =>
+ R_Val := Num'Scaling (R_Val, S);
+
+ when 4 =>
+ if Integer'First / 2 <= S and then S <= Integer'Last / 2 then
+ S := S * 2;
+ end if;
+
+ R_Val := Num'Scaling (R_Val, S);
+
+ when 8 =>
+ if Integer'First / 3 <= S and then S <= Integer'Last / 3 then
+ S := S * 3;
+ end if;
+
+ R_Val := Num'Scaling (R_Val, S);
+
+ when 16 =>
+ if Integer'First / 4 <= S and then S <= Integer'Last / 4 then
+ S := S * 4;
+ end if;
+
+ R_Val := Num'Scaling (R_Val, S);
+
+ -- If the base is 10, we use a table of powers for accuracy's sake
+
+ when 10 =>
+ declare
+ Powten : constant array (0 .. Maxpow) of Num;
+ pragma Import (Ada, Powten);
+ for Powten'Address use Powten_Address;
+
+ begin
+ if S > 0 then
+ while S > Maxpow loop
+ R_Val := R_Val * Powten (Maxpow);
+ S := S - Maxpow;
+ end loop;
+
+ R_Val := R_Val * Powten (S);
+
+ else
+ while S < -Maxpow loop
+ R_Val := R_Val / Powten (Maxpow);
+ S := S + Maxpow;
+ end loop;
+
+ R_Val := R_Val / Powten (-S);
+ end if;
+ end;
+
+ -- Implementation for other bases with exponentiation
+
+ -- When the exponent is positive, we can do the computation
+ -- directly because, if the exponentiation overflows, then
+ -- the final value overflows as well. But when the exponent
+ -- is negative, we may need to do it in two steps to avoid
+ -- an artificial underflow.
- if S > 0 then
- R_Val := R_Val * B ** S;
+ when others =>
+ if S > 0 then
+ R_Val := R_Val * B ** S;
- elsif S < 0 then
- if S < -Maxexp then
- R_Val := R_Val / B ** Maxexp;
- S := S + Maxexp;
- end if;
+ else
+ if S < -Maxexp then
+ R_Val := R_Val / B ** Maxexp;
+ S := S + Maxexp;
+ end if;
- R_Val := R_Val / B ** (-S);
+ R_Val := R_Val / B ** (-S);
+ end if;
+ end case;
end if;
-- Finally deal with initial minus sign, note that this processing is
type Uns is mod <>;
+ Maxpow : Positive;
+
+ Powten_Address : System.Address;
+
package System.Val_Real is
pragma Preelaborate;
pragma Assert (Int'Size <= Uns'Size);
-- We need an unsigned type large enough to represent the mantissa
- package Impl is new Value_R (Uns, 2**(Int'Size - 1), Floating => False);
+ package Impl is new Value_R (Uns, 2**(Int'Size - 1), Round => False);
+ -- We do not use the Extra digit for decimal fixed-point types
function Integer_to_Decimal
(Str : String;
Base : Unsigned;
ScaleB : Integer;
Extra : Unsigned;
+ pragma Unreferenced (Extra);
Minus : Boolean;
Val : Uns;
Base : Unsigned;
ScaleB : Integer;
Extra : Unsigned;
+ pragma Unreferenced (Extra);
Minus : Boolean;
Val : Uns;
pragma Assert (Int'Size <= Uns'Size);
-- We need an unsigned type large enough to represent the mantissa
- package Impl is new Value_R (Uns, 2**(Int'Size - 1), Floating => False);
+ package Impl is new Value_R (Uns, 2**(Int'Size - 1), Round => True);
+ -- We use the Extra digit for ordinary fixed-point types
function Integer_To_Fixed
(Str : String;
function As_Digit (C : Character) return Char_As_Digit;
-- Given a character return the digit it represents
+ procedure Round_Extra
+ (Digit : Char_As_Digit;
+ Value : in out Uns;
+ Scale : in out Integer;
+ Extra : in out Char_As_Digit;
+ Base : Unsigned);
+ -- Round the triplet (Value, Scale, Extra) according to Digit in Base
+
procedure Scan_Decimal_Digits
(Str : String;
Index : in out Integer;
end case;
end As_Digit;
+ -----------------
+ -- Round_Extra --
+ -----------------
+
+ procedure Round_Extra
+ (Digit : Char_As_Digit;
+ Value : in out Uns;
+ Scale : in out Integer;
+ Extra : in out Char_As_Digit;
+ Base : Unsigned)
+ is
+ B : constant Uns := Uns (Base);
+
+ begin
+ if Digit >= Base / 2 then
+
+ -- If Extra is maximum, round Value
+
+ if Extra = Base - 1 then
+
+ -- If Value is maximum, scale it up
+
+ if Value = Precision_Limit then
+ Extra := Char_As_Digit (Value mod B);
+ Value := Value / B;
+ Scale := Scale + 1;
+ Round_Extra (Digit, Value, Scale, Extra, Base);
+
+ else
+ Extra := 0;
+ Value := Value + 1;
+ end if;
+
+ else
+ Extra := Extra + 1;
+ end if;
+ end if;
+ end Round_Extra;
+
-------------------------
-- Scan_Decimal_Digits --
-------------------------
-- to Precision_Limit.
Precision_Limit_Just_Reached : Boolean;
- -- Set to True if Precision_Limit_Reached was just set to True
- -- Only used when Floating = False.
+ -- Set to True if Precision_Limit_Reached was just set to True, but only
+ -- used when Round is True.
Digit : Char_As_Digit;
-- The current digit
Extra := 0;
end if;
- if not Floating then
+ if Round then
Precision_Limit_Just_Reached := False;
end if;
-- If precision limit has been reached, just ignore any remaining
-- digits for the computation of Value and Scale, but store the
- -- first in Extra and use the second to round Extra if this is for
- -- a fixed-point type (we skip the rounding for a floating-point
- -- type to preserve backward compatibility). The scanning should
- -- continue only to assess the validity of the string.
+ -- first in Extra and use the second to round Extra. The scanning
+ -- should continue only to assess the validity of the string.
if Precision_Limit_Reached then
- if not Floating and then Precision_Limit_Just_Reached then
- if Digit >= Base / 2 then
- if Extra = Base - 1 then
- Extra := 0;
- Value := Value + 1;
- else
- Extra := Extra + 1;
- end if;
- end if;
-
+ if Round and then Precision_Limit_Just_Reached then
+ Round_Extra (Digit, Value, Scale, Extra, Base);
Precision_Limit_Just_Reached := False;
end if;
else
Extra := Digit;
Precision_Limit_Reached := True;
-
- if not Floating then
+ if Round then
Precision_Limit_Just_Reached := True;
end if;
end if;
-- to Precision_Limit.
Precision_Limit_Just_Reached : Boolean;
- -- Set to True if Precision_Limit_Reached was just set to True.
- -- Only used when Floating = False.
+ -- Set to True if Precision_Limit_Reached was just set to True, but only
+ -- used when Round is True.
Digit : Char_As_Digit;
-- The current digit
Scale := 0;
Extra := 0;
- if not Floating then
+ if Round then
Precision_Limit_Just_Reached := False;
end if;
-- If precision limit has been reached, just ignore any remaining
-- digits for the computation of Value and Scale, but store the
- -- first in Extra and use the second to round Extra if this is for
- -- a fixed-point type (we skip the rounding for a floating-point
- -- type to preserve backward compatibility). The scanning should
- -- continue only to assess the validity of the string.
+ -- first in Extra and use the second to round Extra. The scanning
+ -- should continue only to assess the validity of the string.
if Precision_Limit_Reached then
Scale := Scale + 1;
- if not Floating and then Precision_Limit_Just_Reached then
- if Digit >= Base / 2 then
- if Extra = Base - 1 then
- Extra := 0;
- Value := Value + 1;
- else
- Extra := Extra + 1;
- end if;
- end if;
-
+ if Round and then Precision_Limit_Just_Reached then
+ Round_Extra (Digit, Value, Scale, Extra, Base);
Precision_Limit_Just_Reached := False;
end if;
else
Extra := Digit;
Precision_Limit_Reached := True;
-
- if not Floating then
+ if Round then
Precision_Limit_Just_Reached := True;
end if;
-
Scale := Scale + 1;
end if;
end if;
Precision_Limit : Uns;
- Floating : Boolean;
+ Round : Boolean;
package System.Value_R is
pragma Preelaborate;
projects / gcc.git / commitdiff