page ,132
title 87tran - elementary functions - EXP, LOG, LN, X^Y
;***
;87tran.asm - elementary functions - EXP, LOG, LN, X^Y
;
; Copyright (c) 1984-2001, Microsoft Corporation. All rights reserved.
;
;Purpose:
; Support for EXP, LOG, LN, X^Y (80x87/emulator version)
;
;Revision History:
;
; 07/04/84 Greg Whitten
; initial version
;
; 07/05/85 Greg Whitten
; support x ^ y where x < 0 and y is an integer
;
; 07/08/85 Greg Whitten
; corrected value of infinity (was a NaN)
;
; 07/26/85 Greg Whitten
; make XENIX version truely System V compatible
;
; 10/31/85 Jamie Bariteau
; made _fFEXP and _fFLN public labels
;
; 05/29/86 Jamie Bariteau
; make pow return values conform to System V and
; ANSI C standards
;
; 09/12/86 Barry McCord
; added FORTRAN specific code to deal
; with zero**nonpositive;
; it requires run-time switching on language
; for mixed-language support
;
; 10/09/86 Barry McCord
; cotan(0.0) ==> SING error (jmp _rtinfnpopse),
; return infinity
;
; 06/11/87 Greg Whitten
; faster transcendental functions
;
; 06/24/87 Barry McCord
; fixed FORTRAN 4.01 bug (bcp #1801) in which
; an expression of the form
; (small positive less than one) ** (large positive)
; was overflowing instead of underflowing to zero
;
; 10/30/87 Bill Johnston
; made changes for os/2 support.
;
; 04/25/88 Bill Johnston
; _cpower is now on stack for MTHREAD
;
; 05/01/88 Bill Johnston
; si was being trashed in MTHREAD
;
; 06/03/88 Bill Johnston
; fixed neg ^ int int MTHREAD case
;
; 08/24/88 Bill Johnston
; 386 version
;
; 11/15/91 Georgios Papagiannakopoulos
; NT port. call _powhlp to handle special cases for pow()
;
; 04/01/91 Georgios Papagiannakopoulos
; fixed special values: log(-INF), log(0), pow(0, neg)
;
; 10/27/92 Steve Salisbury
; Move declaration of _powhlp out of .data declarations
; This fix is required for use with MASM 6.10.
;
; 11/06/92 Georgios Papagiannakopoulos
; changed special return values for NCEG conformance
;
; 09/06/94 Chris Weight
; Change MTHREAD to _MT.
;
; 12/09/94 Jamie MacCalman
; Modified fFEXP to test for bogus Pentiums and call an FDIV workaround
;
; 12/13/94 SKS Correct spelling of _adjust_fdiv
;
; 10-15-95 BWT Don't do _adjust_fdiv test for NT.
;
;*******************************************************************************
.xlist
include cruntime.inc
include mrt386.inc
include elem87.inc
include os2supp.inc
.list
.data
globalT _infinity, 07FFF8000000000000000R
globalT _minfinity, 0FFFF8000000000000000R
globalT _logemax, 0400DB1716685B9D7A7DCR
staticT _log2max, 0400DFFFF000000000000R
staticT _smallarg, 03FFD95F619980C4336F7R
staticQ _half, 03fe0000000000000R
SBUFSIZE EQU 108
ifndef _MT
staticT _temp, 0
extrn _cpower:byte
endif
ifndef NT_BUILD
extrn _adjust_fdiv:dword
endif
jmptab OP_EXP,3,<'exp',0,0,0>,<0,0,0,0,0,0>,1
DNCPTR codeoffset fFEXP ; 0000 TOS Valid non-0
DNCPTR codeoffset _rtonenpop ; 0001 TOS 0
DNCPTR codeoffset _tosnan1 ; 0010 TOS NAN
DNCPTR codeoffset _rtforexpinf ; 0011 TOS Inf
page
CODESEG
extrn _rtindfpop:near
extrn _rtindfnpop:near
extrn _rtnospop:near
extrn _rtonepop:near
extrn _rtonenpop:near
extrn _rttospop:near
extrn _rttosnpop:near
extrn _rttosnpopde:near
extrn _rtzeronpop:near
extrn _tosnan1:near
extrn _tosnan2:near
extrn _nosnan2:near
extrn _nan2:near
extrn _powhlp:proc
ifndef NT_BUILD
extrn _safe_fdivr:near
endif
;----------------------------------------------------------
;
; LOG AND EXPONENTIAL FUNCTIONS
;
;----------------------------------------------------------
;
; INPUTS - For single argument functions the argument
; is the stack top. For fFYTOX the base
; is next to stack top, the exponent is
; the stack top.
; For single argument functions the sign is
; in bit 2 of CL. For fFYTOX the base
; sign is bit 2 of CH, the exponent
; sign is bit 2 of CL.
;
; OUTPUT - The result is the stack top
;
;----------------------------------------------------------
lab fFYTOX
mov DSF.ErrorType, CHECKRANGE ; indicate possible over/under flow on exit
or ch,ch ; base < 0
JSNZ negYTOX ; check for integer power
fxch ; TOS = base , NOS = exponent
lab fFXTOY
fyl2x ; compute y*log2(x)
jmp short fF2X ; compute 2^(y*log2(x))
;-----------------------------------------------
;
; Entry for exponential function (exp)
;
;-----------------------------------------------
labelNP _fFEXP, PUBLIC
lab fFEXP
mov DSF.ErrorType, CHECKRANGE ; indicate possible over/under flow on exit
xor ch,ch ; result is always positive
fldl2e
fmul ; convert log base e to log base 2
lab fF2X
call _ffexpm1 ; get exponent and (2^fraction)-1
fld1
fadd
test CondCode,1 ; if fraction > 0 (TOS > 0)
JSZ ExpNoInvert ; bypass 2^x invert
fld1
ifdef NT_BUILD ; NT always handles the P5 bug in the OS
fdivrp st(1),st(0)
else
cmp _adjust_fdiv, 1
jz badP5_fdivr
fdivrp st(1),st(0)
jmp fdivr_done
lab badP5_fdivr
call _safe_fdivr
lab fdivr_done
endif
lab ExpNoInvert
test dl,040h ; if integer part was zero
JSNZ ExpScaled ; bypass scaling to avoid bug
fscale ; now TOS = 2^x
lab ExpScaled
or ch,ch ; check for negate flag
JSZ expret
fchs ; negate result (negreal ^ odd integer)
lab expret
jmp _rttospop
lab negYTOX ; check for negreal ^ integer
call _isintTOS
or eax, eax
JSE negYTOXerror
xor ch,ch
cmp eax, 2
JSE evenexp
not ch ; ch <> 0 means negative result
lab evenexp
fxch
fabs ; x is positive
jmp fFXTOY ; continue with ch <> 0 for neg result
lab _rtfor0to0
;cmp [_cpower], 1 ; DISABLED (conform to NCEG spec)
;JSE c_0to0 ; C requires a DOMAIN error for System V compat.
jmp _rtonepop ; MS FORTRAN has 0.0**0.0 == 1.0
c_0to0:: ; System V needs DOMAIN error with 0.0 return
lab negYTOXerror
lab Yl2XArgNegative
jmp _rtindfpop ; DOMAIN error or SING error
; top of stack now has a NAN
; code in 87cdisp replaces this with
; proper System V return value
; (for C only)
; FORTRAN keeps indefinite value but
; currently aborts on DOMAIN
; and SING errors
; FORTRAN SING error (return infinity)
; e.g. 0.0**negative
; and cotan(0.0)
;
labelNP _rtinfpopse, PUBLIC
fstp st(0)
labelNP _rtinfnpopse, PUBLIC
fstp st(0)
fld tbyte ptr [_infinity]
mov DSF.ErrorType, SING
ret
labelNP _fFLN, PUBLIC
lab fFLN
fldln2
fxch
ftst
fstsw DSF.StatusWord
fwait
test CondCode, 041H ; if arg is negative or zero
JSNZ Yl2XArgNegative ; return a NAN
fyl2x ; compute y*log2(x)
ret
;-------------------------------------------------------
;
; Logarithmic functions (log and log 10) entry points
;
;-------------------------------------------------------
lab _rtforln0 ; (we don't distinguish +0, -0)
mov DSF. ErrorType, SING ; set SING error
fstp st(0)
fld tbyte ptr [_minfinity]
ret
lab _rtforloginf
or cl, cl ; check sign
JSNZ tranindfnpop ; if negetive return indefinite
ret ; else return +INF
; no overflow in this case (IEEE)
lab fFLOGm
fldlg2 ; main LOG10 entry point
jmp short fFYL2Xm
lab fFLNm ; main LN entry point
fldln2
lab fFYL2Xm
fxch
or cl, cl ; if arg is negative
JSNZ Yl2XArgNegative ; return a NAN
fyl2x ; compute y*log2(x)
ret
page
lab _rtforyto0
jmp _rtonepop ; return 1.0
lab _rtfor0tox
call _isintTOS
fstp st(0)
fstp st(0)
or cl, cl ; if 0^(-valid)
JSNZ _rtfor0toneg ; do more checking
fldz
cmp eax, 1 ; eax has the return value of _isintTOS
JSNE zerotoxdone
or ch, ch
JSE zerotoxdone
fchs
lab zerotoxdone
ret
lab _rtfor0toneg
mov DSF.ErrorType, SING
fld tbyte ptr [_infinity]
cmp eax, 1 ; eax has the return value of _isintTOS
JSNE zerotoxdone
or ch, ch
JSE zerotoxdone
fchs
jmp zerotoxdone
lab tranzeropop
fstp st(0) ; toss 1 stack entry
lab tranzeronpop
jmp _rtzeronpop
lab tranindfpop
fstp st(0) ; toss 1 stack entry
lab tranindfnpop
jmp _rtindfnpop
lab ExpArgOutOfRange
pop rax ; remove return address from stack
; We need to check the sign of the
; exponent to distinguish underflow
; from overflow. We cannot just check
; CL directly since for the XtoY case,
; the exponent is a product of Y*log2(x)
; and not an original argument that
; has already been thru FXAM. So,
; the following instructions were
; substituted to fix FORTRAN 4.01
; bcp #1801)
ftst ; check if exponent was negative large
fstsw DSF.StatusWord
fwait
test CondCode, 01h ; if valid^(-large)
JSNZ zeronpopue ; underflow error/return zero
fstp st(0) ; else return infinity/overflow
fld [_infinity]
or ch, ch
JSZ _expbigret
fchs
lab _expbigret
ret
lab zeronpopue
mov DSF.ErrorType, UNDERFLOW
jmp _rtzeronpop
labelNP _rtinfpop, PUBLIC
fstp st(0) ; remove ST(0)
labelNP _rtinfnpop, PUBLIC
fstp st(0) ; remove ST(0)
fld [_infinity] ; push infinity onto stack
lab setOVERFLOW
mov DSF.ErrorType, OVERFLOW ; set OVERFLOW error
ret
lab _rtforexpinf
or cl, cl
JSNZ tranzeronpop ; if exp(-infinity) return +zero
fstp st(0)
fld [_infinity] ; return infinity, no overflow
ret
labelNP _ffexpm1, PUBLIC
fld st(0) ; copy TOS
fabs ; make TOS +ve
fld [_log2max] ; get log2 of largest number
fcompp
fstsw DSF.StatusWord
fwait
test CondCode, 041H ; if abs(arg) >= 2^15-.5
JSNZ ExpArgOutOfRange ; perform arg out of range routine
fld st(0) ; copy TOS
frndint ; near round to integer
ftst
fstsw DSF.StatusWord
fwait
mov dl, CondCode ; save sign of integer part
fxch ; NOS gets integer part
fsub st,st(1) ; TOS gets fraction
ftst
fstsw DSF.StatusWord ; store sign of fraction
fabs
f2xm1
ret
;
; returns 0, 1, 2 if TOS is non-int, odd int or even int respectively
;
lab _isintTOS
fld st(0)
frndint
fcomp
fstsw ax
sahf
JSNE notanint
fld st(0) ; it is an integer
fmul [_half]
fld st(0)
frndint
fcompp
fstsw ax
sahf
JSE evenint
mov eax, 1
lab _isintTOSret
ret
lab notanint
mov eax, 0
jmp _isintTOSret
lab evenint
mov eax, 2
jmp _isintTOSret
lab _usepowhlp
push rsi ; save rsi
sub rsp, SBUFSIZE+8 ; get storage for _retval and savebuf
mov rsi, rsp
push rsi ; push address for result
sub rsp, 8
fstp qword ptr [rsp]
sub rsp, 8
fstp qword ptr [rsp]
fsave [rsi+8]
call _powhlp
ifndef _STDCALL
add esp, 16+ISIZE ; clear arguments if _cdecl.
endif
frstor [rsi+8]
fld qword ptr [rsi] ; load result on the NDP stack
add rsp, SBUFSIZE+8 ; get rid of storage
pop rsi ; restore rsi
test rax, rax ; check return value for domain error
JSZ noerror
jmp _rttosnpopde
lab noerror
ret
end