532 lines
11 KiB
NASM
532 lines
11 KiB
NASM
|
page ,132
|
||
|
|
title 87cdisp - C transcendental function dispatcher
|
||
|
|
;***
|
||
|
|
;87cdisp.asm - C transcendental function dispatcher (80x87/emulator version)
|
||
|
|
;
|
||
|
|
; Copyright (c) 1987-2001, Microsoft Corporation. All rights reserved.
|
||
|
|
;
|
||
|
|
;Purpose:
|
||
|
|
; Common dispatch code and error handling for C transcendental functions
|
||
|
|
;
|
||
|
|
;Revision History:
|
||
|
|
; 07-04-84 GFW initial version
|
||
|
|
; 12-21-84 GFW correctly point to name in matherr struct
|
||
|
|
; 05-12-85 GFW return HUGE correctly signed on ERANGE errors
|
||
|
|
; fill 2nd operand for matherr structure correctly
|
||
|
|
; 07-05-85 GFW check for possible overflow on PLOSS errors
|
||
|
|
; in this case OVERFLOW overrides PLOSS
|
||
|
|
; 07-08-85 GFW added FWAIT in useHUGE
|
||
|
|
; 11-20-85 GFW faster RANGE checking
|
||
|
|
; 09-30-86 JMB internationalized error message handling
|
||
|
|
; 03-09-87 BCM changed writestr to _wrt2err (extern)
|
||
|
|
; 04-14-87 BCM log(0.0) and log10(0.0) sets errno to ERANGE
|
||
|
|
; for MS C 5.0 (ANSI compatible); errno is still
|
||
|
|
; set to EDOM for IBM C 2.0 (System V compatible).
|
||
|
|
; 04-28-87 BCM Added _cintrindisp1 and _cintrindisp2
|
||
|
|
; for C "intrinsic" versions of pow, log, log10, exp,
|
||
|
|
; cos, sin, tan, acos, asin, atan, atan2,
|
||
|
|
; cosh, sinh, tanh, sqrt, ... for MS C 5.0
|
||
|
|
; 08-04-87 BCM Removed "externP write" declaration.
|
||
|
|
; 08-17-87 BCM Changed _wrt2err from near to model-dependent
|
||
|
|
; except for IMBC20; this is because of QC core lib
|
||
|
|
; 10-12-87 BCM OS/2 support C library changes
|
||
|
|
; 11-24-87 BCM added _loadds under ifdef DLL
|
||
|
|
; 01-18-88 BCM eliminated IBMC20; ifos2,noos2 ==> ifmt, nomt
|
||
|
|
; 02-10-88 WAJ MTHREAD libraries now lock stderr when printing errors
|
||
|
|
; 04-25-88 WAJ _cpower is on the stack for MTHREAD so must be set to 1
|
||
|
|
; 07-11-88 WAJ address of matherr structure was incorrect in MTHREAD case
|
||
|
|
; 08-24-88 WAJ 386 version.
|
||
|
|
; 11-20-89 WAJ 386 MTHREAD is no longer _pascal.
|
||
|
|
; 08-17-90 WAJ Now uses _stdcall.
|
||
|
|
; 10-15-90 WAJ Fixed intrinsic/2 argument problems.
|
||
|
|
; 05-17-91 WAJ Added _STDCALL ifdefs.
|
||
|
|
; 08-27-91 JCR ANSI naming
|
||
|
|
; 09-15-91 GDP Added _cwrt2err. _NMSG_WRITE is no longer _pascal
|
||
|
|
; 11-15-91 GDP Removed error message display stuff
|
||
|
|
; moved exception structure to stack frame, even for
|
||
|
|
; single thread code (allow recursive calls of
|
||
|
|
; transcendentals through matherr)
|
||
|
|
; call _87except after fsave
|
||
|
|
; put Localfac on the stack for multi thread
|
||
|
|
; 02-10-92 GDP changed error handling avoid polluting the fp status word
|
||
|
|
; 03-15-92 GDP extensive changes in error detection scheme
|
||
|
|
; 10-27-92 SKS Re-arranged some code to make this work with MASM 6.10
|
||
|
|
; 11-06-92 GDP merged changes from the fp tree on \\vangogh: removed
|
||
|
|
; saveflag, added __fastflag, new range error checking
|
||
|
|
; 09-06-94 CFW Replace MTHREAD with _MT.
|
||
|
|
; 04-06-01 PML CHECKOVER should check overflow, not underflow (vs7#132450)
|
||
|
|
;*******************************************************************************
|
||
|
|
|
||
|
|
.xlist
|
||
|
|
include cruntime.inc
|
||
|
|
include mrt386.inc
|
||
|
|
include os2supp.inc
|
||
|
|
include elem87.inc
|
||
|
|
.list
|
||
|
|
|
||
|
|
|
||
|
|
EDOM = 33 ; math error numbers
|
||
|
|
ERANGE = 34
|
||
|
|
|
||
|
|
EDOMAIN = 120 ; internal error number for DOMAIN
|
||
|
|
ESING = 121 ; internal error number for SING
|
||
|
|
ETLOSS = 122 ; internal error number for TLOSS
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
.data
|
||
|
|
|
||
|
|
comm _matherr_flag:dword
|
||
|
|
extrn __fastflag:dword
|
||
|
|
|
||
|
|
.const
|
||
|
|
|
||
|
|
staticQ DblMax, 07fefffffffffffffR
|
||
|
|
staticQ DblMin, 00010000000000000R
|
||
|
|
staticQ IeeeAdjO, 0c098000000000000R
|
||
|
|
staticQ IeeeAdjU, 04098000000000000R
|
||
|
|
staticQ _infinity, 07ff0000000000000R
|
||
|
|
staticQ _zero, 00000000000000000R
|
||
|
|
|
||
|
|
ifndef _MT
|
||
|
|
|
||
|
|
.data?
|
||
|
|
|
||
|
|
staticQ LocalFac, ?
|
||
|
|
intrinflag db ?
|
||
|
|
|
||
|
|
else ;_MT
|
||
|
|
|
||
|
|
|
||
|
|
MTStackFrame struc
|
||
|
|
MTS_LocalFac dq ?
|
||
|
|
MTS_cdispflags db ?
|
||
|
|
MTStackFrame ends
|
||
|
|
|
||
|
|
MTSFISize equ ((size MTStackFrame) + ISIZE - 1) and (not (ISIZE-1))
|
||
|
|
|
||
|
|
|
||
|
|
LocalFac equ <MTSF.MTS_LocalFac>
|
||
|
|
cdispflags equ <MTSF.MTS_cdispflags>
|
||
|
|
|
||
|
|
INTRINFLAG = 01h
|
||
|
|
TWOARGFLAG = 02h
|
||
|
|
|
||
|
|
endif ;_MT
|
||
|
|
|
||
|
|
; error value action table
|
||
|
|
|
||
|
|
;labelW retvaltab
|
||
|
|
; DNCPTR codeOFFSET useretval
|
||
|
|
page
|
||
|
|
|
||
|
|
|
||
|
|
CODESEG
|
||
|
|
|
||
|
|
extrn _trandisp1:near
|
||
|
|
extrn _trandisp2:near
|
||
|
|
extrn _87except:proc
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
;----------------------------------------------------------
|
||
|
|
;
|
||
|
|
; intrinsic versions: TRANSCENDENTAL DISPATCH ROUTINES
|
||
|
|
;
|
||
|
|
;----------------------------------------------------------
|
||
|
|
;
|
||
|
|
; _cintrindisp1 - Intrinsic Dispatch for 1 arg DP transcendental
|
||
|
|
; _cintrindisp2 - Intrinsic Dispatch for 2 arg DP transcendental
|
||
|
|
;
|
||
|
|
; rdx - function dispatch table address
|
||
|
|
;
|
||
|
|
;----------------------------------------------------------
|
||
|
|
|
||
|
|
|
||
|
|
_cintrindisp2 proc uses RBXONLY
|
||
|
|
local DLSF[DSFISize]:IWORD
|
||
|
|
ifmt <local MTSF[MTSFISize]:IWORD>
|
||
|
|
|
||
|
|
|
||
|
|
fstcw [DSF.savCntrl]
|
||
|
|
fwait
|
||
|
|
|
||
|
|
; store the args in case they are needed by matherr.
|
||
|
|
; Generally avoid storing since this may generate
|
||
|
|
; various exceptions (overflow, underflow, inexact, invalid)
|
||
|
|
; Args will not be available to an exception handler and
|
||
|
|
; users should not use /Oi if interested in IEEE conformance
|
||
|
|
|
||
|
|
cmp [_matherr_flag], 0
|
||
|
|
JSE save2arg
|
||
|
|
|
||
|
|
lab resume2
|
||
|
|
|
||
|
|
;ifmt <mov [_cpower], 1> ; set _cpower to C semantics
|
||
|
|
; DISABLED this feature since pow(0,0)
|
||
|
|
; will return 1 in C (NCEG spec) which
|
||
|
|
; is the same as in FORTRAN --GDP
|
||
|
|
|
||
|
|
|
||
|
|
call _trandisp2
|
||
|
|
|
||
|
|
ifmt <or [cdispflags], (INTRINFLAG OR TWOARGFLAG)>
|
||
|
|
nomt <mov [intrinflag], 1>
|
||
|
|
|
||
|
|
call cintrinexit
|
||
|
|
ret
|
||
|
|
|
||
|
|
|
||
|
|
lab save2arg
|
||
|
|
fxch
|
||
|
|
fst [DSF.arg1]
|
||
|
|
fxch
|
||
|
|
fst [DSF.arg2]
|
||
|
|
jmp resume2
|
||
|
|
|
||
|
|
_cintrindisp2 endp
|
||
|
|
|
||
|
|
|
||
|
|
_cintrindisp1 proc uses RBXONLY
|
||
|
|
local DLSF[DSFISize]:IWORD
|
||
|
|
ifmt <local MTSF[MTSFISize]:IWORD>
|
||
|
|
|
||
|
|
|
||
|
|
fstcw [DSF.savCntrl]
|
||
|
|
cmp [_matherr_flag], 0
|
||
|
|
JSE save1arg
|
||
|
|
|
||
|
|
lab resume1
|
||
|
|
|
||
|
|
call _trandisp1
|
||
|
|
|
||
|
|
ifmt <or [cdispflags],INTRINFLAG>
|
||
|
|
ifmt <and [cdispflags],(NOT TWOARGFLAG)>
|
||
|
|
nomt <mov [intrinflag], 1>
|
||
|
|
|
||
|
|
call cintrinexit
|
||
|
|
ret
|
||
|
|
|
||
|
|
|
||
|
|
lab save1arg
|
||
|
|
fst [DSF.arg1]
|
||
|
|
jmp resume1
|
||
|
|
|
||
|
|
|
||
|
|
_cintrindisp1 endp
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
;*******************************************************************************
|
||
|
|
;*
|
||
|
|
;* TRANSCENDENTAL DISPATCH ROUTINES
|
||
|
|
;*
|
||
|
|
;*******************************************************************************
|
||
|
|
;*
|
||
|
|
;* _ctrandisp1 - Dispatch for 1 arg DP transcendental
|
||
|
|
;* _ctrandisp2 - Dispatch for 2 arg DP transcendental
|
||
|
|
;*
|
||
|
|
;* edx - function dispatch table address
|
||
|
|
;*
|
||
|
|
;*******************************************************************************
|
||
|
|
|
||
|
|
;*
|
||
|
|
;* Two arg standard dispatch.
|
||
|
|
;*
|
||
|
|
|
||
|
|
_ctrandisp2 proc uses ebx, parm1:qword, parm2:qword
|
||
|
|
|
||
|
|
local DLSF[DSFISize]:IWORD
|
||
|
|
ifmt <local MTSF[MTSFISize]:IWORD>
|
||
|
|
|
||
|
|
|
||
|
|
push dword ptr [parm1+4] ; load arg1
|
||
|
|
push dword ptr [parm1]
|
||
|
|
call _fload
|
||
|
|
ifndef _STDCALL
|
||
|
|
add esp, 8
|
||
|
|
endif
|
||
|
|
push dword ptr [parm2+4] ; load arg2
|
||
|
|
push dword ptr [parm2]
|
||
|
|
call _fload
|
||
|
|
ifndef _STDCALL
|
||
|
|
add esp, 8
|
||
|
|
endif
|
||
|
|
|
||
|
|
fstcw [DSF.savCntrl]
|
||
|
|
|
||
|
|
ifmt <or [cdispflags], TWOARGFLAG>
|
||
|
|
ifmt <mov [_cpower], 1> ; set _cpower to C semantics
|
||
|
|
|
||
|
|
call _trandisp2
|
||
|
|
|
||
|
|
call ctranexit
|
||
|
|
|
||
|
|
ifdef _STDCALL
|
||
|
|
ret 16
|
||
|
|
else
|
||
|
|
ret
|
||
|
|
endif
|
||
|
|
|
||
|
|
;*
|
||
|
|
;* Check for overflow and errors.
|
||
|
|
;*
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
ctranexit::
|
||
|
|
|
||
|
|
ifmt <and [cdispflags], (NOT INTRINFLAG)>
|
||
|
|
nomt <mov [intrinflag], 0>
|
||
|
|
|
||
|
|
cintrinexit::
|
||
|
|
cmp __fastflag, 0
|
||
|
|
JSNZ restoreCW
|
||
|
|
|
||
|
|
fst qword ptr [LocalFac] ; cast result to double precision
|
||
|
|
|
||
|
|
;
|
||
|
|
; PROBLEM: Since the intrinsics may be given an argument anywhere
|
||
|
|
; in the long double range, functions that are not normally
|
||
|
|
; expected to overflow (like sqrt) may generate IEEE exceptions
|
||
|
|
; at this point. We can cure this by making the checkrange test
|
||
|
|
; standard.
|
||
|
|
;
|
||
|
|
|
||
|
|
|
||
|
|
mov al, [DSF.ErrorType] ; check for errors
|
||
|
|
or al, al
|
||
|
|
JE checkinexact
|
||
|
|
cmp al, CHECKOVER
|
||
|
|
JE checkoverflow
|
||
|
|
cmp al, CHECKRANGE
|
||
|
|
JSE checkrng
|
||
|
|
or al, al
|
||
|
|
JSE restoreCW
|
||
|
|
CBI
|
||
|
|
mov [DSF.typ], rax ; set exception type
|
||
|
|
jmp haveerror
|
||
|
|
|
||
|
|
|
||
|
|
lab checkinexact
|
||
|
|
|
||
|
|
; This will be the most common path because of
|
||
|
|
; the nature of transcendentals. If inexact is
|
||
|
|
; unmasked in user's cw and active, raise it
|
||
|
|
|
||
|
|
mov ax, [DSF.savCntrl]
|
||
|
|
and ax, 20h
|
||
|
|
JSNZ restoreCW ; inexact exception masked
|
||
|
|
fstsw ax
|
||
|
|
and ax, 20h
|
||
|
|
JSZ restoreCW
|
||
|
|
mov [DSF.typ], INEXACT
|
||
|
|
jmp haveerror
|
||
|
|
|
||
|
|
|
||
|
|
lab restoreCW
|
||
|
|
lab restoreCW2
|
||
|
|
fldcw [DSF.savCntrl] ; load old control word
|
||
|
|
fwait
|
||
|
|
|
||
|
|
retn
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
lab checkrng
|
||
|
|
mov ax, word ptr [LocalFac+6] ; get exponent part
|
||
|
|
and ax, 07ff0h
|
||
|
|
or ax, ax
|
||
|
|
JSE haveunderflow
|
||
|
|
cmp ax, 07ff0h
|
||
|
|
JSE haveoverflow
|
||
|
|
jmp checkinexact ; assume possibly inexact result
|
||
|
|
|
||
|
|
|
||
|
|
lab checkoverflow
|
||
|
|
mov ax, word ptr [LocalFac+6] ; get exponent part
|
||
|
|
and ax, 07ff0h
|
||
|
|
cmp ax, 07ff0h
|
||
|
|
JSE haveoverflow
|
||
|
|
jmp checkinexact ; assume possibly inexact result
|
||
|
|
|
||
|
|
|
||
|
|
lab haveunderflow
|
||
|
|
mov [DSF.typ], UNDERFLOW
|
||
|
|
fld IeeeAdjU
|
||
|
|
fxch
|
||
|
|
fscale
|
||
|
|
fstp st(1)
|
||
|
|
fld st(0)
|
||
|
|
fabs
|
||
|
|
fcomp [DblMin]
|
||
|
|
fstsw ax
|
||
|
|
sahf
|
||
|
|
JSAE haveerror
|
||
|
|
fmul [_zero]
|
||
|
|
jmp short haveerror
|
||
|
|
|
||
|
|
lab haveoverflow
|
||
|
|
mov [DSF.typ], OVERFLOW
|
||
|
|
fld IeeeAdjO
|
||
|
|
fxch
|
||
|
|
fscale
|
||
|
|
fstp st(1)
|
||
|
|
fld st(0)
|
||
|
|
fabs
|
||
|
|
fcomp [DblMax]
|
||
|
|
fstsw ax
|
||
|
|
sahf
|
||
|
|
JSBE haveerror
|
||
|
|
fmul [_infinity]
|
||
|
|
|
||
|
|
lab haveerror
|
||
|
|
; fill error structure and call matherr
|
||
|
|
|
||
|
|
push rsi ; save si
|
||
|
|
push rdi
|
||
|
|
|
||
|
|
mov rbx, [DSF.Function] ; get function jmp table address
|
||
|
|
inc rbx
|
||
|
|
|
||
|
|
mov [DSF.nam], rbx ; save name address
|
||
|
|
|
||
|
|
|
||
|
|
ifmt <test cdispflags, INTRINFLAG>
|
||
|
|
nomt <cmp [intrinflag], 0>
|
||
|
|
|
||
|
|
JSNE aftercopy
|
||
|
|
;
|
||
|
|
; copy function args (for matherr structure)
|
||
|
|
;
|
||
|
|
cld
|
||
|
|
lea esi, [parm1]
|
||
|
|
lea edi, [DSF.arg1]
|
||
|
|
movsd
|
||
|
|
movsd
|
||
|
|
cmp [rbx-1].fnumarg, 1 ; check for 2nd parameter
|
||
|
|
JSE aftercopy
|
||
|
|
lea esi, [parm2]
|
||
|
|
lea edi, [DSF.arg2]
|
||
|
|
movsd
|
||
|
|
movsd
|
||
|
|
|
||
|
|
lab aftercopy
|
||
|
|
lab useretval
|
||
|
|
fstp [DSF.retval] ; store return value
|
||
|
|
|
||
|
|
|
||
|
|
;
|
||
|
|
; If intrinsic calling convention, an 'fsave' is required
|
||
|
|
; before matherr starts doing any fp operations.
|
||
|
|
; (This needs to be documented.)
|
||
|
|
|
||
|
|
lea rax, [DSF.typ]
|
||
|
|
lea rbx, [DSF.savCntrl]
|
||
|
|
push rbx
|
||
|
|
push rax
|
||
|
|
mov rbx, [DSF.function]
|
||
|
|
mov al, [rbx].fnumber
|
||
|
|
CBI
|
||
|
|
push rax
|
||
|
|
call _87except ; _fpexcept(&exception, &savedcw)
|
||
|
|
ifndef _STDCALL
|
||
|
|
add esp, 12 ; clear arguments if _cdecl.
|
||
|
|
endif
|
||
|
|
|
||
|
|
lab movretval
|
||
|
|
pop rdi ; restore di
|
||
|
|
pop rsi ; restore si
|
||
|
|
fld [DSF.retval] ; this assumes that the user
|
||
|
|
; does not want to return a
|
||
|
|
; signaling NaN
|
||
|
|
|
||
|
|
jmp restoreCW ; restore CW and return
|
||
|
|
|
||
|
|
_ctrandisp2 endp
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
;*
|
||
|
|
;* One arg standard dispatch.
|
||
|
|
;*
|
||
|
|
|
||
|
|
_ctrandisp1 proc uses ebx, parm1:qword
|
||
|
|
|
||
|
|
local DLSF[DSFISize]:IWORD
|
||
|
|
ifmt <local MTSF[MTSFISize]:IWORD>
|
||
|
|
|
||
|
|
push dword ptr [parm1+4] ; load arg1
|
||
|
|
push dword ptr [parm1]
|
||
|
|
call _fload
|
||
|
|
ifndef _STDCALL
|
||
|
|
add esp, 8
|
||
|
|
endif
|
||
|
|
|
||
|
|
fstcw [DSF.savCntrl]
|
||
|
|
|
||
|
|
ifmt <and [cdispflags],(NOT TWOARGFLAG)>
|
||
|
|
|
||
|
|
call _trandisp1
|
||
|
|
|
||
|
|
call ctranexit
|
||
|
|
|
||
|
|
ifdef _STDCALL
|
||
|
|
ret 8
|
||
|
|
else
|
||
|
|
ret
|
||
|
|
endif
|
||
|
|
|
||
|
|
|
||
|
|
_ctrandisp1 endp
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
;
|
||
|
|
; Load arg in the fp stack without raising an exception if the argument
|
||
|
|
; is a signaling NaN
|
||
|
|
;
|
||
|
|
|
||
|
|
|
||
|
|
_fload proc uses ebx, parm:qword
|
||
|
|
local tmp:tbyte
|
||
|
|
|
||
|
|
mov ax, word ptr [parm+6] ; get exponent field
|
||
|
|
mov bx, ax ; save it
|
||
|
|
and ax, 07ff0h
|
||
|
|
cmp ax, 07ff0h ; check for special exponent
|
||
|
|
JSNE fpload
|
||
|
|
; have special argument (NaN or INF)
|
||
|
|
or bx, 07fffh ; preserve sign, set max long double exp
|
||
|
|
mov word ptr [tmp+8], bx
|
||
|
|
; convert to long double
|
||
|
|
mov eax, dword ptr [parm+4]
|
||
|
|
mov ebx, dword ptr [parm]
|
||
|
|
shld eax, ebx, 11
|
||
|
|
; the MSB of the significand is
|
||
|
|
; already 1 because of the exponent value
|
||
|
|
mov dword ptr [tmp+4], eax
|
||
|
|
mov dword ptr [tmp], ebx
|
||
|
|
fld tmp
|
||
|
|
jmp short return
|
||
|
|
|
||
|
|
lab fpload
|
||
|
|
fld parm
|
||
|
|
lab return
|
||
|
|
ifdef _STDCALL
|
||
|
|
ret 8
|
||
|
|
else
|
||
|
|
ret
|
||
|
|
endif
|
||
|
|
|
||
|
|
_fload endp
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
end
|