|
|
1.1 root 1: /* Kmulf.s 1.3 86/01/05 */
2:
3: #include "../tahoemath/fp.h"
4: #include "../tahoemath/Kfp.h"
5: #include "../tahoe/SYS.h"
6:
7: #define HIDDEN 23 /* here we count from 0 not from 1 as in fp.h */
8:
9: /*
10: * _Kmulf(acc_most,acc_least,op_most,op_least,hfs)
11: */
12: .text
13: ENTRY(Kmulf, R5|R4|R3|R2)
14: clrl r3 /* r3 - sign: 0 for positive,1 for negative. */
15: movl 4(fp),r0
16: jgeq 1f
17: movl $1,r3
18: 1: movl 12(fp),r2
19: jgeq 2f
20: bbc $0,r3,1f /* seconed operand is negative. */
21: clrl r3 /* if first was negative, make result positive. */
22: jmp 2f
23: 1: movl $1,r3 /* if first was positive, make result negative. */
24: 2: andl2 $EXPMASK,r0 /* compute first 'pure'exponent. */
25: jeql retzero
26: shrl $EXPSHIFT,r0,r0
27: subl2 $BIASP1,r0
28: andl2 $EXPMASK,r2 /* compute seconed 'pure'exponent. */
29: jeql retzero
30: shrl $EXPSHIFT,r2,r2
31: subl2 $BIASP1,r2
32: addl2 r0,r2 /* add the exponents. */
33: addl2 $(BIASP1+2),r2
34: jleq underflow
35: cmpl r2,$258 /* normalization can make the exp. smaller. */
36: jgeq overflow
37: /*
38: * We have the sign in r3,the exponent in r2,now is the time to
39: * perform the multiplication...
40: */
41: /* fetch first fraction: (r0) */
42: andl3 $(0!(EXPMASK | SIGNBIT)),4(fp),r0
43: orl2 $(0!CLEARHID),r0
44: shll $7,r0,r0 /* leave the sign bit cleared. */
45:
46: /* fetch seconed fraction: (r4) */
47: andl3 $(0!(EXPMASK | SIGNBIT)),12(fp),r4
48: orl2 $(0!CLEARHID),r4
49: shll $7,r4,r4 /* leave the sign bit cleared. */
50:
51:
52: emul r4,r0,$0,r0
53: movl r0,r4 /* to see how much we realy need to shift. */
54: movl $6,r5 /* r5 - shift counter. */
55: shrl $7,r4,r4 /* dummy shift. */
56: 1: bbs $HIDDEN,r4,realshift
57: shll $1,r4,r4
58: decl r2 /* update exponent. */
59: jeql underflow
60: decl r5 /* update shift counter. */
61: jmp 1b
62: realshift:
63: shrl r5,r0,r0
64: bbc $0,r1,shiftmore
65: incl r1 /* rounding. */
66: shiftmore:
67: shrl $1,r0,r0
68: comb:
69: andl2 $CLEARHID,r0
70: shll $EXPSHIFT,r2,r4
71: orl2 r4,r0
72: cmpl r2,$256
73: jlss 1f
74: orl2 $HFS_OVF,*20(fp)
75: sign:
76: 1: bbc $0,r3,done
77: orl2 $SIGNBIT,r0
78: done: ret
79:
80:
81:
82: retzero:
83: clrl r0
84: ret
85: overflow:
86: orl2 $HFS_OVF,*20(fp)
87: jmp sign
88: underflow:
89: orl2 $HFS_UNDF,*20(fp)
90: ret
91:
92:
93:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.