|
|
1.1 root 1:
2: /* @(*)ldexp.s 4.2 (Berkeley) 12/21/80
3: * Tahoe 2/2/83
4: *
5: * double ldexp (value, exp)
6: * double value;
7: * int exp;
8: *
9: * Ldexp returns value*2**exp, if that result is in range.
10: * If underflow occurs, it returns zero. If overflow occurs,
11: * it returns a value of appropriate sign and largest
12: * possible magnitude. In case of either overflow or underflow,
13: * the external int "errno" is set to ERANGE. Note that errno is
14: * not modified if no error occurs, so if you intend to test it
15: * after you use ldexp, you had better set it to something
16: * other than ERANGE first (zero is a reasonable value to use).
17: *
18: * Constants
19: */
20: .set erange,34 /* error number for range error */
21:
22: /* Constants to be in a flt.h file . (?) */
23:
24: .set EXPMASK, 0x7f800000
25: .set SIGNBIT, 0x80000000
26: .set EXPSHIFT, 23
27: .data
28: .globl _errno /* error flag */
29:
30: huge0: .word 0x7fff /* The largest number that can */
31: .word 0xffff /* be represented in a long floating */
32: huge1: .word 0xffff /* number. */
33: .word 0xffff
34: /*
35: * Entry point
36: */
37: .text
38: .globl _ldexp
39: _ldexp: .word 0x0004 /* We use r2 */
40:
41: movl 4(fp),r0 /* Fetch "value" */
42: movl 8(fp),r1
43:
44: andl3 $EXPMASK,r0,r2 /* r2 := shifted biased exponent */
45: jeql ld1 /* If it's zero, we're done */
46: shar $EXPSHIFT,r2,r2 /* shift to get value of exponent */
47:
48: addl2 12(fp),r2 /* r2 := new biased exponent */
49: jleq under /* if it's <= 0, we have an underflow */
50: cmpl r2,$256 /* Otherwise check if it's too big */
51: jgeq over /* jump if overflow */
52: /*
53: * Construct the result and return
54: */
55: andl2 $0!EXPMASK,r0 /* clear old exponent */
56: shal $EXPSHIFT,r2,r2 /* Put the exponent back in the result */
57: orl2 r2,r0
58: ld1: ret
59: /*
60: * Underflow
61: */
62: under: clrl r0 /* Result is zero */
63: clrl r1
64: jbr err /* Join general error code */
65: /*
66: * Overflow
67: */
68: over: movl huge0,r0 /* Largest possible floating magnitude */
69: movl huge1,r1
70: jbc $31,4(fp),err /* Jump if argument was positive */
71: orl2 $SIGNBIT,r0 /* If arg < 0, make result negative */
72:
73: err: movl $erange,_errno /* Indicate range error */
74: ret
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.