1/* Kmuld.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 * _Kmuld(acc_most,acc_least,op_most,op_least,hfs) 11 */ 12 .text 13ENTRY(Kmuld, R9|R8|R7|R6|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 181: movl 12(fp),r2 19 jgeq 2f 20 bbc $0,r3,1f /* seconed operand is negative. */ 21 clrl r3 /* if first was neg, make result pos */ 22 jmp 2f 231: movl $1,r3 /* if first was pos, make result neg */ 242: 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,r1) */ 42 andl3 $(0!(EXPMASK | SIGNBIT)),4(fp),r0 43 orl2 $(0!CLEARHID),r0 44 movl 8(fp),r1 45 shlq $7,r0,r0 /* leave the sign bit cleared. */ 46 47 /* fetch seconed fraction: (r4,r5) */ 48 andl3 $(0!(EXPMASK | SIGNBIT)),12(fp),r4 49 orl2 $(0!CLEARHID),r4 50 movl 16(fp),r5 51 shlq $7,r4,r4 /* leave the sign bit cleared. */ 52 53 /* in the following lp1 stands for least significant part of operand 1, 54 * lp2 for least significant part of operand 2, 55 * mp1 for most significant part of operand 1, 56 * mp2 for most significant part of operand 2. 57 */ 58 59 clrl r6 60 shrl $1,r1,r1 /* clear the sign bit of the lp1. */ 61 jeql 1f 62 emul r1,r4,$0,r6 /* r6,r7 <-- lp1*mp2 */ 63 shlq $1,r6,r6 /* to compensate for the shift we did to clear the sign bit. */ 641: shrl $1,r5,r5 /* clear the sign bit of the lp2. */ 65 jeql 1f 66 emul r0,r5,$0,r8 /* r8,r9 <-- mp1*lp2 */ 67 shlq $1,r8,r8 68 addl2 r9,r7 /* r6,r7 <-- the sum of the products. */ 69 adwc r8,r6 701: emul r0,r4,$0,r0 /* r0,r1 <-- mp1*mp2 */ 71 addl2 r6,r1 /* add the most sig. part of the sum. */ 72 adwc $0,r0 73 movl r0,r4 /* to see how much we realy need to shift. */ 74 movl $6,r5 /* r5 - shift counter. */ 75 shrl $7,r4,r4 /* dummy shift. */ 761: bbs $HIDDEN,r4,realshift 77 shll $1,r4,r4 78 decl r2 /* update exponent. */ 79 jeql underflow 80 decl r5 /* update shift counter. */ 81 jmp 1b 82realshift: 83 shrq r5,r0,r0 84 bbc $0,r1,shiftmore 85 incl r1 /* rounding. */ 86shiftmore: 87 shrq $1,r0,r0 88comb: 89 andl2 $CLEARHID,r0 90 shll $EXPSHIFT,r2,r4 91 orl2 r4,r0 92 cmpl r2,$256 93 jlss 1f 94 orl2 $HFS_OVF,*20(fp) 95sign: 961: bbc $0,r3,done 97 orl2 $SIGNBIT,r0 98done: ret 99 100retzero: 101 clrl r0 102 clrl r1 103 ret 104overflow: 105 orl2 $HFS_OVF,*20(fp) 106 ret 107underflow: 108 orl2 $HFS_UNDF,*20(fp) 109 ret 110