V9/libc/sun/Fmuls.s
.data
.asciz "@(#)Fmuls.s 1.1 86/02/03 Copyr 1985 Sun Micro"
.even
.text
| Copyright (c) 1985 by Sun Microsystems, Inc.
#include "fpcrtdefs.h"
/*
* ieee single floating multiply
* copyright 1981, 1982 Richard E. James III
* translated to SUN idiom 14 March 1983 rt
*/
/*
* entry conditions:
* first argument in d0
* second argument in d1
* exit conditions:
* result (4 bytes) in d0
*
* register conventions:
* d0 operand1/upper1
* d1 operand2/upper2
* d2 9/lower1
* d3 lower2
* d4 exponent
* d5 sign
*/
SAVEMASK = 0x3c00 | registers d2-d5
RESTMASK = 0x3c
NSAVED = 6*4 | 6 registers * sizeof(register)
RTENTRY(Fsqrs)
movel d0,d1 | Copy second argument.
bras Fmuls2
RTENTRY(Fmuls)
| save registers
Fmuls2:
moveml #SAVEMASK,sp@- | registers d2-d7
| save sign of result
movl d0,d5
eorl d1,d5 | sign of result
asll #1,d0 | toss sign
asll #1,d1 | EEmmmm0
cmpl d1,d0
| order operands (exponents at least)
blss eswap
exg d0,d1 | d1 = larger
| extract and check exponents
eswap: roll #8,d0
roll #8,d1 | mmmmm0ee
clrw d4
movb d0,d4
clrw d3
movb d1,d3
addw d3,d4 | result exp
cmpb #0xff, d1
beqs ofl | infinity or nan
tstb d0
beqs ufl | 0 or gu (denormalized)
| clear exponent; set hidden bit
movb #1,d0
rorl #1,d0
back: movb #1,d1
rorl #1,d1
movl d0,d2 | d2 gets x.
movl d1,d3 | d3 gets y.
swap d0 | d0 gets xu.
swap d1 | d1 gets yu.
movw d1,d5 | d5 gets yu.
mulu d2,d1 | d1 gets xl*yu.
mulu d3,d2 | d2 gets xl*yl.
mulu d0,d3 | d3 gets xu*yl.
mulu d5,d0 | d0 gets xu*yu.
addl d3,d1 | d1 gets middle = xu*yl+xl*yu.
bccs 1$ | Branch if no carry occurred.
addl #0x10000,d0 | Propagate carry to upper product.
1$:
swap d1 | d1 gets middle(m) (ml,mu).
clrl d3
movw d1,d3 | d3 gets (0,mu).
clrw d1 | d1 gets (ml,0).
addl d2,d1 | d1 gets lower part of final product.
addxl d3,d0 | d0 gets upper part of final product.
tstl d1
beqs 2$ | Branch if lower part is exact.
bset #0,d0 | Set sticky bit if lower part has bits.
2$:
subw #126,d4 | toss extra bias
jbsr f_rcp | round check, pack
| build answer
mbuild: rorl #8,d0
roxll #1,d5
roxrl #1,d0 | append sign
| answer in d0
mexit: moveml sp@+,#RESTMASK
RET
| EXCEPTION HANDLING
ofl: clrb d1
tstl d1 | larger mantissa
bnes mni | user larger nan
tstl d0
beqs m_gennan | 0*inf
mni: movb #0xff,d1 | inf or nan
movl d1,d0
bras mbuild
ufl: tstl d0 | mantissa of smaller
beqs mbuild
| normalizing mode is embodied int the next few lines:
bmis back
normden:subql #1,d4 | adj exponent
lsll #1,d0
bpls normden
bras back
m_gennan:movl #0x7f800002, d0
bras mexit
/*
* ieee single floating divide
* copyright 1981, Richard E. James III
* translated to SUN idiom 14 March 1983 rt
*/
/*
* entry conditions:
* first argument in d0
* second argument in d1
* exit conditions:
* result (4 bytes) in d0
*
* register conventions:
* d0 top; ab; rq
* d1 bot; c
* d2 q
* d3 bottom exp; d
* d4 top/ final exp
* d5 sign
*/
|
| same as for multiply, above
| SAVEMASK = 0x3c00 | registers d2-d5
| RESTMASK = 0x3c
| NSAVED = 4*4 | 4 registers * sizeof(register)
RTENTRY(Fdivs)
| save registers
moveml #SAVEMASK,sp@- | registers d2-d5
| determine sign
movl d0,d5
eorl d1,d5 | sign in bit 31
| split out exponent
roll #1,d0
roll #1,d1
roll #8,d0
roll #8,d1
clrw d3
clrw d4
movb d0,d4 | exp of top
movb d1,d3 | exp of bottom
andw #0xfe00,d0 | clear out s, exp
andw #0xfe00,d1 | clear out s, exp
| test exponents
addqb #1,d4 | top
subqw #1,d4
bles toperr
addqb #1,d0 | hidden bit
backtop:addqb #1,d3
subqw #1,d3 | bottom
bles boterr
addqb #1,d1 | hidden bit
| position mantissas
backbot:rorl #2,d1 | 01X...
rorl #4,d0 | 0001X...
| compute tentative exponent
subw d3,d4
| to compute ab/cd:
| first do ab/c -> q, remainder -> r
movw d1,d3 | save d
movw d3,d5 | d5 saves d.
swap d1 | get c
divu d1,d0 | ab/c 29/15->15 bits
movw d0,d2 | save q
mulu d2,d3 | q*d
clrw d0 | r in top
subl d3,d0 | r-q*d = +-31
asrl #2,d0 | avoid ofl
divs d1,d0 | more quotient
movl d0,d1 | d1 gets remainder in upper word.
movw d5,d3 | d3 gets d.
muls d0,d3 | d3 gets signed(q2)*unsigned(d).
btst #15,d5
beqs 99$ | Branch if d appeared positive in muls.
swap d3 | If d appeared negative, correct product.
addw d0,d3
swap d3
99$: |
extl d2 | q
extl d0 | second quot
swap d2
asll #2,d0
addl d2,d0
asll #1,d0
clrw d1 | d1 gets remainder in upper, 0 lower.
subl d3,d1 | d1 gets revised remainder.
beqs adjexp | Branch if exact.
bmis decr | Branch if remainder negative.
bset #0,d0 | inexact => set sticky.
bras adjexp
decr:
subql #1,d0 | Subtract sticky bit for negative remainder.
adjexp: | adjust exponent, round, check extremes, pack
addw #127,d4
jbsr f_rcp
| reposition and append sign
drepk: rorl #8,d0
lsll #1,d5 | sign -> x
roxrl #1,d0 | insert sign
dexit: moveml sp@+,#RESTMASK
RET
| EXCEPTIONS
toperr: bnes 2$
|top is 0 or gu, normalize and return
1$: subqw #1,d4
roll #1,d0
bhis 1$ | loop til normalized, fall if 0
addqw #1,d4
bras backtop | 0 or gu
| top is inf or nan
2$: cmpb d3,d4
beqs dinvop | both inf/nan -> nan
tstl d0
beqs geninf | inf/ ... = +- inf
bras dinvop | nan/... = nan
boterr: beqs botlow | .../(0|gu)
| .../(inf|nan)
tstl d1
bnes dinvop | .../nan = nan
clrl d0 | .../inf = +-0
bras drepk
botlow: tstl d1
beqs 5$ | .../0
| .../gu:
4$: subqw #1,d3
roll #1,d1
bccs 4$ | loop til normalized
addqw #1,d3
jra backbot
| bottom is zero
5$: tstl d0
beqs d_gennan | 0/0 = nan
| nonzero/0 = +-inf
| generate infinity for answer
geninf: movl #0xff,d0
bras drepk
| invalid operand/ operation
dinvop: cmpl d0,d1
bcss 8$ | use larger nan
tstl d1
beqs d_gennan | both are infinity, generate a nan
exg d1,d0 | larger nan
8$: lsrl #8,d0
lsrl #1,d0
bras bldnan | return nan
d_gennan:moveq #4,d0 | nan 4
bldnan: orl #0x7f800000,d0
bras dexit
SAVEMASK = 0x3f00
RESTMASK = 0x00fc
EXP = d2
TYPE = d3
/* type values: */
ZERO = 1 | wonderful
GU = 2
PLAIN = 3
INF = 4
NAN = 5
RTENTRY(Fscaleis)
moveml #SAVEMASK,sp@- | state save
movel d1,d4 | Save argument i.
movel d0,d1 | What a crock!
jbsr f_unpk
cmpb #PLAIN,TYPE | is it a funny number?
bgts gohome | yes -- return argument
cmpb #ZERO,TYPE
beqs gohome | is zero -- return arg
| normal path through here
movw EXP,d7
extl d7 | d7 gets long exponent.
addl d4,d7 | d7 gets modified exponent.
bvcs nooflo | Branch if no overflow.
bmis posov | Branch if positive overflow to -.
| Branch if negative overflow to +.
negov:
movw #-2000,EXP
bras gohome
posov:
movw #2000,EXP
bras gohome
nooflo:
cmpl #2000,d7
bges posov
cmpl #-2000,d7
bles negov
movw d7,EXP | Final OK exponent.
gohome:
jbsr f_pack
movel d1,d0 | What a crock!
gone: moveml sp@+,#RESTMASK
RET