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