Mercurial > hg > octave-lyh
changeset 709:49e8c7d2de7d
[project @ 1994-09-16 13:58:25 by jwe]
Initial revision
author | jwe |
---|---|
date | Fri, 16 Sep 1994 13:58:25 +0000 |
parents | 6caaaf4c5dd4 |
children | 60af453e3f67 |
files | float-type.c |
diffstat | 1 files changed, 448 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
new file mode 100644 --- /dev/null +++ b/float-type.c @@ -0,0 +1,448 @@ +/* + +This file combines the single and double precision versions of machar, +selected by cc -DSP or cc -DDP. This feature provided by D. G. Hough, +August 3, 1988. + +*/ + +#ifdef SP +#define REAL float +#define ZERO 0.0 +#define ONE 1.0 +#define PREC "Single " +#define REALSIZE 1 +#endif + +#ifdef DP +#define REAL double +#define ZERO 0.0e0 +#define ONE 1.0e0 +#define PREC "Double " +#define REALSIZE 2 +#endif + +#include <math.h> +#include <stdio.h> + +#define ABS(xxx) ((xxx>ZERO)?(xxx):(-xxx)) + +void +rmachar(ibeta,it,irnd,ngrd,machep,negep,iexp,minexp, + maxexp,eps,epsneg,xmin,xmax) + + int *ibeta,*iexp,*irnd,*it,*machep,*maxexp,*minexp,*negep,*ngrd; + REAL *eps,*epsneg,*xmax,*xmin; + +/* + + This subroutine is intended to determine the parameters of the + floating-point arithmetic system specified below. The + determination of the first three uses an extension of an algorithm + due to M. Malcolm, CACM 15 (1972), pp. 949-951, incorporating some, + but not all, of the improvements suggested by M. Gentleman and S. + Marovich, CACM 17 (1974), pp. 276-277. An earlier version of this + program was published in the book Software Manual for the + Elementary Functions by W. J. Cody and W. Waite, Prentice-Hall, + Englewood Cliffs, NJ, 1980. The present program is a + translation of the Fortran 77 program in W. J. Cody, "MACHAR: + A subroutine to dynamically determine machine parameters". + TOMS (14), 1988. + + Parameter values reported are as follows: + + ibeta - the radix for the floating-point representation + it - the number of base ibeta digits in the floating-point + significand + irnd - 0 if floating-point addition chops + 1 if floating-point addition rounds, but not in the + IEEE style + 2 if floating-point addition rounds in the IEEE style + 3 if floating-point addition chops, and there is + partial underflow + 4 if floating-point addition rounds, but not in the + IEEE style, and there is partial underflow + 5 if floating-point addition rounds in the IEEE style, + and there is partial underflow + ngrd - the number of guard digits for multiplication with + truncating arithmetic. It is + 0 if floating-point arithmetic rounds, or if it + truncates and only it base ibeta digits + participate in the post-normalization shift of the + floating-point significand in multiplication; + 1 if floating-point arithmetic truncates and more + than it base ibeta digits participate in the + post-normalization shift of the floating-point + significand in multiplication. + machep - the largest negative integer such that + 1.0+FLOAT(ibeta)**machep .NE. 1.0, except that + machep is bounded below by -(it+3) + negeps - the largest negative integer such that + 1.0-FLOAT(ibeta)**negeps .NE. 1.0, except that + negeps is bounded below by -(it+3) + iexp - the number of bits (decimal places if ibeta = 10) + reserved for the representation of the exponent + (including the bias or sign) of a floating-point + number + minexp - the largest in magnitude negative integer such that + FLOAT(ibeta)**minexp is positive and normalized + maxexp - the smallest positive power of BETA that overflows + eps - the smallest positive floating-point number such + that 1.0+eps .NE. 1.0. In particular, if either + ibeta = 2 or IRND = 0, eps = FLOAT(ibeta)**machep. + Otherwise, eps = (FLOAT(ibeta)**machep)/2 + epsneg - A small positive floating-point number such that + 1.0-epsneg .NE. 1.0. In particular, if ibeta = 2 + or IRND = 0, epsneg = FLOAT(ibeta)**negeps. + Otherwise, epsneg = (ibeta**negeps)/2. Because + negeps is bounded below by -(it+3), epsneg may not + be the smallest number that can alter 1.0 by + subtraction. + xmin - the smallest non-vanishing normalized floating-point + power of the radix, i.e., xmin = FLOAT(ibeta)**minexp + xmax - the largest finite floating-point number. In + particular xmax = (1.0-epsneg)*FLOAT(ibeta)**maxexp + Note - on some machines xmax will be only the + second, or perhaps third, largest number, being + too small by 1 or 2 units in the last digit of + the significand. + + Latest revision - August 4, 1988 + + Author - W. J. Cody + Argonne National Laboratory + +*/ + +{ + int i,iz,j,k; + int mx,itmp,nxres; + REAL a,b,beta,betain,one,y,z,zero; + REAL betah,t,tmp,tmpa,tmp1,two; + + (*irnd) = 1; + one = (REAL)(*irnd); + two = one + one; + a = two; + b = a; + zero = 0.0e0; + +/* + determine ibeta,beta ala malcolm +*/ + + tmp = ((a+one)-a)-one; + + while (tmp == zero) { + a = a+a; + tmp = a+one; + tmp1 = tmp-a; + tmp = tmp1-one; + } + + tmp = a+b; + itmp = (int)(tmp-a); + while (itmp == 0) { + b = b+b; + tmp = a+b; + itmp = (int)(tmp-a); + } + + *ibeta = itmp; + beta = (REAL)(*ibeta); + +/* + determine irnd, it +*/ + + (*it) = 0; + b = one; + tmp = ((b+one)-b)-one; + + while (tmp == zero) { + *it = *it+1; + b = b*beta; + tmp = b+one; + tmp1 = tmp-b; + tmp = tmp1-one; + } + + *irnd = 0; + betah = beta/two; + tmp = a+betah; + tmp1 = tmp-a; + if (tmp1 != zero) *irnd = 1; + tmpa = a+beta; + tmp = tmpa+betah; + if ((*irnd == 0) && (tmp-tmpa != zero)) *irnd = 2; + +/* + determine negep, epsneg +*/ + + (*negep) = (*it) + 3; + betain = one / beta; + a = one; + + for (i = 1; i<=(*negep); i++) { + a = a * betain; + } + + b = a; + tmp = (one-a); + tmp = tmp-one; + + while (tmp == zero) { + a = a*beta; + *negep = *negep-1; + tmp1 = one-a; + tmp = tmp1-one; + } + + (*negep) = -(*negep); + (*epsneg) = a; + +/* + determine machep, eps +*/ + + (*machep) = -(*it) - 3; + a = b; + tmp = one+a; + + while (tmp-one == zero) { + a = a*beta; + *machep = *machep+1; + tmp = one+a; + } + + *eps = a; + +/* + determine ngrd +*/ + + (*ngrd) = 0; + tmp = one+*eps; + tmp = tmp*one; + if (((*irnd) == 0) && (tmp-one) != zero) (*ngrd) = 1; + +/* + determine iexp, minexp, xmin + + loop to determine largest i such that + (1/beta) ** (2**(i)) + does not underflow. + exit from loop is signaled by an underflow. +*/ + + i = 0; + k = 1; + z = betain; + t = one+*eps; + nxres = 0; + + for (;;) { + y = z; + z = y * y; + +/* + check for underflow +*/ + + a = z * one; + tmp = z*t; + if ((a+a == zero) || (ABS(z) > y)) break; + tmp1 = tmp*betain; + if (tmp1*beta == z) break; + i = i + 1; + k = k+k; + } + +/* + determine k such that (1/beta)**k does not underflow + first set k = 2 ** i +*/ + + (*iexp) = i + 1; + mx = k + k; + if (*ibeta == 10) { + +/* + for decimal machines only +*/ + + (*iexp) = 2; + iz = *ibeta; + while (k >= iz) { + iz = iz * (*ibeta); + (*iexp) = (*iexp) + 1; + } + mx = iz + iz - 1; + } + +/* + loop to determine minexp, xmin. + exit from loop is signaled by an underflow. +*/ + + for (;;) { + (*xmin) = y; + y = y * betain; + a = y * one; + tmp = y*t; + tmp1 = a+a; + if ((tmp1 == zero) || (ABS(y) >= (*xmin))) break; + k = k + 1; + tmp1 = tmp*betain; + tmp1 = tmp1*beta; + + if ((tmp1 == y) && (tmp != y)) { + nxres = 3; + *xmin = y; + break; + } + + } + + (*minexp) = -k; + +/* + determine maxexp, xmax +*/ + + if ((mx <= k+k-3) && ((*ibeta) != 10)) { + mx = mx + mx; + (*iexp) = (*iexp) + 1; + } + + (*maxexp) = mx + (*minexp); + +/* + Adjust *irnd to reflect partial underflow. +*/ + + (*irnd) = (*irnd)+nxres; + +/* + Adjust for IEEE style machines. +*/ + + if ((*irnd) >= 2) (*maxexp) = (*maxexp)-2; + +/* + adjust for machines with implicit leading bit in binary + significand and machines with radix point at extreme + right of significand. +*/ + + i = (*maxexp) + (*minexp); + if (((*ibeta) == 2) && (i == 0)) (*maxexp) = (*maxexp) - 1; + if (i > 20) (*maxexp) = (*maxexp) - 1; + if (a != y) (*maxexp) = (*maxexp) - 2; + (*xmax) = one - (*epsneg); + tmp = (*xmax)*one; + if (tmp != (*xmax)) (*xmax) = one - beta * (*epsneg); + (*xmax) = (*xmax) / (beta * beta * beta * (*xmin)); + i = (*maxexp) + (*minexp) + 3; + if (i > 0) { + + for (j = 1; j<=i; j++ ) { + if ((*ibeta) == 2) (*xmax) = (*xmax) + (*xmax); + if ((*ibeta) != 2) (*xmax) = (*xmax) * beta; + } + + } + + return; + +} + +typedef union +{ + double d; + int i[2]; +} equiv; + +#ifdef DP +int +equiv_compare (equiv *std, equiv *v, int len) +{ + int i; + for (i = 0; i < len; i++) + if (v[i].i[0] != std[i].i[0] || v[i].i[1] != std[i].i[1]) + return 0; + return 1; +} +#endif + +int +main (void) +{ + /* Works for 32 bit machines with 32 bit ints and 64 bit doubles */ + + int ibeta, iexp, irnd, it, machep, maxexp, minexp, negep, ngrd; + REAL eps, epsneg, xmax, xmin; + int i; + equiv flt_params[4]; + + rmachar (&ibeta, &it, &irnd, &ngrd, &machep, &negep, &iexp, &minexp, + &maxexp, &eps, &epsneg, &xmin, &xmax); + + flt_params[0].d = xmin; + flt_params[1].d = xmax; + flt_params[2].d = epsneg; + flt_params[3].d = eps; + +#ifdef DP +#define IS_MACH(v,nm,sm_1,sm_2,lrg_1,lrg_2,rt_1,rt_2,dv_1,dv_2) \ + do \ + { \ + equiv v[4]; \ + v[0].i[0] = (sm_1); v[0].i[1] = (sm_2); \ + v[1].i[0] = (lrg_1); v[1].i[1] = (lrg_2); \ + v[2].i[0] = (rt_1); v[2].i[1] = (rt_2); \ + v[3].i[0] = (dv_1); v[3].i[1] = (dv_2); \ +\ + if (equiv_compare (v, flt_params, 4)) \ + { \ + printf ("%s\n", nm); \ + return 0; \ + } \ + } \ + while (0) + + IS_MACH (ieee_big_endian, "IEEE_BIG_ENDIAN", + 1048576, 0, + 2146435071, -1, + 1017118720, 0, + 1018167296, 0); +/* 1070810131, 1352628735); */ + + IS_MACH (ieee_little_endian, "IEEE_LITTLE_ENDIAN", + 0, 1048576, + -1, 2146435071, + 0, 1017118720, + 0, 1018167296); +/* 1352628735, 1070810131); */ + + IS_MACH (vax_d_float, "VAX_D_FLOAT", + 128, 0, + -32769, -1, + 9344, 0, + 9344, 0); +/* 546979738, -805796613); */ + + IS_MACH (vax_g_float, "VAX_G_FLOAT", + 16, 0, + -32769, -1, + 15552, 0, + 15552, 0); +/* 1142112243, 2046775455); */ +#else +LOSE! LOSE! +#endif + + printf ("UNRECOGNIZED_FLOATING_POINT_FORMAT\n"); + return 1; +}