; Math Library to be used in C programs
;after finishing up the new func I found that BC LIBs suck!
; they had a few bugs, such as INF equal to 1.76645645e308 or so, and
; reports an error when pow(0,0) is used which returns 1 but should not
; be an error (at least according to their online help)
.data?
align 4
result REAL8 ?
tmpd dd ?
tmpr real8 ?
tmpr2 real8 ?
tmpw dw ?
sign db ?
.const
_ZERO real8 0.0
EXP_MAX real8 709.7827128933839
ten REAL8 10.0
;FIX : v2.00 Beta #7 : these were all backwards and messed up
rnd_0 label word ;round towards 0
db 7fh,1111b
rnd_up label word ;round up
db 7fh,1011b
rnd_dw label word ;round down
db 7fh,0111b
cw_def label word ;default rounding (to nearest or even)
db 7fh,0011b
.code
RETURN macro ;saves return value (on FPU stack) in Watcom or Borland style
ifdef _WC_
fstp result
fwait
mov eax,dptr[result]
mov edx,dptr[result+4]
ret
else
fwait
ret
endif
endm
LOADF macro ;loads Watcom return into FPU stack
ifdef _WC_
mov dptr[result],eax
mov dptr[result+4],edx
fld result
fwait
endif
endm
CHKF macro ;sets errno based on value on top of FPU stack
fxam
fstsw ax
fwait
and ah,01000111b
.if ah == 001b || ah == 011b
;+/-NAN
mov errno,EDOM
.elseif ah == 101b || ah == 111b
;+/-INF
mov errno,ERANGE
.endif
endm
sin proc,a:REAL8
fld a
fsin
fstsw ax
.if ax&4 ;mask C2
mov errno,ERANGE
.else
mov errno,0
.endif
RETURN
sin endp
cos proc,a:REAL8
fld a
fcos
fstsw ax
.if ax&4 ;mask C2
mov errno,ERANGE
.else
mov errno,0
.endif
fwait
RETURN
cos endp
tan proc,a:REAL8
fld a
fsincos
fstsw ax
.if ax&4 ;mask C2
mov errno,ERANGE
.else
mov errno,0
.endif
fdivp st(1),st
RETURN
tan endp
ftol proc,a:REAL8
fld a
__ftol::
fistp dptr[result]
fwait
mov eax,dptr[result]
ret
ftol endp
f_abs proc,a:REAL8
and bptr [a+7],7fh
fld a
RETURN
f_abs endp
ceil proc,a:REAL8
fldcw rnd_up
fld a
frndint
fldcw cw_def
RETURN
ceil endp
floor proc,a:REAL8
fldcw rnd_dw
fld a
frndint
fldcw cw_def
RETURN
floor endp
;FIX : v2.00 Beta #7 : now supports exp forms
atof proc,a:dword
local _neg:byte
pushad
mov esi,a
mov _neg,0
fldz
xor eax,eax ;keep high part clear
@@:
lodsb
.if al==32
jmp @b
.endif
.if al=='-'
inc _neg
lodsb
.endif
.if al=='e' || al=='E'
jmp doexp ; still have to get exp even though 0**anything is zero
.endif ; cause _str2num_siz_ must be updated
.if al=='.'
jmp dodec
.endif
@@:
.if (al>='0') && (al<='9')
fmul ten
sub al,'0'
mov tmpd,eax
fiadd tmpd
fwait
.elseif al=='.'
jmp dodec
.elseif al=='e' || al=='E'
jmp doexp
.else
jmp done
.endif
lodsb
jmp @b
dodec:
fldz ;decimal part
mov edi,esi ;save EDI for stop pt
lodsb
.if ! ( (al>='0') && (al<='9') )
fstp tmpr ;ignore!
fwait
;FIX v 2.00 Beta #8 : this was not poped off properly
.if al=='e' || al=='E'
jmp doexp
.endif
jmp done ;no numbers after .
.endif
@@:
.if (al>='0') && (al<='9')
lodsb
jmp @b
.endif
push esi
push ax ;save last thing (if it's 'e' then there is an exp part)
dec esi ;go back
dec esi
@@: ;go until ESI==EDI
mov al,[esi]
sub al,'0'
mov tmpd,eax
fiadd tmpd
fdiv ten
fwait
.if esi>edi
dec esi
jmp @b
.endif
faddp st(1),st
pop ax
pop esi
.if !(al=='e' || al=='E')
jmp done
.endif
doexp:
;esi=>char after e
.if bptr[esi]=='-'
mov ch,1
inc esi
.else
mov ch,0
.endif
xor eax,eax
xor ebx,ebx
@@:
lodsb
.if !((al >= '0') && (al<= '9'))
jmp expdone
.endif
sub al,'0'
imul ebx,ebx,10
add ebx,eax
jmp @b
expdone:
fstp tmpr ;save #
mov tmpd,ebx
fild tmpd
fstp tmpr2
fwait
callp pow,ten,tmpr2
LOADF ;st(1)
fld tmpr ;st ;reload #
.if ch==1 ;neg
fxch
fdivp st(1),st
.else ;pos
fmulp st(1),st
.endif
done:
.if _neg
fchs
.endif
mov eax,esi
sub eax,a
dec eax ;minus the last char not used (ie: NULL)
mov _str2num_siz_,eax ;FIX : v2.00 Beta #7 : this was not set right
popad
RETURN
atof endp
exp PROC, val:REAL8
mov [errno], 0 ; clear matherror
fld val ; load the value
fcom EXP_MAX ; exceeded maximum?
fstsw ax ; save status word in AX
fwait ; wait this shit be idle
sahf ; load flags with it
jna @f
mov [errno], ERANGE ; set matherror from QLIB
@@:
fldl2e ; load log 2 (base e)
fmulp st(1), st(0) ; mul them
fld st(0) ; copy st(0) to st(1)
frndint ; rount st(0)
fxch st(1) ; xchange st(1) for st(0)
fsub st(0), st(1) ; sub rounded from unrounded
f2xm1 ; calc 2^x-1
fld1 ; load 1.00
faddp st(1), st(0) ; add 1.00 to st(1)
fscale ; exponential function of a
ffree st(1) ; remove rounded value
RETURN
exp ENDP
log proc, val:REAL8
mov [errno], 0 ; clear matherror
fld val ; load the value
ftst ; compare with zero
fstsw ax ; save status word in AX
fwait ; wait this shit be idle
sahf ; load flags with it
.if carry? ;jb @@negative ; jump if value < 0
mov [errno], EDOM ; domain error
.endif
.if zero? ;je @@zero ; jump if zero
mov [errno], ERANGE ; range error
.endif
fldln2 ; load natural log of 2
fxch st(1) ; xchange it with value
fyl2x ; calc y=log2(x)
RETURN
log ENDP
log10 PROC, val:REAL8
mov [errno], 0 ; clear matherror
fld val ; load the value
ftst ; compare with zero
fstsw ax ; save status word in AX
fwait ; wait this shit be idle
sahf ; load flags with it
.if carry? ;jb @@negative ; jump if value < 0
mov [errno], EDOM ; domain error
.endif
.if zero? ;je @@zero ; jump if zero
mov [errno], ERANGE ; range error
.endif
fldlg2 ; load log of 2
fxch st(1) ; xchange it wih value
fyl2x ; calc y=log2(x)
RETURN
log10 ENDP
log2 PROC, val:REAL8
mov [errno], 0 ; clear matherror
fld val ; load the value
ftst ; compare with zero
fstsw ax ; save status word in AX
fwait ; wait this shit be idle
sahf ; load flags with it
.if carry? ;jb @@negative ; jump if value < 0
mov [errno], EDOM ; domain error
.endif
.if zero? ;je @@zero ; jump if zero
mov [errno], ERANGE ; range error
.endif
fld1 ; load 1
fxch st(1) ; xchange it with value
fyl2x ; calc y=log2(x)
RETURN
log2 ENDP
pow PROC, val:REAL8, power:REAL8
mov errno,0
fld val
fcomp _ZERO
fstsw ax
fwait
sahf
.if zero?
fld power
fcomp _ZERO
fstsw ax
fwait
sahf
.if zero? ;this is ANSI C specs
fld1 ;load one! (in reality 0**0 is INF - o well)
RETURN
.endif
fldz ;0**power = 0 always
RETURN
.endif
fld power
fcomp _ZERO
fstsw ax
fwait
sahf
.if zero? ;this is ANSI C specs
fld1 ;load one!
RETURN
.endif
callp log,val ; calculate log of val
LOADF
fld power ; load power
fmulp st(1), st(0) ; multiply them
fstp result ; save result
callp exp,result ; calculate exp func of result
LOADF
CHKF ;setup error codes
RETURN
pow ENDP
sqrt PROC, val:REAL8
mov [errno], 0 ; clear matherror
fld val ; load val
ftst ; compare with zero
fstsw ax ; save status word in AX
fwait ; wait this shit be idle
sahf ; load flags with it
.if carry? ; jump if value < 0
mov [errno], EDOM ; uh-oh. val < 0 = domain err!
fsqrt ;will return -NAN ; square root of st(0)
fabs ;make sure it's +NAN
.else
fsqrt ; square root of st(0)
.endif
RETURN
sqrt ENDP
