|
|
1.1 root 1: /*
2: * Copyright (c) 1988 Regents of the University of California.
3: * All rights reserved.
4: *
5: * Redistribution and use in source and binary forms are permitted
6: * provided that the above copyright notice and this paragraph are
7: * duplicated in all such forms and that any documentation,
8: * advertising materials, and other materials related to such
9: * distribution and use acknowledge that the software was developed
10: * by the University of California, Berkeley. The name of the
11: * University may not be used to endorse or promote products derived
12: * from this software without specific prior written permission.
13: * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
14: * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
15: * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
16: *
17: * This code is derived from software contributed to Berkeley by
18: * Computer Consoles Inc.
19: */
20:
21: #if defined(LIBC_SCCS) && !defined(lint)
22: .asciz "@(#)ldexp.s 1.3 (Berkeley) 6/27/88"
23: #endif /* LIBC_SCCS and not lint */
24:
25: /*
26: * double ldexp (value, exp)
27: * double value;
28: * int exp;
29: *
30: * Ldexp returns value*2**exp, if that result is in range.
31: * If underflow occurs, it returns zero. If overflow occurs,
32: * it returns a value of appropriate sign and largest
33: * possible magnitude. In case of either overflow or underflow,
34: * the external int "errno" is set to ERANGE. Note that errno is
35: * not modified if no error occurs, so if you intend to test it
36: * after you use ldexp, you had better set it to something
37: * other than ERANGE first (zero is a reasonable value to use).
38: *
39: * Constants
40: */
41: #include <errno.h>
42: #include <tahoemath/fp.h>
43:
44: #include "DEFS.h"
45:
46: ENTRY(ldexp, 0)
47: movl 4(fp),r0 /* Fetch "value" */
48: movl 8(fp),r1
49:
50: andl3 $EXPMASK,r0,r2 /* r2 := shifted biased exponent */
51: jeql ld1 /* If it's zero, we're done */
52: shar $EXPSHIFT,r2,r2 /* shift to get value of exponent */
53:
54: addl2 12(fp),r2 /* r2 := new biased exponent */
55: jleq under /* if it's <= 0, we have an underflow */
56: cmpl r2,$256 /* Otherwise check if it's too big */
57: jgeq over /* jump if overflow */
58: /*
59: * Construct the result and return
60: */
61: andl2 $0!EXPMASK,r0 /* clear old exponent */
62: shal $EXPSHIFT,r2,r2 /* Put the exponent back in the result */
63: orl2 r2,r0
64: ld1: ret
65: /*
66: * Underflow
67: */
68: under: clrl r0 /* Result is zero */
69: clrl r1
70: jbr err /* Join general error code */
71: /*
72: * Overflow
73: */
74: over: movl huge0,r0 /* Largest possible floating magnitude */
75: movl huge1,r1
76: jbc $31,4(fp),err /* Jump if argument was positive */
77: orl2 $SIGNBIT,r0 /* If arg < 0, make result negative */
78:
79: err: movl $ERANGE,_errno /* Indicate range error */
80: ret
81:
82: .data
83: .globl _errno /* error flag */
84: huge0: .word 0x7fff /* The largest number that can */
85: .word 0xffff /* be represented in a long floating */
86: huge1: .word 0xffff /* number. */
87: .word 0xffff
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.