|
|
1.1 ! root 1: /* Kmodf.s 1.3 86/01/05 */ ! 2: ! 3: #include "../tahoe/SYS.h" ! 4: #include "../tahoemath/fp.h" ! 5: ! 6: /* ! 7: * float Kmodf (value, iptr, hfs) ! 8: * float value, *iptr; ! 9: * int hfs; ! 10: * ! 11: * Modf returns the fractional part of "value", ! 12: * and stores the integer part indirectly through "iptr". ! 13: */ ! 14: .text ! 15: ENTRY(Kmodf, R8|R7|R6|R5|R4|R3|R2) ! 16: /* ! 17: * Some initializations: ! 18: */ ! 19: clrl r3 ! 20: movl 4(fp),r0 /* fetch operand to r0. */ ! 21: movl 8(fp),r1 ! 22: movl 12(fp),r6 /* fetch addr of int to r6. */ ! 23: /* ! 24: * get exponent ! 25: */ ! 26: andl3 $EXPMASK,r0,r2 /* r2 will hold the exponent. */ ! 27: shrl $EXPSHIFT,r2,r2 ! 28: subl2 $BIAS,r2 /* unbias it. */ ! 29: jleq allfrac /* it's int part is zero. */ ! 30: cmpl r2,$56 ! 31: jgeq allint /* it's fraction part is zero. */ ! 32: /* ! 33: * get fraction ! 34: */ ! 35: movl r0,r4 /* remember the original number. */ ! 36: movl r1,r5 ! 37: bbc $31,r0,positive /* if negative remember it. */ ! 38: incl r3 ! 39: positive: ! 40: /* clear the non fraction parts. */ ! 41: andl2 $(0!(EXPMASK | SIGNBIT)),r0 ! 42: /* add the hidden bit. */ ! 43: orl2 $(0!CLEARHID),r0 ! 44: ! 45: cmpl r2,$HID_POS /* see if there are bits to clear only in r0 */ ! 46: jgtr in_r1 /* some bytes in r1 */ ! 47: jeql onlyallr0 /* all r0 must be cleared. */ ! 48: mnegl r2,r7 /* r7 - loop counter. */ ! 49: movl $CLEARHID,r8 /* first bit to clear. */ ! 50: 1: ! 51: andl2 r8,r0 /* clear int. bits from fraction part. */ ! 52: shar $1,r8,r8 ! 53: aoblss $0,r7,1b ! 54: 1: ! 55: andl2 r8,r4 /* clear frac bits for int calculation: */ ! 56: shar $1,r8,r8 ! 57: cmpl $0xffffffff,r8 ! 58: jneq 1b ! 59: clrl r5 ! 60: jmp norm ! 61: ! 62: onlyallr0: ! 63: clrl r0 ! 64: clrl r5 ! 65: jmp norm ! 66: ! 67: in_r1: ! 68: clrl r0 ! 69: subl3 r2,$HID_POS,r7 ! 70: movl $0x7fffffff,r8 ! 71: 1: ! 72: andl2 r8,r1 ! 73: shar $1,r8,r8 ! 74: orl2 $0x80000000,r8 ! 75: aoblss $0,r7,1b ! 76: 1: ! 77: andl2 r8,r5 ! 78: shar $1,r8,r8 ! 79: cmpl $0xffffffff,r8 ! 80: jneq 1b ! 81: norm: ! 82: addl2 $BIAS,r2 /* fnorm expects it biased. */ ! 83: pushl 16(fp) /* hfs */ ! 84: callf $8,_Kfnorm /* normelize fraction part. */ ! 85: cmpl $0,r0 ! 86: jeql 1f ! 87: bbc $0,r3,1f ! 88: orl2 $0x80000000,r0 ! 89: 1: ! 90: movl r4,(r6) /* put int part in place. */ ! 91: movl r5,4(r6) ! 92: ret ! 93: ! 94: allint: ! 95: movl r0,(r6) /* copy the argument to the int addr. */ ! 96: movl r1,4(r6) ! 97: clrl r0 /* clear the fraction part. */ ! 98: clrl r1 ! 99: ret ! 100: ! 101: allfrac: ! 102: /* the fraction is ready in r0. */ ! 103: clrl (r6) /* zero the int part. */ ! 104: clrl 4(r6) ! 105: ret ! 106: ! 107: ret_zero: ! 108: clrl (r6) ! 109: clrl 4(r6) ! 110: clrl r0 ! 111: clrl r1 ! 112: ret
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.