1/* 2 * Copyright (c) 1986, 1993 3 * The Regents of the University of California. All rights reserved. 4 * 5 * This code is derived from software contributed to Berkeley by 6 * Computer Consoles Inc. 7 * 8 * %sccs.include.redist.c% 9 */ 10 11#if defined(SYSLIBC_SCCS) && !defined(lint) 12 .asciz "@(#)muld.s 8.1 (Berkeley) 06/04/93" 13#endif /* SYSLIBC_SCCS and not lint */ 14 15#include <tahoemath/fp.h> 16#include "DEFS.h" 17 18#define HIDDEN 23 /* here we count from 0 not from 1 as in fp.h */ 19 20XENTRY(muld, R2|R3|R4|R5|R6|R7|R8|R9) 21 clrl r3 /* r3 - sign: 0 for positive,1 for negative. */ 22 movl 4(fp),r0 23 jgeq 1f 24 movl $1,r3 251: movl 12(fp),r2 26 jgeq 2f 27 bbc $0,r3,1f /* seconed operand is negative. */ 28 clrl r3 /* if first was negative, make result positive. */ 29 jmp 2f 301: movl $1,r3 /* if first was positive, make result negative. */ 312: andl2 $EXPMASK,r0 /* compute first 'pure'exponent. */ 32 jeql is_res1 33 shrl $EXPSHIFT,r0,r0 34 subl2 $BIASP1,r0 35 andl2 $EXPMASK,r2 /* compute seconed 'pure'exponent. */ 36 jeql is_res2 37 shrl $EXPSHIFT,r2,r2 38 subl2 $BIASP1,r2 39 addl2 r0,r2 /* add the exponents. */ 40 addl2 $(BIASP1+2),r2 41 jleq underflow 42 cmpl r2,$258 /* normalization can make the exp. smaller. */ 43 jgeq overflow 44 /* 45 * We have the sign in r3,the exponent in r2,now is the time to 46 * perform the multiplication... 47 */ 48 /* fetch first fraction: (r0,r1) */ 49 andl3 $(0!(EXPMASK | SIGNBIT)),4(fp),r0 50 orl2 $(0!CLEARHID),r0 51 movl 8(fp),r1 52 shlq $7,r0,r0 /* leave the sign bit cleared. */ 53 54 /* fetch seconed fraction: (r4,r5) */ 55 andl3 $(0!(EXPMASK | SIGNBIT)),12(fp),r4 56 orl2 $(0!CLEARHID),r4 57 movl 16(fp),r5 58 shlq $7,r4,r4 /* leave the sign bit cleared. */ 59 60 /* in the following lp1 stands for least significant part of operand 1, 61 * lp2 for least significant part of operand 2, 62 * mp1 for most significant part of operand 1, 63 * mp2 for most significant part of operand 2. 64 */ 65 66 clrl r6 67 shrl $1,r1,r1 /* clear the sign bit of the lp1. */ 68 jeql 1f 69 emul r1,r4,$0,r6 /* r6,r7 <-- lp1*mp2 */ 70 shlq $1,r6,r6 /* to compensate for the shift we did to clear the sign bit. */ 711: shrl $1,r5,r5 /* clear the sign bit of the lp2. */ 72 jeql 1f 73 emul r0,r5,$0,r8 /* r8,r9 <-- mp1*lp2 */ 74 shlq $1,r8,r8 75 addl2 r9,r7 /* r6,r7 <-- the sum of the products. */ 76 adwc r8,r6 771: emul r0,r4,$0,r0 /* r0,r1 <-- mp1*mp2 */ 78 addl2 r6,r1 /* add the most sig. part of the sum. */ 79 adwc $0,r0 80 movl r0,r4 /* to see how much we realy need to shift. */ 81 movl $6,r5 /* r5 - shift counter. */ 82 shrl $7,r4,r4 /* dummy shift. */ 831: bbs $HIDDEN,r4,realshift 84 shll $1,r4,r4 85 decl r2 /* update exponent. */ 86 jeql underflow 87 decl r5 /* update shift counter. */ 88 jmp 1b 89realshift: 90 shrq r5,r0,r0 91 bbc $0,r1,shiftmore 92 incl r1 /* rounding. */ 93shiftmore: 94 shrq $1,r0,r0 95comb: 96 andl2 $CLEARHID,r0 97 shll $EXPSHIFT,r2,r4 98 orl2 r4,r0 99 cmpl r2,$256 100 jlss 1f 101 callf $4,fpover 102sign: 1031: bbc $0,r3,done 104 orl2 $SIGNBIT,r0 105done: ret 106 107 108 109is_res1: 110 bbc $31,4(fp),retzero 111 callf $4,fpresop 112 ret 113is_res2: 114 bbc $31,12(fp),retzero 115 callf $4,fpresop 116 ret 117 retzero: 118 clrl r0 119 clrl r1 120 ret 121 overflow: 122 callf $4,fpover 123 jmp sign 124 underflow: 125 callf $4,fpunder 126 ret 127