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