|
|
1.1 ! root 1: /* Kldexpf.s 1.3 86/01/05 */ ! 2: ! 3: #include "../tahoe/SYS.h" ! 4: #include "../tahoemath/fp.h" ! 5: #include "../tahoemath/Kfp.h" ! 6: ! 7: /* @(*)Kldexpf.s 4.2 (Berkeley) 12/21/80 ! 8: * Tahoe 2/2/83 ! 9: * ! 10: * float Kldexpf (op_most, op_least, exp, hfs) ! 11: * ! 12: * Ldexp returns value*2**exp, if that result is in range. ! 13: * If underflow occurs, it returns zero. If overflow occurs, ! 14: * it returns a value of appropriate sign and largest ! 15: * possible magnitude. In case of either overflow or underflow, ! 16: * the external int "errno" is set to ERANGE. Note that errno is ! 17: * not modified if no error occurs, so if you intend to test it ! 18: * after you use Kldexpf, you had better set it to something ! 19: * other than ERANGE first (zero is a reasonable value to use). ! 20: */ ! 21: ! 22: .text ! 23: ENTRY(Kldexpf, R2) ! 24: movl 4(fp),r0 /* Fetch "value" */ ! 25: movl 8(fp),r1 ! 26: ! 27: andl3 $EXPMASK,r0,r2 /* r2 := shifted biased exponent */ ! 28: jeql ld1 /* If it's zero, we're done */ ! 29: shar $EXPSHIFT,r2,r2 /* shift to get value of exponent */ ! 30: ! 31: addl2 12(fp),r2 /* r2 := new biased exponent */ ! 32: jleq under /* if it's <= 0, we have an underflow */ ! 33: cmpl r2,$256 /* Otherwise check if it's too big */ ! 34: jgeq over /* jump if overflow */ ! 35: /* ! 36: * Construct the result and return ! 37: */ ! 38: andl2 $0!EXPMASK,r0 /* clear old exponent */ ! 39: shal $EXPSHIFT,r2,r2 /* Put the exponent back in the result */ ! 40: orl2 r2,r0 ! 41: ld1: ret ! 42: /* ! 43: * Underflow ! 44: */ ! 45: under: clrl r0 /* Result is zero */ ! 46: clrl r1 ! 47: orl2 $HFS_UNDF,*16(fp) ! 48: jmp err /* Join general error code */ ! 49: /* ! 50: * Overflow ! 51: */ ! 52: over: movl huge0,r0 /* Largest possible floating magnitude */ ! 53: movl huge1,r1 ! 54: orl2 $HFS_OVF,*16(fp) ! 55: orl2 $SIGNBIT,r0 /* If arg < 0, make result negative */ ! 56: ! 57: err: orl2 $HFS_RANGE,*16(fp) /* Indicate range error */ ! 58: ret ! 59: ! 60: .data ! 61: huge0: .long 0x7fffffff ! 62: huge1: .long 0xffffffff
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.