ack/mach/m65oo2/libem/fp8087.s

616 lines
7.1 KiB
ArmAsm

.define .adf4, .adf8, .sbf4, .sbf8, .mlf4, .mlf8, .dvf4, .dvf8
.define .ngf4, .ngf8, .fif4, .fif8, .fef4, .fef8
.define .cif4, .cif8, .cuf4, .cuf8, .cfi, .cfu, .cff4, .cff8
.define .cmf4, .cmf8
.sect .text; .sect .rom; .sect .data; .sect .bss
! $Id$
! Implement interface to floating point package for Intel 8087
.sect .rom
one:
.data2 1
two:
.data2 2
bigmin:
.data2 0, -32768
.sect .text
.adf4:
mov bx,sp
wait
flds 2(bx)
wait
fadds 6(bx)
wait
fstps 6(bx)
wait
ret
.adf8:
mov bx,sp
wait
fldd 2(bx)
wait
faddd 10(bx)
wait
fstpd 10(bx)
wait
ret
.sbf4:
mov bx,sp
wait
flds 6(bx)
wait
fsubs 2(bx)
wait
fstps 6(bx)
wait
ret
.sbf8:
mov bx,sp
wait
fldd 10(bx)
wait
fsubd 2(bx)
wait
fstpd 10(bx)
wait
ret
.mlf4:
mov bx,sp
wait
flds 2(bx)
wait
fmuls 6(bx)
wait
fstps 6(bx)
wait
ret
.mlf8:
mov bx,sp
wait
fldd 2(bx)
wait
fmuld 10(bx)
wait
fstpd 10(bx)
wait
ret
.dvf4:
mov bx,sp
wait
flds 6(bx)
wait
fdivs 2(bx)
wait
fstps 6(bx)
wait
ret
.dvf8:
mov bx,sp
wait
fldd 10(bx)
wait
fdivd 2(bx)
wait
fstpd 10(bx)
wait
ret
.ngf4:
mov bx,sp
wait
flds 2(bx)
wait
fchs
wait
fstps 2(bx)
wait
ret
.ngf8:
mov bx,sp
wait
fldd 2(bx)
wait
fchs
wait
fstpd 2(bx)
wait
ret
.fif4:
mov bx,sp
push bx ! make room for FP status word
wait
flds 4(bx)
wait
fmuls 8(bx) ! multiply
wait
fld st ! copy result
wait
ftst ! test sign; handle negative separately
wait
fstsw -2(bx)
wait
mov ax,-2(bx)
sahf ! result of test in condition codes
jb 1f
frndint ! this one rounds (?)
wait
fcom st(1) ! compare with original; if <=, then OK
wait
fstsw -2(bx)
wait
mov ax,-2(bx)
sahf
jbe 2f
fisubs (one) ! else subtract 1
wait
jmp 2f
1: ! here, negative case
frndint ! this one rounds (?)
wait
fcom st(1) ! compare with original; if >=, then OK
wait
fstsw -2(bx)
wait
mov ax,-2(bx)
sahf
jae 2f
fiadds (one) ! else add 1
wait
2:
fsub st(1),st ! subtract integer part
wait
mov bx,2(bx)
fstps (bx)
wait
fstps 4(bx)
wait
pop bx
ret
.fif8:
mov bx,sp
push bx ! make room for FP status word
wait
fldd 4(bx)
wait
fmuld 12(bx) ! multiply
wait
fld st ! and copy result
wait
ftst ! test sign; handle negative separately
wait
fstsw -2(bx)
wait
mov ax,-2(bx)
sahf ! result of test in condition codes
jb 1f
frndint ! this one rounds (?)
wait
fcom st(1) ! compare with original; if <=, then OK
wait
fstsw -2(bx)
wait
mov ax,-2(bx)
sahf
jbe 2f
fisubs (one) ! else subtract 1
wait
jmp 2f
1: ! here, negative case
frndint ! this one rounds (?)
wait
fcom st(1) ! compare with original; if >=, then OK
wait
fstsw -2(bx)
wait
mov ax,-2(bx)
sahf
jae 2f
fiadds (one) ! else add 1
wait
2:
fsub st(1),st ! subtract integer part
mov bx,2(bx)
fstpd (bx)
wait
fstpd 8(bx)
wait
pop bx
ret
.fef4:
! this could be simpler, if only the
! fxtract instruction was emulated properly
mov bx,sp
mov ax,6(bx)
and ax,077600
je 1f ! zero exponent
mov cx,7
shr ax,cl
sub ax,126
mov cx,ax ! exponent in cx
mov ax,6(bx)
and ax,0100177
or ax,0037400 ! load -1 exponent
mov dx,4(bx)
mov bx,2(bx)
mov 4(bx),ax
mov 2(bx),dx
mov (bx),cx
ret
1: ! we get here on zero exp
mov ax,6(bx)
and ax,0177
or ax,4(bx)
jne 1f ! zero result
xor ax,ax
mov bx,2(bx)
mov (bx),ax
mov 2(bx),ax
mov 4(bx),ax
ret
1: ! otherwise unnormalized number
mov cx,6(bx)
and cx,0100177
mov dx,cx
and cx,0x8000
mov ax,-125
2:
test dx,0x80
jne 1f
dec ax
shl 4(bx),1
rcl dx,1
or dx,cx
jmp 2b
1:
mov cx,4(bx)
mov bx,2(bx)
mov (bx),ax
mov 2(bx),cx
and dx,0100177
or dx,0037400 ! load -1 exponent
mov 4(bx),dx
ret
.fef8:
! this could be simpler, if only the
! fxtract instruction was emulated properly
mov bx,sp
mov ax,10(bx)
and ax,077760
je 1f ! zero exponent
mov cx,4
shr ax,cl
sub ax,1022
mov cx,ax ! exponent in cx
mov ax,10(bx)
and ax,0100017
or ax,0037740 ! load -1 exponent
push 8(bx)
push 6(bx)
push 4(bx)
mov bx,2(bx)
pop 2(bx)
pop 4(bx)
pop 6(bx)
mov 8(bx),ax
mov (bx),cx
ret
1: ! we get here on zero exp
mov ax,10(bx)
and ax,017
or ax,8(bx)
or ax,6(bx)
or ax,4(bx)
jne 1f ! zero result
xor ax,ax
mov bx,2(bx)
mov (bx),ax
mov 2(bx),ax
mov 4(bx),ax
mov 6(bx),ax
mov 8(bx),ax
ret
1: ! otherwise unnormalized number
mov cx,10(bx)
and cx,0100017
mov dx,cx
and cx,0x8000
mov ax,-1021
2:
test dx,0x10
jne 1f
dec ax
shl 4(bx),1
rcl 6(bx),1
rcl 8(bx),1
rcl dx,1
or dx,cx
jmp 2b
1:
and dx,0100017
or dx,0037740 ! load -1 exponent
mov cx,8(bx)
push 6(bx)
push 4(bx)
mov bx,2(bx)
mov (bx),ax
mov 8(bx),dx
mov 6(bx),cx
pop 2(bx)
pop 4(bx)
ret
.cif4:
mov bx,sp
cmp 2(bx),2
jne 1f
wait
filds 4(bx)
wait
fstps 2(bx)
wait
ret
1:
wait
fildl 4(bx)
wait
fstps 4(bx)
wait
ret
.cif8:
mov bx,sp
cmp 2(bx),2
jne 1f
wait
filds 4(bx)
wait
fstpd 2(bx)
wait
ret
1:
wait
fildl 4(bx)
wait
fstpd 2(bx)
wait
ret
.cuf4:
mov bx,sp
cmp 2(bx),2
jne 1f
mov ax,4(bx)
mov 2(bx),ax
mov 4(bx),0
wait
fildl 2(bx)
wait
fstps 2(bx)
wait
ret
1:
wait
fildl 4(bx)
wait
cmp 6(bx),0
jge 1f
2:
wait
fisubl (bigmin)
wait
fisubl (bigmin)
1:
wait
fstps 4(bx)
wait
ret
.cuf8:
mov bx,sp
cmp 2(bx),2
jne 1f
mov 6(bx),0
1:
wait
fildl 4(bx)
wait
cmp 6(bx),0
jge 1f
2:
wait
fisubl (bigmin)
wait
fisubl (bigmin)
1:
wait
fstpd 2(bx)
wait
ret
.cfi:
mov bx,sp
push bx
wait
fstcw -2(bx)
wait
mov dx,-2(bx)
or -2(bx),0xc00 ! truncating mode
wait
fldcw -2(bx)
pop ax
cmp 4(bx),4
jne 2f
! loc 4 loc ? cfi
wait
flds 6(bx)
wait
fistpl 6(bx)
wait
cmp 2(bx),2
jne 1f
mov ax,6(bx)
1:
mov 4(bx),dx
wait
fldcw 4(bx)
wait
ret
2:
! loc 8 loc ? cfi
wait
fldd 6(bx)
wait
fistpl 10(bx)
wait
cmp 2(bx),2
jne 1b
mov ax,10(bx)
jmp 1b
.cfu:
mov bx,sp
push bx
wait
fstcw -2(bx)
wait
mov dx,-2(bx)
and -2(bx),0xf3ff
or -2(bx),0x400 ! to -infinity
wait
fldcw -2(bx)
wait
pop ax
cmp 4(bx),4
jne 2f
! loc 4 loc ? cfu
flds 6(bx)
wait
fabs ! ???
wait
fiaddl (bigmin)
fistpl 6(bx)
wait
mov ax,8(bx)
sub ax,(bigmin+2)
mov 8(bx),ax
cmp 2(bx),2
jne 1f
mov ax,6(bx)
1:
mov 4(bx),dx
wait
fldcw 4(bx)
wait
ret
2:
wait
! loc 8 loc ? cfu
fldd 6(bx)
wait
fabs ! ???
wait
fiaddl (bigmin)
fistpl 10(bx)
wait
mov ax,12(bx)
sub ax,(bigmin+2)
mov 12(bx),ax
cmp 2(bx),2
jne 1b
mov ax,10(bx)
jmp 1b
.cff4:
mov bx,sp
wait
fldd 2(bx)
wait
fstcw 2(bx)
wait
mov dx,2(bx)
and 2(bx),0xf3ff ! set to rounding mode
wait
fldcw 2(bx)
wait
fstps 6(bx)
mov 2(bx),dx
wait
fldcw 2(bx)
wait
ret
.cff8:
mov bx,sp
wait
flds 2(bx)
wait
fstpd 2(bx)
wait
ret
.cmf4:
mov bx,sp
push bx ! room for 8087 status word
xor cx,cx
wait
flds 6(bx)
wait
flds 2(bx)
wait
fcompp ! compare and pop operands
wait
fstsw -2(bx)
wait
mov ax,-2(bx)
sahf
je 1f
jb 2f
dec cx
jmp 1f
2:
inc cx
1:
mov ax,cx
pop bx
ret
.cmf8:
mov bx,sp
push bx ! room for 8087 status word
xor cx,cx
wait
fldd 10(bx)
wait
fldd 2(bx)
wait
fcompp ! compare and pop operands
wait
fstsw -2(bx)
wait
mov ax,-2(bx)
sahf
je 1f
jb 2f
dec cx
jmp 1f
2:
inc cx
1:
mov ax,cx
pop bx
ret