1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M . F O R E _ F --
-- --
-- B o d y --
-- --
-- Copyright (C) 2020-2023, 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. --
-- --
------------------------------------------------------------------------------
package body System.Fore_F is
Maxdigs : constant Natural := Int'Width - 2;
-- Maximum number of decimal digits that can be represented in an Int.
-- The "-2" accounts for the sign and one extra digit, since we need the
-- maximum number of 9's that can be represented, e.g. for the 64-bit case,
-- Integer_64'Width is 20 since the maximum value is approximately 9.2E+18
-- and has 19 digits, but the maximum number of 9's that can be represented
-- in Integer_64 is only 18.
-- The first prerequisite of the implementation is that the scaled divide
-- does not overflow, which means that the absolute value of the bounds of
-- the subtype must be smaller than 10**Maxdigs * 2**(Int'Size - 1).
-- Otherwise Constraint_Error is raised by the scaled divide operation.
-- The second prerequisite is that the computation of the operands does not
-- overflow, which means that, if the small is larger than 1, it is either
-- an integer or its numerator and denominator must be both smaller than
-- the power 10**(Maxdigs - 1).
----------------
-- Fore_Fixed --
----------------
function Fore_Fixed (Lo, Hi, Num, Den : Int; Scale : Integer) return Natural
is
pragma Assert (Num < 0 and then Den < 0);
-- Accept only negative numbers to allow -2**(Int'Size - 1)
function Negative_Abs (Val : Int) return Int is
(if Val <= 0 then Val else -Val);
-- Return the opposite of the absolute value of Val
T : Int := Int'Min (Negative_Abs (Lo), Negative_Abs (Hi));
F : Natural;
Q, R : Int;
begin
-- Initial value of 2 allows for sign and mandatory single digit
F := 2;
-- The easy case is when Num is not larger than Den in magnitude,
-- i.e. if S = Num / Den, then S <= 1, in which case we can just
-- compute the product Q = T * S.
if Num >= Den then
Scaled_Divide (T, Num, Den, Q, R, Round => False);
T := Q;
-- Otherwise S > 1 and thus Scale <= 0, compute Q and R such that
-- T * Num = Q * (Den * 10**(-D)) + R
-- with
-- D = Integer'Max (-Maxdigs, Scale - 1)
-- then reason on Q if it is non-zero or else on R / Den.
-- This works only if Den * 10**(-D) does not overflow, which is true
-- if Den = 1. Suppose that Num corresponds to the maximum value of -D,
-- i.e. Maxdigs and 10**(-D) = 10**Maxdigs. If you change Den into 10,
-- then S becomes 10 times smaller and, therefore, Scale is incremented
-- by 1, which means that -D is decremented by 1 provided that Scale was
-- initially not smaller than 1 - Maxdigs, so the multiplication still
-- does not overflow. But you need to reach 10 to trigger this effect,
-- which means that a leeway of 10 is required, so let's restrict this
-- to a Num for which 10**(-D) <= 10**(Maxdigs - 1). To sum up, if S is
-- the ratio of two integers with
-- 1 < Den < Num <= B
-- where B is a fixed limit, then the multiplication does not overflow.
-- B can be taken as the largest integer Small such that D = 1 - Maxdigs
-- i.e. such that Scale = 2 - Maxdigs, which is 10**(Maxdigs - 1) - 1.
else
declare
D : constant Integer := Integer'Max (-Maxdigs, Scale - 1);
begin
Scaled_Divide (T, Num, Den * 10**(-D), Q, R, Round => False);
if Q /= 0 then
T := Q;
F := F - D;
else
T := R / Den;
end if;
end;
end if;
-- Loop to increase Fore as needed to include full range of values
while T <= -10 or else T >= 10 loop
T := T / 10;
F := F + 1;
end loop;
return F;
end Fore_Fixed;
end System.Fore_F;
|
