From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- sys/gio/fpfixr.x | 43 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) create mode 100644 sys/gio/fpfixr.x (limited to 'sys/gio/fpfixr.x') diff --git a/sys/gio/fpfixr.x b/sys/gio/fpfixr.x new file mode 100644 index 00000000..fe67c5b8 --- /dev/null +++ b/sys/gio/fpfixr.x @@ -0,0 +1,43 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include + +# FP_FIXR -- The following procedure is equivalent to "int(x)", except that +# it preserves the most significant digits of x, when x is greater than the +# largest integer. For example, if an integer is 32 bits and X has a 58 bit +# mantissa, "int(x)" would cause nearly half the precision to be lost. +# +# Algorithm (x is assumed nonnegative): +# (1) find high, low x such that x = highx + lowx +# and highx contains the extra digits of precision. +# (2) subtract highx from x, and truncate the residual by assignment +# into a long integer. +# (3) add truncated lowx and highx to get high precision truncated +# real or double result. + +real procedure fp_fixr (x) + +real x +real absx, highx, scaledx +int expon +long longx, lowx + +begin + absx = abs (x) + scaledx = absx + expon = 0 + + while (scaledx > MAX_LONG) { + scaledx = scaledx / 10.0E0 + expon = expon + 1 + } + + longx = scaledx + highx = longx * (10.0E0 ** expon) + lowx = absx - highx + + if (x > 0) + return (highx + lowx) + else + return (-highx - lowx) +end -- cgit