← Back to branch summary

~ubuntu-branches/ubuntu/hardy/asis/hardy-proposed

« back to all changes in this revision

Viewing changes to gnat/urealp.ads

  • Committer: Bazaar Package Importer
  • Author(s): Ludovic Brenta
  • Date: 2006-08-08 23:02:17 UTC
  • mfrom: (3.1.6 edgy)
  • Revision ID: james.westby@ubuntu.com-20060808230217-8j3ts1m8i83e0apm
Tags: 2005-5

debian/control: add support for alpha and s390.

Show diffs side-by-side

added added

removed removed

Lines of Context:
gnat/urealp.ads
1
 
------------------------------------------------------------------------------
2
 
------------------------------------------------------------------------------
3
 
 
4
 
 
5
 
with Types; use Types;
6
 
with Uintp; use Uintp;
7
 
 
8
 
package Urealp is
9
 
 
10
 
   ---------------------------------------
11
 
   -- Representation of Universal Reals --
12
 
   ---------------------------------------
13
 
 
14
 
   --  A universal real value is represented by a single value (which is
15
 
   --  an index into an internal table). These values are not hashed, so
16
 
   --  the equality operator should not be used on Ureal values (instead
17
 
   --  use the UR_Eq function).
18
 
 
19
 
   --  A Ureal value represents an arbitrary precision universal real value,
20
 
   --  stored internally using four components
21
 
 
22
 
   --    the numerator (Uint, always non-negative)
23
 
   --    the denominator (Uint, always non-zero, always positive if base = 0)
24
 
   --    a real base (Nat, either zero, or in the range 2 .. 16)
25
 
   --    a sign flag (Boolean), set if negative
26
 
 
27
 
   --  If the base is zero, then the absolute value of the Ureal is simply
28
 
   --  numerator/denominator. If the base is non-zero, then the absolute
29
 
   --  value is num / (rbase ** den).
30
 
 
31
 
   --  Negative numbers are represented by the sign of the numerator being
32
 
   --  negative. The denominator is always positive.
33
 
 
34
 
   --  A normalized Ureal value has base = 0, and numerator/denominator
35
 
   --  reduced to lowest terms, with zero itself being represented as 0/1.
36
 
   --  This is a canonical format, so that for normalized Ureal values it
37
 
   --  is the case that two equal values always have the same denominator
38
 
   --  and numerator values.
39
 
 
40
 
   --  Note: a value of minus zero is legitimate, and the operations in
41
 
   --  Urealp preserve the handling of signed zeroes in accordance with
42
 
   --  the rules of IEEE P754 ("IEEE floating point").
43
 
 
44
 
   ------------------------------
45
 
   -- Types for Urealp Package --
46
 
   ------------------------------
47
 
 
48
 
   type Ureal is private;
49
 
   --  Type used for representation of universal reals
50
 
 
51
 
   No_Ureal : constant Ureal;
52
 
   --  Constant used to indicate missing or unset Ureal value
53
 
 
54
 
   ---------------------
55
 
   -- Ureal Constants --
56
 
   ---------------------
57
 
 
58
 
   function Ureal_0 return Ureal;
59
 
   --  Returns value 0.0
60
 
 
61
 
   function Ureal_M_0 return Ureal;
62
 
   --  Returns value -0.0
63
 
 
64
 
   function Ureal_Tenth return Ureal;
65
 
   --  Returns value 0.1
66
 
 
67
 
   function Ureal_Half return Ureal;
68
 
   --  Returns value 0.5
69
 
 
70
 
   function Ureal_1 return Ureal;
71
 
   --  Returns value 1.0
72
 
 
73
 
   function Ureal_2 return Ureal;
74
 
   --  Returns value 2.0
75
 
 
76
 
   function Ureal_10 return Ureal;
77
 
   --  Returns value 10.0
78
 
 
79
 
   function Ureal_100 return Ureal;
80
 
   --  Returns value 100.0
81
 
 
82
 
   function Ureal_2_128 return Ureal;
83
 
   --  Returns value 2.0 ** 128
84
 
 
85
 
   function Ureal_2_M_128 return Ureal;
86
 
   --  Returns value 2.0 ** (-128)
87
 
 
88
 
   -----------------
89
 
   -- Subprograms --
90
 
   -----------------
91
 
 
92
 
   procedure Initialize;
93
 
   --  Initialize Ureal tables. Note that Initialize must not be called if
94
 
   --  Tree_Read is used. Note also that there is no Lock routine in this
95
 
   --  unit. These tables are among the few tables that can be expanded
96
 
   --  during Gigi processing.
97
 
 
98
 
   procedure Tree_Read;
99
 
   --  Initializes internal tables from current tree file using Tree_Read.
100
 
   --  Note that Initialize should not be called if Tree_Read is used.
101
 
   --  Tree_Read includes all necessary initialization.
102
 
 
103
 
   procedure Tree_Write;
104
 
   --  Writes out internal tables to current tree file using Tree_Write
105
 
 
106
 
   function Rbase (Real : Ureal) return Nat;
107
 
   --  Return the base of the universal real.
108
 
 
109
 
   function Denominator (Real : Ureal) return Uint;
110
 
   --  Return the denominator of the universal real.
111
 
 
112
 
   function Numerator (Real : Ureal) return Uint;
113
 
   --  Return the numerator of the universal real.
114
 
 
115
 
   function Norm_Den (Real : Ureal) return Uint;
116
 
   --  Return the denominator of the universal real after a normalization.
117
 
 
118
 
   function Norm_Num (Real : Ureal) return Uint;
119
 
   --  Return the numerator of the universal real after a normalization.
120
 
 
121
 
   function UR_From_Uint (UI : Uint) return Ureal;
122
 
   --  Returns real corresponding to universal integer value
123
 
 
124
 
   function UR_To_Uint (Real : Ureal) return Uint;
125
 
   --  Return integer value obtained by accurate rounding of real value.
126
 
   --  The rounding of values half way between two integers is away from
127
 
   --  zero, as required by normal Ada 95 rounding semantics.
128
 
 
129
 
   function UR_Trunc (Real : Ureal) return Uint;
130
 
   --  Return integer value obtained by a truncation of real towards zero
131
 
 
132
 
   function UR_Ceiling (Real : Ureal) return Uint;
133
 
   --  Return value of smallest integer not less than the given value
134
 
 
135
 
   function UR_Floor (Real : Ureal) return Uint;
136
 
   --  Return value of smallest integer not greater than the given value
137
 
 
138
 
   --  Conversion table for above four functions
139
 
 
140
 
   --    Input    To_Uint    Trunc    Ceiling    Floor
141
 
   --     1.0        1         1         1         1
142
 
   --     1.2        1         1         2         1
143
 
   --     1.5        2         1         2         1
144
 
   --     1.7        2         1         2         1
145
 
   --     2.0        2         2         2         2
146
 
   --    -1.0       -1        -1        -1        -1
147
 
   --    -1.2       -1        -1        -1        -2
148
 
   --    -1.5       -2        -1        -1        -2
149
 
   --    -1.7       -2        -1        -1        -2
150
 
   --    -2.0       -2        -2        -2        -2
151
 
 
152
 
   function UR_From_Components
153
 
     (Num      : Uint;
154
 
      Den      : Uint;
155
 
      Rbase    : Nat := 0;
156
 
      Negative : Boolean := False)
157
 
      return     Ureal;
158
 
   --  Builds real value from given numerator, denominator and base. The
159
 
   --  value is negative if Negative is set to true, and otherwise is
160
 
   --  non-negative.
161
 
 
162
 
   function UR_Add (Left : Ureal; Right : Ureal) return Ureal;
163
 
   function UR_Add (Left : Ureal; Right : Uint)  return Ureal;
164
 
   function UR_Add (Left : Uint;  Right : Ureal) return Ureal;
165
 
   --  Returns real sum of operands
166
 
 
167
 
   function UR_Div (Left : Ureal; Right : Ureal) return Ureal;
168
 
   function UR_Div (Left : Uint;  Right : Ureal) return Ureal;
169
 
   function UR_Div (Left : Ureal; Right : Uint)  return Ureal;
170
 
   --  Returns real quotient of operands. Fatal error if Right is zero
171
 
 
172
 
   function UR_Mul (Left : Ureal; Right : Ureal) return Ureal;
173
 
   function UR_Mul (Left : Uint;  Right : Ureal) return Ureal;
174
 
   function UR_Mul (Left : Ureal; Right : Uint)  return Ureal;
175
 
   --  Returns real product of operands
176
 
 
177
 
   function UR_Sub (Left : Ureal; Right : Ureal) return Ureal;
178
 
   function UR_Sub (Left : Uint;  Right : Ureal) return Ureal;
179
 
   function UR_Sub (Left : Ureal; Right : Uint)  return Ureal;
180
 
   --  Returns real difference of operands
181
 
 
182
 
   function UR_Exponentiate (Real  : Ureal; N : Uint) return  Ureal;
183
 
   --  Returns result of raising Ureal to Uint power.
184
 
   --  Fatal error if Left is 0 and Right is negative.
185
 
 
186
 
   function UR_Abs (Real : Ureal) return Ureal;
187
 
   --  Returns abs function of real
188
 
 
189
 
   function UR_Negate (Real : Ureal) return Ureal;
190
 
   --  Returns negative of real
191
 
 
192
 
   function UR_Eq (Left, Right : Ureal) return Boolean;
193
 
   --  Compares reals for equality.
194
 
 
195
 
   function UR_Max (Left, Right : Ureal) return Ureal;
196
 
   --  Returns the maximum of two reals
197
 
 
198
 
   function UR_Min (Left, Right : Ureal) return Ureal;
199
 
   --  Returns the minimum of two reals
200
 
 
201
 
   function UR_Ne (Left, Right : Ureal) return Boolean;
202
 
   --  Compares reals for inequality.
203
 
 
204
 
   function UR_Lt (Left, Right : Ureal) return Boolean;
205
 
   --  Compares reals for less than.
206
 
 
207
 
   function UR_Le (Left, Right : Ureal) return Boolean;
208
 
   --  Compares reals for less than or equal.
209
 
 
210
 
   function UR_Gt (Left, Right : Ureal) return Boolean;
211
 
   --  Compares reals for greater than.
212
 
 
213
 
   function UR_Ge (Left, Right : Ureal) return Boolean;
214
 
   --  Compares reals for greater than or equal.
215
 
 
216
 
   function UR_Is_Zero (Real : Ureal) return Boolean;
217
 
   --  Tests if real value is zero
218
 
 
219
 
   function UR_Is_Negative (Real : Ureal) return Boolean;
220
 
   --  Tests if real value is negative, note that negative zero gives true
221
 
 
222
 
   function UR_Is_Positive (Real : Ureal) return Boolean;
223
 
   --  Test if real value is greater than zero
224
 
 
225
 
   procedure UR_Write (Real : Ureal);
226
 
   --  Writes value of Real to standard output. Used only for debugging and
227
 
   --  tree/source output. If the result is easily representable as a standard
228
 
   --  Ada literal, it will be given that way, but as a result of evaluation
229
 
   --  of static expressions, it is possible to generate constants (e.g. 1/13)
230
 
   --  which have no such representation. In such cases (and in cases where it
231
 
   --  is too much work to figure out the Ada literal), the string that is
232
 
   --  output is of the form [numerator/denominator].
233
 
 
234
 
   procedure pr (Real : Ureal);
235
 
   pragma Export (Ada, pr);
236
 
   --  Writes value of Real to standard output with a terminating line return,
237
 
   --  using UR_Write as described above. This is for use from the debugger.
238
 
 
239
 
   ------------------------
240
 
   -- Operator Renamings --
241
 
   ------------------------
242
 
 
243
 
   function "+" (Left : Ureal; Right : Ureal) return Ureal renames UR_Add;
244
 
   function "+" (Left : Uint;  Right : Ureal) return Ureal renames UR_Add;
245
 
   function "+" (Left : Ureal; Right : Uint)  return Ureal renames UR_Add;
246
 
 
247
 
   function "/" (Left : Ureal; Right : Ureal) return Ureal renames UR_Div;
248
 
   function "/" (Left : Uint;  Right : Ureal) return Ureal renames UR_Div;
249
 
   function "/" (Left : Ureal; Right : Uint)  return Ureal renames UR_Div;
250
 
 
251
 
   function "*" (Left : Ureal; Right : Ureal) return Ureal renames UR_Mul;
252
 
   function "*" (Left : Uint;  Right : Ureal) return Ureal renames UR_Mul;
253
 
   function "*" (Left : Ureal; Right : Uint)  return Ureal renames UR_Mul;
254
 
 
255
 
   function "-" (Left : Ureal; Right : Ureal) return Ureal renames UR_Sub;
256
 
   function "-" (Left : Uint;  Right : Ureal) return Ureal renames UR_Sub;
257
 
   function "-" (Left : Ureal; Right : Uint)  return Ureal renames UR_Sub;
258
 
 
259
 
   function "**"  (Real  : Ureal; N : Uint) return Ureal
260
 
                                                     renames UR_Exponentiate;
261
 
 
262
 
   function "abs" (Real : Ureal) return Ureal renames UR_Abs;
263
 
 
264
 
   function "-"   (Real : Ureal) return Ureal renames UR_Negate;
265
 
 
266
 
   function "="   (Left, Right : Ureal) return Boolean renames UR_Eq;
267
 
 
268
 
   function "<"   (Left, Right : Ureal) return Boolean renames UR_Lt;
269
 
 
270
 
   function "<="  (Left, Right : Ureal) return Boolean renames UR_Le;
271
 
 
272
 
   function ">="  (Left, Right : Ureal) return Boolean renames UR_Ge;
273
 
 
274
 
   function ">"   (Left, Right : Ureal) return Boolean renames UR_Gt;
275
 
 
276
 
   -----------------------------
277
 
   -- Mark/Release Processing --
278
 
   -----------------------------
279
 
 
280
 
   --  The space used by Ureal data is not automatically reclaimed. However,
281
 
   --  a mark-release regime is implemented which allows storage to be
282
 
   --  released back to a previously noted mark. This is used for example
283
 
   --  when doing comparisons, where only intermediate results get stored
284
 
   --  that do not need to be saved for future use.
285
 
 
286
 
   type Save_Mark is private;
287
 
 
288
 
   function Mark return Save_Mark;
289
 
   --  Note mark point for future release
290
 
 
291
 
   procedure Release (M : Save_Mark);
292
 
   --  Release storage allocated since mark was noted
293
 
 
294
 
   ------------------------------------
295
 
   -- Representation of Ureal Values --
296
 
   ------------------------------------
297
 
 
298
 
private
299
 
 
300
 
   type Ureal is new Int range Ureal_Low_Bound .. Ureal_High_Bound;
301
 
   for Ureal'Size use 32;
302
 
 
303
 
   No_Ureal : constant Ureal := Ureal'First;
304
 
 
305
 
   type Save_Mark is new Int;
306
 
 
307
 
   pragma Inline (Denominator);
308
 
   pragma Inline (Mark);
309
 
   pragma Inline (Norm_Num);
310
 
   pragma Inline (Norm_Den);
311
 
   pragma Inline (Numerator);
312
 
   pragma Inline (Rbase);
313
 
   pragma Inline (Release);
314
 
   pragma Inline (Ureal_0);
315
 
   pragma Inline (Ureal_M_0);
316
 
   pragma Inline (Ureal_Tenth);
317
 
   pragma Inline (Ureal_Half);
318
 
   pragma Inline (Ureal_1);
319
 
   pragma Inline (Ureal_2);
320
 
   pragma Inline (Ureal_10);
321
 
   pragma Inline (UR_From_Components);
322
 
 
323
 
end Urealp;