add directory gnu

This commit is contained in:
gohigh
2024-02-19 00:24:47 -05:00
parent 32616db5a4
commit a40f4cadb0
5086 changed files with 1860970 additions and 0 deletions

View File

@@ -0,0 +1,106 @@
# Copyright (C) 1991, 1992 Free Software Foundation, Inc.
# This file is part of the GNU C Library.
# The GNU C Library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public License as
# published by the Free Software Foundation; either version 2 of the
# License, or (at your option) any later version.
# The GNU C Library 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
# Library General Public License for more details.
# You should have received a copy of the GNU Library General Public
# License along with the GNU C Library; see the file COPYING.LIB. If
# not, write to the Free Software Foundation, Inc., 675 Mass Ave,
# Cambridge, MA 02139, USA.
#
# Makefile for math.
#
subdir := math
headers := math.h __math.h
routines := acos asin atan cos sin tan cosh sinh tanh exp fabs ldexp \
log log10 floor sqrt fmod frexp pow atan2 ceil modf \
isinf isnan finite infnan copysign scalb drem logb \
__isinf __isnan __finite __infnan __copysign __scalb __drem __logb\
__rint rint hypot cabs cbrt __expm1 expm1 log1p acosh asinh atanh
tests := test-math
install-lib := libm.a
include ../Rules
$(objpfx)libm.a:
$(AR) cr$(verbose) $@
# Other dirs to look for source files (for dist).
source_dirs = $(filter-out unused,$(shell find bsd -type d -print))
include $(objpfx)BSDmath-files
$(objpfx)BSDmath-files:
(echo define +ansideclificate-bsd; \
echo "(echo '#include <ansidecl.h>'; \
echo '#include \"\$$<\"') > \$$@-tmp; \
mv \$$@-tmp \$$@"; \
echo endef; \
for dir in $(source_dirs); do \
echo "\$$(objpfx)%.c: $${dir}/%.c;\$$(+ansideclificate-bsd)";\
done) > $@-tmp
mv $@-tmp $@
ifdef bsdmath_dirs
override CPPFLAGS := $(CPPFLAGS) -Ibsd $(addprefix -Ibsd/,$(bsdmath_dirs))
+bsdpath := $(subst $+ ,:,bsd $(addprefix bsd/,$(bsdmath_dirs)))
vpath %.s $(+bsdpath)
vpath %.h $(+bsdpath)
+bsdfiles := $(wildcard $(patsubst %,bsd/%/*.c,$(bsdmath_dirs)))
ifdef +bsdfiles
# Find all the files which have both BSD and sysdep versions.
+sysdeps := $(notdir $(wildcard \
$(foreach dir, \
$(filter-out %/generic %/stub, \
$(+sysdep_dirs)), \
$(addprefix $(dir)/, \
$(notdir $(+bsdfiles))))))
# Filter these out of the list of BSD files.
+bsdfiles := $(filter-out $(addprefix %/,$(+sysdeps)),$(+bsdfiles))
ifdef +bsdfiles
# Assert that all the BSD C sources exist in the object directory,
# so VPATH will find them there first.
$(addprefix $(objpfx),$(notdir $(+bsdfiles))):
endif
# See how easy this would be in make v4?
ifneq (,)
define bsd-files
$(foreach dir,$(bsdmath_dirs),
$(objpfx)%.c: bsd/$(dir)/%.c
(echo '#include <ansidecl.h>'; echo '#include "$<") > $@-tmp
mv $@-tmp $@
endef
$(bsd-files)
endif
ifneq ($(findstring gcc,$(CC)),)
# Disable GCC warnings for grody BSD code.
override CFLAGS := $(filter-out -W%,$(CFLAGS))
# In make v4, put "$(+bsdfiles): " in front of that.
endif
endif # +bsdfiles
endif # bsdmath_dirs

View File

@@ -0,0 +1,29 @@
/* Copyright (C) 1991, 1992 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
The GNU C Library 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with the GNU C Library; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA. */
#include <ansidecl.h>
#include <math.h>
#undef __finite
/* Return nonzero if VALUE is finite and not NaN. */
int
DEFUN(__finite, (value), double value)
{
return !__isinf (value) && !__isnan (value);
}

View File

@@ -0,0 +1,25 @@
/* Copyright (C) 1991 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
The GNU C Library 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with the GNU C Library; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA. */
#include <ansidecl.h>
#include <gnu-stabs.h>
#include <math.h>
#undef __scalb
function_alias(__scalb, ldexp, double, (x, n),
DEFUN(__scalb, (x, n), double x AND int n))

View File

@@ -0,0 +1,267 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)atan2.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* ATAN2(Y,X)
* RETURN ARG (X+iY)
* DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 1/8/85;
* REVISED BY K.C. NG on 2/7/85, 2/13/85, 3/7/85, 3/30/85, 6/29/85.
*
* Required system supported functions :
* copysign(x,y)
* scalb(x,y)
* logb(x)
*
* Method :
* 1. Reduce y to positive by atan2(y,x)=-atan2(-y,x).
* 2. Reduce x to positive by (if x and y are unexceptional):
* ARG (x+iy) = arctan(y/x) ... if x > 0,
* ARG (x+iy) = pi - arctan[y/(-x)] ... if x < 0,
* 3. According to the integer k=4t+0.25 truncated , t=y/x, the argument
* is further reduced to one of the following intervals and the
* arctangent of y/x is evaluated by the corresponding formula:
*
* [0,7/16] atan(y/x) = t - t^3*(a1+t^2*(a2+...(a10+t^2*a11)...)
* [7/16,11/16] atan(y/x) = atan(1/2) + atan( (y-x/2)/(x+y/2) )
* [11/16.19/16] atan(y/x) = atan( 1 ) + atan( (y-x)/(x+y) )
* [19/16,39/16] atan(y/x) = atan(3/2) + atan( (y-1.5x)/(x+1.5y) )
* [39/16,INF] atan(y/x) = atan(INF) + atan( -x/y )
*
* Special cases:
* Notations: atan2(y,x) == ARG (x+iy) == ARG(x,y).
*
* ARG( NAN , (anything) ) is NaN;
* ARG( (anything), NaN ) is NaN;
* ARG(+(anything but NaN), +-0) is +-0 ;
* ARG(-(anything but NaN), +-0) is +-PI ;
* ARG( 0, +-(anything but 0 and NaN) ) is +-PI/2;
* ARG( +INF,+-(anything but INF and NaN) ) is +-0 ;
* ARG( -INF,+-(anything but INF and NaN) ) is +-PI;
* ARG( +INF,+-INF ) is +-PI/4 ;
* ARG( -INF,+-INF ) is +-3PI/4;
* ARG( (anything but,0,NaN, and INF),+-INF ) is +-PI/2;
*
* Accuracy:
* atan2(y,x) returns (PI/pi) * the exact ARG (x+iy) nearly rounded,
* where
*
* in decimal:
* pi = 3.141592653589793 23846264338327 .....
* 53 bits PI = 3.141592653589793 115997963 ..... ,
* 56 bits PI = 3.141592653589793 227020265 ..... ,
*
* in hexadecimal:
* pi = 3.243F6A8885A308D313198A2E....
* 53 bits PI = 3.243F6A8885A30 = 2 * 1.921FB54442D18 error=.276ulps
* 56 bits PI = 3.243F6A8885A308 = 4 * .C90FDAA22168C2 error=.206ulps
*
* In a test run with 356,000 random argument on [-1,1] * [-1,1] on a
* VAX, the maximum observed error was 1.41 ulps (units of the last place)
* compared with (PI/pi)*(the exact ARG(x+iy)).
*
* Note:
* We use machine PI (the true pi rounded) in place of the actual
* value of pi for all the trig and inverse trig functions. In general,
* if trig is one of sin, cos, tan, then computed trig(y) returns the
* exact trig(y*pi/PI) nearly rounded; correspondingly, computed arctrig
* returns the exact arctrig(y)*PI/pi nearly rounded. These guarantee the
* trig functions have period PI, and trig(arctrig(x)) returns x for
* all critical values x.
*
* Constants:
* The hexadecimal values are the intended ones for the following constants.
* The decimal values may be used, provided that the compiler will convert
* from decimal to binary accurately enough to produce the hexadecimal values
* shown.
*/
#include "mathimpl.h"
vc(athfhi, 4.6364760900080611433E-1 ,6338,3fed,da7b,2b0d, -1, .ED63382B0DDA7B)
vc(athflo, 1.9338828231967579916E-19 ,5005,2164,92c0,9cfe, -62, .E450059CFE92C0)
vc(PIo4, 7.8539816339744830676E-1 ,0fda,4049,68c2,a221, 0, .C90FDAA22168C2)
vc(at1fhi, 9.8279372324732906796E-1 ,985e,407b,b4d9,940f, 0, .FB985E940FB4D9)
vc(at1flo,-3.5540295636764633916E-18 ,1edc,a383,eaea,34d6, -57,-.831EDC34D6EAEA)
vc(PIo2, 1.5707963267948966135E0 ,0fda,40c9,68c2,a221, 1, .C90FDAA22168C2)
vc(PI, 3.1415926535897932270E0 ,0fda,4149,68c2,a221, 2, .C90FDAA22168C2)
vc(a1, 3.3333333333333473730E-1 ,aaaa,3faa,ab75,aaaa, -1, .AAAAAAAAAAAB75)
vc(a2, -2.0000000000017730678E-1 ,cccc,bf4c,946e,cccd, -2,-.CCCCCCCCCD946E)
vc(a3, 1.4285714286694640301E-1 ,4924,3f12,4262,9274, -2, .92492492744262)
vc(a4, -1.1111111135032672795E-1 ,8e38,bee3,6292,ebc6, -3,-.E38E38EBC66292)
vc(a5, 9.0909091380563043783E-2 ,2e8b,3eba,d70c,b31b, -3, .BA2E8BB31BD70C)
vc(a6, -7.6922954286089459397E-2 ,89c8,be9d,7f18,27c3, -3,-.9D89C827C37F18)
vc(a7, 6.6663180891693915586E-2 ,86b4,3e88,9e58,ae37, -3, .8886B4AE379E58)
vc(a8, -5.8772703698290408927E-2 ,bba5,be70,a942,8481, -4,-.F0BBA58481A942)
vc(a9, 5.2170707402812969804E-2 ,b0f3,3e55,13ab,a1ab, -4, .D5B0F3A1AB13AB)
vc(a10, -4.4895863157820361210E-2 ,e4b9,be37,048f,7fd1, -4,-.B7E4B97FD1048F)
vc(a11, 3.3006147437343875094E-2 ,3174,3e07,2d87,3cf7, -4, .8731743CF72D87)
vc(a12, -1.4614844866464185439E-2 ,731a,bd6f,76d9,2f34, -6,-.EF731A2F3476D9)
ic(athfhi, 4.6364760900080609352E-1 , -2, 1.DAC670561BB4F)
ic(athflo, 4.6249969567426939759E-18 , -58, 1.5543B8F253271)
ic(PIo4, 7.8539816339744827900E-1 , -1, 1.921FB54442D18)
ic(at1fhi, 9.8279372324732905408E-1 , -1, 1.F730BD281F69B)
ic(at1flo,-2.4407677060164810007E-17 , -56, -1.C23DFEFEAE6B5)
ic(PIo2, 1.5707963267948965580E0 , 0, 1.921FB54442D18)
ic(PI, 3.1415926535897931160E0 , 1, 1.921FB54442D18)
ic(a1, 3.3333333333333942106E-1 , -2, 1.55555555555C3)
ic(a2, -1.9999999999979536924E-1 , -3, -1.9999999997CCD)
ic(a3, 1.4285714278004377209E-1 , -3, 1.24924921EC1D7)
ic(a4, -1.1111110579344973814E-1 , -4, -1.C71C7059AF280)
ic(a5, 9.0908906105474668324E-2 , -4, 1.745CE5AA35DB2)
ic(a6, -7.6919217767468239799E-2 , -4, -1.3B0FA54BEC400)
ic(a7, 6.6614695906082474486E-2 , -4, 1.10DA924597FFF)
ic(a8, -5.8358371008508623523E-2 , -5, -1.DE125FDDBD793)
ic(a9, 4.9850617156082015213E-2 , -5, 1.9860524BDD807)
ic(a10, -3.6700606902093604877E-2 , -5, -1.2CA6C04C6937A)
ic(a11, 1.6438029044759730479E-2 , -6, 1.0D52174A1BB54)
#ifdef vccast
#define athfhi vccast(athfhi)
#define athflo vccast(athflo)
#define PIo4 vccast(PIo4)
#define at1fhi vccast(at1fhi)
#define at1flo vccast(at1flo)
#define PIo2 vccast(PIo2)
#define PI vccast(PI)
#define a1 vccast(a1)
#define a2 vccast(a2)
#define a3 vccast(a3)
#define a4 vccast(a4)
#define a5 vccast(a5)
#define a6 vccast(a6)
#define a7 vccast(a7)
#define a8 vccast(a8)
#define a9 vccast(a9)
#define a10 vccast(a10)
#define a11 vccast(a11)
#define a12 vccast(a12)
#endif
double atan2(y,x)
double y,x;
{
static const double zero=0, one=1, small=1.0E-9, big=1.0E18;
double t,z,signy,signx,hi,lo;
int k,m;
#if !defined(vax)&&!defined(tahoe)
/* if x or y is NAN */
if(x!=x) return(x); if(y!=y) return(y);
#endif /* !defined(vax)&&!defined(tahoe) */
/* copy down the sign of y and x */
signy = copysign(one,y) ;
signx = copysign(one,x) ;
/* if x is 1.0, goto begin */
if(x==1) { y=copysign(y,one); t=y; if(finite(t)) goto begin;}
/* when y = 0 */
if(y==zero) return((signx==one)?y:copysign(PI,signy));
/* when x = 0 */
if(x==zero) return(copysign(PIo2,signy));
/* when x is INF */
if(!finite(x))
if(!finite(y))
return(copysign((signx==one)?PIo4:3*PIo4,signy));
else
return(copysign((signx==one)?zero:PI,signy));
/* when y is INF */
if(!finite(y)) return(copysign(PIo2,signy));
/* compute y/x */
x=copysign(x,one);
y=copysign(y,one);
if((m=(k=logb(y))-logb(x)) > 60) t=big+big;
else if(m < -80 ) t=y/x;
else { t = y/x ; y = scalb(y,-k); x=scalb(x,-k); }
/* begin argument reduction */
begin:
if (t < 2.4375) {
/* truncate 4(t+1/16) to integer for branching */
k = 4 * (t+0.0625);
switch (k) {
/* t is in [0,7/16] */
case 0:
case 1:
if (t < small)
{ big + small ; /* raise inexact flag */
return (copysign((signx>zero)?t:PI-t,signy)); }
hi = zero; lo = zero; break;
/* t is in [7/16,11/16] */
case 2:
hi = athfhi; lo = athflo;
z = x+x;
t = ( (y+y) - x ) / ( z + y ); break;
/* t is in [11/16,19/16] */
case 3:
case 4:
hi = PIo4; lo = zero;
t = ( y - x ) / ( x + y ); break;
/* t is in [19/16,39/16] */
default:
hi = at1fhi; lo = at1flo;
z = y-x; y=y+y+y; t = x+x;
t = ( (z+z)-x ) / ( t + y ); break;
}
}
/* end of if (t < 2.4375) */
else
{
hi = PIo2; lo = zero;
/* t is in [2.4375, big] */
if (t <= big) t = - x / y;
/* t is in [big, INF] */
else
{ big+small; /* raise inexact flag */
t = zero; }
}
/* end of argument reduction */
/* compute atan(t) for t in [-.4375, .4375] */
z = t*t;
#if defined(vax)||defined(tahoe)
z = t*(z*(a1+z*(a2+z*(a3+z*(a4+z*(a5+z*(a6+z*(a7+z*(a8+
z*(a9+z*(a10+z*(a11+z*a12))))))))))));
#else /* defined(vax)||defined(tahoe) */
z = t*(z*(a1+z*(a2+z*(a3+z*(a4+z*(a5+z*(a6+z*(a7+z*(a8+
z*(a9+z*(a10+z*a11)))))))))));
#endif /* defined(vax)||defined(tahoe) */
z = lo - z; z += t; z += hi;
return(copysign((signx>zero)?z:PI-z,signy));
}

View File

@@ -0,0 +1,84 @@
/*
* Copyright (c) 1987 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)sincos.c 5.5 (Berkeley) 10/9/90";
#endif /* not lint */
#include "trig.h"
double
sin(x)
double x;
{
double a,c,z;
if(!finite(x)) /* sin(NaN) and sin(INF) must be NaN */
return x-x;
x=drem(x,PI2); /* reduce x into [-PI,PI] */
a=copysign(x,one);
if (a >= PIo4) {
if(a >= PI3o4) /* ... in [3PI/4,PI] */
x = copysign((a = PI-a),x);
else { /* ... in [PI/4,3PI/4] */
a = PIo2-a; /* rtn. sign(x)*C(PI/2-|x|) */
z = a*a;
c = cos__C(z);
z *= half;
a = (z >= thresh ? half-((z-half)-c) : one-(z-c));
return copysign(a,x);
}
}
if (a < small) { /* rtn. S(x) */
big+a;
return x;
}
return x+x*sin__S(x*x);
}
double
cos(x)
double x;
{
double a,c,z,s = 1.0;
if(!finite(x)) /* cos(NaN) and cos(INF) must be NaN */
return x-x;
x=drem(x,PI2); /* reduce x into [-PI,PI] */
a=copysign(x,one);
if (a >= PIo4) {
if (a >= PI3o4) { /* ... in [3PI/4,PI] */
a = PI-a;
s = negone;
}
else { /* ... in [PI/4,3PI/4] */
a = PIo2-a;
return a+a*sin__S(a*a); /* rtn. S(PI/2-|x|) */
}
}
if (a < small) {
big+a;
return s; /* rtn. s*C(a) */
}
z = a*a;
c = cos__C(z);
z *= half;
a = (z >= thresh ? half-((z-half)-c) : one-(z-c));
return copysign(a,s);
}

View File

@@ -0,0 +1,60 @@
/*
* Copyright (c) 1987 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)tan.c 5.5 (Berkeley) 10/9/90";
#endif /* not lint */
#include "trig.h"
double
tan(x)
double x;
{
double a,z,ss,cc,c;
int k;
if(!finite(x)) /* tan(NaN) and tan(INF) must be NaN */
return x-x;
x = drem(x,PI); /* reduce x into [-PI/2, PI/2] */
a = copysign(x,one); /* ... = abs(x) */
if (a >= PIo4) {
k = 1;
x = copysign(PIo2-a,x);
}
else {
k = 0;
if (a < small) {
big+a;
return x;
}
}
z = x*x;
cc = cos__C(z);
ss = sin__S(z);
z *= half; /* Next get c = cos(x) accurately */
c = (z >= thresh ? half-((z-half)-cc) : one-(z-cc));
if (k == 0)
return x+(x*(z-(cc-ss)))/c; /* ... sin/cos */
#ifdef national
else if (x == zero)
return copysign(fmax,x); /* no inf on 32k */
#endif /* national */
else
return c/(x+x*ss); /* ... cos/sin */
}

View File

@@ -0,0 +1,201 @@
/*
* Copyright (c) 1987 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*
* @(#)trig.h 5.6 (Berkeley) 10/9/90
*/
#include "mathimpl.h"
vc(thresh, 2.6117239648121182150E-1 ,b863,3f85,6ea0,6b02, -1, .85B8636B026EA0)
vc(PIo4, 7.8539816339744830676E-1 ,0fda,4049,68c2,a221, 0, .C90FDAA22168C2)
vc(PIo2, 1.5707963267948966135E0 ,0fda,40c9,68c2,a221, 1, .C90FDAA22168C2)
vc(PI3o4, 2.3561944901923449203E0 ,cbe3,4116,0e92,f999, 2, .96CBE3F9990E92)
vc(PI, 3.1415926535897932270E0 ,0fda,4149,68c2,a221, 2, .C90FDAA22168C2)
vc(PI2, 6.2831853071795864540E0 ,0fda,41c9,68c2,a221, 3, .C90FDAA22168C2)
ic(thresh, 2.6117239648121182150E-1 , -2, 1.0B70C6D604DD4)
ic(PIo4, 7.8539816339744827900E-1 , -1, 1.921FB54442D18)
ic(PIo2, 1.5707963267948965580E0 , 0, 1.921FB54442D18)
ic(PI3o4, 2.3561944901923448370E0 , 1, 1.2D97C7F3321D2)
ic(PI, 3.1415926535897931160E0 , 1, 1.921FB54442D18)
ic(PI2, 6.2831853071795862320E0 , 2, 1.921FB54442D18)
#ifdef vccast
#define thresh vccast(thresh)
#define PIo4 vccast(PIo4)
#define PIo2 vccast(PIo2)
#define PI3o4 vccast(PI3o4)
#define PI vccast(PI)
#define PI2 vccast(PI2)
#endif
#ifdef national
static long fmaxx[] = { 0xffffffff, 0x7fefffff};
#define fmax (*(double*)fmaxx)
#endif /* national */
static const double
zero = 0,
one = 1,
negone = -1,
half = 1.0/2.0,
small = 1E-10, /* 1+small**2 == 1; better values for small:
* small = 1.5E-9 for VAX D
* = 1.2E-8 for IEEE Double
* = 2.8E-10 for IEEE Extended
*/
big = 1E20; /* big := 1/(small**2) */
/* sin__S(x*x) ... re-implemented as a macro
* DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
* STATIC KERNEL FUNCTION OF SIN(X), COS(X), AND TAN(X)
* CODED IN C BY K.C. NG, 1/21/85;
* REVISED BY K.C. NG on 8/13/85.
*
* sin(x*k) - x
* RETURN --------------- on [-PI/4,PI/4] , where k=pi/PI, PI is the rounded
* x
* value of pi in machine precision:
*
* Decimal:
* pi = 3.141592653589793 23846264338327 .....
* 53 bits PI = 3.141592653589793 115997963 ..... ,
* 56 bits PI = 3.141592653589793 227020265 ..... ,
*
* Hexadecimal:
* pi = 3.243F6A8885A308D313198A2E....
* 53 bits PI = 3.243F6A8885A30 = 2 * 1.921FB54442D18
* 56 bits PI = 3.243F6A8885A308 = 4 * .C90FDAA22168C2
*
* Method:
* 1. Let z=x*x. Create a polynomial approximation to
* (sin(k*x)-x)/x = z*(S0 + S1*z^1 + ... + S5*z^5).
* Then
* sin__S(x*x) = z*(S0 + S1*z^1 + ... + S5*z^5)
*
* The coefficient S's are obtained by a special Remez algorithm.
*
* Accuracy:
* In the absence of rounding error, the approximation has absolute error
* less than 2**(-61.11) for VAX D FORMAT, 2**(-57.45) for IEEE DOUBLE.
*
* Constants:
* The hexadecimal values are the intended ones for the following constants.
* The decimal values may be used, provided that the compiler will convert
* from decimal to binary accurately enough to produce the hexadecimal values
* shown.
*
*/
vc(S0, -1.6666666666666646660E-1 ,aaaa,bf2a,aa71,aaaa, -2, -.AAAAAAAAAAAA71)
vc(S1, 8.3333333333297230413E-3 ,8888,3d08,477f,8888, -6, .8888888888477F)
vc(S2, -1.9841269838362403710E-4 ,0d00,ba50,1057,cf8a, -12, -.D00D00CF8A1057)
vc(S3, 2.7557318019967078930E-6 ,ef1c,3738,bedc,a326, -18, .B8EF1CA326BEDC)
vc(S4, -2.5051841873876551398E-8 ,3195,b3d7,e1d3,374c, -25, -.D73195374CE1D3)
vc(S5, 1.6028995389845827653E-10 ,3d9c,3030,cccc,6d26, -32, .B03D9C6D26CCCC)
vc(S6, -6.2723499671769283121E-13 ,8d0b,ac30,ea82,7561, -40, -.B08D0B7561EA82)
ic(S0, -1.6666666666666463126E-1 , -3, -1.555555555550C)
ic(S1, 8.3333333332992771264E-3 , -7, 1.111111110C461)
ic(S2, -1.9841269816180999116E-4 , -13, -1.A01A019746345)
ic(S3, 2.7557309793219876880E-6 , -19, 1.71DE3209CDCD9)
ic(S4, -2.5050225177523807003E-8 , -26, -1.AE5C0E319A4EF)
ic(S5, 1.5868926979889205164E-10 , -33, 1.5CF61DF672B13)
#ifdef vccast
#define S0 vccast(S0)
#define S1 vccast(S1)
#define S2 vccast(S2)
#define S3 vccast(S3)
#define S4 vccast(S4)
#define S5 vccast(S5)
#define S6 vccast(S6)
#endif
#if defined(vax)||defined(tahoe)
# define sin__S(z) (z*(S0+z*(S1+z*(S2+z*(S3+z*(S4+z*(S5+z*S6)))))))
#else /* defined(vax)||defined(tahoe) */
# define sin__S(z) (z*(S0+z*(S1+z*(S2+z*(S3+z*(S4+z*S5))))))
#endif /* defined(vax)||defined(tahoe) */
/* cos__C(x*x) ... re-implemented as a macro
* DOUBLE PRECISION (VAX D FORMAT 56 BITS, IEEE DOUBLE 53 BITS)
* STATIC KERNEL FUNCTION OF SIN(X), COS(X), AND TAN(X)
* CODED IN C BY K.C. NG, 1/21/85;
* REVISED BY K.C. NG on 8/13/85.
*
* x*x
* RETURN cos(k*x) - 1 + ----- on [-PI/4,PI/4], where k = pi/PI,
* 2
* PI is the rounded value of pi in machine precision :
*
* Decimal:
* pi = 3.141592653589793 23846264338327 .....
* 53 bits PI = 3.141592653589793 115997963 ..... ,
* 56 bits PI = 3.141592653589793 227020265 ..... ,
*
* Hexadecimal:
* pi = 3.243F6A8885A308D313198A2E....
* 53 bits PI = 3.243F6A8885A30 = 2 * 1.921FB54442D18
* 56 bits PI = 3.243F6A8885A308 = 4 * .C90FDAA22168C2
*
*
* Method:
* 1. Let z=x*x. Create a polynomial approximation to
* cos(k*x)-1+z/2 = z*z*(C0 + C1*z^1 + ... + C5*z^5)
* then
* cos__C(z) = z*z*(C0 + C1*z^1 + ... + C5*z^5)
*
* The coefficient C's are obtained by a special Remez algorithm.
*
* Accuracy:
* In the absence of rounding error, the approximation has absolute error
* less than 2**(-64) for VAX D FORMAT, 2**(-58.3) for IEEE DOUBLE.
*
*
* Constants:
* The hexadecimal values are the intended ones for the following constants.
* The decimal values may be used, provided that the compiler will convert
* from decimal to binary accurately enough to produce the hexadecimal values
* shown.
*/
vc(C0, 4.1666666666666504759E-2 ,aaaa,3e2a,a9f0,aaaa, -4, .AAAAAAAAAAA9F0)
vc(C1, -1.3888888888865302059E-3 ,0b60,bbb6,0cca,b60a, -9, -.B60B60B60A0CCA)
vc(C2, 2.4801587285601038265E-5 ,0d00,38d0,098f,cdcd, -15, .D00D00CDCD098F)
vc(C3, -2.7557313470902390219E-7 ,f27b,b593,e805,b593, -21, -.93F27BB593E805)
vc(C4, 2.0875623401082232009E-9 ,74c8,320f,3ff0,fa1e, -28, .8F74C8FA1E3FF0)
vc(C5, -1.1355178117642986178E-11 ,c32d,ae47,5a63,0a5c, -36, -.C7C32D0A5C5A63)
ic(C0, 4.1666666666666504759E-2 , -5, 1.555555555553E)
ic(C1, -1.3888888888865301516E-3 , -10, -1.6C16C16C14199)
ic(C2, 2.4801587269650015769E-5 , -16, 1.A01A01971CAEB)
ic(C3, -2.7557304623183959811E-7 , -22, -1.27E4F1314AD1A)
ic(C4, 2.0873958177697780076E-9 , -29, 1.1EE3B60DDDC8C)
ic(C5, -1.1250289076471311557E-11 , -37, -1.8BD5986B2A52E)
#ifdef vccast
#define C0 vccast(C0)
#define C1 vccast(C1)
#define C2 vccast(C2)
#define C3 vccast(C3)
#define C4 vccast(C4)
#define C5 vccast(C5)
#endif
#define cos__C(z) (z*z*(C0+z*(C1+z*(C2+z*(C3+z*(C4+z*C5))))))

View File

@@ -0,0 +1,153 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)expm1.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* EXPM1(X)
* RETURN THE EXPONENTIAL OF X MINUS ONE
* DOUBLE PRECISION (IEEE 53 BITS, VAX D FORMAT 56 BITS)
* CODED IN C BY K.C. NG, 1/19/85;
* REVISED BY K.C. NG on 2/6/85, 3/7/85, 3/21/85, 4/16/85.
*
* Required system supported functions:
* scalb(x,n)
* copysign(x,y)
* finite(x)
*
* Kernel function:
* exp__E(x,c)
*
* Method:
* 1. Argument Reduction: given the input x, find r and integer k such
* that
* x = k*ln2 + r, |r| <= 0.5*ln2 .
* r will be represented as r := z+c for better accuracy.
*
* 2. Compute EXPM1(r)=exp(r)-1 by
*
* EXPM1(r=z+c) := z + exp__E(z,c)
*
* 3. EXPM1(x) = 2^k * ( EXPM1(r) + 1-2^-k ).
*
* Remarks:
* 1. When k=1 and z < -0.25, we use the following formula for
* better accuracy:
* EXPM1(x) = 2 * ( (z+0.5) + exp__E(z,c) )
* 2. To avoid rounding error in 1-2^-k where k is large, we use
* EXPM1(x) = 2^k * { [z+(exp__E(z,c)-2^-k )] + 1 }
* when k>56.
*
* Special cases:
* EXPM1(INF) is INF, EXPM1(NaN) is NaN;
* EXPM1(-INF)= -1;
* for finite argument, only EXPM1(0)=0 is exact.
*
* Accuracy:
* EXPM1(x) returns the exact (exp(x)-1) nearly rounded. In a test run with
* 1,166,000 random arguments on a VAX, the maximum observed error was
* .872 ulps (units of the last place).
*
* Constants:
* The hexadecimal values are the intended ones for the following constants.
* The decimal values may be used, provided that the compiler will convert
* from decimal to binary accurately enough to produce the hexadecimal values
* shown.
*/
#include "mathimpl.h"
vc(ln2hi, 6.9314718055829871446E-1 ,7217,4031,0000,f7d0, 0, .B17217F7D00000)
vc(ln2lo, 1.6465949582897081279E-12 ,bcd5,2ce7,d9cc,e4f1, -39, .E7BCD5E4F1D9CC)
vc(lnhuge, 9.4961163736712506989E1 ,ec1d,43bd,9010,a73e, 7, .BDEC1DA73E9010)
vc(invln2, 1.4426950408889634148E0 ,aa3b,40b8,17f1,295c, 1, .B8AA3B295C17F1)
ic(ln2hi, 6.9314718036912381649E-1, -1, 1.62E42FEE00000)
ic(ln2lo, 1.9082149292705877000E-10, -33, 1.A39EF35793C76)
ic(lnhuge, 7.1602103751842355450E2, 9, 1.6602B15B7ECF2)
ic(invln2, 1.4426950408889633870E0, 0, 1.71547652B82FE)
#ifdef vccast
#define ln2hi vccast(ln2hi)
#define ln2lo vccast(ln2lo)
#define lnhuge vccast(lnhuge)
#define invln2 vccast(invln2)
#endif
double expm1(x)
double x;
{
const static double one=1.0, half=1.0/2.0;
double z,hi,lo,c;
int k;
#if defined(vax)||defined(tahoe)
static prec=56;
#else /* defined(vax)||defined(tahoe) */
static prec=53;
#endif /* defined(vax)||defined(tahoe) */
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
if( x <= lnhuge ) {
if( x >= -40.0 ) {
/* argument reduction : x - k*ln2 */
k= invln2 *x+copysign(0.5,x); /* k=NINT(x/ln2) */
hi=x-k*ln2hi ;
z=hi-(lo=k*ln2lo);
c=(hi-z)-lo;
if(k==0) return(z+exp__E(z,c));
if(k==1)
if(z< -0.25)
{x=z+half;x +=exp__E(z,c); return(x+x);}
else
{z+=exp__E(z,c); x=half+z; return(x+x);}
/* end of k=1 */
else {
if(k<=prec)
{ x=one-scalb(one,-k); z += exp__E(z,c);}
else if(k<100)
{ x = exp__E(z,c)-scalb(one,-k); x+=z; z=one;}
else
{ x = exp__E(z,c)+z; z=one;}
return (scalb(x+z,k));
}
}
/* end of x > lnunfl */
else
/* expm1(-big#) rounded to -1 (inexact) */
if(finite(x))
{ ln2hi+ln2lo; return(-one);}
/* expm1(-INF) is -1 */
else return(-one);
}
/* end of x < lnhuge */
else
/* expm1(INF) is INF, expm1(+big#) overflows to INF */
return( finite(x) ? scalb(one,5000) : x);
}

View File

@@ -0,0 +1,88 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)acosh.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* ACOSH(X)
* RETURN THE INVERSE HYPERBOLIC COSINE OF X
* DOUBLE PRECISION (VAX D FORMAT 56 BITS, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 2/16/85;
* REVISED BY K.C. NG on 3/6/85, 3/24/85, 4/16/85, 8/17/85.
*
* Required system supported functions :
* sqrt(x)
*
* Required kernel function:
* log1p(x) ...return log(1+x)
*
* Method :
* Based on
* acosh(x) = log [ x + sqrt(x*x-1) ]
* we have
* acosh(x) := log1p(x)+ln2, if (x > 1.0E20); else
* acosh(x) := log1p( sqrt(x-1) * (sqrt(x-1) + sqrt(x+1)) ) .
* These formulae avoid the over/underflow complication.
*
* Special cases:
* acosh(x) is NaN with signal if x<1.
* acosh(NaN) is NaN without signal.
*
* Accuracy:
* acosh(x) returns the exact inverse hyperbolic cosine of x nearly
* rounded. In a test run with 512,000 random arguments on a VAX, the
* maximum observed error was 3.30 ulps (units of the last place) at
* x=1.0070493753568216 .
*
* Constants:
* The hexadecimal values are the intended ones for the following constants.
* The decimal values may be used, provided that the compiler will convert
* from decimal to binary accurately enough to produce the hexadecimal values
* shown.
*/
#include "mathimpl.h"
vc(ln2hi, 6.9314718055829871446E-1 ,7217,4031,0000,f7d0, 0, .B17217F7D00000)
vc(ln2lo, 1.6465949582897081279E-12 ,bcd5,2ce7,d9cc,e4f1, -39, .E7BCD5E4F1D9CC)
ic(ln2hi, 6.9314718036912381649E-1, -1, 1.62E42FEE00000)
ic(ln2lo, 1.9082149292705877000E-10,-33, 1.A39EF35793C76)
#ifdef vccast
#define ln2hi vccast(ln2hi)
#define ln2lo vccast(ln2lo)
#endif
double acosh(x)
double x;
{
double t,big=1.E20; /* big+1==big */
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
/* return log1p(x) + log(2) if x is large */
if(x>big) {t=log1p(x)+ln2lo; return(t+ln2hi);}
t=sqrt(x-1.0);
return(log1p(t*(t+sqrt(x+1.0))));
}

View File

@@ -0,0 +1,155 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)asincos.c 5.5 (Berkeley) 10/9/90";
#endif /* not lint */
/* ASIN(X)
* RETURNS ARC SINE OF X
* DOUBLE PRECISION (IEEE DOUBLE 53 bits, VAX D FORMAT 56 bits)
* CODED IN C BY K.C. NG, 4/16/85, REVISED ON 6/10/85.
*
* Required system supported functions:
* copysign(x,y)
* sqrt(x)
*
* Required kernel function:
* atan2(y,x)
*
* Method :
* asin(x) = atan2(x,sqrt(1-x*x)); for better accuracy, 1-x*x is
* computed as follows
* 1-x*x if x < 0.5,
* 2*(1-|x|)-(1-|x|)*(1-|x|) if x >= 0.5.
*
* Special cases:
* if x is NaN, return x itself;
* if |x|>1, return NaN.
*
* Accuracy:
* 1) If atan2() uses machine PI, then
*
* asin(x) returns (PI/pi) * (the exact arc sine of x) nearly rounded;
* and PI is the exact pi rounded to machine precision (see atan2 for
* details):
*
* in decimal:
* pi = 3.141592653589793 23846264338327 .....
* 53 bits PI = 3.141592653589793 115997963 ..... ,
* 56 bits PI = 3.141592653589793 227020265 ..... ,
*
* in hexadecimal:
* pi = 3.243F6A8885A308D313198A2E....
* 53 bits PI = 3.243F6A8885A30 = 2 * 1.921FB54442D18 error=.276ulps
* 56 bits PI = 3.243F6A8885A308 = 4 * .C90FDAA22168C2 error=.206ulps
*
* In a test run with more than 200,000 random arguments on a VAX, the
* maximum observed error in ulps (units in the last place) was
* 2.06 ulps. (comparing against (PI/pi)*(exact asin(x)));
*
* 2) If atan2() uses true pi, then
*
* asin(x) returns the exact asin(x) with error below about 2 ulps.
*
* In a test run with more than 1,024,000 random arguments on a VAX, the
* maximum observed error in ulps (units in the last place) was
* 1.99 ulps.
*/
double asin(x)
double x;
{
double s,t,copysign(),atan2(),sqrt(),one=1.0;
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
s=copysign(x,one);
if(s <= 0.5)
return(atan2(x,sqrt(one-x*x)));
else
{ t=one-s; s=t+t; return(atan2(x,sqrt(s-t*t))); }
}
/* ACOS(X)
* RETURNS ARC COS OF X
* DOUBLE PRECISION (IEEE DOUBLE 53 bits, VAX D FORMAT 56 bits)
* CODED IN C BY K.C. NG, 4/16/85, REVISED ON 6/10/85.
*
* Required system supported functions:
* copysign(x,y)
* sqrt(x)
*
* Required kernel function:
* atan2(y,x)
*
* Method :
* ________
* / 1 - x
* acos(x) = 2*atan2( / -------- , 1 ) .
* \/ 1 + x
*
* Special cases:
* if x is NaN, return x itself;
* if |x|>1, return NaN.
*
* Accuracy:
* 1) If atan2() uses machine PI, then
*
* acos(x) returns (PI/pi) * (the exact arc cosine of x) nearly rounded;
* and PI is the exact pi rounded to machine precision (see atan2 for
* details):
*
* in decimal:
* pi = 3.141592653589793 23846264338327 .....
* 53 bits PI = 3.141592653589793 115997963 ..... ,
* 56 bits PI = 3.141592653589793 227020265 ..... ,
*
* in hexadecimal:
* pi = 3.243F6A8885A308D313198A2E....
* 53 bits PI = 3.243F6A8885A30 = 2 * 1.921FB54442D18 error=.276ulps
* 56 bits PI = 3.243F6A8885A308 = 4 * .C90FDAA22168C2 error=.206ulps
*
* In a test run with more than 200,000 random arguments on a VAX, the
* maximum observed error in ulps (units in the last place) was
* 2.07 ulps. (comparing against (PI/pi)*(exact acos(x)));
*
* 2) If atan2() uses true pi, then
*
* acos(x) returns the exact acos(x) with error below about 2 ulps.
*
* In a test run with more than 1,024,000 random arguments on a VAX, the
* maximum observed error in ulps (units in the last place) was
* 2.15 ulps.
*/
double acos(x)
double x;
{
double t,copysign(),atan2(),sqrt(),one=1.0;
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x);
#endif /* !defined(vax)&&!defined(tahoe) */
if( x != -1.0)
t=atan2(sqrt((one-x)/(one+x)),one);
else
t=atan2(one,0.0); /* t = PI/2 */
return(t+t);
}

View File

@@ -0,0 +1,87 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)asinh.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* ASINH(X)
* RETURN THE INVERSE HYPERBOLIC SINE OF X
* DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 2/16/85;
* REVISED BY K.C. NG on 3/7/85, 3/24/85, 4/16/85.
*
* Required system supported functions :
* copysign(x,y)
* sqrt(x)
*
* Required kernel function:
* log1p(x) ...return log(1+x)
*
* Method :
* Based on
* asinh(x) = sign(x) * log [ |x| + sqrt(x*x+1) ]
* we have
* asinh(x) := x if 1+x*x=1,
* := sign(x)*(log1p(x)+ln2)) if sqrt(1+x*x)=x, else
* := sign(x)*log1p(|x| + |x|/(1/|x| + sqrt(1+(1/|x|)^2)) )
*
* Accuracy:
* asinh(x) returns the exact inverse hyperbolic sine of x nearly rounded.
* In a test run with 52,000 random arguments on a VAX, the maximum
* observed error was 1.58 ulps (units in the last place).
*
* Constants:
* The hexadecimal values are the intended ones for the following constants.
* The decimal values may be used, provided that the compiler will convert
* from decimal to binary accurately enough to produce the hexadecimal values
* shown.
*/
#include "mathimpl.h"
vc(ln2hi, 6.9314718055829871446E-1 ,7217,4031,0000,f7d0, 0, .B17217F7D00000)
vc(ln2lo, 1.6465949582897081279E-12 ,bcd5,2ce7,d9cc,e4f1, -39, .E7BCD5E4F1D9CC)
ic(ln2hi, 6.9314718036912381649E-1, -1, 1.62E42FEE00000)
ic(ln2lo, 1.9082149292705877000E-10, -33, 1.A39EF35793C76)
#ifdef vccast
#define ln2hi vccast(ln2hi)
#define ln2lo vccast(ln2lo)
#endif
double asinh(x)
double x;
{
double t,s;
const static double small=1.0E-10, /* fl(1+small*small) == 1 */
big =1.0E20, /* fl(1+big) == big */
one =1.0 ;
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
if((t=copysign(x,one))>small)
if(t<big) {
s=one/t; return(copysign(log1p(t+t/(s+sqrt(one+s*s))),x)); }
else /* if |x| > big */
{s=log1p(t)+ln2lo; return(copysign(s+ln2hi,x));}
else /* if |x| < small */
return(x);
}

View File

@@ -0,0 +1,73 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)atan.c 5.5 (Berkeley) 10/9/90";
#endif /* not lint */
/* ATAN(X)
* RETURNS ARC TANGENT OF X
* DOUBLE PRECISION (IEEE DOUBLE 53 bits, VAX D FORMAT 56 bits)
* CODED IN C BY K.C. NG, 4/16/85, REVISED ON 6/10/85.
*
* Required kernel function:
* atan2(y,x)
*
* Method:
* atan(x) = atan2(x,1.0).
*
* Special case:
* if x is NaN, return x itself.
*
* Accuracy:
* 1) If atan2() uses machine PI, then
*
* atan(x) returns (PI/pi) * (the exact arc tangent of x) nearly rounded;
* and PI is the exact pi rounded to machine precision (see atan2 for
* details):
*
* in decimal:
* pi = 3.141592653589793 23846264338327 .....
* 53 bits PI = 3.141592653589793 115997963 ..... ,
* 56 bits PI = 3.141592653589793 227020265 ..... ,
*
* in hexadecimal:
* pi = 3.243F6A8885A308D313198A2E....
* 53 bits PI = 3.243F6A8885A30 = 2 * 1.921FB54442D18 error=.276ulps
* 56 bits PI = 3.243F6A8885A308 = 4 * .C90FDAA22168C2 error=.206ulps
*
* In a test run with more than 200,000 random arguments on a VAX, the
* maximum observed error in ulps (units in the last place) was
* 0.86 ulps. (comparing against (PI/pi)*(exact atan(x))).
*
* 2) If atan2() uses true pi, then
*
* atan(x) returns the exact atan(x) with error below about 2 ulps.
*
* In a test run with more than 1,024,000 random arguments on a VAX, the
* maximum observed error in ulps (units in the last place) was
* 0.85 ulps.
*/
double atan(x)
double x;
{
double atan2(),one=1.0;
return(atan2(x,one));
}

View File

@@ -0,0 +1,69 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)atanh.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* ATANH(X)
* RETURN THE HYPERBOLIC ARC TANGENT OF X
* DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 1/8/85;
* REVISED BY K.C. NG on 2/7/85, 3/7/85, 8/18/85.
*
* Required kernel function:
* log1p(x) ...return log(1+x)
*
* Method :
* Return
* 1 2x x
* atanh(x) = --- * log(1 + -------) = 0.5 * log1p(2 * --------)
* 2 1 - x 1 - x
*
* Special cases:
* atanh(x) is NaN if |x| > 1 with signal;
* atanh(NaN) is that NaN with no signal;
* atanh(+-1) is +-INF with signal.
*
* Accuracy:
* atanh(x) returns the exact hyperbolic arc tangent of x nearly rounded.
* In a test run with 512,000 random arguments on a VAX, the maximum
* observed error was 1.87 ulps (units in the last place) at
* x= -3.8962076028810414000e-03.
*/
#include "mathimpl.h"
#if defined(vax)||defined(tahoe)
#include <errno.h>
#endif /* defined(vax)||defined(tahoe) */
double atanh(x)
double x;
{
double z;
z = copysign(0.5,x);
x = copysign(x,1.0);
#if defined(vax)||defined(tahoe)
if (x == 1.0) {
return(copysign(1.0,z)*infnan(ERANGE)); /* sign(x)*INF */
}
#endif /* defined(vax)||defined(tahoe) */
x = x/(1.0-x);
return( z*log1p(x+x) );
}

View File

@@ -0,0 +1,119 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)cosh.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* COSH(X)
* RETURN THE HYPERBOLIC COSINE OF X
* DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 1/8/85;
* REVISED BY K.C. NG on 2/8/85, 2/23/85, 3/7/85, 3/29/85, 4/16/85.
*
* Required system supported functions :
* copysign(x,y)
* scalb(x,N)
*
* Required kernel function:
* exp(x)
* exp__E(x,c) ...return exp(x+c)-1-x for |x|<0.3465
*
* Method :
* 1. Replace x by |x|.
* 2.
* [ exp(x) - 1 ]^2
* 0 <= x <= 0.3465 : cosh(x) := 1 + -------------------
* 2*exp(x)
*
* exp(x) + 1/exp(x)
* 0.3465 <= x <= 22 : cosh(x) := -------------------
* 2
* 22 <= x <= lnovfl : cosh(x) := exp(x)/2
* lnovfl <= x <= lnovfl+log(2)
* : cosh(x) := exp(x)/2 (avoid overflow)
* log(2)+lnovfl < x < INF: overflow to INF
*
* Note: .3465 is a number near one half of ln2.
*
* Special cases:
* cosh(x) is x if x is +INF, -INF, or NaN.
* only cosh(0)=1 is exact for finite x.
*
* Accuracy:
* cosh(x) returns the exact hyperbolic cosine of x nearly rounded.
* In a test run with 768,000 random arguments on a VAX, the maximum
* observed error was 1.23 ulps (units in the last place).
*
* Constants:
* The hexadecimal values are the intended ones for the following constants.
* The decimal values may be used, provided that the compiler will convert
* from decimal to binary accurately enough to produce the hexadecimal values
* shown.
*/
#include "mathimpl.h"
vc(mln2hi, 8.8029691931113054792E1 ,0f33,43b0,2bdb,c7e2, 7, .B00F33C7E22BDB)
vc(mln2lo,-4.9650192275318476525E-16 ,1b60,a70f,582a,279e, -50,-.8F1B60279E582A)
vc(lnovfl, 8.8029691931113053016E1 ,0f33,43b0,2bda,c7e2, 7, .B00F33C7E22BDA)
ic(mln2hi, 7.0978271289338397310E2, 10, 1.62E42FEFA39EF)
ic(mln2lo, 2.3747039373786107478E-14, -45, 1.ABC9E3B39803F)
ic(lnovfl, 7.0978271289338397310E2, 9, 1.62E42FEFA39EF)
#ifdef vccast
#define mln2hi vccast(mln2hi)
#define mln2lo vccast(mln2lo)
#define lnovfl vccast(lnovfl)
#endif
#if defined(vax)||defined(tahoe)
static max = 126 ;
#else /* defined(vax)||defined(tahoe) */
static max = 1023 ;
#endif /* defined(vax)||defined(tahoe) */
double cosh(x)
double x;
{
static const double half=1.0/2.0,
one=1.0, small=1.0E-18; /* fl(1+small)==1 */
double t;
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
if((x=copysign(x,one)) <= 22)
if(x<0.3465)
if(x<small) return(one+x);
else {t=x+exp__E(x,0.0);x=t+t; return(one+t*t/(2.0+x)); }
else /* for x lies in [0.3465,22] */
{ t=exp(x); return((t+one/t)*half); }
if( lnovfl <= x && x <= (lnovfl+0.7))
/* for x lies in [lnovfl, lnovfl+ln2], decrease x by ln(2^(max+1))
* and return 2^max*exp(x) to avoid unnecessary overflow
*/
return(scalb(exp((x-mln2hi)-mln2lo), max));
else
return(exp(x)*half); /* for large x, cosh(x)=exp(x)/2 */
}

View File

@@ -0,0 +1,144 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)exp.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* EXP(X)
* RETURN THE EXPONENTIAL OF X
* DOUBLE PRECISION (IEEE 53 bits, VAX D FORMAT 56 BITS)
* CODED IN C BY K.C. NG, 1/19/85;
* REVISED BY K.C. NG on 2/6/85, 2/15/85, 3/7/85, 3/24/85, 4/16/85, 6/14/86.
*
* Required system supported functions:
* scalb(x,n)
* copysign(x,y)
* finite(x)
*
* Method:
* 1. Argument Reduction: given the input x, find r and integer k such
* that
* x = k*ln2 + r, |r| <= 0.5*ln2 .
* r will be represented as r := z+c for better accuracy.
*
* 2. Compute exp(r) by
*
* exp(r) = 1 + r + r*R1/(2-R1),
* where
* R1 = x - x^2*(p1+x^2*(p2+x^2*(p3+x^2*(p4+p5*x^2)))).
*
* 3. exp(x) = 2^k * exp(r) .
*
* Special cases:
* exp(INF) is INF, exp(NaN) is NaN;
* exp(-INF)= 0;
* for finite argument, only exp(0)=1 is exact.
*
* Accuracy:
* exp(x) returns the exponential of x nearly rounded. In a test run
* with 1,156,000 random arguments on a VAX, the maximum observed
* error was 0.869 ulps (units in the last place).
*
* Constants:
* The hexadecimal values are the intended ones for the following constants.
* The decimal values may be used, provided that the compiler will convert
* from decimal to binary accurately enough to produce the hexadecimal values
* shown.
*/
#include "mathimpl.h"
vc(ln2hi, 6.9314718055829871446E-1 ,7217,4031,0000,f7d0, 0, .B17217F7D00000)
vc(ln2lo, 1.6465949582897081279E-12 ,bcd5,2ce7,d9cc,e4f1, -39, .E7BCD5E4F1D9CC)
vc(lnhuge, 9.4961163736712506989E1 ,ec1d,43bd,9010,a73e, 7, .BDEC1DA73E9010)
vc(lntiny,-9.5654310917272452386E1 ,4f01,c3bf,33af,d72e, 7,-.BF4F01D72E33AF)
vc(invln2, 1.4426950408889634148E0 ,aa3b,40b8,17f1,295c, 1, .B8AA3B295C17F1)
vc(p1, 1.6666666666666602251E-1 ,aaaa,3f2a,a9f1,aaaa, -2, .AAAAAAAAAAA9F1)
vc(p2, -2.7777777777015591216E-3 ,0b60,bc36,ec94,b5f5, -8,-.B60B60B5F5EC94)
vc(p3, 6.6137563214379341918E-5 ,b355,398a,f15f,792e, -13, .8AB355792EF15F)
vc(p4, -1.6533902205465250480E-6 ,ea0e,b6dd,5f84,2e93, -19,-.DDEA0E2E935F84)
vc(p5, 4.1381367970572387085E-8 ,bb4b,3431,2683,95f5, -24, .B1BB4B95F52683)
#ifdef vccast
#define ln2hi vccast(ln2hi)
#define ln2lo vccast(ln2lo)
#define lnhuge vccast(lnhuge)
#define lntiny vccast(lntiny)
#define invln2 vccast(invln2)
#define p1 vccast(p1)
#define p2 vccast(p2)
#define p3 vccast(p3)
#define p4 vccast(p4)
#define p5 vccast(p5)
#endif
ic(p1, 1.6666666666666601904E-1, -3, 1.555555555553E)
ic(p2, -2.7777777777015593384E-3, -9, -1.6C16C16BEBD93)
ic(p3, 6.6137563214379343612E-5, -14, 1.1566AAF25DE2C)
ic(p4, -1.6533902205465251539E-6, -20, -1.BBD41C5D26BF1)
ic(p5, 4.1381367970572384604E-8, -25, 1.6376972BEA4D0)
ic(ln2hi, 6.9314718036912381649E-1, -1, 1.62E42FEE00000)
ic(ln2lo, 1.9082149292705877000E-10,-33, 1.A39EF35793C76)
ic(lnhuge, 7.1602103751842355450E2, 9, 1.6602B15B7ECF2)
ic(lntiny,-7.5137154372698068983E2, 9, -1.77AF8EBEAE354)
ic(invln2, 1.4426950408889633870E0, 0, 1.71547652B82FE)
double exp(x)
double x;
{
double z,hi,lo,c;
int k;
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
if( x <= lnhuge ) {
if( x >= lntiny ) {
/* argument reduction : x --> x - k*ln2 */
k=invln2*x+copysign(0.5,x); /* k=NINT(x/ln2) */
/* express x-k*ln2 as hi-lo and let x=hi-lo rounded */
hi=x-k*ln2hi;
x=hi-(lo=k*ln2lo);
/* return 2^k*[1+x+x*c/(2+c)] */
z=x*x;
c= x - z*(p1+z*(p2+z*(p3+z*(p4+z*p5))));
return scalb(1.0+(hi-(lo-(x*c)/(2.0-c))),k);
}
/* end of x > lntiny */
else
/* exp(-big#) underflows to zero */
if(finite(x)) return(scalb(1.0,-5000));
/* exp(-INF) is zero */
else return(0.0);
}
/* end of x < lnhuge */
else
/* exp(INF) is INF, exp(+big#) overflows to INF */
return( finite(x) ? scalb(1.0,5000) : x);
}

View File

@@ -0,0 +1,122 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)exp__E.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* exp__E(x,c)
* ASSUMPTION: c << x SO THAT fl(x+c)=x.
* (c is the correction term for x)
* exp__E RETURNS
*
* / exp(x+c) - 1 - x , 1E-19 < |x| < .3465736
* exp__E(x,c) = |
* \ 0 , |x| < 1E-19.
*
* DOUBLE PRECISION (IEEE 53 bits, VAX D FORMAT 56 BITS)
* KERNEL FUNCTION OF EXP, EXPM1, POW FUNCTIONS
* CODED IN C BY K.C. NG, 1/31/85;
* REVISED BY K.C. NG on 3/16/85, 4/16/85.
*
* Required system supported function:
* copysign(x,y)
*
* Method:
* 1. Rational approximation. Let r=x+c.
* Based on
* 2 * sinh(r/2)
* exp(r) - 1 = ---------------------- ,
* cosh(r/2) - sinh(r/2)
* exp__E(r) is computed using
* x*x (x/2)*W - ( Q - ( 2*P + x*P ) )
* --- + (c + x*[---------------------------------- + c ])
* 2 1 - W
* where P := p1*x^2 + p2*x^4,
* Q := q1*x^2 + q2*x^4 (for 56 bits precision, add q3*x^6)
* W := x/2-(Q-x*P),
*
* (See the listing below for the values of p1,p2,q1,q2,q3. The poly-
* nomials P and Q may be regarded as the approximations to sinh
* and cosh :
* sinh(r/2) = r/2 + r * P , cosh(r/2) = 1 + Q . )
*
* The coefficients were obtained by a special Remez algorithm.
*
* Approximation error:
*
* | exp(x) - 1 | 2**(-57), (IEEE double)
* | ------------ - (exp__E(x,0)+x)/x | <=
* | x | 2**(-69). (VAX D)
*
* Constants:
* The hexadecimal values are the intended ones for the following constants.
* The decimal values may be used, provided that the compiler will convert
* from decimal to binary accurately enough to produce the hexadecimal values
* shown.
*/
#include "mathimpl.h"
vc(p1, 1.5150724356786683059E-2 ,3abe,3d78,066a,67e1, -6, .F83ABE67E1066A)
vc(p2, 6.3112487873718332688E-5 ,5b42,3984,0173,48cd, -13, .845B4248CD0173)
vc(q1, 1.1363478204690669916E-1 ,b95a,3ee8,ec45,44a2, -3, .E8B95A44A2EC45)
vc(q2, 1.2624568129896839182E-3 ,7905,3ba5,f5e7,72e4, -9, .A5790572E4F5E7)
vc(q3, 1.5021856115869022674E-6 ,9eb4,36c9,c395,604a, -19, .C99EB4604AC395)
ic(p1, 1.3887401997267371720E-2, -7, 1.C70FF8B3CC2CF)
ic(p2, 3.3044019718331897649E-5, -15, 1.15317DF4526C4)
ic(q1, 1.1110813732786649355E-1, -4, 1.C719538248597)
ic(q2, 9.9176615021572857300E-4, -10, 1.03FC4CB8C98E8)
#ifdef vccast
#define p1 vccast(p1)
#define p2 vccast(p2)
#define q1 vccast(q1)
#define q2 vccast(q2)
#define q3 vccast(q3)
#endif
double exp__E(x,c)
double x,c;
{
const static double zero=0.0, one=1.0, half=1.0/2.0, small=1.0E-19;
double z,p,q,xp,xh,w;
if(copysign(x,one)>small) {
z = x*x ;
p = z*( p1 +z* p2 );
#if defined(vax)||defined(tahoe)
q = z*( q1 +z*( q2 +z* q3 ));
#else /* defined(vax)||defined(tahoe) */
q = z*( q1 +z* q2 );
#endif /* defined(vax)||defined(tahoe) */
xp= x*p ;
xh= x*half ;
w = xh-(q-xp) ;
p = p+p;
c += x*((xh*w-(q-(p+xp)))/(one-w)+c);
return(z*half+c);
}
/* end of |x| > small */
else {
if(x!=zero) one+small; /* raise the inexact flag */
return(copysign(zero,x));
}
}

View File

@@ -0,0 +1,126 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)floor.c 5.7 (Berkeley) 10/9/90";
#endif /* not lint */
#include "mathimpl.h"
vc(L, 4503599627370496.0E0 ,0000,5c00,0000,0000, 55, 1.0) /* 2**55 */
ic(L, 4503599627370496.0E0, 52, 1.0) /* 2**52 */
#ifdef vccast
#define L vccast(L)
#endif
double ceil();
double floor();
/*
* floor(x) := the largest integer no larger than x;
* ceil(x) := -floor(-x), for all real x.
*
* Note: Inexact will be signaled if x is not an integer, as is
* customary for IEEE 754. No other signal can be emitted.
*/
double
floor(x)
double x;
{
double y;
if (
#if !defined(vax)&&!defined(tahoe)
x != x || /* NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
x >= L) /* already an even integer */
return x;
else if (x < (double)0)
return -ceil(-x);
else { /* now 0 <= x < L */
y = L+x; /* destructive store must be forced */
y -= L; /* an integer, and |x-y| < 1 */
return x < y ? y-(double)1 : y;
}
}
double
ceil(x)
double x;
{
double y;
if (
#if !defined(vax)&&!defined(tahoe)
x != x || /* NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
x >= L) /* already an even integer */
return x;
else if (x < (double)0)
return -floor(-x);
else { /* now 0 <= x < L */
y = L+x; /* destructive store must be forced */
y -= L; /* an integer, and |x-y| < 1 */
return x > y ? y+(double)1 : y;
}
}
#ifndef national /* rint() is in ./NATIONAL/support.s */
/*
* algorithm for rint(x) in pseudo-pascal form ...
*
* real rint(x): real x;
* ... delivers integer nearest x in direction of prevailing rounding
* ... mode
* const L = (last consecutive integer)/2
* = 2**55; for VAX D
* = 2**52; for IEEE 754 Double
* real s,t;
* begin
* if x != x then return x; ... NaN
* if |x| >= L then return x; ... already an integer
* s := copysign(L,x);
* t := x + s; ... = (x+s) rounded to integer
* return t - s
* end;
*
* Note: Inexact will be signaled if x is not an integer, as is
* customary for IEEE 754. No other signal can be emitted.
*/
double
__rint(x)
double x;
{
double s,t;
const double one = 1.0;
#if !defined(vax)&&!defined(tahoe)
if (x != x) /* NaN */
return (x);
#endif /* !defined(vax)&&!defined(tahoe) */
if (copysign(x,one) >= L) /* already an integer */
return (x);
s = copysign(L,x);
t = x + s; /* x+s rounded to integer */
return (t - s);
}
#endif /* not national */

View File

@@ -0,0 +1,143 @@
/*
* Copyright (c) 1989 The Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted
* provided that: (1) source distributions retain this entire copyright
* notice and comment, and (2) distributions including binaries display
* the following acknowledgement: ``This product includes software
* developed by the University of California, Berkeley and its contributors''
* in the documentation or other materials provided with the distribution
* and in all advertising materials mentioning features or use of this
* software. Neither the name of the University nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)fmod.c 5.2 (Berkeley) 6/1/90";
#endif /* not lint */
/* fmod.c
*
* SYNOPSIS
*
* #include <math.h>
* double fmod(double x, double y)
*
* DESCRIPTION
*
* The fmod function computes the floating-point remainder of x/y.
*
* RETURNS
*
* The fmod function returns the value x-i*y, for some integer i
* such that, if y is nonzero, the result has the same sign as x and
* magnitude less than the magnitude of y.
*
* On a VAX or CCI,
*
* fmod(x,0) traps/faults on floating-point divided-by-zero.
*
* On IEEE-754 conforming machines with "isnan()" primitive,
*
* fmod(x,0), fmod(INF,y) are invalid operations and NaN is returned.
*
*/
#include "mathimpl.h"
#if !defined(vax) && !defined(tahoe)
extern int isnan(),finite();
#endif /* !defined(vax) && !defined(tahoe) */
extern double frexp(),ldexp(),fabs();
#ifdef TEST_FMOD
static double
_fmod(x,y)
#else /* TEST_FMOD */
double
fmod(x,y)
#endif /* TEST_FMOD */
double x,y;
{
int ir,iy;
double r,w;
if (y == (double)0
#if !defined(vax) && !defined(tahoe) /* per "fmod" manual entry, SunOS 4.0 */
|| isnan(y) || !finite(x)
#endif /* !defined(vax) && !defined(tahoe) */
)
return (x*y)/(x*y);
r = fabs(x);
y = fabs(y);
(void)frexp(y,&iy);
while (r >= y) {
(void)frexp(r,&ir);
w = ldexp(y,ir-iy);
r -= w <= r ? w : w*(double)0.5;
}
return x >= (double)0 ? r : -r;
}
#ifdef TEST_FMOD
extern long random();
extern double fmod();
#define NTEST 10000
#define NCASES 3
static int nfail = 0;
static void
doit(x,y)
double x,y;
{
double ro = fmod(x,y),rn = _fmod(x,y);
if (ro != rn) {
(void)printf(" x = 0x%08.8x %08.8x (%24.16e)\n",x,x);
(void)printf(" y = 0x%08.8x %08.8x (%24.16e)\n",y,y);
(void)printf(" fmod = 0x%08.8x %08.8x (%24.16e)\n",ro,ro);
(void)printf("_fmod = 0x%08.8x %08.8x (%24.16e)\n",rn,rn);
(void)printf("\n");
}
}
main()
{
register int i,cases;
double x,y;
srandom(12345);
for (i = 0; i < NTEST; i++) {
x = (double)random();
y = (double)random();
for (cases = 0; cases < NCASES; cases++) {
switch (cases) {
case 0:
break;
case 1:
y = (double)1/y; break;
case 2:
x = (double)1/x; break;
default:
abort(); break;
}
doit(x,y);
doit(x,-y);
doit(-x,y);
doit(-x,-y);
}
}
if (nfail)
(void)printf("Number of failures: %d (out of a total of %d)\n",
nfail,NTEST*NCASES*4);
else
(void)printf("No discrepancies were found\n");
exit(0);
}
#endif /* TEST_FMOD */

View File

@@ -0,0 +1,149 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)log.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* LOG(X)
* RETURN THE LOGARITHM OF x
* DOUBLE PRECISION (VAX D FORMAT 56 bits or IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 1/19/85;
* REVISED BY K.C. NG on 2/7/85, 3/7/85, 3/24/85, 4/16/85.
*
* Required system supported functions:
* scalb(x,n)
* copysign(x,y)
* logb(x)
* finite(x)
*
* Required kernel function:
* log__L(z)
*
* Method :
* 1. Argument Reduction: find k and f such that
* x = 2^k * (1+f),
* where sqrt(2)/2 < 1+f < sqrt(2) .
*
* 2. Let s = f/(2+f) ; based on log(1+f) = log(1+s) - log(1-s)
* = 2s + 2/3 s**3 + 2/5 s**5 + .....,
* log(1+f) is computed by
*
* log(1+f) = 2s + s*log__L(s*s)
* where
* log__L(z) = z*(L1 + z*(L2 + z*(... (L6 + z*L7)...)))
*
* See log__L() for the values of the coefficients.
*
* 3. Finally, log(x) = k*ln2 + log(1+f). (Here n*ln2 will be stored
* in two floating point number: n*ln2hi + n*ln2lo, n*ln2hi is exact
* since the last 20 bits of ln2hi is 0.)
*
* Special cases:
* log(x) is NaN with signal if x < 0 (including -INF) ;
* log(+INF) is +INF; log(0) is -INF with signal;
* log(NaN) is that NaN with no signal.
*
* Accuracy:
* log(x) returns the exact log(x) nearly rounded. In a test run with
* 1,536,000 random arguments on a VAX, the maximum observed error was
* .826 ulps (units in the last place).
*
* Constants:
* The hexadecimal values are the intended ones for the following constants.
* The decimal values may be used, provided that the compiler will convert
* from decimal to binary accurately enough to produce the hexadecimal values
* shown.
*/
#include <errno.h>
#include "mathimpl.h"
vc(ln2hi, 6.9314718055829871446E-1 ,7217,4031,0000,f7d0, 0, .B17217F7D00000)
vc(ln2lo, 1.6465949582897081279E-12 ,bcd5,2ce7,d9cc,e4f1, -39, .E7BCD5E4F1D9CC)
vc(sqrt2, 1.4142135623730950622E0 ,04f3,40b5,de65,33f9, 1, .B504F333F9DE65)
ic(ln2hi, 6.9314718036912381649E-1, -1, 1.62E42FEE00000)
ic(ln2lo, 1.9082149292705877000E-10, -33, 1.A39EF35793C76)
ic(sqrt2, 1.4142135623730951455E0, 0, 1.6A09E667F3BCD)
#ifdef vccast
#define ln2hi vccast(ln2hi)
#define ln2lo vccast(ln2lo)
#define sqrt2 vccast(sqrt2)
#endif
double log(x)
double x;
{
const static double zero=0.0, negone= -1.0, half=1.0/2.0;
double s,z,t;
int k,n;
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
if(finite(x)) {
if( x > zero ) {
/* argument reduction */
k=logb(x); x=scalb(x,-k);
if(k == -1022) /* subnormal no. */
{n=logb(x); x=scalb(x,-n); k+=n;}
if(x >= sqrt2 ) {k += 1; x *= half;}
x += negone ;
/* compute log(1+x) */
s=x/(2+x); t=x*x*half;
z=k*ln2lo+s*(t+log__L(s*s));
x += (z - t) ;
return(k*ln2hi+x);
}
/* end of if (x > zero) */
else {
#if defined(vax)||defined(tahoe)
if ( x == zero )
return (infnan(-ERANGE)); /* -INF */
else
return (infnan(EDOM)); /* NaN */
#else /* defined(vax)||defined(tahoe) */
/* zero argument, return -INF with signal */
if ( x == zero )
return( negone/zero );
/* negative argument, return NaN with signal */
else
return ( zero / zero );
#endif /* defined(vax)||defined(tahoe) */
}
}
/* end of if (finite(x)) */
/* NOTREACHED if defined(vax)||defined(tahoe) */
/* log(-INF) is NaN with signal */
else if (x<0)
return(zero/zero);
/* log(+INF) is +INF */
else return(x);
}

View File

@@ -0,0 +1,81 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)log10.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* LOG10(X)
* RETURN THE BASE 10 LOGARITHM OF x
* DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 1/20/85;
* REVISED BY K.C. NG on 1/23/85, 3/7/85, 4/16/85.
*
* Required kernel function:
* log(x)
*
* Method :
* log(x)
* log10(x) = --------- or [1/log(10)]*log(x)
* log(10)
*
* Note:
* [log(10)] rounded to 56 bits has error .0895 ulps,
* [1/log(10)] rounded to 53 bits has error .198 ulps;
* therefore, for better accuracy, in VAX D format, we divide
* log(x) by log(10), but in IEEE Double format, we multiply
* log(x) by [1/log(10)].
*
* Special cases:
* log10(x) is NaN with signal if x < 0;
* log10(+INF) is +INF with no signal; log10(0) is -INF with signal;
* log10(NaN) is that NaN with no signal.
*
* Accuracy:
* log10(X) returns the exact log10(x) nearly rounded. In a test run
* with 1,536,000 random arguments on a VAX, the maximum observed
* error was 1.74 ulps (units in the last place).
*
* Constants:
* The hexadecimal values are the intended ones for the following constants.
* The decimal values may be used, provided that the compiler will convert
* from decimal to binary accurately enough to produce the hexadecimal values
* shown.
*/
#include "mathimpl.h"
vc(ln10hi, 2.3025850929940456790E0 ,5d8d,4113,a8ac,ddaa, 2, .935D8DDDAAA8AC)
ic(ivln10, 4.3429448190325181667E-1, -2, 1.BCB7B1526E50E)
#ifdef vccast
#define ln10hi vccast(ln10hi)
#endif
double log10(x)
double x;
{
#if defined(vax)||defined(tahoe)
return(log(x)/ln10hi);
#else /* defined(vax)||defined(tahoe) */
return(ivln10*log(x));
#endif /* defined(vax)||defined(tahoe) */
}

View File

@@ -0,0 +1,156 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)log1p.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* LOG1P(x)
* RETURN THE LOGARITHM OF 1+x
* DOUBLE PRECISION (VAX D FORMAT 56 bits, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 1/19/85;
* REVISED BY K.C. NG on 2/6/85, 3/7/85, 3/24/85, 4/16/85.
*
* Required system supported functions:
* scalb(x,n)
* copysign(x,y)
* logb(x)
* finite(x)
*
* Required kernel function:
* log__L(z)
*
* Method :
* 1. Argument Reduction: find k and f such that
* 1+x = 2^k * (1+f),
* where sqrt(2)/2 < 1+f < sqrt(2) .
*
* 2. Let s = f/(2+f) ; based on log(1+f) = log(1+s) - log(1-s)
* = 2s + 2/3 s**3 + 2/5 s**5 + .....,
* log(1+f) is computed by
*
* log(1+f) = 2s + s*log__L(s*s)
* where
* log__L(z) = z*(L1 + z*(L2 + z*(... (L6 + z*L7)...)))
*
* See log__L() for the values of the coefficients.
*
* 3. Finally, log(1+x) = k*ln2 + log(1+f).
*
* Remarks 1. In step 3 n*ln2 will be stored in two floating point numbers
* n*ln2hi + n*ln2lo, where ln2hi is chosen such that the last
* 20 bits (for VAX D format), or the last 21 bits ( for IEEE
* double) is 0. This ensures n*ln2hi is exactly representable.
* 2. In step 1, f may not be representable. A correction term c
* for f is computed. It follows that the correction term for
* f - t (the leading term of log(1+f) in step 2) is c-c*x. We
* add this correction term to n*ln2lo to attenuate the error.
*
*
* Special cases:
* log1p(x) is NaN with signal if x < -1; log1p(NaN) is NaN with no signal;
* log1p(INF) is +INF; log1p(-1) is -INF with signal;
* only log1p(0)=0 is exact for finite argument.
*
* Accuracy:
* log1p(x) returns the exact log(1+x) nearly rounded. In a test run
* with 1,536,000 random arguments on a VAX, the maximum observed
* error was .846 ulps (units in the last place).
*
* Constants:
* The hexadecimal values are the intended ones for the following constants.
* The decimal values may be used, provided that the compiler will convert
* from decimal to binary accurately enough to produce the hexadecimal values
* shown.
*/
#include <errno.h>
#include "mathimpl.h"
vc(ln2hi, 6.9314718055829871446E-1 ,7217,4031,0000,f7d0, 0, .B17217F7D00000)
vc(ln2lo, 1.6465949582897081279E-12 ,bcd5,2ce7,d9cc,e4f1, -39, .E7BCD5E4F1D9CC)
vc(sqrt2, 1.4142135623730950622E0 ,04f3,40b5,de65,33f9, 1, .B504F333F9DE65)
ic(ln2hi, 6.9314718036912381649E-1, -1, 1.62E42FEE00000)
ic(ln2lo, 1.9082149292705877000E-10, -33, 1.A39EF35793C76)
ic(sqrt2, 1.4142135623730951455E0, 0, 1.6A09E667F3BCD)
#ifdef vccast
#define ln2hi vccast(ln2hi)
#define ln2lo vccast(ln2lo)
#define sqrt2 vccast(sqrt2)
#endif
double log1p(x)
double x;
{
const static double zero=0.0, negone= -1.0, one=1.0,
half=1.0/2.0, small=1.0E-20; /* 1+small == 1 */
double z,s,t,c;
int k;
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
if(finite(x)) {
if( x > negone ) {
/* argument reduction */
if(copysign(x,one)<small) return(x);
k=logb(one+x); z=scalb(x,-k); t=scalb(one,-k);
if(z+t >= sqrt2 )
{ k += 1 ; z *= half; t *= half; }
t += negone; x = z + t;
c = (t-x)+z ; /* correction term for x */
/* compute log(1+x) */
s = x/(2+x); t = x*x*half;
c += (k*ln2lo-c*x);
z = c+s*(t+log__L(s*s));
x += (z - t) ;
return(k*ln2hi+x);
}
/* end of if (x > negone) */
else {
#if defined(vax)||defined(tahoe)
if ( x == negone )
return (infnan(-ERANGE)); /* -INF */
else
return (infnan(EDOM)); /* NaN */
#else /* defined(vax)||defined(tahoe) */
/* x = -1, return -INF with signal */
if ( x == negone ) return( negone/zero );
/* negative argument for log, return NaN with signal */
else return ( zero / zero );
#endif /* defined(vax)||defined(tahoe) */
}
}
/* end of if (finite(x)) */
/* log(-INF) is NaN */
else if(x<0)
return(zero/zero);
/* log(+INF) is INF */
else return(x);
}

View File

@@ -0,0 +1,96 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)log__L.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* log__L(Z)
* LOG(1+X) - 2S X
* RETURN --------------- WHERE Z = S*S, S = ------- , 0 <= Z <= .0294...
* S 2 + X
*
* DOUBLE PRECISION (VAX D FORMAT 56 bits or IEEE DOUBLE 53 BITS)
* KERNEL FUNCTION FOR LOG; TO BE USED IN LOG1P, LOG, AND POW FUNCTIONS
* CODED IN C BY K.C. NG, 1/19/85;
* REVISED BY K.C. Ng, 2/3/85, 4/16/85.
*
* Method :
* 1. Polynomial approximation: let s = x/(2+x).
* Based on log(1+x) = log(1+s) - log(1-s)
* = 2s + 2/3 s**3 + 2/5 s**5 + .....,
*
* (log(1+x) - 2s)/s is computed by
*
* z*(L1 + z*(L2 + z*(... (L7 + z*L8)...)))
*
* where z=s*s. (See the listing below for Lk's values.) The
* coefficients are obtained by a special Remez algorithm.
*
* Accuracy:
* Assuming no rounding error, the maximum magnitude of the approximation
* error (absolute) is 2**(-58.49) for IEEE double, and 2**(-63.63)
* for VAX D format.
*
* Constants:
* The hexadecimal values are the intended ones for the following constants.
* The decimal values may be used, provided that the compiler will convert
* from decimal to binary accurately enough to produce the hexadecimal values
* shown.
*/
#include "mathimpl.h"
vc(L1, 6.6666666666666703212E-1 ,aaaa,402a,aac5,aaaa, 0, .AAAAAAAAAAAAC5)
vc(L2, 3.9999999999970461961E-1 ,cccc,3fcc,2684,cccc, -1, .CCCCCCCCCC2684)
vc(L3, 2.8571428579395698188E-1 ,4924,3f92,5782,92f8, -1, .92492492F85782)
vc(L4, 2.2222221233634724402E-1 ,8e38,3f63,af2c,39b7, -2, .E38E3839B7AF2C)
vc(L5, 1.8181879517064680057E-1 ,2eb4,3f3a,655e,cc39, -2, .BA2EB4CC39655E)
vc(L6, 1.5382888777946145467E-1 ,8551,3f1d,781d,e8c5, -2, .9D8551E8C5781D)
vc(L7, 1.3338356561139403517E-1 ,95b3,3f08,cd92,907f, -2, .8895B3907FCD92)
vc(L8, 1.2500000000000000000E-1 ,0000,3f00,0000,0000, -2, .80000000000000)
ic(L1, 6.6666666666667340202E-1, -1, 1.5555555555592)
ic(L2, 3.9999999999416702146E-1, -2, 1.999999997FF24)
ic(L3, 2.8571428742008753154E-1, -2, 1.24924941E07B4)
ic(L4, 2.2222198607186277597E-1, -3, 1.C71C52150BEA6)
ic(L5, 1.8183562745289935658E-1, -3, 1.74663CC94342F)
ic(L6, 1.5314087275331442206E-1, -3, 1.39A1EC014045B)
ic(L7, 1.4795612545334174692E-1, -3, 1.2F039F0085122)
#ifdef vccast
#define L1 vccast(L1)
#define L2 vccast(L2)
#define L3 vccast(L3)
#define L4 vccast(L4)
#define L5 vccast(L5)
#define L6 vccast(L6)
#define L7 vccast(L7)
#define L8 vccast(L8)
#endif
double log__L(z)
double z;
{
#if defined(vax)||defined(tahoe)
return(z*(L1+z*(L2+z*(L3+z*(L4+z*(L5+z*(L6+z*(L7+z*L8))))))));
#else /* defined(vax)||defined(tahoe) */
return(z*(L1+z*(L2+z*(L3+z*(L4+z*(L5+z*(L6+z*L7)))))));
#endif /* defined(vax)||defined(tahoe) */
}

View File

@@ -0,0 +1,116 @@
/*
* Copyright (c) 1988 The Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*
* @(#)mathimpl.h 5.3 (Berkeley) 10/9/90
*/
#include <math.h>
#include <endian.h>
#ifdef __LITTLE_ENDIAN
#undef national
#define national
#endif
#undef isinf
#define isinf __isinf
#undef isnan
#define isnan __isnan
#undef infnan
#define infnan __infnan
#undef copysign
#define copysign __copysign
#undef scalb
#define scalb __scalb
#undef drem
#define drem __drem
#undef logb
#define logb __logb
#undef __finite
#undef finite
#define finite __finite
#undef expm1
#define expm1 __expm1
#define exp__E __exp__E
#define log__L __log__L
#ifdef __STDC__
#define const const
#else
#define const /**/
#endif
#if defined(vax)||defined(tahoe)
/* Deal with different ways to concatenate in cpp */
# ifdef __STDC__
# define cat3(a,b,c) a ## b ## c
# else
# define cat3(a,b,c) a/**/b/**/c
# endif
/* Deal with vax/tahoe byte order issues */
# ifdef vax
# define cat3t(a,b,c) cat3(a,b,c)
# else
# define cat3t(a,b,c) cat3(a,c,b)
# endif
# define vccast(name) (*(const double *)(cat3(name,,x)))
/*
* Define a constant to high precision on a Vax or Tahoe.
*
* Args are the name to define, the decimal floating point value,
* four 16-bit chunks of the float value in hex
* (because the vax and tahoe differ in float format!), the power
* of 2 of the hex-float exponent, and the hex-float mantissa.
* Most of these arguments are not used at compile time; they are
* used in a post-check to make sure the constants were compiled
* correctly.
*
* People who want to use the constant will have to do their own
* #define foo vccast(foo)
* since CPP cannot do this for them from inside another macro (sigh).
* We define "vccast" if this needs doing.
*/
# define vc(name, value, x1,x2,x3,x4, bexp, xval) \
const static long cat3(name,,x)[] = {cat3t(0x,x1,x2), cat3t(0x,x3,x4)};
# define ic(name, value, bexp, xval) ;
#else /* vax or tahoe */
/* Hooray, we have an IEEE machine */
# undef vccast
# define vc(name, value, x1,x2,x3,x4, bexp, xval) ;
# define ic(name, value, bexp, xval) \
const static double name = value;
#endif /* defined(vax)||defined(tahoe) */
/*
* Functions internal to the math package, yet not static.
*/
extern double exp__E();
extern double log__L();

View File

@@ -0,0 +1,236 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)pow.c 5.7 (Berkeley) 10/9/90";
#endif /* not lint */
/* POW(X,Y)
* RETURN X**Y
* DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 1/8/85;
* REVISED BY K.C. NG on 7/10/85.
*
* Required system supported functions:
* scalb(x,n)
* logb(x)
* copysign(x,y)
* finite(x)
* drem(x,y)
*
* Required kernel functions:
* exp__E(a,c) ...return exp(a+c) - 1 - a*a/2
* log__L(x) ...return (log(1+x) - 2s)/s, s=x/(2+x)
* pow_p(x,y) ...return +(anything)**(finite non zero)
*
* Method
* 1. Compute and return log(x) in three pieces:
* log(x) = n*ln2 + hi + lo,
* where n is an integer.
* 2. Perform y*log(x) by simulating muti-precision arithmetic and
* return the answer in three pieces:
* y*log(x) = m*ln2 + hi + lo,
* where m is an integer.
* 3. Return x**y = exp(y*log(x))
* = 2^m * ( exp(hi+lo) ).
*
* Special cases:
* (anything) ** 0 is 1 ;
* (anything) ** 1 is itself;
* (anything) ** NaN is NaN;
* NaN ** (anything except 0) is NaN;
* +-(anything > 1) ** +INF is +INF;
* +-(anything > 1) ** -INF is +0;
* +-(anything < 1) ** +INF is +0;
* +-(anything < 1) ** -INF is +INF;
* +-1 ** +-INF is NaN and signal INVALID;
* +0 ** +(anything except 0, NaN) is +0;
* -0 ** +(anything except 0, NaN, odd integer) is +0;
* +0 ** -(anything except 0, NaN) is +INF and signal DIV-BY-ZERO;
* -0 ** -(anything except 0, NaN, odd integer) is +INF with signal;
* -0 ** (odd integer) = -( +0 ** (odd integer) );
* +INF ** +(anything except 0,NaN) is +INF;
* +INF ** -(anything except 0,NaN) is +0;
* -INF ** (odd integer) = -( +INF ** (odd integer) );
* -INF ** (even integer) = ( +INF ** (even integer) );
* -INF ** -(anything except integer,NaN) is NaN with signal;
* -(x=anything) ** (k=integer) is (-1)**k * (x ** k);
* -(anything except 0) ** (non-integer) is NaN with signal;
*
* Accuracy:
* pow(x,y) returns x**y nearly rounded. In particular, on a SUN, a VAX,
* and a Zilog Z8000,
* pow(integer,integer)
* always returns the correct integer provided it is representable.
* In a test run with 100,000 random arguments with 0 < x, y < 20.0
* on a VAX, the maximum observed error was 1.79 ulps (units in the
* last place).
*
* Constants :
* The hexadecimal values are the intended ones for the following constants.
* The decimal values may be used, provided that the compiler will convert
* from decimal to binary accurately enough to produce the hexadecimal values
* shown.
*/
#include <errno.h>
#include "mathimpl.h"
vc(ln2hi, 6.9314718055829871446E-1 ,7217,4031,0000,f7d0, 0, .B17217F7D00000)
vc(ln2lo, 1.6465949582897081279E-12 ,bcd5,2ce7,d9cc,e4f1, -39, .E7BCD5E4F1D9CC)
vc(invln2, 1.4426950408889634148E0 ,aa3b,40b8,17f1,295c, 1, .B8AA3B295C17F1)
vc(sqrt2, 1.4142135623730950622E0 ,04f3,40b5,de65,33f9, 1, .B504F333F9DE65)
ic(ln2hi, 6.9314718036912381649E-1, -1, 1.62E42FEE00000)
ic(ln2lo, 1.9082149292705877000E-10, -33, 1.A39EF35793C76)
ic(invln2, 1.4426950408889633870E0, 0, 1.71547652B82FE)
ic(sqrt2, 1.4142135623730951455E0, 0, 1.6A09E667F3BCD)
#ifdef vccast
#define ln2hi vccast(ln2hi)
#define ln2lo vccast(ln2lo)
#define invln2 vccast(invln2)
#define sqrt2 vccast(sqrt2)
#endif
const static double zero=0.0, half=1.0/2.0, one=1.0, two=2.0, negone= -1.0;
static double pow_p();
double pow(x,y)
double x,y;
{
double t;
if (y==zero) return(one);
else if(y==one
#if !defined(vax)&&!defined(tahoe)
||x!=x
#endif /* !defined(vax)&&!defined(tahoe) */
) return( x ); /* if x is NaN or y=1 */
#if !defined(vax)&&!defined(tahoe)
else if(y!=y) return( y ); /* if y is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
else if(!finite(y)) /* if y is INF */
if((t=copysign(x,one))==one) return(zero/zero);
else if(t>one) return((y>zero)?y:zero);
else return((y<zero)?-y:zero);
else if(y==two) return(x*x);
else if(y==negone) return(one/x);
/* sign(x) = 1 */
else if(copysign(one,x)==one) return(pow_p(x,y));
/* sign(x)= -1 */
/* if y is an even integer */
else if ( (t=drem(y,two)) == zero) return( pow_p(-x,y) );
/* if y is an odd integer */
else if (copysign(t,one) == one) return( -pow_p(-x,y) );
/* Henceforth y is not an integer */
else if(x==zero) /* x is -0 */
return((y>zero)?-x:one/(-x));
else { /* return NaN */
#if defined(vax)||defined(tahoe)
return (infnan(EDOM)); /* NaN */
#else /* defined(vax)||defined(tahoe) */
return(zero/zero);
#endif /* defined(vax)||defined(tahoe) */
}
}
#ifndef mc68881
/* pow_p(x,y) return x**y for x with sign=1 and finite y */
static double pow_p(x,y)
double x,y;
{
double c,s,t,z,tx,ty;
#ifdef tahoe
double tahoe_tmp;
#endif /* tahoe */
float sx,sy;
long k=0;
int n,m;
if(x==zero||!finite(x)) { /* if x is +INF or +0 */
#if defined(vax)||defined(tahoe)
return((y>zero)?x:infnan(ERANGE)); /* if y<zero, return +INF */
#else /* defined(vax)||defined(tahoe) */
return((y>zero)?x:one/x);
#endif /* defined(vax)||defined(tahoe) */
}
if(x==1.0) return(x); /* if x=1.0, return 1 since y is finite */
/* reduce x to z in [sqrt(1/2)-1, sqrt(2)-1] */
z=scalb(x,-(n=logb(x)));
#if !defined(vax)&&!defined(tahoe) /* IEEE double; subnormal number */
if(n <= -1022) {n += (m=logb(z)); z=scalb(z,-m);}
#endif /* !defined(vax)&&!defined(tahoe) */
if(z >= sqrt2 ) {n += 1; z *= half;} z -= one ;
/* log(x) = nlog2+log(1+z) ~ nlog2 + t + tx */
s=z/(two+z); c=z*z*half; tx=s*(c+log__L(s*s));
t= z-(c-tx); tx += (z-t)-c;
/* if y*log(x) is neither too big nor too small */
if((s=logb(y)+logb(n+t)) < 12.0)
if(s>-60.0) {
/* compute y*log(x) ~ mlog2 + t + c */
s=y*(n+invln2*t);
m=s+copysign(half,s); /* m := nint(y*log(x)) */
k=y;
if((double)k==y) { /* if y is an integer */
k = m-k*n;
sx=t; tx+=(t-sx); }
else { /* if y is not an integer */
k =m;
tx+=n*ln2lo;
sx=(c=n*ln2hi)+t; tx+=(c-sx)+t; }
/* end of checking whether k==y */
sy=y; ty=y-sy; /* y ~ sy + ty */
#ifdef tahoe
s = (tahoe_tmp = sx)*sy-k*ln2hi;
#else /* tahoe */
s=(double)sx*sy-k*ln2hi; /* (sy+ty)*(sx+tx)-kln2 */
#endif /* tahoe */
z=(tx*ty-k*ln2lo);
tx=tx*sy; ty=sx*ty;
t=ty+z; t+=tx; t+=s;
c= -((((t-s)-tx)-ty)-z);
/* return exp(y*log(x)) */
t += exp__E(t,c); return(scalb(one+t,m));
}
/* end of if log(y*log(x)) > -60.0 */
else
/* exp(+- tiny) = 1 with inexact flag */
{ln2hi+ln2lo; return(one);}
else if(copysign(one,y)*(n+invln2*t) <zero)
/* exp(-(big#)) underflows to zero */
return(scalb(one,-5000));
else
/* exp(+(big#)) overflows to INF */
return(scalb(one, 5000));
}
#endif /* mc68881 */

View File

@@ -0,0 +1,107 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)sinh.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* SINH(X)
* RETURN THE HYPERBOLIC SINE OF X
* DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 1/8/85;
* REVISED BY K.C. NG on 2/8/85, 3/7/85, 3/24/85, 4/16/85.
*
* Required system supported functions :
* copysign(x,y)
* scalb(x,N)
*
* Required kernel functions:
* expm1(x) ...return exp(x)-1
*
* Method :
* 1. reduce x to non-negative by sinh(-x) = - sinh(x).
* 2.
*
* expm1(x) + expm1(x)/(expm1(x)+1)
* 0 <= x <= lnovfl : sinh(x) := --------------------------------
* 2
* lnovfl <= x <= lnovfl+ln2 : sinh(x) := expm1(x)/2 (avoid overflow)
* lnovfl+ln2 < x < INF : overflow to INF
*
*
* Special cases:
* sinh(x) is x if x is +INF, -INF, or NaN.
* only sinh(0)=0 is exact for finite argument.
*
* Accuracy:
* sinh(x) returns the exact hyperbolic sine of x nearly rounded. In
* a test run with 1,024,000 random arguments on a VAX, the maximum
* observed error was 1.93 ulps (units in the last place).
*
* Constants:
* The hexadecimal values are the intended ones for the following constants.
* The decimal values may be used, provided that the compiler will convert
* from decimal to binary accurately enough to produce the hexadecimal values
* shown.
*/
#include "mathimpl.h"
vc(mln2hi, 8.8029691931113054792E1 ,0f33,43b0,2bdb,c7e2, 7, .B00F33C7E22BDB)
vc(mln2lo,-4.9650192275318476525E-16 ,1b60,a70f,582a,279e, -50,-.8F1B60279E582A)
vc(lnovfl, 8.8029691931113053016E1 ,0f33,43b0,2bda,c7e2, 7, .B00F33C7E22BDA)
ic(mln2hi, 7.0978271289338397310E2, 10, 1.62E42FEFA39EF)
ic(mln2lo, 2.3747039373786107478E-14, -45, 1.ABC9E3B39803F)
ic(lnovfl, 7.0978271289338397310E2, 9, 1.62E42FEFA39EF)
#ifdef vccast
#define mln2hi vccast(mln2hi)
#define mln2lo vccast(mln2lo)
#define lnovfl vccast(lnovfl)
#endif
#if defined(vax)||defined(tahoe)
static max = 126 ;
#else /* defined(vax)||defined(tahoe) */
static max = 1023 ;
#endif /* defined(vax)||defined(tahoe) */
double sinh(x)
double x;
{
static const double one=1.0, half=1.0/2.0 ;
double t, sign;
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
sign=copysign(one,x);
x=copysign(x,one);
if(x<lnovfl)
{t=expm1(x); return(copysign((t+t/(one+t))*half,sign));}
else if(x <= lnovfl+0.7)
/* subtract x by ln(2^(max+1)) and return 2^max*exp(x)
to avoid unnecessary overflow */
return(copysign(scalb(one+expm1((x-mln2hi)-mln2lo),max),sign));
else /* sinh(+-INF) = +-INF, sinh(+-big no.) overflow to +-INF */
return( expm1(x)*sign );
}

View File

@@ -0,0 +1,87 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)tanh.c 5.5 (Berkeley) 10/9/90";
#endif /* not lint */
/* TANH(X)
* RETURN THE HYPERBOLIC TANGENT OF X
* DOUBLE PRECISION (VAX D FORMAT 56 BITS, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 1/8/85;
* REVISED BY K.C. NG on 2/8/85, 2/11/85, 3/7/85, 3/24/85.
*
* Required system supported functions :
* copysign(x,y)
* finite(x)
*
* Required kernel function:
* expm1(x) ...exp(x)-1
*
* Method :
* 1. reduce x to non-negative by tanh(-x) = - tanh(x).
* 2.
* 0 < x <= 1.e-10 : tanh(x) := x
* -expm1(-2x)
* 1.e-10 < x <= 1 : tanh(x) := --------------
* expm1(-2x) + 2
* 2
* 1 <= x <= 22.0 : tanh(x) := 1 - ---------------
* expm1(2x) + 2
* 22.0 < x <= INF : tanh(x) := 1.
*
* Note: 22 was chosen so that fl(1.0+2/(expm1(2*22)+2)) == 1.
*
* Special cases:
* tanh(NaN) is NaN;
* only tanh(0)=0 is exact for finite argument.
*
* Accuracy:
* tanh(x) returns the exact hyperbolic tangent of x nealy rounded.
* In a test run with 1,024,000 random arguments on a VAX, the maximum
* observed error was 2.22 ulps (units in the last place).
*/
#include "mathimpl.h"
double tanh(x)
double x;
{
static double one=1.0, two=2.0, small = 1.0e-10, big = 1.0e10;
double expm1(), t, copysign(), sign;
int finite();
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
sign=copysign(one,x);
x=copysign(x,one);
if(x < 22.0)
if( x > one )
return(copysign(one-two/(expm1(x+x)+two),sign));
else if ( x > small )
{t= -expm1(-(x+x)); return(copysign(t/(two-t),sign));}
else /* raise the INEXACT flag for non-zero x */
{big+x; return(copysign(x,sign));}
else if(finite(x))
return (sign+1.0E-37); /* raise the INEXACT flag */
else
return(sign); /* x is +- INF */
}

View File

@@ -0,0 +1,214 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)cabs.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* HYPOT(X,Y)
* RETURN THE SQUARE ROOT OF X^2 + Y^2 WHERE Z=X+iY
* DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 11/28/84;
* REVISED BY K.C. NG, 7/12/85.
*
* Required system supported functions :
* copysign(x,y)
* finite(x)
* scalb(x,N)
* sqrt(x)
*
* Method :
* 1. replace x by |x| and y by |y|, and swap x and
* y if y > x (hence x is never smaller than y).
* 2. Hypot(x,y) is computed by:
* Case I, x/y > 2
*
* y
* hypot = x + -----------------------------
* 2
* sqrt ( 1 + [x/y] ) + x/y
*
* Case II, x/y <= 2
* y
* hypot = x + --------------------------------------------------
* 2
* [x/y] - 2
* (sqrt(2)+1) + (x-y)/y + -----------------------------
* 2
* sqrt ( 1 + [x/y] ) + sqrt(2)
*
*
*
* Special cases:
* hypot(x,y) is INF if x or y is +INF or -INF; else
* hypot(x,y) is NAN if x or y is NAN.
*
* Accuracy:
* hypot(x,y) returns the sqrt(x^2+y^2) with error less than 1 ulps (units
* in the last place). See Kahan's "Interval Arithmetic Options in the
* Proposed IEEE Floating Point Arithmetic Standard", Interval Mathematics
* 1980, Edited by Karl L.E. Nickel, pp 99-128. (A faster but less accurate
* code follows in comments.) In a test run with 500,000 random arguments
* on a VAX, the maximum observed error was .959 ulps.
*
* Constants:
* The hexadecimal values are the intended ones for the following constants.
* The decimal values may be used, provided that the compiler will convert
* from decimal to binary accurately enough to produce the hexadecimal values
* shown.
*/
#include "mathimpl.h"
vc(r2p1hi, 2.4142135623730950345E0 ,8279,411a,ef32,99fc, 2, .9A827999FCEF32)
vc(r2p1lo, 1.4349369327986523769E-17 ,597d,2484,754b,89b3, -55, .84597D89B3754B)
vc(sqrt2, 1.4142135623730950622E0 ,04f3,40b5,de65,33f9, 1, .B504F333F9DE65)
ic(r2p1hi, 2.4142135623730949234E0 , 1, 1.3504F333F9DE6)
ic(r2p1lo, 1.2537167179050217666E-16 , -53, 1.21165F626CDD5)
ic(sqrt2, 1.4142135623730951455E0 , 0, 1.6A09E667F3BCD)
#ifdef vccast
#define r2p1hi vccast(r2p1hi)
#define r2p1lo vccast(r2p1lo)
#define sqrt2 vccast(sqrt2)
#endif
double
hypot(x,y)
double x, y;
{
static const double zero=0, one=1,
small=1.0E-18; /* fl(1+small)==1 */
static const ibig=30; /* fl(1+2**(2*ibig))==1 */
double t,r;
int exp;
if(finite(x))
if(finite(y))
{
x=copysign(x,one);
y=copysign(y,one);
if(y > x)
{ t=x; x=y; y=t; }
if(x == zero) return(zero);
if(y == zero) return(x);
exp= logb(x);
if(exp-(int)logb(y) > ibig )
/* raise inexact flag and return |x| */
{ one+small; return(x); }
/* start computing sqrt(x^2 + y^2) */
r=x-y;
if(r>y) { /* x/y > 2 */
r=x/y;
r=r+sqrt(one+r*r); }
else { /* 1 <= x/y <= 2 */
r/=y; t=r*(r+2.0);
r+=t/(sqrt2+sqrt(2.0+t));
r+=r2p1lo; r+=r2p1hi; }
r=y/r;
return(x+r);
}
else if(y==y) /* y is +-INF */
return(copysign(y,one));
else
return(y); /* y is NaN and x is finite */
else if(x==x) /* x is +-INF */
return (copysign(x,one));
else if(finite(y))
return(x); /* x is NaN, y is finite */
#if !defined(vax)&&!defined(tahoe)
else if(y!=y) return(y); /* x and y is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
else return(copysign(y,one)); /* y is INF */
}
/* CABS(Z)
* RETURN THE ABSOLUTE VALUE OF THE COMPLEX NUMBER Z = X + iY
* DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 11/28/84.
* REVISED BY K.C. NG, 7/12/85.
*
* Required kernel function :
* hypot(x,y)
*
* Method :
* cabs(z) = hypot(x,y) .
*/
double
cabs(z)
struct/* { double x, y;}*/ __complex z;
{
return hypot(z.__x,z.__y);
}
double
z_abs(z)
struct/* { double x,y;}*/ __complex *z;
{
return hypot(z->__x,z->__y);
}
/* A faster but less accurate version of cabs(x,y) */
#if 0
double hypot(x,y)
double x, y;
{
static const double zero=0, one=1;
small=1.0E-18; /* fl(1+small)==1 */
static const ibig=30; /* fl(1+2**(2*ibig))==1 */
double temp;
int exp;
if(finite(x))
if(finite(y))
{
x=copysign(x,one);
y=copysign(y,one);
if(y > x)
{ temp=x; x=y; y=temp; }
if(x == zero) return(zero);
if(y == zero) return(x);
exp= logb(x);
x=scalb(x,-exp);
if(exp-(int)logb(y) > ibig )
/* raise inexact flag and return |x| */
{ one+small; return(scalb(x,exp)); }
else y=scalb(y,-exp);
return(scalb(sqrt(x*x+y*y),exp));
}
else if(y==y) /* y is +-INF */
return(copysign(y,one));
else
return(y); /* y is NaN and x is finite */
else if(x==x) /* x is +-INF */
return (copysign(x,one));
else if(finite(y))
return(x); /* x is NaN, y is finite */
else if(y!=y) return(y); /* x and y is NaN */
else return(copysign(y,one)); /* y is INF */
}
#endif

View File

@@ -0,0 +1,106 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)cbrt.c 5.8 (Berkeley) 10/9/90";
#endif /* not lint */
#include <sys/stdc.h>
/* kahan's cube root (53 bits IEEE double precision)
* for IEEE machines only
* coded in C by K.C. Ng, 4/30/85
*
* Accuracy:
* better than 0.667 ulps according to an error analysis. Maximum
* error observed was 0.666 ulps in an 1,000,000 random arguments test.
*
* Warning: this code is semi machine dependent; the ordering of words in
* a floating point number must be known in advance. I assume that the
* long interger at the address of a floating point number will be the
* leading 32 bits of that floating point number (i.e., sign, exponent,
* and the 20 most significant bits).
* On a National machine, it has different ordering; therefore, this code
* must be compiled with flag -DNATIONAL.
*/
#if !defined(vax)&&!defined(tahoe)
static const unsigned long
B1 = 715094163, /* B1 = (682-0.03306235651)*2**20 */
B2 = 696219795; /* B2 = (664-0.03306235651)*2**20 */
static const double
C= 19./35.,
D= -864./1225.,
E= 99./70.,
F= 45./28.,
G= 5./14.;
double cbrt(x)
double x;
{
double r,s,t=0.0,w;
unsigned long *px = (unsigned long *) &x,
*pt = (unsigned long *) &t,
mexp,sign;
#ifdef national /* ordering of words in a floating points number */
const int n0=1,n1=0;
#else /* national */
const int n0=0,n1=1;
#endif /* national */
mexp=px[n0]&0x7ff00000;
if(mexp==0x7ff00000) return(x); /* cbrt(NaN,INF) is itself */
if(x==0.0) return(x); /* cbrt(0) is itself */
sign=px[n0]&0x80000000; /* sign= sign(x) */
px[n0] ^= sign; /* x=|x| */
/* rough cbrt to 5 bits */
if(mexp==0) /* subnormal number */
{pt[n0]=0x43500000; /* set t= 2**54 */
t*=x; pt[n0]=pt[n0]/3+B2;
}
else
pt[n0]=px[n0]/3+B1;
/* new cbrt to 23 bits, may be implemented in single precision */
r=t*t/x;
s=C+r*t;
t*=G+F/(s+E+D/s);
/* chopped to 20 bits and make it larger than cbrt(x) */
pt[n1]=0; pt[n0]+=0x00000001;
/* one step newton iteration to 53 bits with error less than 0.667 ulps */
s=t*t; /* t*t is exact */
r=x/s;
w=t+t;
r=(r-t)/(w+r); /* r-t is exact */
t=t+t*r;
/* retore the sign bit */
pt[n0] |= sign;
return(t);
}
#endif

View File

@@ -0,0 +1,510 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)support.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/*
* Some IEEE standard 754 recommended functions and remainder and sqrt for
* supporting the C elementary functions.
******************************************************************************
* WARNING:
* These codes are developed (in double) to support the C elementary
* functions temporarily. They are not universal, and some of them are very
* slow (in particular, drem and sqrt is extremely inefficient). Each
* computer system should have its implementation of these functions using
* its own assembler.
******************************************************************************
*
* IEEE 754 required operations:
* drem(x,p)
* returns x REM y = x - [x/y]*y , where [x/y] is the integer
* nearest x/y; in half way case, choose the even one.
* sqrt(x)
* returns the square root of x correctly rounded according to
* the rounding mod.
*
* IEEE 754 recommended functions:
* (a) copysign(x,y)
* returns x with the sign of y.
* (b) scalb(x,N)
* returns x * (2**N), for integer values N.
* (c) logb(x)
* returns the unbiased exponent of x, a signed integer in
* double precision, except that logb(0) is -INF, logb(INF)
* is +INF, and logb(NAN) is that NAN.
* (d) finite(x)
* returns the value TRUE if -INF < x < +INF and returns
* FALSE otherwise.
*
*
* CODED IN C BY K.C. NG, 11/25/84;
* REVISED BY K.C. NG on 1/22/85, 2/13/85, 3/24/85.
*/
#include "mathimpl.h"
#if defined(vax)||defined(tahoe) /* VAX D format */
#include <errno.h>
static const unsigned short msign=0x7fff , mexp =0x7f80 ;
static const short prep1=57, gap=7, bias=129 ;
static const double novf=1.7E38, nunf=3.0E-39, zero=0.0 ;
#else /* defined(vax)||defined(tahoe) */
static const unsigned short msign=0x7fff, mexp =0x7ff0 ;
static const short prep1=54, gap=4, bias=1023 ;
static const double novf=1.7E308, nunf=3.0E-308,zero=0.0;
#endif /* defined(vax)||defined(tahoe) */
double scalb(x,N)
double x; int N;
{
int k;
#ifdef national
unsigned short *px=(unsigned short *) &x + 3;
#else /* national */
unsigned short *px=(unsigned short *) &x;
#endif /* national */
if( x == zero ) return(x);
#if defined(vax)||defined(tahoe)
if( (k= *px & mexp ) != ~msign ) {
if (N < -260)
return(nunf*nunf);
else if (N > 260) {
return(copysign(infnan(ERANGE),x));
}
#else /* defined(vax)||defined(tahoe) */
if( (k= *px & mexp ) != mexp ) {
if( N<-2100) return(nunf*nunf); else if(N>2100) return(novf+novf);
if( k == 0 ) {
x *= scalb(1.0,(int)prep1); N -= prep1; return(scalb(x,N));}
#endif /* defined(vax)||defined(tahoe) */
if((k = (k>>gap)+ N) > 0 )
if( k < (mexp>>gap) ) *px = (*px&~mexp) | (k<<gap);
else x=novf+novf; /* overflow */
else
if( k > -prep1 )
/* gradual underflow */
{*px=(*px&~mexp)|(short)(1<<gap); x *= scalb(1.0,k-1);}
else
return(nunf*nunf);
}
return(x);
}
double copysign(x,y)
double x,y;
{
#ifdef national
unsigned short *px=(unsigned short *) &x+3,
*py=(unsigned short *) &y+3;
#else /* national */
unsigned short *px=(unsigned short *) &x,
*py=(unsigned short *) &y;
#endif /* national */
#if defined(vax)||defined(tahoe)
if ( (*px & mexp) == 0 ) return(x);
#endif /* defined(vax)||defined(tahoe) */
*px = ( *px & msign ) | ( *py & ~msign );
return(x);
}
double logb(x)
double x;
{
#ifdef national
short *px=(short *) &x+3, k;
#else /* national */
short *px=(short *) &x, k;
#endif /* national */
#if defined(vax)||defined(tahoe)
return (int)(((*px&mexp)>>gap)-bias);
#else /* defined(vax)||defined(tahoe) */
if( (k= *px & mexp ) != mexp )
if ( k != 0 )
return ( (k>>gap) - bias );
else if( x != zero)
return ( -1022.0 );
else
return(-(1.0/zero));
else if(x != x)
return(x);
else
{*px &= msign; return(x);}
#endif /* defined(vax)||defined(tahoe) */
}
finite(x)
double x;
{
#if defined(vax)||defined(tahoe)
return(1);
#else /* defined(vax)||defined(tahoe) */
#ifdef national
return( (*((short *) &x+3 ) & mexp ) != mexp );
#else /* national */
return( (*((short *) &x ) & mexp ) != mexp );
#endif /* national */
#endif /* defined(vax)||defined(tahoe) */
}
double drem(x,p)
double x,p;
{
short sign;
double hp,dp,tmp;
unsigned short k;
#ifdef national
unsigned short
*px=(unsigned short *) &x +3,
*pp=(unsigned short *) &p +3,
*pd=(unsigned short *) &dp +3,
*pt=(unsigned short *) &tmp+3;
#else /* national */
unsigned short
*px=(unsigned short *) &x ,
*pp=(unsigned short *) &p ,
*pd=(unsigned short *) &dp ,
*pt=(unsigned short *) &tmp;
#endif /* national */
*pp &= msign ;
#if defined(vax)||defined(tahoe)
if( ( *px & mexp ) == ~msign ) /* is x a reserved operand? */
#else /* defined(vax)||defined(tahoe) */
if( ( *px & mexp ) == mexp )
#endif /* defined(vax)||defined(tahoe) */
return (x-p)-(x-p); /* create nan if x is inf */
if (p == zero) {
#if defined(vax)||defined(tahoe)
return(infnan(EDOM));
#else /* defined(vax)||defined(tahoe) */
return zero/zero;
#endif /* defined(vax)||defined(tahoe) */
}
#if defined(vax)||defined(tahoe)
if( ( *pp & mexp ) == ~msign ) /* is p a reserved operand? */
#else /* defined(vax)||defined(tahoe) */
if( ( *pp & mexp ) == mexp )
#endif /* defined(vax)||defined(tahoe) */
{ if (p != p) return p; else return x;}
else if ( ((*pp & mexp)>>gap) <= 1 )
/* subnormal p, or almost subnormal p */
{ double b; b=scalb(1.0,(int)prep1);
p *= b; x = drem(x,p); x *= b; return(drem(x,p)/b);}
else if ( p >= novf/2)
{ p /= 2 ; x /= 2; return(drem(x,p)*2);}
else
{
dp=p+p; hp=p/2;
sign= *px & ~msign ;
*px &= msign ;
while ( x > dp )
{
k=(*px & mexp) - (*pd & mexp) ;
tmp = dp ;
*pt += k ;
#if defined(vax)||defined(tahoe)
if( x < tmp ) *pt -= 128 ;
#else /* defined(vax)||defined(tahoe) */
if( x < tmp ) *pt -= 16 ;
#endif /* defined(vax)||defined(tahoe) */
x -= tmp ;
}
if ( x > hp )
{ x -= p ; if ( x >= hp ) x -= p ; }
#if defined(vax)||defined(tahoe)
if (x)
#endif /* defined(vax)||defined(tahoe) */
*px ^= sign;
return( x);
}
}
double sqrt(x)
double x;
{
double q,s,b,r;
double t;
double const zero=0.0;
int m,n,i;
#if defined(vax)||defined(tahoe)
int k=54;
#else /* defined(vax)||defined(tahoe) */
int k=51;
#endif /* defined(vax)||defined(tahoe) */
/* sqrt(NaN) is NaN, sqrt(+-0) = +-0 */
if(x!=x||x==zero) return(x);
/* sqrt(negative) is invalid */
if(x<zero) {
#if defined(vax)||defined(tahoe)
return (infnan(EDOM)); /* NaN */
#else /* defined(vax)||defined(tahoe) */
return(zero/zero);
#endif /* defined(vax)||defined(tahoe) */
}
/* sqrt(INF) is INF */
if(!finite(x)) return(x);
/* scale x to [1,4) */
n=logb(x);
x=scalb(x,-n);
if((m=logb(x))!=0) x=scalb(x,-m); /* subnormal number */
m += n;
n = m/2;
if((n+n)!=m) {x *= 2; m -=1; n=m/2;}
/* generate sqrt(x) bit by bit (accumulating in q) */
q=1.0; s=4.0; x -= 1.0; r=1;
for(i=1;i<=k;i++) {
t=s+1; x *= 4; r /= 2;
if(t<=x) {
s=t+t+2, x -= t; q += r;}
else
s *= 2;
}
/* generate the last bit and determine the final rounding */
r/=2; x *= 4;
if(x==zero) goto end; 100+r; /* trigger inexact flag */
if(s<x) {
q+=r; x -=s; s += 2; s *= 2; x *= 4;
t = (x-s)-5;
b=1.0+3*r/4; if(b==1.0) goto end; /* b==1 : Round-to-zero */
b=1.0+r/4; if(b>1.0) t=1; /* b>1 : Round-to-(+INF) */
if(t>=0) q+=r; } /* else: Round-to-nearest */
else {
s *= 2; x *= 4;
t = (x-s)-1;
b=1.0+3*r/4; if(b==1.0) goto end;
b=1.0+r/4; if(b>1.0) t=1;
if(t>=0) q+=r; }
end: return(scalb(q,n));
}
#if 0
/* DREM(X,Y)
* RETURN X REM Y =X-N*Y, N=[X/Y] ROUNDED (ROUNDED TO EVEN IN THE HALF WAY CASE)
* DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
* INTENDED FOR ASSEMBLY LANGUAGE
* CODED IN C BY K.C. NG, 3/23/85, 4/8/85.
*
* Warning: this code should not get compiled in unless ALL of
* the following machine-dependent routines are supplied.
*
* Required machine dependent functions (not on a VAX):
* swapINX(i): save inexact flag and reset it to "i"
* swapENI(e): save inexact enable and reset it to "e"
*/
double drem(x,y)
double x,y;
{
#ifdef national /* order of words in floating point number */
static const n0=3,n1=2,n2=1,n3=0;
#else /* VAX, SUN, ZILOG, TAHOE */
static const n0=0,n1=1,n2=2,n3=3;
#endif
static const unsigned short mexp =0x7ff0, m25 =0x0190, m57 =0x0390;
static const double zero=0.0;
double hy,y1,t,t1;
short k;
long n;
int i,e;
unsigned short xexp,yexp, *px =(unsigned short *) &x ,
nx,nf, *py =(unsigned short *) &y ,
sign, *pt =(unsigned short *) &t ,
*pt1 =(unsigned short *) &t1 ;
xexp = px[n0] & mexp ; /* exponent of x */
yexp = py[n0] & mexp ; /* exponent of y */
sign = px[n0] &0x8000; /* sign of x */
/* return NaN if x is NaN, or y is NaN, or x is INF, or y is zero */
if(x!=x) return(x); if(y!=y) return(y); /* x or y is NaN */
if( xexp == mexp ) return(zero/zero); /* x is INF */
if(y==zero) return(y/y);
/* save the inexact flag and inexact enable in i and e respectively
* and reset them to zero
*/
i=swapINX(0); e=swapENI(0);
/* subnormal number */
nx=0;
if(yexp==0) {t=1.0,pt[n0]+=m57; y*=t; nx=m57;}
/* if y is tiny (biased exponent <= 57), scale up y to y*2**57 */
if( yexp <= m57 ) {py[n0]+=m57; nx+=m57; yexp+=m57;}
nf=nx;
py[n0] &= 0x7fff;
px[n0] &= 0x7fff;
/* mask off the least significant 27 bits of y */
t=y; pt[n3]=0; pt[n2]&=0xf800; y1=t;
/* LOOP: argument reduction on x whenever x > y */
loop:
while ( x > y )
{
t=y;
t1=y1;
xexp=px[n0]&mexp; /* exponent of x */
k=xexp-yexp-m25;
if(k>0) /* if x/y >= 2**26, scale up y so that x/y < 2**26 */
{pt[n0]+=k;pt1[n0]+=k;}
n=x/t; x=(x-n*t1)-n*(t-t1);
}
/* end while (x > y) */
if(nx!=0) {t=1.0; pt[n0]+=nx; x*=t; nx=0; goto loop;}
/* final adjustment */
hy=y/2.0;
if(x>hy||((x==hy)&&n%2==1)) x-=y;
px[n0] ^= sign;
if(nf!=0) { t=1.0; pt[n0]-=nf; x*=t;}
/* restore inexact flag and inexact enable */
swapINX(i); swapENI(e);
return(x);
}
#endif
#if 0
/* SQRT
* RETURN CORRECTLY ROUNDED (ACCORDING TO THE ROUNDING MODE) SQRT
* FOR IEEE DOUBLE PRECISION ONLY, INTENDED FOR ASSEMBLY LANGUAGE
* CODED IN C BY K.C. NG, 3/22/85.
*
* Warning: this code should not get compiled in unless ALL of
* the following machine-dependent routines are supplied.
*
* Required machine dependent functions:
* swapINX(i) ...return the status of INEXACT flag and reset it to "i"
* swapRM(r) ...return the current Rounding Mode and reset it to "r"
* swapENI(e) ...return the status of inexact enable and reset it to "e"
* addc(t) ...perform t=t+1 regarding t as a 64 bit unsigned integer
* subc(t) ...perform t=t-1 regarding t as a 64 bit unsigned integer
*/
static const unsigned long table[] = {
0, 1204, 3062, 5746, 9193, 13348, 18162, 23592, 29598, 36145, 43202, 50740,
58733, 67158, 75992, 85215, 83599, 71378, 60428, 50647, 41945, 34246, 27478,
21581, 16499, 12183, 8588, 5674, 3403, 1742, 661, 130, };
double newsqrt(x)
double x;
{
double y,z,t,addc(),subc()
double const b54=134217728.*134217728.; /* b54=2**54 */
long mx,scalx;
long const mexp=0x7ff00000;
int i,j,r,e,swapINX(),swapRM(),swapENI();
unsigned long *py=(unsigned long *) &y ,
*pt=(unsigned long *) &t ,
*px=(unsigned long *) &x ;
#ifdef national /* ordering of word in a floating point number */
const int n0=1, n1=0;
#else
const int n0=0, n1=1;
#endif
/* Rounding Mode: RN ...round-to-nearest
* RZ ...round-towards 0
* RP ...round-towards +INF
* RM ...round-towards -INF
*/
const int RN=0,RZ=1,RP=2,RM=3;
/* machine dependent: work on a Zilog Z8070
* and a National 32081 & 16081
*/
/* exceptions */
if(x!=x||x==0.0) return(x); /* sqrt(NaN) is NaN, sqrt(+-0) = +-0 */
if(x<0) return((x-x)/(x-x)); /* sqrt(negative) is invalid */
if((mx=px[n0]&mexp)==mexp) return(x); /* sqrt(+INF) is +INF */
/* save, reset, initialize */
e=swapENI(0); /* ...save and reset the inexact enable */
i=swapINX(0); /* ...save INEXACT flag */
r=swapRM(RN); /* ...save and reset the Rounding Mode to RN */
scalx=0;
/* subnormal number, scale up x to x*2**54 */
if(mx==0) {x *= b54 ; scalx-=0x01b00000;}
/* scale x to avoid intermediate over/underflow:
* if (x > 2**512) x=x/2**512; if (x < 2**-512) x=x*2**512 */
if(mx>0x5ff00000) {px[n0] -= 0x20000000; scalx+= 0x10000000;}
if(mx<0x1ff00000) {px[n0] += 0x20000000; scalx-= 0x10000000;}
/* magic initial approximation to almost 8 sig. bits */
py[n0]=(px[n0]>>1)+0x1ff80000;
py[n0]=py[n0]-table[(py[n0]>>15)&31];
/* Heron's rule once with correction to improve y to almost 18 sig. bits */
t=x/y; y=y+t; py[n0]=py[n0]-0x00100006; py[n1]=0;
/* triple to almost 56 sig. bits; now y approx. sqrt(x) to within 1 ulp */
t=y*y; z=t; pt[n0]+=0x00100000; t+=z; z=(x-z)*y;
t=z/(t+x) ; pt[n0]+=0x00100000; y+=t;
/* twiddle last bit to force y correctly rounded */
swapRM(RZ); /* ...set Rounding Mode to round-toward-zero */
swapINX(0); /* ...clear INEXACT flag */
swapENI(e); /* ...restore inexact enable status */
t=x/y; /* ...chopped quotient, possibly inexact */
j=swapINX(i); /* ...read and restore inexact flag */
if(j==0) { if(t==y) goto end; else t=subc(t); } /* ...t=t-ulp */
b54+0.1; /* ..trigger inexact flag, sqrt(x) is inexact */
if(r==RN) t=addc(t); /* ...t=t+ulp */
else if(r==RP) { t=addc(t);y=addc(y);}/* ...t=t+ulp;y=y+ulp; */
y=y+t; /* ...chopped sum */
py[n0]=py[n0]-0x00100000; /* ...correctly rounded sqrt(x) */
end: py[n0]=py[n0]+scalx; /* ...scale back y */
swapRM(r); /* ...restore Rounding Mode */
return(y);
}
#endif

View File

@@ -0,0 +1,36 @@
/*-
* Copyright (c) 1990 The Regents of the University of California.
* All rights reserved.
*
* This code is derived from software contributed to Berkeley by
* the Systems Programming Group of the University of Utah Computer
* Science Department.
*
* Redistribution and use in source and binary forms are permitted
* provided that: (1) source distributions retain this entire copyright
* notice and comment, and (2) distributions including binaries display
* the following acknowledgement: ``This product includes software
* developed by the University of California, Berkeley and its contributors''
* in the documentation or other materials provided with the distribution
* and in all advertising materials mentioning features or use of this
* software. Neither the name of the University nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*
* @(#)expm1.s 5.1 (Berkeley) 5/17/90
*/
/* expm1(x) */
.text
.globl ___expm1
___expm1:
fetoxm1d sp@(4),fp0
fmoved fp0,sp@-
movel sp@+,d0
movel sp@+,d1
rts

View File

@@ -0,0 +1,36 @@
/*-
* Copyright (c) 1990 The Regents of the University of California.
* All rights reserved.
*
* This code is derived from software contributed to Berkeley by
* the Systems Programming Group of the University of Utah Computer
* Science Department.
*
* Redistribution and use in source and binary forms are permitted
* provided that: (1) source distributions retain this entire copyright
* notice and comment, and (2) distributions including binaries display
* the following acknowledgement: ``This product includes software
* developed by the University of California, Berkeley and its contributors''
* in the documentation or other materials provided with the distribution
* and in all advertising materials mentioning features or use of this
* software. Neither the name of the University nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*
* @(#)atan.s 5.1 (Berkeley) 5/17/90
*/
/* atan(x) */
.text
.globl _atan
_atan:
fatand sp@(4),fp0
fmoved fp0,sp@-
movel sp@+,d0
movel sp@+,d1
rts

View File

@@ -0,0 +1,130 @@
/*-
* Copyright (c) 1990 The Regents of the University of California.
* All rights reserved.
*
* This code is derived from software contributed to Berkeley by
* the Systems Programming Group of the University of Utah Computer
* Science Department.
*
* Redistribution and use in source and binary forms are permitted
* provided that: (1) source distributions retain this entire copyright
* notice and comment, and (2) distributions including binaries display
* the following acknowledgement: ``This product includes software
* developed by the University of California, Berkeley and its contributors''
* in the documentation or other materials provided with the distribution
* and in all advertising materials mentioning features or use of this
* software. Neither the name of the University nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)atan2.c 5.1 (Berkeley) 5/17/90";
#endif /* not lint */
/*
* ATAN2(Y,X)
* RETURN ARG (X+iY)
* DOUBLE PRECISION (IEEE DOUBLE 53 BITS)
*
* Scaled down version to weed out special cases. "Normal" cases are
* handled by calling atan2__A(), an assembly coded support routine in
* support.s.
*
* Required system supported functions :
* copysign(x,y)
* atan2__A(y,x)
*
* Method :
* 1. Deal with special cases
* 2. Call atan2__A() to do the others
*
* Special cases:
* Notations: atan2(y,x) == ARG (x+iy) == ARG(x,y).
*
* ARG( NAN , (anything) ) is NaN;
* ARG( (anything), NaN ) is NaN;
* ARG(+(anything but NaN), +-0) is +-0 ;
* ARG(-(anything but NaN), +-0) is +-PI ;
* ARG( 0, +-(anything but 0 and NaN) ) is +-PI/2;
* ARG( +INF,+-(anything but INF and NaN) ) is +-0 ;
* ARG( -INF,+-(anything but INF and NaN) ) is +-PI;
* ARG( +INF,+-INF ) is +-PI/4 ;
* ARG( -INF,+-INF ) is +-3PI/4;
* ARG( (anything but,0,NaN, and INF),+-INF ) is +-PI/2;
*
* Accuracy:
* atan2(y,x) returns (PI/pi) * the exact ARG (x+iy) nearly rounded,
* where
*
* in decimal:
* pi = 3.141592653589793 23846264338327 .....
* 53 bits PI = 3.141592653589793 115997963 ..... ,
* 56 bits PI = 3.141592653589793 227020265 ..... ,
*
* in hexadecimal:
* pi = 3.243F6A8885A308D313198A2E....
* 53 bits PI = 3.243F6A8885A30 = 2 * 1.921FB54442D18 error=.276ulps
* 56 bits PI = 3.243F6A8885A308 = 4 * .C90FDAA22168C2 error=.206ulps
*
* In a test run with 356,000 random argument on [-1,1] * [-1,1] on a
* VAX, the maximum observed error was 1.41 ulps (units of the last place)
* compared with (PI/pi)*(the exact ARG(x+iy)).
*
* Note:
* We use machine PI (the true pi rounded) in place of the actual
* value of pi for all the trig and inverse trig functions. In general,
* if trig is one of sin, cos, tan, then computed trig(y) returns the
* exact trig(y*pi/PI) nearly rounded; correspondingly, computed arctrig
* returns the exact arctrig(y)*PI/pi nearly rounded. These guarantee the
* trig functions have period PI, and trig(arctrig(x)) returns x for
* all critical values x.
*
* Constants:
* The hexadecimal values are the intended ones for the following constants.
* The decimal values may be used, provided that the compiler will convert
* from decimal to binary accurately enough to produce the hexadecimal values
* shown.
*/
static double
PIo4 = 7.8539816339744827900E-1 , /*Hex 2^ -1 * 1.921FB54442D18 */
PIo2 = 1.5707963267948965580E0 , /*Hex 2^ 0 * 1.921FB54442D18 */
PI = 3.1415926535897931160E0 ; /*Hex 2^ 1 * 1.921FB54442D18 */
double atan2(y,x)
double y,x;
{
static double zero=0, one=1;
double copysign(),atan2__A(),signy,signx;
int finite();
/* if x or y is NAN */
if(x!=x) return(x); if(y!=y) return(y);
/* copy down the sign of y and x */
signy = copysign(one,y);
signx = copysign(one,x);
/* when y = 0 */
if(y==zero) return((signx==one)?y:copysign(PI,signy));
/* when x = 0 */
if(x==zero) return(copysign(PIo2,signy));
/* when x is INF */
if(!finite(x))
if(!finite(y))
return(copysign((signx==one)?PIo4:3*PIo4,signy));
else
return(copysign((signx==one)?zero:PI,signy));
/* when y is INF */
if(!finite(y)) return(copysign(PIo2,signy));
/* else let atan2__A do the work */
return(atan2__A(y,x));
}

View File

@@ -0,0 +1,36 @@
/*-
* Copyright (c) 1990 The Regents of the University of California.
* All rights reserved.
*
* This code is derived from software contributed to Berkeley by
* the Systems Programming Group of the University of Utah Computer
* Science Department.
*
* Redistribution and use in source and binary forms are permitted
* provided that: (1) source distributions retain this entire copyright
* notice and comment, and (2) distributions including binaries display
* the following acknowledgement: ``This product includes software
* developed by the University of California, Berkeley and its contributors''
* in the documentation or other materials provided with the distribution
* and in all advertising materials mentioning features or use of this
* software. Neither the name of the University nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*
* @(#)atanh.s 5.1 (Berkeley) 5/17/90
*/
/* atanh(x) */
.text
.globl _atanh
_atanh:
fatanhd sp@(4),fp0
fmoved fp0,sp@-
movel sp@+,d0
movel sp@+,d1
rts

View File

@@ -0,0 +1,36 @@
/*-
* Copyright (c) 1990 The Regents of the University of California.
* All rights reserved.
*
* This code is derived from software contributed to Berkeley by
* the Systems Programming Group of the University of Utah Computer
* Science Department.
*
* Redistribution and use in source and binary forms are permitted
* provided that: (1) source distributions retain this entire copyright
* notice and comment, and (2) distributions including binaries display
* the following acknowledgement: ``This product includes software
* developed by the University of California, Berkeley and its contributors''
* in the documentation or other materials provided with the distribution
* and in all advertising materials mentioning features or use of this
* software. Neither the name of the University nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*
* @(#)cosh.s 5.1 (Berkeley) 5/17/90
*/
/* cosh(x) */
.text
.globl _cosh
_cosh:
fcoshd sp@(4),fp0
fmoved fp0,sp@-
movel sp@+,d0
movel sp@+,d1
rts

View File

@@ -0,0 +1,36 @@
/*-
* Copyright (c) 1990 The Regents of the University of California.
* All rights reserved.
*
* This code is derived from software contributed to Berkeley by
* the Systems Programming Group of the University of Utah Computer
* Science Department.
*
* Redistribution and use in source and binary forms are permitted
* provided that: (1) source distributions retain this entire copyright
* notice and comment, and (2) distributions including binaries display
* the following acknowledgement: ``This product includes software
* developed by the University of California, Berkeley and its contributors''
* in the documentation or other materials provided with the distribution
* and in all advertising materials mentioning features or use of this
* software. Neither the name of the University nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*
* @(#)exp.s 5.1 (Berkeley) 5/17/90
*/
/* exp(x) */
.text
.globl _exp
_exp:
fetoxd sp@(4),fp0
fmoved fp0,sp@-
movel sp@+,d0
movel sp@+,d1
rts

View File

@@ -0,0 +1,64 @@
/*-
* Copyright (c) 1990 The Regents of the University of California.
* All rights reserved.
*
* This code is derived from software contributed to Berkeley by
* the Systems Programming Group of the University of Utah Computer
* Science Department.
*
* Redistribution and use in source and binary forms are permitted
* provided that: (1) source distributions retain this entire copyright
* notice and comment, and (2) distributions including binaries display
* the following acknowledgement: ``This product includes software
* developed by the University of California, Berkeley and its contributors''
* in the documentation or other materials provided with the distribution
* and in all advertising materials mentioning features or use of this
* software. Neither the name of the University nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*
* @(#)floor.s 5.1 (Berkeley) 5/17/90
*/
.text
.globl _floor,_ceil,_rint
| floor(x)
| the largest integer no larger than x
_floor:
fmovel fpcr,d0 | save old FPCR
fmoved sp@(4),fp0 | get argument
fbun Lret | if NaN, return NaN
fboge Lrtz | >=0, round to zero
fmovel #0x20,fpcr | <0, round to -inf
jra Ldoit
| ceil(x)
| -floor(-x), for all real x
_ceil:
fmovel fpcr,d0 | save old FPCR
fmoved sp@(4),fp0 | get argument
fbun Lret | if NaN, return NaN
fbolt Lrtz | <0, round to zero
fmovel #0x30,fpcr | >=0, round to inf
jra Ldoit
Lrtz:
fmovel #0x10,fpcr
Ldoit:
fintd sp@(4),fp0 | truncate
fmovel d0,fpcr | restore old FPCR
Lret:
fmoved fp0,sp@-
movel sp@+,d0
movel sp@+,d1
rts
| rint(x)
| delivers integer nearest x in direction of prevailing rounding mode
_rint:
fintd sp@(4),fp0 | use prevailing rounding mode
jra Lret

View File

@@ -0,0 +1,36 @@
/*-
* Copyright (c) 1990 The Regents of the University of California.
* All rights reserved.
*
* This code is derived from software contributed to Berkeley by
* the Systems Programming Group of the University of Utah Computer
* Science Department.
*
* Redistribution and use in source and binary forms are permitted
* provided that: (1) source distributions retain this entire copyright
* notice and comment, and (2) distributions including binaries display
* the following acknowledgement: ``This product includes software
* developed by the University of California, Berkeley and its contributors''
* in the documentation or other materials provided with the distribution
* and in all advertising materials mentioning features or use of this
* software. Neither the name of the University nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*
* @(#)log.s 5.1 (Berkeley) 5/17/90
*/
/* log(x) */
.text
.globl _log
_log:
flognd sp@(4),fp0
fmoved fp0,sp@-
movel sp@+,d0
movel sp@+,d1
rts

View File

@@ -0,0 +1,36 @@
/*-
* Copyright (c) 1990 The Regents of the University of California.
* All rights reserved.
*
* This code is derived from software contributed to Berkeley by
* the Systems Programming Group of the University of Utah Computer
* Science Department.
*
* Redistribution and use in source and binary forms are permitted
* provided that: (1) source distributions retain this entire copyright
* notice and comment, and (2) distributions including binaries display
* the following acknowledgement: ``This product includes software
* developed by the University of California, Berkeley and its contributors''
* in the documentation or other materials provided with the distribution
* and in all advertising materials mentioning features or use of this
* software. Neither the name of the University nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*
* @(#)log10.s 5.1 (Berkeley) 5/17/90
*/
/* log10(x) */
.text
.globl _log10
_log10:
flog10d sp@(4),fp0
fmoved fp0,sp@-
movel sp@+,d0
movel sp@+,d1
rts

View File

@@ -0,0 +1,36 @@
/*-
* Copyright (c) 1990 The Regents of the University of California.
* All rights reserved.
*
* This code is derived from software contributed to Berkeley by
* the Systems Programming Group of the University of Utah Computer
* Science Department.
*
* Redistribution and use in source and binary forms are permitted
* provided that: (1) source distributions retain this entire copyright
* notice and comment, and (2) distributions including binaries display
* the following acknowledgement: ``This product includes software
* developed by the University of California, Berkeley and its contributors''
* in the documentation or other materials provided with the distribution
* and in all advertising materials mentioning features or use of this
* software. Neither the name of the University nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*
* @(#)log1p.s 5.1 (Berkeley) 5/17/90
*/
/* log1p(x) */
.text
.globl _log1p
_log1p:
flognp1d sp@(4),fp0
fmoved fp0,sp@-
movel sp@+,d0
movel sp@+,d1
rts

View File

@@ -0,0 +1,36 @@
/*-
* Copyright (c) 1990 The Regents of the University of California.
* All rights reserved.
*
* This code is derived from software contributed to Berkeley by
* the Systems Programming Group of the University of Utah Computer
* Science Department.
*
* Redistribution and use in source and binary forms are permitted
* provided that: (1) source distributions retain this entire copyright
* notice and comment, and (2) distributions including binaries display
* the following acknowledgement: ``This product includes software
* developed by the University of California, Berkeley and its contributors''
* in the documentation or other materials provided with the distribution
* and in all advertising materials mentioning features or use of this
* software. Neither the name of the University nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*
* @(#)sinh.s 5.1 (Berkeley) 5/17/90
*/
/* sinh(x) */
.text
.globl _sinh
_sinh:
fsinhd sp@(4),fp0
fmoved fp0,sp@-
movel sp@+,d0
movel sp@+,d1
rts

View File

@@ -0,0 +1,40 @@
/*-
* Copyright (c) 1990 The Regents of the University of California.
* All rights reserved.
*
* This code is derived from software contributed to Berkeley by
* the Systems Programming Group of the University of Utah Computer
* Science Department.
*
* Redistribution and use in source and binary forms are permitted
* provided that: (1) source distributions retain this entire copyright
* notice and comment, and (2) distributions including binaries display
* the following acknowledgement: ``This product includes software
* developed by the University of California, Berkeley and its contributors''
* in the documentation or other materials provided with the distribution
* and in all advertising materials mentioning features or use of this
* software. Neither the name of the University nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*
* @(#)sqrt.s 5.1 (Berkeley) 5/17/90
*/
/*
* sqrt(x)
* returns the square root of x correctly rounded according
* to the rounding mode.
*/
.text
.globl _sqrt
_sqrt:
fsqrtd sp@(4),fp0
fmoved fp0,sp@-
movel sp@+,d0
movel sp@+,d1
rts

View File

@@ -0,0 +1,36 @@
/*-
* Copyright (c) 1990 The Regents of the University of California.
* All rights reserved.
*
* This code is derived from software contributed to Berkeley by
* the Systems Programming Group of the University of Utah Computer
* Science Department.
*
* Redistribution and use in source and binary forms are permitted
* provided that: (1) source distributions retain this entire copyright
* notice and comment, and (2) distributions including binaries display
* the following acknowledgement: ``This product includes software
* developed by the University of California, Berkeley and its contributors''
* in the documentation or other materials provided with the distribution
* and in all advertising materials mentioning features or use of this
* software. Neither the name of the University nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*
* @(#)tan.s 5.1 (Berkeley) 5/17/90
*/
/* tan(x) */
.text
.globl _tan
_tan:
ftand sp@(4),fp0
fmoved fp0,sp@-
movel sp@+,d0
movel sp@+,d1
rts

View File

@@ -0,0 +1,36 @@
/*-
* Copyright (c) 1990 The Regents of the University of California.
* All rights reserved.
*
* This code is derived from software contributed to Berkeley by
* the Systems Programming Group of the University of Utah Computer
* Science Department.
*
* Redistribution and use in source and binary forms are permitted
* provided that: (1) source distributions retain this entire copyright
* notice and comment, and (2) distributions including binaries display
* the following acknowledgement: ``This product includes software
* developed by the University of California, Berkeley and its contributors''
* in the documentation or other materials provided with the distribution
* and in all advertising materials mentioning features or use of this
* software. Neither the name of the University nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*
* @(#)tanh.s 5.1 (Berkeley) 5/17/90
*/
/* tanh(x) */
.text
.globl _tanh
_tanh:
ftanhd sp@(4),fp0
fmoved fp0,sp@-
movel sp@+,d0
movel sp@+,d1
rts

View File

@@ -0,0 +1,218 @@
; Copyright (c) 1985 Regents of the University of California.
; All rights reserved.
;
; Redistribution and use in source and binary forms are permitted provided
; that: (1) source distributions retain this entire copyright notice and
; comment, and (2) distributions including binaries display the following
; acknowledgement: ``This product includes software developed by the
; University of California, Berkeley and its contributors'' in the
; documentation or other materials provided with the distribution and in
; all advertising materials mentioning features or use of this software.
; Neither the name of the University nor the names of its contributors may
; be used to endorse or promote products derived from this software without
; specific prior written permission.
; THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
; WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
;
; @(#)sqrt.s 5.4 (Berkeley) 10/9/90
;
; double sqrt(x)
; double x;
; IEEE double precision sqrt
; code in NSC assembly by K.C. Ng
; 12/13/85
;
; Method:
; Use Kahan's trick to get 8 bits initial approximation
; by integer shift and add/subtract. Then three Newton
; iterations to get down error to within one ulp. Finally
; twiddle the last bit to make to correctly rounded
; according to the rounding mode.
;
.vers 2
.text
.align 2
.globl _sqrt
_sqrt:
enter [r3,r4,r5,r6,r7],44
movl f4,tos
movl f6,tos
movd 2146435072,r2 ; r2 = 0x7ff00000
movl 8(fp),f0 ; f2 = x
movd 12(fp),r3 ; r3 = high part of x
movd r3,r4 ; make a copy of high part of x in r4
andd r2,r3 ; r3 become the bias exponent of x
cmpd r2,r3 ; if r3 = 0x7ff00000 then x is INF or NAN
bne L22
; to see if x is INF
movd 8(fp),r0 ; r0 = low part of x
movd r4,r1 ; r1 is high part of x again
andd 0xfff00000,r1 ; mask off the sign and exponent of x
ord r0,r1 ; or with low part, if 0 then x is INF
cmpqd 0,r1 ;
bne L1 ; not 0; therefore x is NaN; return x.
cmpqd 0,r4 ; now x is Inf, is it +inf?
blt L1 ; +INF, return x
; -INF, return NaN by doing 0/0
nan: movl 0f0.0,f0 ;
divl f0,f0
br L1
L22: ; now x is finite
cmpl 0f0.0,f0 ; x = 0 ?
beq L1 ; return x if x is +0 or -0
cmpqd 0,r4 ; Is x < 0 ?
bgt nan ; if x < 0 return NaN
movqd 0,r5 ; r5 == scalx initialize to zero
cmpqd 0,r3 ; is x is subnormal ? (r3 is the exponent)
bne L21 ; if x is normal, goto L21
movl L30,f2 ; f2 = 2**54
mull f2,f0 ; scale up x by 2**54
subd 0x1b00000,r5 ; off set the scale factor by -27 in exponent
L21:
; now x is normal
; notations:
; r1 == copy of fsr
; r2 == mask of e inexact enable flag
; r3 == mask of i inexact flag
; r4 == mask of r rounding mode
; r5 == x's scale factor (already defined)
movd 0x20,r2
movd 0x40,r3
movd 0x180,r4
sfsr r0 ; store fsr to r0
movd r0,r1 ; make a copy of fsr to r1
bicd [5,6,7,8],r0 ; clear e,i, and set r to round to nearest
lfsr r0
; begin to compute sqrt(x)
movl f0,-8(fp)
movd -4(fp),r0 ; r0 the high part of modified x
lshd -1,r0 ; r0 >> 1
addd 0x1ff80000,r0 ; add correction to r0 ...got 5 bits approx.
movd r0,r6
lshd -13,r6 ; r6 = r0>>-15
andd 0x7c,r6 ; obtain 4*leading 5 bits of r0
addrd L29,r7 ; r7 = address of L29 = table[0]
addd r6,r7 ; r6 = address of L29[r6] = table[r6]
subd 0(r7),r0 ; r0 = r0 - table[r6]
movd r0,-4(fp)
movl -8(fp),f2 ; now f2 = y approximate sqrt(f0) to 8 bits
movl 0f0.5,f6 ; f6 = 0.5
movl f0,f4
divl f2,f4 ; t = x/y
addl f4,f2 ; y = y + x/y
mull f6,f2 ; y = 0.5(y+x/y) got 17 bits approx.
movl f0,f4
divl f2,f4 ; t = x/y
addl f4,f2 ; y = y + x/y
mull f6,f2 ; y = 0.5(y+x/y) got 35 bits approx.
movl f0,f4
divl f2,f4 ; t = x/y
subl f2,f4 ; t = x/y - y
mull f6,f4 ; t = 0.5(x/y-y)
addl f4,f2 ; y = y + 0.5(x/y -y)
; now y approx. sqrt(x) to within 1 ulp
; twiddle last bit to force y correctly rounded
movd r1,r0 ; restore the old fsr
bicd [6,7,8],r0 ; clear inexact bit but retain inexact enable
ord 0x80,r0 ; set rounding mode to round to zero
lfsr r0
movl f0,f4
divl f2,f4 ; f4 = x/y
sfsr r0
andd r3,r0 ; get the inexact flag
cmpqd 0,r0
bne L18
; if x/y exact, then ...
cmpl f2,f4 ; if y == x/y
beq L2
movl f4,-8(fp)
subd 1,-8(fp)
subcd 0,-4(fp)
movl -8(fp),f4 ; f4 = f4 - ulp
L18:
bicd [6],r1
ord r3,r1 ; set inexact flag in r1
andd r1,r4 ; r4 = the old rounding mode
cmpqd 0,r4 ; round to nearest?
bne L17
movl f4,-8(fp)
addd 1,-8(fp)
addcd 0,-4(fp)
movl -8(fp),f4 ; f4 = f4 + ulp
br L16
L17:
cmpd 0x100,r4 ; round to positive inf ?
bne L16
movl f4,-8(fp)
addd 1,-8(fp)
addcd 0,-4(fp)
movl -8(fp),f4 ; f4 = f4 + ulp
movl f2,-8(fp)
addd 1,-8(fp)
addcd 0,-4(fp)
movl -8(fp),f2 ; f2 = f2 + ulp
L16:
addl f4,f2 ; y = y + t
subd 0x100000,r5 ; scalx = scalx - 1
L2:
movl f2,-8(fp)
addd r5,-4(fp)
movl -8(fp),f0
lfsr r1
L1:
movl tos,f6
movl tos,f4
exit [r3,r4,r5,r6,r7]
ret 0
.data
L28: .byte 64,40,35,41,115,113,114,116,46,99
.byte 9,49,46,49,32,40,117,99,98,46
.byte 101,108,101,102,117,110,116,41,32,57
.byte 47,49,57,47,56,53,0
L29: .blkb 4
.double 1204
.double 3062
.double 5746
.double 9193
.double 13348
.double 18162
.double 23592
.double 29598
.double 36145
.double 43202
.double 50740
.double 58733
.double 67158
.double 75992
.double 85215
.double 83599
.double 71378
.double 60428
.double 50647
.double 41945
.double 34246
.double 27478
.double 21581
.double 16499
.double 12183
.double 8588
.double 5674
.double 3403
.double 1742
.double 661
.double 130
L30: .blkb 4
.double 1129316352 ;L30: .double 0,0x43500000
L31: .blkb 4
.double 0x1ff00000
L32: .blkb 4
.double 0x5ff00000

View File

@@ -0,0 +1,40 @@
/*
* Copyright (c) 1988 The Regents of the University of California.
* All rights reserved.
*
* Redistribution is only permitted until one year after the first shipment
* of 4.4BSD by the Regents. Otherwise, redistribution and use in source and
* binary forms are permitted provided that: (1) source distributions retain
* this entire copyright notice and comment, and (2) distributions including
* binaries display the following acknowledgement: This product includes
* software developed by the University of California, Berkeley and its
* contributors'' in the documentation or other materials provided with the
* distribution and in all advertising materials mentioning features or use
* of this software. Neither the name of the University nor the names of
* its contributors may be used to endorse or promote products derived from
* this software without specific prior written permission.
* THIS SOFTWARE IS PROVIDED AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*
* @(#)stdc.h 7.3 (Berkeley) 6/28/90
*/
/*
* This file is designed to ease the porting from standard C to ANSI C.
* It will eventually go away.
* Questions to K. Bostic.
*/
#if __STDC__ || c_plusplus
#define CONCAT(x,y) x ## y
#define PROTOTYPE(p) p
#define STRING(x) #x
#else
#define const
#define volatile
#define signed
#define CONCAT(x,y) x/**/y
#define PROTOTYPE(p) ()
#define STRING(x) "x"
#endif

View File

@@ -0,0 +1,47 @@
# Copyright (c) 1985 Regents of the University of California.
# All rights reserved.
#
# Redistribution and use in source and binary forms are permitted provided
# that: (1) source distributions retain this entire copyright notice and
# comment, and (2) distributions including binaries display the following
# acknowledgement: ``This product includes software developed by the
# University of California, Berkeley and its contributors'' in the
# documentation or other materials provided with the distribution and in
# all advertising materials mentioning features or use of this software.
# Neither the name of the University nor the names of its contributors may
# be used to endorse or promote products derived from this software without
# specific prior written permission.
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# @(#)infnan.s 5.5 (Berkeley) 10/9/90
#
.data
.align 2
_sccsid:
.asciz "@(#)infnan.s 5.5 (ucb.elefunt) 10/9/90"
/*
* double infnan(arg)
* int arg;
* where arg := EDOM if result is NaN
* := ERANGE if result is +INF
* := -ERANGE if result is -INF
*
* The Reserved Operand Fault is generated inside of this routine.
*/
.globl _infnan
.set EDOM,33
.set ERANGE,34
.text
.align 2
___infnan:
.word 0x0000 # save nothing
cmpl 4(fp),$ERANGE
bneq 1f
movl $ERANGE,_errno
brb 2f
1: movl $EDOM,_errno
2: cmpf2 $0x80000000,$0x80000000 # generates the reserved operand fault
ret

View File

@@ -0,0 +1,104 @@
# Copyright (c) 1987 Regents of the University of California.
# All rights reserved.
#
# Redistribution and use in source and binary forms are permitted provided
# that: (1) source distributions retain this entire copyright notice and
# comment, and (2) distributions including binaries display the following
# acknowledgement: ``This product includes software developed by the
# University of California, Berkeley and its contributors'' in the
# documentation or other materials provided with the distribution and in
# all advertising materials mentioning features or use of this software.
# Neither the name of the University nor the names of its contributors may
# be used to endorse or promote products derived from this software without
# specific prior written permission.
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# @(#)cabs.s 5.5 (Berkeley) 10/9/90
#
.data
.align 2
_sccsid:
.asciz "@(#)cabs.s 5.5 5.5 (ucb.elefunt) 10/9/90"
# double precision complex absolute value
# CABS by W. Kahan, 9/7/80.
# Revised for reserved operands by E. LeBlanc, 8/18/82
# argument for complex absolute value by reference, *4(fp)
# argument for cabs and hypot (C fcns) by value, 4(fp)
# output is in r0:r1
.text
.align 2
.globl _cabs
.globl _hypot
.globl _z_abs
# entry for c functions cabs and hypot
_cabs:
_hypot:
.word 0x807c # save r2-r6, enable floating overflow
movl 16(fp),r3
movl 12(fp),r2 # r2:3 = y
movl 8(fp),r1
movl 4(fp),r0 # r0:1 = x
brb 1f
# entry for Fortran use, call by: d = abs(z)
_z_abs:
.word 0x807c # save r2-r6, enable floating overflow
movl 4(fp),r4 # indirect addressing is necessary here
movl 12(r4),r3 #
movl 8(r4),r2 # r2:3 = y
movl 4(r4),r1 #
movl (r4),r0 # r0:1 = x
1: andl3 $0xff800000,r0,r4 # r4 has signed biased exp of x
cmpl $0x80000000,r4
beql 2f # x is a reserved operand, so return it
andl3 $0xff800000,r2,r5 # r5 has signed biased exp of y
cmpl $0x80000000,r5
bneq 3f # y isn't a reserved operand
movl r3,r1
movl r2,r0 # return y if it's reserved
2: ret
3: callf $4,regs_set # r0:1 = dsqrt(x^2+y^2)/2^r6
addl2 r6,r0 # unscaled cdabs in r0:1
jvc 2b # unless it overflows
subl2 $0x800000,r0 # halve r0 to get meaningful overflow
ldd r0
addd r0 # overflow; r0 is half of true abs value
ret
regs_set:
.word 0x0000
andl2 $0x7fffffff,r0 # r0:r1 = dabs(x)
andl2 $0x7fffffff,r2 # r2:r3 = dabs(y)
cmpl r0,r2
bgeq 4f
movl r1,r5
movl r0,r4
movl r3,r1
movl r2,r0
movl r5,r3
movl r4,r2 # force y's exp <= x's exp
4: andl3 $0xff800000,r0,r6 # r6 = exponent(x) + bias(129)
beql 5f # if x = y = 0 then cdabs(x,y) = 0
subl2 $0x47800000,r6 # r6 = exponent(x) - 14
subl2 r6,r0 # 2^14 <= scaled x < 2^15
bitl $0xff800000,r2
beql 5f # if y = 0 return dabs(x)
subl2 r6,r2
cmpl $0x37800000,r2 # if scaled y < 2^-18
bgtr 5f # return dabs(x)
ldd r0
muld r0
std r0 # r0:1 = scaled x^2
ldd r2
muld r2 # acc = scaled y^2
addd r0
std r0
pushl r1
pushl r0
callf $12,_sqrt # r0:1 = dsqrt(x^2+y^2)/2^r6
5: ret

View File

@@ -0,0 +1,104 @@
# Copyright (c) 1987 Regents of the University of California.
# All rights reserved.
#
# Redistribution and use in source and binary forms are permitted provided
# that: (1) source distributions retain this entire copyright notice and
# comment, and (2) distributions including binaries display the following
# acknowledgement: ``This product includes software developed by the
# University of California, Berkeley and its contributors'' in the
# documentation or other materials provided with the distribution and in
# all advertising materials mentioning features or use of this software.
# Neither the name of the University nor the names of its contributors may
# be used to endorse or promote products derived from this software without
# specific prior written permission.
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# @(#)cbrt.s 5.5 (Berkeley) 10/9/90
#
.data
.align 2
_sccsid:
.asciz "@(#)cbrt.s 5.5 (ucb.elefunt) 10/9/90"
# double cbrt(double arg)
# W. Kahan, 10/13/80. revised 1/13/84 for keeping sign symmetry
# Re-coded in tahoe assembly language by Z. Alex Liu (7/13/87)
# Max error less than 0.667 ULPs _if_ +,-,*,/ were all correctly rounded...
.globl _cbrt
.globl _d_cbrt
.globl _dcbrt_
.text
.align 2
_cbrt:
_d_cbrt:
.word 0x01fc # save r2-r8
movl 4(fp),r0 # r0:r1 = x
movl 8(fp),r1
brb 1f
_dcbrt_:
.word 0x01fc # save r2-r8
movl 4(fp),r8
movl (r8),r0
movl 4(r8),r1 # r0:r1 = x
1: andl3 $0x7f800000,r0,r2 # biased exponent of x
beql return # dcbrt(0)=0 dcbrt(res)=res. operand
andl3 $0x80000000,r0,r8 # r8 has sign(x)
xorl2 r8,r0 # r0 is abs(x)
movl r0,r2 # r2 has abs(x)
divl2 $3,r2 # rough dcbrt with bias/3
addl2 B,r2 # restore bias, diminish fraction
ldf r2 # acc = |q|=|dcbrt| to 5 bits
mulf r2 # acc = qq
divf r0 # acc = qq/|x|
mulf r2 # acc = qqq/|x|
addf C # acc = C+qqq/|x|
stf r3 # r3 = s = C+qqq/|x|
ldf D # acc = D
divf r3 # acc = D/s
addf E # acc = E+D/s
addf r3 # acc = s+E+D/s
stf r3 # r3 = s+E+D/s
ldf F # acc = F
divf r3 # acc = F/(s+E+D/s)
addf G # acc = G+F/(s+E+D/s)
mulf r2 # acc = q*(G+F/(s+E+D/s)) = new q to 23 bits
stf r2 # r2 = q*(G+F/(s+E+D/s)) = new q to 23 bits
clrl r3 # r2:r3 = q as double float
ldd r2 # acc = q as double float
muld r2 # acc = qq exactly
std r4 # r4:r5 = qq exactly
ldd r0 # acc = |x|
divd r4 # acc = |x|/(q*q) rounded
std r0 # r0:r1 = |x|/(q*q) rounded
subd r2 # acc = |x|/(q*q)-q exactly
std r6 # r6:r7 = |x|/(q*q)-q exactly
movl r2,r4
clrl r5 # r4:r5 = q as double float
addl2 $0x800000,r4 # r4:r5 = 2*q
ldd r4 # acc = 2*q
addd r0 # acc = 2*q+|x|/(q*q)
std r4 # r4:r5 = 2*q+|x|/(q*q)
ldd r6 # acc = |x|/(q*q)-q
divd r4 # acc = (|x|/(q*q)-q)/(2*q+|x|/(q*q))
muld r2 # acc = q*(|x|/(q*q)-q)/(2*q+|x|/(q*q))
addd r2 # acc = q+q*(|x|/(q*q)-q)/(2*q+|x|/(q*q))
std r0 # r0:r1 = |result|
orl2 r8,r0 # restore the sign bit
return: ret # error less than 0.667ULPs?
.data
.align 2
B : .long 721142941 #(86-0.03306235651)*(2^23)
.align 2
C: .long 0x400af8b0 #.float 0f0.5428571429 # 19/35
.align 2
D: .long 0xc0348ef1 #.float 0f-0.7053061224 # -864/1225
.align 2
E: .long 0x40b50750 #.float 0f1.414285714 # 99/70
.align 2
F: .long 0x40cdb6db #.float 0f1.607142857 # 45/28
.align 2
G: .long 0x3fb6db6e #.float 0f0.3571428571 # 5/14

View File

@@ -0,0 +1,125 @@
/*
* Copyright (c) 1987 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
.data
.align 2
_sccsid:
.asciz "@(#)sqrt.s 5.6 (ucb.elefunt) 10/9/90"
/*
* double sqrt(arg) revised August 15,1982
* double arg;
* if(arg<0.0) { _errno = EDOM; return(<a reserved operand>); }
* if arg is a reserved operand it is returned as it is
* W. Kahan's magic square root
* Coded by Heidi Stettner and revised by Emile LeBlanc 8/18/82.
* Re-coded in tahoe assembly language by Z. Alex Liu 7/13/87.
*
* entry points:_d_sqrt address of double arg is on the stack
* _sqrt double arg is on the stack
*/
.text
.align 2
.globl _sqrt
.globl _d_sqrt
.globl libm$dsqrt_r5
.set EDOM,33
_d_sqrt:
.word 0x003c # save r2-r5
movl 4(fp),r2
movl (r2),r0
movl 4(r2),r1 # r0:r1 = x
brb 1f
_sqrt:
.word 0x003c # save r2-r5
movl 4(fp),r0
movl 8(fp),r1 # r0:r1 = x
1: andl3 $0x7f800000,r0,r2 # r2 = biased exponent
bneq 2f
ret # biased exponent is zero -> 0 or reserved op.
/*
* # internal procedure
* # ENTRY POINT FOR cdabs and cdsqrt
*/
libm$dsqrt_r5: # returns double square root scaled by 2^r6
.word 0x0000 # save nothing
2: ldd r0
std r4
bleq nonpos # argument is not positive
andl3 $0xfffe0000,r4,r2
shar $1,r2,r0
addl2 $0x203c0000,r0 # r0 has magic initial approximation
/*
* # Do two steps of Heron's rule
* # ((arg/guess)+guess)/2 = better guess
*/
ldf r4
divf r0
addf r0
stf r0
subl2 $0x800000,r0 # divide by two
ldf r4
divf r0
addf r0
stf r0
subl2 $0x800000,r0 # divide by two
/*
* # Scale argument and approximation
* # to prevent over/underflow
*/
andl3 $0x7f800000,r4,r1
subl2 $0x40800000,r1 # r1 contains scaling factor
subl2 r1,r4 # r4:r5 = n/s
movl r0,r2
subl2 r1,r2 # r2 = a/s
/*
* # Cubic step
* # b = a+2*a*(n-a*a)/(n+3*a*a) where
* # b is better approximation, a is approximation
* # and n is the original argument.
* # s := scale factor.
*/
clrl r1 # r0:r1 = a
clrl r3 # r2:r3 = a/s
ldd r0 # acc = a
muld r2 # acc = a*a/s
std r2 # r2:r3 = a*a/s
negd # acc = -a*a/s
addd r4 # acc = n/s-a*a/s
std r4 # r4:r5 = n/s-a*a/s
addl2 $0x1000000,r2 # r2:r3 = 4*a*a/s
ldd r2 # acc = 4*a*a/s
addd r4 # acc = n/s+3*a*a/s
std r2 # r2:r3 = n/s+3*a*a/s
ldd r0 # acc = a
muld r4 # acc = a*n/s-a*a*a/s
divd r2 # acc = a*(n-a*a)/(n+3*a*a)
std r4 # r4:r5 = a*(n-a*a)/(n+3*a*a)
addl2 $0x800000,r4 # r4:r5 = 2*a*(n-a*a)/(n+3*a*a)
ldd r4 # acc = 2*a*(n-a*a)/(n+3*a*a)
addd r0 # acc = a+2*a*(n-a*a)/(n+3*a*a)
std r0 # r0:r1 = a+2*a*(n-a*a)/(n+3*a*a)
ret # rsb
nonpos:
bneq negarg
ret # argument and root are zero
negarg:
pushl $EDOM
callf $8,_infnan # generate the reserved op fault
ret

View File

@@ -0,0 +1,47 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*
* @(#)infnan.s 5.5 (Berkeley) 10/9/90
*/
.data
.align 2
_sccsid:
.asciz "@(#)infnan.s 1.1 (Berkeley) 8/21/85; 5.5 (ucb.elefunt) 10/9/90"
/*
* infnan(arg) int arg;
* where arg := EDOM if result is NaN
* := ERANGE if result is +INF
* := -ERANGE if result is -INF
*
* The Reserved Operand Fault is generated inside of this routine.
*/
.globl _infnan
.set EDOM,33
.set ERANGE,34
.text
.align 1
___infnan:
.word 0x0
cmpl 4(ap),$ERANGE
bneq 1f
movl $ERANGE,_errno
brb 2f
1: movl $EDOM,_errno
2: emodd $0,$0,$0x8000,r0,r0 # generates the reserved operand fault
ret

View File

@@ -0,0 +1,205 @@
# Copyright (c) 1985 Regents of the University of California.
# All rights reserved.
#
# Redistribution and use in source and binary forms are permitted provided
# that: (1) source distributions retain this entire copyright notice and
# comment, and (2) distributions including binaries display the following
# acknowledgement: ``This product includes software developed by the
# University of California, Berkeley and its contributors'' in the
# documentation or other materials provided with the distribution and in
# all advertising materials mentioning features or use of this software.
# Neither the name of the University nor the names of its contributors may
# be used to endorse or promote products derived from this software without
# specific prior written permission.
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# @(#)atan2.s 5.4 (Berkeley) 10/9/90
#
.data
.align 2
_sccsid:
.asciz "@(#)atan2.s 1.2 (Berkeley) 8/21/85; 5.4 (ucb.elefunt) 10/9/90"
# ATAN2(Y,X)
# RETURN ARG (X+iY)
# VAX D FORMAT (56 BITS PRECISION)
# CODED IN VAX ASSEMBLY LANGUAGE BY K.C. NG, 4/16/85;
#
#
# Method :
# 1. Reduce y to positive by atan2(y,x)=-atan2(-y,x).
# 2. Reduce x to positive by (if x and y are unexceptional):
# ARG (x+iy) = arctan(y/x) ... if x > 0,
# ARG (x+iy) = pi - arctan[y/(-x)] ... if x < 0,
# 3. According to the integer k=4t+0.25 truncated , t=y/x, the argument
# is further reduced to one of the following intervals and the
# arctangent of y/x is evaluated by the corresponding formula:
#
# [0,7/16] atan(y/x) = t - t^3*(a1+t^2*(a2+...(a10+t^2*a11)...)
# [7/16,11/16] atan(y/x) = atan(1/2) + atan( (y-x/2)/(x+y/2) )
# [11/16.19/16] atan(y/x) = atan( 1 ) + atan( (y-x)/(x+y) )
# [19/16,39/16] atan(y/x) = atan(3/2) + atan( (y-1.5x)/(x+1.5y) )
# [39/16,INF] atan(y/x) = atan(INF) + atan( -x/y )
#
# Special cases:
# Notations: atan2(y,x) == ARG (x+iy) == ARG(x,y).
#
# ARG( NAN , (anything) ) is NaN;
# ARG( (anything), NaN ) is NaN;
# ARG(+(anything but NaN), +-0) is +-0 ;
# ARG(-(anything but NaN), +-0) is +-PI ;
# ARG( 0, +-(anything but 0 and NaN) ) is +-PI/2;
# ARG( +INF,+-(anything but INF and NaN) ) is +-0 ;
# ARG( -INF,+-(anything but INF and NaN) ) is +-PI;
# ARG( +INF,+-INF ) is +-PI/4 ;
# ARG( -INF,+-INF ) is +-3PI/4;
# ARG( (anything but,0,NaN, and INF),+-INF ) is +-PI/2;
#
# Accuracy:
# atan2(y,x) returns the exact ARG(x+iy) nearly rounded.
#
.text
.align 1
.globl _atan2
_atan2 :
.word 0x0ff4
movq 4(ap),r2 # r2 = y
movq 12(ap),r4 # r4 = x
bicw3 $0x7f,r2,r0
bicw3 $0x7f,r4,r1
cmpw r0,$0x8000 # y is the reserved operand
jeql resop
cmpw r1,$0x8000 # x is the reserved operand
jeql resop
subl2 $8,sp
bicw3 $0x7fff,r2,-4(fp) # copy y sign bit to -4(fp)
bicw3 $0x7fff,r4,-8(fp) # copy x sign bit to -8(fp)
cmpd r4,$0x4080 # x = 1.0 ?
bneq xnot1
movq r2,r0
bicw2 $0x8000,r0 # t = |y|
movq r0,r2 # y = |y|
brb begin
xnot1:
bicw3 $0x807f,r2,r11 # yexp
jeql yeq0 # if y=0 goto yeq0
bicw3 $0x807f,r4,r10 # xexp
jeql pio2 # if x=0 goto pio2
subw2 r10,r11 # k = yexp - xexp
cmpw r11,$0x2000 # k >= 64 (exp) ?
jgeq pio2 # atan2 = +-pi/2
divd3 r4,r2,r0 # t = y/x never overflow
bicw2 $0x8000,r0 # t > 0
bicw2 $0xff80,r2 # clear the exponent of y
bicw2 $0xff80,r4 # clear the exponent of x
bisw2 $0x4080,r2 # normalize y to [1,2)
bisw2 $0x4080,r4 # normalize x to [1,2)
subw2 r11,r4 # scale x so that yexp-xexp=k
begin:
cmpw r0,$0x411c # t : 39/16
jgeq L50
addl3 $0x180,r0,r10 # 8*t
cvtrfl r10,r10 # [8*t] rounded to int
ashl $-1,r10,r10 # [8*t]/2
casel r10,$0,$4
L1:
.word L20-L1
.word L20-L1
.word L30-L1
.word L40-L1
.word L40-L1
L10:
movq $0xb4d9940f985e407b,r6 # Hi=.98279372324732906796d0
movq $0x21b1879a3bc2a2fc,r8 # Lo=-.17092002525602665777d-17
subd3 r4,r2,r0 # y-x
addw2 $0x80,r0 # 2(y-x)
subd2 r4,r0 # 2(y-x)-x
addw2 $0x80,r4 # 2x
movq r2,r10
addw2 $0x80,r10 # 2y
addd2 r10,r2 # 3y
addd2 r4,r2 # 3y+2x
divd2 r2,r0 # (2y-3x)/(2x+3y)
brw L60
L20:
cmpw r0,$0x3280 # t : 2**(-28)
jlss L80
clrq r6 # Hi=r6=0, Lo=r8=0
clrq r8
brw L60
L30:
movq $0xda7b2b0d63383fed,r6 # Hi=.46364760900080611433d0
movq $0xf0ea17b2bf912295,r8 # Lo=.10147340032515978826d-17
movq r2,r0
addw2 $0x80,r0 # 2y
subd2 r4,r0 # 2y-x
addw2 $0x80,r4 # 2x
addd2 r2,r4 # 2x+y
divd2 r4,r0 # (2y-x)/(2x+y)
brb L60
L50:
movq $0x68c2a2210fda40c9,r6 # Hi=1.5707963267948966135d1
movq $0x06e0145c26332326,r8 # Lo=.22517417741562176079d-17
cmpw r0,$0x5100 # y : 2**57
bgeq L90
divd3 r2,r4,r0
bisw2 $0x8000,r0 # -x/y
brb L60
L40:
movq $0x68c2a2210fda4049,r6 # Hi=.78539816339744830676d0
movq $0x06e0145c263322a6,r8 # Lo=.11258708870781088040d-17
subd3 r4,r2,r0 # y-x
addd2 r4,r2 # y+x
divd2 r2,r0 # (y-x)/(y+x)
L60:
movq r0,r10
muld2 r0,r0
polyd r0,$12,ptable
muld2 r10,r0
subd2 r0,r8
addd3 r8,r10,r0
addd2 r6,r0
L80:
movw -8(fp),r2
bneq pim
bisw2 -4(fp),r0 # return sign(y)*r0
ret
L90: # x >= 2**25
movq r6,r0
brb L80
pim:
subd3 r0,$0x68c2a2210fda4149,r0 # pi-t
bisw2 -4(fp),r0
ret
yeq0:
movw -8(fp),r2
beql zero # if sign(x)=1 return pi
movq $0x68c2a2210fda4149,r0 # pi=3.1415926535897932270d1
ret
zero:
clrq r0 # return 0
ret
pio2:
movq $0x68c2a2210fda40c9,r0 # pi/2=1.5707963267948966135d1
bisw2 -4(fp),r0 # return sign(y)*pi/2
ret
resop:
movq $0x8000,r0 # propagate the reserved operand
ret
.align 2
ptable:
.quad 0xb50f5ce96e7abd60
.quad 0x51e44a42c1073e02
.quad 0x3487e3289643be35
.quad 0xdb62066dffba3e54
.quad 0xcf8e2d5199abbe70
.quad 0x26f39cb884883e88
.quad 0x135117d18998be9d
.quad 0x602ce9742e883eba
.quad 0xa35ad0be8e38bee3
.quad 0xffac922249243f12
.quad 0x7f14ccccccccbf4c
.quad 0xaa8faaaaaaaa3faa
.quad 0x0000000000000000

View File

@@ -0,0 +1,119 @@
# Copyright (c) 1985 Regents of the University of California.
# All rights reserved.
#
# Redistribution and use in source and binary forms are permitted provided
# that: (1) source distributions retain this entire copyright notice and
# comment, and (2) distributions including binaries display the following
# acknowledgement: ``This product includes software developed by the
# University of California, Berkeley and its contributors'' in the
# documentation or other materials provided with the distribution and in
# all advertising materials mentioning features or use of this software.
# Neither the name of the University nor the names of its contributors may
# be used to endorse or promote products derived from this software without
# specific prior written permission.
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# @(#)cabs.s 5.4 (Berkeley) 10/9/90
#
.data
.align 2
_sccsid:
.asciz "@(#)cabs.s 1.2 (Berkeley) 8/21/85; 5.4 (ucb.elefunt) 10/9/90"
# double precision complex absolute value
# CABS by W. Kahan, 9/7/80.
# Revised for reserved operands by E. LeBlanc, 8/18/82
# argument for complex absolute value by reference, *4(ap)
# argument for cabs and hypot (C fcns) by value, 4(ap)
# output is in r0:r1 (error less than 0.86 ulps)
.text
.align 1
.globl _cabs
.globl _hypot
.globl _z_abs
.globl libm$cdabs_r6
.globl libm$dsqrt_r5
# entry for c functions cabs and hypot
_cabs:
_hypot:
.word 0x807c # save r2-r6, enable floating overflow
movq 4(ap),r0 # r0:1 = x
movq 12(ap),r2 # r2:3 = y
jmp cabs2
# entry for Fortran use, call by: d = abs(z)
_z_abs:
.word 0x807c # save r2-r6, enable floating overflow
movl 4(ap),r2 # indirect addressing is necessary here
movq (r2)+,r0 # r0:1 = x
movq (r2),r2 # r2:3 = y
cabs2:
bicw3 $0x7f,r0,r4 # r4 has signed biased exp of x
cmpw $0x8000,r4
jeql return # x is a reserved operand, so return it
bicw3 $0x7f,r2,r5 # r5 has signed biased exp of y
cmpw $0x8000,r5
jneq cont # y isn't a reserved operand
movq r2,r0 # return y if it's reserved
ret
cont:
bsbb regs_set # r0:1 = dsqrt(x^2+y^2)/2^r6
addw2 r6,r0 # unscaled cdabs in r0:1
jvc return # unless it overflows
subw2 $0x80,r0 # halve r0 to get meaningful overflow
addd2 r0,r0 # overflow; r0 is half of true abs value
return:
ret
libm$cdabs_r6: # ENTRY POINT for cdsqrt
# calculates a scaled (factor in r6)
# complex absolute value
movq (r4)+,r0 # r0:r1 = x via indirect addressing
movq (r4),r2 # r2:r3 = y via indirect addressing
bicw3 $0x7f,r0,r5 # r5 has signed biased exp of x
cmpw $0x8000,r5
jeql cdreserved # x is a reserved operand
bicw3 $0x7f,r2,r5 # r5 has signed biased exp of y
cmpw $0x8000,r5
jneq regs_set # y isn't a reserved operand either?
cdreserved:
movl *4(ap),r4 # r4 -> (u,v), if x or y is reserved
movq r0,(r4)+ # copy u and v as is and return
movq r2,(r4) # (again addressing is indirect)
ret
regs_set:
bicw2 $0x8000,r0 # r0:r1 = dabs(x)
bicw2 $0x8000,r2 # r2:r3 = dabs(y)
cmpw r0,r2
jgeq ordered
movq r0,r4
movq r2,r0
movq r4,r2 # force y's exp <= x's exp
ordered:
bicw3 $0x7f,r0,r6 # r6 = exponent(x) + bias(129)
jeql retsb # if x = y = 0 then cdabs(x,y) = 0
subw2 $0x4780,r6 # r6 = exponent(x) - 14
subw2 r6,r0 # 2^14 <= scaled x < 2^15
bitw $0xff80,r2
jeql retsb # if y = 0 return dabs(x)
subw2 r6,r2
cmpw $0x3780,r2 # if scaled y < 2^-18
jgtr retsb # return dabs(x)
emodd r0,$0,r0,r4,r0 # r4 + r0:1 = scaled x^2
emodd r2,$0,r2,r5,r2 # r5 + r2:3 = scaled y^2
addd2 r2,r0
addl2 r5,r4
cvtld r4,r2
addd2 r2,r0 # r0:1 = scaled x^2 + y^2
jmp libm$dsqrt_r5 # r0:1 = dsqrt(x^2+y^2)/2^r6
retsb:
rsb # error < 0.86 ulp

View File

@@ -0,0 +1,86 @@
# Copyright (c) 1985 Regents of the University of California.
# All rights reserved.
#
# Redistribution and use in source and binary forms are permitted provided
# that: (1) source distributions retain this entire copyright notice and
# comment, and (2) distributions including binaries display the following
# acknowledgement: ``This product includes software developed by the
# University of California, Berkeley and its contributors'' in the
# documentation or other materials provided with the distribution and in
# all advertising materials mentioning features or use of this software.
# Neither the name of the University nor the names of its contributors may
# be used to endorse or promote products derived from this software without
# specific prior written permission.
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# @(#)cbrt.s 5.4 (Berkeley) 10/9/90
#
.data
.align 2
_sccsid:
.asciz "@(#)cbrt.s 1.1 (Berkeley) 5/23/85; 5.4 (ucb.elefunt) 10/9/90"
# double cbrt(double arg)
# W. Kahan, 10/13/80. revised 1/13/84 for keeping sign symmetry
# error check by E LeBlanc, 8/18/82
# Revised and tested by K.C. Ng, 5/2/85
# Max error less than 0.667 ulps (unit in the last places)
.globl _cbrt
.globl _d_cbrt
.globl _dcbrt_
.text
.align 1
_cbrt:
_d_cbrt:
.word 0x00fc # save r2 to r7
movq 4(ap),r0 # r0 = argument x
jmp dcbrt2
_dcbrt_:
.word 0x00fc # save r2 to r7
movq *4(ap),r0 # r0 = argument x
dcbrt2: bicw3 $0x807f,r0,r2 # biased exponent of x
jeql return # dcbrt(0)=0 dcbrt(res)=res. operand
bicw3 $0x7fff,r0,ap # ap has sign(x)
xorw2 ap,r0 # r0 is abs(x)
movl r0,r2 # r2 has abs(x)
rotl $16,r2,r2 # r2 = |x| with bits unscrambled
divl2 $3,r2 # rough dcbrt with bias/3
addl2 B,r2 # restore bias, diminish fraction
rotl $16,r2,r2 # r2=|q|=|dcbrt| to 5 bits
mulf3 r2,r2,r3 # r3 =qq
divf2 r0,r3 # r3 = qq/x
mulf2 r2,r3
addf2 C,r3 # r3 = s = C + qqq/x
divf3 r3,D,r4 # r4 = D/s
addf2 E,r4
addf2 r4,r3 # r3 = s + E + D/s
divf3 r3,F,r3 # r3 = F / (s + E + D/s)
addf2 G,r3 # r3 = G + F / (s + E + D/s)
mulf2 r3,r2 # r2 = qr3 = new q to 23 bits
clrl r3 # r2:r3 = q as double float
muld3 r2,r2,r4 # r4:r5 = qq exactly
divd2 r4,r0 # r0:r1 = x/(q*q) rounded
subd3 r2,r0,r6 # r6:r7 = x/(q*q) - q exactly
movq r2,r4 # r4:r5 = q
addw2 $0x80,r4 # r4:r5 = 2 * q
addd2 r0,r4 # r4:r5 = 2*q + x/(q*q)
divd2 r4,r6 # r6:r7 = (x/(q*q)-q)/(2*q+x/(q*q))
muld2 r2,r6 # r6:r7 = q*(x/(q*q)-q)/(2*q+x/(q*q))
addd3 r6,r2,r0 # r0:r1 = q + r6:r7
bisw2 ap,r0 # restore the sign bit
return:
ret # error less than 0.667 ulps
.data
.align 2
B : .long 721142941 # (86-0.03306235651)*(2^23)
C : .float 0f0.5428571429 # 19/35
D : .float 0f-0.7053061224 # -864/1225
E : .float 0f1.414285714 # 99/70
F : .float 0f1.607142857 # 45/28
G : .float 0f0.3571428571 # 5/14

View File

@@ -0,0 +1,110 @@
# Copyright (c) 1985 Regents of the University of California.
# All rights reserved.
#
# Redistribution and use in source and binary forms are permitted provided
# that: (1) source distributions retain this entire copyright notice and
# comment, and (2) distributions including binaries display the following
# acknowledgement: ``This product includes software developed by the
# University of California, Berkeley and its contributors'' in the
# documentation or other materials provided with the distribution and in
# all advertising materials mentioning features or use of this software.
# Neither the name of the University nor the names of its contributors may
# be used to endorse or promote products derived from this software without
# specific prior written permission.
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
LAR PURPOSE.
#
# @(#)sqrt.s 5.4 (Berkeley) 10/9/90
#
.data
.align 2
_sccsid:
.asciz "@(#)sqrt.s 1.1 (Berkeley) 8/21/85; 5.4 (ucb.elefunt) 10/9/90"
/*
* double sqrt(arg) revised August 15,1982
* double arg;
* if(arg<0.0) { _errno = EDOM; return(<a reserved operand>); }
* if arg is a reserved operand it is returned as it is
* W. Kahan's magic square root
* coded by Heidi Stettner and revised by Emile LeBlanc 8/18/82
*
* entry points:_d_sqrt address of double arg is on the stack
* _sqrt double arg is on the stack
*/
.text
.align 1
.globl _sqrt
.globl _d_sqrt
.globl libm$dsqrt_r5
.set EDOM,33
_d_sqrt:
.word 0x003c # save r5,r4,r3,r2
movq *4(ap),r0
jmp dsqrt2
_sqrt:
.word 0x003c # save r5,r4,r3,r2
movq 4(ap),r0
dsqrt2: bicw3 $0x807f,r0,r2 # check exponent of input
jeql noexp # biased exponent is zero -> 0.0 or reserved
bsbb libm$dsqrt_r5
noexp: ret
/* **************************** internal procedure */
libm$dsqrt_r5: # ENTRY POINT FOR cdabs and cdsqrt
# returns double square root scaled by
# 2^r6
movd r0,r4
jleq nonpos # argument is not positive
movzwl r4,r2
ashl $-1,r2,r0
addw2 $0x203c,r0 # r0 has magic initial approximation
/*
* Do two steps of Heron's rule
* ((arg/guess) + guess) / 2 = better guess
*/
divf3 r0,r4,r2
addf2 r2,r0
subw2 $0x80,r0 # divide by two
divf3 r0,r4,r2
addf2 r2,r0
subw2 $0x80,r0 # divide by two
/* Scale argument and approximation to prevent over/underflow */
bicw3 $0x807f,r4,r1
subw2 $0x4080,r1 # r1 contains scaling factor
subw2 r1,r4
movl r0,r2
subw2 r1,r2
/* Cubic step
*
* b = a + 2*a*(n-a*a)/(n+3*a*a) where b is better approximation,
* a is approximation, and n is the original argument.
* (let s be scale factor in the following comments)
*/
clrl r1
clrl r3
muld2 r0,r2 # r2:r3 = a*a/s
subd2 r2,r4 # r4:r5 = n/s - a*a/s
addw2 $0x100,r2 # r2:r3 = 4*a*a/s
addd2 r4,r2 # r2:r3 = n/s + 3*a*a/s
muld2 r0,r4 # r4:r5 = a*n/s - a*a*a/s
divd2 r2,r4 # r4:r5 = a*(n-a*a)/(n+3*a*a)
addw2 $0x80,r4 # r4:r5 = 2*a*(n-a*a)/(n+3*a*a)
addd2 r4,r0 # r0:r1 = a + 2*a*(n-a*a)/(n+3*a*a)
rsb # DONE!
nonpos:
jneq negarg
ret # argument and root are zero
negarg:
pushl $EDOM
calls $1,_infnan # generate the reserved op fault
ret

View File

@@ -0,0 +1,84 @@
# Copyright (c) 1985 Regents of the University of California.
# All rights reserved.
#
# Redistribution and use in source and binary forms are permitted provided
# that: (1) source distributions retain this entire copyright notice and
# comment, and (2) distributions including binaries display the following
# acknowledgement: ``This product includes software developed by the
# University of California, Berkeley and its contributors'' in the
# documentation or other materials provided with the distribution and in
# all advertising materials mentioning features or use of this software.
# Neither the name of the University nor the names of its contributors may
# be used to endorse or promote products derived from this software without
# specific prior written permission.
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
LAR PURPOSE.
#
# @(#)tan.s 5.4 (Berkeley) 10/9/90
#
.data
.align 2
_sccsid:
.asciz "@(#)tan.s 1.1 (Berkeley) 8/21/85; 5.4 (ucb.elefunt) 10/9/90"
# This is the implementation of Peter Tang's double precision
# tangent for the VAX using Bob Corbett's argument reduction.
#
# Notes:
# under 1,024,000 random arguments testing on [0,2*pi]
# tan() observed maximum error = 2.15 ulps
#
# double tan(arg)
# double arg;
# method: true range reduction to [-pi/4,pi/4], P. Tang & B. Corbett
# S. McDonald, April 4, 1985
#
.globl _tan
.text
.align 1
_tan: .word 0xffc # save r2-r11
movq 4(ap),r0
bicw3 $0x807f,r0,r2
beql 1f # if x is zero or reserved operand then return x
#
# Save the PSL's IV & FU bits on the stack.
#
movpsl r2
bicw3 $0xff9f,r2,-(sp)
#
# Clear the IV & FU bits.
#
bicpsw $0x0060
jsb libm$argred
#
# At this point,
# r0 contains the quadrant number, 0, 1, 2, or 3;
# r2/r1 contains the reduced argument as a D-format number;
# r3 contains a F-format extension to the reduced argument;
#
# Save r3/r0 so that we can call cosine after calling sine.
#
movq r2,-(sp)
movq r0,-(sp)
#
# Call sine. r4 = 0 implies sine.
#
movl $0,r4
jsb libm$sincos
#
# Save sin(x) in r11/r10 .
#
movd r0,r10
#
# Call cosine. r4 = 1 implies cosine.
#
movq (sp)+,r0
movq (sp)+,r2
movl $1,r4
jsb libm$sincos
divd3 r0,r10,r0
bispsw (sp)+
1: ret

View File

@@ -0,0 +1,25 @@
/* Copyright (C) 1991 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
The GNU C Library 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with the GNU C Library; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA. */
#include <ansidecl.h>
#include <gnu-stabs.h>
#include <math.h>
#undef copysign
function_alias(copysign, __copysign, double, (x, y),
DEFUN(copysign, (x, y), double x AND double y))

View File

@@ -0,0 +1,25 @@
/* Copyright (C) 1991, 1992 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
The GNU C Library 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with the GNU C Library; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA. */
#include <ansidecl.h>
#include <gnu-stabs.h>
#include <math.h>
#undef drem
function_alias(drem, __drem, double, (x, y),
DEFUN(drem, (x, y), double x AND double y))

View File

@@ -0,0 +1,25 @@
/* Copyright (C) 1992 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
The GNU C Library 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with the GNU C Library; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA. */
#include <ansidecl.h>
#include <gnu-stabs.h>
#include <math.h>
#undef expm1
function_alias(expm1, __expm1, double, (x),
DEFUN(expm1, (x), double x))

View File

@@ -0,0 +1,25 @@
/* Copyright (C) 1991 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
The GNU C Library 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with the GNU C Library; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA. */
#include <ansidecl.h>
#include <gnu-stabs.h>
#include <math.h>
#undef finite
function_alias(finite, __finite, int, (value),
DEFUN(finite, (value), double value))

View File

@@ -0,0 +1,25 @@
/* Copyright (C) 1991 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
The GNU C Library 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with the GNU C Library; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA. */
#include <ansidecl.h>
#include <gnu-stabs.h>
#include <math.h>
#undef infnan
function_alias(infnan, __infnan, double, (error),
DEFUN(infnan, (error), int error))

View File

@@ -0,0 +1,25 @@
/* Copyright (C) 1991 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
The GNU C Library 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with the GNU C Library; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA. */
#include <ansidecl.h>
#include <gnu-stabs.h>
#include <math.h>
#undef isinf
function_alias(isinf, __isinf, int, (value),
DEFUN(isinf, (value), double value))

View File

@@ -0,0 +1,25 @@
/* Copyright (C) 1991 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
The GNU C Library 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with the GNU C Library; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA. */
#include <ansidecl.h>
#include <gnu-stabs.h>
#include <math.h>
#undef isnan
function_alias(isnan, __isnan, int, (value),
DEFUN(isnan, (value), double value))

View File

@@ -0,0 +1,25 @@
/* Copyright (C) 1991 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
The GNU C Library 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with the GNU C Library; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA. */
#include <ansidecl.h>
#include <gnu-stabs.h>
#include <math.h>
#undef logb
function_alias(logb, __logb, double, (x),
DEFUN(logb, (x), double x))

View File

@@ -0,0 +1,277 @@
/* Copyright (C) 1991, 1992 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
The GNU C Library 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with the GNU C Library; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA. */
/*
* ANSI Standard: 4.5 MATHEMATICS <math.h>
*/
#ifndef _MATH_H
#define _MATH_H 1
#include <features.h>
#define __need_Emath
#include <errno.h>
/* Get HUGE_VAL (returned on overflow) from <float.h>. */
#define __need_HUGE_VAL
#include <float.h>
#ifndef __CONSTVALUE
#ifdef __GNUC__
/* The `const' keyword tells GCC that a function's return value is
based solely on its arguments, and there are no side-effects. */
#define __CONSTVALUE __const
#else
#define __CONSTVALUE
#endif /* GCC. */
#endif /* __CONSTVALUE not defined. */
/* Trigonometric functions. */
/* Arc cosine of X. */
extern __CONSTVALUE double EXFUN(acos, (double __x));
/* Arc sine of X. */
extern __CONSTVALUE double EXFUN(asin, (double __x));
/* Arc tangent of X. */
extern __CONSTVALUE double EXFUN(atan, (double __x));
/* Arc tangent of Y/X. */
extern __CONSTVALUE double EXFUN(atan2, (double __y, double __x));
/* Cosine of X. */
extern __CONSTVALUE double EXFUN(cos, (double __x));
/* Sine of X. */
extern __CONSTVALUE double EXFUN(sin, (double __x));
/* Tangent of X. */
extern __CONSTVALUE double EXFUN(tan, (double __x));
/* Hyperbolic functions. */
/* Hyperbolic cosine of X. */
extern __CONSTVALUE double EXFUN(cosh, (double __x));
/* Hyperbolic sine of X. */
extern __CONSTVALUE double EXFUN(sinh, (double __x));
/* Hyperbolic tangent of X. */
extern __CONSTVALUE double EXFUN(tanh, (double __x));
#ifdef __USE_MISC
/* Hyperbolic arc cosine of X. */
extern __CONSTVALUE double EXFUN(acosh, (double __x));
/* Hyperbolic arc sine of X. */
extern __CONSTVALUE double EXFUN(asinh, (double __x));
/* Hyperbolic arc tangent of X. */
extern __CONSTVALUE double EXFUN(atanh, (double __x));
#endif
/* Exponential and logarithmic functions. */
/* Exponentional function of X. */
extern __CONSTVALUE double EXFUN(exp, (double __x));
/* Break VALUE into a normalized fraction and an integral power of 2. */
extern double EXFUN(frexp, (double __value, int *__exp));
/* X times (two to the EXP power). */
extern __CONSTVALUE double EXFUN(ldexp, (double __x, int __exp));
/* Natural logarithm of X. */
extern __CONSTVALUE double EXFUN(log, (double __x));
/* Base-ten logarithm of X. */
extern __CONSTVALUE double EXFUN(log10, (double __x));
#ifdef __USE_MISC
/* Return exp(X) - 1. */
extern __CONSTVALUE double EXFUN(expm1, (double __x));
/* Return log(1 + X). */
extern __CONSTVALUE double EXFUN(log1p, (double __x));
#endif
/* Break VALUE into integral and fractional parts. */
extern double EXFUN(modf, (double __value, double *__iptr));
/* Power functions. */
/* Return X to the Y power. */
extern __CONSTVALUE double EXFUN(pow, (double __x, double __y));
/* Return the square root of X. */
extern __CONSTVALUE double EXFUN(sqrt, (double __x));
#ifdef __USE_MISC
/* Return the cube root of X. */
extern __CONSTVALUE double EXFUN(cbrt, (double __x));
#endif
/* Nearest integer, absolute value, and remainder functions. */
/* Smallest integral value not less than X. */
extern __CONSTVALUE double EXFUN(ceil, (double __x));
/* Absolute value of X. */
extern __CONSTVALUE double EXFUN(fabs, (double __x));
/* Largest integer not greater than X. */
extern __CONSTVALUE double EXFUN(floor, (double __x));
/* Floating-point modulo remainder of X/Y. */
extern __CONSTVALUE double EXFUN(fmod, (double __x, double __y));
/* Return 0 if VALUE is finite or NaN, +1 if it
is +Infinity, -1 if it is -Infinity. */
extern __CONSTVALUE int EXFUN(__isinf, (double __value));
/* Return nonzero if VALUE is not a number. */
extern __CONSTVALUE int EXFUN(__isnan, (double __value));
/* Return nonzero if VALUE is finite and not NaN. */
extern __CONSTVALUE int EXFUN(__finite, (double __value));
#ifdef __OPTIMIZE__
#define __finite(value) (!__isinf(value))
#endif
/* Deal with an infinite or NaN result.
If ERROR is ERANGE, result is +Inf;
if ERROR is - ERANGE, result is -Inf;
otherwise result is NaN.
This will set `errno' to either ERANGE or EDOM,
and may return an infinity or NaN, or may do something else. */
extern double EXFUN(__infnan, (int __error));
/* Return X with its signed changed to Y's. */
extern __CONSTVALUE double EXFUN(__copysign, (double __x, double __y));
/* Return X times (2 to the Nth power). */
extern __CONSTVALUE double EXFUN(__scalb, (double __x, int __n));
#ifdef __OPTIMIZE__
#define __scalb(x, n) ldexp ((x), (n))
#endif
/* Return the remainder of X/Y. */
extern __CONSTVALUE double EXFUN(__drem, (double __x, double __y));
/* Return the base 2 signed integral exponent of X. */
extern __CONSTVALUE double EXFUN(__logb, (double __x));
#ifdef __USE_MISC
/* Return the integer nearest X in the direction of the
prevailing rounding mode. */
extern __CONSTVALUE double EXFUN(rint, (double __x));
/* Return `sqrt(X*X + Y*Y)'. */
extern __CONSTVALUE double EXFUN(hypot, (double __x, double __y));
struct __complex
{
double __x, __y;
};
/* Return `sqrt(X*X + Y*Y)'. */
extern __CONSTVALUE double EXFUN(cabs, (struct __complex));
extern __CONSTVALUE int EXFUN(isinf, (double __value));
extern __CONSTVALUE int EXFUN(isnan, (double __value));
extern __CONSTVALUE int EXFUN(finite, (double __value));
extern __CONSTVALUE double EXFUN(infnan, (int __error));
extern __CONSTVALUE double EXFUN(copysign, (double __x, double __y));
extern __CONSTVALUE double EXFUN(scalb, (double __x, int __n));
extern __CONSTVALUE double EXFUN(drem, (double __x, double __y));
extern __CONSTVALUE double EXFUN(logb, (double __x));
#ifdef __OPTIMIZE__
#define isinf(value) __isinf(value)
#define isnan(value) __isnan(value)
#define infnan(error) __infnan(error)
#define finite(value) __finite(value)
#define copysign(x, y) __copysign((x), (y))
#define scalb(x, n) __scalb((x), (n))
#define drem(x, y) __drem((x), (y))
#define logb(x) __logb(x)
#endif /* Optimizing. */
#endif /* Use misc. */
#if 0
/* The "Future Library Directions" section of the
ANSI Standard reserves these as `float' and
`long double' versions of the above functions. */
extern __CONSTVALUE float EXFUN(acosf, (float __x));
extern __CONSTVALUE float EXFUN(asinf, (float __x));
extern __CONSTVALUE float EXFUN(atanf, (float __x));
extern __CONSTVALUE float EXFUN(atan2f, (float __y, float __x));
extern __CONSTVALUE float EXFUN(cosf, (float __x));
extern __CONSTVALUE float EXFUN(sinf, (float __x));
extern __CONSTVALUE float EXFUN(tanf, (float __x));
extern __CONSTVALUE float EXFUN(coshf, (float __x));
extern __CONSTVALUE float EXFUN(sinhf, (float __x));
extern __CONSTVALUE float EXFUN(tanhf, (float __x));
extern __CONSTVALUE float EXFUN(expf, (float __x));
extern float EXFUN(frexpf, (float __value, int *__exp));
extern __CONSTVALUE float EXFUN(ldexpf, (float __x, int __exp));
extern __CONSTVALUE float EXFUN(logf, (float __x));
extern __CONSTVALUE float EXFUN(log10f, (float __x));
extern float EXFUN(modff, (float __value, float *__iptr));
extern __CONSTVALUE float EXFUN(powf, (float __x, float __y));
extern __CONSTVALUE float EXFUN(sqrtf, (float __x));
extern __CONSTVALUE float EXFUN(ceilf, (float __x));
extern __CONSTVALUE float EXFUN(fabsf, (float __x));
extern __CONSTVALUE float EXFUN(floorf, (float __x));
extern __CONSTVALUE float EXFUN(fmodf, (float __x, float __y));
extern __CONSTVALUE LONG_DOUBLE EXFUN(acosl, (LONG_DOUBLE __x));
extern __CONSTVALUE LONG_DOUBLE EXFUN(asinl, (LONG_DOUBLE __x));
extern __CONSTVALUE LONG_DOUBLE EXFUN(atanl, (LONG_DOUBLE __x));
extern __CONSTVALUE LONG_DOUBLE EXFUN(atan2l,
(LONG_DOUBLE __y, LONG_DOUBLE __x));
extern __CONSTVALUE LONG_DOUBLE EXFUN(cosl, (LONG_DOUBLE __x));
extern __CONSTVALUE LONG_DOUBLE EXFUN(sinl, (LONG_DOUBLE __x));
extern __CONSTVALUE LONG_DOUBLE EXFUN(tanl, (LONG_DOUBLE __x));
extern __CONSTVALUE LONG_DOUBLE EXFUN(coshl, (LONG_DOUBLE __x));
extern __CONSTVALUE LONG_DOUBLE EXFUN(sinhl, (LONG_DOUBLE __x));
extern __CONSTVALUE LONG_DOUBLE EXFUN(tanhl, (LONG_DOUBLE __x));
extern __CONSTVALUE LONG_DOUBLE EXFUN(expl, (LONG_DOUBLE __x));
extern LONG_DOUBLE EXFUN(frexpl, (LONG_DOUBLE __value, int *__exp));
extern __CONSTVALUE LONG_DOUBLE EXFUN(ldexpl, (LONG_DOUBLE __x, int __exp));
extern __CONSTVALUE LONG_DOUBLE EXFUN(logl, (LONG_DOUBLE __x));
extern __CONSTVALUE LONG_DOUBLE EXFUN(log10l, (LONG_DOUBLE __x));
extern LONG_DOUBLE EXFUN(modfl, (LONG_DOUBLE __value, LONG_DOUBLE *__ip));
extern __CONSTVALUE LONG_DOUBLE EXFUN(powl,
(LONG_DOUBLE __x, LONG_DOUBLE __y));
extern __CONSTVALUE LONG_DOUBLE EXFUN(sqrtl, (LONG_DOUBLE __x));
extern __CONSTVALUE LONG_DOUBLE EXFUN(ceill, (LONG_DOUBLE __x));
extern __CONSTVALUE LONG_DOUBLE EXFUN(fabsl, (LONG_DOUBLE __x));
extern __CONSTVALUE LONG_DOUBLE EXFUN(floorl, (LONG_DOUBLE __x));
extern __CONSTVALUE LONG_DOUBLE EXFUN(fmodl,
(LONG_DOUBLE __x, LONG_DOUBLE __y));
#endif /* 0 */
/* Get machine-dependent inline versions (if there are any). */
#include <__math.h>
#endif /* math.h */

View File

@@ -0,0 +1,25 @@
/* Copyright (C) 1992 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
The GNU C Library 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with the GNU C Library; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA. */
#include <ansidecl.h>
#include <gnu-stabs.h>
#include <math.h>
#undef rint
function_alias(rint, __rint, double, (x),
DEFUN(rint, (x), double x))

View File

@@ -0,0 +1,25 @@
/* Copyright (C) 1991 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
The GNU C Library 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with the GNU C Library; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA. */
#include <ansidecl.h>
#include <gnu-stabs.h>
#include <math.h>
#undef scalb
function_alias(scalb, __scalb, double, (x, n),
DEFUN(scalb, (x, n), double x AND int n))

View File

@@ -0,0 +1,55 @@
#include <ansidecl.h>
#include <stdio.h>
#include <math.h>
#include <stdlib.h>
int
DEFUN_VOID(main)
{
CONST char str[] = "123.456";
double x,y,z,h,li,lr,a,lrr;
x = atof (str);
printf ("%g %g\n", x, pow (10.0, 3.0));
x = sinh(2.0);
fprintf(stderr,"sinh(2.0) = %g\n", x);
x = sinh(3.0);
fprintf(stderr,"sinh(3.0) = %g\n", x);
h = hypot(2.0,3.0);
fprintf(stderr,"h=%g\n", h);
a = atan2(3.0, 2.0);
fprintf(stderr,"atan2(3,2) = %g\n", a);
lr = pow(h,4.0);
fprintf(stderr,"pow(%g,4.0) = %g\n", h, lr);
lrr = lr;
li = 4.0 * a;
lr = lr / exp(a*5.0);
fprintf(stderr,"%g / exp(%g * 5) = %g\n", lrr, exp(a*5.0), lr);
lrr = li;
li += 5.0 * log(h);
fprintf(stderr,"%g + 5*log(%g) = %g\n", lrr, h, li);
fprintf(stderr,"cos(%g) = %g, sin(%g) = %g\n", li, cos(li), li, sin(li));
fflush(stderr);
return 0;
}