|
|
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.