| (* LowLong.mod implement ISO LowLong specification. |
| |
| Copyright (C) 2010-2023 Free Software Foundation, Inc. |
| Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. |
| |
| This file is part of GNU Modula-2. |
| |
| GNU Modula-2 is free software; you can redistribute it and/or modify |
| it under the terms of the GNU General Public License as published by |
| the Free Software Foundation; either version 3, or (at your option) |
| any later version. |
| |
| GNU Modula-2 is distributed in the hope that it will be useful, but |
| WITHOUT ANY WARRANTY; without even the implied warranty of |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| General Public License for more details. |
| |
| 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/>. *) |
| |
| IMPLEMENTATION MODULE LowLong ; |
| |
| FROM SYSTEM IMPORT ADDRESS ; |
| FROM Builtins IMPORT ilogbl, modfl, signbitl, scalbnl, huge_vall, nextafterl ; |
| FROM dtoa IMPORT Mode, strtod, dtoa ; |
| FROM libc IMPORT free ; |
| FROM RealMath IMPORT power ; |
| FROM ConvStringReal IMPORT RealToFloatString ; |
| FROM StringConvert IMPORT ToSigFig ; |
| |
| FROM EXCEPTIONS IMPORT ExceptionSource, AllocateSource, RAISE, CurrentNumber, |
| IsCurrentSource, IsExceptionalExecution ; |
| |
| FROM DynamicStrings IMPORT String, InitString, KillString, Slice, Mark, |
| Mult, InitStringCharStar, Length, ConCat, |
| ConCatChar, InitStringChar, string ; |
| |
| TYPE |
| FloatingPointExceptions = (badparam) ; |
| |
| VAR |
| currentmode: Modes ; |
| |
| |
| (* |
| exponent - returns the exponent value of x |
| *) |
| |
| PROCEDURE exponent (x: LONGREAL) : INTEGER ; |
| BEGIN |
| RETURN ilogbl(x) |
| END exponent ; |
| |
| |
| (* |
| fraction - returns the significand (or significant part) of x |
| *) |
| |
| PROCEDURE fraction (x: LONGREAL) : LONGREAL ; |
| BEGIN |
| RETURN scalbnl(x, -ilogbl (x)) |
| END fraction ; |
| |
| (* |
| sign - returns the signum of x. sign(x) = 1.0 for all x>0.0 |
| sign(x) = -1.0 for all x<0.0. |
| may be either -1.0 or 1.0 if x = 0.0 |
| *) |
| |
| PROCEDURE sign (x: LONGREAL) : LONGREAL ; |
| BEGIN |
| IF signbitl(x)=0 |
| THEN |
| RETURN 1.0 |
| ELSE |
| RETURN -1.0 |
| END |
| END sign ; |
| |
| |
| (* |
| succ - returns the next value of the type REAL greater than x |
| *) |
| |
| PROCEDURE succ (x: LONGREAL) : LONGREAL ; |
| BEGIN |
| RETURN nextafterl(x, huge_vall()) |
| END succ ; |
| |
| |
| (* |
| ulp - returns the value of a unit in the last place of x. |
| So either: |
| |
| ulp(x) = succ(x)-x or |
| ulp(x) = x-pred(x) or both are true. |
| |
| if the value does not exist then an exception is raised. |
| *) |
| |
| PROCEDURE ulp (x: LONGREAL) : LONGREAL ; |
| BEGIN |
| IF x<huge_vall() |
| THEN |
| RETURN succ(x)-x |
| ELSE |
| RETURN x-pred(x) |
| END |
| END ulp ; |
| |
| |
| (* |
| pred - returns the previous value of the type REAL less than x. |
| *) |
| |
| PROCEDURE pred (x: LONGREAL) : LONGREAL ; |
| BEGIN |
| RETURN nextafterl(x, -huge_vall()) |
| END pred ; |
| |
| |
| (* |
| intpart - returns the integer part of x |
| *) |
| |
| PROCEDURE intpart (x: LONGREAL) : LONGREAL ; |
| VAR |
| y, z: LONGREAL ; |
| BEGIN |
| z := modfl(x, y) ; |
| RETURN y |
| END intpart ; |
| |
| |
| (* |
| fractpart - returns the fractional part of x |
| *) |
| |
| PROCEDURE fractpart (x: LONGREAL) : LONGREAL ; |
| VAR |
| y: LONGREAL ; |
| BEGIN |
| RETURN modfl(x, y) |
| END fractpart ; |
| |
| |
| (* |
| scale - returns the value of x * radix ** n |
| |
| The following holds true: |
| |
| x = synthesize(exponent(x),fraction(x)) |
| x = scale(fraction(x), exponent(x)) |
| *) |
| |
| PROCEDURE scale (x: LONGREAL; n: INTEGER) : LONGREAL ; |
| BEGIN |
| RETURN scalbnl(x, n) |
| END scale ; |
| |
| |
| (* |
| trunc - returns the value of the first n places of x. |
| *) |
| |
| PROCEDURE trunc (x: LONGREAL; n: INTEGER) : LONGREAL ; |
| VAR |
| y : LONGREAL ; |
| sign, |
| error : BOOLEAN ; |
| s : String ; |
| r : ADDRESS ; |
| point, l, |
| powerOfTen: INTEGER ; |
| BEGIN |
| IF n<0 |
| THEN |
| (* exception raised *) |
| RAISE(except, ORD(badparam), |
| 'LowLong.trunc: cannot truncate to a negative number of digits') ; |
| RETURN x |
| ELSE |
| r := dtoa(x, maxsignificant, 100, point, sign) ; |
| s := InitStringCharStar(r) ; |
| free(r) ; |
| l := Length(s) ; |
| IF VAL(INTEGER, n)<l |
| THEN |
| s := Slice(ToSigFig(s, n), 0, n) |
| ELSE |
| (* add '0's to make up significant figures *) |
| s := ConCat(s, Mark(Mult(InitStringChar('0'), l-VAL(INTEGER, n)))) |
| END ; |
| powerOfTen := point-1 ; |
| point := 1 ; |
| |
| IF (point<l) AND (point<VAL(INTEGER, n)) |
| THEN |
| s := ConCat(ConCatChar(Slice(s, 0, point), '.'), |
| Slice(s, point, 0)) |
| END ; |
| y := strtod(string(s), error) ; |
| IF powerOfTen#0 |
| THEN |
| y := power(y, FLOATL(powerOfTen)) |
| END ; |
| s := KillString(s) ; |
| RETURN y |
| END |
| END trunc ; |
| |
| |
| (* |
| round - returns the value of x rounded to the first n places. |
| n significant figures. |
| *) |
| |
| PROCEDURE round (x: LONGREAL; n: INTEGER) : LONGREAL ; |
| VAR |
| y : LONGREAL ; |
| error: BOOLEAN ; |
| s : String ; |
| BEGIN |
| IF n<0 |
| THEN |
| (* exception raised *) |
| RAISE(except, ORD(badparam), |
| 'LowLong.round: cannot round to a negative number of digits') ; |
| RETURN x |
| ELSE |
| s := RealToFloatString(x, n) ; |
| y := strtod(string(s), error) ; |
| s := KillString(s) ; |
| RETURN y |
| END |
| END round ; |
| |
| |
| (* |
| synthesize - returns a value of the type REAL constructed from |
| the given expart and frapart. |
| |
| The following holds true: |
| |
| x = synthesize(exponent(x),fraction(x)) |
| x = scale(fraction(x), exponent(x)) |
| *) |
| |
| PROCEDURE synthesize (expart: INTEGER; frapart: LONGREAL) : LONGREAL ; |
| BEGIN |
| RETURN scalbnl(frapart, expart) |
| END synthesize ; |
| |
| |
| (* |
| setMode - sets status flags appropriate to the underlying implementation |
| of the type REAL. |
| *) |
| |
| PROCEDURE setMode (m: Modes) ; |
| BEGIN |
| currentmode := m |
| END setMode ; |
| |
| |
| (* |
| currentMode - returns the current status flags in the form set by setMode |
| *) |
| |
| PROCEDURE currentMode () : Modes ; |
| BEGIN |
| RETURN currentmode |
| END currentMode ; |
| |
| |
| (* |
| IsLowException - returns TRUE if the current coroutine is in the exceptional |
| execution state because of the raising of an exception in a |
| routine from this module; otherwise returns FALSE. |
| *) |
| |
| PROCEDURE IsLowException () : BOOLEAN ; |
| BEGIN |
| RETURN( IsExceptionalExecution() AND IsCurrentSource(except) ) |
| END IsLowException ; |
| |
| |
| VAR |
| except: ExceptionSource ; |
| BEGIN |
| AllocateSource(except) |
| END LowLong. |