1/*- 2 * Copyright (c) 1985 The Regents of the University of California. 3 * 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 * @(#)Kmuld.s 7.1 (Berkeley) 12/06/90 11 */ 12 13#include "../math/fp.h" 14#include "../math/Kfp.h" 15#include "../tahoe/SYS.h" 16 17#define HIDDEN 23 /* here we count from 0 not from 1 as in fp.h */ 18 19/* 20 * _Kmuld(acc_most,acc_least,op_most,op_least,hfs) 21 */ 22 .text 23ENTRY(Kmuld, R9|R8|R7|R6|R5|R4|R3|R2) 24 clrl r3 /* r3 - sign: 0 for positive,1 for negative. */ 25 movl 4(fp),r0 26 jgeq 1f 27 movl $1,r3 281: movl 12(fp),r2 29 jgeq 2f 30 bbc $0,r3,1f /* seconed operand is negative. */ 31 clrl r3 /* if first was neg, make result pos */ 32 jmp 2f 331: movl $1,r3 /* if first was pos, make result neg */ 342: andl2 $EXPMASK,r0 /* compute first 'pure'exponent. */ 35 jeql retzero 36 shrl $EXPSHIFT,r0,r0 37 subl2 $BIASP1,r0 38 andl2 $EXPMASK,r2 /* compute seconed 'pure'exponent. */ 39 jeql retzero 40 shrl $EXPSHIFT,r2,r2 41 subl2 $BIASP1,r2 42 addl2 r0,r2 /* add the exponents. */ 43 addl2 $(BIASP1+2),r2 44 jleq underflow 45 cmpl r2,$258 /* normalization can make the exp. smaller. */ 46 jgeq overflow 47 /* 48 * We have the sign in r3,the exponent in r2,now is the time to 49 * perform the multiplication... 50 */ 51 /* fetch first fraction: (r0,r1) */ 52 andl3 $(0!(EXPMASK | SIGNBIT)),4(fp),r0 53 orl2 $(0!CLEARHID),r0 54 movl 8(fp),r1 55 shlq $7,r0,r0 /* leave the sign bit cleared. */ 56 57 /* fetch seconed fraction: (r4,r5) */ 58 andl3 $(0!(EXPMASK | SIGNBIT)),12(fp),r4 59 orl2 $(0!CLEARHID),r4 60 movl 16(fp),r5 61 shlq $7,r4,r4 /* leave the sign bit cleared. */ 62 63 /* in the following lp1 stands for least significant part of operand 1, 64 * lp2 for least significant part of operand 2, 65 * mp1 for most significant part of operand 1, 66 * mp2 for most significant part of operand 2. 67 */ 68 69 clrl r6 70 shrl $1,r1,r1 /* clear the sign bit of the lp1. */ 71 jeql 1f 72 emul r1,r4,$0,r6 /* r6,r7 <-- lp1*mp2 */ 73 shlq $1,r6,r6 /* to compensate for the shift we did to clear the sign bit. */ 741: shrl $1,r5,r5 /* clear the sign bit of the lp2. */ 75 jeql 1f 76 emul r0,r5,$0,r8 /* r8,r9 <-- mp1*lp2 */ 77 shlq $1,r8,r8 78 addl2 r9,r7 /* r6,r7 <-- the sum of the products. */ 79 adwc r8,r6 801: emul r0,r4,$0,r0 /* r0,r1 <-- mp1*mp2 */ 81 addl2 r6,r1 /* add the most sig. part of the sum. */ 82 adwc $0,r0 83 movl r0,r4 /* to see how much we realy need to shift. */ 84 movl $6,r5 /* r5 - shift counter. */ 85 shrl $7,r4,r4 /* dummy shift. */ 861: bbs $HIDDEN,r4,realshift 87 shll $1,r4,r4 88 decl r2 /* update exponent. */ 89 jeql underflow 90 decl r5 /* update shift counter. */ 91 jmp 1b 92realshift: 93 shrq r5,r0,r0 94 bbc $0,r1,shiftmore 95 incl r1 /* rounding. */ 96shiftmore: 97 shrq $1,r0,r0 98comb: 99 andl2 $CLEARHID,r0 100 shll $EXPSHIFT,r2,r4 101 orl2 r4,r0 102 cmpl r2,$256 103 jlss 1f 104 orl2 $HFS_OVF,*20(fp) 105sign: 1061: bbc $0,r3,done 107 orl2 $SIGNBIT,r0 108done: ret 109 110retzero: 111 clrl r0 112 clrl r1 113 ret 114overflow: 115 orl2 $HFS_OVF,*20(fp) 116 ret 117underflow: 118 orl2 $HFS_UNDF,*20(fp) 119 ret 120