154387Storek /*
2*61168Sbostic * Copyright (c) 1992, 1993
3*61168Sbostic * The Regents of the University of California. All rights reserved.
454387Storek *
554387Storek * This software was developed by the Computer Systems Engineering group
654387Storek * at Lawrence Berkeley Laboratory under DARPA contract BG 91-66 and
754387Storek * contributed to Berkeley.
854387Storek *
954387Storek * %sccs.include.redist.c%
1054387Storek *
1154387Storek * from: $Header: ldexp.c,v 1.1 91/07/07 04:28:19 torek Exp $
1254387Storek */
1354387Storek
1454387Storek #if defined(LIBC_SCCS) && !defined(lint)
15*61168Sbostic static const char sccsid[] = "@(#)ldexp.c 8.1 (Berkeley) 06/04/93";
1654387Storek #endif /* LIBC_SCCS and not lint */
1754387Storek
1854387Storek #include <sys/types.h>
1954387Storek #include <machine/ieee.h>
2054387Storek #include <errno.h>
2154387Storek
2254387Storek /*
2354387Storek * double ldexp(double val, int exp)
2454387Storek * returns: val * (2**exp)
2554387Storek */
2654387Storek double
ldexp(val,exp)2754387Storek ldexp(val, exp)
2854387Storek double val;
2954387Storek int exp;
3054387Storek {
3154387Storek register int oldexp, newexp, mulexp;
3254387Storek union doub {
3354387Storek double v;
3454387Storek struct ieee_double s;
3554387Storek } u, mul;
3654387Storek
3754387Storek /*
3854387Storek * If input is zero, or no change, just return input.
3954387Storek * Likewise, if input is Inf or NaN, just return it.
4054387Storek */
4154387Storek u.v = val;
4254387Storek oldexp = u.s.dbl_exp;
4354387Storek if (val == 0 || exp == 0 || oldexp == DBL_EXP_INFNAN)
4454387Storek return (val);
4554387Storek
4654387Storek /*
4754387Storek * Compute new exponent and check for over/under flow.
4854387Storek * Underflow, unfortunately, could mean switching to denormal.
4954387Storek * If result out of range, set ERANGE and return 0 if too small
5054387Storek * or Inf if too big, with the same sign as the input value.
5154387Storek */
5254387Storek newexp = oldexp + exp;
5354387Storek if (newexp >= DBL_EXP_INFNAN) {
5454387Storek /* u.s.dbl_sign = val < 0; -- already set */
5554387Storek u.s.dbl_exp = DBL_EXP_INFNAN;
5654387Storek u.s.dbl_frach = u.s.dbl_fracl = 0;
5754387Storek errno = ERANGE;
5854387Storek return (u.v); /* Inf */
5954387Storek }
6054387Storek if (newexp <= 0) {
6154387Storek /*
6254387Storek * The output number is either a denormal or underflows
6354387Storek * (see comments in machine/ieee.h).
6454387Storek */
6554387Storek if (newexp <= -DBL_FRACBITS) {
6654387Storek /* u.s.dbl_sign = val < 0; -- already set */
6754387Storek u.s.dbl_exp = 0;
6854387Storek u.s.dbl_frach = u.s.dbl_fracl = 0;
6954387Storek errno = ERANGE;
7054387Storek return (u.v); /* zero */
7154387Storek }
7254387Storek /*
7354387Storek * We are going to produce a denorm. Our `exp' argument
7454387Storek * might be as small as -2097, and we cannot compute
7554387Storek * 2^-2097, so we may have to do this as many as three
7654387Storek * steps (not just two, as for positive `exp's below).
7754387Storek */
7854387Storek mul.v = 0;
7954387Storek while (exp <= -DBL_EXP_BIAS) {
8054387Storek mul.s.dbl_exp = 1;
8154387Storek val *= mul.v;
8254387Storek exp += DBL_EXP_BIAS - 1;
8354387Storek }
8454387Storek mul.s.dbl_exp = exp + DBL_EXP_BIAS;
8554387Storek val *= mul.v;
8654387Storek return (val);
8754387Storek }
8854387Storek
8954387Storek /*
9054387Storek * Newexp is positive.
9154387Storek *
9254387Storek * If oldexp is zero, we are starting with a denorm, and simply
9354387Storek * adjusting the exponent will produce bogus answers. We need
9454387Storek * to fix that first.
9554387Storek */
9654387Storek if (oldexp == 0) {
9754387Storek /*
9854387Storek * Multiply by 2^mulexp to make the number normalizable.
9954387Storek * We cannot multiply by more than 2^1023, but `exp'
10054387Storek * argument might be as large as 2046. A single
10154387Storek * adjustment, however, will normalize the number even
10254387Storek * for huge `exp's, and then we can use exponent
10354387Storek * arithmetic just as for normal `double's.
10454387Storek */
10554387Storek mulexp = exp <= DBL_EXP_BIAS ? exp : DBL_EXP_BIAS;
10654387Storek mul.v = 0;
10754387Storek mul.s.dbl_exp = mulexp + DBL_EXP_BIAS;
10854387Storek val *= mul.v;
10954387Storek if (mulexp == exp)
11054387Storek return (val);
11154387Storek u.v = val;
11254387Storek newexp -= mulexp;
11354387Storek }
11454387Storek
11554387Storek /*
11654387Storek * Both oldexp and newexp are positive; just replace the
11754387Storek * old exponent with the new one.
11854387Storek */
11954387Storek u.s.dbl_exp = newexp;
12054387Storek return (u.v);
12154387Storek }
122