1 (* LowReal.mod implements ISO LowReal.def Copyright (C) 2008-2024 Free Software Foundation, Inc.
3 Copyright (C) 2008-2024 Free Software Foundation, Inc.
4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
6 This file is part of GNU Modula-2.
8 GNU Modula-2 is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
13 GNU Modula-2 is distributed in the hope that it will be useful, but
14 WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 General Public License for more details.
18 Under Section 7 of GPL version 3, you are granted additional
19 permissions described in the GCC Runtime Library Exception, version
20 3.1, as published by the Free Software Foundation.
22 You should have received a copy of the GNU General Public License and
23 a copy of the GCC Runtime Library Exception along with this program;
24 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
25 <http://www.gnu.org/licenses/>. *)
27 IMPLEMENTATION MODULE LowReal ;
29 FROM SYSTEM IMPORT ADDRESS ;
30 FROM Builtins IMPORT ilogb, modf, signbit, scalbn, huge_val, nextafter ;
31 FROM dtoa IMPORT Mode, strtod, dtoa ;
32 FROM libc IMPORT free ;
33 FROM RealMath IMPORT power ;
34 FROM ConvStringReal IMPORT RealToFloatString ;
35 FROM StringConvert IMPORT ToSigFig ;
37 FROM EXCEPTIONS IMPORT ExceptionSource, AllocateSource, RAISE, CurrentNumber,
38 IsCurrentSource, IsExceptionalExecution ;
40 FROM DynamicStrings IMPORT String, InitString, KillString, Slice, Mark,
41 Mult, InitStringCharStar, Length, ConCat,
42 ConCatChar, InitStringChar, string ;
45 FloatingPointExceptions = (badparam) ;
52 exponent - returns the exponent value of x
55 PROCEDURE exponent (x: REAL) : INTEGER ;
62 fraction - returns the significand (or significant part) of x
65 PROCEDURE fraction (x: REAL) : REAL ;
67 RETURN scalbn (x, -ilogb (x))
72 sign - returns the signum of x. sign(x) = 1.0 for all x>0.0
73 sign(x) = -1.0 for all x<0.0.
74 may be either -1.0 or 1.0 if x = 0.0
77 PROCEDURE sign (x: REAL) : REAL ;
89 succ - returns the next value of the type REAL greater than x
92 PROCEDURE succ (x: REAL) : REAL ;
94 RETURN nextafter(x, huge_val())
99 ulp - returns the value of a unit in the last place of x.
102 ulp(x) = succ(x)-x or
103 ulp(x) = x-pred(x) or both are true.
105 if the value does not exist then an exception is raised.
108 PROCEDURE ulp (x: REAL) : REAL ;
120 pred - returns the previous value of the type REAL less than x.
123 PROCEDURE pred (x: REAL) : REAL ;
125 RETURN nextafter(x, -huge_val())
130 intpart - returns the integer part of x
133 PROCEDURE intpart (x: REAL) : REAL ;
143 fractpart - returns the fractional part of x
146 PROCEDURE fractpart (x: REAL) : REAL ;
155 scale - returns the value of x * radix ** n
157 The following holds true:
159 x = synthesize(exponent(x),fraction(x))
160 x = scale(fraction(x), exponent(x))
163 PROCEDURE scale (x: REAL; n: INTEGER) : REAL ;
170 trunc - returns the value of the first n places of x.
173 PROCEDURE trunc (x: REAL; n: INTEGER) : REAL ;
181 powerOfTen: INTEGER ;
185 (* exception raised *)
186 RAISE(except, ORD(badparam),
187 'LowReal.trunc: cannot truncate to a negative number of digits') ;
190 r := dtoa(x, maxsignificant, 100, point, sign) ;
191 s := InitStringCharStar(r) ;
196 s := Slice(ToSigFig(s, n), 0, n)
198 (* add '0's to make up significant figures *)
199 s := ConCat(s, Mark(Mult(InitStringChar('0'), l-VAL(INTEGER, n))))
201 powerOfTen := point-1 ;
204 IF (point<l) AND (point<VAL(INTEGER, n))
206 s := ConCat(ConCatChar(Slice(s, 0, point), '.'),
209 y := strtod(string(s), error) ;
212 y := power(y, FLOAT(powerOfTen))
221 round - returns the value of x rounded to the first n places.
222 n significant figures.
225 PROCEDURE round (x: REAL; n: INTEGER) : REAL ;
233 (* exception raised *)
234 RAISE(except, ORD(badparam),
235 'LowReal.round: cannot round to a negative number of digits') ;
238 s := RealToFloatString(x, n) ;
239 y := strtod(string(s), error) ;
247 synthesize - returns a value of the type REAL constructed from
248 the given expart and frapart.
250 The following holds true:
252 x = synthesize(exponent(x),fraction(x))
253 x = scale(fraction(x), exponent(x))
256 PROCEDURE synthesize (expart: INTEGER; frapart: REAL) : REAL ;
258 RETURN scalbn(frapart, expart)
263 setMode - sets status flags appropriate to the underlying implementation
267 PROCEDURE setMode (m: Modes) ;
274 currentMode - returns the current status flags in the form set by setMode
277 PROCEDURE currentMode () : Modes ;
284 IsLowException - returns TRUE if the current coroutine is in the exceptional
285 execution state because of the raising of an exception in a
286 routine from this module; otherwise returns FALSE.
289 PROCEDURE IsLowException () : BOOLEAN ;
291 RETURN( IsExceptionalExecution() AND IsCurrentSource(except) )
296 except: ExceptionSource ;
298 AllocateSource(except)