windows-server-2003/base/crts/fpw32/tran/i386/87cdisp.asm

	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